gcc/ada/libgnat/s-geveop.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
   4 --                                                                          --
   5 --      S Y S T E M . G E N E R I C _ V E C T O R _ O P E R A T I O N S     --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2002-2020, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with System;                    use System;
  33 with System.Address_Operations; use System.Address_Operations;
  34 with System.Storage_Elements;   use System.Storage_Elements;
  35
  36 with Ada.Unchecked_Conversion;
  37
  38 package body System.Generic_Vector_Operations is
  39
  40    IU : constant Integer := Integer (Storage_Unit);
  41    VU : constant Address := Address (Vectors.Vector'Size / IU);
  42    EU : constant Address := Address (Element_Array'Component_Size / IU);
  43
  44    ----------------------
  45    -- Binary_Operation --
  46    ----------------------
  47
  48    procedure Binary_Operation
  49      (R, X, Y : System.Address;
  50       Length  : System.Storage_Elements.Storage_Count)
  51    is
  52       RA : Address := R;
  53       XA : Address := X;
  54       YA : Address := Y;
  55       --  Address of next element to process in R, X and Y
  56
  57       VI : constant Integer_Address := To_Integer (VU);
  58
  59       Unaligned : constant Integer_Address :=
  60                     Boolean'Pos (ModA (OrA (OrA (RA, XA), YA), VU) /= 0) - 1;
  61       --  Zero iff one or more argument addresses is not aligned, else all 1's
  62
  63       type Vector_Ptr is access all Vectors.Vector;
  64       type Element_Ptr is access all Element;
  65
  66       function VP is new Ada.Unchecked_Conversion (Address, Vector_Ptr);
  67       function EP is new Ada.Unchecked_Conversion (Address, Element_Ptr);
  68
  69       SA : constant Address :=
  70              AddA (XA, To_Address
  71                          ((Integer_Address (Length) / VI * VI) and Unaligned));
  72       --  First address of argument X to start serial processing
  73
  74    begin
  75       while XA < SA loop
  76          VP (RA).all := Vector_Op (VP (XA).all, VP (YA).all);
  77          XA := AddA (XA, VU);
  78          YA := AddA (YA, VU);
  79          RA := AddA (RA, VU);
  80       end loop;
  81
  82       while XA < X + Length loop
  83          EP (RA).all := Element_Op (EP (XA).all, EP (YA).all);
  84          XA := AddA (XA, EU);
  85          YA := AddA (YA, EU);
  86          RA := AddA (RA, EU);
  87       end loop;
  88    end Binary_Operation;
  89
  90    ----------------------
  91    -- Unary_Operation --
  92    ----------------------
  93
  94    procedure Unary_Operation
  95      (R, X    : System.Address;
  96       Length  : System.Storage_Elements.Storage_Count)
  97    is
  98       RA : Address := R;
  99       XA : Address := X;
 100       --  Address of next element to process in R and X
 101
 102       VI : constant Integer_Address := To_Integer (VU);
 103
 104       Unaligned : constant Integer_Address :=
 105                     Boolean'Pos (ModA (OrA (RA, XA), VU) /= 0) - 1;
 106       --  Zero iff one or more argument addresses is not aligned, else all 1's
 107
 108       type Vector_Ptr is access all Vectors.Vector;
 109       type Element_Ptr is access all Element;
 110
 111       function VP is new Ada.Unchecked_Conversion (Address, Vector_Ptr);
 112       function EP is new Ada.Unchecked_Conversion (Address, Element_Ptr);
 113
 114       SA : constant Address :=
 115              AddA (XA, To_Address
 116                          ((Integer_Address (Length) / VI * VI) and Unaligned));
 117       --  First address of argument X to start serial processing
 118
 119    begin
 120       while XA < SA loop
 121          VP (RA).all := Vector_Op (VP (XA).all);
 122          XA := AddA (XA, VU);
 123          RA := AddA (RA, VU);
 124       end loop;
 125
 126       while XA < X + Length loop
 127          EP (RA).all := Element_Op (EP (XA).all);
 128          XA := AddA (XA, EU);
 129          RA := AddA (RA, EU);
 130       end loop;
 131    end Unary_Operation;
 132
 133 end System.Generic_Vector_Operations;