diff options
author | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
---|---|---|
committer | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
commit | 554fd8c5195424bdbcabf5de30fdc183aba391bd (patch) | |
tree | 976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/ada/s-geveop.adb | |
download | cbb-gcc-4.6.4-15d2061ac0796199866debe9ac87130894b0cdd3.tar.bz2 cbb-gcc-4.6.4-15d2061ac0796199866debe9ac87130894b0cdd3.tar.xz |
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.
downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.
if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
Diffstat (limited to 'gcc/ada/s-geveop.adb')
-rw-r--r-- | gcc/ada/s-geveop.adb | 133 |
1 files changed, 133 insertions, 0 deletions
diff --git a/gcc/ada/s-geveop.adb b/gcc/ada/s-geveop.adb new file mode 100644 index 000000000..e04032485 --- /dev/null +++ b/gcc/ada/s-geveop.adb @@ -0,0 +1,133 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- 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 -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2002-2009, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with System; use System; +with System.Address_Operations; use System.Address_Operations; +with System.Storage_Elements; use System.Storage_Elements; + +with Ada.Unchecked_Conversion; + +package body System.Generic_Vector_Operations is + + IU : constant Integer := Integer (Storage_Unit); + VU : constant Address := Address (Vectors.Vector'Size / IU); + EU : constant Address := Address (Element_Array'Component_Size / IU); + + ---------------------- + -- Binary_Operation -- + ---------------------- + + procedure Binary_Operation + (R, X, Y : System.Address; + Length : System.Storage_Elements.Storage_Count) + is + RA : Address := R; + XA : Address := X; + YA : Address := Y; + -- Address of next element to process in R, X and Y + + VI : constant Integer_Address := To_Integer (VU); + + Unaligned : constant Integer_Address := + Boolean'Pos (ModA (OrA (OrA (RA, XA), YA), VU) /= 0) - 1; + -- Zero iff one or more argument addresses is not aligned, else all 1's + + type Vector_Ptr is access all Vectors.Vector; + type Element_Ptr is access all Element; + + function VP is new Ada.Unchecked_Conversion (Address, Vector_Ptr); + function EP is new Ada.Unchecked_Conversion (Address, Element_Ptr); + + SA : constant Address := + AddA (XA, To_Address + ((Integer_Address (Length) / VI * VI) and Unaligned)); + -- First address of argument X to start serial processing + + begin + while XA < SA loop + VP (RA).all := Vector_Op (VP (XA).all, VP (YA).all); + XA := AddA (XA, VU); + YA := AddA (YA, VU); + RA := AddA (RA, VU); + end loop; + + while XA < X + Length loop + EP (RA).all := Element_Op (EP (XA).all, EP (YA).all); + XA := AddA (XA, EU); + YA := AddA (YA, EU); + RA := AddA (RA, EU); + end loop; + end Binary_Operation; + + ---------------------- + -- Unary_Operation -- + ---------------------- + + procedure Unary_Operation + (R, X : System.Address; + Length : System.Storage_Elements.Storage_Count) + is + RA : Address := R; + XA : Address := X; + -- Address of next element to process in R and X + + VI : constant Integer_Address := To_Integer (VU); + + Unaligned : constant Integer_Address := + Boolean'Pos (ModA (OrA (RA, XA), VU) /= 0) - 1; + -- Zero iff one or more argument addresses is not aligned, else all 1's + + type Vector_Ptr is access all Vectors.Vector; + type Element_Ptr is access all Element; + + function VP is new Ada.Unchecked_Conversion (Address, Vector_Ptr); + function EP is new Ada.Unchecked_Conversion (Address, Element_Ptr); + + SA : constant Address := + AddA (XA, To_Address + ((Integer_Address (Length) / VI * VI) and Unaligned)); + -- First address of argument X to start serial processing + + begin + while XA < SA loop + VP (RA).all := Vector_Op (VP (XA).all); + XA := AddA (XA, VU); + RA := AddA (RA, VU); + end loop; + + while XA < X + Length loop + EP (RA).all := Element_Op (EP (XA).all); + XA := AddA (XA, EU); + RA := AddA (RA, EU); + end loop; + end Unary_Operation; + +end System.Generic_Vector_Operations; |