-- B o d y --
-- (Soft Binding Version) --
-- --
--- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-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 2, or (at your option) any later ver- --
+-- 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. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
+-- 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. --
package body GNAT.Altivec.Low_Level_Vectors is
- -- This package assumes C_float is an IEEE single-precision float type
-
- pragma Assert (C_float'Machine_Radix = 2);
- pragma Assert (C_float'Machine_Mantissa = 24);
- pragma Assert (C_float'Machine_Emin = -125);
- pragma Assert (C_float'Machine_Emax = 128);
- pragma Assert (C_float'Machine_Rounds);
- pragma Assert (not C_float'Machine_Overflows);
- pragma Assert (C_float'Signed_Zeros);
- pragma Assert (C_float'Denorm);
-
-- Pixel types. As defined in [PIM-2.1 Data types]:
-- A 16-bit pixel is 1/5/5/5;
-- A 32-bit pixel is 8/8/8/8.
begin
for K in Varray_Type'Range loop
- if A (K) /= Component_Type'First then
- D (K) := abs (A (K));
- else
- D (K) := Component_Type'First;
- end if;
+ D (K) := (if A (K) /= Component_Type'First
+ then abs (A (K)) else Component_Type'First);
end loop;
return D;
begin
for J in Varray_Type'Range loop
- if A (J) > B (J) then
- D (J) := Bool_True;
- else
- D (J) := Bool_False;
- end if;
+ D (J) := (if A (J) > B (J) then Bool_True else Bool_False);
end loop;
return D;
begin
for J in Varray_Type'Range loop
- if A (J) > B (J) then
- D (J) := A (J);
- else
- D (J) := B (J);
- end if;
+ D (J) := (if A (J) > B (J) then A (J) else B (J));
end loop;
return D;
begin
for J in Varray_Type'Range loop
- if A (J) < B (J) then
- D (J) := A (J);
- else
- D (J) := B (J);
- end if;
+ D (J) := (if A (J) < B (J) then A (J) else B (J));
end loop;
return D;
begin
for J in Varray_Type'Range loop
- All_Element := All_Element and (D (J) = Bool_True);
- Any_Element := Any_Element or (D (J) = Bool_True);
+ All_Element := All_Element and then (D (J) = Bool_True);
+ Any_Element := Any_Element or else (D (J) = Bool_True);
end loop;
if A = CR6_LT then
begin
for J in Varray_Type'Range loop
- if A (J) = B (J) then
- D (J) := Bool_True;
- else
- D (J) := Bool_False;
- end if;
+ D (J) := (if A (J) = B (J) then Bool_True else Bool_False);
end loop;
return D;
D : Varray_Type;
begin
for J in Varray_Type'Range loop
- if A (J) > B (J) then
- D (J) := Bool_True;
- else
- D (J) := Bool_False;
- end if;
+ D (J) := (if A (J) > B (J) then Bool_True else Bool_False);
end loop;
return D;
begin
for J in Varray_Type'Range loop
- if A (J) > B (J) then
- D (J) := A (J);
- else
- D (J) := B (J);
- end if;
+ D (J) := (if A (J) > B (J) then A (J) else B (J));
end loop;
return D;
begin
for J in Varray_Type'Range loop
- if A (J) < B (J) then
- D (J) := A (J);
- else
- D (J) := B (J);
- end if;
+ D (J) := (if A (J) < B (J) then A (J) else B (J));
end loop;
return D;
begin
for J in Varray_Type'Range loop
- All_Element := All_Element and (D (J) = Bool_True);
- Any_Element := Any_Element or (D (J) = Bool_True);
+ All_Element := All_Element and then (D (J) = Bool_True);
+ Any_Element := Any_Element or else (D (J) = Bool_True);
end loop;
if A = CR6_LT then
begin
for J in 0 .. N - 1 loop
- if Use_Even_Components then
- Offset := Index_Type (2 * J + Integer (Index_Type'First));
- else
- Offset := Index_Type (2 * J + 1 + Integer (Index_Type'First));
- end if;
+ Offset :=
+ Index_Type ((if Use_Even_Components then 2 * J else 2 * J + 1) +
+ Integer (Index_Type'First));
Double_Offset :=
Double_Index_Type (J + Integer (Double_Index_Type'First));
D (Double_Offset) :=
- Double_Component_Type (A (Offset))
- * Double_Component_Type (B (Offset));
+ Double_Component_Type (A (Offset)) *
+ Double_Component_Type (B (Offset));
end loop;
return D;
begin
for J in 0 .. N - 1 loop
- if Use_Even_Components then
- Offset := Index_Type (2 * J + Integer (Index_Type'First));
- else
- Offset := Index_Type (2 * J + 1 + Integer (Index_Type'First));
- end if;
+ Offset :=
+ Index_Type ((if Use_Even_Components then 2 * J else 2 * J + 1) +
+ Integer (Index_Type'First));
Double_Offset :=
Double_Index_Type (J + Integer (Double_Index_Type'First));
D (Double_Offset) :=
- Double_Component_Type (A (Offset))
- * Double_Component_Type (B (Offset));
+ Double_Component_Type (A (Offset)) *
+ Double_Component_Type (B (Offset));
end loop;
return D;
if (Bits (VSCR, NJ_POS, NJ_POS) = 1)
and then abs (X) < 2.0 ** (-126)
then
- if X < 0.0 then
- D := -0.0;
- else
- D := 0.0;
- end if;
+ D := (if X < 0.0 then -0.0 else +0.0);
else
D := X;
end if;
function Rnd_To_FPI_Near (X : F64) return F64 is
Result : F64;
Ceiling : F64;
+
begin
Result := F64 (SI64 (X));
if (F64'Ceiling (X) - X) = (X + 1.0 - F64'Ceiling (X)) then
+
-- Round to even
+
Ceiling := F64'Ceiling (X);
- if Rnd_To_FPI_Trunc (Ceiling / 2.0) * 2.0 = Ceiling then
- Result := Ceiling;
- else
- Result := Ceiling - 1.0;
- end if;
+ Result :=
+ (if Rnd_To_FPI_Trunc (Ceiling / 2.0) * 2.0 = Ceiling
+ then Ceiling else Ceiling - 1.0);
end if;
return Result;
function To_Pixel (Source : unsigned_short) return Pixel_16 is
- -- This conversion should not depend on the host endianess;
+ -- This conversion should not depend on the host endianness;
-- therefore, we cannot use an unchecked conversion.
Target : Pixel_16;
function To_Pixel (Source : unsigned_int) return Pixel_32 is
- -- This conversion should not depend on the host endianess;
+ -- This conversion should not depend on the host endianness;
-- therefore, we cannot use an unchecked conversion.
Target : Pixel_32;
function To_unsigned_int (Source : Pixel_32) return unsigned_int is
- -- This conversion should not depend on the host endianess;
+ -- This conversion should not depend on the host endianness;
-- therefore, we cannot use an unchecked conversion.
-- It should also be the same result, value-wise, on two hosts
- -- with the same endianess.
+ -- with the same endianness.
Target : unsigned_int := 0;
function To_unsigned_short (Source : Pixel_16) return unsigned_short is
- -- This conversion should not depend on the host endianess;
+ -- This conversion should not depend on the host endianness;
-- therefore, we cannot use an unchecked conversion.
-- It should also be the same result, value-wise, on two hosts
- -- with the same endianess.
+ -- with the same endianness.
Target : unsigned_short := 0;
begin
for J in Varray_unsigned_int'Range loop
- Addition_Result :=
- UI64 (VA.Values (J)) + UI64 (VB.Values (J));
-
- if Addition_Result > UI64 (unsigned_int'Last) then
- D.Values (J) := 1;
- else
- D.Values (J) := 0;
- end if;
+ Addition_Result := UI64 (VA.Values (J)) + UI64 (VB.Values (J));
+ D.Values (J) :=
+ (if Addition_Result > UI64 (unsigned_int'Last) then 1 else 0);
end loop;
return To_LL_VSI (To_Vector (D));
D.Values (K) := Write_Bit (D.Values (K), 1, 1);
else
- if NJ_Truncate (VA.Values (J))
- <= NJ_Truncate (VB.Values (J)) then
- D.Values (K) := Write_Bit (D.Values (K), 0, 0);
- else
- D.Values (K) := Write_Bit (D.Values (K), 0, 1);
- end if;
-
- if NJ_Truncate (VA.Values (J))
- >= -NJ_Truncate (VB.Values (J)) then
- D.Values (K) := Write_Bit (D.Values (K), 1, 0);
- else
- D.Values (K) := Write_Bit (D.Values (K), 1, 1);
- end if;
+ D.Values (K) :=
+ (if NJ_Truncate (VA.Values (J)) <= NJ_Truncate (VB.Values (J))
+ then Write_Bit (D.Values (K), 0, 0)
+ else Write_Bit (D.Values (K), 0, 1));
+
+ D.Values (K) :=
+ (if NJ_Truncate (VA.Values (J)) >= -NJ_Truncate (VB.Values (J))
+ then Write_Bit (D.Values (K), 1, 0)
+ else Write_Bit (D.Values (K), 1, 1));
end if;
end loop;
VA : constant VF_View := To_View (A);
VB : constant VF_View := To_View (B);
D : VUI_View;
- K : Vint_Range;
begin
for J in Varray_float'Range loop
- K := Vint_Range (J);
-
- if VA.Values (J) = VB.Values (J) then
- D.Values (K) := unsigned_int'Last;
- else
- D.Values (K) := 0;
- end if;
+ D.Values (Vint_Range (J)) :=
+ (if VA.Values (J) = VB.Values (J) then unsigned_int'Last else 0);
end loop;
return To_LL_VSI (To_Vector (D));
VA : constant VF_View := To_View (A);
VB : constant VF_View := To_View (B);
D : VSI_View;
- K : Vint_Range;
begin
for J in Varray_float'Range loop
- K := Vint_Range (J);
-
- if VA.Values (J) >= VB.Values (J) then
- D.Values (K) := Signed_Bool_True;
- else
- D.Values (K) := Signed_Bool_False;
- end if;
+ D.Values (Vint_Range (J)) :=
+ (if VA.Values (J) >= VB.Values (J) then Signed_Bool_True
+ else Signed_Bool_False);
end loop;
return To_Vector (D);
VA : constant VF_View := To_View (A);
VB : constant VF_View := To_View (B);
D : VSI_View;
- K : Vint_Range;
begin
for J in Varray_float'Range loop
- K := Vint_Range (J);
-
- if NJ_Truncate (VA.Values (J))
- > NJ_Truncate (VB.Values (J)) then
- D.Values (K) := Signed_Bool_True;
- else
- D.Values (K) := Signed_Bool_False;
- end if;
+ D.Values (Vint_Range (J)) :=
+ (if NJ_Truncate (VA.Values (J)) > NJ_Truncate (VB.Values (J))
+ then Signed_Bool_True else Signed_Bool_False);
end loop;
return To_Vector (D);
-- ??? Check the precision of the operation.
-- As described in [PEM-6 vexptefp]:
- -- If theorical_result is equal to 2 at the power of A (J) with
+ -- If theoretical_result is equal to 2 at the power of A (J) with
-- infinite precision, we should have:
- -- abs ((D (J) - theorical_result) / theorical_result) <= 1/16
+ -- abs ((D (J) - theoretical_result) / theoretical_result) <= 1/16
D.Values (J) := 2.0 ** NJ_Truncate (VA.Values (J));
end loop;
---------
function lvx (A : c_long; B : c_ptr) return LL_VSI is
- EA : Integer_Address;
- begin
- EA := Bound_Align (Integer_Address (A) + To_Integer (B), 16);
+ -- Simulate the altivec unit behavior regarding what Effective Address
+ -- is accessed, stripping off the input address least significant bits
+ -- wrt to vector alignment.
- declare
- D : LL_VSI;
- for D'Address use To_Address (EA);
- begin
- return D;
- end;
+ -- On targets where VECTOR_ALIGNMENT is less than the vector size (16),
+ -- an address within a vector is not necessarily rounded back at the
+ -- vector start address. Besides, rounding on 16 makes no sense on such
+ -- targets because the address of a properly aligned vector (that is,
+ -- a proper multiple of VECTOR_ALIGNMENT) could be affected, which we
+ -- want never to happen.
+
+ EA : constant System.Address :=
+ To_Address
+ (Bound_Align
+ (Integer_Address (A) + To_Integer (B), VECTOR_ALIGNMENT));
+
+ D : LL_VSI;
+ for D'Address use EA;
+
+ begin
+ return D;
end lvx;
-----------
begin
for J in Varray_float'Range loop
- if VA.Values (J) > VB.Values (J) then
- D.Values (J) := VA.Values (J);
- else
- D.Values (J) := VB.Values (J);
- end if;
+ D.Values (J) := (if VA.Values (J) > VB.Values (J) then VA.Values (J)
+ else VB.Values (J));
end loop;
return To_Vector (D);
begin
for J in Varray_float'Range loop
- if VA.Values (J) < VB.Values (J) then
- D.Values (J) := VA.Values (J);
- else
- D.Values (J) := VB.Values (J);
- end if;
+ D.Values (J) := (if VA.Values (J) < VB.Values (J) then VA.Values (J)
+ else VB.Values (J));
end loop;
return To_Vector (D);
for N in Vchar_Range'Range loop
J := Vchar_Range (Integer (Bits (VC.Values (N), 4, 7))
+ Integer (Vchar_Range'First));
-
- if Bits (VC.Values (N), 3, 3) = 0 then
- D.Values (N) := VA.Values (J);
- else
- D.Values (N) := VB.Values (J);
- end if;
+ D.Values (N) :=
+ (if Bits (VC.Values (N), 3, 3) = 0 then VA.Values (J)
+ else VB.Values (J));
end loop;
return To_LL_VSI (To_Vector (D));
begin
for N in Vchar_Range'Range loop
J := Natural (N) + M;
-
- if J <= Natural (Vchar_Range'Last) then
- D.Values (N) := VA.Values (Vchar_Range (J));
- else
- D.Values (N) := 0;
- end if;
+ D.Values (N) :=
+ (if J <= Natural (Vchar_Range'Last) then VA.Values (Vchar_Range (J))
+ else 0);
end loop;
return To_LL_VSI (To_Vector (D));
----------
procedure stvx (A : LL_VSI; B : c_int; C : c_ptr) is
- EA : Integer_Address;
- begin
- EA := Bound_Align (Integer_Address (B) + To_Integer (C), 16);
+ -- Simulate the altivec unit behavior regarding what Effective Address
+ -- is accessed, stripping off the input address least significant bits
+ -- wrt to vector alignment (see comment in lvx for further details).
- declare
- D : LL_VSI;
- for D'Address use To_Address (EA);
- begin
- D := A;
- end;
+ EA : constant System.Address :=
+ To_Address
+ (Bound_Align
+ (Integer_Address (B) + To_Integer (C), VECTOR_ALIGNMENT));
+
+ D : LL_VSI;
+ for D'Address use EA;
+
+ begin
+ D := A;
end stvx;
------------
begin
for J in Vint_Range'Range loop
Subst_Result := SI64 (VA.Values (J)) - SI64 (VB.Values (J));
-
- if Subst_Result < SI64 (unsigned_int'First) then
- D.Values (J) := 0;
- else
- D.Values (J) := 1;
- end if;
+ D.Values (J) :=
+ (if Subst_Result < SI64 (unsigned_int'First) then 0 else 1);
end loop;
return To_LL_VSI (To_Vector (D));
D := To_View (vcmpbfp (B, C));
for J in Vint_Range'Range loop
+
-- vcmpbfp is not returning the usual bool vector; do the conversion
- if D.Values (J) = 0 then
- D.Values (J) := Signed_Bool_False;
- else
- D.Values (J) := Signed_Bool_True;
- end if;
+
+ D.Values (J) :=
+ (if D.Values (J) = 0 then Signed_Bool_False else Signed_Bool_True);
end loop;
return LL_VSI_Operations.Check_CR6 (A, D.Values);
OSDN Git Service
