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