URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [g-alleve.adb] - Rev 724
Go to most recent revision | Compare with Previous | Blame | View Log
------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- G N A T . A L T I V E C . L O W _ L E V E L _ V E C T O R S -- -- -- -- B o d y -- -- (Soft Binding Version) -- -- -- -- 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 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. -- -- -- ------------------------------------------------------------------------------ -- ??? What is exactly needed for the soft case is still a bit unclear on -- some accounts. The expected functional equivalence with the Hard binding -- might require tricky things to be done on some targets. -- Examples that come to mind are endianness variations or differences in the -- base FP model while we need the operation results to be the same as what -- the real AltiVec instructions would do on a PowerPC. with Ada.Numerics.Generic_Elementary_Functions; with Interfaces; use Interfaces; with System.Storage_Elements; use System.Storage_Elements; with GNAT.Altivec.Conversions; use GNAT.Altivec.Conversions; with GNAT.Altivec.Low_Level_Interface; use GNAT.Altivec.Low_Level_Interface; package body GNAT.Altivec.Low_Level_Vectors is -- 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. -- We use the following records as an intermediate representation, to -- ease computation. type Unsigned_1 is mod 2 ** 1; type Unsigned_5 is mod 2 ** 5; type Pixel_16 is record T : Unsigned_1; R : Unsigned_5; G : Unsigned_5; B : Unsigned_5; end record; type Pixel_32 is record T : unsigned_char; R : unsigned_char; G : unsigned_char; B : unsigned_char; end record; -- Conversions to/from the pixel records to the integer types that are -- actually stored into the pixel vectors: function To_Pixel (Source : unsigned_short) return Pixel_16; function To_unsigned_short (Source : Pixel_16) return unsigned_short; function To_Pixel (Source : unsigned_int) return Pixel_32; function To_unsigned_int (Source : Pixel_32) return unsigned_int; package C_float_Operations is new Ada.Numerics.Generic_Elementary_Functions (C_float); -- Model of the Vector Status and Control Register (VSCR), as -- defined in [PIM-4.1 Vector Status and Control Register]: VSCR : unsigned_int; -- Positions of the flags in VSCR(0 .. 31): NJ_POS : constant := 15; SAT_POS : constant := 31; -- To control overflows, integer operations are done on 64-bit types: SINT64_MIN : constant := -2 ** 63; SINT64_MAX : constant := 2 ** 63 - 1; UINT64_MAX : constant := 2 ** 64 - 1; type SI64 is range SINT64_MIN .. SINT64_MAX; type UI64 is mod UINT64_MAX + 1; type F64 is digits 15 range -16#0.FFFF_FFFF_FFFF_F8#E+256 .. 16#0.FFFF_FFFF_FFFF_F8#E+256; function Bits (X : unsigned_int; Low : Natural; High : Natural) return unsigned_int; function Bits (X : unsigned_short; Low : Natural; High : Natural) return unsigned_short; function Bits (X : unsigned_char; Low : Natural; High : Natural) return unsigned_char; function Write_Bit (X : unsigned_int; Where : Natural; Value : Unsigned_1) return unsigned_int; function Write_Bit (X : unsigned_short; Where : Natural; Value : Unsigned_1) return unsigned_short; function Write_Bit (X : unsigned_char; Where : Natural; Value : Unsigned_1) return unsigned_char; function NJ_Truncate (X : C_float) return C_float; -- If NJ and A is a denormalized number, return zero function Bound_Align (X : Integer_Address; Y : Integer_Address) return Integer_Address; -- [PIM-4.3 Notations and Conventions] -- Align X in a y-byte boundary and return the result function Rnd_To_FP_Nearest (X : F64) return C_float; -- [PIM-4.3 Notations and Conventions] function Rnd_To_FPI_Near (X : F64) return F64; function Rnd_To_FPI_Trunc (X : F64) return F64; function FP_Recip_Est (X : C_float) return C_float; -- [PIM-4.3 Notations and Conventions] -- 12-bit accurate floating-point estimate of 1/x function ROTL (Value : unsigned_char; Amount : Natural) return unsigned_char; -- [PIM-4.3 Notations and Conventions] -- Rotate left function ROTL (Value : unsigned_short; Amount : Natural) return unsigned_short; function ROTL (Value : unsigned_int; Amount : Natural) return unsigned_int; function Recip_SQRT_Est (X : C_float) return C_float; function Shift_Left (Value : unsigned_char; Amount : Natural) return unsigned_char; -- [PIM-4.3 Notations and Conventions] -- Shift left function Shift_Left (Value : unsigned_short; Amount : Natural) return unsigned_short; function Shift_Left (Value : unsigned_int; Amount : Natural) return unsigned_int; function Shift_Right (Value : unsigned_char; Amount : Natural) return unsigned_char; -- [PIM-4.3 Notations and Conventions] -- Shift Right function Shift_Right (Value : unsigned_short; Amount : Natural) return unsigned_short; function Shift_Right (Value : unsigned_int; Amount : Natural) return unsigned_int; Signed_Bool_False : constant := 0; Signed_Bool_True : constant := -1; ------------------------------ -- Signed_Operations (spec) -- ------------------------------ generic type Component_Type is range <>; type Index_Type is range <>; type Varray_Type is array (Index_Type) of Component_Type; package Signed_Operations is function Modular_Result (X : SI64) return Component_Type; function Saturate (X : SI64) return Component_Type; function Saturate (X : F64) return Component_Type; function Sign_Extend (X : c_int) return Component_Type; -- [PIM-4.3 Notations and Conventions] -- Sign-extend X function abs_vxi (A : Varray_Type) return Varray_Type; pragma Convention (LL_Altivec, abs_vxi); function abss_vxi (A : Varray_Type) return Varray_Type; pragma Convention (LL_Altivec, abss_vxi); function vaddsxs (A : Varray_Type; B : Varray_Type) return Varray_Type; pragma Convention (LL_Altivec, vaddsxs); function vavgsx (A : Varray_Type; B : Varray_Type) return Varray_Type; pragma Convention (LL_Altivec, vavgsx); function vcmpgtsx (A : Varray_Type; B : Varray_Type) return Varray_Type; pragma Convention (LL_Altivec, vcmpgtsx); function lvexx (A : c_long; B : c_ptr) return Varray_Type; pragma Convention (LL_Altivec, lvexx); function vmaxsx (A : Varray_Type; B : Varray_Type) return Varray_Type; pragma Convention (LL_Altivec, vmaxsx); function vmrghx (A : Varray_Type; B : Varray_Type) return Varray_Type; pragma Convention (LL_Altivec, vmrghx); function vmrglx (A : Varray_Type; B : Varray_Type) return Varray_Type; pragma Convention (LL_Altivec, vmrglx); function vminsx (A : Varray_Type; B : Varray_Type) return Varray_Type; pragma Convention (LL_Altivec, vminsx); function vspltx (A : Varray_Type; B : c_int) return Varray_Type; pragma Convention (LL_Altivec, vspltx); function vspltisx (A : c_int) return Varray_Type; pragma Convention (LL_Altivec, vspltisx); type Bit_Operation is access function (Value : Component_Type; Amount : Natural) return Component_Type; function vsrax (A : Varray_Type; B : Varray_Type; Shift_Func : Bit_Operation) return Varray_Type; procedure stvexx (A : Varray_Type; B : c_int; C : c_ptr); pragma Convention (LL_Altivec, stvexx); function vsubsxs (A : Varray_Type; B : Varray_Type) return Varray_Type; pragma Convention (LL_Altivec, vsubsxs); function Check_CR6 (A : c_int; D : Varray_Type) return c_int; -- If D is the result of a vcmp operation and A the flag for -- the kind of operation (e.g CR6_LT), check the predicate -- that corresponds to this flag. end Signed_Operations; ------------------------------ -- Signed_Operations (body) -- ------------------------------ package body Signed_Operations is Bool_True : constant Component_Type := Signed_Bool_True; Bool_False : constant Component_Type := Signed_Bool_False; Number_Of_Elements : constant Integer := VECTOR_BIT / Component_Type'Size; -------------------- -- Modular_Result -- -------------------- function Modular_Result (X : SI64) return Component_Type is D : Component_Type; begin if X > 0 then D := Component_Type (UI64 (X) mod (UI64 (Component_Type'Last) + 1)); else D := Component_Type ((-(UI64 (-X) mod (UI64 (Component_Type'Last) + 1)))); end if; return D; end Modular_Result; -------------- -- Saturate -- -------------- function Saturate (X : SI64) return Component_Type is D : Component_Type; begin -- Saturation, as defined in -- [PIM-4.1 Vector Status and Control Register] D := Component_Type (SI64'Max (SI64 (Component_Type'First), SI64'Min (SI64 (Component_Type'Last), X))); if SI64 (D) /= X then VSCR := Write_Bit (VSCR, SAT_POS, 1); end if; return D; end Saturate; function Saturate (X : F64) return Component_Type is D : Component_Type; begin -- Saturation, as defined in -- [PIM-4.1 Vector Status and Control Register] D := Component_Type (F64'Max (F64 (Component_Type'First), F64'Min (F64 (Component_Type'Last), X))); if F64 (D) /= X then VSCR := Write_Bit (VSCR, SAT_POS, 1); end if; return D; end Saturate; ----------------- -- Sign_Extend -- ----------------- function Sign_Extend (X : c_int) return Component_Type is begin -- X is usually a 5-bits literal. In the case of the simulator, -- it is an integral parameter, so sign extension is straightforward. return Component_Type (X); end Sign_Extend; ------------- -- abs_vxi -- ------------- function abs_vxi (A : Varray_Type) return Varray_Type is D : Varray_Type; begin for K in Varray_Type'Range loop D (K) := (if A (K) /= Component_Type'First then abs (A (K)) else Component_Type'First); end loop; return D; end abs_vxi; -------------- -- abss_vxi -- -------------- function abss_vxi (A : Varray_Type) return Varray_Type is D : Varray_Type; begin for K in Varray_Type'Range loop D (K) := Saturate (abs (SI64 (A (K)))); end loop; return D; end abss_vxi; ------------- -- vaddsxs -- ------------- function vaddsxs (A : Varray_Type; B : Varray_Type) return Varray_Type is D : Varray_Type; begin for J in Varray_Type'Range loop D (J) := Saturate (SI64 (A (J)) + SI64 (B (J))); end loop; return D; end vaddsxs; ------------ -- vavgsx -- ------------ function vavgsx (A : Varray_Type; B : Varray_Type) return Varray_Type is D : Varray_Type; begin for J in Varray_Type'Range loop D (J) := Component_Type ((SI64 (A (J)) + SI64 (B (J)) + 1) / 2); end loop; return D; end vavgsx; -------------- -- vcmpgtsx -- -------------- function vcmpgtsx (A : Varray_Type; B : Varray_Type) return Varray_Type is D : Varray_Type; begin for J in Varray_Type'Range loop D (J) := (if A (J) > B (J) then Bool_True else Bool_False); end loop; return D; end vcmpgtsx; ----------- -- lvexx -- ----------- function lvexx (A : c_long; B : c_ptr) return Varray_Type is D : Varray_Type; S : Integer; EA : Integer_Address; J : Index_Type; begin S := 16 / Number_Of_Elements; EA := Bound_Align (Integer_Address (A) + To_Integer (B), Integer_Address (S)); J := Index_Type (((EA mod 16) / Integer_Address (S)) + Integer_Address (Index_Type'First)); declare Component : Component_Type; for Component'Address use To_Address (EA); begin D (J) := Component; end; return D; end lvexx; ------------ -- vmaxsx -- ------------ function vmaxsx (A : Varray_Type; B : Varray_Type) return Varray_Type is D : Varray_Type; begin for J in Varray_Type'Range loop D (J) := (if A (J) > B (J) then A (J) else B (J)); end loop; return D; end vmaxsx; ------------ -- vmrghx -- ------------ function vmrghx (A : Varray_Type; B : Varray_Type) return Varray_Type is D : Varray_Type; Offset : constant Integer := Integer (Index_Type'First); M : constant Integer := Number_Of_Elements / 2; begin for J in 0 .. M - 1 loop D (Index_Type (2 * J + Offset)) := A (Index_Type (J + Offset)); D (Index_Type (2 * J + Offset + 1)) := B (Index_Type (J + Offset)); end loop; return D; end vmrghx; ------------ -- vmrglx -- ------------ function vmrglx (A : Varray_Type; B : Varray_Type) return Varray_Type is D : Varray_Type; Offset : constant Integer := Integer (Index_Type'First); M : constant Integer := Number_Of_Elements / 2; begin for J in 0 .. M - 1 loop D (Index_Type (2 * J + Offset)) := A (Index_Type (J + Offset + M)); D (Index_Type (2 * J + Offset + 1)) := B (Index_Type (J + Offset + M)); end loop; return D; end vmrglx; ------------ -- vminsx -- ------------ function vminsx (A : Varray_Type; B : Varray_Type) return Varray_Type is D : Varray_Type; begin for J in Varray_Type'Range loop D (J) := (if A (J) < B (J) then A (J) else B (J)); end loop; return D; end vminsx; ------------ -- vspltx -- ------------ function vspltx (A : Varray_Type; B : c_int) return Varray_Type is J : constant Integer := Integer (B) mod Number_Of_Elements + Integer (Varray_Type'First); D : Varray_Type; begin for K in Varray_Type'Range loop D (K) := A (Index_Type (J)); end loop; return D; end vspltx; -------------- -- vspltisx -- -------------- function vspltisx (A : c_int) return Varray_Type is D : Varray_Type; begin for J in Varray_Type'Range loop D (J) := Sign_Extend (A); end loop; return D; end vspltisx; ----------- -- vsrax -- ----------- function vsrax (A : Varray_Type; B : Varray_Type; Shift_Func : Bit_Operation) return Varray_Type is D : Varray_Type; S : constant Component_Type := Component_Type (128 / Number_Of_Elements); begin for J in Varray_Type'Range loop D (J) := Shift_Func (A (J), Natural (B (J) mod S)); end loop; return D; end vsrax; ------------ -- stvexx -- ------------ procedure stvexx (A : Varray_Type; B : c_int; C : c_ptr) is S : Integer; EA : Integer_Address; J : Index_Type; begin S := 16 / Number_Of_Elements; EA := Bound_Align (Integer_Address (B) + To_Integer (C), Integer_Address (S)); J := Index_Type ((EA mod 16) / Integer_Address (S) + Integer_Address (Index_Type'First)); declare Component : Component_Type; for Component'Address use To_Address (EA); begin Component := A (J); end; end stvexx; ------------- -- vsubsxs -- ------------- function vsubsxs (A : Varray_Type; B : Varray_Type) return Varray_Type is D : Varray_Type; begin for J in Varray_Type'Range loop D (J) := Saturate (SI64 (A (J)) - SI64 (B (J))); end loop; return D; end vsubsxs; --------------- -- Check_CR6 -- --------------- function Check_CR6 (A : c_int; D : Varray_Type) return c_int is All_Element : Boolean := True; Any_Element : Boolean := False; begin for J in Varray_Type'Range loop 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 if All_Element then return 1; else return 0; end if; elsif A = CR6_EQ then if not Any_Element then return 1; else return 0; end if; elsif A = CR6_EQ_REV then if Any_Element then return 1; else return 0; end if; elsif A = CR6_LT_REV then if not All_Element then return 1; else return 0; end if; end if; return 0; end Check_CR6; end Signed_Operations; -------------------------------- -- Unsigned_Operations (spec) -- -------------------------------- generic type Component_Type is mod <>; type Index_Type is range <>; type Varray_Type is array (Index_Type) of Component_Type; package Unsigned_Operations is function Bits (X : Component_Type; Low : Natural; High : Natural) return Component_Type; -- Return X [Low:High] as defined in [PIM-4.3 Notations and Conventions] -- using big endian bit ordering. function Write_Bit (X : Component_Type; Where : Natural; Value : Unsigned_1) return Component_Type; -- Write Value into X[Where:Where] (if it fits in) and return the result -- (big endian bit ordering). function Modular_Result (X : UI64) return Component_Type; function Saturate (X : UI64) return Component_Type; function Saturate (X : F64) return Component_Type; function Saturate (X : SI64) return Component_Type; function vadduxm (A : Varray_Type; B : Varray_Type) return Varray_Type; function vadduxs (A : Varray_Type; B : Varray_Type) return Varray_Type; function vavgux (A : Varray_Type; B : Varray_Type) return Varray_Type; function vcmpequx (A : Varray_Type; B : Varray_Type) return Varray_Type; function vcmpgtux (A : Varray_Type; B : Varray_Type) return Varray_Type; function vmaxux (A : Varray_Type; B : Varray_Type) return Varray_Type; function vminux (A : Varray_Type; B : Varray_Type) return Varray_Type; type Bit_Operation is access function (Value : Component_Type; Amount : Natural) return Component_Type; function vrlx (A : Varray_Type; B : Varray_Type; ROTL : Bit_Operation) return Varray_Type; function vsxx (A : Varray_Type; B : Varray_Type; Shift_Func : Bit_Operation) return Varray_Type; -- Vector shift (left or right, depending on Shift_Func) function vsubuxm (A : Varray_Type; B : Varray_Type) return Varray_Type; function vsubuxs (A : Varray_Type; B : Varray_Type) return Varray_Type; function Check_CR6 (A : c_int; D : Varray_Type) return c_int; -- If D is the result of a vcmp operation and A the flag for -- the kind of operation (e.g CR6_LT), check the predicate -- that corresponds to this flag. end Unsigned_Operations; -------------------------------- -- Unsigned_Operations (body) -- -------------------------------- package body Unsigned_Operations is Number_Of_Elements : constant Integer := VECTOR_BIT / Component_Type'Size; Bool_True : constant Component_Type := Component_Type'Last; Bool_False : constant Component_Type := 0; -------------------- -- Modular_Result -- -------------------- function Modular_Result (X : UI64) return Component_Type is D : Component_Type; begin D := Component_Type (X mod (UI64 (Component_Type'Last) + 1)); return D; end Modular_Result; -------------- -- Saturate -- -------------- function Saturate (X : UI64) return Component_Type is D : Component_Type; begin -- Saturation, as defined in -- [PIM-4.1 Vector Status and Control Register] D := Component_Type (UI64'Max (UI64 (Component_Type'First), UI64'Min (UI64 (Component_Type'Last), X))); if UI64 (D) /= X then VSCR := Write_Bit (VSCR, SAT_POS, 1); end if; return D; end Saturate; function Saturate (X : SI64) return Component_Type is D : Component_Type; begin -- Saturation, as defined in -- [PIM-4.1 Vector Status and Control Register] D := Component_Type (SI64'Max (SI64 (Component_Type'First), SI64'Min (SI64 (Component_Type'Last), X))); if SI64 (D) /= X then VSCR := Write_Bit (VSCR, SAT_POS, 1); end if; return D; end Saturate; function Saturate (X : F64) return Component_Type is D : Component_Type; begin -- Saturation, as defined in -- [PIM-4.1 Vector Status and Control Register] D := Component_Type (F64'Max (F64 (Component_Type'First), F64'Min (F64 (Component_Type'Last), X))); if F64 (D) /= X then VSCR := Write_Bit (VSCR, SAT_POS, 1); end if; return D; end Saturate; ---------- -- Bits -- ---------- function Bits (X : Component_Type; Low : Natural; High : Natural) return Component_Type is Mask : Component_Type := 0; -- The Altivec ABI uses a big endian bit ordering, and we are -- using little endian bit ordering for extracting bits: Low_LE : constant Natural := Component_Type'Size - 1 - High; High_LE : constant Natural := Component_Type'Size - 1 - Low; begin pragma Assert (Low <= Component_Type'Size); pragma Assert (High <= Component_Type'Size); for J in Low_LE .. High_LE loop Mask := Mask or 2 ** J; end loop; return (X and Mask) / 2 ** Low_LE; end Bits; --------------- -- Write_Bit -- --------------- function Write_Bit (X : Component_Type; Where : Natural; Value : Unsigned_1) return Component_Type is Result : Component_Type := 0; -- The Altivec ABI uses a big endian bit ordering, and we are -- using little endian bit ordering for extracting bits: Where_LE : constant Natural := Component_Type'Size - 1 - Where; begin pragma Assert (Where < Component_Type'Size); case Value is when 1 => Result := X or 2 ** Where_LE; when 0 => Result := X and not (2 ** Where_LE); end case; return Result; end Write_Bit; ------------- -- vadduxm -- ------------- function vadduxm (A : Varray_Type; B : Varray_Type) return Varray_Type is D : Varray_Type; begin for J in Varray_Type'Range loop D (J) := A (J) + B (J); end loop; return D; end vadduxm; ------------- -- vadduxs -- ------------- function vadduxs (A : Varray_Type; B : Varray_Type) return Varray_Type is D : Varray_Type; begin for J in Varray_Type'Range loop D (J) := Saturate (UI64 (A (J)) + UI64 (B (J))); end loop; return D; end vadduxs; ------------ -- vavgux -- ------------ function vavgux (A : Varray_Type; B : Varray_Type) return Varray_Type is D : Varray_Type; begin for J in Varray_Type'Range loop D (J) := Component_Type ((UI64 (A (J)) + UI64 (B (J)) + 1) / 2); end loop; return D; end vavgux; -------------- -- vcmpequx -- -------------- function vcmpequx (A : Varray_Type; B : Varray_Type) return Varray_Type is D : Varray_Type; begin for J in Varray_Type'Range loop D (J) := (if A (J) = B (J) then Bool_True else Bool_False); end loop; return D; end vcmpequx; -------------- -- vcmpgtux -- -------------- function vcmpgtux (A : Varray_Type; B : Varray_Type) return Varray_Type is D : Varray_Type; begin for J in Varray_Type'Range loop D (J) := (if A (J) > B (J) then Bool_True else Bool_False); end loop; return D; end vcmpgtux; ------------ -- vmaxux -- ------------ function vmaxux (A : Varray_Type; B : Varray_Type) return Varray_Type is D : Varray_Type; begin for J in Varray_Type'Range loop D (J) := (if A (J) > B (J) then A (J) else B (J)); end loop; return D; end vmaxux; ------------ -- vminux -- ------------ function vminux (A : Varray_Type; B : Varray_Type) return Varray_Type is D : Varray_Type; begin for J in Varray_Type'Range loop D (J) := (if A (J) < B (J) then A (J) else B (J)); end loop; return D; end vminux; ---------- -- vrlx -- ---------- function vrlx (A : Varray_Type; B : Varray_Type; ROTL : Bit_Operation) return Varray_Type is D : Varray_Type; begin for J in Varray_Type'Range loop D (J) := ROTL (A (J), Natural (B (J))); end loop; return D; end vrlx; ---------- -- vsxx -- ---------- function vsxx (A : Varray_Type; B : Varray_Type; Shift_Func : Bit_Operation) return Varray_Type is D : Varray_Type; S : constant Component_Type := Component_Type (128 / Number_Of_Elements); begin for J in Varray_Type'Range loop D (J) := Shift_Func (A (J), Natural (B (J) mod S)); end loop; return D; end vsxx; ------------- -- vsubuxm -- ------------- function vsubuxm (A : Varray_Type; B : Varray_Type) return Varray_Type is D : Varray_Type; begin for J in Varray_Type'Range loop D (J) := A (J) - B (J); end loop; return D; end vsubuxm; ------------- -- vsubuxs -- ------------- function vsubuxs (A : Varray_Type; B : Varray_Type) return Varray_Type is D : Varray_Type; begin for J in Varray_Type'Range loop D (J) := Saturate (SI64 (A (J)) - SI64 (B (J))); end loop; return D; end vsubuxs; --------------- -- Check_CR6 -- --------------- function Check_CR6 (A : c_int; D : Varray_Type) return c_int is All_Element : Boolean := True; Any_Element : Boolean := False; begin for J in Varray_Type'Range loop 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 if All_Element then return 1; else return 0; end if; elsif A = CR6_EQ then if not Any_Element then return 1; else return 0; end if; elsif A = CR6_EQ_REV then if Any_Element then return 1; else return 0; end if; elsif A = CR6_LT_REV then if not All_Element then return 1; else return 0; end if; end if; return 0; end Check_CR6; end Unsigned_Operations; -------------------------------------- -- Signed_Merging_Operations (spec) -- -------------------------------------- generic type Component_Type is range <>; type Index_Type is range <>; type Varray_Type is array (Index_Type) of Component_Type; type Double_Component_Type is range <>; type Double_Index_Type is range <>; type Double_Varray_Type is array (Double_Index_Type) of Double_Component_Type; package Signed_Merging_Operations is pragma Assert (Integer (Varray_Type'First) = Integer (Double_Varray_Type'First)); pragma Assert (Varray_Type'Length = 2 * Double_Varray_Type'Length); pragma Assert (2 * Component_Type'Size = Double_Component_Type'Size); function Saturate (X : Double_Component_Type) return Component_Type; function vmulxsx (Use_Even_Components : Boolean; A : Varray_Type; B : Varray_Type) return Double_Varray_Type; function vpksxss (A : Double_Varray_Type; B : Double_Varray_Type) return Varray_Type; pragma Convention (LL_Altivec, vpksxss); function vupkxsx (A : Varray_Type; Offset : Natural) return Double_Varray_Type; end Signed_Merging_Operations; -------------------------------------- -- Signed_Merging_Operations (body) -- -------------------------------------- package body Signed_Merging_Operations is -------------- -- Saturate -- -------------- function Saturate (X : Double_Component_Type) return Component_Type is D : Component_Type; begin -- Saturation, as defined in -- [PIM-4.1 Vector Status and Control Register] D := Component_Type (Double_Component_Type'Max (Double_Component_Type (Component_Type'First), Double_Component_Type'Min (Double_Component_Type (Component_Type'Last), X))); if Double_Component_Type (D) /= X then VSCR := Write_Bit (VSCR, SAT_POS, 1); end if; return D; end Saturate; ------------- -- vmulsxs -- ------------- function vmulxsx (Use_Even_Components : Boolean; A : Varray_Type; B : Varray_Type) return Double_Varray_Type is Double_Offset : Double_Index_Type; Offset : Index_Type; D : Double_Varray_Type; N : constant Integer := Integer (Double_Index_Type'Last) - Integer (Double_Index_Type'First) + 1; begin for J in 0 .. N - 1 loop 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)); end loop; return D; end vmulxsx; ------------- -- vpksxss -- ------------- function vpksxss (A : Double_Varray_Type; B : Double_Varray_Type) return Varray_Type is N : constant Index_Type := Index_Type (Double_Index_Type'Last); D : Varray_Type; Offset : Index_Type; Double_Offset : Double_Index_Type; begin for J in 0 .. N - 1 loop Offset := Index_Type (Integer (J) + Integer (Index_Type'First)); Double_Offset := Double_Index_Type (Integer (J) + Integer (Double_Index_Type'First)); D (Offset) := Saturate (A (Double_Offset)); D (Offset + N) := Saturate (B (Double_Offset)); end loop; return D; end vpksxss; ------------- -- vupkxsx -- ------------- function vupkxsx (A : Varray_Type; Offset : Natural) return Double_Varray_Type is K : Index_Type; D : Double_Varray_Type; begin for J in Double_Varray_Type'Range loop K := Index_Type (Integer (J) - Integer (Double_Index_Type'First) + Integer (Index_Type'First) + Offset); D (J) := Double_Component_Type (A (K)); end loop; return D; end vupkxsx; end Signed_Merging_Operations; ---------------------------------------- -- Unsigned_Merging_Operations (spec) -- ---------------------------------------- generic type Component_Type is mod <>; type Index_Type is range <>; type Varray_Type is array (Index_Type) of Component_Type; type Double_Component_Type is mod <>; type Double_Index_Type is range <>; type Double_Varray_Type is array (Double_Index_Type) of Double_Component_Type; package Unsigned_Merging_Operations is pragma Assert (Integer (Varray_Type'First) = Integer (Double_Varray_Type'First)); pragma Assert (Varray_Type'Length = 2 * Double_Varray_Type'Length); pragma Assert (2 * Component_Type'Size = Double_Component_Type'Size); function UI_To_UI_Mod (X : Double_Component_Type; Y : Natural) return Component_Type; function Saturate (X : Double_Component_Type) return Component_Type; function vmulxux (Use_Even_Components : Boolean; A : Varray_Type; B : Varray_Type) return Double_Varray_Type; function vpkuxum (A : Double_Varray_Type; B : Double_Varray_Type) return Varray_Type; function vpkuxus (A : Double_Varray_Type; B : Double_Varray_Type) return Varray_Type; end Unsigned_Merging_Operations; ---------------------------------------- -- Unsigned_Merging_Operations (body) -- ---------------------------------------- package body Unsigned_Merging_Operations is ------------------ -- UI_To_UI_Mod -- ------------------ function UI_To_UI_Mod (X : Double_Component_Type; Y : Natural) return Component_Type is Z : Component_Type; begin Z := Component_Type (X mod 2 ** Y); return Z; end UI_To_UI_Mod; -------------- -- Saturate -- -------------- function Saturate (X : Double_Component_Type) return Component_Type is D : Component_Type; begin -- Saturation, as defined in -- [PIM-4.1 Vector Status and Control Register] D := Component_Type (Double_Component_Type'Max (Double_Component_Type (Component_Type'First), Double_Component_Type'Min (Double_Component_Type (Component_Type'Last), X))); if Double_Component_Type (D) /= X then VSCR := Write_Bit (VSCR, SAT_POS, 1); end if; return D; end Saturate; ------------- -- vmulxux -- ------------- function vmulxux (Use_Even_Components : Boolean; A : Varray_Type; B : Varray_Type) return Double_Varray_Type is Double_Offset : Double_Index_Type; Offset : Index_Type; D : Double_Varray_Type; N : constant Integer := Integer (Double_Index_Type'Last) - Integer (Double_Index_Type'First) + 1; begin for J in 0 .. N - 1 loop 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)); end loop; return D; end vmulxux; ------------- -- vpkuxum -- ------------- function vpkuxum (A : Double_Varray_Type; B : Double_Varray_Type) return Varray_Type is S : constant Natural := Double_Component_Type'Size / 2; N : constant Index_Type := Index_Type (Double_Index_Type'Last); D : Varray_Type; Offset : Index_Type; Double_Offset : Double_Index_Type; begin for J in 0 .. N - 1 loop Offset := Index_Type (Integer (J) + Integer (Index_Type'First)); Double_Offset := Double_Index_Type (Integer (J) + Integer (Double_Index_Type'First)); D (Offset) := UI_To_UI_Mod (A (Double_Offset), S); D (Offset + N) := UI_To_UI_Mod (B (Double_Offset), S); end loop; return D; end vpkuxum; ------------- -- vpkuxus -- ------------- function vpkuxus (A : Double_Varray_Type; B : Double_Varray_Type) return Varray_Type is N : constant Index_Type := Index_Type (Double_Index_Type'Last); D : Varray_Type; Offset : Index_Type; Double_Offset : Double_Index_Type; begin for J in 0 .. N - 1 loop Offset := Index_Type (Integer (J) + Integer (Index_Type'First)); Double_Offset := Double_Index_Type (Integer (J) + Integer (Double_Index_Type'First)); D (Offset) := Saturate (A (Double_Offset)); D (Offset + N) := Saturate (B (Double_Offset)); end loop; return D; end vpkuxus; end Unsigned_Merging_Operations; package LL_VSC_Operations is new Signed_Operations (signed_char, Vchar_Range, Varray_signed_char); package LL_VSS_Operations is new Signed_Operations (signed_short, Vshort_Range, Varray_signed_short); package LL_VSI_Operations is new Signed_Operations (signed_int, Vint_Range, Varray_signed_int); package LL_VUC_Operations is new Unsigned_Operations (unsigned_char, Vchar_Range, Varray_unsigned_char); package LL_VUS_Operations is new Unsigned_Operations (unsigned_short, Vshort_Range, Varray_unsigned_short); package LL_VUI_Operations is new Unsigned_Operations (unsigned_int, Vint_Range, Varray_unsigned_int); package LL_VSC_LL_VSS_Operations is new Signed_Merging_Operations (signed_char, Vchar_Range, Varray_signed_char, signed_short, Vshort_Range, Varray_signed_short); package LL_VSS_LL_VSI_Operations is new Signed_Merging_Operations (signed_short, Vshort_Range, Varray_signed_short, signed_int, Vint_Range, Varray_signed_int); package LL_VUC_LL_VUS_Operations is new Unsigned_Merging_Operations (unsigned_char, Vchar_Range, Varray_unsigned_char, unsigned_short, Vshort_Range, Varray_unsigned_short); package LL_VUS_LL_VUI_Operations is new Unsigned_Merging_Operations (unsigned_short, Vshort_Range, Varray_unsigned_short, unsigned_int, Vint_Range, Varray_unsigned_int); ---------- -- Bits -- ---------- function Bits (X : unsigned_int; Low : Natural; High : Natural) return unsigned_int renames LL_VUI_Operations.Bits; function Bits (X : unsigned_short; Low : Natural; High : Natural) return unsigned_short renames LL_VUS_Operations.Bits; function Bits (X : unsigned_char; Low : Natural; High : Natural) return unsigned_char renames LL_VUC_Operations.Bits; --------------- -- Write_Bit -- --------------- function Write_Bit (X : unsigned_int; Where : Natural; Value : Unsigned_1) return unsigned_int renames LL_VUI_Operations.Write_Bit; function Write_Bit (X : unsigned_short; Where : Natural; Value : Unsigned_1) return unsigned_short renames LL_VUS_Operations.Write_Bit; function Write_Bit (X : unsigned_char; Where : Natural; Value : Unsigned_1) return unsigned_char renames LL_VUC_Operations.Write_Bit; ----------------- -- Bound_Align -- ----------------- function Bound_Align (X : Integer_Address; Y : Integer_Address) return Integer_Address is D : Integer_Address; begin D := X - X mod Y; return D; end Bound_Align; ----------------- -- NJ_Truncate -- ----------------- function NJ_Truncate (X : C_float) return C_float is D : C_float; begin if (Bits (VSCR, NJ_POS, NJ_POS) = 1) and then abs (X) < 2.0 ** (-126) then D := (if X < 0.0 then -0.0 else +0.0); else D := X; end if; return D; end NJ_Truncate; ----------------------- -- Rnd_To_FP_Nearest -- ----------------------- function Rnd_To_FP_Nearest (X : F64) return C_float is begin return C_float (X); end Rnd_To_FP_Nearest; --------------------- -- Rnd_To_FPI_Near -- --------------------- 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); Result := (if Rnd_To_FPI_Trunc (Ceiling / 2.0) * 2.0 = Ceiling then Ceiling else Ceiling - 1.0); end if; return Result; end Rnd_To_FPI_Near; ---------------------- -- Rnd_To_FPI_Trunc -- ---------------------- function Rnd_To_FPI_Trunc (X : F64) return F64 is Result : F64; begin Result := F64'Ceiling (X); -- Rnd_To_FPI_Trunc rounds toward 0, 'Ceiling rounds toward -- +Infinity if X > 0.0 and then Result /= X then Result := Result - 1.0; end if; return Result; end Rnd_To_FPI_Trunc; ------------------ -- FP_Recip_Est -- ------------------ function FP_Recip_Est (X : C_float) return C_float is begin -- ??? [PIM-4.4 vec_re] "For result that are not +0, -0, +Inf, -- -Inf, or QNaN, the estimate has a relative error no greater -- than one part in 4096, that is: -- Abs ((estimate - 1 / x) / (1 / x)) < = 1/4096" return NJ_Truncate (1.0 / NJ_Truncate (X)); end FP_Recip_Est; ---------- -- ROTL -- ---------- function ROTL (Value : unsigned_char; Amount : Natural) return unsigned_char is Result : Unsigned_8; begin Result := Rotate_Left (Unsigned_8 (Value), Amount); return unsigned_char (Result); end ROTL; function ROTL (Value : unsigned_short; Amount : Natural) return unsigned_short is Result : Unsigned_16; begin Result := Rotate_Left (Unsigned_16 (Value), Amount); return unsigned_short (Result); end ROTL; function ROTL (Value : unsigned_int; Amount : Natural) return unsigned_int is Result : Unsigned_32; begin Result := Rotate_Left (Unsigned_32 (Value), Amount); return unsigned_int (Result); end ROTL; -------------------- -- Recip_SQRT_Est -- -------------------- function Recip_SQRT_Est (X : C_float) return C_float is Result : C_float; begin -- ??? -- [PIM-4.4 vec_rsqrte] the estimate has a relative error in precision -- no greater than one part in 4096, that is: -- abs ((estimate - 1 / sqrt (x)) / (1 / sqrt (x)) <= 1 / 4096" Result := 1.0 / NJ_Truncate (C_float_Operations.Sqrt (NJ_Truncate (X))); return NJ_Truncate (Result); end Recip_SQRT_Est; ---------------- -- Shift_Left -- ---------------- function Shift_Left (Value : unsigned_char; Amount : Natural) return unsigned_char is Result : Unsigned_8; begin Result := Shift_Left (Unsigned_8 (Value), Amount); return unsigned_char (Result); end Shift_Left; function Shift_Left (Value : unsigned_short; Amount : Natural) return unsigned_short is Result : Unsigned_16; begin Result := Shift_Left (Unsigned_16 (Value), Amount); return unsigned_short (Result); end Shift_Left; function Shift_Left (Value : unsigned_int; Amount : Natural) return unsigned_int is Result : Unsigned_32; begin Result := Shift_Left (Unsigned_32 (Value), Amount); return unsigned_int (Result); end Shift_Left; ----------------- -- Shift_Right -- ----------------- function Shift_Right (Value : unsigned_char; Amount : Natural) return unsigned_char is Result : Unsigned_8; begin Result := Shift_Right (Unsigned_8 (Value), Amount); return unsigned_char (Result); end Shift_Right; function Shift_Right (Value : unsigned_short; Amount : Natural) return unsigned_short is Result : Unsigned_16; begin Result := Shift_Right (Unsigned_16 (Value), Amount); return unsigned_short (Result); end Shift_Right; function Shift_Right (Value : unsigned_int; Amount : Natural) return unsigned_int is Result : Unsigned_32; begin Result := Shift_Right (Unsigned_32 (Value), Amount); return unsigned_int (Result); end Shift_Right; ------------------- -- Shift_Right_A -- ------------------- generic type Signed_Type is range <>; type Unsigned_Type is mod <>; with function Shift_Right (Value : Unsigned_Type; Amount : Natural) return Unsigned_Type; function Shift_Right_Arithmetic (Value : Signed_Type; Amount : Natural) return Signed_Type; function Shift_Right_Arithmetic (Value : Signed_Type; Amount : Natural) return Signed_Type is begin if Value > 0 then return Signed_Type (Shift_Right (Unsigned_Type (Value), Amount)); else return -Signed_Type (Shift_Right (Unsigned_Type (-Value - 1), Amount) + 1); end if; end Shift_Right_Arithmetic; function Shift_Right_A is new Shift_Right_Arithmetic (signed_int, Unsigned_32, Shift_Right); function Shift_Right_A is new Shift_Right_Arithmetic (signed_short, Unsigned_16, Shift_Right); function Shift_Right_A is new Shift_Right_Arithmetic (signed_char, Unsigned_8, Shift_Right); -------------- -- To_Pixel -- -------------- function To_Pixel (Source : unsigned_short) return Pixel_16 is -- This conversion should not depend on the host endianness; -- therefore, we cannot use an unchecked conversion. Target : Pixel_16; begin Target.T := Unsigned_1 (Bits (Source, 0, 0) mod 2 ** 1); Target.R := Unsigned_5 (Bits (Source, 1, 5) mod 2 ** 5); Target.G := Unsigned_5 (Bits (Source, 6, 10) mod 2 ** 5); Target.B := Unsigned_5 (Bits (Source, 11, 15) mod 2 ** 5); return Target; end To_Pixel; function To_Pixel (Source : unsigned_int) return Pixel_32 is -- This conversion should not depend on the host endianness; -- therefore, we cannot use an unchecked conversion. Target : Pixel_32; begin Target.T := unsigned_char (Bits (Source, 0, 7)); Target.R := unsigned_char (Bits (Source, 8, 15)); Target.G := unsigned_char (Bits (Source, 16, 23)); Target.B := unsigned_char (Bits (Source, 24, 31)); return Target; end To_Pixel; --------------------- -- To_unsigned_int -- --------------------- function To_unsigned_int (Source : Pixel_32) return unsigned_int is -- 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 endianness. Target : unsigned_int := 0; begin -- In big endian bit ordering, Pixel_32 looks like: -- ------------------------------------- -- | T | R | G | B | -- ------------------------------------- -- 0 (MSB) 7 15 23 32 -- -- Sizes of the components: (8/8/8/8) -- Target := Target or unsigned_int (Source.T); Target := Shift_Left (Target, 8); Target := Target or unsigned_int (Source.R); Target := Shift_Left (Target, 8); Target := Target or unsigned_int (Source.G); Target := Shift_Left (Target, 8); Target := Target or unsigned_int (Source.B); return Target; end To_unsigned_int; ----------------------- -- To_unsigned_short -- ----------------------- function To_unsigned_short (Source : Pixel_16) return unsigned_short is -- 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 endianness. Target : unsigned_short := 0; begin -- In big endian bit ordering, Pixel_16 looks like: -- ------------------------------------- -- | T | R | G | B | -- ------------------------------------- -- 0 (MSB) 1 5 11 15 -- -- Sizes of the components: (1/5/5/5) -- Target := Target or unsigned_short (Source.T); Target := Shift_Left (Target, 5); Target := Target or unsigned_short (Source.R); Target := Shift_Left (Target, 5); Target := Target or unsigned_short (Source.G); Target := Shift_Left (Target, 5); Target := Target or unsigned_short (Source.B); return Target; end To_unsigned_short; --------------- -- abs_v16qi -- --------------- function abs_v16qi (A : LL_VSC) return LL_VSC is VA : constant VSC_View := To_View (A); begin return To_Vector ((Values => LL_VSC_Operations.abs_vxi (VA.Values))); end abs_v16qi; -------------- -- abs_v8hi -- -------------- function abs_v8hi (A : LL_VSS) return LL_VSS is VA : constant VSS_View := To_View (A); begin return To_Vector ((Values => LL_VSS_Operations.abs_vxi (VA.Values))); end abs_v8hi; -------------- -- abs_v4si -- -------------- function abs_v4si (A : LL_VSI) return LL_VSI is VA : constant VSI_View := To_View (A); begin return To_Vector ((Values => LL_VSI_Operations.abs_vxi (VA.Values))); end abs_v4si; -------------- -- abs_v4sf -- -------------- function abs_v4sf (A : LL_VF) return LL_VF is D : Varray_float; VA : constant VF_View := To_View (A); begin for J in Varray_float'Range loop D (J) := abs (VA.Values (J)); end loop; return To_Vector ((Values => D)); end abs_v4sf; ---------------- -- abss_v16qi -- ---------------- function abss_v16qi (A : LL_VSC) return LL_VSC is VA : constant VSC_View := To_View (A); begin return To_Vector ((Values => LL_VSC_Operations.abss_vxi (VA.Values))); end abss_v16qi; --------------- -- abss_v8hi -- --------------- function abss_v8hi (A : LL_VSS) return LL_VSS is VA : constant VSS_View := To_View (A); begin return To_Vector ((Values => LL_VSS_Operations.abss_vxi (VA.Values))); end abss_v8hi; --------------- -- abss_v4si -- --------------- function abss_v4si (A : LL_VSI) return LL_VSI is VA : constant VSI_View := To_View (A); begin return To_Vector ((Values => LL_VSI_Operations.abss_vxi (VA.Values))); end abss_v4si; ------------- -- vaddubm -- ------------- function vaddubm (A : LL_VSC; B : LL_VSC) return LL_VSC is UC : constant GNAT.Altivec.Low_Level_Vectors.LL_VUC := To_LL_VUC (A); VA : constant VUC_View := To_View (UC); VB : constant VUC_View := To_View (To_LL_VUC (B)); D : Varray_unsigned_char; begin D := LL_VUC_Operations.vadduxm (VA.Values, VB.Values); return To_LL_VSC (To_Vector (VUC_View'(Values => D))); end vaddubm; ------------- -- vadduhm -- ------------- function vadduhm (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VUS_View := To_View (To_LL_VUS (A)); VB : constant VUS_View := To_View (To_LL_VUS (B)); D : Varray_unsigned_short; begin D := LL_VUS_Operations.vadduxm (VA.Values, VB.Values); return To_LL_VSS (To_Vector (VUS_View'(Values => D))); end vadduhm; ------------- -- vadduwm -- ------------- function vadduwm (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : Varray_unsigned_int; begin D := LL_VUI_Operations.vadduxm (VA.Values, VB.Values); return To_LL_VSI (To_Vector (VUI_View'(Values => D))); end vadduwm; ------------ -- vaddfp -- ------------ function vaddfp (A : LL_VF; B : LL_VF) return LL_VF is VA : constant VF_View := To_View (A); VB : constant VF_View := To_View (B); D : Varray_float; begin for J in Varray_float'Range loop D (J) := NJ_Truncate (NJ_Truncate (VA.Values (J)) + NJ_Truncate (VB.Values (J))); end loop; return To_Vector (VF_View'(Values => D)); end vaddfp; ------------- -- vaddcuw -- ------------- function vaddcuw (A : LL_VSI; B : LL_VSI) return LL_VSI is Addition_Result : UI64; D : VUI_View; VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); begin for J in Varray_unsigned_int'Range loop 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)); end vaddcuw; ------------- -- vaddubs -- ------------- function vaddubs (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VUC_View := To_View (To_LL_VUC (A)); VB : constant VUC_View := To_View (To_LL_VUC (B)); begin return To_LL_VSC (To_Vector (VUC_View'(Values => (LL_VUC_Operations.vadduxs (VA.Values, VB.Values))))); end vaddubs; ------------- -- vaddsbs -- ------------- function vaddsbs (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VSC_View := To_View (A); VB : constant VSC_View := To_View (B); D : VSC_View; begin D.Values := LL_VSC_Operations.vaddsxs (VA.Values, VB.Values); return To_Vector (D); end vaddsbs; ------------- -- vadduhs -- ------------- function vadduhs (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VUS_View := To_View (To_LL_VUS (A)); VB : constant VUS_View := To_View (To_LL_VUS (B)); D : VUS_View; begin D.Values := LL_VUS_Operations.vadduxs (VA.Values, VB.Values); return To_LL_VSS (To_Vector (D)); end vadduhs; ------------- -- vaddshs -- ------------- function vaddshs (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VSS_View := To_View (A); VB : constant VSS_View := To_View (B); D : VSS_View; begin D.Values := LL_VSS_Operations.vaddsxs (VA.Values, VB.Values); return To_Vector (D); end vaddshs; ------------- -- vadduws -- ------------- function vadduws (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUI_View; begin D.Values := LL_VUI_Operations.vadduxs (VA.Values, VB.Values); return To_LL_VSI (To_Vector (D)); end vadduws; ------------- -- vaddsws -- ------------- function vaddsws (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VSI_View := To_View (A); VB : constant VSI_View := To_View (B); D : VSI_View; begin D.Values := LL_VSI_Operations.vaddsxs (VA.Values, VB.Values); return To_Vector (D); end vaddsws; ---------- -- vand -- ---------- function vand (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUI_View; begin for J in Varray_unsigned_int'Range loop D.Values (J) := VA.Values (J) and VB.Values (J); end loop; return To_LL_VSI (To_Vector (D)); end vand; ----------- -- vandc -- ----------- function vandc (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUI_View; begin for J in Varray_unsigned_int'Range loop D.Values (J) := VA.Values (J) and not VB.Values (J); end loop; return To_LL_VSI (To_Vector (D)); end vandc; ------------ -- vavgub -- ------------ function vavgub (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VUC_View := To_View (To_LL_VUC (A)); VB : constant VUC_View := To_View (To_LL_VUC (B)); D : VUC_View; begin D.Values := LL_VUC_Operations.vavgux (VA.Values, VB.Values); return To_LL_VSC (To_Vector (D)); end vavgub; ------------ -- vavgsb -- ------------ function vavgsb (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VSC_View := To_View (A); VB : constant VSC_View := To_View (B); D : VSC_View; begin D.Values := LL_VSC_Operations.vavgsx (VA.Values, VB.Values); return To_Vector (D); end vavgsb; ------------ -- vavguh -- ------------ function vavguh (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VUS_View := To_View (To_LL_VUS (A)); VB : constant VUS_View := To_View (To_LL_VUS (B)); D : VUS_View; begin D.Values := LL_VUS_Operations.vavgux (VA.Values, VB.Values); return To_LL_VSS (To_Vector (D)); end vavguh; ------------ -- vavgsh -- ------------ function vavgsh (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VSS_View := To_View (A); VB : constant VSS_View := To_View (B); D : VSS_View; begin D.Values := LL_VSS_Operations.vavgsx (VA.Values, VB.Values); return To_Vector (D); end vavgsh; ------------ -- vavguw -- ------------ function vavguw (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUI_View; begin D.Values := LL_VUI_Operations.vavgux (VA.Values, VB.Values); return To_LL_VSI (To_Vector (D)); end vavguw; ------------ -- vavgsw -- ------------ function vavgsw (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VSI_View := To_View (A); VB : constant VSI_View := To_View (B); D : VSI_View; begin D.Values := LL_VSI_Operations.vavgsx (VA.Values, VB.Values); return To_Vector (D); end vavgsw; ----------- -- vrfip -- ----------- function vrfip (A : LL_VF) return LL_VF is VA : constant VF_View := To_View (A); D : VF_View; begin for J in Varray_float'Range loop -- If A (J) is infinite, D (J) should be infinite; With -- IEEE floating points, we can use 'Ceiling for that purpose. D.Values (J) := C_float'Ceiling (NJ_Truncate (VA.Values (J))); end loop; return To_Vector (D); end vrfip; ------------- -- vcmpbfp -- ------------- function vcmpbfp (A : LL_VF; B : LL_VF) return LL_VSI is 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); D.Values (K) := 0; if NJ_Truncate (VB.Values (J)) < 0.0 then -- [PIM-4.4 vec_cmpb] "If any single-precision floating-point -- word element in B is negative; the corresponding element in A -- is out of bounds. D.Values (K) := Write_Bit (D.Values (K), 0, 1); D.Values (K) := Write_Bit (D.Values (K), 1, 1); else 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; return To_LL_VSI (To_Vector (D)); end vcmpbfp; -------------- -- vcmpequb -- -------------- function vcmpequb (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VUC_View := To_View (To_LL_VUC (A)); VB : constant VUC_View := To_View (To_LL_VUC (B)); D : VUC_View; begin D.Values := LL_VUC_Operations.vcmpequx (VA.Values, VB.Values); return To_LL_VSC (To_Vector (D)); end vcmpequb; -------------- -- vcmpequh -- -------------- function vcmpequh (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VUS_View := To_View (To_LL_VUS (A)); VB : constant VUS_View := To_View (To_LL_VUS (B)); D : VUS_View; begin D.Values := LL_VUS_Operations.vcmpequx (VA.Values, VB.Values); return To_LL_VSS (To_Vector (D)); end vcmpequh; -------------- -- vcmpequw -- -------------- function vcmpequw (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUI_View; begin D.Values := LL_VUI_Operations.vcmpequx (VA.Values, VB.Values); return To_LL_VSI (To_Vector (D)); end vcmpequw; -------------- -- vcmpeqfp -- -------------- function vcmpeqfp (A : LL_VF; B : LL_VF) return LL_VSI is VA : constant VF_View := To_View (A); VB : constant VF_View := To_View (B); D : VUI_View; begin for J in Varray_float'Range loop 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)); end vcmpeqfp; -------------- -- vcmpgefp -- -------------- function vcmpgefp (A : LL_VF; B : LL_VF) return LL_VSI is VA : constant VF_View := To_View (A); VB : constant VF_View := To_View (B); D : VSI_View; begin for J in Varray_float'Range loop 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); end vcmpgefp; -------------- -- vcmpgtub -- -------------- function vcmpgtub (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VUC_View := To_View (To_LL_VUC (A)); VB : constant VUC_View := To_View (To_LL_VUC (B)); D : VUC_View; begin D.Values := LL_VUC_Operations.vcmpgtux (VA.Values, VB.Values); return To_LL_VSC (To_Vector (D)); end vcmpgtub; -------------- -- vcmpgtsb -- -------------- function vcmpgtsb (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VSC_View := To_View (A); VB : constant VSC_View := To_View (B); D : VSC_View; begin D.Values := LL_VSC_Operations.vcmpgtsx (VA.Values, VB.Values); return To_Vector (D); end vcmpgtsb; -------------- -- vcmpgtuh -- -------------- function vcmpgtuh (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VUS_View := To_View (To_LL_VUS (A)); VB : constant VUS_View := To_View (To_LL_VUS (B)); D : VUS_View; begin D.Values := LL_VUS_Operations.vcmpgtux (VA.Values, VB.Values); return To_LL_VSS (To_Vector (D)); end vcmpgtuh; -------------- -- vcmpgtsh -- -------------- function vcmpgtsh (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VSS_View := To_View (A); VB : constant VSS_View := To_View (B); D : VSS_View; begin D.Values := LL_VSS_Operations.vcmpgtsx (VA.Values, VB.Values); return To_Vector (D); end vcmpgtsh; -------------- -- vcmpgtuw -- -------------- function vcmpgtuw (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUI_View; begin D.Values := LL_VUI_Operations.vcmpgtux (VA.Values, VB.Values); return To_LL_VSI (To_Vector (D)); end vcmpgtuw; -------------- -- vcmpgtsw -- -------------- function vcmpgtsw (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VSI_View := To_View (A); VB : constant VSI_View := To_View (B); D : VSI_View; begin D.Values := LL_VSI_Operations.vcmpgtsx (VA.Values, VB.Values); return To_Vector (D); end vcmpgtsw; -------------- -- vcmpgtfp -- -------------- function vcmpgtfp (A : LL_VF; B : LL_VF) return LL_VSI is VA : constant VF_View := To_View (A); VB : constant VF_View := To_View (B); D : VSI_View; begin for J in Varray_float'Range loop 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); end vcmpgtfp; ----------- -- vcfux -- ----------- function vcfux (A : LL_VSI; B : c_int) return LL_VF is D : VF_View; VA : constant VUI_View := To_View (To_LL_VUI (A)); K : Vfloat_Range; begin for J in Varray_signed_int'Range loop K := Vfloat_Range (J); -- Note: The conversion to Integer is safe, as Integers are required -- to include the range -2 ** 15 + 1 .. 2 ** 15 + 1 and therefore -- include the range of B (should be 0 .. 255). D.Values (K) := C_float (VA.Values (J)) / (2.0 ** Integer (B)); end loop; return To_Vector (D); end vcfux; ----------- -- vcfsx -- ----------- function vcfsx (A : LL_VSI; B : c_int) return LL_VF is VA : constant VSI_View := To_View (A); D : VF_View; K : Vfloat_Range; begin for J in Varray_signed_int'Range loop K := Vfloat_Range (J); D.Values (K) := C_float (VA.Values (J)) / (2.0 ** Integer (B)); end loop; return To_Vector (D); end vcfsx; ------------ -- vctsxs -- ------------ function vctsxs (A : LL_VF; B : c_int) return LL_VSI is VA : constant VF_View := To_View (A); D : VSI_View; K : Vfloat_Range; begin for J in Varray_signed_int'Range loop K := Vfloat_Range (J); D.Values (J) := LL_VSI_Operations.Saturate (F64 (NJ_Truncate (VA.Values (K))) * F64 (2.0 ** Integer (B))); end loop; return To_Vector (D); end vctsxs; ------------ -- vctuxs -- ------------ function vctuxs (A : LL_VF; B : c_int) return LL_VSI is VA : constant VF_View := To_View (A); D : VUI_View; K : Vfloat_Range; begin for J in Varray_unsigned_int'Range loop K := Vfloat_Range (J); D.Values (J) := LL_VUI_Operations.Saturate (F64 (NJ_Truncate (VA.Values (K))) * F64 (2.0 ** Integer (B))); end loop; return To_LL_VSI (To_Vector (D)); end vctuxs; --------- -- dss -- --------- -- No-ops, as allowed by [PEM-5.2.1.1 Data Stream Touch (dst)]: procedure dss (A : c_int) is pragma Unreferenced (A); begin null; end dss; ------------ -- dssall -- ------------ -- No-ops, as allowed by [PEM-5.2.1.1 Data Stream Touch (dst)]: procedure dssall is begin null; end dssall; --------- -- dst -- --------- -- No-ops, as allowed by [PEM-5.2.1.1 Data Stream Touch (dst)]: procedure dst (A : c_ptr; B : c_int; C : c_int) is pragma Unreferenced (A); pragma Unreferenced (B); pragma Unreferenced (C); begin null; end dst; ----------- -- dstst -- ----------- -- No-ops, as allowed by [PEM-5.2.1.1 Data Stream Touch (dst)]: procedure dstst (A : c_ptr; B : c_int; C : c_int) is pragma Unreferenced (A); pragma Unreferenced (B); pragma Unreferenced (C); begin null; end dstst; ------------ -- dststt -- ------------ -- No-ops, as allowed by [PEM-5.2.1.1 Data Stream Touch (dst)]: procedure dststt (A : c_ptr; B : c_int; C : c_int) is pragma Unreferenced (A); pragma Unreferenced (B); pragma Unreferenced (C); begin null; end dststt; ---------- -- dstt -- ---------- -- No-ops, as allowed by [PEM-5.2.1.1 Data Stream Touch (dst)]: procedure dstt (A : c_ptr; B : c_int; C : c_int) is pragma Unreferenced (A); pragma Unreferenced (B); pragma Unreferenced (C); begin null; end dstt; -------------- -- vexptefp -- -------------- function vexptefp (A : LL_VF) return LL_VF is use C_float_Operations; VA : constant VF_View := To_View (A); D : VF_View; begin for J in Varray_float'Range loop -- ??? Check the precision of the operation. -- As described in [PEM-6 vexptefp]: -- If theoretical_result is equal to 2 at the power of A (J) with -- infinite precision, we should have: -- abs ((D (J) - theoretical_result) / theoretical_result) <= 1/16 D.Values (J) := 2.0 ** NJ_Truncate (VA.Values (J)); end loop; return To_Vector (D); end vexptefp; ----------- -- vrfim -- ----------- function vrfim (A : LL_VF) return LL_VF is VA : constant VF_View := To_View (A); D : VF_View; begin for J in Varray_float'Range loop -- If A (J) is infinite, D (J) should be infinite; With -- IEEE floating point, we can use 'Ceiling for that purpose. D.Values (J) := C_float'Ceiling (NJ_Truncate (VA.Values (J))); -- Vrfim rounds toward -Infinity, whereas 'Ceiling rounds toward -- +Infinity: if D.Values (J) /= VA.Values (J) then D.Values (J) := D.Values (J) - 1.0; end if; end loop; return To_Vector (D); end vrfim; --------- -- lvx -- --------- function lvx (A : c_long; B : c_ptr) return LL_VSI is -- Simulate the altivec unit behavior regarding what Effective Address -- is accessed, stripping off the input address least significant bits -- wrt to vector alignment. -- 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; ----------- -- lvebx -- ----------- function lvebx (A : c_long; B : c_ptr) return LL_VSC is D : VSC_View; begin D.Values := LL_VSC_Operations.lvexx (A, B); return To_Vector (D); end lvebx; ----------- -- lvehx -- ----------- function lvehx (A : c_long; B : c_ptr) return LL_VSS is D : VSS_View; begin D.Values := LL_VSS_Operations.lvexx (A, B); return To_Vector (D); end lvehx; ----------- -- lvewx -- ----------- function lvewx (A : c_long; B : c_ptr) return LL_VSI is D : VSI_View; begin D.Values := LL_VSI_Operations.lvexx (A, B); return To_Vector (D); end lvewx; ---------- -- lvxl -- ---------- function lvxl (A : c_long; B : c_ptr) return LL_VSI renames lvx; ------------- -- vlogefp -- ------------- function vlogefp (A : LL_VF) return LL_VF is VA : constant VF_View := To_View (A); D : VF_View; begin for J in Varray_float'Range loop -- ??? Check the precision of the operation. -- As described in [PEM-6 vlogefp]: -- If theorical_result is equal to the log2 of A (J) with -- infinite precision, we should have: -- abs (D (J) - theorical_result) <= 1/32, -- unless abs(D(J) - 1) <= 1/8. D.Values (J) := C_float_Operations.Log (NJ_Truncate (VA.Values (J)), 2.0); end loop; return To_Vector (D); end vlogefp; ---------- -- lvsl -- ---------- function lvsl (A : c_long; B : c_ptr) return LL_VSC is type bit4_type is mod 16#F# + 1; for bit4_type'Alignment use 1; EA : Integer_Address; D : VUC_View; SH : bit4_type; begin EA := Integer_Address (A) + To_Integer (B); SH := bit4_type (EA mod 2 ** 4); for J in D.Values'Range loop D.Values (J) := unsigned_char (SH) + unsigned_char (J) - unsigned_char (D.Values'First); end loop; return To_LL_VSC (To_Vector (D)); end lvsl; ---------- -- lvsr -- ---------- function lvsr (A : c_long; B : c_ptr) return LL_VSC is type bit4_type is mod 16#F# + 1; for bit4_type'Alignment use 1; EA : Integer_Address; D : VUC_View; SH : bit4_type; begin EA := Integer_Address (A) + To_Integer (B); SH := bit4_type (EA mod 2 ** 4); for J in D.Values'Range loop D.Values (J) := (16#F# - unsigned_char (SH)) + unsigned_char (J); end loop; return To_LL_VSC (To_Vector (D)); end lvsr; ------------- -- vmaddfp -- ------------- function vmaddfp (A : LL_VF; B : LL_VF; C : LL_VF) return LL_VF is VA : constant VF_View := To_View (A); VB : constant VF_View := To_View (B); VC : constant VF_View := To_View (C); D : VF_View; begin for J in Varray_float'Range loop D.Values (J) := Rnd_To_FP_Nearest (F64 (VA.Values (J)) * F64 (VB.Values (J)) + F64 (VC.Values (J))); end loop; return To_Vector (D); end vmaddfp; --------------- -- vmhaddshs -- --------------- function vmhaddshs (A : LL_VSS; B : LL_VSS; C : LL_VSS) return LL_VSS is VA : constant VSS_View := To_View (A); VB : constant VSS_View := To_View (B); VC : constant VSS_View := To_View (C); D : VSS_View; begin for J in Varray_signed_short'Range loop D.Values (J) := LL_VSS_Operations.Saturate ((SI64 (VA.Values (J)) * SI64 (VB.Values (J))) / SI64 (2 ** 15) + SI64 (VC.Values (J))); end loop; return To_Vector (D); end vmhaddshs; ------------ -- vmaxub -- ------------ function vmaxub (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VUC_View := To_View (To_LL_VUC (A)); VB : constant VUC_View := To_View (To_LL_VUC (B)); D : VUC_View; begin D.Values := LL_VUC_Operations.vmaxux (VA.Values, VB.Values); return To_LL_VSC (To_Vector (D)); end vmaxub; ------------ -- vmaxsb -- ------------ function vmaxsb (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VSC_View := To_View (A); VB : constant VSC_View := To_View (B); D : VSC_View; begin D.Values := LL_VSC_Operations.vmaxsx (VA.Values, VB.Values); return To_Vector (D); end vmaxsb; ------------ -- vmaxuh -- ------------ function vmaxuh (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VUS_View := To_View (To_LL_VUS (A)); VB : constant VUS_View := To_View (To_LL_VUS (B)); D : VUS_View; begin D.Values := LL_VUS_Operations.vmaxux (VA.Values, VB.Values); return To_LL_VSS (To_Vector (D)); end vmaxuh; ------------ -- vmaxsh -- ------------ function vmaxsh (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VSS_View := To_View (A); VB : constant VSS_View := To_View (B); D : VSS_View; begin D.Values := LL_VSS_Operations.vmaxsx (VA.Values, VB.Values); return To_Vector (D); end vmaxsh; ------------ -- vmaxuw -- ------------ function vmaxuw (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUI_View; begin D.Values := LL_VUI_Operations.vmaxux (VA.Values, VB.Values); return To_LL_VSI (To_Vector (D)); end vmaxuw; ------------ -- vmaxsw -- ------------ function vmaxsw (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VSI_View := To_View (A); VB : constant VSI_View := To_View (B); D : VSI_View; begin D.Values := LL_VSI_Operations.vmaxsx (VA.Values, VB.Values); return To_Vector (D); end vmaxsw; -------------- -- vmaxsxfp -- -------------- function vmaxfp (A : LL_VF; B : LL_VF) return LL_VF is VA : constant VF_View := To_View (A); VB : constant VF_View := To_View (B); D : VF_View; begin for J in Varray_float'Range loop D.Values (J) := (if VA.Values (J) > VB.Values (J) then VA.Values (J) else VB.Values (J)); end loop; return To_Vector (D); end vmaxfp; ------------ -- vmrghb -- ------------ function vmrghb (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VSC_View := To_View (A); VB : constant VSC_View := To_View (B); D : VSC_View; begin D.Values := LL_VSC_Operations.vmrghx (VA.Values, VB.Values); return To_Vector (D); end vmrghb; ------------ -- vmrghh -- ------------ function vmrghh (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VSS_View := To_View (A); VB : constant VSS_View := To_View (B); D : VSS_View; begin D.Values := LL_VSS_Operations.vmrghx (VA.Values, VB.Values); return To_Vector (D); end vmrghh; ------------ -- vmrghw -- ------------ function vmrghw (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VSI_View := To_View (A); VB : constant VSI_View := To_View (B); D : VSI_View; begin D.Values := LL_VSI_Operations.vmrghx (VA.Values, VB.Values); return To_Vector (D); end vmrghw; ------------ -- vmrglb -- ------------ function vmrglb (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VSC_View := To_View (A); VB : constant VSC_View := To_View (B); D : VSC_View; begin D.Values := LL_VSC_Operations.vmrglx (VA.Values, VB.Values); return To_Vector (D); end vmrglb; ------------ -- vmrglh -- ------------ function vmrglh (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VSS_View := To_View (A); VB : constant VSS_View := To_View (B); D : VSS_View; begin D.Values := LL_VSS_Operations.vmrglx (VA.Values, VB.Values); return To_Vector (D); end vmrglh; ------------ -- vmrglw -- ------------ function vmrglw (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VSI_View := To_View (A); VB : constant VSI_View := To_View (B); D : VSI_View; begin D.Values := LL_VSI_Operations.vmrglx (VA.Values, VB.Values); return To_Vector (D); end vmrglw; ------------ -- mfvscr -- ------------ function mfvscr return LL_VSS is D : VUS_View; begin for J in Varray_unsigned_short'Range loop D.Values (J) := 0; end loop; D.Values (Varray_unsigned_short'Last) := unsigned_short (VSCR mod 2 ** unsigned_short'Size); D.Values (Varray_unsigned_short'Last - 1) := unsigned_short (VSCR / 2 ** unsigned_short'Size); return To_LL_VSS (To_Vector (D)); end mfvscr; ------------ -- vminfp -- ------------ function vminfp (A : LL_VF; B : LL_VF) return LL_VF is VA : constant VF_View := To_View (A); VB : constant VF_View := To_View (B); D : VF_View; begin for J in Varray_float'Range loop D.Values (J) := (if VA.Values (J) < VB.Values (J) then VA.Values (J) else VB.Values (J)); end loop; return To_Vector (D); end vminfp; ------------ -- vminsb -- ------------ function vminsb (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VSC_View := To_View (A); VB : constant VSC_View := To_View (B); D : VSC_View; begin D.Values := LL_VSC_Operations.vminsx (VA.Values, VB.Values); return To_Vector (D); end vminsb; ------------ -- vminub -- ------------ function vminub (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VUC_View := To_View (To_LL_VUC (A)); VB : constant VUC_View := To_View (To_LL_VUC (B)); D : VUC_View; begin D.Values := LL_VUC_Operations.vminux (VA.Values, VB.Values); return To_LL_VSC (To_Vector (D)); end vminub; ------------ -- vminsh -- ------------ function vminsh (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VSS_View := To_View (A); VB : constant VSS_View := To_View (B); D : VSS_View; begin D.Values := LL_VSS_Operations.vminsx (VA.Values, VB.Values); return To_Vector (D); end vminsh; ------------ -- vminuh -- ------------ function vminuh (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VUS_View := To_View (To_LL_VUS (A)); VB : constant VUS_View := To_View (To_LL_VUS (B)); D : VUS_View; begin D.Values := LL_VUS_Operations.vminux (VA.Values, VB.Values); return To_LL_VSS (To_Vector (D)); end vminuh; ------------ -- vminsw -- ------------ function vminsw (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VSI_View := To_View (A); VB : constant VSI_View := To_View (B); D : VSI_View; begin D.Values := LL_VSI_Operations.vminsx (VA.Values, VB.Values); return To_Vector (D); end vminsw; ------------ -- vminuw -- ------------ function vminuw (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUI_View; begin D.Values := LL_VUI_Operations.vminux (VA.Values, VB.Values); return To_LL_VSI (To_Vector (D)); end vminuw; --------------- -- vmladduhm -- --------------- function vmladduhm (A : LL_VSS; B : LL_VSS; C : LL_VSS) return LL_VSS is VA : constant VUS_View := To_View (To_LL_VUS (A)); VB : constant VUS_View := To_View (To_LL_VUS (B)); VC : constant VUS_View := To_View (To_LL_VUS (C)); D : VUS_View; begin for J in Varray_unsigned_short'Range loop D.Values (J) := VA.Values (J) * VB.Values (J) + VC.Values (J); end loop; return To_LL_VSS (To_Vector (D)); end vmladduhm; ---------------- -- vmhraddshs -- ---------------- function vmhraddshs (A : LL_VSS; B : LL_VSS; C : LL_VSS) return LL_VSS is VA : constant VSS_View := To_View (A); VB : constant VSS_View := To_View (B); VC : constant VSS_View := To_View (C); D : VSS_View; begin for J in Varray_signed_short'Range loop D.Values (J) := LL_VSS_Operations.Saturate (((SI64 (VA.Values (J)) * SI64 (VB.Values (J)) + 2 ** 14) / 2 ** 15 + SI64 (VC.Values (J)))); end loop; return To_Vector (D); end vmhraddshs; -------------- -- vmsumubm -- -------------- function vmsumubm (A : LL_VSC; B : LL_VSC; C : LL_VSI) return LL_VSI is Offset : Vchar_Range; VA : constant VUC_View := To_View (To_LL_VUC (A)); VB : constant VUC_View := To_View (To_LL_VUC (B)); VC : constant VUI_View := To_View (To_LL_VUI (C)); D : VUI_View; begin for J in 0 .. 3 loop Offset := Vchar_Range (4 * J + Integer (Vchar_Range'First)); D.Values (Vint_Range (J + Integer (Vint_Range'First))) := (unsigned_int (VA.Values (Offset)) * unsigned_int (VB.Values (Offset))) + (unsigned_int (VA.Values (Offset + 1)) * unsigned_int (VB.Values (1 + Offset))) + (unsigned_int (VA.Values (2 + Offset)) * unsigned_int (VB.Values (2 + Offset))) + (unsigned_int (VA.Values (3 + Offset)) * unsigned_int (VB.Values (3 + Offset))) + VC.Values (Vint_Range (J + Integer (Varray_unsigned_int'First))); end loop; return To_LL_VSI (To_Vector (D)); end vmsumubm; -------------- -- vmsumumbm -- -------------- function vmsummbm (A : LL_VSC; B : LL_VSC; C : LL_VSI) return LL_VSI is Offset : Vchar_Range; VA : constant VSC_View := To_View (A); VB : constant VUC_View := To_View (To_LL_VUC (B)); VC : constant VSI_View := To_View (C); D : VSI_View; begin for J in 0 .. 3 loop Offset := Vchar_Range (4 * J + Integer (Vchar_Range'First)); D.Values (Vint_Range (J + Integer (Varray_unsigned_int'First))) := 0 + LL_VSI_Operations.Modular_Result (SI64 (VA.Values (Offset)) * SI64 (VB.Values (Offset))) + LL_VSI_Operations.Modular_Result (SI64 (VA.Values (Offset + 1)) * SI64 (VB.Values (1 + Offset))) + LL_VSI_Operations.Modular_Result (SI64 (VA.Values (2 + Offset)) * SI64 (VB.Values (2 + Offset))) + LL_VSI_Operations.Modular_Result (SI64 (VA.Values (3 + Offset)) * SI64 (VB.Values (3 + Offset))) + VC.Values (Vint_Range (J + Integer (Varray_unsigned_int'First))); end loop; return To_Vector (D); end vmsummbm; -------------- -- vmsumuhm -- -------------- function vmsumuhm (A : LL_VSS; B : LL_VSS; C : LL_VSI) return LL_VSI is Offset : Vshort_Range; VA : constant VUS_View := To_View (To_LL_VUS (A)); VB : constant VUS_View := To_View (To_LL_VUS (B)); VC : constant VUI_View := To_View (To_LL_VUI (C)); D : VUI_View; begin for J in 0 .. 3 loop Offset := Vshort_Range (2 * J + Integer (Vshort_Range'First)); D.Values (Vint_Range (J + Integer (Varray_unsigned_int'First))) := (unsigned_int (VA.Values (Offset)) * unsigned_int (VB.Values (Offset))) + (unsigned_int (VA.Values (Offset + 1)) * unsigned_int (VB.Values (1 + Offset))) + VC.Values (Vint_Range (J + Integer (Vint_Range'First))); end loop; return To_LL_VSI (To_Vector (D)); end vmsumuhm; -------------- -- vmsumshm -- -------------- function vmsumshm (A : LL_VSS; B : LL_VSS; C : LL_VSI) return LL_VSI is VA : constant VSS_View := To_View (A); VB : constant VSS_View := To_View (B); VC : constant VSI_View := To_View (C); Offset : Vshort_Range; D : VSI_View; begin for J in 0 .. 3 loop Offset := Vshort_Range (2 * J + Integer (Varray_signed_char'First)); D.Values (Vint_Range (J + Integer (Varray_unsigned_int'First))) := 0 + LL_VSI_Operations.Modular_Result (SI64 (VA.Values (Offset)) * SI64 (VB.Values (Offset))) + LL_VSI_Operations.Modular_Result (SI64 (VA.Values (Offset + 1)) * SI64 (VB.Values (1 + Offset))) + VC.Values (Vint_Range (J + Integer (Varray_unsigned_int'First))); end loop; return To_Vector (D); end vmsumshm; -------------- -- vmsumuhs -- -------------- function vmsumuhs (A : LL_VSS; B : LL_VSS; C : LL_VSI) return LL_VSI is Offset : Vshort_Range; VA : constant VUS_View := To_View (To_LL_VUS (A)); VB : constant VUS_View := To_View (To_LL_VUS (B)); VC : constant VUI_View := To_View (To_LL_VUI (C)); D : VUI_View; begin for J in 0 .. 3 loop Offset := Vshort_Range (2 * J + Integer (Varray_signed_short'First)); D.Values (Vint_Range (J + Integer (Varray_unsigned_int'First))) := LL_VUI_Operations.Saturate (UI64 (VA.Values (Offset)) * UI64 (VB.Values (Offset)) + UI64 (VA.Values (Offset + 1)) * UI64 (VB.Values (1 + Offset)) + UI64 (VC.Values (Vint_Range (J + Integer (Varray_unsigned_int'First))))); end loop; return To_LL_VSI (To_Vector (D)); end vmsumuhs; -------------- -- vmsumshs -- -------------- function vmsumshs (A : LL_VSS; B : LL_VSS; C : LL_VSI) return LL_VSI is VA : constant VSS_View := To_View (A); VB : constant VSS_View := To_View (B); VC : constant VSI_View := To_View (C); Offset : Vshort_Range; D : VSI_View; begin for J in 0 .. 3 loop Offset := Vshort_Range (2 * J + Integer (Varray_signed_short'First)); D.Values (Vint_Range (J + Integer (Varray_signed_int'First))) := LL_VSI_Operations.Saturate (SI64 (VA.Values (Offset)) * SI64 (VB.Values (Offset)) + SI64 (VA.Values (Offset + 1)) * SI64 (VB.Values (1 + Offset)) + SI64 (VC.Values (Vint_Range (J + Integer (Varray_signed_int'First))))); end loop; return To_Vector (D); end vmsumshs; ------------ -- mtvscr -- ------------ procedure mtvscr (A : LL_VSI) is VA : constant VUI_View := To_View (To_LL_VUI (A)); begin VSCR := VA.Values (Varray_unsigned_int'Last); end mtvscr; ------------- -- vmuleub -- ------------- function vmuleub (A : LL_VSC; B : LL_VSC) return LL_VSS is VA : constant VUC_View := To_View (To_LL_VUC (A)); VB : constant VUC_View := To_View (To_LL_VUC (B)); D : VUS_View; begin D.Values := LL_VUC_LL_VUS_Operations.vmulxux (True, VA.Values, VB.Values); return To_LL_VSS (To_Vector (D)); end vmuleub; ------------- -- vmuleuh -- ------------- function vmuleuh (A : LL_VSS; B : LL_VSS) return LL_VSI is VA : constant VUS_View := To_View (To_LL_VUS (A)); VB : constant VUS_View := To_View (To_LL_VUS (B)); D : VUI_View; begin D.Values := LL_VUS_LL_VUI_Operations.vmulxux (True, VA.Values, VB.Values); return To_LL_VSI (To_Vector (D)); end vmuleuh; ------------- -- vmulesb -- ------------- function vmulesb (A : LL_VSC; B : LL_VSC) return LL_VSS is VA : constant VSC_View := To_View (A); VB : constant VSC_View := To_View (B); D : VSS_View; begin D.Values := LL_VSC_LL_VSS_Operations.vmulxsx (True, VA.Values, VB.Values); return To_Vector (D); end vmulesb; ------------- -- vmulesh -- ------------- function vmulesh (A : LL_VSS; B : LL_VSS) return LL_VSI is VA : constant VSS_View := To_View (A); VB : constant VSS_View := To_View (B); D : VSI_View; begin D.Values := LL_VSS_LL_VSI_Operations.vmulxsx (True, VA.Values, VB.Values); return To_Vector (D); end vmulesh; ------------- -- vmuloub -- ------------- function vmuloub (A : LL_VSC; B : LL_VSC) return LL_VSS is VA : constant VUC_View := To_View (To_LL_VUC (A)); VB : constant VUC_View := To_View (To_LL_VUC (B)); D : VUS_View; begin D.Values := LL_VUC_LL_VUS_Operations.vmulxux (False, VA.Values, VB.Values); return To_LL_VSS (To_Vector (D)); end vmuloub; ------------- -- vmulouh -- ------------- function vmulouh (A : LL_VSS; B : LL_VSS) return LL_VSI is VA : constant VUS_View := To_View (To_LL_VUS (A)); VB : constant VUS_View := To_View (To_LL_VUS (B)); D : VUI_View; begin D.Values := LL_VUS_LL_VUI_Operations.vmulxux (False, VA.Values, VB.Values); return To_LL_VSI (To_Vector (D)); end vmulouh; ------------- -- vmulosb -- ------------- function vmulosb (A : LL_VSC; B : LL_VSC) return LL_VSS is VA : constant VSC_View := To_View (A); VB : constant VSC_View := To_View (B); D : VSS_View; begin D.Values := LL_VSC_LL_VSS_Operations.vmulxsx (False, VA.Values, VB.Values); return To_Vector (D); end vmulosb; ------------- -- vmulosh -- ------------- function vmulosh (A : LL_VSS; B : LL_VSS) return LL_VSI is VA : constant VSS_View := To_View (A); VB : constant VSS_View := To_View (B); D : VSI_View; begin D.Values := LL_VSS_LL_VSI_Operations.vmulxsx (False, VA.Values, VB.Values); return To_Vector (D); end vmulosh; -------------- -- vnmsubfp -- -------------- function vnmsubfp (A : LL_VF; B : LL_VF; C : LL_VF) return LL_VF is VA : constant VF_View := To_View (A); VB : constant VF_View := To_View (B); VC : constant VF_View := To_View (C); D : VF_View; begin for J in Vfloat_Range'Range loop D.Values (J) := -Rnd_To_FP_Nearest (F64 (VA.Values (J)) * F64 (VB.Values (J)) - F64 (VC.Values (J))); end loop; return To_Vector (D); end vnmsubfp; ---------- -- vnor -- ---------- function vnor (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUI_View; begin for J in Vint_Range'Range loop D.Values (J) := not (VA.Values (J) or VB.Values (J)); end loop; return To_LL_VSI (To_Vector (D)); end vnor; ---------- -- vor -- ---------- function vor (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUI_View; begin for J in Vint_Range'Range loop D.Values (J) := VA.Values (J) or VB.Values (J); end loop; return To_LL_VSI (To_Vector (D)); end vor; ------------- -- vpkuhum -- ------------- function vpkuhum (A : LL_VSS; B : LL_VSS) return LL_VSC is VA : constant VUS_View := To_View (To_LL_VUS (A)); VB : constant VUS_View := To_View (To_LL_VUS (B)); D : VUC_View; begin D.Values := LL_VUC_LL_VUS_Operations.vpkuxum (VA.Values, VB.Values); return To_LL_VSC (To_Vector (D)); end vpkuhum; ------------- -- vpkuwum -- ------------- function vpkuwum (A : LL_VSI; B : LL_VSI) return LL_VSS is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUS_View; begin D.Values := LL_VUS_LL_VUI_Operations.vpkuxum (VA.Values, VB.Values); return To_LL_VSS (To_Vector (D)); end vpkuwum; ----------- -- vpkpx -- ----------- function vpkpx (A : LL_VSI; B : LL_VSI) return LL_VSS is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUS_View; Offset : Vint_Range; P16 : Pixel_16; P32 : Pixel_32; begin for J in 0 .. 3 loop Offset := Vint_Range (J + Integer (Vshort_Range'First)); P32 := To_Pixel (VA.Values (Offset)); P16.T := Unsigned_1 (P32.T mod 2 ** 1); P16.R := Unsigned_5 (Shift_Right (P32.R, 3) mod 2 ** 5); P16.G := Unsigned_5 (Shift_Right (P32.G, 3) mod 2 ** 5); P16.B := Unsigned_5 (Shift_Right (P32.B, 3) mod 2 ** 5); D.Values (Vshort_Range (Offset)) := To_unsigned_short (P16); P32 := To_Pixel (VB.Values (Offset)); P16.T := Unsigned_1 (P32.T mod 2 ** 1); P16.R := Unsigned_5 (Shift_Right (P32.R, 3) mod 2 ** 5); P16.G := Unsigned_5 (Shift_Right (P32.G, 3) mod 2 ** 5); P16.B := Unsigned_5 (Shift_Right (P32.B, 3) mod 2 ** 5); D.Values (Vshort_Range (Offset) + 4) := To_unsigned_short (P16); end loop; return To_LL_VSS (To_Vector (D)); end vpkpx; ------------- -- vpkuhus -- ------------- function vpkuhus (A : LL_VSS; B : LL_VSS) return LL_VSC is VA : constant VUS_View := To_View (To_LL_VUS (A)); VB : constant VUS_View := To_View (To_LL_VUS (B)); D : VUC_View; begin D.Values := LL_VUC_LL_VUS_Operations.vpkuxus (VA.Values, VB.Values); return To_LL_VSC (To_Vector (D)); end vpkuhus; ------------- -- vpkuwus -- ------------- function vpkuwus (A : LL_VSI; B : LL_VSI) return LL_VSS is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUS_View; begin D.Values := LL_VUS_LL_VUI_Operations.vpkuxus (VA.Values, VB.Values); return To_LL_VSS (To_Vector (D)); end vpkuwus; ------------- -- vpkshss -- ------------- function vpkshss (A : LL_VSS; B : LL_VSS) return LL_VSC is VA : constant VSS_View := To_View (A); VB : constant VSS_View := To_View (B); D : VSC_View; begin D.Values := LL_VSC_LL_VSS_Operations.vpksxss (VA.Values, VB.Values); return To_Vector (D); end vpkshss; ------------- -- vpkswss -- ------------- function vpkswss (A : LL_VSI; B : LL_VSI) return LL_VSS is VA : constant VSI_View := To_View (A); VB : constant VSI_View := To_View (B); D : VSS_View; begin D.Values := LL_VSS_LL_VSI_Operations.vpksxss (VA.Values, VB.Values); return To_Vector (D); end vpkswss; ------------- -- vpksxus -- ------------- generic type Signed_Component_Type is range <>; type Signed_Index_Type is range <>; type Signed_Varray_Type is array (Signed_Index_Type) of Signed_Component_Type; type Unsigned_Component_Type is mod <>; type Unsigned_Index_Type is range <>; type Unsigned_Varray_Type is array (Unsigned_Index_Type) of Unsigned_Component_Type; function vpksxus (A : Signed_Varray_Type; B : Signed_Varray_Type) return Unsigned_Varray_Type; function vpksxus (A : Signed_Varray_Type; B : Signed_Varray_Type) return Unsigned_Varray_Type is N : constant Unsigned_Index_Type := Unsigned_Index_Type (Signed_Index_Type'Last); Offset : Unsigned_Index_Type; Signed_Offset : Signed_Index_Type; D : Unsigned_Varray_Type; function Saturate (X : Signed_Component_Type) return Unsigned_Component_Type; -- Saturation, as defined in -- [PIM-4.1 Vector Status and Control Register] -------------- -- Saturate -- -------------- function Saturate (X : Signed_Component_Type) return Unsigned_Component_Type is D : Unsigned_Component_Type; begin D := Unsigned_Component_Type (Signed_Component_Type'Max (Signed_Component_Type (Unsigned_Component_Type'First), Signed_Component_Type'Min (Signed_Component_Type (Unsigned_Component_Type'Last), X))); if Signed_Component_Type (D) /= X then VSCR := Write_Bit (VSCR, SAT_POS, 1); end if; return D; end Saturate; -- Start of processing for vpksxus begin for J in 0 .. N - 1 loop Offset := Unsigned_Index_Type (Integer (J) + Integer (Unsigned_Index_Type'First)); Signed_Offset := Signed_Index_Type (Integer (J) + Integer (Signed_Index_Type'First)); D (Offset) := Saturate (A (Signed_Offset)); D (Offset + N) := Saturate (B (Signed_Offset)); end loop; return D; end vpksxus; ------------- -- vpkshus -- ------------- function vpkshus (A : LL_VSS; B : LL_VSS) return LL_VSC is function vpkshus_Instance is new vpksxus (signed_short, Vshort_Range, Varray_signed_short, unsigned_char, Vchar_Range, Varray_unsigned_char); VA : constant VSS_View := To_View (A); VB : constant VSS_View := To_View (B); D : VUC_View; begin D.Values := vpkshus_Instance (VA.Values, VB.Values); return To_LL_VSC (To_Vector (D)); end vpkshus; ------------- -- vpkswus -- ------------- function vpkswus (A : LL_VSI; B : LL_VSI) return LL_VSS is function vpkswus_Instance is new vpksxus (signed_int, Vint_Range, Varray_signed_int, unsigned_short, Vshort_Range, Varray_unsigned_short); VA : constant VSI_View := To_View (A); VB : constant VSI_View := To_View (B); D : VUS_View; begin D.Values := vpkswus_Instance (VA.Values, VB.Values); return To_LL_VSS (To_Vector (D)); end vpkswus; --------------- -- vperm_4si -- --------------- function vperm_4si (A : LL_VSI; B : LL_VSI; C : LL_VSC) return LL_VSI is VA : constant VUC_View := To_View (To_LL_VUC (A)); VB : constant VUC_View := To_View (To_LL_VUC (B)); VC : constant VUC_View := To_View (To_LL_VUC (C)); J : Vchar_Range; D : VUC_View; begin for N in Vchar_Range'Range loop J := Vchar_Range (Integer (Bits (VC.Values (N), 4, 7)) + Integer (Vchar_Range'First)); 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)); end vperm_4si; ----------- -- vrefp -- ----------- function vrefp (A : LL_VF) return LL_VF is VA : constant VF_View := To_View (A); D : VF_View; begin for J in Vfloat_Range'Range loop D.Values (J) := FP_Recip_Est (VA.Values (J)); end loop; return To_Vector (D); end vrefp; ---------- -- vrlb -- ---------- function vrlb (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VUC_View := To_View (To_LL_VUC (A)); VB : constant VUC_View := To_View (To_LL_VUC (B)); D : VUC_View; begin D.Values := LL_VUC_Operations.vrlx (VA.Values, VB.Values, ROTL'Access); return To_LL_VSC (To_Vector (D)); end vrlb; ---------- -- vrlh -- ---------- function vrlh (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VUS_View := To_View (To_LL_VUS (A)); VB : constant VUS_View := To_View (To_LL_VUS (B)); D : VUS_View; begin D.Values := LL_VUS_Operations.vrlx (VA.Values, VB.Values, ROTL'Access); return To_LL_VSS (To_Vector (D)); end vrlh; ---------- -- vrlw -- ---------- function vrlw (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUI_View; begin D.Values := LL_VUI_Operations.vrlx (VA.Values, VB.Values, ROTL'Access); return To_LL_VSI (To_Vector (D)); end vrlw; ----------- -- vrfin -- ----------- function vrfin (A : LL_VF) return LL_VF is VA : constant VF_View := To_View (A); D : VF_View; begin for J in Vfloat_Range'Range loop D.Values (J) := C_float (Rnd_To_FPI_Near (F64 (VA.Values (J)))); end loop; return To_Vector (D); end vrfin; --------------- -- vrsqrtefp -- --------------- function vrsqrtefp (A : LL_VF) return LL_VF is VA : constant VF_View := To_View (A); D : VF_View; begin for J in Vfloat_Range'Range loop D.Values (J) := Recip_SQRT_Est (VA.Values (J)); end loop; return To_Vector (D); end vrsqrtefp; -------------- -- vsel_4si -- -------------- function vsel_4si (A : LL_VSI; B : LL_VSI; C : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); VC : constant VUI_View := To_View (To_LL_VUI (C)); D : VUI_View; begin for J in Vint_Range'Range loop D.Values (J) := ((not VC.Values (J)) and VA.Values (J)) or (VC.Values (J) and VB.Values (J)); end loop; return To_LL_VSI (To_Vector (D)); end vsel_4si; ---------- -- vslb -- ---------- function vslb (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VUC_View := To_View (To_LL_VUC (A)); VB : constant VUC_View := To_View (To_LL_VUC (B)); D : VUC_View; begin D.Values := LL_VUC_Operations.vsxx (VA.Values, VB.Values, Shift_Left'Access); return To_LL_VSC (To_Vector (D)); end vslb; ---------- -- vslh -- ---------- function vslh (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VUS_View := To_View (To_LL_VUS (A)); VB : constant VUS_View := To_View (To_LL_VUS (B)); D : VUS_View; begin D.Values := LL_VUS_Operations.vsxx (VA.Values, VB.Values, Shift_Left'Access); return To_LL_VSS (To_Vector (D)); end vslh; ---------- -- vslw -- ---------- function vslw (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUI_View; begin D.Values := LL_VUI_Operations.vsxx (VA.Values, VB.Values, Shift_Left'Access); return To_LL_VSI (To_Vector (D)); end vslw; ---------------- -- vsldoi_4si -- ---------------- function vsldoi_4si (A : LL_VSI; B : LL_VSI; C : c_int) return LL_VSI is VA : constant VUC_View := To_View (To_LL_VUC (A)); VB : constant VUC_View := To_View (To_LL_VUC (B)); Offset : c_int; Bound : c_int; D : VUC_View; begin for J in Vchar_Range'Range loop Offset := c_int (J) + C; Bound := c_int (Vchar_Range'First) + c_int (Varray_unsigned_char'Length); if Offset < Bound then D.Values (J) := VA.Values (Vchar_Range (Offset)); else D.Values (J) := VB.Values (Vchar_Range (Offset - Bound + c_int (Vchar_Range'First))); end if; end loop; return To_LL_VSI (To_Vector (D)); end vsldoi_4si; ---------------- -- vsldoi_8hi -- ---------------- function vsldoi_8hi (A : LL_VSS; B : LL_VSS; C : c_int) return LL_VSS is begin return To_LL_VSS (vsldoi_4si (To_LL_VSI (A), To_LL_VSI (B), C)); end vsldoi_8hi; ----------------- -- vsldoi_16qi -- ----------------- function vsldoi_16qi (A : LL_VSC; B : LL_VSC; C : c_int) return LL_VSC is begin return To_LL_VSC (vsldoi_4si (To_LL_VSI (A), To_LL_VSI (B), C)); end vsldoi_16qi; ---------------- -- vsldoi_4sf -- ---------------- function vsldoi_4sf (A : LL_VF; B : LL_VF; C : c_int) return LL_VF is begin return To_LL_VF (vsldoi_4si (To_LL_VSI (A), To_LL_VSI (B), C)); end vsldoi_4sf; --------- -- vsl -- --------- function vsl (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUI_View; M : constant Natural := Natural (Bits (VB.Values (Vint_Range'Last), 29, 31)); -- [PIM-4.4 vec_sll] "Note that the three low-order byte elements in B -- must be the same. Otherwise the value placed into D is undefined." -- ??? Shall we add a optional check for B? begin for J in Vint_Range'Range loop D.Values (J) := 0; D.Values (J) := D.Values (J) + Shift_Left (VA.Values (J), M); if J /= Vint_Range'Last then D.Values (J) := D.Values (J) + Shift_Right (VA.Values (J + 1), signed_int'Size - M); end if; end loop; return To_LL_VSI (To_Vector (D)); end vsl; ---------- -- vslo -- ---------- function vslo (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUC_View := To_View (To_LL_VUC (A)); VB : constant VUC_View := To_View (To_LL_VUC (B)); D : VUC_View; M : constant Natural := Natural (Bits (VB.Values (Vchar_Range'Last), 1, 4)); J : Natural; begin for N in Vchar_Range'Range loop J := Natural (N) + M; 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)); end vslo; ------------ -- vspltb -- ------------ function vspltb (A : LL_VSC; B : c_int) return LL_VSC is VA : constant VSC_View := To_View (A); D : VSC_View; begin D.Values := LL_VSC_Operations.vspltx (VA.Values, B); return To_Vector (D); end vspltb; ------------ -- vsplth -- ------------ function vsplth (A : LL_VSS; B : c_int) return LL_VSS is VA : constant VSS_View := To_View (A); D : VSS_View; begin D.Values := LL_VSS_Operations.vspltx (VA.Values, B); return To_Vector (D); end vsplth; ------------ -- vspltw -- ------------ function vspltw (A : LL_VSI; B : c_int) return LL_VSI is VA : constant VSI_View := To_View (A); D : VSI_View; begin D.Values := LL_VSI_Operations.vspltx (VA.Values, B); return To_Vector (D); end vspltw; -------------- -- vspltisb -- -------------- function vspltisb (A : c_int) return LL_VSC is D : VSC_View; begin D.Values := LL_VSC_Operations.vspltisx (A); return To_Vector (D); end vspltisb; -------------- -- vspltish -- -------------- function vspltish (A : c_int) return LL_VSS is D : VSS_View; begin D.Values := LL_VSS_Operations.vspltisx (A); return To_Vector (D); end vspltish; -------------- -- vspltisw -- -------------- function vspltisw (A : c_int) return LL_VSI is D : VSI_View; begin D.Values := LL_VSI_Operations.vspltisx (A); return To_Vector (D); end vspltisw; ---------- -- vsrb -- ---------- function vsrb (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VUC_View := To_View (To_LL_VUC (A)); VB : constant VUC_View := To_View (To_LL_VUC (B)); D : VUC_View; begin D.Values := LL_VUC_Operations.vsxx (VA.Values, VB.Values, Shift_Right'Access); return To_LL_VSC (To_Vector (D)); end vsrb; ---------- -- vsrh -- ---------- function vsrh (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VUS_View := To_View (To_LL_VUS (A)); VB : constant VUS_View := To_View (To_LL_VUS (B)); D : VUS_View; begin D.Values := LL_VUS_Operations.vsxx (VA.Values, VB.Values, Shift_Right'Access); return To_LL_VSS (To_Vector (D)); end vsrh; ---------- -- vsrw -- ---------- function vsrw (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUI_View; begin D.Values := LL_VUI_Operations.vsxx (VA.Values, VB.Values, Shift_Right'Access); return To_LL_VSI (To_Vector (D)); end vsrw; ----------- -- vsrab -- ----------- function vsrab (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VSC_View := To_View (A); VB : constant VSC_View := To_View (B); D : VSC_View; begin D.Values := LL_VSC_Operations.vsrax (VA.Values, VB.Values, Shift_Right_A'Access); return To_Vector (D); end vsrab; ----------- -- vsrah -- ----------- function vsrah (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VSS_View := To_View (A); VB : constant VSS_View := To_View (B); D : VSS_View; begin D.Values := LL_VSS_Operations.vsrax (VA.Values, VB.Values, Shift_Right_A'Access); return To_Vector (D); end vsrah; ----------- -- vsraw -- ----------- function vsraw (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VSI_View := To_View (A); VB : constant VSI_View := To_View (B); D : VSI_View; begin D.Values := LL_VSI_Operations.vsrax (VA.Values, VB.Values, Shift_Right_A'Access); return To_Vector (D); end vsraw; --------- -- vsr -- --------- function vsr (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); M : constant Natural := Natural (Bits (VB.Values (Vint_Range'Last), 29, 31)); D : VUI_View; begin for J in Vint_Range'Range loop D.Values (J) := 0; D.Values (J) := D.Values (J) + Shift_Right (VA.Values (J), M); if J /= Vint_Range'First then D.Values (J) := D.Values (J) + Shift_Left (VA.Values (J - 1), signed_int'Size - M); end if; end loop; return To_LL_VSI (To_Vector (D)); end vsr; ---------- -- vsro -- ---------- function vsro (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUC_View := To_View (To_LL_VUC (A)); VB : constant VUC_View := To_View (To_LL_VUC (B)); M : constant Natural := Natural (Bits (VB.Values (Vchar_Range'Last), 1, 4)); J : Natural; D : VUC_View; begin for N in Vchar_Range'Range loop J := Natural (N) - M; if J >= Natural (Vchar_Range'First) then D.Values (N) := VA.Values (Vchar_Range (J)); else D.Values (N) := 0; end if; end loop; return To_LL_VSI (To_Vector (D)); end vsro; ---------- -- stvx -- ---------- procedure stvx (A : LL_VSI; B : c_int; C : c_ptr) is -- 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). 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; ------------ -- stvewx -- ------------ procedure stvebx (A : LL_VSC; B : c_int; C : c_ptr) is VA : constant VSC_View := To_View (A); begin LL_VSC_Operations.stvexx (VA.Values, B, C); end stvebx; ------------ -- stvehx -- ------------ procedure stvehx (A : LL_VSS; B : c_int; C : c_ptr) is VA : constant VSS_View := To_View (A); begin LL_VSS_Operations.stvexx (VA.Values, B, C); end stvehx; ------------ -- stvewx -- ------------ procedure stvewx (A : LL_VSI; B : c_int; C : c_ptr) is VA : constant VSI_View := To_View (A); begin LL_VSI_Operations.stvexx (VA.Values, B, C); end stvewx; ----------- -- stvxl -- ----------- procedure stvxl (A : LL_VSI; B : c_int; C : c_ptr) renames stvx; ------------- -- vsububm -- ------------- function vsububm (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VUC_View := To_View (To_LL_VUC (A)); VB : constant VUC_View := To_View (To_LL_VUC (B)); D : VUC_View; begin D.Values := LL_VUC_Operations.vsubuxm (VA.Values, VB.Values); return To_LL_VSC (To_Vector (D)); end vsububm; ------------- -- vsubuhm -- ------------- function vsubuhm (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VUS_View := To_View (To_LL_VUS (A)); VB : constant VUS_View := To_View (To_LL_VUS (B)); D : VUS_View; begin D.Values := LL_VUS_Operations.vsubuxm (VA.Values, VB.Values); return To_LL_VSS (To_Vector (D)); end vsubuhm; ------------- -- vsubuwm -- ------------- function vsubuwm (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUI_View; begin D.Values := LL_VUI_Operations.vsubuxm (VA.Values, VB.Values); return To_LL_VSI (To_Vector (D)); end vsubuwm; ------------ -- vsubfp -- ------------ function vsubfp (A : LL_VF; B : LL_VF) return LL_VF is VA : constant VF_View := To_View (A); VB : constant VF_View := To_View (B); D : VF_View; begin for J in Vfloat_Range'Range loop D.Values (J) := NJ_Truncate (NJ_Truncate (VA.Values (J)) - NJ_Truncate (VB.Values (J))); end loop; return To_Vector (D); end vsubfp; ------------- -- vsubcuw -- ------------- function vsubcuw (A : LL_VSI; B : LL_VSI) return LL_VSI is Subst_Result : SI64; VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUI_View; begin for J in Vint_Range'Range loop Subst_Result := SI64 (VA.Values (J)) - SI64 (VB.Values (J)); D.Values (J) := (if Subst_Result < SI64 (unsigned_int'First) then 0 else 1); end loop; return To_LL_VSI (To_Vector (D)); end vsubcuw; ------------- -- vsububs -- ------------- function vsububs (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VUC_View := To_View (To_LL_VUC (A)); VB : constant VUC_View := To_View (To_LL_VUC (B)); D : VUC_View; begin D.Values := LL_VUC_Operations.vsubuxs (VA.Values, VB.Values); return To_LL_VSC (To_Vector (D)); end vsububs; ------------- -- vsubsbs -- ------------- function vsubsbs (A : LL_VSC; B : LL_VSC) return LL_VSC is VA : constant VSC_View := To_View (A); VB : constant VSC_View := To_View (B); D : VSC_View; begin D.Values := LL_VSC_Operations.vsubsxs (VA.Values, VB.Values); return To_Vector (D); end vsubsbs; ------------- -- vsubuhs -- ------------- function vsubuhs (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VUS_View := To_View (To_LL_VUS (A)); VB : constant VUS_View := To_View (To_LL_VUS (B)); D : VUS_View; begin D.Values := LL_VUS_Operations.vsubuxs (VA.Values, VB.Values); return To_LL_VSS (To_Vector (D)); end vsubuhs; ------------- -- vsubshs -- ------------- function vsubshs (A : LL_VSS; B : LL_VSS) return LL_VSS is VA : constant VSS_View := To_View (A); VB : constant VSS_View := To_View (B); D : VSS_View; begin D.Values := LL_VSS_Operations.vsubsxs (VA.Values, VB.Values); return To_Vector (D); end vsubshs; ------------- -- vsubuws -- ------------- function vsubuws (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUI_View; begin D.Values := LL_VUI_Operations.vsubuxs (VA.Values, VB.Values); return To_LL_VSI (To_Vector (D)); end vsubuws; ------------- -- vsubsws -- ------------- function vsubsws (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VSI_View := To_View (A); VB : constant VSI_View := To_View (B); D : VSI_View; begin D.Values := LL_VSI_Operations.vsubsxs (VA.Values, VB.Values); return To_Vector (D); end vsubsws; -------------- -- vsum4ubs -- -------------- function vsum4ubs (A : LL_VSC; B : LL_VSI) return LL_VSI is VA : constant VUC_View := To_View (To_LL_VUC (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); Offset : Vchar_Range; D : VUI_View; begin for J in 0 .. 3 loop Offset := Vchar_Range (4 * J + Integer (Vchar_Range'First)); D.Values (Vint_Range (J + Integer (Vint_Range'First))) := LL_VUI_Operations.Saturate (UI64 (VA.Values (Offset)) + UI64 (VA.Values (Offset + 1)) + UI64 (VA.Values (Offset + 2)) + UI64 (VA.Values (Offset + 3)) + UI64 (VB.Values (Vint_Range (J + Integer (Vint_Range'First))))); end loop; return To_LL_VSI (To_Vector (D)); end vsum4ubs; -------------- -- vsum4sbs -- -------------- function vsum4sbs (A : LL_VSC; B : LL_VSI) return LL_VSI is VA : constant VSC_View := To_View (A); VB : constant VSI_View := To_View (B); Offset : Vchar_Range; D : VSI_View; begin for J in 0 .. 3 loop Offset := Vchar_Range (4 * J + Integer (Vchar_Range'First)); D.Values (Vint_Range (J + Integer (Vint_Range'First))) := LL_VSI_Operations.Saturate (SI64 (VA.Values (Offset)) + SI64 (VA.Values (Offset + 1)) + SI64 (VA.Values (Offset + 2)) + SI64 (VA.Values (Offset + 3)) + SI64 (VB.Values (Vint_Range (J + Integer (Vint_Range'First))))); end loop; return To_Vector (D); end vsum4sbs; -------------- -- vsum4shs -- -------------- function vsum4shs (A : LL_VSS; B : LL_VSI) return LL_VSI is VA : constant VSS_View := To_View (A); VB : constant VSI_View := To_View (B); Offset : Vshort_Range; D : VSI_View; begin for J in 0 .. 3 loop Offset := Vshort_Range (2 * J + Integer (Vchar_Range'First)); D.Values (Vint_Range (J + Integer (Vint_Range'First))) := LL_VSI_Operations.Saturate (SI64 (VA.Values (Offset)) + SI64 (VA.Values (Offset + 1)) + SI64 (VB.Values (Vint_Range (J + Integer (Vint_Range'First))))); end loop; return To_Vector (D); end vsum4shs; -------------- -- vsum2sws -- -------------- function vsum2sws (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VSI_View := To_View (A); VB : constant VSI_View := To_View (B); Offset : Vint_Range; D : VSI_View; begin for J in 0 .. 1 loop Offset := Vint_Range (2 * J + Integer (Vchar_Range'First)); D.Values (Offset) := 0; D.Values (Offset + 1) := LL_VSI_Operations.Saturate (SI64 (VA.Values (Offset)) + SI64 (VA.Values (Offset + 1)) + SI64 (VB.Values (Vint_Range (Offset + 1)))); end loop; return To_Vector (D); end vsum2sws; ------------- -- vsumsws -- ------------- function vsumsws (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VSI_View := To_View (A); VB : constant VSI_View := To_View (B); D : VSI_View; Sum_Buffer : SI64 := 0; begin for J in Vint_Range'Range loop D.Values (J) := 0; Sum_Buffer := Sum_Buffer + SI64 (VA.Values (J)); end loop; Sum_Buffer := Sum_Buffer + SI64 (VB.Values (Vint_Range'Last)); D.Values (Vint_Range'Last) := LL_VSI_Operations.Saturate (Sum_Buffer); return To_Vector (D); end vsumsws; ----------- -- vrfiz -- ----------- function vrfiz (A : LL_VF) return LL_VF is VA : constant VF_View := To_View (A); D : VF_View; begin for J in Vfloat_Range'Range loop D.Values (J) := C_float (Rnd_To_FPI_Trunc (F64 (VA.Values (J)))); end loop; return To_Vector (D); end vrfiz; ------------- -- vupkhsb -- ------------- function vupkhsb (A : LL_VSC) return LL_VSS is VA : constant VSC_View := To_View (A); D : VSS_View; begin D.Values := LL_VSC_LL_VSS_Operations.vupkxsx (VA.Values, 0); return To_Vector (D); end vupkhsb; ------------- -- vupkhsh -- ------------- function vupkhsh (A : LL_VSS) return LL_VSI is VA : constant VSS_View := To_View (A); D : VSI_View; begin D.Values := LL_VSS_LL_VSI_Operations.vupkxsx (VA.Values, 0); return To_Vector (D); end vupkhsh; ------------- -- vupkxpx -- ------------- function vupkxpx (A : LL_VSS; Offset : Natural) return LL_VSI; -- For vupkhpx and vupklpx (depending on Offset) function vupkxpx (A : LL_VSS; Offset : Natural) return LL_VSI is VA : constant VUS_View := To_View (To_LL_VUS (A)); K : Vshort_Range; D : VUI_View; P16 : Pixel_16; P32 : Pixel_32; function Sign_Extend (X : Unsigned_1) return unsigned_char; function Sign_Extend (X : Unsigned_1) return unsigned_char is begin if X = 1 then return 16#FF#; else return 16#00#; end if; end Sign_Extend; begin for J in Vint_Range'Range loop K := Vshort_Range (Integer (J) - Integer (Vint_Range'First) + Integer (Vshort_Range'First) + Offset); P16 := To_Pixel (VA.Values (K)); P32.T := Sign_Extend (P16.T); P32.R := unsigned_char (P16.R); P32.G := unsigned_char (P16.G); P32.B := unsigned_char (P16.B); D.Values (J) := To_unsigned_int (P32); end loop; return To_LL_VSI (To_Vector (D)); end vupkxpx; ------------- -- vupkhpx -- ------------- function vupkhpx (A : LL_VSS) return LL_VSI is begin return vupkxpx (A, 0); end vupkhpx; ------------- -- vupklsb -- ------------- function vupklsb (A : LL_VSC) return LL_VSS is VA : constant VSC_View := To_View (A); D : VSS_View; begin D.Values := LL_VSC_LL_VSS_Operations.vupkxsx (VA.Values, Varray_signed_short'Length); return To_Vector (D); end vupklsb; ------------- -- vupklsh -- ------------- function vupklsh (A : LL_VSS) return LL_VSI is VA : constant VSS_View := To_View (A); D : VSI_View; begin D.Values := LL_VSS_LL_VSI_Operations.vupkxsx (VA.Values, Varray_signed_int'Length); return To_Vector (D); end vupklsh; ------------- -- vupklpx -- ------------- function vupklpx (A : LL_VSS) return LL_VSI is begin return vupkxpx (A, Varray_signed_int'Length); end vupklpx; ---------- -- vxor -- ---------- function vxor (A : LL_VSI; B : LL_VSI) return LL_VSI is VA : constant VUI_View := To_View (To_LL_VUI (A)); VB : constant VUI_View := To_View (To_LL_VUI (B)); D : VUI_View; begin for J in Vint_Range'Range loop D.Values (J) := VA.Values (J) xor VB.Values (J); end loop; return To_LL_VSI (To_Vector (D)); end vxor; ---------------- -- vcmpequb_p -- ---------------- function vcmpequb_p (A : c_int; B : LL_VSC; C : LL_VSC) return c_int is D : LL_VSC; begin D := vcmpequb (B, C); return LL_VSC_Operations.Check_CR6 (A, To_View (D).Values); end vcmpequb_p; ---------------- -- vcmpequh_p -- ---------------- function vcmpequh_p (A : c_int; B : LL_VSS; C : LL_VSS) return c_int is D : LL_VSS; begin D := vcmpequh (B, C); return LL_VSS_Operations.Check_CR6 (A, To_View (D).Values); end vcmpequh_p; ---------------- -- vcmpequw_p -- ---------------- function vcmpequw_p (A : c_int; B : LL_VSI; C : LL_VSI) return c_int is D : LL_VSI; begin D := vcmpequw (B, C); return LL_VSI_Operations.Check_CR6 (A, To_View (D).Values); end vcmpequw_p; ---------------- -- vcmpeqfp_p -- ---------------- function vcmpeqfp_p (A : c_int; B : LL_VF; C : LL_VF) return c_int is D : LL_VSI; begin D := vcmpeqfp (B, C); return LL_VSI_Operations.Check_CR6 (A, To_View (D).Values); end vcmpeqfp_p; ---------------- -- vcmpgtub_p -- ---------------- function vcmpgtub_p (A : c_int; B : LL_VSC; C : LL_VSC) return c_int is D : LL_VSC; begin D := vcmpgtub (B, C); return LL_VSC_Operations.Check_CR6 (A, To_View (D).Values); end vcmpgtub_p; ---------------- -- vcmpgtuh_p -- ---------------- function vcmpgtuh_p (A : c_int; B : LL_VSS; C : LL_VSS) return c_int is D : LL_VSS; begin D := vcmpgtuh (B, C); return LL_VSS_Operations.Check_CR6 (A, To_View (D).Values); end vcmpgtuh_p; ---------------- -- vcmpgtuw_p -- ---------------- function vcmpgtuw_p (A : c_int; B : LL_VSI; C : LL_VSI) return c_int is D : LL_VSI; begin D := vcmpgtuw (B, C); return LL_VSI_Operations.Check_CR6 (A, To_View (D).Values); end vcmpgtuw_p; ---------------- -- vcmpgtsb_p -- ---------------- function vcmpgtsb_p (A : c_int; B : LL_VSC; C : LL_VSC) return c_int is D : LL_VSC; begin D := vcmpgtsb (B, C); return LL_VSC_Operations.Check_CR6 (A, To_View (D).Values); end vcmpgtsb_p; ---------------- -- vcmpgtsh_p -- ---------------- function vcmpgtsh_p (A : c_int; B : LL_VSS; C : LL_VSS) return c_int is D : LL_VSS; begin D := vcmpgtsh (B, C); return LL_VSS_Operations.Check_CR6 (A, To_View (D).Values); end vcmpgtsh_p; ---------------- -- vcmpgtsw_p -- ---------------- function vcmpgtsw_p (A : c_int; B : LL_VSI; C : LL_VSI) return c_int is D : LL_VSI; begin D := vcmpgtsw (B, C); return LL_VSI_Operations.Check_CR6 (A, To_View (D).Values); end vcmpgtsw_p; ---------------- -- vcmpgefp_p -- ---------------- function vcmpgefp_p (A : c_int; B : LL_VF; C : LL_VF) return c_int is D : LL_VSI; begin D := vcmpgefp (B, C); return LL_VSI_Operations.Check_CR6 (A, To_View (D).Values); end vcmpgefp_p; ---------------- -- vcmpgtfp_p -- ---------------- function vcmpgtfp_p (A : c_int; B : LL_VF; C : LL_VF) return c_int is D : LL_VSI; begin D := vcmpgtfp (B, C); return LL_VSI_Operations.Check_CR6 (A, To_View (D).Values); end vcmpgtfp_p; ---------------- -- vcmpbfp_p -- ---------------- function vcmpbfp_p (A : c_int; B : LL_VF; C : LL_VF) return c_int is D : VSI_View; begin D := To_View (vcmpbfp (B, C)); for J in Vint_Range'Range loop -- vcmpbfp is not returning the usual bool vector; do the conversion 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); end vcmpbfp_p; end GNAT.Altivec.Low_Level_Vectors;
Go to most recent revision | Compare with Previous | Blame | View Log