gcc/ada/g-alleve.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --       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        --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                         (Soft Binding Version)                           --
   9 --                                                                          --
  10 --          Copyright (C) 2004-2009, Free Software Foundation, Inc.         --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  18 --                                                                          --
  19 -- As a special exception under Section 7 of GPL version 3, you are granted --
  20 -- additional permissions described in the GCC Runtime Library Exception,   --
  21 -- version 3.1, as published by the Free Software Foundation.               --
  22 --                                                                          --
  23 -- You should have received a copy of the GNU General Public License and    --
  24 -- a copy of the GCC Runtime Library Exception along with this program;     --
  25 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  26 -- <http://www.gnu.org/licenses/>.                                          --
  27 --                                                                          --
  28 -- GNAT was originally developed  by the GNAT team at  New York University. --
  29 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  30 --                                                                          --
  31 ------------------------------------------------------------------------------
  32
  33 --  ??? What is exactly needed for the soft case is still a bit unclear on
  34 --  some accounts. The expected functional equivalence with the Hard binding
  35 --  might require tricky things to be done on some targets.
  36
  37 --  Examples that come to mind are endianness variations or differences in the
  38 --  base FP model while we need the operation results to be the same as what
  39 --  the real AltiVec instructions would do on a PowerPC.
  40
  41 with Ada.Numerics.Generic_Elementary_Functions;
  42 with Interfaces;                       use Interfaces;
  43 with System.Storage_Elements;          use System.Storage_Elements;
  44
  45 with GNAT.Altivec.Conversions;         use  GNAT.Altivec.Conversions;
  46 with GNAT.Altivec.Low_Level_Interface; use  GNAT.Altivec.Low_Level_Interface;
  47
  48 package body GNAT.Altivec.Low_Level_Vectors is
  49
  50    --  Pixel types. As defined in [PIM-2.1 Data types]:
  51    --  A 16-bit pixel is 1/5/5/5;
  52    --  A 32-bit pixel is 8/8/8/8.
  53    --  We use the following records as an intermediate representation, to
  54    --  ease computation.
  55
  56    type Unsigned_1 is mod 2 ** 1;
  57    type Unsigned_5 is mod 2 ** 5;
  58
  59    type Pixel_16 is record
  60       T : Unsigned_1;
  61       R : Unsigned_5;
  62       G : Unsigned_5;
  63       B : Unsigned_5;
  64    end record;
  65
  66    type Pixel_32 is record
  67       T : unsigned_char;
  68       R : unsigned_char;
  69       G : unsigned_char;
  70       B : unsigned_char;
  71    end record;
  72
  73    --  Conversions to/from the pixel records to the integer types that are
  74    --  actually stored into the pixel vectors:
  75
  76    function To_Pixel (Source : unsigned_short) return Pixel_16;
  77    function To_unsigned_short (Source : Pixel_16) return unsigned_short;
  78    function To_Pixel (Source : unsigned_int) return Pixel_32;
  79    function To_unsigned_int (Source : Pixel_32) return unsigned_int;
  80
  81    package C_float_Operations is
  82      new Ada.Numerics.Generic_Elementary_Functions (C_float);
  83
  84    --  Model of the Vector Status and Control Register (VSCR), as
  85    --  defined in [PIM-4.1 Vector Status and Control Register]:
  86
  87    VSCR : unsigned_int;
  88
  89    --  Positions of the flags in VSCR(0 .. 31):
  90
  91    NJ_POS   : constant := 15;
  92    SAT_POS  : constant := 31;
  93
  94    --  To control overflows, integer operations are done on 64-bit types:
  95
  96    SINT64_MIN : constant := -2 ** 63;
  97    SINT64_MAX : constant := 2 ** 63 - 1;
  98    UINT64_MAX : constant := 2 ** 64 - 1;
  99
 100    type SI64 is range SINT64_MIN .. SINT64_MAX;
 101    type UI64 is mod UINT64_MAX + 1;
 102
 103    type F64 is digits 15
 104      range -16#0.FFFF_FFFF_FFFF_F8#E+256 .. 16#0.FFFF_FFFF_FFFF_F8#E+256;
 105
 106    function Bits
 107      (X    : unsigned_int;
 108       Low  : Natural;
 109       High : Natural) return unsigned_int;
 110
 111    function Bits
 112      (X    : unsigned_short;
 113       Low  : Natural;
 114       High : Natural) return unsigned_short;
 115
 116    function Bits
 117      (X    : unsigned_char;
 118       Low  : Natural;
 119       High : Natural) return unsigned_char;
 120
 121    function Write_Bit
 122      (X     : unsigned_int;
 123       Where : Natural;
 124       Value : Unsigned_1) return unsigned_int;
 125
 126    function Write_Bit
 127      (X     : unsigned_short;
 128       Where : Natural;
 129       Value : Unsigned_1) return unsigned_short;
 130
 131    function Write_Bit
 132      (X     : unsigned_char;
 133       Where : Natural;
 134       Value : Unsigned_1) return unsigned_char;
 135
 136    function NJ_Truncate (X : C_float) return C_float;
 137    --  If NJ and A is a denormalized number, return zero
 138
 139    function Bound_Align
 140      (X : Integer_Address;
 141       Y : Integer_Address) return Integer_Address;
 142    --  [PIM-4.3 Notations and Conventions]
 143    --  Align X in a y-byte boundary and return the result
 144
 145    function Rnd_To_FP_Nearest (X : F64) return C_float;
 146    --  [PIM-4.3 Notations and Conventions]
 147
 148    function Rnd_To_FPI_Near (X : F64) return F64;
 149
 150    function Rnd_To_FPI_Trunc (X : F64) return F64;
 151
 152    function FP_Recip_Est (X : C_float) return C_float;
 153    --  [PIM-4.3 Notations and Conventions]
 154    --  12-bit accurate floating-point estimate of 1/x
 155
 156    function ROTL
 157      (Value  : unsigned_char;
 158       Amount : Natural) return unsigned_char;
 159    --  [PIM-4.3 Notations and Conventions]
 160    --  Rotate left
 161
 162    function ROTL
 163      (Value  : unsigned_short;
 164       Amount : Natural) return unsigned_short;
 165
 166    function ROTL
 167      (Value  : unsigned_int;
 168       Amount : Natural) return unsigned_int;
 169
 170    function Recip_SQRT_Est (X : C_float) return C_float;
 171
 172    function Shift_Left
 173      (Value  : unsigned_char;
 174       Amount : Natural) return unsigned_char;
 175    --  [PIM-4.3 Notations and Conventions]
 176    --  Shift left
 177
 178    function Shift_Left
 179      (Value  : unsigned_short;
 180       Amount : Natural) return unsigned_short;
 181
 182    function Shift_Left
 183      (Value  : unsigned_int;
 184       Amount : Natural) return unsigned_int;
 185
 186    function Shift_Right
 187      (Value  : unsigned_char;
 188       Amount : Natural) return unsigned_char;
 189    --  [PIM-4.3 Notations and Conventions]
 190    --  Shift Right
 191
 192    function Shift_Right
 193      (Value  : unsigned_short;
 194       Amount : Natural) return unsigned_short;
 195
 196    function Shift_Right
 197      (Value  : unsigned_int;
 198       Amount : Natural) return unsigned_int;
 199
 200    Signed_Bool_False : constant := 0;
 201    Signed_Bool_True  : constant := -1;
 202
 203    ------------------------------
 204    -- Signed_Operations (spec) --
 205    ------------------------------
 206
 207    generic
 208       type Component_Type is range <>;
 209       type Index_Type is range <>;
 210       type Varray_Type is array (Index_Type) of Component_Type;
 211
 212    package Signed_Operations is
 213
 214       function Modular_Result (X : SI64) return Component_Type;
 215
 216       function Saturate (X : SI64) return Component_Type;
 217
 218       function Saturate (X : F64) return Component_Type;
 219
 220       function Sign_Extend (X : c_int) return Component_Type;
 221       --  [PIM-4.3 Notations and Conventions]
 222       --  Sign-extend X
 223
 224       function abs_vxi (A : Varray_Type) return Varray_Type;
 225       pragma Convention (LL_Altivec, abs_vxi);
 226
 227       function abss_vxi (A : Varray_Type) return Varray_Type;
 228       pragma Convention (LL_Altivec, abss_vxi);
 229
 230       function vaddsxs (A : Varray_Type; B : Varray_Type) return Varray_Type;
 231       pragma Convention (LL_Altivec, vaddsxs);
 232
 233       function vavgsx (A : Varray_Type; B : Varray_Type) return Varray_Type;
 234       pragma Convention (LL_Altivec, vavgsx);
 235
 236       function vcmpgtsx (A : Varray_Type; B : Varray_Type) return Varray_Type;
 237       pragma Convention (LL_Altivec, vcmpgtsx);
 238
 239       function lvexx (A : c_long; B : c_ptr) return Varray_Type;
 240       pragma Convention (LL_Altivec, lvexx);
 241
 242       function vmaxsx (A : Varray_Type;  B : Varray_Type) return Varray_Type;
 243       pragma Convention (LL_Altivec, vmaxsx);
 244
 245       function vmrghx (A : Varray_Type; B : Varray_Type) return Varray_Type;
 246       pragma Convention (LL_Altivec, vmrghx);
 247
 248       function vmrglx (A : Varray_Type; B : Varray_Type) return Varray_Type;
 249       pragma Convention (LL_Altivec, vmrglx);
 250
 251       function vminsx (A : Varray_Type; B : Varray_Type) return Varray_Type;
 252       pragma Convention (LL_Altivec, vminsx);
 253
 254       function vspltx (A : Varray_Type; B : c_int) return Varray_Type;
 255       pragma Convention (LL_Altivec, vspltx);
 256
 257       function vspltisx (A : c_int) return Varray_Type;
 258       pragma Convention (LL_Altivec, vspltisx);
 259
 260       type Bit_Operation is
 261         access function
 262         (Value  : Component_Type;
 263          Amount : Natural) return Component_Type;
 264
 265       function vsrax
 266         (A          : Varray_Type;
 267          B          : Varray_Type;
 268          Shift_Func : Bit_Operation) return Varray_Type;
 269
 270       procedure stvexx (A : Varray_Type; B : c_int; C : c_ptr);
 271       pragma Convention (LL_Altivec, stvexx);
 272
 273       function vsubsxs (A : Varray_Type; B : Varray_Type) return Varray_Type;
 274       pragma Convention (LL_Altivec, vsubsxs);
 275
 276       function Check_CR6 (A : c_int; D : Varray_Type) return c_int;
 277       --  If D is the result of a vcmp operation and A the flag for
 278       --  the kind of operation (e.g CR6_LT), check the predicate
 279       --  that corresponds to this flag.
 280
 281    end Signed_Operations;
 282
 283    ------------------------------
 284    -- Signed_Operations (body) --
 285    ------------------------------
 286
 287    package body Signed_Operations is
 288
 289       Bool_True  : constant Component_Type := Signed_Bool_True;
 290       Bool_False : constant Component_Type := Signed_Bool_False;
 291
 292       Number_Of_Elements : constant Integer :=
 293                              VECTOR_BIT / Component_Type'Size;
 294
 295       --------------------
 296       -- Modular_Result --
 297       --------------------
 298
 299       function Modular_Result (X : SI64) return Component_Type is
 300          D : Component_Type;
 301
 302       begin
 303          if X > 0 then
 304             D := Component_Type (UI64 (X)
 305                                  mod (UI64 (Component_Type'Last) + 1));
 306          else
 307             D := Component_Type ((-(UI64 (-X)
 308                                     mod (UI64 (Component_Type'Last) + 1))));
 309          end if;
 310
 311          return D;
 312       end Modular_Result;
 313
 314       --------------
 315       -- Saturate --
 316       --------------
 317
 318       function Saturate (X : SI64) return Component_Type is
 319          D : Component_Type;
 320
 321       begin
 322          --  Saturation, as defined in
 323          --  [PIM-4.1 Vector Status and Control Register]
 324
 325          D := Component_Type (SI64'Max
 326                               (SI64 (Component_Type'First),
 327                                SI64'Min
 328                                (SI64 (Component_Type'Last),
 329                                 X)));
 330
 331          if SI64 (D) /= X then
 332             VSCR := Write_Bit (VSCR, SAT_POS, 1);
 333          end if;
 334
 335          return D;
 336       end Saturate;
 337
 338       function Saturate (X : F64) return Component_Type is
 339          D : Component_Type;
 340
 341       begin
 342          --  Saturation, as defined in
 343          --  [PIM-4.1 Vector Status and Control Register]
 344
 345          D := Component_Type (F64'Max
 346                               (F64 (Component_Type'First),
 347                                F64'Min
 348                                (F64 (Component_Type'Last),
 349                                 X)));
 350
 351          if F64 (D) /= X then
 352             VSCR := Write_Bit (VSCR, SAT_POS, 1);
 353          end if;
 354
 355          return D;
 356       end Saturate;
 357
 358       -----------------
 359       -- Sign_Extend --
 360       -----------------
 361
 362       function Sign_Extend (X : c_int) return Component_Type is
 363       begin
 364          --  X is usually a 5-bits literal. In the case of the simulator,
 365          --  it is an integral parameter, so sign extension is straightforward.
 366
 367          return Component_Type (X);
 368       end Sign_Extend;
 369
 370       -------------
 371       -- abs_vxi --
 372       -------------
 373
 374       function abs_vxi (A : Varray_Type) return Varray_Type is
 375          D : Varray_Type;
 376
 377       begin
 378          for K in Varray_Type'Range loop
 379             D (K) := (if A (K) /= Component_Type'First
 380                       then abs (A (K)) else Component_Type'First);
 381          end loop;
 382
 383          return D;
 384       end abs_vxi;
 385
 386       --------------
 387       -- abss_vxi --
 388       --------------
 389
 390       function abss_vxi (A : Varray_Type) return Varray_Type is
 391          D : Varray_Type;
 392
 393       begin
 394          for K in Varray_Type'Range loop
 395             D (K) := Saturate (abs (SI64 (A (K))));
 396          end loop;
 397
 398          return D;
 399       end abss_vxi;
 400
 401       -------------
 402       -- vaddsxs --
 403       -------------
 404
 405       function vaddsxs (A : Varray_Type; B : Varray_Type) return Varray_Type is
 406          D : Varray_Type;
 407
 408       begin
 409          for J in Varray_Type'Range loop
 410             D (J) := Saturate (SI64 (A (J)) + SI64 (B (J)));
 411          end loop;
 412
 413          return D;
 414       end vaddsxs;
 415
 416       ------------
 417       -- vavgsx --
 418       ------------
 419
 420       function vavgsx (A : Varray_Type; B : Varray_Type) return Varray_Type is
 421          D : Varray_Type;
 422
 423       begin
 424          for J in Varray_Type'Range loop
 425             D (J) := Component_Type ((SI64 (A (J)) + SI64 (B (J)) + 1) / 2);
 426          end loop;
 427
 428          return D;
 429       end vavgsx;
 430
 431       --------------
 432       -- vcmpgtsx --
 433       --------------
 434
 435       function vcmpgtsx
 436         (A : Varray_Type;
 437          B : Varray_Type) return Varray_Type
 438       is
 439          D : Varray_Type;
 440
 441       begin
 442          for J in Varray_Type'Range loop
 443             D (J) := (if A (J) > B (J) then Bool_True else Bool_False);
 444          end loop;
 445
 446          return D;
 447       end vcmpgtsx;
 448
 449       -----------
 450       -- lvexx --
 451       -----------
 452
 453       function lvexx (A : c_long; B : c_ptr) return Varray_Type is
 454          D  : Varray_Type;
 455          S  : Integer;
 456          EA : Integer_Address;
 457          J  : Index_Type;
 458
 459       begin
 460          S := 16 / Number_Of_Elements;
 461          EA := Bound_Align (Integer_Address (A) + To_Integer (B),
 462                             Integer_Address (S));
 463          J := Index_Type (((EA mod 16) / Integer_Address (S))
 464                           + Integer_Address (Index_Type'First));
 465
 466          declare
 467             Component : Component_Type;
 468             for Component'Address use To_Address (EA);
 469          begin
 470             D (J) := Component;
 471          end;
 472
 473          return D;
 474       end lvexx;
 475
 476       ------------
 477       -- vmaxsx --
 478       ------------
 479
 480       function vmaxsx (A : Varray_Type;  B : Varray_Type) return Varray_Type is
 481          D : Varray_Type;
 482
 483       begin
 484          for J in Varray_Type'Range loop
 485             D (J) := (if A (J) > B (J) then A (J) else B (J));
 486          end loop;
 487
 488          return D;
 489       end vmaxsx;
 490
 491       ------------
 492       -- vmrghx --
 493       ------------
 494
 495       function vmrghx (A : Varray_Type; B : Varray_Type) return Varray_Type is
 496          D      : Varray_Type;
 497          Offset : constant Integer := Integer (Index_Type'First);
 498          M      : constant Integer := Number_Of_Elements / 2;
 499
 500       begin
 501          for J in 0 .. M - 1 loop
 502             D (Index_Type (2 * J + Offset)) := A (Index_Type (J + Offset));
 503             D (Index_Type (2 * J + Offset + 1)) := B (Index_Type (J + Offset));
 504          end loop;
 505
 506          return D;
 507       end vmrghx;
 508
 509       ------------
 510       -- vmrglx --
 511       ------------
 512
 513       function vmrglx (A : Varray_Type; B : Varray_Type) return Varray_Type is
 514          D      : Varray_Type;
 515          Offset : constant Integer := Integer (Index_Type'First);
 516          M      : constant Integer := Number_Of_Elements / 2;
 517
 518       begin
 519          for J in 0 .. M - 1 loop
 520             D (Index_Type (2 * J + Offset)) := A (Index_Type (J + Offset + M));
 521             D (Index_Type (2 * J + Offset + 1)) :=
 522               B (Index_Type (J + Offset + M));
 523          end loop;
 524
 525          return D;
 526       end vmrglx;
 527
 528       ------------
 529       -- vminsx --
 530       ------------
 531
 532       function vminsx (A : Varray_Type; B : Varray_Type) return Varray_Type is
 533          D : Varray_Type;
 534
 535       begin
 536          for J in Varray_Type'Range loop
 537             D (J) := (if A (J) < B (J) then A (J) else B (J));
 538          end loop;
 539
 540          return D;
 541       end vminsx;
 542
 543       ------------
 544       -- vspltx --
 545       ------------
 546
 547       function vspltx (A : Varray_Type; B : c_int) return Varray_Type is
 548          J : constant Integer :=
 549                Integer (B) mod Number_Of_Elements
 550            + Integer (Varray_Type'First);
 551          D : Varray_Type;
 552
 553       begin
 554          for K in Varray_Type'Range loop
 555             D (K) := A (Index_Type (J));
 556          end loop;
 557
 558          return D;
 559       end vspltx;
 560
 561       --------------
 562       -- vspltisx --
 563       --------------
 564
 565       function vspltisx (A : c_int) return Varray_Type is
 566          D : Varray_Type;
 567
 568       begin
 569          for J in Varray_Type'Range loop
 570             D (J) := Sign_Extend (A);
 571          end loop;
 572
 573          return D;
 574       end vspltisx;
 575
 576       -----------
 577       -- vsrax --
 578       -----------
 579
 580       function vsrax
 581         (A          : Varray_Type;
 582          B          : Varray_Type;
 583          Shift_Func : Bit_Operation) return Varray_Type
 584       is
 585          D : Varray_Type;
 586          S : constant Component_Type :=
 587                Component_Type (128 / Number_Of_Elements);
 588
 589       begin
 590          for J in Varray_Type'Range loop
 591             D (J) := Shift_Func (A (J), Natural (B (J) mod S));
 592          end loop;
 593
 594          return D;
 595       end vsrax;
 596
 597       ------------
 598       -- stvexx --
 599       ------------
 600
 601       procedure stvexx (A : Varray_Type; B : c_int; C : c_ptr) is
 602          S  : Integer;
 603          EA : Integer_Address;
 604          J  : Index_Type;
 605
 606       begin
 607          S := 16 / Number_Of_Elements;
 608          EA := Bound_Align (Integer_Address (B) + To_Integer (C),
 609                             Integer_Address (S));
 610          J := Index_Type ((EA mod 16) / Integer_Address (S)
 611                           + Integer_Address (Index_Type'First));
 612
 613          declare
 614             Component : Component_Type;
 615             for Component'Address use To_Address (EA);
 616          begin
 617             Component := A (J);
 618          end;
 619       end stvexx;
 620
 621       -------------
 622       -- vsubsxs --
 623       -------------
 624
 625       function vsubsxs (A : Varray_Type; B : Varray_Type) return Varray_Type is
 626          D : Varray_Type;
 627
 628       begin
 629          for J in Varray_Type'Range loop
 630             D (J) := Saturate (SI64 (A (J)) - SI64 (B (J)));
 631          end loop;
 632
 633          return D;
 634       end vsubsxs;
 635
 636       ---------------
 637       -- Check_CR6 --
 638       ---------------
 639
 640       function Check_CR6 (A : c_int; D : Varray_Type) return c_int is
 641          All_Element : Boolean := True;
 642          Any_Element : Boolean := False;
 643
 644       begin
 645          for J in Varray_Type'Range loop
 646             All_Element := All_Element and then (D (J) = Bool_True);
 647             Any_Element := Any_Element or else  (D (J) = Bool_True);
 648          end loop;
 649
 650          if A = CR6_LT then
 651             if All_Element then
 652                return 1;
 653             else
 654                return 0;
 655             end if;
 656
 657          elsif A = CR6_EQ then
 658             if not Any_Element then
 659                return 1;
 660             else
 661                return 0;
 662             end if;
 663
 664          elsif A = CR6_EQ_REV then
 665             if Any_Element then
 666                return 1;
 667             else
 668                return 0;
 669             end if;
 670
 671          elsif A = CR6_LT_REV then
 672             if not All_Element then
 673                return 1;
 674             else
 675                return 0;
 676             end if;
 677          end if;
 678
 679          return 0;
 680       end Check_CR6;
 681
 682    end Signed_Operations;
 683
 684    --------------------------------
 685    -- Unsigned_Operations (spec) --
 686    --------------------------------
 687
 688    generic
 689       type Component_Type is mod <>;
 690       type Index_Type is range <>;
 691       type Varray_Type is array (Index_Type) of Component_Type;
 692
 693    package Unsigned_Operations is
 694
 695       function Bits
 696         (X    : Component_Type;
 697          Low  : Natural;
 698          High : Natural) return Component_Type;
 699       --  Return X [Low:High] as defined in [PIM-4.3 Notations and Conventions]
 700       --  using big endian bit ordering.
 701
 702       function Write_Bit
 703         (X     : Component_Type;
 704          Where : Natural;
 705          Value : Unsigned_1) return Component_Type;
 706       --  Write Value into X[Where:Where] (if it fits in) and return the result
 707       --  (big endian bit ordering).
 708
 709       function Modular_Result (X : UI64) return Component_Type;
 710
 711       function Saturate (X : UI64) return Component_Type;
 712
 713       function Saturate (X : F64) return Component_Type;
 714
 715       function Saturate (X : SI64) return Component_Type;
 716
 717       function vadduxm  (A : Varray_Type; B : Varray_Type) return Varray_Type;
 718
 719       function vadduxs  (A : Varray_Type; B : Varray_Type) return Varray_Type;
 720
 721       function vavgux   (A : Varray_Type; B : Varray_Type) return Varray_Type;
 722
 723       function vcmpequx (A : Varray_Type; B : Varray_Type) return Varray_Type;
 724
 725       function vcmpgtux (A : Varray_Type; B : Varray_Type) return Varray_Type;
 726
 727       function vmaxux   (A : Varray_Type; B : Varray_Type) return Varray_Type;
 728
 729       function vminux   (A : Varray_Type; B : Varray_Type) return Varray_Type;
 730
 731       type Bit_Operation is
 732         access function
 733         (Value  : Component_Type;
 734          Amount : Natural) return Component_Type;
 735
 736       function vrlx
 737         (A    : Varray_Type;
 738          B    : Varray_Type;
 739          ROTL : Bit_Operation) return Varray_Type;
 740
 741       function vsxx
 742         (A          : Varray_Type;
 743          B          : Varray_Type;
 744          Shift_Func : Bit_Operation) return Varray_Type;
 745       --  Vector shift (left or right, depending on Shift_Func)
 746
 747       function vsubuxm (A : Varray_Type; B : Varray_Type) return Varray_Type;
 748
 749       function vsubuxs (A : Varray_Type; B : Varray_Type) return Varray_Type;
 750
 751       function Check_CR6 (A : c_int; D : Varray_Type) return c_int;
 752       --  If D is the result of a vcmp operation and A the flag for
 753       --  the kind of operation (e.g CR6_LT), check the predicate
 754       --  that corresponds to this flag.
 755
 756    end Unsigned_Operations;
 757
 758    --------------------------------
 759    -- Unsigned_Operations (body) --
 760    --------------------------------
 761
 762    package body Unsigned_Operations is
 763
 764       Number_Of_Elements : constant Integer :=
 765                              VECTOR_BIT / Component_Type'Size;
 766
 767       Bool_True  : constant Component_Type := Component_Type'Last;
 768       Bool_False : constant Component_Type := 0;
 769
 770       --------------------
 771       -- Modular_Result --
 772       --------------------
 773
 774       function Modular_Result (X : UI64) return Component_Type is
 775          D : Component_Type;
 776       begin
 777          D := Component_Type (X mod (UI64 (Component_Type'Last) + 1));
 778          return D;
 779       end Modular_Result;
 780
 781       --------------
 782       -- Saturate --
 783       --------------
 784
 785       function Saturate (X : UI64) return Component_Type is
 786          D : Component_Type;
 787
 788       begin
 789          --  Saturation, as defined in
 790          --  [PIM-4.1 Vector Status and Control Register]
 791
 792          D := Component_Type (UI64'Max
 793                               (UI64 (Component_Type'First),
 794                                UI64'Min
 795                                (UI64 (Component_Type'Last),
 796                                 X)));
 797
 798          if UI64 (D) /= X then
 799             VSCR := Write_Bit (VSCR, SAT_POS, 1);
 800          end if;
 801
 802          return D;
 803       end Saturate;
 804
 805       function Saturate (X : SI64) return Component_Type is
 806          D : Component_Type;
 807
 808       begin
 809          --  Saturation, as defined in
 810          --  [PIM-4.1 Vector Status and Control Register]
 811
 812          D := Component_Type (SI64'Max
 813                               (SI64 (Component_Type'First),
 814                                SI64'Min
 815                                (SI64 (Component_Type'Last),
 816                                 X)));
 817
 818          if SI64 (D) /= X then
 819             VSCR := Write_Bit (VSCR, SAT_POS, 1);
 820          end if;
 821
 822          return D;
 823       end Saturate;
 824
 825       function Saturate (X : F64) return Component_Type is
 826          D : Component_Type;
 827
 828       begin
 829          --  Saturation, as defined in
 830          --  [PIM-4.1 Vector Status and Control Register]
 831
 832          D := Component_Type (F64'Max
 833                               (F64 (Component_Type'First),
 834                                F64'Min
 835                                (F64 (Component_Type'Last),
 836                                 X)));
 837
 838          if F64 (D) /= X then
 839             VSCR := Write_Bit (VSCR, SAT_POS, 1);
 840          end if;
 841
 842          return D;
 843       end Saturate;
 844
 845       ----------
 846       -- Bits --
 847       ----------
 848
 849       function Bits
 850         (X    : Component_Type;
 851          Low  : Natural;
 852          High : Natural) return Component_Type
 853       is
 854          Mask : Component_Type := 0;
 855
 856          --  The Altivec ABI uses a big endian bit ordering, and we are
 857          --  using little endian bit ordering for extracting bits:
 858
 859          Low_LE  : constant Natural := Component_Type'Size - 1 - High;
 860          High_LE : constant Natural := Component_Type'Size - 1 - Low;
 861
 862       begin
 863          pragma Assert (Low <= Component_Type'Size);
 864          pragma Assert (High <= Component_Type'Size);
 865
 866          for J in Low_LE .. High_LE loop
 867             Mask := Mask or 2 ** J;
 868          end loop;
 869
 870          return (X and Mask) / 2 ** Low_LE;
 871       end Bits;
 872
 873       ---------------
 874       -- Write_Bit --
 875       ---------------
 876
 877       function Write_Bit
 878         (X     : Component_Type;
 879          Where : Natural;
 880          Value : Unsigned_1) return Component_Type
 881       is
 882          Result   : Component_Type := 0;
 883
 884          --  The Altivec ABI uses a big endian bit ordering, and we are
 885          --  using little endian bit ordering for extracting bits:
 886
 887          Where_LE : constant Natural := Component_Type'Size - 1 - Where;
 888
 889       begin
 890          pragma Assert (Where < Component_Type'Size);
 891
 892          case Value is
 893             when 1 =>
 894                Result := X or 2 ** Where_LE;
 895             when 0 =>
 896                Result := X and not (2 ** Where_LE);
 897          end case;
 898
 899          return Result;
 900       end Write_Bit;
 901
 902       -------------
 903       -- vadduxm --
 904       -------------
 905
 906       function vadduxm (A : Varray_Type; B : Varray_Type) return Varray_Type is
 907          D : Varray_Type;
 908
 909       begin
 910          for J in Varray_Type'Range loop
 911             D (J) := A (J) + B (J);
 912          end loop;
 913
 914          return D;
 915       end vadduxm;
 916
 917       -------------
 918       -- vadduxs --
 919       -------------
 920
 921       function vadduxs (A : Varray_Type; B : Varray_Type) return Varray_Type is
 922          D : Varray_Type;
 923
 924       begin
 925          for J in Varray_Type'Range loop
 926             D (J) := Saturate (UI64 (A (J)) + UI64 (B (J)));
 927          end loop;
 928
 929          return D;
 930       end vadduxs;
 931
 932       ------------
 933       -- vavgux --
 934       ------------
 935
 936       function vavgux (A : Varray_Type; B : Varray_Type) return Varray_Type is
 937          D : Varray_Type;
 938
 939       begin
 940          for J in Varray_Type'Range loop
 941             D (J) := Component_Type ((UI64 (A (J)) + UI64 (B (J)) + 1) / 2);
 942          end loop;
 943
 944          return D;
 945       end vavgux;
 946
 947       --------------
 948       -- vcmpequx --
 949       --------------
 950
 951       function vcmpequx
 952         (A : Varray_Type;
 953          B : Varray_Type) return Varray_Type
 954       is
 955          D : Varray_Type;
 956
 957       begin
 958          for J in Varray_Type'Range loop
 959             D (J) := (if A (J) = B (J) then Bool_True else Bool_False);
 960          end loop;
 961
 962          return D;
 963       end vcmpequx;
 964
 965       --------------
 966       -- vcmpgtux --
 967       --------------
 968
 969       function vcmpgtux
 970         (A : Varray_Type;
 971          B : Varray_Type) return Varray_Type
 972       is
 973          D : Varray_Type;
 974       begin
 975          for J in Varray_Type'Range loop
 976             D (J) := (if A (J) > B (J) then Bool_True else Bool_False);
 977          end loop;
 978
 979          return D;
 980       end vcmpgtux;
 981
 982       ------------
 983       -- vmaxux --
 984       ------------
 985
 986       function vmaxux (A : Varray_Type;  B : Varray_Type) return Varray_Type is
 987          D : Varray_Type;
 988
 989       begin
 990          for J in Varray_Type'Range loop
 991             D (J) := (if A (J) > B (J) then A (J) else B (J));
 992          end loop;
 993
 994          return D;
 995       end vmaxux;
 996
 997       ------------
 998       -- vminux --
 999       ------------
1000
1001       function vminux (A : Varray_Type; B : Varray_Type) return Varray_Type is
1002          D : Varray_Type;
1003
1004       begin
1005          for J in Varray_Type'Range loop
1006             D (J) := (if A (J) < B (J) then A (J) else B (J));
1007          end loop;
1008
1009          return D;
1010       end vminux;
1011
1012       ----------
1013       -- vrlx --
1014       ----------
1015
1016       function vrlx
1017         (A    : Varray_Type;
1018          B    : Varray_Type;
1019          ROTL : Bit_Operation) return Varray_Type
1020       is
1021          D : Varray_Type;
1022
1023       begin
1024          for J in Varray_Type'Range loop
1025             D (J) := ROTL (A (J), Natural (B (J)));
1026          end loop;
1027
1028          return D;
1029       end vrlx;
1030
1031       ----------
1032       -- vsxx --
1033       ----------
1034
1035       function vsxx
1036         (A          : Varray_Type;
1037          B          : Varray_Type;
1038          Shift_Func : Bit_Operation) return Varray_Type
1039       is
1040          D : Varray_Type;
1041          S : constant Component_Type :=
1042                Component_Type (128 / Number_Of_Elements);
1043
1044       begin
1045          for J in Varray_Type'Range loop
1046             D (J) := Shift_Func (A (J), Natural (B (J) mod S));
1047          end loop;
1048
1049          return D;
1050       end vsxx;
1051
1052       -------------
1053       -- vsubuxm --
1054       -------------
1055
1056       function vsubuxm (A : Varray_Type; B : Varray_Type) return Varray_Type is
1057          D : Varray_Type;
1058
1059       begin
1060          for J in Varray_Type'Range loop
1061             D (J) := A (J) - B (J);
1062          end loop;
1063
1064          return D;
1065       end vsubuxm;
1066
1067       -------------
1068       -- vsubuxs --
1069       -------------
1070
1071       function vsubuxs (A : Varray_Type; B : Varray_Type) return Varray_Type is
1072          D : Varray_Type;
1073
1074       begin
1075          for J in Varray_Type'Range loop
1076             D (J) := Saturate (SI64 (A (J)) - SI64 (B (J)));
1077          end loop;
1078
1079          return D;
1080       end vsubuxs;
1081
1082       ---------------
1083       -- Check_CR6 --
1084       ---------------
1085
1086       function Check_CR6 (A : c_int; D : Varray_Type) return c_int is
1087          All_Element : Boolean := True;
1088          Any_Element : Boolean := False;
1089
1090       begin
1091          for J in Varray_Type'Range loop
1092             All_Element := All_Element and then (D (J) = Bool_True);
1093             Any_Element := Any_Element or else  (D (J) = Bool_True);
1094          end loop;
1095
1096          if A = CR6_LT then
1097             if All_Element then
1098                return 1;
1099             else
1100                return 0;
1101             end if;
1102
1103          elsif A = CR6_EQ then
1104             if not Any_Element then
1105                return 1;
1106             else
1107                return 0;
1108             end if;
1109
1110          elsif A = CR6_EQ_REV then
1111             if Any_Element then
1112                return 1;
1113             else
1114                return 0;
1115             end if;
1116
1117          elsif A = CR6_LT_REV then
1118             if not All_Element then
1119                return 1;
1120             else
1121                return 0;
1122             end if;
1123          end if;
1124
1125          return 0;
1126       end Check_CR6;
1127
1128    end Unsigned_Operations;
1129
1130    --------------------------------------
1131    -- Signed_Merging_Operations (spec) --
1132    --------------------------------------
1133
1134    generic
1135       type Component_Type is range <>;
1136       type Index_Type is range <>;
1137       type Varray_Type is array (Index_Type) of Component_Type;
1138       type Double_Component_Type is range <>;
1139       type Double_Index_Type is range <>;
1140       type Double_Varray_Type is array (Double_Index_Type)
1141         of Double_Component_Type;
1142
1143    package Signed_Merging_Operations is
1144
1145       pragma Assert (Integer (Varray_Type'First)
1146                      = Integer (Double_Varray_Type'First));
1147       pragma Assert (Varray_Type'Length = 2 * Double_Varray_Type'Length);
1148       pragma Assert (2 * Component_Type'Size = Double_Component_Type'Size);
1149
1150       function Saturate
1151         (X : Double_Component_Type) return Component_Type;
1152
1153       function vmulxsx
1154         (Use_Even_Components : Boolean;
1155          A                   : Varray_Type;
1156          B                   : Varray_Type) return Double_Varray_Type;
1157
1158       function vpksxss
1159         (A : Double_Varray_Type;
1160          B : Double_Varray_Type) return Varray_Type;
1161       pragma Convention (LL_Altivec, vpksxss);
1162
1163       function vupkxsx
1164         (A      : Varray_Type;
1165          Offset : Natural) return Double_Varray_Type;
1166
1167    end Signed_Merging_Operations;
1168
1169    --------------------------------------
1170    -- Signed_Merging_Operations (body) --
1171    --------------------------------------
1172
1173    package body Signed_Merging_Operations is
1174
1175       --------------
1176       -- Saturate --
1177       --------------
1178
1179       function Saturate
1180         (X : Double_Component_Type) return Component_Type
1181       is
1182          D : Component_Type;
1183
1184       begin
1185          --  Saturation, as defined in
1186          --  [PIM-4.1 Vector Status and Control Register]
1187
1188          D := Component_Type (Double_Component_Type'Max
1189                               (Double_Component_Type (Component_Type'First),
1190                                Double_Component_Type'Min
1191                                (Double_Component_Type (Component_Type'Last),
1192                                 X)));
1193
1194          if Double_Component_Type (D) /= X then
1195             VSCR := Write_Bit (VSCR, SAT_POS, 1);
1196          end if;
1197
1198          return D;
1199       end Saturate;
1200
1201       -------------
1202       -- vmulsxs --
1203       -------------
1204
1205       function vmulxsx
1206         (Use_Even_Components : Boolean;
1207          A                   : Varray_Type;
1208          B                   : Varray_Type) return Double_Varray_Type
1209       is
1210          Double_Offset : Double_Index_Type;
1211          Offset        : Index_Type;
1212          D             : Double_Varray_Type;
1213          N             : constant Integer :=
1214                            Integer (Double_Index_Type'Last)
1215                            - Integer (Double_Index_Type'First) + 1;
1216
1217       begin
1218
1219          for J in 0 .. N - 1 loop
1220             Offset :=
1221               Index_Type ((if Use_Even_Components then 2 * J else 2 * J + 1) +
1222                           Integer (Index_Type'First));
1223
1224             Double_Offset :=
1225               Double_Index_Type (J + Integer (Double_Index_Type'First));
1226             D (Double_Offset) :=
1227               Double_Component_Type (A (Offset)) *
1228               Double_Component_Type (B (Offset));
1229          end loop;
1230
1231          return D;
1232       end vmulxsx;
1233
1234       -------------
1235       -- vpksxss --
1236       -------------
1237
1238       function vpksxss
1239         (A : Double_Varray_Type;
1240          B : Double_Varray_Type) return Varray_Type
1241       is
1242          N             : constant Index_Type :=
1243                            Index_Type (Double_Index_Type'Last);
1244          D             : Varray_Type;
1245          Offset        : Index_Type;
1246          Double_Offset : Double_Index_Type;
1247
1248       begin
1249          for J in 0 .. N - 1 loop
1250             Offset := Index_Type (Integer (J) + Integer (Index_Type'First));
1251             Double_Offset :=
1252               Double_Index_Type (Integer (J)
1253                                  + Integer (Double_Index_Type'First));
1254             D (Offset) := Saturate (A (Double_Offset));
1255             D (Offset + N) := Saturate (B (Double_Offset));
1256          end loop;
1257
1258          return D;
1259       end vpksxss;
1260
1261       -------------
1262       -- vupkxsx --
1263       -------------
1264
1265       function vupkxsx
1266         (A      : Varray_Type;
1267          Offset : Natural) return Double_Varray_Type
1268       is
1269          K : Index_Type;
1270          D : Double_Varray_Type;
1271
1272       begin
1273          for J in Double_Varray_Type'Range loop
1274             K := Index_Type (Integer (J)
1275                              - Integer (Double_Index_Type'First)
1276                              + Integer (Index_Type'First)
1277                              + Offset);
1278             D (J) := Double_Component_Type (A (K));
1279          end loop;
1280
1281          return D;
1282       end vupkxsx;
1283
1284    end Signed_Merging_Operations;
1285
1286    ----------------------------------------
1287    -- Unsigned_Merging_Operations (spec) --
1288    ----------------------------------------
1289
1290    generic
1291       type Component_Type is mod <>;
1292       type Index_Type is range <>;
1293       type Varray_Type is array (Index_Type) of Component_Type;
1294       type Double_Component_Type is mod <>;
1295       type Double_Index_Type is range <>;
1296       type Double_Varray_Type is array (Double_Index_Type)
1297         of Double_Component_Type;
1298
1299    package Unsigned_Merging_Operations is
1300
1301       pragma Assert (Integer (Varray_Type'First)
1302                      = Integer (Double_Varray_Type'First));
1303       pragma Assert (Varray_Type'Length = 2 * Double_Varray_Type'Length);
1304       pragma Assert (2 * Component_Type'Size = Double_Component_Type'Size);
1305
1306       function UI_To_UI_Mod
1307         (X : Double_Component_Type;
1308          Y : Natural) return Component_Type;
1309
1310       function Saturate (X : Double_Component_Type) return Component_Type;
1311
1312       function vmulxux
1313         (Use_Even_Components : Boolean;
1314          A                   : Varray_Type;
1315          B                   : Varray_Type) return Double_Varray_Type;
1316
1317       function vpkuxum
1318         (A : Double_Varray_Type;
1319          B : Double_Varray_Type) return Varray_Type;
1320
1321       function vpkuxus
1322         (A : Double_Varray_Type;
1323          B : Double_Varray_Type) return Varray_Type;
1324
1325    end Unsigned_Merging_Operations;
1326
1327    ----------------------------------------
1328    -- Unsigned_Merging_Operations (body) --
1329    ----------------------------------------
1330
1331    package body Unsigned_Merging_Operations is
1332
1333       ------------------
1334       -- UI_To_UI_Mod --
1335       ------------------
1336
1337       function UI_To_UI_Mod
1338         (X : Double_Component_Type;
1339          Y : Natural) return Component_Type is
1340          Z : Component_Type;
1341       begin
1342          Z := Component_Type (X mod 2 ** Y);
1343          return Z;
1344       end UI_To_UI_Mod;
1345
1346       --------------
1347       -- Saturate --
1348       --------------
1349
1350       function Saturate (X : Double_Component_Type) return Component_Type is
1351          D : Component_Type;
1352
1353       begin
1354          --  Saturation, as defined in
1355          --  [PIM-4.1 Vector Status and Control Register]
1356
1357          D := Component_Type (Double_Component_Type'Max
1358                               (Double_Component_Type (Component_Type'First),
1359                                Double_Component_Type'Min
1360                                (Double_Component_Type (Component_Type'Last),
1361                                 X)));
1362
1363          if Double_Component_Type (D) /= X then
1364             VSCR := Write_Bit (VSCR, SAT_POS, 1);
1365          end if;
1366
1367          return D;
1368       end Saturate;
1369
1370       -------------
1371       -- vmulxux --
1372       -------------
1373
1374       function vmulxux
1375         (Use_Even_Components : Boolean;
1376          A                   : Varray_Type;
1377          B                   : Varray_Type) return Double_Varray_Type
1378       is
1379          Double_Offset : Double_Index_Type;
1380          Offset        : Index_Type;
1381          D             : Double_Varray_Type;
1382          N             : constant Integer :=
1383                            Integer (Double_Index_Type'Last)
1384                            - Integer (Double_Index_Type'First) + 1;
1385
1386       begin
1387          for J in 0 .. N - 1 loop
1388             Offset :=
1389               Index_Type ((if Use_Even_Components then 2 * J else 2 * J + 1) +
1390                           Integer (Index_Type'First));
1391
1392             Double_Offset :=
1393               Double_Index_Type (J + Integer (Double_Index_Type'First));
1394             D (Double_Offset) :=
1395               Double_Component_Type (A (Offset)) *
1396               Double_Component_Type (B (Offset));
1397          end loop;
1398
1399          return D;
1400       end vmulxux;
1401
1402       -------------
1403       -- vpkuxum --
1404       -------------
1405
1406       function vpkuxum
1407         (A : Double_Varray_Type;
1408          B : Double_Varray_Type) return Varray_Type
1409       is
1410          S             : constant Natural :=
1411                            Double_Component_Type'Size / 2;
1412          N             : constant Index_Type :=
1413                            Index_Type (Double_Index_Type'Last);
1414          D             : Varray_Type;
1415          Offset        : Index_Type;
1416          Double_Offset : Double_Index_Type;
1417
1418       begin
1419          for J in 0 .. N - 1 loop
1420             Offset := Index_Type (Integer (J) + Integer (Index_Type'First));
1421             Double_Offset :=
1422               Double_Index_Type (Integer (J)
1423                                  + Integer (Double_Index_Type'First));
1424             D (Offset) := UI_To_UI_Mod (A (Double_Offset), S);
1425             D (Offset + N) := UI_To_UI_Mod (B (Double_Offset), S);
1426          end loop;
1427
1428          return D;
1429       end vpkuxum;
1430
1431       -------------
1432       -- vpkuxus --
1433       -------------
1434
1435       function vpkuxus
1436         (A : Double_Varray_Type;
1437          B : Double_Varray_Type) return Varray_Type
1438       is
1439          N             : constant Index_Type :=
1440                            Index_Type (Double_Index_Type'Last);
1441          D             : Varray_Type;
1442          Offset        : Index_Type;
1443          Double_Offset : Double_Index_Type;
1444
1445       begin
1446          for J in 0 .. N - 1 loop
1447             Offset := Index_Type (Integer (J) + Integer (Index_Type'First));
1448             Double_Offset :=
1449               Double_Index_Type (Integer (J)
1450                                  + Integer (Double_Index_Type'First));
1451             D (Offset) := Saturate (A (Double_Offset));
1452             D (Offset + N) := Saturate (B (Double_Offset));
1453          end loop;
1454
1455          return D;
1456       end vpkuxus;
1457
1458    end Unsigned_Merging_Operations;
1459
1460    package LL_VSC_Operations is
1461      new Signed_Operations (signed_char,
1462                             Vchar_Range,
1463                             Varray_signed_char);
1464
1465    package LL_VSS_Operations is
1466      new Signed_Operations (signed_short,
1467                             Vshort_Range,
1468                             Varray_signed_short);
1469
1470    package LL_VSI_Operations is
1471      new Signed_Operations (signed_int,
1472                             Vint_Range,
1473                             Varray_signed_int);
1474
1475    package LL_VUC_Operations is
1476      new Unsigned_Operations (unsigned_char,
1477                               Vchar_Range,
1478                               Varray_unsigned_char);
1479
1480    package LL_VUS_Operations is
1481      new Unsigned_Operations (unsigned_short,
1482                               Vshort_Range,
1483                               Varray_unsigned_short);
1484
1485    package LL_VUI_Operations is
1486      new Unsigned_Operations (unsigned_int,
1487                               Vint_Range,
1488                               Varray_unsigned_int);
1489
1490    package LL_VSC_LL_VSS_Operations is
1491      new Signed_Merging_Operations (signed_char,
1492                                     Vchar_Range,
1493                                     Varray_signed_char,
1494                                     signed_short,
1495                                     Vshort_Range,
1496                                     Varray_signed_short);
1497
1498    package LL_VSS_LL_VSI_Operations is
1499      new Signed_Merging_Operations (signed_short,
1500                                     Vshort_Range,
1501                                     Varray_signed_short,
1502                                     signed_int,
1503                                     Vint_Range,
1504                                     Varray_signed_int);
1505
1506    package LL_VUC_LL_VUS_Operations is
1507      new Unsigned_Merging_Operations (unsigned_char,
1508                                       Vchar_Range,
1509                                       Varray_unsigned_char,
1510                                       unsigned_short,
1511                                       Vshort_Range,
1512                                       Varray_unsigned_short);
1513
1514    package LL_VUS_LL_VUI_Operations is
1515      new Unsigned_Merging_Operations (unsigned_short,
1516                                       Vshort_Range,
1517                                       Varray_unsigned_short,
1518                                       unsigned_int,
1519                                       Vint_Range,
1520                                       Varray_unsigned_int);
1521
1522    ----------
1523    -- Bits --
1524    ----------
1525
1526    function Bits
1527      (X    : unsigned_int;
1528       Low  : Natural;
1529       High : Natural) return unsigned_int renames LL_VUI_Operations.Bits;
1530
1531    function Bits
1532      (X    : unsigned_short;
1533       Low  : Natural;
1534       High : Natural) return unsigned_short renames LL_VUS_Operations.Bits;
1535
1536    function Bits
1537      (X    : unsigned_char;
1538       Low  : Natural;
1539       High : Natural) return unsigned_char renames LL_VUC_Operations.Bits;
1540
1541    ---------------
1542    -- Write_Bit --
1543    ---------------
1544
1545    function Write_Bit
1546      (X     : unsigned_int;
1547       Where : Natural;
1548       Value : Unsigned_1) return unsigned_int
1549      renames LL_VUI_Operations.Write_Bit;
1550
1551    function Write_Bit
1552      (X     : unsigned_short;
1553       Where : Natural;
1554       Value : Unsigned_1) return unsigned_short
1555      renames LL_VUS_Operations.Write_Bit;
1556
1557    function Write_Bit
1558      (X     : unsigned_char;
1559       Where : Natural;
1560       Value : Unsigned_1) return unsigned_char
1561      renames LL_VUC_Operations.Write_Bit;
1562
1563    -----------------
1564    -- Bound_Align --
1565    -----------------
1566
1567    function Bound_Align
1568      (X : Integer_Address;
1569       Y : Integer_Address) return Integer_Address
1570    is
1571       D : Integer_Address;
1572    begin
1573       D := X - X mod Y;
1574       return D;
1575    end Bound_Align;
1576
1577    -----------------
1578    -- NJ_Truncate --
1579    -----------------
1580
1581    function NJ_Truncate (X : C_float) return C_float is
1582       D : C_float;
1583
1584    begin
1585       if (Bits (VSCR, NJ_POS, NJ_POS) = 1)
1586         and then abs (X) < 2.0 ** (-126)
1587       then
1588          D := (if X < 0.0 then -0.0 else +0.0);
1589       else
1590          D := X;
1591       end if;
1592
1593       return D;
1594    end NJ_Truncate;
1595
1596    -----------------------
1597    -- Rnd_To_FP_Nearest --
1598    -----------------------
1599
1600    function Rnd_To_FP_Nearest (X : F64) return C_float is
1601    begin
1602       return C_float (X);
1603    end Rnd_To_FP_Nearest;
1604
1605    ---------------------
1606    -- Rnd_To_FPI_Near --
1607    ---------------------
1608
1609    function Rnd_To_FPI_Near (X : F64) return F64 is
1610       Result  : F64;
1611       Ceiling : F64;
1612
1613    begin
1614       Result := F64 (SI64 (X));
1615
1616       if (F64'Ceiling (X) - X) = (X + 1.0 - F64'Ceiling (X)) then
1617
1618          --  Round to even
1619
1620          Ceiling := F64'Ceiling (X);
1621          Result :=
1622            (if Rnd_To_FPI_Trunc (Ceiling / 2.0) * 2.0 = Ceiling
1623             then Ceiling else Ceiling - 1.0);
1624       end if;
1625
1626       return Result;
1627    end Rnd_To_FPI_Near;
1628
1629    ----------------------
1630    -- Rnd_To_FPI_Trunc --
1631    ----------------------
1632
1633    function Rnd_To_FPI_Trunc (X : F64) return F64 is
1634       Result : F64;
1635
1636    begin
1637       Result := F64'Ceiling (X);
1638
1639       --  Rnd_To_FPI_Trunc rounds toward 0, 'Ceiling rounds toward
1640       --  +Infinity
1641
1642       if X > 0.0
1643         and then Result /= X
1644       then
1645          Result := Result - 1.0;
1646       end if;
1647
1648       return Result;
1649    end Rnd_To_FPI_Trunc;
1650
1651    ------------------
1652    -- FP_Recip_Est --
1653    ------------------
1654
1655    function FP_Recip_Est (X : C_float) return C_float is
1656    begin
1657       --  ???  [PIM-4.4 vec_re] "For result that are not +0, -0, +Inf,
1658       --  -Inf, or QNaN, the estimate has a relative error no greater
1659       --  than one part in 4096, that is:
1660       --  Abs ((estimate - 1 / x) / (1 / x)) < = 1/4096"
1661
1662       return NJ_Truncate (1.0 / NJ_Truncate (X));
1663    end FP_Recip_Est;
1664
1665    ----------
1666    -- ROTL --
1667    ----------
1668
1669    function ROTL
1670      (Value  : unsigned_char;
1671       Amount : Natural) return unsigned_char
1672    is
1673       Result : Unsigned_8;
1674    begin
1675       Result := Rotate_Left (Unsigned_8 (Value), Amount);
1676       return unsigned_char (Result);
1677    end ROTL;
1678
1679    function ROTL
1680      (Value  : unsigned_short;
1681       Amount : Natural) return unsigned_short
1682    is
1683       Result : Unsigned_16;
1684    begin
1685       Result := Rotate_Left (Unsigned_16 (Value), Amount);
1686       return unsigned_short (Result);
1687    end ROTL;
1688
1689    function ROTL
1690      (Value  : unsigned_int;
1691       Amount : Natural) return unsigned_int
1692    is
1693       Result : Unsigned_32;
1694    begin
1695       Result := Rotate_Left (Unsigned_32 (Value), Amount);
1696       return unsigned_int (Result);
1697    end ROTL;
1698
1699    --------------------
1700    -- Recip_SQRT_Est --
1701    --------------------
1702
1703    function Recip_SQRT_Est (X : C_float) return C_float is
1704       Result : C_float;
1705
1706    begin
1707       --  ???
1708       --  [PIM-4.4 vec_rsqrte] the estimate has a relative error in precision
1709       --  no greater than one part in 4096, that is:
1710       --  abs ((estimate - 1 / sqrt (x)) / (1 / sqrt (x)) <= 1 / 4096"
1711
1712       Result := 1.0 / NJ_Truncate (C_float_Operations.Sqrt (NJ_Truncate (X)));
1713       return NJ_Truncate (Result);
1714    end Recip_SQRT_Est;
1715
1716    ----------------
1717    -- Shift_Left --
1718    ----------------
1719
1720    function Shift_Left
1721      (Value  : unsigned_char;
1722       Amount : Natural) return unsigned_char
1723    is
1724       Result : Unsigned_8;
1725    begin
1726       Result := Shift_Left (Unsigned_8 (Value), Amount);
1727       return unsigned_char (Result);
1728    end Shift_Left;
1729
1730    function Shift_Left
1731      (Value  : unsigned_short;
1732       Amount : Natural) return unsigned_short
1733    is
1734       Result : Unsigned_16;
1735    begin
1736       Result := Shift_Left (Unsigned_16 (Value), Amount);
1737       return unsigned_short (Result);
1738    end Shift_Left;
1739
1740    function Shift_Left
1741      (Value  : unsigned_int;
1742       Amount : Natural) return unsigned_int
1743    is
1744       Result : Unsigned_32;
1745    begin
1746       Result := Shift_Left (Unsigned_32 (Value), Amount);
1747       return unsigned_int (Result);
1748    end Shift_Left;
1749
1750    -----------------
1751    -- Shift_Right --
1752    -----------------
1753
1754    function Shift_Right
1755      (Value  : unsigned_char;
1756       Amount : Natural) return unsigned_char
1757    is
1758       Result : Unsigned_8;
1759    begin
1760       Result := Shift_Right (Unsigned_8 (Value), Amount);
1761       return unsigned_char (Result);
1762    end Shift_Right;
1763
1764    function Shift_Right
1765      (Value  : unsigned_short;
1766       Amount : Natural) return unsigned_short
1767    is
1768       Result : Unsigned_16;
1769    begin
1770       Result := Shift_Right (Unsigned_16 (Value), Amount);
1771       return unsigned_short (Result);
1772    end Shift_Right;
1773
1774    function Shift_Right
1775      (Value  : unsigned_int;
1776       Amount : Natural) return unsigned_int
1777    is
1778       Result : Unsigned_32;
1779    begin
1780       Result := Shift_Right (Unsigned_32 (Value), Amount);
1781       return unsigned_int (Result);
1782    end Shift_Right;
1783
1784    -------------------
1785    -- Shift_Right_A --
1786    -------------------
1787
1788    generic
1789       type Signed_Type is range <>;
1790       type Unsigned_Type is mod <>;
1791       with function Shift_Right (Value : Unsigned_Type; Amount : Natural)
1792                                 return Unsigned_Type;
1793    function Shift_Right_Arithmetic
1794      (Value  : Signed_Type;
1795       Amount : Natural) return Signed_Type;
1796
1797    function Shift_Right_Arithmetic
1798      (Value  : Signed_Type;
1799       Amount : Natural) return Signed_Type
1800    is
1801    begin
1802       if Value > 0 then
1803          return Signed_Type (Shift_Right (Unsigned_Type (Value), Amount));
1804       else
1805          return -Signed_Type (Shift_Right (Unsigned_Type (-Value - 1), Amount)
1806                               + 1);
1807       end if;
1808    end Shift_Right_Arithmetic;
1809
1810    function Shift_Right_A is new Shift_Right_Arithmetic (signed_int,
1811                                                          Unsigned_32,
1812                                                          Shift_Right);
1813
1814    function Shift_Right_A is new Shift_Right_Arithmetic (signed_short,
1815                                                          Unsigned_16,
1816                                                          Shift_Right);
1817
1818    function Shift_Right_A is new Shift_Right_Arithmetic (signed_char,
1819                                                          Unsigned_8,
1820                                                          Shift_Right);
1821    --------------
1822    -- To_Pixel --
1823    --------------
1824
1825    function To_Pixel (Source : unsigned_short) return Pixel_16 is
1826
1827       --  This conversion should not depend on the host endianness;
1828       --  therefore, we cannot use an unchecked conversion.
1829
1830       Target : Pixel_16;
1831
1832    begin
1833       Target.T := Unsigned_1 (Bits (Source, 0, 0)   mod 2 ** 1);
1834       Target.R := Unsigned_5 (Bits (Source, 1, 5)   mod 2 ** 5);
1835       Target.G := Unsigned_5 (Bits (Source, 6, 10)  mod 2 ** 5);
1836       Target.B := Unsigned_5 (Bits (Source, 11, 15) mod 2 ** 5);
1837       return Target;
1838    end To_Pixel;
1839
1840    function To_Pixel (Source : unsigned_int) return Pixel_32 is
1841
1842       --  This conversion should not depend on the host endianness;
1843       --  therefore, we cannot use an unchecked conversion.
1844
1845       Target : Pixel_32;
1846
1847    begin
1848       Target.T := unsigned_char (Bits (Source, 0, 7));
1849       Target.R := unsigned_char (Bits (Source, 8, 15));
1850       Target.G := unsigned_char (Bits (Source, 16, 23));
1851       Target.B := unsigned_char (Bits (Source, 24, 31));
1852       return Target;
1853    end To_Pixel;
1854
1855    ---------------------
1856    -- To_unsigned_int --
1857    ---------------------
1858
1859    function To_unsigned_int (Source : Pixel_32) return unsigned_int is
1860
1861       --  This conversion should not depend on the host endianness;
1862       --  therefore, we cannot use an unchecked conversion.
1863       --  It should also be the same result, value-wise, on two hosts
1864       --  with the same endianness.
1865
1866       Target : unsigned_int := 0;
1867
1868    begin
1869       --  In big endian bit ordering, Pixel_32 looks like:
1870       --  -------------------------------------
1871       --  |   T    |   R    |   G    |    B   |
1872       --  -------------------------------------
1873       --  0 (MSB)  7        15       23       32
1874       --
1875       --  Sizes of the components: (8/8/8/8)
1876       --
1877       Target := Target or unsigned_int (Source.T);
1878       Target := Shift_Left (Target, 8);
1879       Target := Target or unsigned_int (Source.R);
1880       Target := Shift_Left (Target, 8);
1881       Target := Target or unsigned_int (Source.G);
1882       Target := Shift_Left (Target, 8);
1883       Target := Target or unsigned_int (Source.B);
1884       return Target;
1885    end To_unsigned_int;
1886
1887    -----------------------
1888    -- To_unsigned_short --
1889    -----------------------
1890
1891    function To_unsigned_short (Source : Pixel_16) return unsigned_short is
1892
1893       --  This conversion should not depend on the host endianness;
1894       --  therefore, we cannot use an unchecked conversion.
1895       --  It should also be the same result, value-wise, on two hosts
1896       --  with the same endianness.
1897
1898       Target : unsigned_short := 0;
1899
1900    begin
1901       --  In big endian bit ordering, Pixel_16 looks like:
1902       --  -------------------------------------
1903       --  |   T    |   R    |   G    |    B   |
1904       --  -------------------------------------
1905       --  0 (MSB)  1        5        11       15
1906       --
1907       --  Sizes of the components: (1/5/5/5)
1908       --
1909       Target := Target or unsigned_short (Source.T);
1910       Target := Shift_Left (Target, 5);
1911       Target := Target or unsigned_short (Source.R);
1912       Target := Shift_Left (Target, 5);
1913       Target := Target or unsigned_short (Source.G);
1914       Target := Shift_Left (Target, 5);
1915       Target := Target or unsigned_short (Source.B);
1916       return Target;
1917    end To_unsigned_short;
1918
1919    ---------------
1920    -- abs_v16qi --
1921    ---------------
1922
1923    function abs_v16qi (A : LL_VSC) return LL_VSC is
1924       VA : constant VSC_View := To_View (A);
1925    begin
1926       return To_Vector ((Values =>
1927                            LL_VSC_Operations.abs_vxi (VA.Values)));
1928    end abs_v16qi;
1929
1930    --------------
1931    -- abs_v8hi --
1932    --------------
1933
1934    function abs_v8hi (A : LL_VSS) return LL_VSS is
1935       VA : constant VSS_View := To_View (A);
1936    begin
1937       return To_Vector ((Values =>
1938                            LL_VSS_Operations.abs_vxi (VA.Values)));
1939    end abs_v8hi;
1940
1941    --------------
1942    -- abs_v4si --
1943    --------------
1944
1945    function abs_v4si (A : LL_VSI) return LL_VSI is
1946       VA : constant VSI_View := To_View (A);
1947    begin
1948       return To_Vector ((Values =>
1949                            LL_VSI_Operations.abs_vxi (VA.Values)));
1950    end abs_v4si;
1951
1952    --------------
1953    -- abs_v4sf --
1954    --------------
1955
1956    function abs_v4sf (A : LL_VF) return LL_VF is
1957       D  : Varray_float;
1958       VA : constant VF_View := To_View (A);
1959
1960    begin
1961       for J in Varray_float'Range loop
1962          D (J) := abs (VA.Values (J));
1963       end loop;
1964
1965       return To_Vector ((Values => D));
1966    end abs_v4sf;
1967
1968    ----------------
1969    -- abss_v16qi --
1970    ----------------
1971
1972    function abss_v16qi (A : LL_VSC) return LL_VSC is
1973       VA : constant VSC_View := To_View (A);
1974    begin
1975       return To_Vector ((Values =>
1976                            LL_VSC_Operations.abss_vxi (VA.Values)));
1977    end abss_v16qi;
1978
1979    ---------------
1980    -- abss_v8hi --
1981    ---------------
1982
1983    function abss_v8hi (A : LL_VSS) return LL_VSS is
1984       VA : constant VSS_View := To_View (A);
1985    begin
1986       return To_Vector ((Values =>
1987                            LL_VSS_Operations.abss_vxi (VA.Values)));
1988    end abss_v8hi;
1989
1990    ---------------
1991    -- abss_v4si --
1992    ---------------
1993
1994    function abss_v4si (A : LL_VSI) return LL_VSI is
1995       VA : constant VSI_View := To_View (A);
1996    begin
1997       return To_Vector ((Values =>
1998                            LL_VSI_Operations.abss_vxi (VA.Values)));
1999    end abss_v4si;
2000
2001    -------------
2002    -- vaddubm --
2003    -------------
2004
2005    function vaddubm (A : LL_VSC; B : LL_VSC) return LL_VSC is
2006       UC : constant GNAT.Altivec.Low_Level_Vectors.LL_VUC :=
2007              To_LL_VUC (A);
2008       VA : constant VUC_View :=
2009              To_View (UC);
2010       VB : constant VUC_View := To_View (To_LL_VUC (B));
2011       D  : Varray_unsigned_char;
2012
2013    begin
2014       D := LL_VUC_Operations.vadduxm (VA.Values, VB.Values);
2015       return To_LL_VSC (To_Vector (VUC_View'(Values => D)));
2016    end vaddubm;
2017
2018    -------------
2019    -- vadduhm --
2020    -------------
2021
2022    function vadduhm (A : LL_VSS; B : LL_VSS) return LL_VSS is
2023       VA : constant VUS_View := To_View (To_LL_VUS (A));
2024       VB : constant VUS_View := To_View (To_LL_VUS (B));
2025       D  : Varray_unsigned_short;
2026
2027    begin
2028       D := LL_VUS_Operations.vadduxm (VA.Values, VB.Values);
2029       return To_LL_VSS (To_Vector (VUS_View'(Values => D)));
2030    end vadduhm;
2031
2032    -------------
2033    -- vadduwm --
2034    -------------
2035
2036    function vadduwm (A : LL_VSI; B : LL_VSI) return LL_VSI is
2037       VA : constant VUI_View := To_View (To_LL_VUI (A));
2038       VB : constant VUI_View := To_View (To_LL_VUI (B));
2039       D  : Varray_unsigned_int;
2040
2041    begin
2042       D := LL_VUI_Operations.vadduxm (VA.Values, VB.Values);
2043       return To_LL_VSI (To_Vector (VUI_View'(Values => D)));
2044    end vadduwm;
2045
2046    ------------
2047    -- vaddfp --
2048    ------------
2049
2050    function vaddfp (A : LL_VF; B : LL_VF) return LL_VF is
2051       VA : constant VF_View := To_View (A);
2052       VB : constant VF_View := To_View (B);
2053       D  : Varray_float;
2054
2055    begin
2056       for J in Varray_float'Range loop
2057          D (J) := NJ_Truncate (NJ_Truncate (VA.Values (J))
2058                                + NJ_Truncate (VB.Values (J)));
2059       end loop;
2060
2061       return To_Vector (VF_View'(Values => D));
2062    end vaddfp;
2063
2064    -------------
2065    -- vaddcuw --
2066    -------------
2067
2068    function vaddcuw (A : LL_VSI; B : LL_VSI) return LL_VSI is
2069       Addition_Result : UI64;
2070       D               : VUI_View;
2071       VA              : constant VUI_View := To_View (To_LL_VUI (A));
2072       VB              : constant VUI_View := To_View (To_LL_VUI (B));
2073
2074    begin
2075       for J in Varray_unsigned_int'Range loop
2076          Addition_Result := UI64 (VA.Values (J)) + UI64 (VB.Values (J));
2077          D.Values (J) :=
2078            (if Addition_Result > UI64 (unsigned_int'Last) then 1 else 0);
2079       end loop;
2080
2081       return To_LL_VSI (To_Vector (D));
2082    end vaddcuw;
2083
2084    -------------
2085    -- vaddubs --
2086    -------------
2087
2088    function vaddubs (A : LL_VSC; B : LL_VSC) return LL_VSC is
2089       VA : constant VUC_View := To_View (To_LL_VUC (A));
2090       VB : constant VUC_View := To_View (To_LL_VUC (B));
2091
2092    begin
2093       return To_LL_VSC (To_Vector
2094                         (VUC_View'(Values =>
2095                                      (LL_VUC_Operations.vadduxs
2096                                       (VA.Values,
2097                                        VB.Values)))));
2098    end vaddubs;
2099
2100    -------------
2101    -- vaddsbs --
2102    -------------
2103
2104    function vaddsbs (A : LL_VSC; B : LL_VSC) return LL_VSC is
2105       VA : constant VSC_View := To_View (A);
2106       VB : constant VSC_View := To_View (B);
2107       D  : VSC_View;
2108
2109    begin
2110       D.Values := LL_VSC_Operations.vaddsxs (VA.Values, VB.Values);
2111       return To_Vector (D);
2112    end vaddsbs;
2113
2114    -------------
2115    -- vadduhs --
2116    -------------
2117
2118    function vadduhs (A : LL_VSS; B : LL_VSS) return LL_VSS is
2119       VA : constant VUS_View := To_View (To_LL_VUS (A));
2120       VB : constant VUS_View := To_View (To_LL_VUS (B));
2121       D  : VUS_View;
2122
2123    begin
2124       D.Values := LL_VUS_Operations.vadduxs (VA.Values, VB.Values);
2125       return To_LL_VSS (To_Vector (D));
2126    end vadduhs;
2127
2128    -------------
2129    -- vaddshs --
2130    -------------
2131
2132    function vaddshs (A : LL_VSS; B : LL_VSS) return LL_VSS is
2133       VA : constant VSS_View := To_View (A);
2134       VB : constant VSS_View := To_View (B);
2135       D  : VSS_View;
2136
2137    begin
2138       D.Values := LL_VSS_Operations.vaddsxs (VA.Values, VB.Values);
2139       return To_Vector (D);
2140    end vaddshs;
2141
2142    -------------
2143    -- vadduws --
2144    -------------
2145
2146    function vadduws (A : LL_VSI; B : LL_VSI) return LL_VSI is
2147       VA : constant VUI_View := To_View (To_LL_VUI (A));
2148       VB : constant VUI_View := To_View (To_LL_VUI (B));
2149       D  : VUI_View;
2150
2151    begin
2152       D.Values := LL_VUI_Operations.vadduxs (VA.Values, VB.Values);
2153       return To_LL_VSI (To_Vector (D));
2154    end vadduws;
2155
2156    -------------
2157    -- vaddsws --
2158    -------------
2159
2160    function vaddsws (A : LL_VSI; B : LL_VSI) return LL_VSI is
2161       VA : constant VSI_View := To_View (A);
2162       VB : constant VSI_View := To_View (B);
2163       D  : VSI_View;
2164
2165    begin
2166       D.Values := LL_VSI_Operations.vaddsxs (VA.Values, VB.Values);
2167       return To_Vector (D);
2168    end vaddsws;
2169
2170    ----------
2171    -- vand --
2172    ----------
2173
2174    function vand (A : LL_VSI; B : LL_VSI) return LL_VSI is
2175       VA : constant VUI_View := To_View (To_LL_VUI (A));
2176       VB : constant VUI_View := To_View (To_LL_VUI (B));
2177       D  : VUI_View;
2178
2179    begin
2180       for J in Varray_unsigned_int'Range loop
2181          D.Values (J) := VA.Values (J) and VB.Values (J);
2182       end loop;
2183
2184       return To_LL_VSI (To_Vector (D));
2185    end vand;
2186
2187    -----------
2188    -- vandc --
2189    -----------
2190
2191    function vandc (A : LL_VSI; B : LL_VSI) return LL_VSI is
2192       VA : constant VUI_View := To_View (To_LL_VUI (A));
2193       VB : constant VUI_View := To_View (To_LL_VUI (B));
2194       D  : VUI_View;
2195
2196    begin
2197       for J in Varray_unsigned_int'Range loop
2198          D.Values (J) := VA.Values (J) and not VB.Values (J);
2199       end loop;
2200
2201       return To_LL_VSI (To_Vector (D));
2202    end vandc;
2203
2204    ------------
2205    -- vavgub --
2206    ------------
2207
2208    function vavgub (A : LL_VSC; B : LL_VSC) return LL_VSC is
2209       VA : constant VUC_View := To_View (To_LL_VUC (A));
2210       VB : constant VUC_View := To_View (To_LL_VUC (B));
2211       D  : VUC_View;
2212
2213    begin
2214       D.Values := LL_VUC_Operations.vavgux (VA.Values, VB.Values);
2215       return To_LL_VSC (To_Vector (D));
2216    end vavgub;
2217
2218    ------------
2219    -- vavgsb --
2220    ------------
2221
2222    function vavgsb (A : LL_VSC; B : LL_VSC) return LL_VSC is
2223       VA : constant VSC_View := To_View (A);
2224       VB : constant VSC_View := To_View (B);
2225       D  : VSC_View;
2226
2227    begin
2228       D.Values := LL_VSC_Operations.vavgsx (VA.Values, VB.Values);
2229       return To_Vector (D);
2230    end vavgsb;
2231
2232    ------------
2233    -- vavguh --
2234    ------------
2235
2236    function vavguh (A : LL_VSS; B : LL_VSS) return LL_VSS is
2237       VA : constant VUS_View := To_View (To_LL_VUS (A));
2238       VB : constant VUS_View := To_View (To_LL_VUS (B));
2239       D  : VUS_View;
2240
2241    begin
2242       D.Values := LL_VUS_Operations.vavgux (VA.Values, VB.Values);
2243       return To_LL_VSS (To_Vector (D));
2244    end vavguh;
2245
2246    ------------
2247    -- vavgsh --
2248    ------------
2249
2250    function vavgsh (A : LL_VSS; B : LL_VSS) return LL_VSS is
2251       VA : constant VSS_View := To_View (A);
2252       VB : constant VSS_View := To_View (B);
2253       D  : VSS_View;
2254
2255    begin
2256       D.Values := LL_VSS_Operations.vavgsx (VA.Values, VB.Values);
2257       return To_Vector (D);
2258    end vavgsh;
2259
2260    ------------
2261    -- vavguw --
2262    ------------
2263
2264    function vavguw (A : LL_VSI; B : LL_VSI) return LL_VSI is
2265       VA : constant VUI_View := To_View (To_LL_VUI (A));
2266       VB : constant VUI_View := To_View (To_LL_VUI (B));
2267       D  : VUI_View;
2268
2269    begin
2270       D.Values := LL_VUI_Operations.vavgux (VA.Values, VB.Values);
2271       return To_LL_VSI (To_Vector (D));
2272    end vavguw;
2273
2274    ------------
2275    -- vavgsw --
2276    ------------
2277
2278    function vavgsw (A : LL_VSI; B : LL_VSI) return LL_VSI is
2279       VA : constant VSI_View := To_View (A);
2280       VB : constant VSI_View := To_View (B);
2281       D  : VSI_View;
2282
2283    begin
2284       D.Values := LL_VSI_Operations.vavgsx (VA.Values, VB.Values);
2285       return To_Vector (D);
2286    end vavgsw;
2287
2288    -----------
2289    -- vrfip --
2290    -----------
2291
2292    function vrfip (A : LL_VF) return LL_VF is
2293       VA : constant VF_View := To_View (A);
2294       D  : VF_View;
2295
2296    begin
2297       for J in Varray_float'Range loop
2298
2299          --  If A (J) is infinite, D (J) should be infinite; With
2300          --  IEEE floating points, we can use 'Ceiling for that purpose.
2301
2302          D.Values (J) := C_float'Ceiling (NJ_Truncate (VA.Values (J)));
2303
2304       end loop;
2305
2306       return To_Vector (D);
2307    end vrfip;
2308
2309    -------------
2310    -- vcmpbfp --
2311    -------------
2312
2313    function vcmpbfp (A : LL_VF; B : LL_VF) return LL_VSI is
2314       VA   : constant VF_View := To_View (A);
2315       VB   : constant VF_View := To_View (B);
2316       D    : VUI_View;
2317       K    : Vint_Range;
2318
2319    begin
2320       for J in Varray_float'Range loop
2321          K := Vint_Range (J);
2322          D.Values (K) := 0;
2323
2324          if NJ_Truncate (VB.Values (J)) < 0.0 then
2325
2326             --  [PIM-4.4 vec_cmpb] "If any single-precision floating-point
2327             --  word element in B is negative; the corresponding element in A
2328             --  is out of bounds.
2329
2330             D.Values (K) := Write_Bit (D.Values (K), 0, 1);
2331             D.Values (K) := Write_Bit (D.Values (K), 1, 1);
2332
2333          else
2334             D.Values (K) :=
2335               (if NJ_Truncate (VA.Values (J)) <= NJ_Truncate (VB.Values (J))
2336                then Write_Bit (D.Values (K), 0, 0)
2337                else Write_Bit (D.Values (K), 0, 1));
2338
2339             D.Values (K) :=
2340               (if NJ_Truncate (VA.Values (J)) >= -NJ_Truncate (VB.Values (J))
2341                then Write_Bit (D.Values (K), 1, 0)
2342                else Write_Bit (D.Values (K), 1, 1));
2343          end if;
2344       end loop;
2345
2346       return To_LL_VSI (To_Vector (D));
2347    end vcmpbfp;
2348
2349    --------------
2350    -- vcmpequb --
2351    --------------
2352
2353    function vcmpequb (A : LL_VSC; B : LL_VSC) return LL_VSC is
2354       VA : constant VUC_View := To_View (To_LL_VUC (A));
2355       VB : constant VUC_View := To_View (To_LL_VUC (B));
2356       D  : VUC_View;
2357
2358    begin
2359       D.Values := LL_VUC_Operations.vcmpequx (VA.Values, VB.Values);
2360       return To_LL_VSC (To_Vector (D));
2361    end vcmpequb;
2362
2363    --------------
2364    -- vcmpequh --
2365    --------------
2366
2367    function vcmpequh (A : LL_VSS; B : LL_VSS) return LL_VSS is
2368       VA : constant VUS_View := To_View (To_LL_VUS (A));
2369       VB : constant VUS_View := To_View (To_LL_VUS (B));
2370       D  : VUS_View;
2371    begin
2372       D.Values := LL_VUS_Operations.vcmpequx (VA.Values, VB.Values);
2373       return To_LL_VSS (To_Vector (D));
2374    end vcmpequh;
2375
2376    --------------
2377    -- vcmpequw --
2378    --------------
2379
2380    function vcmpequw (A : LL_VSI; B : LL_VSI) return LL_VSI is
2381       VA : constant VUI_View := To_View (To_LL_VUI (A));
2382       VB : constant VUI_View := To_View (To_LL_VUI (B));
2383       D  : VUI_View;
2384    begin
2385       D.Values := LL_VUI_Operations.vcmpequx (VA.Values, VB.Values);
2386       return To_LL_VSI (To_Vector (D));
2387    end vcmpequw;
2388
2389    --------------
2390    -- vcmpeqfp --
2391    --------------
2392
2393    function vcmpeqfp (A : LL_VF; B : LL_VF) return LL_VSI is
2394       VA : constant VF_View := To_View (A);
2395       VB : constant VF_View := To_View (B);
2396       D  : VUI_View;
2397
2398    begin
2399       for J in Varray_float'Range loop
2400          D.Values (Vint_Range (J)) :=
2401             (if VA.Values (J) = VB.Values (J) then unsigned_int'Last else 0);
2402       end loop;
2403
2404       return To_LL_VSI (To_Vector (D));
2405    end vcmpeqfp;
2406
2407    --------------
2408    -- vcmpgefp --
2409    --------------
2410
2411    function vcmpgefp (A : LL_VF; B : LL_VF) return LL_VSI is
2412       VA : constant VF_View := To_View (A);
2413       VB : constant VF_View := To_View (B);
2414       D : VSI_View;
2415
2416    begin
2417       for J in Varray_float'Range loop
2418          D.Values (Vint_Range (J)) :=
2419            (if VA.Values (J) >= VB.Values (J) then Signed_Bool_True
2420                                               else Signed_Bool_False);
2421       end loop;
2422
2423       return To_Vector (D);
2424    end vcmpgefp;
2425
2426    --------------
2427    -- vcmpgtub --
2428    --------------
2429
2430    function vcmpgtub (A : LL_VSC; B : LL_VSC) return LL_VSC is
2431       VA : constant VUC_View := To_View (To_LL_VUC (A));
2432       VB : constant VUC_View := To_View (To_LL_VUC (B));
2433       D  : VUC_View;
2434    begin
2435       D.Values := LL_VUC_Operations.vcmpgtux (VA.Values, VB.Values);
2436       return To_LL_VSC (To_Vector (D));
2437    end vcmpgtub;
2438
2439    --------------
2440    -- vcmpgtsb --
2441    --------------
2442
2443    function vcmpgtsb (A : LL_VSC; B : LL_VSC) return LL_VSC is
2444       VA : constant VSC_View := To_View (A);
2445       VB : constant VSC_View := To_View (B);
2446       D  : VSC_View;
2447    begin
2448       D.Values := LL_VSC_Operations.vcmpgtsx (VA.Values, VB.Values);
2449       return To_Vector (D);
2450    end vcmpgtsb;
2451
2452    --------------
2453    -- vcmpgtuh --
2454    --------------
2455
2456    function vcmpgtuh (A : LL_VSS; B : LL_VSS) return LL_VSS is
2457       VA : constant VUS_View := To_View (To_LL_VUS (A));
2458       VB : constant VUS_View := To_View (To_LL_VUS (B));
2459       D  : VUS_View;
2460    begin
2461       D.Values := LL_VUS_Operations.vcmpgtux (VA.Values, VB.Values);
2462       return To_LL_VSS (To_Vector (D));
2463    end vcmpgtuh;
2464
2465    --------------
2466    -- vcmpgtsh --
2467    --------------
2468
2469    function vcmpgtsh (A : LL_VSS; B : LL_VSS) return LL_VSS is
2470       VA : constant VSS_View := To_View (A);
2471       VB : constant VSS_View := To_View (B);
2472       D  : VSS_View;
2473    begin
2474       D.Values := LL_VSS_Operations.vcmpgtsx (VA.Values, VB.Values);
2475       return To_Vector (D);
2476    end vcmpgtsh;
2477
2478    --------------
2479    -- vcmpgtuw --
2480    --------------
2481
2482    function vcmpgtuw (A : LL_VSI; B : LL_VSI) return LL_VSI is
2483       VA : constant VUI_View := To_View (To_LL_VUI (A));
2484       VB : constant VUI_View := To_View (To_LL_VUI (B));
2485       D  : VUI_View;
2486    begin
2487       D.Values := LL_VUI_Operations.vcmpgtux (VA.Values, VB.Values);
2488       return To_LL_VSI (To_Vector (D));
2489    end vcmpgtuw;
2490
2491    --------------
2492    -- vcmpgtsw --
2493    --------------
2494
2495    function vcmpgtsw (A : LL_VSI; B : LL_VSI) return LL_VSI is
2496       VA : constant VSI_View := To_View (A);
2497       VB : constant VSI_View := To_View (B);
2498       D  : VSI_View;
2499    begin
2500       D.Values := LL_VSI_Operations.vcmpgtsx (VA.Values, VB.Values);
2501       return To_Vector (D);
2502    end vcmpgtsw;
2503
2504    --------------
2505    -- vcmpgtfp --
2506    --------------
2507
2508    function vcmpgtfp (A : LL_VF; B : LL_VF) return LL_VSI is
2509       VA : constant VF_View := To_View (A);
2510       VB : constant VF_View := To_View (B);
2511       D  : VSI_View;
2512
2513    begin
2514       for J in Varray_float'Range loop
2515          D.Values (Vint_Range (J)) :=
2516            (if NJ_Truncate (VA.Values (J)) > NJ_Truncate (VB.Values (J))
2517             then Signed_Bool_True else Signed_Bool_False);
2518       end loop;
2519
2520       return To_Vector (D);
2521    end vcmpgtfp;
2522
2523    -----------
2524    -- vcfux --
2525    -----------
2526
2527    function vcfux (A : LL_VSI; B : c_int) return LL_VF is
2528       D  : VF_View;
2529       VA : constant VUI_View := To_View (To_LL_VUI (A));
2530       K  : Vfloat_Range;
2531
2532    begin
2533       for J in Varray_signed_int'Range loop
2534          K := Vfloat_Range (J);
2535
2536          --  Note: The conversion to Integer is safe, as Integers are required
2537          --  to include the range -2 ** 15 + 1 .. 2 ** 15 + 1 and therefore
2538          --  include the range of B (should be 0 .. 255).
2539
2540          D.Values (K) :=
2541            C_float (VA.Values (J)) / (2.0 ** Integer (B));
2542       end loop;
2543
2544       return To_Vector (D);
2545    end vcfux;
2546
2547    -----------
2548    -- vcfsx --
2549    -----------
2550
2551    function vcfsx (A : LL_VSI; B : c_int) return LL_VF is
2552       VA : constant VSI_View := To_View (A);
2553       D  : VF_View;
2554       K  : Vfloat_Range;
2555
2556    begin
2557       for J in Varray_signed_int'Range loop
2558          K := Vfloat_Range (J);
2559          D.Values (K) := C_float (VA.Values (J))
2560            / (2.0 ** Integer (B));
2561       end loop;
2562
2563       return To_Vector (D);
2564    end vcfsx;
2565
2566    ------------
2567    -- vctsxs --
2568    ------------
2569
2570    function vctsxs (A : LL_VF; B : c_int) return LL_VSI is
2571       VA : constant VF_View := To_View (A);
2572       D  : VSI_View;
2573       K  : Vfloat_Range;
2574
2575    begin
2576       for J in Varray_signed_int'Range loop
2577          K := Vfloat_Range (J);
2578          D.Values (J) :=
2579            LL_VSI_Operations.Saturate
2580            (F64 (NJ_Truncate (VA.Values (K)))
2581             * F64 (2.0 ** Integer (B)));
2582       end loop;
2583
2584       return To_Vector (D);
2585    end vctsxs;
2586
2587    ------------
2588    -- vctuxs --
2589    ------------
2590
2591    function vctuxs (A : LL_VF; B : c_int) return LL_VSI is
2592       VA : constant VF_View := To_View (A);
2593       D  : VUI_View;
2594       K  : Vfloat_Range;
2595
2596    begin
2597       for J in Varray_unsigned_int'Range loop
2598          K := Vfloat_Range (J);
2599          D.Values (J) :=
2600            LL_VUI_Operations.Saturate
2601            (F64 (NJ_Truncate (VA.Values (K)))
2602             * F64 (2.0 ** Integer (B)));
2603       end loop;
2604
2605       return To_LL_VSI (To_Vector (D));
2606    end vctuxs;
2607
2608    ---------
2609    -- dss --
2610    ---------
2611
2612    --  No-ops, as allowed by [PEM-5.2.1.1 Data Stream Touch (dst)]:
2613
2614    procedure dss (A : c_int) is
2615       pragma Unreferenced (A);
2616    begin
2617       null;
2618    end dss;
2619
2620    ------------
2621    -- dssall --
2622    ------------
2623
2624    --  No-ops, as allowed by [PEM-5.2.1.1 Data Stream Touch (dst)]:
2625
2626    procedure dssall is
2627    begin
2628       null;
2629    end dssall;
2630
2631    ---------
2632    -- dst --
2633    ---------
2634
2635    --  No-ops, as allowed by [PEM-5.2.1.1 Data Stream Touch (dst)]:
2636
2637    procedure dst    (A : c_ptr; B : c_int; C : c_int) is
2638       pragma Unreferenced (A);
2639       pragma Unreferenced (B);
2640       pragma Unreferenced (C);
2641    begin
2642       null;
2643    end dst;
2644
2645    -----------
2646    -- dstst --
2647    -----------
2648
2649    --  No-ops, as allowed by [PEM-5.2.1.1 Data Stream Touch (dst)]:
2650
2651    procedure dstst  (A : c_ptr; B : c_int; C : c_int) is
2652       pragma Unreferenced (A);
2653       pragma Unreferenced (B);
2654       pragma Unreferenced (C);
2655    begin
2656       null;
2657    end dstst;
2658
2659    ------------
2660    -- dststt --
2661    ------------
2662
2663    --  No-ops, as allowed by [PEM-5.2.1.1 Data Stream Touch (dst)]:
2664
2665    procedure dststt (A : c_ptr; B : c_int; C : c_int) is
2666       pragma Unreferenced (A);
2667       pragma Unreferenced (B);
2668       pragma Unreferenced (C);
2669    begin
2670       null;
2671    end dststt;
2672
2673    ----------
2674    -- dstt --
2675    ----------
2676
2677    --  No-ops, as allowed by [PEM-5.2.1.1 Data Stream Touch (dst)]:
2678
2679    procedure dstt   (A : c_ptr; B : c_int; C : c_int) is
2680       pragma Unreferenced (A);
2681       pragma Unreferenced (B);
2682       pragma Unreferenced (C);
2683    begin
2684       null;
2685    end dstt;
2686
2687    --------------
2688    -- vexptefp --
2689    --------------
2690
2691    function vexptefp (A : LL_VF) return LL_VF is
2692       use C_float_Operations;
2693
2694       VA : constant VF_View := To_View (A);
2695       D  : VF_View;
2696
2697    begin
2698       for J in Varray_float'Range loop
2699
2700          --  ??? Check the precision of the operation.
2701          --  As described in [PEM-6 vexptefp]:
2702          --  If theoretical_result is equal to 2 at the power of A (J) with
2703          --  infinite precision, we should have:
2704          --  abs ((D (J) - theoretical_result) / theoretical_result) <= 1/16
2705
2706          D.Values (J) := 2.0 ** NJ_Truncate (VA.Values (J));
2707       end loop;
2708
2709       return To_Vector (D);
2710    end vexptefp;
2711
2712    -----------
2713    -- vrfim --
2714    -----------
2715
2716    function vrfim (A : LL_VF) return LL_VF is
2717       VA : constant VF_View := To_View (A);
2718       D  : VF_View;
2719
2720    begin
2721       for J in Varray_float'Range loop
2722
2723          --  If A (J) is infinite, D (J) should be infinite; With
2724          --  IEEE floating point, we can use 'Ceiling for that purpose.
2725
2726          D.Values (J) := C_float'Ceiling (NJ_Truncate (VA.Values (J)));
2727
2728          --  Vrfim rounds toward -Infinity, whereas 'Ceiling rounds toward
2729          --  +Infinity:
2730
2731          if D.Values (J) /= VA.Values (J) then
2732             D.Values (J) := D.Values (J) - 1.0;
2733          end if;
2734       end loop;
2735
2736       return To_Vector (D);
2737    end vrfim;
2738
2739    ---------
2740    -- lvx --
2741    ---------
2742
2743    function lvx (A : c_long; B : c_ptr) return LL_VSI is
2744
2745       --  Simulate the altivec unit behavior regarding what Effective Address
2746       --  is accessed, stripping off the input address least significant bits
2747       --  wrt to vector alignment.
2748
2749       --  On targets where VECTOR_ALIGNMENT is less than the vector size (16),
2750       --  an address within a vector is not necessarily rounded back at the
2751       --  vector start address. Besides, rounding on 16 makes no sense on such
2752       --  targets because the address of a properly aligned vector (that is,
2753       --  a proper multiple of VECTOR_ALIGNMENT) could be affected, which we
2754       --  want never to happen.
2755
2756       EA : constant System.Address :=
2757              To_Address
2758                (Bound_Align
2759                   (Integer_Address (A) + To_Integer (B), VECTOR_ALIGNMENT));
2760
2761       D : LL_VSI;
2762       for D'Address use EA;
2763
2764    begin
2765       return D;
2766    end lvx;
2767
2768    -----------
2769    -- lvebx --
2770    -----------
2771
2772    function lvebx (A : c_long; B : c_ptr) return LL_VSC is
2773       D : VSC_View;
2774    begin
2775       D.Values := LL_VSC_Operations.lvexx (A, B);
2776       return To_Vector (D);
2777    end lvebx;
2778
2779    -----------
2780    -- lvehx --
2781    -----------
2782
2783    function lvehx (A : c_long; B : c_ptr) return LL_VSS is
2784       D : VSS_View;
2785    begin
2786       D.Values := LL_VSS_Operations.lvexx (A, B);
2787       return To_Vector (D);
2788    end lvehx;
2789
2790    -----------
2791    -- lvewx --
2792    -----------
2793
2794    function lvewx (A : c_long; B : c_ptr) return LL_VSI is
2795       D : VSI_View;
2796    begin
2797       D.Values := LL_VSI_Operations.lvexx (A, B);
2798       return To_Vector (D);
2799    end lvewx;
2800
2801    ----------
2802    -- lvxl --
2803    ----------
2804
2805    function lvxl  (A : c_long; B : c_ptr) return LL_VSI renames
2806      lvx;
2807
2808    -------------
2809    -- vlogefp --
2810    -------------
2811
2812    function vlogefp (A : LL_VF) return LL_VF is
2813       VA : constant VF_View := To_View (A);
2814       D  : VF_View;
2815
2816    begin
2817       for J in Varray_float'Range loop
2818
2819          --  ??? Check the precision of the operation.
2820          --  As described in [PEM-6 vlogefp]:
2821          --  If theorical_result is equal to the log2 of A (J) with
2822          --  infinite precision, we should have:
2823          --  abs (D (J) - theorical_result) <= 1/32,
2824          --  unless abs(D(J) - 1) <= 1/8.
2825
2826          D.Values (J) :=
2827            C_float_Operations.Log (NJ_Truncate (VA.Values (J)), 2.0);
2828       end loop;
2829
2830       return To_Vector (D);
2831    end vlogefp;
2832
2833    ----------
2834    -- lvsl --
2835    ----------
2836
2837    function lvsl (A : c_long; B : c_ptr) return LL_VSC is
2838       type bit4_type is mod 16#F# + 1;
2839       for bit4_type'Alignment use 1;
2840       EA : Integer_Address;
2841       D  : VUC_View;
2842       SH : bit4_type;
2843
2844    begin
2845       EA := Integer_Address (A) + To_Integer (B);
2846       SH := bit4_type (EA mod 2 ** 4);
2847
2848       for J in D.Values'Range loop
2849          D.Values (J) := unsigned_char (SH) + unsigned_char (J)
2850            - unsigned_char (D.Values'First);
2851       end loop;
2852
2853       return To_LL_VSC (To_Vector (D));
2854    end lvsl;
2855
2856    ----------
2857    -- lvsr --
2858    ----------
2859
2860    function lvsr (A : c_long; B : c_ptr) return LL_VSC is
2861       type bit4_type is mod 16#F# + 1;
2862       for bit4_type'Alignment use 1;
2863       EA : Integer_Address;
2864       D  : VUC_View;
2865       SH : bit4_type;
2866
2867    begin
2868       EA := Integer_Address (A) + To_Integer (B);
2869       SH := bit4_type (EA mod 2 ** 4);
2870
2871       for J in D.Values'Range loop
2872          D.Values (J) := (16#F# - unsigned_char (SH)) + unsigned_char (J);
2873       end loop;
2874
2875       return To_LL_VSC (To_Vector (D));
2876    end lvsr;
2877
2878    -------------
2879    -- vmaddfp --
2880    -------------
2881
2882    function vmaddfp (A : LL_VF; B : LL_VF; C : LL_VF) return LL_VF is
2883       VA : constant VF_View := To_View (A);
2884       VB : constant VF_View := To_View (B);
2885       VC : constant VF_View := To_View (C);
2886       D  : VF_View;
2887
2888    begin
2889       for J in Varray_float'Range loop
2890          D.Values (J) :=
2891            Rnd_To_FP_Nearest (F64 (VA.Values (J))
2892                               * F64 (VB.Values (J))
2893                               + F64 (VC.Values (J)));
2894       end loop;
2895
2896       return To_Vector (D);
2897    end vmaddfp;
2898
2899    ---------------
2900    -- vmhaddshs --
2901    ---------------
2902
2903    function vmhaddshs  (A : LL_VSS; B : LL_VSS; C : LL_VSS) return LL_VSS is
2904       VA : constant VSS_View := To_View (A);
2905       VB : constant VSS_View := To_View (B);
2906       VC : constant VSS_View := To_View (C);
2907       D  : VSS_View;
2908
2909    begin
2910       for J in Varray_signed_short'Range loop
2911          D.Values (J) := LL_VSS_Operations.Saturate
2912            ((SI64 (VA.Values (J)) * SI64 (VB.Values (J)))
2913             / SI64 (2 ** 15) + SI64 (VC.Values (J)));
2914       end loop;
2915
2916       return To_Vector (D);
2917    end vmhaddshs;
2918
2919    ------------
2920    -- vmaxub --
2921    ------------
2922
2923    function vmaxub (A : LL_VSC; B : LL_VSC) return LL_VSC is
2924       VA : constant VUC_View := To_View (To_LL_VUC (A));
2925       VB : constant VUC_View := To_View (To_LL_VUC (B));
2926       D  : VUC_View;
2927    begin
2928       D.Values := LL_VUC_Operations.vmaxux (VA.Values, VB.Values);
2929       return To_LL_VSC (To_Vector (D));
2930    end vmaxub;
2931
2932    ------------
2933    -- vmaxsb --
2934    ------------
2935
2936    function vmaxsb (A : LL_VSC; B : LL_VSC) return LL_VSC is
2937       VA : constant VSC_View := To_View (A);
2938       VB : constant VSC_View := To_View (B);
2939       D  : VSC_View;
2940    begin
2941       D.Values := LL_VSC_Operations.vmaxsx (VA.Values, VB.Values);
2942       return To_Vector (D);
2943    end vmaxsb;
2944
2945    ------------
2946    -- vmaxuh --
2947    ------------
2948
2949    function vmaxuh (A : LL_VSS; B : LL_VSS) return LL_VSS is
2950       VA : constant VUS_View := To_View (To_LL_VUS (A));
2951       VB : constant VUS_View := To_View (To_LL_VUS (B));
2952       D  : VUS_View;
2953    begin
2954       D.Values := LL_VUS_Operations.vmaxux (VA.Values, VB.Values);
2955       return To_LL_VSS (To_Vector (D));
2956    end vmaxuh;
2957
2958    ------------
2959    -- vmaxsh --
2960    ------------
2961
2962    function vmaxsh (A : LL_VSS; B : LL_VSS) return LL_VSS is
2963       VA : constant VSS_View := To_View (A);
2964       VB : constant VSS_View := To_View (B);
2965       D  : VSS_View;
2966    begin
2967       D.Values := LL_VSS_Operations.vmaxsx (VA.Values, VB.Values);
2968       return To_Vector (D);
2969    end vmaxsh;
2970
2971    ------------
2972    -- vmaxuw --
2973    ------------
2974
2975    function vmaxuw (A : LL_VSI; B : LL_VSI) return LL_VSI is
2976       VA : constant VUI_View := To_View (To_LL_VUI (A));
2977       VB : constant VUI_View := To_View (To_LL_VUI (B));
2978       D  : VUI_View;
2979    begin
2980       D.Values := LL_VUI_Operations.vmaxux (VA.Values, VB.Values);
2981       return To_LL_VSI (To_Vector (D));
2982    end vmaxuw;
2983
2984    ------------
2985    -- vmaxsw --
2986    ------------
2987
2988    function vmaxsw (A : LL_VSI; B : LL_VSI) return LL_VSI is
2989       VA : constant VSI_View := To_View (A);
2990       VB : constant VSI_View := To_View (B);
2991       D  : VSI_View;
2992    begin
2993       D.Values := LL_VSI_Operations.vmaxsx (VA.Values, VB.Values);
2994       return To_Vector (D);
2995    end vmaxsw;
2996
2997    --------------
2998    -- vmaxsxfp --
2999    --------------
3000
3001    function vmaxfp (A : LL_VF; B : LL_VF) return LL_VF is
3002       VA : constant VF_View := To_View (A);
3003       VB : constant VF_View := To_View (B);
3004       D  : VF_View;
3005
3006    begin
3007       for J in Varray_float'Range loop
3008          D.Values (J) := (if VA.Values (J) > VB.Values (J) then VA.Values (J)
3009                                                            else VB.Values (J));
3010       end loop;
3011
3012       return To_Vector (D);
3013    end vmaxfp;
3014
3015    ------------
3016    -- vmrghb --
3017    ------------
3018
3019    function vmrghb (A : LL_VSC; B : LL_VSC) return LL_VSC is
3020       VA : constant VSC_View := To_View (A);
3021       VB : constant VSC_View := To_View (B);
3022       D  : VSC_View;
3023    begin
3024       D.Values := LL_VSC_Operations.vmrghx (VA.Values, VB.Values);
3025       return To_Vector (D);
3026    end vmrghb;
3027
3028    ------------
3029    -- vmrghh --
3030    ------------
3031
3032    function vmrghh (A : LL_VSS; B : LL_VSS) return LL_VSS is
3033       VA : constant VSS_View := To_View (A);
3034       VB : constant VSS_View := To_View (B);
3035       D  : VSS_View;
3036    begin
3037       D.Values := LL_VSS_Operations.vmrghx (VA.Values, VB.Values);
3038       return To_Vector (D);
3039    end vmrghh;
3040
3041    ------------
3042    -- vmrghw --
3043    ------------
3044
3045    function vmrghw (A : LL_VSI; B : LL_VSI) return LL_VSI is
3046       VA : constant VSI_View := To_View (A);
3047       VB : constant VSI_View := To_View (B);
3048       D  : VSI_View;
3049    begin
3050       D.Values := LL_VSI_Operations.vmrghx (VA.Values, VB.Values);
3051       return To_Vector (D);
3052    end vmrghw;
3053
3054    ------------
3055    -- vmrglb --
3056    ------------
3057
3058    function vmrglb (A : LL_VSC; B : LL_VSC) return LL_VSC is
3059       VA : constant VSC_View := To_View (A);
3060       VB : constant VSC_View := To_View (B);
3061       D  : VSC_View;
3062    begin
3063       D.Values := LL_VSC_Operations.vmrglx (VA.Values, VB.Values);
3064       return To_Vector (D);
3065    end vmrglb;
3066
3067    ------------
3068    -- vmrglh --
3069    ------------
3070
3071    function vmrglh (A : LL_VSS; B : LL_VSS) return LL_VSS is
3072       VA : constant VSS_View := To_View (A);
3073       VB : constant VSS_View := To_View (B);
3074       D  : VSS_View;
3075    begin
3076       D.Values := LL_VSS_Operations.vmrglx (VA.Values, VB.Values);
3077       return To_Vector (D);
3078    end vmrglh;
3079
3080    ------------
3081    -- vmrglw --
3082    ------------
3083
3084    function vmrglw (A : LL_VSI; B : LL_VSI) return LL_VSI is
3085       VA : constant VSI_View := To_View (A);
3086       VB : constant VSI_View := To_View (B);
3087       D  : VSI_View;
3088    begin
3089       D.Values := LL_VSI_Operations.vmrglx (VA.Values, VB.Values);
3090       return To_Vector (D);
3091    end vmrglw;
3092
3093    ------------
3094    -- mfvscr --
3095    ------------
3096
3097    function  mfvscr return LL_VSS is
3098       D : VUS_View;
3099    begin
3100       for J in Varray_unsigned_short'Range loop
3101          D.Values (J) := 0;
3102       end loop;
3103
3104       D.Values (Varray_unsigned_short'Last) :=
3105         unsigned_short (VSCR mod 2 ** unsigned_short'Size);
3106       D.Values (Varray_unsigned_short'Last - 1) :=
3107         unsigned_short (VSCR / 2 ** unsigned_short'Size);
3108       return To_LL_VSS (To_Vector (D));
3109    end mfvscr;
3110
3111    ------------
3112    -- vminfp --
3113    ------------
3114
3115    function vminfp (A : LL_VF;  B : LL_VF) return LL_VF is
3116       VA : constant VF_View := To_View (A);
3117       VB : constant VF_View := To_View (B);
3118       D  : VF_View;
3119
3120    begin
3121       for J in Varray_float'Range loop
3122          D.Values (J) := (if VA.Values (J) < VB.Values (J) then VA.Values (J)
3123                                                            else VB.Values (J));
3124       end loop;
3125
3126       return To_Vector (D);
3127    end vminfp;
3128
3129    ------------
3130    -- vminsb --
3131    ------------
3132
3133    function vminsb (A : LL_VSC; B : LL_VSC) return LL_VSC is
3134       VA : constant VSC_View := To_View (A);
3135       VB : constant VSC_View := To_View (B);
3136       D  : VSC_View;
3137    begin
3138       D.Values := LL_VSC_Operations.vminsx (VA.Values, VB.Values);
3139       return To_Vector (D);
3140    end vminsb;
3141
3142    ------------
3143    -- vminub --
3144    ------------
3145
3146    function vminub (A : LL_VSC; B : LL_VSC) return LL_VSC is
3147       VA : constant VUC_View := To_View (To_LL_VUC (A));
3148       VB : constant VUC_View := To_View (To_LL_VUC (B));
3149       D  : VUC_View;
3150    begin
3151       D.Values := LL_VUC_Operations.vminux (VA.Values, VB.Values);
3152       return To_LL_VSC (To_Vector (D));
3153    end vminub;
3154
3155    ------------
3156    -- vminsh --
3157    ------------
3158
3159    function vminsh (A : LL_VSS; B : LL_VSS) return LL_VSS is
3160       VA : constant VSS_View := To_View (A);
3161       VB : constant VSS_View := To_View (B);
3162       D  : VSS_View;
3163    begin
3164       D.Values := LL_VSS_Operations.vminsx (VA.Values, VB.Values);
3165       return To_Vector (D);
3166    end vminsh;
3167
3168    ------------
3169    -- vminuh --
3170    ------------
3171
3172    function vminuh (A : LL_VSS; B : LL_VSS) return LL_VSS is
3173       VA : constant VUS_View := To_View (To_LL_VUS (A));
3174       VB : constant VUS_View := To_View (To_LL_VUS (B));
3175       D  : VUS_View;
3176    begin
3177       D.Values := LL_VUS_Operations.vminux (VA.Values, VB.Values);
3178       return To_LL_VSS (To_Vector (D));
3179    end vminuh;
3180
3181    ------------
3182    -- vminsw --
3183    ------------
3184
3185    function vminsw (A : LL_VSI; B : LL_VSI) return LL_VSI is
3186       VA : constant VSI_View := To_View (A);
3187       VB : constant VSI_View := To_View (B);
3188       D  : VSI_View;
3189    begin
3190       D.Values := LL_VSI_Operations.vminsx (VA.Values, VB.Values);
3191       return To_Vector (D);
3192    end vminsw;
3193
3194    ------------
3195    -- vminuw --
3196    ------------
3197
3198    function vminuw (A : LL_VSI; B : LL_VSI) return LL_VSI is
3199       VA : constant VUI_View := To_View (To_LL_VUI (A));
3200       VB : constant VUI_View := To_View (To_LL_VUI (B));
3201       D  : VUI_View;
3202    begin
3203       D.Values := LL_VUI_Operations.vminux (VA.Values,
3204                                             VB.Values);
3205       return To_LL_VSI (To_Vector (D));
3206    end vminuw;
3207
3208    ---------------
3209    -- vmladduhm --
3210    ---------------
3211
3212    function vmladduhm (A : LL_VSS; B : LL_VSS; C : LL_VSS) return LL_VSS is
3213       VA : constant VUS_View := To_View (To_LL_VUS (A));
3214       VB : constant VUS_View := To_View (To_LL_VUS (B));
3215       VC : constant VUS_View := To_View (To_LL_VUS (C));
3216       D  : VUS_View;
3217
3218    begin
3219       for J in Varray_unsigned_short'Range loop
3220          D.Values (J) := VA.Values (J) * VB.Values (J)
3221            + VC.Values (J);
3222       end loop;
3223
3224       return To_LL_VSS (To_Vector (D));
3225    end vmladduhm;
3226
3227    ----------------
3228    -- vmhraddshs --
3229    ----------------
3230
3231    function vmhraddshs (A : LL_VSS; B : LL_VSS; C : LL_VSS) return LL_VSS is
3232       VA : constant VSS_View := To_View (A);
3233       VB : constant VSS_View := To_View (B);
3234       VC : constant VSS_View := To_View (C);
3235       D  : VSS_View;
3236
3237    begin
3238       for J in Varray_signed_short'Range loop
3239          D.Values (J) :=
3240            LL_VSS_Operations.Saturate (((SI64 (VA.Values (J))
3241                                          * SI64 (VB.Values (J))
3242                                          + 2 ** 14)
3243                                         / 2 ** 15
3244                                         + SI64 (VC.Values (J))));
3245       end loop;
3246
3247       return To_Vector (D);
3248    end vmhraddshs;
3249
3250    --------------
3251    -- vmsumubm --
3252    --------------
3253
3254    function vmsumubm (A : LL_VSC; B : LL_VSC; C : LL_VSI) return LL_VSI is
3255       Offset : Vchar_Range;
3256       VA     : constant VUC_View := To_View (To_LL_VUC (A));
3257       VB     : constant VUC_View := To_View (To_LL_VUC (B));
3258       VC     : constant VUI_View := To_View (To_LL_VUI (C));
3259       D      : VUI_View;
3260
3261    begin
3262       for J in 0 .. 3 loop
3263          Offset := Vchar_Range (4 * J + Integer (Vchar_Range'First));
3264          D.Values (Vint_Range
3265                    (J + Integer (Vint_Range'First))) :=
3266            (unsigned_int (VA.Values (Offset))
3267             * unsigned_int (VB.Values (Offset)))
3268            + (unsigned_int (VA.Values (Offset + 1))
3269               * unsigned_int (VB.Values (1 + Offset)))
3270            + (unsigned_int (VA.Values (2 + Offset))
3271               * unsigned_int (VB.Values (2 + Offset)))
3272            + (unsigned_int (VA.Values (3 + Offset))
3273               * unsigned_int (VB.Values (3 + Offset)))
3274            + VC.Values (Vint_Range
3275                         (J + Integer (Varray_unsigned_int'First)));
3276       end loop;
3277
3278       return To_LL_VSI (To_Vector (D));
3279    end vmsumubm;
3280
3281    --------------
3282    -- vmsumumbm --
3283    --------------
3284
3285    function vmsummbm (A : LL_VSC; B : LL_VSC; C : LL_VSI) return LL_VSI is
3286       Offset : Vchar_Range;
3287       VA     : constant VSC_View := To_View (A);
3288       VB     : constant VUC_View := To_View (To_LL_VUC (B));
3289       VC     : constant VSI_View := To_View (C);
3290       D      : VSI_View;
3291
3292    begin
3293       for J in 0 .. 3 loop
3294          Offset := Vchar_Range (4 * J + Integer (Vchar_Range'First));
3295          D.Values (Vint_Range
3296                    (J + Integer (Varray_unsigned_int'First))) := 0
3297            + LL_VSI_Operations.Modular_Result (SI64 (VA.Values (Offset))
3298                                                * SI64 (VB.Values (Offset)))
3299            + LL_VSI_Operations.Modular_Result (SI64 (VA.Values (Offset + 1))
3300                                                * SI64 (VB.Values
3301                                                        (1 + Offset)))
3302            + LL_VSI_Operations.Modular_Result (SI64 (VA.Values (2 + Offset))
3303                                                * SI64 (VB.Values
3304                                                        (2 + Offset)))
3305            + LL_VSI_Operations.Modular_Result (SI64 (VA.Values (3 + Offset))
3306                                                * SI64 (VB.Values
3307                                                        (3 + Offset)))
3308            + VC.Values (Vint_Range
3309                         (J + Integer (Varray_unsigned_int'First)));
3310       end loop;
3311
3312       return To_Vector (D);
3313    end vmsummbm;
3314
3315    --------------
3316    -- vmsumuhm --
3317    --------------
3318
3319    function vmsumuhm (A : LL_VSS; B : LL_VSS; C : LL_VSI) return LL_VSI is
3320       Offset : Vshort_Range;
3321       VA     : constant VUS_View := To_View (To_LL_VUS (A));
3322       VB     : constant VUS_View := To_View (To_LL_VUS (B));
3323       VC     : constant VUI_View := To_View (To_LL_VUI (C));
3324       D      : VUI_View;
3325
3326    begin
3327       for J in 0 .. 3 loop
3328          Offset :=
3329            Vshort_Range (2 * J + Integer (Vshort_Range'First));
3330          D.Values (Vint_Range
3331                    (J + Integer (Varray_unsigned_int'First))) :=
3332            (unsigned_int (VA.Values (Offset))
3333             * unsigned_int (VB.Values (Offset)))
3334            + (unsigned_int (VA.Values (Offset + 1))
3335               * unsigned_int (VB.Values (1 + Offset)))
3336            + VC.Values (Vint_Range
3337                         (J + Integer (Vint_Range'First)));
3338       end loop;
3339
3340       return To_LL_VSI (To_Vector (D));
3341    end vmsumuhm;
3342
3343    --------------
3344    -- vmsumshm --
3345    --------------
3346
3347    function vmsumshm (A : LL_VSS; B : LL_VSS; C : LL_VSI) return LL_VSI is
3348       VA     : constant VSS_View := To_View (A);
3349       VB     : constant VSS_View := To_View (B);
3350       VC     : constant VSI_View := To_View (C);
3351       Offset : Vshort_Range;
3352       D      : VSI_View;
3353
3354    begin
3355       for J in 0 .. 3 loop
3356          Offset :=
3357            Vshort_Range (2 * J + Integer (Varray_signed_char'First));
3358          D.Values (Vint_Range
3359                    (J + Integer (Varray_unsigned_int'First))) := 0
3360            + LL_VSI_Operations.Modular_Result (SI64 (VA.Values (Offset))
3361                                                * SI64 (VB.Values (Offset)))
3362            + LL_VSI_Operations.Modular_Result (SI64 (VA.Values (Offset + 1))
3363                                                * SI64 (VB.Values
3364                                                        (1 + Offset)))
3365            + VC.Values (Vint_Range
3366                         (J + Integer (Varray_unsigned_int'First)));
3367       end loop;
3368
3369       return To_Vector (D);
3370    end vmsumshm;
3371
3372    --------------
3373    -- vmsumuhs --
3374    --------------
3375
3376    function vmsumuhs (A : LL_VSS; B : LL_VSS; C : LL_VSI) return LL_VSI is
3377       Offset : Vshort_Range;
3378       VA     : constant VUS_View := To_View (To_LL_VUS (A));
3379       VB     : constant VUS_View := To_View (To_LL_VUS (B));
3380       VC     : constant VUI_View := To_View (To_LL_VUI (C));
3381       D      : VUI_View;
3382
3383    begin
3384       for J in 0 .. 3 loop
3385          Offset :=
3386            Vshort_Range (2 * J + Integer (Varray_signed_short'First));
3387          D.Values (Vint_Range
3388                    (J + Integer (Varray_unsigned_int'First))) :=
3389            LL_VUI_Operations.Saturate
3390            (UI64 (VA.Values (Offset))
3391             * UI64 (VB.Values (Offset))
3392             + UI64 (VA.Values (Offset + 1))
3393             * UI64 (VB.Values (1 + Offset))
3394             + UI64 (VC.Values
3395                     (Vint_Range
3396                      (J + Integer (Varray_unsigned_int'First)))));
3397       end loop;
3398
3399       return To_LL_VSI (To_Vector (D));
3400    end vmsumuhs;
3401
3402    --------------
3403    -- vmsumshs --
3404    --------------
3405
3406    function vmsumshs (A : LL_VSS; B : LL_VSS; C : LL_VSI) return LL_VSI is
3407       VA     : constant VSS_View := To_View (A);
3408       VB     : constant VSS_View := To_View (B);
3409       VC     : constant VSI_View := To_View (C);
3410       Offset : Vshort_Range;
3411       D      : VSI_View;
3412
3413    begin
3414       for J in 0 .. 3 loop
3415          Offset :=
3416            Vshort_Range (2 * J + Integer (Varray_signed_short'First));
3417          D.Values (Vint_Range
3418                    (J + Integer (Varray_signed_int'First))) :=
3419            LL_VSI_Operations.Saturate
3420            (SI64 (VA.Values (Offset))
3421             * SI64 (VB.Values (Offset))
3422             + SI64 (VA.Values (Offset + 1))
3423             * SI64 (VB.Values (1 + Offset))
3424             + SI64 (VC.Values
3425                     (Vint_Range
3426                      (J + Integer (Varray_signed_int'First)))));
3427       end loop;
3428
3429       return To_Vector (D);
3430    end vmsumshs;
3431
3432    ------------
3433    -- mtvscr --
3434    ------------
3435
3436    procedure mtvscr (A : LL_VSI) is
3437       VA : constant VUI_View := To_View (To_LL_VUI (A));
3438    begin
3439       VSCR := VA.Values (Varray_unsigned_int'Last);
3440    end mtvscr;
3441
3442    -------------
3443    -- vmuleub --
3444    -------------
3445
3446    function vmuleub (A : LL_VSC; B : LL_VSC) return LL_VSS is
3447       VA : constant VUC_View := To_View (To_LL_VUC (A));
3448       VB : constant VUC_View := To_View (To_LL_VUC (B));
3449       D  : VUS_View;
3450    begin
3451       D.Values := LL_VUC_LL_VUS_Operations.vmulxux (True,
3452                                                     VA.Values,
3453                                                     VB.Values);
3454       return To_LL_VSS (To_Vector (D));
3455    end vmuleub;
3456
3457    -------------
3458    -- vmuleuh --
3459    -------------
3460
3461    function vmuleuh (A : LL_VSS; B : LL_VSS) return LL_VSI is
3462       VA : constant VUS_View := To_View (To_LL_VUS (A));
3463       VB : constant VUS_View := To_View (To_LL_VUS (B));
3464       D  : VUI_View;
3465    begin
3466       D.Values := LL_VUS_LL_VUI_Operations.vmulxux (True,
3467                                                     VA.Values,
3468                                                     VB.Values);
3469       return To_LL_VSI (To_Vector (D));
3470    end vmuleuh;
3471
3472    -------------
3473    -- vmulesb --
3474    -------------
3475
3476    function vmulesb (A : LL_VSC; B : LL_VSC) return LL_VSS is
3477       VA : constant VSC_View := To_View (A);
3478       VB : constant VSC_View := To_View (B);
3479       D  : VSS_View;
3480    begin
3481       D.Values := LL_VSC_LL_VSS_Operations.vmulxsx (True,
3482                                                     VA.Values,
3483                                                     VB.Values);
3484       return To_Vector (D);
3485    end vmulesb;
3486
3487    -------------
3488    -- vmulesh --
3489    -------------
3490
3491    function vmulesh (A : LL_VSS; B : LL_VSS) return LL_VSI is
3492       VA : constant VSS_View := To_View (A);
3493       VB : constant VSS_View := To_View (B);
3494       D  : VSI_View;
3495    begin
3496       D.Values := LL_VSS_LL_VSI_Operations.vmulxsx (True,
3497                                                     VA.Values,
3498                                                     VB.Values);
3499       return To_Vector (D);
3500    end vmulesh;
3501
3502    -------------
3503    -- vmuloub --
3504    -------------
3505
3506    function vmuloub (A : LL_VSC; B : LL_VSC) return LL_VSS is
3507       VA : constant VUC_View := To_View (To_LL_VUC (A));
3508       VB : constant VUC_View := To_View (To_LL_VUC (B));
3509       D  : VUS_View;
3510    begin
3511       D.Values := LL_VUC_LL_VUS_Operations.vmulxux (False,
3512                                                     VA.Values,
3513                                                     VB.Values);
3514       return To_LL_VSS (To_Vector (D));
3515    end vmuloub;
3516
3517    -------------
3518    -- vmulouh --
3519    -------------
3520
3521    function vmulouh (A : LL_VSS; B : LL_VSS) return LL_VSI is
3522       VA : constant VUS_View := To_View (To_LL_VUS (A));
3523       VB : constant VUS_View := To_View (To_LL_VUS (B));
3524       D  : VUI_View;
3525    begin
3526       D.Values :=
3527         LL_VUS_LL_VUI_Operations.vmulxux (False, VA.Values, VB.Values);
3528       return To_LL_VSI (To_Vector (D));
3529    end vmulouh;
3530
3531    -------------
3532    -- vmulosb --
3533    -------------
3534
3535    function vmulosb (A : LL_VSC; B : LL_VSC) return LL_VSS is
3536       VA : constant VSC_View := To_View (A);
3537       VB : constant VSC_View := To_View (B);
3538       D  : VSS_View;
3539    begin
3540       D.Values := LL_VSC_LL_VSS_Operations.vmulxsx (False,
3541                                                     VA.Values,
3542                                                     VB.Values);
3543       return To_Vector (D);
3544    end vmulosb;
3545
3546    -------------
3547    -- vmulosh --
3548    -------------
3549
3550    function vmulosh (A : LL_VSS; B : LL_VSS) return LL_VSI is
3551       VA : constant VSS_View := To_View (A);
3552       VB : constant VSS_View := To_View (B);
3553       D  : VSI_View;
3554    begin
3555       D.Values := LL_VSS_LL_VSI_Operations.vmulxsx (False,
3556                                                     VA.Values,
3557                                                     VB.Values);
3558       return To_Vector (D);
3559    end vmulosh;
3560
3561    --------------
3562    -- vnmsubfp --
3563    --------------
3564
3565    function vnmsubfp (A : LL_VF; B : LL_VF; C : LL_VF) return LL_VF is
3566       VA : constant VF_View := To_View (A);
3567       VB : constant VF_View := To_View (B);
3568       VC : constant VF_View := To_View (C);
3569       D  : VF_View;
3570
3571    begin
3572       for J in Vfloat_Range'Range loop
3573          D.Values (J) :=
3574            -Rnd_To_FP_Nearest (F64 (VA.Values (J))
3575                                * F64 (VB.Values (J))
3576                                - F64 (VC.Values (J)));
3577       end loop;
3578
3579       return To_Vector (D);
3580    end vnmsubfp;
3581
3582    ----------
3583    -- vnor --
3584    ----------
3585
3586    function vnor (A : LL_VSI; B : LL_VSI) return LL_VSI is
3587       VA : constant VUI_View := To_View (To_LL_VUI (A));
3588       VB : constant VUI_View := To_View (To_LL_VUI (B));
3589       D  : VUI_View;
3590
3591    begin
3592       for J in Vint_Range'Range loop
3593          D.Values (J) := not (VA.Values (J) or VB.Values (J));
3594       end loop;
3595
3596       return To_LL_VSI (To_Vector (D));
3597    end vnor;
3598
3599    ----------
3600    -- vor --
3601    ----------
3602
3603    function vor (A : LL_VSI; B : LL_VSI) return LL_VSI is
3604       VA : constant VUI_View := To_View (To_LL_VUI (A));
3605       VB : constant VUI_View := To_View (To_LL_VUI (B));
3606       D  : VUI_View;
3607
3608    begin
3609       for J in Vint_Range'Range loop
3610          D.Values (J) := VA.Values (J) or VB.Values (J);
3611       end loop;
3612
3613       return To_LL_VSI (To_Vector (D));
3614    end vor;
3615
3616    -------------
3617    -- vpkuhum --
3618    -------------
3619
3620    function vpkuhum (A : LL_VSS; B : LL_VSS) return LL_VSC is
3621       VA : constant VUS_View := To_View (To_LL_VUS (A));
3622       VB : constant VUS_View := To_View (To_LL_VUS (B));
3623       D  : VUC_View;
3624    begin
3625       D.Values := LL_VUC_LL_VUS_Operations.vpkuxum (VA.Values, VB.Values);
3626       return To_LL_VSC (To_Vector (D));
3627    end vpkuhum;
3628
3629    -------------
3630    -- vpkuwum --
3631    -------------
3632
3633    function vpkuwum (A : LL_VSI; B : LL_VSI) return LL_VSS is
3634       VA : constant VUI_View := To_View (To_LL_VUI (A));
3635       VB : constant VUI_View := To_View (To_LL_VUI (B));
3636       D  : VUS_View;
3637    begin
3638       D.Values := LL_VUS_LL_VUI_Operations.vpkuxum (VA.Values, VB.Values);
3639       return To_LL_VSS (To_Vector (D));
3640    end vpkuwum;
3641
3642    -----------
3643    -- vpkpx --
3644    -----------
3645
3646    function vpkpx (A : LL_VSI; B : LL_VSI) return LL_VSS is
3647       VA     : constant VUI_View := To_View (To_LL_VUI (A));
3648       VB     : constant VUI_View := To_View (To_LL_VUI (B));
3649       D      : VUS_View;
3650       Offset : Vint_Range;
3651       P16    : Pixel_16;
3652       P32    : Pixel_32;
3653
3654    begin
3655       for J in 0 .. 3 loop
3656          Offset := Vint_Range (J + Integer (Vshort_Range'First));
3657          P32 := To_Pixel (VA.Values (Offset));
3658          P16.T := Unsigned_1 (P32.T mod 2 ** 1);
3659          P16.R := Unsigned_5 (Shift_Right (P32.R, 3) mod 2 ** 5);
3660          P16.G := Unsigned_5 (Shift_Right (P32.G, 3) mod 2 ** 5);
3661          P16.B := Unsigned_5 (Shift_Right (P32.B, 3) mod 2 ** 5);
3662          D.Values (Vshort_Range (Offset)) := To_unsigned_short (P16);
3663          P32 := To_Pixel (VB.Values (Offset));
3664          P16.T := Unsigned_1 (P32.T mod 2 ** 1);
3665          P16.R := Unsigned_5 (Shift_Right (P32.R, 3) mod 2 ** 5);
3666          P16.G := Unsigned_5 (Shift_Right (P32.G, 3) mod 2 ** 5);
3667          P16.B := Unsigned_5 (Shift_Right (P32.B, 3) mod 2 ** 5);
3668          D.Values (Vshort_Range (Offset) + 4) := To_unsigned_short (P16);
3669       end loop;
3670
3671       return To_LL_VSS (To_Vector (D));
3672    end vpkpx;
3673
3674    -------------
3675    -- vpkuhus --
3676    -------------
3677
3678    function vpkuhus (A : LL_VSS; B : LL_VSS) return LL_VSC is
3679       VA : constant VUS_View := To_View (To_LL_VUS (A));
3680       VB : constant VUS_View := To_View (To_LL_VUS (B));
3681       D  : VUC_View;
3682    begin
3683       D.Values := LL_VUC_LL_VUS_Operations.vpkuxus (VA.Values, VB.Values);
3684       return To_LL_VSC (To_Vector (D));
3685    end vpkuhus;
3686
3687    -------------
3688    -- vpkuwus --
3689    -------------
3690
3691    function vpkuwus (A : LL_VSI; B : LL_VSI) return LL_VSS is
3692       VA : constant VUI_View := To_View (To_LL_VUI (A));
3693       VB : constant VUI_View := To_View (To_LL_VUI (B));
3694       D  : VUS_View;
3695    begin
3696       D.Values := LL_VUS_LL_VUI_Operations.vpkuxus (VA.Values, VB.Values);
3697       return To_LL_VSS (To_Vector (D));
3698    end vpkuwus;
3699
3700    -------------
3701    -- vpkshss --
3702    -------------
3703
3704    function vpkshss (A : LL_VSS; B : LL_VSS) return LL_VSC is
3705       VA : constant VSS_View := To_View (A);
3706       VB : constant VSS_View := To_View (B);
3707       D  : VSC_View;
3708    begin
3709       D.Values := LL_VSC_LL_VSS_Operations.vpksxss (VA.Values, VB.Values);
3710       return To_Vector (D);
3711    end vpkshss;
3712
3713    -------------
3714    -- vpkswss --
3715    -------------
3716
3717    function vpkswss (A : LL_VSI; B : LL_VSI) return LL_VSS is
3718       VA : constant VSI_View := To_View (A);
3719       VB : constant VSI_View := To_View (B);
3720       D  : VSS_View;
3721    begin
3722       D.Values := LL_VSS_LL_VSI_Operations.vpksxss (VA.Values, VB.Values);
3723       return To_Vector (D);
3724    end vpkswss;
3725
3726    -------------
3727    -- vpksxus --
3728    -------------
3729
3730    generic
3731       type Signed_Component_Type is range <>;
3732       type Signed_Index_Type is range <>;
3733       type Signed_Varray_Type is
3734         array (Signed_Index_Type) of Signed_Component_Type;
3735       type Unsigned_Component_Type is mod <>;
3736       type Unsigned_Index_Type is range <>;
3737       type Unsigned_Varray_Type is
3738         array (Unsigned_Index_Type) of Unsigned_Component_Type;
3739
3740    function vpksxus
3741      (A : Signed_Varray_Type;
3742       B : Signed_Varray_Type) return Unsigned_Varray_Type;
3743
3744    function vpksxus
3745      (A : Signed_Varray_Type;
3746       B : Signed_Varray_Type) return Unsigned_Varray_Type
3747    is
3748       N             : constant Unsigned_Index_Type :=
3749                         Unsigned_Index_Type (Signed_Index_Type'Last);
3750       Offset        : Unsigned_Index_Type;
3751       Signed_Offset : Signed_Index_Type;
3752       D             : Unsigned_Varray_Type;
3753
3754       function Saturate
3755         (X : Signed_Component_Type) return Unsigned_Component_Type;
3756       --  Saturation, as defined in
3757       --  [PIM-4.1 Vector Status and Control Register]
3758
3759       --------------
3760       -- Saturate --
3761       --------------
3762
3763       function Saturate
3764         (X : Signed_Component_Type) return Unsigned_Component_Type
3765       is
3766          D : Unsigned_Component_Type;
3767
3768       begin
3769          D := Unsigned_Component_Type
3770            (Signed_Component_Type'Max
3771             (Signed_Component_Type (Unsigned_Component_Type'First),
3772              Signed_Component_Type'Min
3773              (Signed_Component_Type (Unsigned_Component_Type'Last),
3774               X)));
3775          if Signed_Component_Type (D) /= X then
3776             VSCR := Write_Bit (VSCR, SAT_POS, 1);
3777          end if;
3778
3779          return D;
3780       end Saturate;
3781
3782       --  Start of processing for vpksxus
3783
3784    begin
3785       for J in 0 .. N - 1 loop
3786          Offset :=
3787            Unsigned_Index_Type (Integer (J)
3788                                 + Integer (Unsigned_Index_Type'First));
3789          Signed_Offset :=
3790            Signed_Index_Type (Integer (J)
3791                               + Integer (Signed_Index_Type'First));
3792          D (Offset) := Saturate (A (Signed_Offset));
3793          D (Offset + N) := Saturate (B (Signed_Offset));
3794       end loop;
3795
3796       return D;
3797    end vpksxus;
3798
3799    -------------
3800    -- vpkshus --
3801    -------------
3802
3803    function vpkshus (A : LL_VSS; B : LL_VSS) return LL_VSC is
3804       function vpkshus_Instance is
3805         new vpksxus (signed_short,
3806                      Vshort_Range,
3807                      Varray_signed_short,
3808                      unsigned_char,
3809                      Vchar_Range,
3810                      Varray_unsigned_char);
3811
3812       VA : constant VSS_View := To_View (A);
3813       VB : constant VSS_View := To_View (B);
3814       D  : VUC_View;
3815
3816    begin
3817       D.Values := vpkshus_Instance (VA.Values, VB.Values);
3818       return To_LL_VSC (To_Vector (D));
3819    end vpkshus;
3820
3821    -------------
3822    -- vpkswus --
3823    -------------
3824
3825    function vpkswus (A : LL_VSI; B : LL_VSI) return LL_VSS is
3826       function vpkswus_Instance is
3827         new vpksxus (signed_int,
3828                      Vint_Range,
3829                      Varray_signed_int,
3830                      unsigned_short,
3831                      Vshort_Range,
3832                      Varray_unsigned_short);
3833
3834       VA : constant VSI_View := To_View (A);
3835       VB : constant VSI_View := To_View (B);
3836       D  : VUS_View;
3837    begin
3838       D.Values := vpkswus_Instance (VA.Values, VB.Values);
3839       return To_LL_VSS (To_Vector (D));
3840    end vpkswus;
3841
3842    ---------------
3843    -- vperm_4si --
3844    ---------------
3845
3846    function vperm_4si (A : LL_VSI; B : LL_VSI; C : LL_VSC) return LL_VSI is
3847       VA : constant VUC_View := To_View (To_LL_VUC (A));
3848       VB : constant VUC_View := To_View (To_LL_VUC (B));
3849       VC : constant VUC_View := To_View (To_LL_VUC (C));
3850       J  : Vchar_Range;
3851       D  : VUC_View;
3852
3853    begin
3854       for N in Vchar_Range'Range loop
3855          J := Vchar_Range (Integer (Bits (VC.Values (N), 4, 7))
3856                            + Integer (Vchar_Range'First));
3857          D.Values (N) :=
3858            (if Bits (VC.Values (N), 3, 3) = 0 then VA.Values (J)
3859                                               else VB.Values (J));
3860       end loop;
3861
3862       return To_LL_VSI (To_Vector (D));
3863    end vperm_4si;
3864
3865    -----------
3866    -- vrefp --
3867    -----------
3868
3869    function vrefp (A : LL_VF) return LL_VF is
3870       VA : constant VF_View := To_View (A);
3871       D  : VF_View;
3872
3873    begin
3874       for J in Vfloat_Range'Range loop
3875          D.Values (J) := FP_Recip_Est (VA.Values (J));
3876       end loop;
3877
3878       return To_Vector (D);
3879    end vrefp;
3880
3881    ----------
3882    -- vrlb --
3883    ----------
3884
3885    function vrlb (A : LL_VSC; B : LL_VSC) return LL_VSC is
3886       VA : constant VUC_View := To_View (To_LL_VUC (A));
3887       VB : constant VUC_View := To_View (To_LL_VUC (B));
3888       D  : VUC_View;
3889    begin
3890       D.Values := LL_VUC_Operations.vrlx (VA.Values, VB.Values, ROTL'Access);
3891       return To_LL_VSC (To_Vector (D));
3892    end vrlb;
3893
3894    ----------
3895    -- vrlh --
3896    ----------
3897
3898    function vrlh (A : LL_VSS; B : LL_VSS) return LL_VSS is
3899       VA : constant VUS_View := To_View (To_LL_VUS (A));
3900       VB : constant VUS_View := To_View (To_LL_VUS (B));
3901       D  : VUS_View;
3902    begin
3903       D.Values := LL_VUS_Operations.vrlx (VA.Values, VB.Values, ROTL'Access);
3904       return To_LL_VSS (To_Vector (D));
3905    end vrlh;
3906
3907    ----------
3908    -- vrlw --
3909    ----------
3910
3911    function vrlw (A : LL_VSI; B : LL_VSI) return LL_VSI is
3912       VA : constant VUI_View := To_View (To_LL_VUI (A));
3913       VB : constant VUI_View := To_View (To_LL_VUI (B));
3914       D  : VUI_View;
3915    begin
3916       D.Values := LL_VUI_Operations.vrlx (VA.Values, VB.Values, ROTL'Access);
3917       return To_LL_VSI (To_Vector (D));
3918    end vrlw;
3919
3920    -----------
3921    -- vrfin --
3922    -----------
3923
3924    function vrfin (A : LL_VF) return LL_VF is
3925       VA : constant VF_View := To_View (A);
3926       D  : VF_View;
3927
3928    begin
3929       for J in Vfloat_Range'Range loop
3930          D.Values (J) := C_float (Rnd_To_FPI_Near (F64 (VA.Values (J))));
3931       end loop;
3932
3933       return To_Vector (D);
3934    end vrfin;
3935
3936    ---------------
3937    -- vrsqrtefp --
3938    ---------------
3939
3940    function vrsqrtefp (A : LL_VF) return LL_VF is
3941       VA : constant VF_View := To_View (A);
3942       D  : VF_View;
3943
3944    begin
3945       for J in Vfloat_Range'Range loop
3946          D.Values (J) := Recip_SQRT_Est (VA.Values (J));
3947       end loop;
3948
3949       return To_Vector (D);
3950    end vrsqrtefp;
3951
3952    --------------
3953    -- vsel_4si --
3954    --------------
3955
3956    function vsel_4si (A : LL_VSI; B : LL_VSI; C : LL_VSI) return LL_VSI is
3957       VA : constant VUI_View := To_View (To_LL_VUI (A));
3958       VB : constant VUI_View := To_View (To_LL_VUI (B));
3959       VC : constant VUI_View := To_View (To_LL_VUI (C));
3960       D  : VUI_View;
3961
3962    begin
3963       for J in Vint_Range'Range loop
3964          D.Values (J) := ((not VC.Values (J)) and VA.Values (J))
3965            or (VC.Values (J) and VB.Values (J));
3966       end loop;
3967
3968       return To_LL_VSI (To_Vector (D));
3969    end vsel_4si;
3970
3971    ----------
3972    -- vslb --
3973    ----------
3974
3975    function vslb (A : LL_VSC; B : LL_VSC) return LL_VSC is
3976       VA : constant VUC_View := To_View (To_LL_VUC (A));
3977       VB : constant VUC_View := To_View (To_LL_VUC (B));
3978       D  : VUC_View;
3979    begin
3980       D.Values :=
3981         LL_VUC_Operations.vsxx (VA.Values, VB.Values, Shift_Left'Access);
3982       return To_LL_VSC (To_Vector (D));
3983    end vslb;
3984
3985    ----------
3986    -- vslh --
3987    ----------
3988
3989    function vslh (A : LL_VSS; B : LL_VSS) return LL_VSS is
3990       VA : constant VUS_View := To_View (To_LL_VUS (A));
3991       VB : constant VUS_View := To_View (To_LL_VUS (B));
3992       D  : VUS_View;
3993    begin
3994       D.Values :=
3995         LL_VUS_Operations.vsxx (VA.Values, VB.Values, Shift_Left'Access);
3996       return To_LL_VSS (To_Vector (D));
3997    end vslh;
3998
3999    ----------
4000    -- vslw --
4001    ----------
4002
4003    function vslw (A : LL_VSI; B : LL_VSI) return LL_VSI is
4004       VA : constant VUI_View := To_View (To_LL_VUI (A));
4005       VB : constant VUI_View := To_View (To_LL_VUI (B));
4006       D  : VUI_View;
4007    begin
4008       D.Values :=
4009         LL_VUI_Operations.vsxx (VA.Values, VB.Values, Shift_Left'Access);
4010       return To_LL_VSI (To_Vector (D));
4011    end vslw;
4012
4013    ----------------
4014    -- vsldoi_4si --
4015    ----------------
4016
4017    function vsldoi_4si (A : LL_VSI; B : LL_VSI; C : c_int) return LL_VSI is
4018       VA     : constant VUC_View := To_View (To_LL_VUC (A));
4019       VB     : constant VUC_View := To_View (To_LL_VUC (B));
4020       Offset : c_int;
4021       Bound  : c_int;
4022       D      : VUC_View;
4023
4024    begin
4025       for J in Vchar_Range'Range loop
4026          Offset := c_int (J) + C;
4027          Bound := c_int (Vchar_Range'First)
4028            + c_int (Varray_unsigned_char'Length);
4029
4030          if Offset < Bound then
4031             D.Values (J) := VA.Values (Vchar_Range (Offset));
4032          else
4033             D.Values (J) :=
4034               VB.Values (Vchar_Range (Offset - Bound
4035                                       + c_int (Vchar_Range'First)));
4036          end if;
4037       end loop;
4038
4039       return To_LL_VSI (To_Vector (D));
4040    end vsldoi_4si;
4041
4042    ----------------
4043    -- vsldoi_8hi --
4044    ----------------
4045
4046    function vsldoi_8hi (A : LL_VSS; B : LL_VSS; C : c_int) return LL_VSS is
4047    begin
4048       return To_LL_VSS (vsldoi_4si (To_LL_VSI (A), To_LL_VSI (B), C));
4049    end vsldoi_8hi;
4050
4051    -----------------
4052    -- vsldoi_16qi --
4053    -----------------
4054
4055    function vsldoi_16qi (A : LL_VSC; B : LL_VSC; C : c_int) return LL_VSC is
4056    begin
4057       return To_LL_VSC (vsldoi_4si (To_LL_VSI (A), To_LL_VSI (B), C));
4058    end vsldoi_16qi;
4059
4060    ----------------
4061    -- vsldoi_4sf --
4062    ----------------
4063
4064    function vsldoi_4sf (A : LL_VF; B : LL_VF; C : c_int) return LL_VF is
4065    begin
4066       return To_LL_VF (vsldoi_4si (To_LL_VSI (A), To_LL_VSI (B), C));
4067    end vsldoi_4sf;
4068
4069    ---------
4070    -- vsl --
4071    ---------
4072
4073    function vsl  (A : LL_VSI; B : LL_VSI) return LL_VSI is
4074       VA : constant VUI_View := To_View (To_LL_VUI (A));
4075       VB : constant VUI_View := To_View (To_LL_VUI (B));
4076       D  : VUI_View;
4077       M  : constant Natural :=
4078              Natural (Bits (VB.Values (Vint_Range'Last), 29, 31));
4079
4080       --  [PIM-4.4 vec_sll] "Note that the three low-order byte elements in B
4081       --  must be the same. Otherwise the value placed into D is undefined."
4082       --  ??? Shall we add a optional check for B?
4083
4084    begin
4085       for J in Vint_Range'Range loop
4086          D.Values (J) := 0;
4087          D.Values (J) := D.Values (J) + Shift_Left (VA.Values (J), M);
4088
4089          if J /= Vint_Range'Last then
4090             D.Values (J) :=
4091               D.Values (J) + Shift_Right (VA.Values (J + 1),
4092                                           signed_int'Size - M);
4093          end if;
4094       end loop;
4095
4096       return To_LL_VSI (To_Vector (D));
4097    end vsl;
4098
4099    ----------
4100    -- vslo --
4101    ----------
4102
4103    function vslo (A : LL_VSI; B : LL_VSI) return LL_VSI is
4104       VA : constant VUC_View := To_View (To_LL_VUC (A));
4105       VB : constant VUC_View := To_View (To_LL_VUC (B));
4106       D  : VUC_View;
4107       M  : constant Natural :=
4108              Natural (Bits (VB.Values (Vchar_Range'Last), 1, 4));
4109       J  : Natural;
4110
4111    begin
4112       for N in Vchar_Range'Range loop
4113          J := Natural (N) + M;
4114          D.Values (N) :=
4115            (if J <= Natural (Vchar_Range'Last) then VA.Values (Vchar_Range (J))
4116                                                else 0);
4117       end loop;
4118
4119       return To_LL_VSI (To_Vector (D));
4120    end vslo;
4121
4122    ------------
4123    -- vspltb --
4124    ------------
4125
4126    function vspltb (A : LL_VSC; B : c_int) return LL_VSC is
4127       VA : constant VSC_View := To_View (A);
4128       D  : VSC_View;
4129    begin
4130       D.Values := LL_VSC_Operations.vspltx (VA.Values, B);
4131       return To_Vector (D);
4132    end vspltb;
4133
4134    ------------
4135    -- vsplth --
4136    ------------
4137
4138    function vsplth (A : LL_VSS; B : c_int) return LL_VSS is
4139       VA : constant VSS_View := To_View (A);
4140       D  : VSS_View;
4141    begin
4142       D.Values := LL_VSS_Operations.vspltx (VA.Values, B);
4143       return To_Vector (D);
4144    end vsplth;
4145
4146    ------------
4147    -- vspltw --
4148    ------------
4149
4150    function vspltw (A : LL_VSI; B : c_int) return LL_VSI is
4151       VA : constant VSI_View := To_View (A);
4152       D  : VSI_View;
4153    begin
4154       D.Values := LL_VSI_Operations.vspltx (VA.Values, B);
4155       return To_Vector (D);
4156    end vspltw;
4157
4158    --------------
4159    -- vspltisb --
4160    --------------
4161
4162    function vspltisb (A : c_int) return LL_VSC is
4163       D : VSC_View;
4164    begin
4165       D.Values := LL_VSC_Operations.vspltisx (A);
4166       return To_Vector (D);
4167    end vspltisb;
4168
4169    --------------
4170    -- vspltish --
4171    --------------
4172
4173    function vspltish (A : c_int) return LL_VSS is
4174       D : VSS_View;
4175    begin
4176       D.Values := LL_VSS_Operations.vspltisx (A);
4177       return To_Vector (D);
4178    end vspltish;
4179
4180    --------------
4181    -- vspltisw --
4182    --------------
4183
4184    function vspltisw (A : c_int) return LL_VSI is
4185       D : VSI_View;
4186    begin
4187       D.Values := LL_VSI_Operations.vspltisx (A);
4188       return To_Vector (D);
4189    end vspltisw;
4190
4191    ----------
4192    -- vsrb --
4193    ----------
4194
4195    function vsrb (A : LL_VSC; B : LL_VSC) return LL_VSC is
4196       VA : constant VUC_View := To_View (To_LL_VUC (A));
4197       VB : constant VUC_View := To_View (To_LL_VUC (B));
4198       D  : VUC_View;
4199    begin
4200       D.Values :=
4201         LL_VUC_Operations.vsxx (VA.Values, VB.Values, Shift_Right'Access);
4202       return To_LL_VSC (To_Vector (D));
4203    end vsrb;
4204
4205    ----------
4206    -- vsrh --
4207    ----------
4208
4209    function vsrh (A : LL_VSS; B : LL_VSS) return LL_VSS is
4210       VA : constant VUS_View := To_View (To_LL_VUS (A));
4211       VB : constant VUS_View := To_View (To_LL_VUS (B));
4212       D  : VUS_View;
4213    begin
4214       D.Values :=
4215         LL_VUS_Operations.vsxx (VA.Values, VB.Values, Shift_Right'Access);
4216       return To_LL_VSS (To_Vector (D));
4217    end vsrh;
4218
4219    ----------
4220    -- vsrw --
4221    ----------
4222
4223    function vsrw (A : LL_VSI; B : LL_VSI) return LL_VSI is
4224       VA : constant VUI_View := To_View (To_LL_VUI (A));
4225       VB : constant VUI_View := To_View (To_LL_VUI (B));
4226       D  : VUI_View;
4227    begin
4228       D.Values :=
4229         LL_VUI_Operations.vsxx (VA.Values, VB.Values, Shift_Right'Access);
4230       return To_LL_VSI (To_Vector (D));
4231    end vsrw;
4232
4233    -----------
4234    -- vsrab --
4235    -----------
4236
4237    function vsrab (A : LL_VSC; B : LL_VSC) return LL_VSC is
4238       VA : constant VSC_View := To_View (A);
4239       VB : constant VSC_View := To_View (B);
4240       D  : VSC_View;
4241    begin
4242       D.Values :=
4243         LL_VSC_Operations.vsrax (VA.Values, VB.Values, Shift_Right_A'Access);
4244       return To_Vector (D);
4245    end vsrab;
4246
4247    -----------
4248    -- vsrah --
4249    -----------
4250
4251    function vsrah (A : LL_VSS; B : LL_VSS) return LL_VSS is
4252       VA : constant VSS_View := To_View (A);
4253       VB : constant VSS_View := To_View (B);
4254       D  : VSS_View;
4255    begin
4256       D.Values :=
4257         LL_VSS_Operations.vsrax (VA.Values, VB.Values, Shift_Right_A'Access);
4258       return To_Vector (D);
4259    end vsrah;
4260
4261    -----------
4262    -- vsraw --
4263    -----------
4264
4265    function vsraw (A : LL_VSI; B : LL_VSI) return LL_VSI is
4266       VA : constant VSI_View := To_View (A);
4267       VB : constant VSI_View := To_View (B);
4268       D  : VSI_View;
4269    begin
4270       D.Values :=
4271         LL_VSI_Operations.vsrax (VA.Values, VB.Values, Shift_Right_A'Access);
4272       return To_Vector (D);
4273    end vsraw;
4274
4275    ---------
4276    -- vsr --
4277    ---------
4278
4279    function vsr  (A : LL_VSI; B : LL_VSI) return LL_VSI is
4280       VA : constant VUI_View := To_View (To_LL_VUI (A));
4281       VB : constant VUI_View := To_View (To_LL_VUI (B));
4282       M  : constant Natural :=
4283              Natural (Bits (VB.Values (Vint_Range'Last), 29, 31));
4284       D  : VUI_View;
4285
4286    begin
4287       for J in Vint_Range'Range loop
4288          D.Values (J) := 0;
4289          D.Values (J) := D.Values (J) + Shift_Right (VA.Values (J), M);
4290
4291          if J /= Vint_Range'First then
4292             D.Values (J) :=
4293               D.Values (J)
4294               + Shift_Left (VA.Values (J - 1), signed_int'Size - M);
4295          end if;
4296       end loop;
4297
4298       return To_LL_VSI (To_Vector (D));
4299    end vsr;
4300
4301    ----------
4302    -- vsro --
4303    ----------
4304
4305    function vsro (A : LL_VSI; B : LL_VSI) return LL_VSI is
4306       VA : constant VUC_View := To_View (To_LL_VUC (A));
4307       VB : constant VUC_View := To_View (To_LL_VUC (B));
4308       M  : constant Natural :=
4309              Natural (Bits (VB.Values (Vchar_Range'Last), 1, 4));
4310       J  : Natural;
4311       D  : VUC_View;
4312
4313    begin
4314       for N in Vchar_Range'Range loop
4315          J := Natural (N) - M;
4316
4317          if J >= Natural (Vchar_Range'First) then
4318             D.Values (N) := VA.Values (Vchar_Range (J));
4319          else
4320             D.Values (N) := 0;
4321          end if;
4322       end loop;
4323
4324       return To_LL_VSI (To_Vector (D));
4325    end vsro;
4326
4327    ----------
4328    -- stvx --
4329    ----------
4330
4331    procedure stvx   (A : LL_VSI; B : c_int; C : c_ptr) is
4332
4333       --  Simulate the altivec unit behavior regarding what Effective Address
4334       --  is accessed, stripping off the input address least significant bits
4335       --  wrt to vector alignment (see comment in lvx for further details).
4336
4337       EA : constant System.Address :=
4338              To_Address
4339                (Bound_Align
4340                   (Integer_Address (B) + To_Integer (C), VECTOR_ALIGNMENT));
4341
4342       D  : LL_VSI;
4343       for D'Address use EA;
4344
4345    begin
4346       D := A;
4347    end stvx;
4348
4349    ------------
4350    -- stvewx --
4351    ------------
4352
4353    procedure stvebx (A : LL_VSC; B : c_int; C : c_ptr) is
4354       VA : constant VSC_View := To_View (A);
4355    begin
4356       LL_VSC_Operations.stvexx (VA.Values, B, C);
4357    end stvebx;
4358
4359    ------------
4360    -- stvehx --
4361    ------------
4362
4363    procedure stvehx (A : LL_VSS; B : c_int; C : c_ptr) is
4364       VA : constant VSS_View := To_View (A);
4365    begin
4366       LL_VSS_Operations.stvexx (VA.Values, B, C);
4367    end stvehx;
4368
4369    ------------
4370    -- stvewx --
4371    ------------
4372
4373    procedure stvewx (A : LL_VSI; B : c_int; C : c_ptr) is
4374       VA : constant VSI_View := To_View (A);
4375    begin
4376       LL_VSI_Operations.stvexx (VA.Values, B, C);
4377    end stvewx;
4378
4379    -----------
4380    -- stvxl --
4381    -----------
4382
4383    procedure stvxl   (A : LL_VSI; B : c_int; C : c_ptr) renames stvx;
4384
4385    -------------
4386    -- vsububm --
4387    -------------
4388
4389    function vsububm (A : LL_VSC; B : LL_VSC) return LL_VSC is
4390       VA : constant VUC_View := To_View (To_LL_VUC (A));
4391       VB : constant VUC_View := To_View (To_LL_VUC (B));
4392       D  : VUC_View;
4393    begin
4394       D.Values := LL_VUC_Operations.vsubuxm (VA.Values, VB.Values);
4395       return To_LL_VSC (To_Vector (D));
4396    end vsububm;
4397
4398    -------------
4399    -- vsubuhm --
4400    -------------
4401
4402    function vsubuhm (A : LL_VSS; B : LL_VSS) return LL_VSS is
4403       VA : constant VUS_View := To_View (To_LL_VUS (A));
4404       VB : constant VUS_View := To_View (To_LL_VUS (B));
4405       D  : VUS_View;
4406    begin
4407       D.Values := LL_VUS_Operations.vsubuxm (VA.Values, VB.Values);
4408       return To_LL_VSS (To_Vector (D));
4409    end vsubuhm;
4410
4411    -------------
4412    -- vsubuwm --
4413    -------------
4414
4415    function vsubuwm (A : LL_VSI; B : LL_VSI) return LL_VSI is
4416       VA : constant VUI_View := To_View (To_LL_VUI (A));
4417       VB : constant VUI_View := To_View (To_LL_VUI (B));
4418       D  : VUI_View;
4419    begin
4420       D.Values := LL_VUI_Operations.vsubuxm (VA.Values, VB.Values);
4421       return To_LL_VSI (To_Vector (D));
4422    end vsubuwm;
4423
4424    ------------
4425    -- vsubfp --
4426    ------------
4427
4428    function vsubfp (A : LL_VF; B : LL_VF) return LL_VF is
4429       VA : constant VF_View := To_View (A);
4430       VB : constant VF_View := To_View (B);
4431       D  : VF_View;
4432
4433    begin
4434       for J in Vfloat_Range'Range loop
4435          D.Values (J) :=
4436            NJ_Truncate (NJ_Truncate (VA.Values (J))
4437                         - NJ_Truncate (VB.Values (J)));
4438       end loop;
4439
4440       return To_Vector (D);
4441    end vsubfp;
4442
4443    -------------
4444    -- vsubcuw --
4445    -------------
4446
4447    function vsubcuw (A : LL_VSI; B : LL_VSI) return LL_VSI is
4448       Subst_Result : SI64;
4449
4450       VA : constant VUI_View := To_View (To_LL_VUI (A));
4451       VB : constant VUI_View := To_View (To_LL_VUI (B));
4452       D  : VUI_View;
4453
4454    begin
4455       for J in Vint_Range'Range loop
4456          Subst_Result := SI64 (VA.Values (J)) - SI64 (VB.Values (J));
4457          D.Values (J) :=
4458            (if Subst_Result < SI64 (unsigned_int'First) then 0 else 1);
4459       end loop;
4460
4461       return To_LL_VSI (To_Vector (D));
4462    end vsubcuw;
4463
4464    -------------
4465    -- vsububs --
4466    -------------
4467
4468    function vsububs (A : LL_VSC; B : LL_VSC) return LL_VSC is
4469       VA : constant VUC_View := To_View (To_LL_VUC (A));
4470       VB : constant VUC_View := To_View (To_LL_VUC (B));
4471       D  : VUC_View;
4472    begin
4473       D.Values := LL_VUC_Operations.vsubuxs (VA.Values, VB.Values);
4474       return To_LL_VSC (To_Vector (D));
4475    end vsububs;
4476
4477    -------------
4478    -- vsubsbs --
4479    -------------
4480
4481    function vsubsbs (A : LL_VSC; B : LL_VSC) return LL_VSC is
4482       VA : constant VSC_View := To_View (A);
4483       VB : constant VSC_View := To_View (B);
4484       D  : VSC_View;
4485    begin
4486       D.Values := LL_VSC_Operations.vsubsxs (VA.Values, VB.Values);
4487       return To_Vector (D);
4488    end vsubsbs;
4489
4490    -------------
4491    -- vsubuhs --
4492    -------------
4493
4494    function vsubuhs (A : LL_VSS; B : LL_VSS) return LL_VSS is
4495       VA : constant VUS_View := To_View (To_LL_VUS (A));
4496       VB : constant VUS_View := To_View (To_LL_VUS (B));
4497       D  : VUS_View;
4498    begin
4499       D.Values := LL_VUS_Operations.vsubuxs (VA.Values, VB.Values);
4500       return To_LL_VSS (To_Vector (D));
4501    end vsubuhs;
4502
4503    -------------
4504    -- vsubshs --
4505    -------------
4506
4507    function vsubshs (A : LL_VSS; B : LL_VSS) return LL_VSS is
4508       VA : constant VSS_View := To_View (A);
4509       VB : constant VSS_View := To_View (B);
4510       D  : VSS_View;
4511    begin
4512       D.Values := LL_VSS_Operations.vsubsxs (VA.Values, VB.Values);
4513       return To_Vector (D);
4514    end vsubshs;
4515
4516    -------------
4517    -- vsubuws --
4518    -------------
4519
4520    function vsubuws (A : LL_VSI; B : LL_VSI) return LL_VSI is
4521       VA : constant VUI_View := To_View (To_LL_VUI (A));
4522       VB : constant VUI_View := To_View (To_LL_VUI (B));
4523       D  : VUI_View;
4524    begin
4525       D.Values := LL_VUI_Operations.vsubuxs (VA.Values, VB.Values);
4526       return To_LL_VSI (To_Vector (D));
4527    end vsubuws;
4528
4529    -------------
4530    -- vsubsws --
4531    -------------
4532
4533    function vsubsws (A : LL_VSI; B : LL_VSI) return LL_VSI is
4534       VA : constant VSI_View := To_View (A);
4535       VB : constant VSI_View := To_View (B);
4536       D  : VSI_View;
4537    begin
4538       D.Values := LL_VSI_Operations.vsubsxs (VA.Values, VB.Values);
4539       return To_Vector (D);
4540    end vsubsws;
4541
4542    --------------
4543    -- vsum4ubs --
4544    --------------
4545
4546    function vsum4ubs (A : LL_VSC; B : LL_VSI) return LL_VSI is
4547       VA     : constant VUC_View := To_View (To_LL_VUC (A));
4548       VB     : constant VUI_View := To_View (To_LL_VUI (B));
4549       Offset : Vchar_Range;
4550       D      : VUI_View;
4551
4552    begin
4553       for J in 0 .. 3 loop
4554          Offset := Vchar_Range (4 * J + Integer (Vchar_Range'First));
4555          D.Values (Vint_Range (J + Integer (Vint_Range'First))) :=
4556            LL_VUI_Operations.Saturate
4557            (UI64 (VA.Values (Offset))
4558             + UI64 (VA.Values (Offset + 1))
4559             + UI64 (VA.Values (Offset + 2))
4560             + UI64 (VA.Values (Offset + 3))
4561             + UI64 (VB.Values (Vint_Range (J + Integer (Vint_Range'First)))));
4562       end loop;
4563
4564       return To_LL_VSI (To_Vector (D));
4565    end vsum4ubs;
4566
4567    --------------
4568    -- vsum4sbs --
4569    --------------
4570
4571    function vsum4sbs (A : LL_VSC; B : LL_VSI) return LL_VSI is
4572       VA     : constant VSC_View := To_View (A);
4573       VB     : constant VSI_View := To_View (B);
4574       Offset : Vchar_Range;
4575       D      : VSI_View;
4576
4577    begin
4578       for J in 0 .. 3 loop
4579          Offset := Vchar_Range (4 * J + Integer (Vchar_Range'First));
4580          D.Values (Vint_Range (J + Integer (Vint_Range'First))) :=
4581            LL_VSI_Operations.Saturate
4582            (SI64 (VA.Values (Offset))
4583             + SI64 (VA.Values (Offset + 1))
4584             + SI64 (VA.Values (Offset + 2))
4585             + SI64 (VA.Values (Offset + 3))
4586             + SI64 (VB.Values (Vint_Range (J + Integer (Vint_Range'First)))));
4587       end loop;
4588
4589       return To_Vector (D);
4590    end vsum4sbs;
4591
4592    --------------
4593    -- vsum4shs --
4594    --------------
4595
4596    function vsum4shs (A : LL_VSS; B : LL_VSI) return LL_VSI is
4597       VA     : constant VSS_View := To_View (A);
4598       VB     : constant VSI_View := To_View (B);
4599       Offset : Vshort_Range;
4600       D      : VSI_View;
4601
4602    begin
4603       for J in 0 .. 3 loop
4604          Offset := Vshort_Range (2 * J + Integer (Vchar_Range'First));
4605          D.Values (Vint_Range (J + Integer (Vint_Range'First))) :=
4606            LL_VSI_Operations.Saturate
4607            (SI64 (VA.Values (Offset))
4608             + SI64 (VA.Values (Offset + 1))
4609             + SI64 (VB.Values (Vint_Range (J + Integer (Vint_Range'First)))));
4610       end loop;
4611
4612       return To_Vector (D);
4613    end vsum4shs;
4614
4615    --------------
4616    -- vsum2sws --
4617    --------------
4618
4619    function vsum2sws (A : LL_VSI; B : LL_VSI) return LL_VSI is
4620       VA     : constant VSI_View := To_View (A);
4621       VB     : constant VSI_View := To_View (B);
4622       Offset : Vint_Range;
4623       D      : VSI_View;
4624
4625    begin
4626       for J in 0 .. 1 loop
4627          Offset := Vint_Range (2 * J + Integer (Vchar_Range'First));
4628          D.Values (Offset) := 0;
4629          D.Values (Offset + 1) :=
4630            LL_VSI_Operations.Saturate
4631            (SI64 (VA.Values (Offset))
4632             + SI64 (VA.Values (Offset + 1))
4633             + SI64 (VB.Values (Vint_Range (Offset + 1))));
4634       end loop;
4635
4636       return To_Vector (D);
4637    end vsum2sws;
4638
4639    -------------
4640    -- vsumsws --
4641    -------------
4642
4643    function vsumsws (A : LL_VSI; B : LL_VSI) return LL_VSI is
4644       VA         : constant VSI_View := To_View (A);
4645       VB         : constant VSI_View := To_View (B);
4646       D          : VSI_View;
4647       Sum_Buffer : SI64 := 0;
4648
4649    begin
4650       for J in Vint_Range'Range loop
4651          D.Values (J) := 0;
4652          Sum_Buffer := Sum_Buffer + SI64 (VA.Values (J));
4653       end loop;
4654
4655       Sum_Buffer := Sum_Buffer + SI64 (VB.Values (Vint_Range'Last));
4656       D.Values (Vint_Range'Last) := LL_VSI_Operations.Saturate (Sum_Buffer);
4657       return To_Vector (D);
4658    end vsumsws;
4659
4660    -----------
4661    -- vrfiz --
4662    -----------
4663
4664    function vrfiz (A : LL_VF) return LL_VF is
4665       VA : constant VF_View := To_View (A);
4666       D  : VF_View;
4667    begin
4668       for J in Vfloat_Range'Range loop
4669          D.Values (J) := C_float (Rnd_To_FPI_Trunc (F64 (VA.Values (J))));
4670       end loop;
4671
4672       return To_Vector (D);
4673    end vrfiz;
4674
4675    -------------
4676    -- vupkhsb --
4677    -------------
4678
4679    function vupkhsb (A : LL_VSC) return LL_VSS is
4680       VA : constant VSC_View := To_View (A);
4681       D  : VSS_View;
4682    begin
4683       D.Values := LL_VSC_LL_VSS_Operations.vupkxsx (VA.Values, 0);
4684       return To_Vector (D);
4685    end vupkhsb;
4686
4687    -------------
4688    -- vupkhsh --
4689    -------------
4690
4691    function vupkhsh (A : LL_VSS) return LL_VSI is
4692       VA : constant VSS_View := To_View (A);
4693       D  : VSI_View;
4694    begin
4695       D.Values := LL_VSS_LL_VSI_Operations.vupkxsx (VA.Values, 0);
4696       return To_Vector (D);
4697    end vupkhsh;
4698
4699    -------------
4700    -- vupkxpx --
4701    -------------
4702
4703    function vupkxpx (A : LL_VSS; Offset : Natural) return LL_VSI;
4704    --  For vupkhpx and vupklpx (depending on Offset)
4705
4706    function vupkxpx (A : LL_VSS; Offset : Natural) return LL_VSI is
4707       VA  : constant VUS_View := To_View (To_LL_VUS (A));
4708       K   : Vshort_Range;
4709       D   : VUI_View;
4710       P16 : Pixel_16;
4711       P32 : Pixel_32;
4712
4713       function Sign_Extend (X : Unsigned_1) return unsigned_char;
4714
4715       function Sign_Extend (X : Unsigned_1) return unsigned_char is
4716       begin
4717          if X = 1 then
4718             return 16#FF#;
4719          else
4720             return 16#00#;
4721          end if;
4722       end Sign_Extend;
4723
4724    begin
4725       for J in Vint_Range'Range loop
4726          K := Vshort_Range (Integer (J)
4727                             - Integer (Vint_Range'First)
4728                             + Integer (Vshort_Range'First)
4729                             + Offset);
4730          P16 := To_Pixel (VA.Values (K));
4731          P32.T := Sign_Extend (P16.T);
4732          P32.R := unsigned_char (P16.R);
4733          P32.G := unsigned_char (P16.G);
4734          P32.B := unsigned_char (P16.B);
4735          D.Values (J) := To_unsigned_int (P32);
4736       end loop;
4737
4738       return To_LL_VSI (To_Vector (D));
4739    end vupkxpx;
4740
4741    -------------
4742    -- vupkhpx --
4743    -------------
4744
4745    function vupkhpx (A : LL_VSS) return LL_VSI is
4746    begin
4747       return vupkxpx (A, 0);
4748    end vupkhpx;
4749
4750    -------------
4751    -- vupklsb --
4752    -------------
4753
4754    function vupklsb (A : LL_VSC) return LL_VSS is
4755       VA : constant VSC_View := To_View (A);
4756       D  : VSS_View;
4757    begin
4758       D.Values :=
4759         LL_VSC_LL_VSS_Operations.vupkxsx (VA.Values,
4760                                           Varray_signed_short'Length);
4761       return To_Vector (D);
4762    end vupklsb;
4763
4764    -------------
4765    -- vupklsh --
4766    -------------
4767
4768    function vupklsh (A : LL_VSS) return LL_VSI is
4769       VA : constant VSS_View := To_View (A);
4770       D  : VSI_View;
4771    begin
4772       D.Values :=
4773         LL_VSS_LL_VSI_Operations.vupkxsx (VA.Values,
4774                                           Varray_signed_int'Length);
4775       return To_Vector (D);
4776    end vupklsh;
4777
4778    -------------
4779    -- vupklpx --
4780    -------------
4781
4782    function vupklpx (A : LL_VSS) return LL_VSI is
4783    begin
4784       return vupkxpx (A, Varray_signed_int'Length);
4785    end vupklpx;
4786
4787    ----------
4788    -- vxor --
4789    ----------
4790
4791    function vxor (A : LL_VSI; B : LL_VSI) return LL_VSI is
4792       VA : constant VUI_View := To_View (To_LL_VUI (A));
4793       VB : constant VUI_View := To_View (To_LL_VUI (B));
4794       D  : VUI_View;
4795
4796    begin
4797       for J in Vint_Range'Range loop
4798          D.Values (J) := VA.Values (J) xor VB.Values (J);
4799       end loop;
4800
4801       return To_LL_VSI (To_Vector (D));
4802    end vxor;
4803
4804    ----------------
4805    -- vcmpequb_p --
4806    ----------------
4807
4808    function vcmpequb_p (A : c_int; B : LL_VSC; C : LL_VSC) return c_int is
4809       D : LL_VSC;
4810    begin
4811       D := vcmpequb (B, C);
4812       return LL_VSC_Operations.Check_CR6 (A, To_View (D).Values);
4813    end vcmpequb_p;
4814
4815    ----------------
4816    -- vcmpequh_p --
4817    ----------------
4818
4819    function vcmpequh_p (A : c_int; B : LL_VSS; C : LL_VSS) return c_int is
4820       D : LL_VSS;
4821    begin
4822       D := vcmpequh (B, C);
4823       return LL_VSS_Operations.Check_CR6 (A, To_View (D).Values);
4824    end vcmpequh_p;
4825
4826    ----------------
4827    -- vcmpequw_p --
4828    ----------------
4829
4830    function vcmpequw_p (A : c_int; B : LL_VSI; C : LL_VSI) return c_int is
4831       D : LL_VSI;
4832    begin
4833       D := vcmpequw (B, C);
4834       return LL_VSI_Operations.Check_CR6 (A, To_View (D).Values);
4835    end vcmpequw_p;
4836
4837    ----------------
4838    -- vcmpeqfp_p --
4839    ----------------
4840
4841    function vcmpeqfp_p (A : c_int; B : LL_VF; C : LL_VF) return c_int is
4842       D : LL_VSI;
4843    begin
4844       D := vcmpeqfp (B, C);
4845       return LL_VSI_Operations.Check_CR6 (A, To_View (D).Values);
4846    end vcmpeqfp_p;
4847
4848    ----------------
4849    -- vcmpgtub_p --
4850    ----------------
4851
4852    function vcmpgtub_p (A : c_int; B : LL_VSC; C : LL_VSC) return c_int is
4853       D : LL_VSC;
4854    begin
4855       D := vcmpgtub (B, C);
4856       return LL_VSC_Operations.Check_CR6 (A, To_View (D).Values);
4857    end vcmpgtub_p;
4858
4859    ----------------
4860    -- vcmpgtuh_p --
4861    ----------------
4862
4863    function vcmpgtuh_p (A : c_int; B : LL_VSS; C : LL_VSS) return c_int is
4864       D : LL_VSS;
4865    begin
4866       D := vcmpgtuh (B, C);
4867       return LL_VSS_Operations.Check_CR6 (A, To_View (D).Values);
4868    end vcmpgtuh_p;
4869
4870    ----------------
4871    -- vcmpgtuw_p --
4872    ----------------
4873
4874    function vcmpgtuw_p (A : c_int; B : LL_VSI; C : LL_VSI) return c_int is
4875       D : LL_VSI;
4876    begin
4877       D := vcmpgtuw (B, C);
4878       return LL_VSI_Operations.Check_CR6 (A, To_View (D).Values);
4879    end vcmpgtuw_p;
4880
4881    ----------------
4882    -- vcmpgtsb_p --
4883    ----------------
4884
4885    function vcmpgtsb_p (A : c_int; B : LL_VSC; C : LL_VSC) return c_int is
4886       D : LL_VSC;
4887    begin
4888       D := vcmpgtsb (B, C);
4889       return LL_VSC_Operations.Check_CR6 (A, To_View (D).Values);
4890    end vcmpgtsb_p;
4891
4892    ----------------
4893    -- vcmpgtsh_p --
4894    ----------------
4895
4896    function vcmpgtsh_p (A : c_int; B : LL_VSS; C : LL_VSS) return c_int is
4897       D : LL_VSS;
4898    begin
4899       D := vcmpgtsh (B, C);
4900       return LL_VSS_Operations.Check_CR6 (A, To_View (D).Values);
4901    end vcmpgtsh_p;
4902
4903    ----------------
4904    -- vcmpgtsw_p --
4905    ----------------
4906
4907    function vcmpgtsw_p (A : c_int; B : LL_VSI; C : LL_VSI) return c_int is
4908       D : LL_VSI;
4909    begin
4910       D := vcmpgtsw (B, C);
4911       return LL_VSI_Operations.Check_CR6 (A, To_View (D).Values);
4912    end vcmpgtsw_p;
4913
4914    ----------------
4915    -- vcmpgefp_p --
4916    ----------------
4917
4918    function vcmpgefp_p (A : c_int; B : LL_VF; C : LL_VF) return c_int is
4919       D : LL_VSI;
4920    begin
4921       D := vcmpgefp (B, C);
4922       return LL_VSI_Operations.Check_CR6 (A, To_View (D).Values);
4923    end vcmpgefp_p;
4924
4925    ----------------
4926    -- vcmpgtfp_p --
4927    ----------------
4928
4929    function vcmpgtfp_p (A : c_int; B : LL_VF; C : LL_VF) return c_int is
4930       D : LL_VSI;
4931    begin
4932       D := vcmpgtfp (B, C);
4933       return LL_VSI_Operations.Check_CR6 (A, To_View (D).Values);
4934    end vcmpgtfp_p;
4935
4936    ----------------
4937    -- vcmpbfp_p --
4938    ----------------
4939
4940    function vcmpbfp_p (A : c_int; B : LL_VF; C : LL_VF) return c_int is
4941       D : VSI_View;
4942    begin
4943       D := To_View (vcmpbfp (B, C));
4944
4945       for J in Vint_Range'Range loop
4946
4947          --  vcmpbfp is not returning the usual bool vector; do the conversion
4948
4949          D.Values (J) :=
4950            (if D.Values (J) = 0 then Signed_Bool_False else Signed_Bool_True);
4951       end loop;
4952
4953       return LL_VSI_Operations.Check_CR6 (A, D.Values);
4954    end vcmpbfp_p;
4955
4956 end GNAT.Altivec.Low_Level_Vectors;