gcc/ada/s-geveop.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                GNU ADA RUNTIME 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-2003 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 2,  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.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- As a special exception,  if other files  instantiate  generics from this --
  23 -- unit, or you link  this unit with other files  to produce an executable, --
  24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  25 -- covered  by the  GNU  General  Public  License.  This exception does not --
  26 -- however invalidate  any other reasons why  the executable file  might be --
  27 -- covered by the  GNU Public License.                                      --
  28 --                                                                          --
  29 -- GNAT was originally developed  by the GNAT team at  New York University. --
  30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 with System;                   use System;
  35 with System.Storage_Elements; use System.Storage_Elements;
  36 with Ada.Unchecked_Conversion; use Ada;
  37
  38 package body System.Generic_Vector_Operations is
  39    VU : constant Address := Vectors.Vector'Size / Storage_Unit;
  40    EU : constant Address := Element_Array'Component_Size / Storage_Unit;
  41
  42    ----------------------
  43    -- Binary_Operation --
  44    ----------------------
  45
  46    procedure Binary_Operation
  47      (R, X, Y : System.Address;
  48       Length  : System.Storage_Elements.Storage_Count)
  49    is
  50       RA : Address := R;
  51       XA : Address := X;
  52       YA : Address := Y;
  53       --  Address of next element to process in R, X and Y
  54
  55       Unaligned : constant Boolean := (RA or XA or YA)  mod VU /= 0;
  56       --  False iff one or more argument addresses is not aligned
  57
  58       type Vector_Ptr is access all Vectors.Vector;
  59       type Element_Ptr is access all Element;
  60
  61       function VP is new Unchecked_Conversion (Address, Vector_Ptr);
  62       function EP is new Unchecked_Conversion (Address, Element_Ptr);
  63
  64       SA : constant Address := XA + ((Length + 0) / VU * VU
  65                            and (Boolean'Pos (Unaligned) - Address'(1)));
  66       --  First address of argument X to start serial processing
  67
  68    begin
  69       while XA < SA loop
  70          VP (RA).all := Vector_Op (VP (XA).all, VP (YA).all);
  71          XA := XA + VU;
  72          YA := YA + VU;
  73          RA := RA + VU;
  74       end loop;
  75
  76       while XA < X + Length loop
  77          EP (RA).all := Element_Op (EP (XA).all, EP (YA).all);
  78          XA := XA + EU;
  79          YA := YA + EU;
  80          RA := RA + EU;
  81       end loop;
  82    end Binary_Operation;
  83
  84    ----------------------
  85    -- Unary_Operation --
  86    ----------------------
  87
  88    procedure Unary_Operation
  89      (R, X    : System.Address;
  90       Length  : System.Storage_Elements.Storage_Count)
  91    is
  92       RA : Address := R;
  93       XA : Address := X;
  94       --  Address of next element to process in R and X
  95
  96       Unaligned : constant Boolean := (RA or XA)  mod VU /= 0;
  97       --  False iff one or more argument addresses is not aligned
  98
  99       type Vector_Ptr is access all Vectors.Vector;
 100       type Element_Ptr is access all Element;
 101
 102       function VP is new Unchecked_Conversion (Address, Vector_Ptr);
 103       function EP is new Unchecked_Conversion (Address, Element_Ptr);
 104
 105       SA : constant Address := XA + ((Length + 0) / VU * VU
 106                            and (Boolean'Pos (Unaligned) - Address'(1)));
 107       --  First address of argument X to start serial processing
 108
 109    begin
 110       while XA < SA loop
 111          VP (RA).all := Vector_Op (VP (XA).all);
 112          XA := XA + VU;
 113          RA := RA + VU;
 114       end loop;
 115
 116       while XA < X + Length loop
 117          EP (RA).all := Element_Op (EP (XA).all);
 118          XA := XA + EU;
 119          RA := RA + EU;
 120       end loop;
 121    end Unary_Operation;
 122
 123 end System.Generic_Vector_Operations;