------------------------------------------------------------------------------
--                                                                          --
--                         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
            if A (K) /= Component_Type'First then
               D (K) := abs (A (K));
            else
               D (K) := Component_Type'First;
            end if;
         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
            if A (J) > B (J) then
               D (J) := Bool_True;
            else
               D (J) := Bool_False;
            end if;
         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
            if A (J) > B (J) then
               D (J) := A (J);
            else
               D (J) := B (J);
            end if;
         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
            if A (J) < B (J) then
               D (J) := A (J);
            else
               D (J) := B (J);
            end if;
         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 (D (J) = Bool_True);
            Any_Element := Any_Element or  (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
            if A (J) = B (J) then
               D (J) := Bool_True;
            else
               D (J) := Bool_False;
            end if;
         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
            if A (J) > B (J) then
               D (J) := Bool_True;
            else
               D (J) := Bool_False;
            end if;
         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
            if A (J) > B (J) then
               D (J) := A (J);
            else
               D (J) := B (J);
            end if;
         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
            if A (J) < B (J) then
               D (J) := A (J);
            else
               D (J) := B (J);
            end if;
         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 (D (J) = Bool_True);
            Any_Element := Any_Element or  (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
            if Use_Even_Components then
               Offset := Index_Type (2 * J + Integer (Index_Type'First));
            else
               Offset := Index_Type (2 * J + 1 + Integer (Index_Type'First));
            end if;

            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
            if Use_Even_Components then
               Offset := Index_Type (2 * J + Integer (Index_Type'First));
            else
               Offset := Index_Type (2 * J + 1 + Integer (Index_Type'First));
            end if;

            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
         if X < 0.0 then
            D := -0.0;
         else
            D := 0.0;
         end if;
      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);
         if Rnd_To_FPI_Trunc (Ceiling / 2.0) * 2.0 = Ceiling then
            Result := Ceiling;
         else
            Result := Ceiling - 1.0;
         end if;
      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));

         if Addition_Result > UI64 (unsigned_int'Last) then
            D.Values (J) := 1;
         else
            D.Values (J) := 0;
         end if;
      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
            if NJ_Truncate (VA.Values (J))
              <= NJ_Truncate (VB.Values (J)) then
               D.Values (K) := Write_Bit (D.Values (K), 0, 0);
            else
               D.Values (K) := Write_Bit (D.Values (K), 0, 1);
            end if;

            if NJ_Truncate (VA.Values (J))
              >= -NJ_Truncate (VB.Values (J)) then
               D.Values (K) := Write_Bit (D.Values (K), 1, 0);
            else
               D.Values (K) := Write_Bit (D.Values (K), 1, 1);
            end if;
         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;
      K  : Vint_Range;

   begin
      for J in Varray_float'Range loop
         K := Vint_Range (J);

         if VA.Values (J) = VB.Values (J) then
            D.Values (K) := unsigned_int'Last;
         else
            D.Values (K) := 0;
         end if;
      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;
      K : Vint_Range;

   begin
      for J in Varray_float'Range loop
         K := Vint_Range (J);

         if VA.Values (J) >= VB.Values (J) then
            D.Values (K) := Signed_Bool_True;
         else
            D.Values (K) := Signed_Bool_False;
         end if;
      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;
      K  : Vint_Range;

   begin
      for J in Varray_float'Range loop
         K := Vint_Range (J);

         if NJ_Truncate (VA.Values (J))
           > NJ_Truncate (VB.Values (J)) then
            D.Values (K) := Signed_Bool_True;
         else
            D.Values (K) := Signed_Bool_False;
         end if;
      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
         if VA.Values (J) > VB.Values (J) then
            D.Values (J) := VA.Values (J);
         else
            D.Values (J) := VB.Values (J);
         end if;
      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
         if VA.Values (J) < VB.Values (J) then
            D.Values (J) := VA.Values (J);
         else
            D.Values (J) := VB.Values (J);
         end if;
      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));

         if Bits (VC.Values (N), 3, 3) = 0 then
            D.Values (N) := VA.Values (J);
         else
            D.Values (N) := VB.Values (J);
         end if;
      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;

         if J <= Natural (Vchar_Range'Last) 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 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));

         if Subst_Result < SI64 (unsigned_int'First) then
            D.Values (J) := 0;
         else
            D.Values (J) := 1;
         end if;
      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
         if D.Values (J) = 0 then
            D.Values (J) := Signed_Bool_False;
         else
            D.Values (J) := Signed_Bool_True;
         end if;
      end loop;

      return LL_VSI_Operations.Check_CR6 (A, D.Values);
   end vcmpbfp_p;

end GNAT.Altivec.Low_Level_Vectors;