OSDN Git Service

* tree-chrec.c (avoid_arithmetics_in_type_p): New.
[pf3gnuchains/gcc-fork.git] / 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-2005, 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       EA : Integer_Address;
2822
2823    begin
2824       EA := Bound_Align (Integer_Address (A) + To_Integer (B), 16);
2825
2826       declare
2827          D : LL_VSI;
2828          for D'Address use To_Address (EA);
2829       begin
2830          return D;
2831       end;
2832    end lvx;
2833
2834    -----------
2835    -- lvebx --
2836    -----------
2837
2838    function lvebx (A : c_long; B : c_ptr) return LL_VSC is
2839       D : VSC_View;
2840    begin
2841       D.Values := LL_VSC_Operations.lvexx (A, B);
2842       return To_Vector (D);
2843    end lvebx;
2844
2845    -----------
2846    -- lvehx --
2847    -----------
2848
2849    function lvehx (A : c_long; B : c_ptr) return LL_VSS is
2850       D : VSS_View;
2851    begin
2852       D.Values := LL_VSS_Operations.lvexx (A, B);
2853       return To_Vector (D);
2854    end lvehx;
2855
2856    -----------
2857    -- lvewx --
2858    -----------
2859
2860    function lvewx (A : c_long; B : c_ptr) return LL_VSI is
2861       D : VSI_View;
2862    begin
2863       D.Values := LL_VSI_Operations.lvexx (A, B);
2864       return To_Vector (D);
2865    end lvewx;
2866
2867    ----------
2868    -- lvxl --
2869    ----------
2870
2871    function lvxl  (A : c_long; B : c_ptr) return LL_VSI renames
2872      lvx;
2873
2874    -------------
2875    -- vlogefp --
2876    -------------
2877
2878    function vlogefp (A : LL_VF) return LL_VF is
2879       VA : constant VF_View := To_View (A);
2880       D  : VF_View;
2881
2882    begin
2883       for J in Varray_float'Range loop
2884
2885          --  ??? Check the precision of the operation.
2886          --  As described in [PEM-6 vlogefp]:
2887          --  If theorical_result is equal to the log2 of A (J) with
2888          --  infinite precision, we should have:
2889          --  abs (D (J) - theorical_result) <= 1/32,
2890          --  unless abs(D(J) - 1) <= 1/8.
2891
2892          D.Values (J) :=
2893            C_float_Operations.Log (NJ_Truncate (VA.Values (J)), 2.0);
2894       end loop;
2895
2896       return To_Vector (D);
2897    end vlogefp;
2898
2899    ----------
2900    -- lvsl --
2901    ----------
2902
2903    function lvsl (A : c_long; B : c_ptr) return LL_VSC is
2904       type bit4_type is mod 16#F# + 1;
2905       for bit4_type'Alignment use 1;
2906       EA : Integer_Address;
2907       D  : VUC_View;
2908       SH : bit4_type;
2909
2910    begin
2911       EA := Integer_Address (A) + To_Integer (B);
2912       SH := bit4_type (EA mod 2 ** 4);
2913
2914       for J in D.Values'Range loop
2915          D.Values (J) := unsigned_char (SH) + unsigned_char (J)
2916            - unsigned_char (D.Values'First);
2917       end loop;
2918
2919       return To_LL_VSC (To_Vector (D));
2920    end lvsl;
2921
2922    ----------
2923    -- lvsr --
2924    ----------
2925
2926    function lvsr (A : c_long; B : c_ptr) return LL_VSC is
2927       type bit4_type is mod 16#F# + 1;
2928       for bit4_type'Alignment use 1;
2929       EA : Integer_Address;
2930       D  : VUC_View;
2931       SH : bit4_type;
2932
2933    begin
2934       EA := Integer_Address (A) + To_Integer (B);
2935       SH := bit4_type (EA mod 2 ** 4);
2936
2937       for J in D.Values'Range loop
2938          D.Values (J) := (16#F# - unsigned_char (SH)) + unsigned_char (J);
2939       end loop;
2940
2941       return To_LL_VSC (To_Vector (D));
2942    end lvsr;
2943
2944    -------------
2945    -- vmaddfp --
2946    -------------
2947
2948    function vmaddfp (A : LL_VF; B : LL_VF; C : LL_VF) return LL_VF is
2949       VA : constant VF_View := To_View (A);
2950       VB : constant VF_View := To_View (B);
2951       VC : constant VF_View := To_View (C);
2952       D  : VF_View;
2953
2954    begin
2955       for J in Varray_float'Range loop
2956          D.Values (J) :=
2957            Rnd_To_FP_Nearest (F64 (VA.Values (J))
2958                               * F64 (VB.Values (J))
2959                               + F64 (VC.Values (J)));
2960       end loop;
2961
2962       return To_Vector (D);
2963    end vmaddfp;
2964
2965    ---------------
2966    -- vmhaddshs --
2967    ---------------
2968
2969    function vmhaddshs  (A : LL_VSS; B : LL_VSS; C : LL_VSS) return LL_VSS is
2970       VA : constant VSS_View := To_View (A);
2971       VB : constant VSS_View := To_View (B);
2972       VC : constant VSS_View := To_View (C);
2973       D  : VSS_View;
2974
2975    begin
2976       for J in Varray_signed_short'Range loop
2977          D.Values (J) := LL_VSS_Operations.Saturate
2978            ((SI64 (VA.Values (J)) * SI64 (VB.Values (J)))
2979             / SI64 (2 ** 15) + SI64 (VC.Values (J)));
2980       end loop;
2981
2982       return To_Vector (D);
2983    end vmhaddshs;
2984
2985    ------------
2986    -- vmaxub --
2987    ------------
2988
2989    function vmaxub (A : LL_VSC; B : LL_VSC) return LL_VSC is
2990       VA : constant VUC_View := To_View (To_LL_VUC (A));
2991       VB : constant VUC_View := To_View (To_LL_VUC (B));
2992       D  : VUC_View;
2993    begin
2994       D.Values := LL_VUC_Operations.vmaxux (VA.Values, VB.Values);
2995       return To_LL_VSC (To_Vector (D));
2996    end vmaxub;
2997
2998    ------------
2999    -- vmaxsb --
3000    ------------
3001
3002    function vmaxsb (A : LL_VSC; B : LL_VSC) return LL_VSC is
3003       VA : constant VSC_View := To_View (A);
3004       VB : constant VSC_View := To_View (B);
3005       D  : VSC_View;
3006    begin
3007       D.Values := LL_VSC_Operations.vmaxsx (VA.Values, VB.Values);
3008       return To_Vector (D);
3009    end vmaxsb;
3010
3011    ------------
3012    -- vmaxuh --
3013    ------------
3014
3015    function vmaxuh (A : LL_VSS; B : LL_VSS) return LL_VSS is
3016       VA : constant VUS_View := To_View (To_LL_VUS (A));
3017       VB : constant VUS_View := To_View (To_LL_VUS (B));
3018       D  : VUS_View;
3019    begin
3020       D.Values := LL_VUS_Operations.vmaxux (VA.Values, VB.Values);
3021       return To_LL_VSS (To_Vector (D));
3022    end vmaxuh;
3023
3024    ------------
3025    -- vmaxsh --
3026    ------------
3027
3028    function vmaxsh (A : LL_VSS; B : LL_VSS) return LL_VSS is
3029       VA : constant VSS_View := To_View (A);
3030       VB : constant VSS_View := To_View (B);
3031       D  : VSS_View;
3032    begin
3033       D.Values := LL_VSS_Operations.vmaxsx (VA.Values, VB.Values);
3034       return To_Vector (D);
3035    end vmaxsh;
3036
3037    ------------
3038    -- vmaxuw --
3039    ------------
3040
3041    function vmaxuw (A : LL_VSI; B : LL_VSI) return LL_VSI is
3042       VA : constant VUI_View := To_View (To_LL_VUI (A));
3043       VB : constant VUI_View := To_View (To_LL_VUI (B));
3044       D  : VUI_View;
3045    begin
3046       D.Values := LL_VUI_Operations.vmaxux (VA.Values, VB.Values);
3047       return To_LL_VSI (To_Vector (D));
3048    end vmaxuw;
3049
3050    ------------
3051    -- vmaxsw --
3052    ------------
3053
3054    function vmaxsw (A : LL_VSI; B : LL_VSI) return LL_VSI is
3055       VA : constant VSI_View := To_View (A);
3056       VB : constant VSI_View := To_View (B);
3057       D  : VSI_View;
3058    begin
3059       D.Values := LL_VSI_Operations.vmaxsx (VA.Values, VB.Values);
3060       return To_Vector (D);
3061    end vmaxsw;
3062
3063    --------------
3064    -- vmaxsxfp --
3065    --------------
3066
3067    function vmaxfp (A : LL_VF; B : LL_VF) return LL_VF is
3068       VA : constant VF_View := To_View (A);
3069       VB : constant VF_View := To_View (B);
3070       D  : VF_View;
3071
3072    begin
3073       for J in Varray_float'Range loop
3074          if VA.Values (J) > VB.Values (J) then
3075             D.Values (J) := VA.Values (J);
3076          else
3077             D.Values (J) := VB.Values (J);
3078          end if;
3079       end loop;
3080
3081       return To_Vector (D);
3082    end vmaxfp;
3083
3084    ------------
3085    -- vmrghb --
3086    ------------
3087
3088    function vmrghb (A : LL_VSC; B : LL_VSC) return LL_VSC is
3089       VA : constant VSC_View := To_View (A);
3090       VB : constant VSC_View := To_View (B);
3091       D  : VSC_View;
3092    begin
3093       D.Values := LL_VSC_Operations.vmrghx (VA.Values, VB.Values);
3094       return To_Vector (D);
3095    end vmrghb;
3096
3097    ------------
3098    -- vmrghh --
3099    ------------
3100
3101    function vmrghh (A : LL_VSS; B : LL_VSS) return LL_VSS is
3102       VA : constant VSS_View := To_View (A);
3103       VB : constant VSS_View := To_View (B);
3104       D  : VSS_View;
3105    begin
3106       D.Values := LL_VSS_Operations.vmrghx (VA.Values, VB.Values);
3107       return To_Vector (D);
3108    end vmrghh;
3109
3110    ------------
3111    -- vmrghw --
3112    ------------
3113
3114    function vmrghw (A : LL_VSI; B : LL_VSI) return LL_VSI is
3115       VA : constant VSI_View := To_View (A);
3116       VB : constant VSI_View := To_View (B);
3117       D  : VSI_View;
3118    begin
3119       D.Values := LL_VSI_Operations.vmrghx (VA.Values, VB.Values);
3120       return To_Vector (D);
3121    end vmrghw;
3122
3123    ------------
3124    -- vmrglb --
3125    ------------
3126
3127    function vmrglb (A : LL_VSC; B : LL_VSC) return LL_VSC is
3128       VA : constant VSC_View := To_View (A);
3129       VB : constant VSC_View := To_View (B);
3130       D  : VSC_View;
3131    begin
3132       D.Values := LL_VSC_Operations.vmrglx (VA.Values, VB.Values);
3133       return To_Vector (D);
3134    end vmrglb;
3135
3136    ------------
3137    -- vmrglh --
3138    ------------
3139
3140    function vmrglh (A : LL_VSS; B : LL_VSS) return LL_VSS is
3141       VA : constant VSS_View := To_View (A);
3142       VB : constant VSS_View := To_View (B);
3143       D  : VSS_View;
3144    begin
3145       D.Values := LL_VSS_Operations.vmrglx (VA.Values, VB.Values);
3146       return To_Vector (D);
3147    end vmrglh;
3148
3149    ------------
3150    -- vmrglw --
3151    ------------
3152
3153    function vmrglw (A : LL_VSI; B : LL_VSI) return LL_VSI is
3154       VA : constant VSI_View := To_View (A);
3155       VB : constant VSI_View := To_View (B);
3156       D  : VSI_View;
3157    begin
3158       D.Values := LL_VSI_Operations.vmrglx (VA.Values, VB.Values);
3159       return To_Vector (D);
3160    end vmrglw;
3161
3162    ------------
3163    -- mfvscr --
3164    ------------
3165
3166    function  mfvscr return LL_VSS is
3167       D : VUS_View;
3168    begin
3169       for J in Varray_unsigned_short'Range loop
3170          D.Values (J) := 0;
3171       end loop;
3172
3173       D.Values (Varray_unsigned_short'Last) :=
3174         unsigned_short (VSCR mod 2 ** unsigned_short'Size);
3175       D.Values (Varray_unsigned_short'Last - 1) :=
3176         unsigned_short (VSCR / 2 ** unsigned_short'Size);
3177       return To_LL_VSS (To_Vector (D));
3178    end mfvscr;
3179
3180    ------------
3181    -- vminfp --
3182    ------------
3183
3184    function vminfp (A : LL_VF;  B : LL_VF) return LL_VF is
3185       VA : constant VF_View := To_View (A);
3186       VB : constant VF_View := To_View (B);
3187       D  : VF_View;
3188
3189    begin
3190       for J in Varray_float'Range loop
3191          if VA.Values (J) < VB.Values (J) then
3192             D.Values (J) := VA.Values (J);
3193          else
3194             D.Values (J) := VB.Values (J);
3195          end if;
3196       end loop;
3197
3198       return To_Vector (D);
3199    end vminfp;
3200
3201    ------------
3202    -- vminsb --
3203    ------------
3204
3205    function vminsb (A : LL_VSC; B : LL_VSC) return LL_VSC is
3206       VA : constant VSC_View := To_View (A);
3207       VB : constant VSC_View := To_View (B);
3208       D  : VSC_View;
3209    begin
3210       D.Values := LL_VSC_Operations.vminsx (VA.Values, VB.Values);
3211       return To_Vector (D);
3212    end vminsb;
3213
3214    ------------
3215    -- vminub --
3216    ------------
3217
3218    function vminub (A : LL_VSC; B : LL_VSC) return LL_VSC is
3219       VA : constant VUC_View := To_View (To_LL_VUC (A));
3220       VB : constant VUC_View := To_View (To_LL_VUC (B));
3221       D  : VUC_View;
3222    begin
3223       D.Values := LL_VUC_Operations.vminux (VA.Values, VB.Values);
3224       return To_LL_VSC (To_Vector (D));
3225    end vminub;
3226
3227    ------------
3228    -- vminsh --
3229    ------------
3230
3231    function vminsh (A : LL_VSS; B : LL_VSS) return LL_VSS is
3232       VA : constant VSS_View := To_View (A);
3233       VB : constant VSS_View := To_View (B);
3234       D  : VSS_View;
3235    begin
3236       D.Values := LL_VSS_Operations.vminsx (VA.Values, VB.Values);
3237       return To_Vector (D);
3238    end vminsh;
3239
3240    ------------
3241    -- vminuh --
3242    ------------
3243
3244    function vminuh (A : LL_VSS; B : LL_VSS) return LL_VSS is
3245       VA : constant VUS_View := To_View (To_LL_VUS (A));
3246       VB : constant VUS_View := To_View (To_LL_VUS (B));
3247       D  : VUS_View;
3248    begin
3249       D.Values := LL_VUS_Operations.vminux (VA.Values, VB.Values);
3250       return To_LL_VSS (To_Vector (D));
3251    end vminuh;
3252
3253    ------------
3254    -- vminsw --
3255    ------------
3256
3257    function vminsw (A : LL_VSI; B : LL_VSI) return LL_VSI is
3258       VA : constant VSI_View := To_View (A);
3259       VB : constant VSI_View := To_View (B);
3260       D  : VSI_View;
3261    begin
3262       D.Values := LL_VSI_Operations.vminsx (VA.Values, VB.Values);
3263       return To_Vector (D);
3264    end vminsw;
3265
3266    ------------
3267    -- vminuw --
3268    ------------
3269
3270    function vminuw (A : LL_VSI; B : LL_VSI) return LL_VSI is
3271       VA : constant VUI_View := To_View (To_LL_VUI (A));
3272       VB : constant VUI_View := To_View (To_LL_VUI (B));
3273       D  : VUI_View;
3274    begin
3275       D.Values := LL_VUI_Operations.vminux (VA.Values,
3276                                             VB.Values);
3277       return To_LL_VSI (To_Vector (D));
3278    end vminuw;
3279
3280    ---------------
3281    -- vmladduhm --
3282    ---------------
3283
3284    function vmladduhm (A : LL_VSS; B : LL_VSS; C : LL_VSS) return LL_VSS is
3285       VA : constant VUS_View := To_View (To_LL_VUS (A));
3286       VB : constant VUS_View := To_View (To_LL_VUS (B));
3287       VC : constant VUS_View := To_View (To_LL_VUS (C));
3288       D  : VUS_View;
3289
3290    begin
3291       for J in Varray_unsigned_short'Range loop
3292          D.Values (J) := VA.Values (J) * VB.Values (J)
3293            + VC.Values (J);
3294       end loop;
3295
3296       return To_LL_VSS (To_Vector (D));
3297    end vmladduhm;
3298
3299    ----------------
3300    -- vmhraddshs --
3301    ----------------
3302
3303    function vmhraddshs (A : LL_VSS; B : LL_VSS; C : LL_VSS) return LL_VSS is
3304       VA : constant VSS_View := To_View (A);
3305       VB : constant VSS_View := To_View (B);
3306       VC : constant VSS_View := To_View (C);
3307       D  : VSS_View;
3308
3309    begin
3310       for J in Varray_signed_short'Range loop
3311          D.Values (J) :=
3312            LL_VSS_Operations.Saturate (((SI64 (VA.Values (J))
3313                                          * SI64 (VB.Values (J))
3314                                          + 2 ** 14)
3315                                         / 2 ** 15
3316                                         + SI64 (VC.Values (J))));
3317       end loop;
3318
3319       return To_Vector (D);
3320    end vmhraddshs;
3321
3322    --------------
3323    -- vmsumubm --
3324    --------------
3325
3326    function vmsumubm (A : LL_VSC; B : LL_VSC; C : LL_VSI) return LL_VSI is
3327       Offset : Vchar_Range;
3328       VA     : constant VUC_View := To_View (To_LL_VUC (A));
3329       VB     : constant VUC_View := To_View (To_LL_VUC (B));
3330       VC     : constant VUI_View := To_View (To_LL_VUI (C));
3331       D      : VUI_View;
3332
3333    begin
3334       for J in 0 .. 3 loop
3335          Offset := Vchar_Range (4 * J + Integer (Vchar_Range'First));
3336          D.Values (Vint_Range
3337                    (J + Integer (Vint_Range'First))) :=
3338            (unsigned_int (VA.Values (Offset))
3339             * unsigned_int (VB.Values (Offset)))
3340            + (unsigned_int (VA.Values (Offset + 1))
3341               * unsigned_int (VB.Values (1 + Offset)))
3342            + (unsigned_int (VA.Values (2 + Offset))
3343               * unsigned_int (VB.Values (2 + Offset)))
3344            + (unsigned_int (VA.Values (3 + Offset))
3345               * unsigned_int (VB.Values (3 + Offset)))
3346            + VC.Values (Vint_Range
3347                         (J + Integer (Varray_unsigned_int'First)));
3348       end loop;
3349
3350       return To_LL_VSI (To_Vector (D));
3351    end vmsumubm;
3352
3353    --------------
3354    -- vmsumumbm --
3355    --------------
3356
3357    function vmsummbm (A : LL_VSC; B : LL_VSC; C : LL_VSI) return LL_VSI is
3358       Offset : Vchar_Range;
3359       VA     : constant VSC_View := To_View (A);
3360       VB     : constant VUC_View := To_View (To_LL_VUC (B));
3361       VC     : constant VSI_View := To_View (C);
3362       D      : VSI_View;
3363
3364    begin
3365       for J in 0 .. 3 loop
3366          Offset := Vchar_Range (4 * J + Integer (Vchar_Range'First));
3367          D.Values (Vint_Range
3368                    (J + Integer (Varray_unsigned_int'First))) := 0
3369            + LL_VSI_Operations.Modular_Result (SI64 (VA.Values (Offset))
3370                                                * SI64 (VB.Values (Offset)))
3371            + LL_VSI_Operations.Modular_Result (SI64 (VA.Values (Offset + 1))
3372                                                * SI64 (VB.Values
3373                                                        (1 + Offset)))
3374            + LL_VSI_Operations.Modular_Result (SI64 (VA.Values (2 + Offset))
3375                                                * SI64 (VB.Values
3376                                                        (2 + Offset)))
3377            + LL_VSI_Operations.Modular_Result (SI64 (VA.Values (3 + Offset))
3378                                                * SI64 (VB.Values
3379                                                        (3 + Offset)))
3380            + VC.Values (Vint_Range
3381                         (J + Integer (Varray_unsigned_int'First)));
3382       end loop;
3383
3384       return To_Vector (D);
3385    end vmsummbm;
3386
3387    --------------
3388    -- vmsumuhm --
3389    --------------
3390
3391    function vmsumuhm (A : LL_VSS; B : LL_VSS; C : LL_VSI) return LL_VSI is
3392       Offset : Vshort_Range;
3393       VA     : constant VUS_View := To_View (To_LL_VUS (A));
3394       VB     : constant VUS_View := To_View (To_LL_VUS (B));
3395       VC     : constant VUI_View := To_View (To_LL_VUI (C));
3396       D      : VUI_View;
3397
3398    begin
3399       for J in 0 .. 3 loop
3400          Offset :=
3401            Vshort_Range (2 * J + Integer (Vshort_Range'First));
3402          D.Values (Vint_Range
3403                    (J + Integer (Varray_unsigned_int'First))) :=
3404            (unsigned_int (VA.Values (Offset))
3405             * unsigned_int (VB.Values (Offset)))
3406            + (unsigned_int (VA.Values (Offset + 1))
3407               * unsigned_int (VB.Values (1 + Offset)))
3408            + VC.Values (Vint_Range
3409                         (J + Integer (Vint_Range'First)));
3410       end loop;
3411
3412       return To_LL_VSI (To_Vector (D));
3413    end vmsumuhm;
3414
3415    --------------
3416    -- vmsumshm --
3417    --------------
3418
3419    function vmsumshm (A : LL_VSS; B : LL_VSS; C : LL_VSI) return LL_VSI is
3420       VA     : constant VSS_View := To_View (A);
3421       VB     : constant VSS_View := To_View (B);
3422       VC     : constant VSI_View := To_View (C);
3423       Offset : Vshort_Range;
3424       D      : VSI_View;
3425
3426    begin
3427       for J in 0 .. 3 loop
3428          Offset :=
3429            Vshort_Range (2 * J + Integer (Varray_signed_char'First));
3430          D.Values (Vint_Range
3431                    (J + Integer (Varray_unsigned_int'First))) := 0
3432            + LL_VSI_Operations.Modular_Result (SI64 (VA.Values (Offset))
3433                                                * SI64 (VB.Values (Offset)))
3434            + LL_VSI_Operations.Modular_Result (SI64 (VA.Values (Offset + 1))
3435                                                * SI64 (VB.Values
3436                                                        (1 + Offset)))
3437            + VC.Values (Vint_Range
3438                         (J + Integer (Varray_unsigned_int'First)));
3439       end loop;
3440
3441       return To_Vector (D);
3442    end vmsumshm;
3443
3444    --------------
3445    -- vmsumuhs --
3446    --------------
3447
3448    function vmsumuhs (A : LL_VSS; B : LL_VSS; C : LL_VSI) return LL_VSI is
3449       Offset : Vshort_Range;
3450       VA     : constant VUS_View := To_View (To_LL_VUS (A));
3451       VB     : constant VUS_View := To_View (To_LL_VUS (B));
3452       VC     : constant VUI_View := To_View (To_LL_VUI (C));
3453       D      : VUI_View;
3454
3455    begin
3456       for J in 0 .. 3 loop
3457          Offset :=
3458            Vshort_Range (2 * J + Integer (Varray_signed_short'First));
3459          D.Values (Vint_Range
3460                    (J + Integer (Varray_unsigned_int'First))) :=
3461            LL_VUI_Operations.Saturate
3462            (UI64 (VA.Values (Offset))
3463             * UI64 (VB.Values (Offset))
3464             + UI64 (VA.Values (Offset + 1))
3465             * UI64 (VB.Values (1 + Offset))
3466             + UI64 (VC.Values
3467                     (Vint_Range
3468                      (J + Integer (Varray_unsigned_int'First)))));
3469       end loop;
3470
3471       return To_LL_VSI (To_Vector (D));
3472    end vmsumuhs;
3473
3474    --------------
3475    -- vmsumshs --
3476    --------------
3477
3478    function vmsumshs (A : LL_VSS; B : LL_VSS; C : LL_VSI) return LL_VSI is
3479       VA     : constant VSS_View := To_View (A);
3480       VB     : constant VSS_View := To_View (B);
3481       VC     : constant VSI_View := To_View (C);
3482       Offset : Vshort_Range;
3483       D      : VSI_View;
3484
3485    begin
3486       for J in 0 .. 3 loop
3487          Offset :=
3488            Vshort_Range (2 * J + Integer (Varray_signed_short'First));
3489          D.Values (Vint_Range
3490                    (J + Integer (Varray_signed_int'First))) :=
3491            LL_VSI_Operations.Saturate
3492            (SI64 (VA.Values (Offset))
3493             * SI64 (VB.Values (Offset))
3494             + SI64 (VA.Values (Offset + 1))
3495             * SI64 (VB.Values (1 + Offset))
3496             + SI64 (VC.Values
3497                     (Vint_Range
3498                      (J + Integer (Varray_signed_int'First)))));
3499       end loop;
3500
3501       return To_Vector (D);
3502    end vmsumshs;
3503
3504    ------------
3505    -- mtvscr --
3506    ------------
3507
3508    procedure mtvscr (A : LL_VSI) is
3509       VA : constant VUI_View := To_View (To_LL_VUI (A));
3510    begin
3511       VSCR := VA.Values (Varray_unsigned_int'Last);
3512    end mtvscr;
3513
3514    -------------
3515    -- vmuleub --
3516    -------------
3517
3518    function vmuleub (A : LL_VSC; B : LL_VSC) return LL_VSS is
3519       VA : constant VUC_View := To_View (To_LL_VUC (A));
3520       VB : constant VUC_View := To_View (To_LL_VUC (B));
3521       D  : VUS_View;
3522    begin
3523       D.Values := LL_VUC_LL_VUS_Operations.vmulxux (True,
3524                                                     VA.Values,
3525                                                     VB.Values);
3526       return To_LL_VSS (To_Vector (D));
3527    end vmuleub;
3528
3529    -------------
3530    -- vmuleuh --
3531    -------------
3532
3533    function vmuleuh (A : LL_VSS; B : LL_VSS) return LL_VSI is
3534       VA : constant VUS_View := To_View (To_LL_VUS (A));
3535       VB : constant VUS_View := To_View (To_LL_VUS (B));
3536       D  : VUI_View;
3537    begin
3538       D.Values := LL_VUS_LL_VUI_Operations.vmulxux (True,
3539                                                     VA.Values,
3540                                                     VB.Values);
3541       return To_LL_VSI (To_Vector (D));
3542    end vmuleuh;
3543
3544    -------------
3545    -- vmulesb --
3546    -------------
3547
3548    function vmulesb (A : LL_VSC; B : LL_VSC) return LL_VSS is
3549       VA : constant VSC_View := To_View (A);
3550       VB : constant VSC_View := To_View (B);
3551       D  : VSS_View;
3552    begin
3553       D.Values := LL_VSC_LL_VSS_Operations.vmulxsx (True,
3554                                                     VA.Values,
3555                                                     VB.Values);
3556       return To_Vector (D);
3557    end vmulesb;
3558
3559    -------------
3560    -- vmulesh --
3561    -------------
3562
3563    function vmulesh (A : LL_VSS; B : LL_VSS) return LL_VSI is
3564       VA : constant VSS_View := To_View (A);
3565       VB : constant VSS_View := To_View (B);
3566       D  : VSI_View;
3567    begin
3568       D.Values := LL_VSS_LL_VSI_Operations.vmulxsx (True,
3569                                                     VA.Values,
3570                                                     VB.Values);
3571       return To_Vector (D);
3572    end vmulesh;
3573
3574    -------------
3575    -- vmuloub --
3576    -------------
3577
3578    function vmuloub (A : LL_VSC; B : LL_VSC) return LL_VSS is
3579       VA : constant VUC_View := To_View (To_LL_VUC (A));
3580       VB : constant VUC_View := To_View (To_LL_VUC (B));
3581       D  : VUS_View;
3582    begin
3583       D.Values := LL_VUC_LL_VUS_Operations.vmulxux (False,
3584                                                     VA.Values,
3585                                                     VB.Values);
3586       return To_LL_VSS (To_Vector (D));
3587    end vmuloub;
3588
3589    -------------
3590    -- vmulouh --
3591    -------------
3592
3593    function vmulouh (A : LL_VSS; B : LL_VSS) return LL_VSI is
3594       VA : constant VUS_View := To_View (To_LL_VUS (A));
3595       VB : constant VUS_View := To_View (To_LL_VUS (B));
3596       D  : VUI_View;
3597    begin
3598       D.Values :=
3599         LL_VUS_LL_VUI_Operations.vmulxux (False, VA.Values, VB.Values);
3600       return To_LL_VSI (To_Vector (D));
3601    end vmulouh;
3602
3603    -------------
3604    -- vmulosb --
3605    -------------
3606
3607    function vmulosb (A : LL_VSC; B : LL_VSC) return LL_VSS is
3608       VA : constant VSC_View := To_View (A);
3609       VB : constant VSC_View := To_View (B);
3610       D  : VSS_View;
3611    begin
3612       D.Values := LL_VSC_LL_VSS_Operations.vmulxsx (False,
3613                                                     VA.Values,
3614                                                     VB.Values);
3615       return To_Vector (D);
3616    end vmulosb;
3617
3618    -------------
3619    -- vmulosh --
3620    -------------
3621
3622    function vmulosh (A : LL_VSS; B : LL_VSS) return LL_VSI is
3623       VA : constant VSS_View := To_View (A);
3624       VB : constant VSS_View := To_View (B);
3625       D  : VSI_View;
3626    begin
3627       D.Values := LL_VSS_LL_VSI_Operations.vmulxsx (False,
3628                                                     VA.Values,
3629                                                     VB.Values);
3630       return To_Vector (D);
3631    end vmulosh;
3632
3633    --------------
3634    -- vnmsubfp --
3635    --------------
3636
3637    function vnmsubfp (A : LL_VF; B : LL_VF; C : LL_VF) return LL_VF is
3638       VA : constant VF_View := To_View (A);
3639       VB : constant VF_View := To_View (B);
3640       VC : constant VF_View := To_View (C);
3641       D  : VF_View;
3642
3643    begin
3644       for J in Vfloat_Range'Range loop
3645          D.Values (J) :=
3646            -Rnd_To_FP_Nearest (F64 (VA.Values (J))
3647                                * F64 (VB.Values (J))
3648                                - F64 (VC.Values (J)));
3649       end loop;
3650
3651       return To_Vector (D);
3652    end vnmsubfp;
3653
3654    ----------
3655    -- vnor --
3656    ----------
3657
3658    function vnor (A : LL_VSI; B : LL_VSI) return LL_VSI is
3659       VA : constant VUI_View := To_View (To_LL_VUI (A));
3660       VB : constant VUI_View := To_View (To_LL_VUI (B));
3661       D  : VUI_View;
3662
3663    begin
3664       for J in Vint_Range'Range loop
3665          D.Values (J) := not (VA.Values (J) or VB.Values (J));
3666       end loop;
3667
3668       return To_LL_VSI (To_Vector (D));
3669    end vnor;
3670
3671    ----------
3672    -- vor --
3673    ----------
3674
3675    function vor (A : LL_VSI; B : LL_VSI) return LL_VSI is
3676       VA : constant VUI_View := To_View (To_LL_VUI (A));
3677       VB : constant VUI_View := To_View (To_LL_VUI (B));
3678       D  : VUI_View;
3679
3680    begin
3681       for J in Vint_Range'Range loop
3682          D.Values (J) := VA.Values (J) or VB.Values (J);
3683       end loop;
3684
3685       return To_LL_VSI (To_Vector (D));
3686    end vor;
3687
3688    -------------
3689    -- vpkuhum --
3690    -------------
3691
3692    function vpkuhum (A : LL_VSS; B : LL_VSS) return LL_VSC is
3693       VA : constant VUS_View := To_View (To_LL_VUS (A));
3694       VB : constant VUS_View := To_View (To_LL_VUS (B));
3695       D  : VUC_View;
3696    begin
3697       D.Values := LL_VUC_LL_VUS_Operations.vpkuxum (VA.Values, VB.Values);
3698       return To_LL_VSC (To_Vector (D));
3699    end vpkuhum;
3700
3701    -------------
3702    -- vpkuwum --
3703    -------------
3704
3705    function vpkuwum (A : LL_VSI; B : LL_VSI) return LL_VSS is
3706       VA : constant VUI_View := To_View (To_LL_VUI (A));
3707       VB : constant VUI_View := To_View (To_LL_VUI (B));
3708       D  : VUS_View;
3709    begin
3710       D.Values := LL_VUS_LL_VUI_Operations.vpkuxum (VA.Values, VB.Values);
3711       return To_LL_VSS (To_Vector (D));
3712    end vpkuwum;
3713
3714    -----------
3715    -- vpkpx --
3716    -----------
3717
3718    function vpkpx (A : LL_VSI; B : LL_VSI) return LL_VSS is
3719       VA     : constant VUI_View := To_View (To_LL_VUI (A));
3720       VB     : constant VUI_View := To_View (To_LL_VUI (B));
3721       D      : VUS_View;
3722       Offset : Vint_Range;
3723       P16    : Pixel_16;
3724       P32    : Pixel_32;
3725
3726    begin
3727       for J in 0 .. 3 loop
3728          Offset := Vint_Range (J + Integer (Vshort_Range'First));
3729          P32 := To_Pixel (VA.Values (Offset));
3730          P16.T := Unsigned_1 (P32.T mod 2 ** 1);
3731          P16.R := Unsigned_5 (Shift_Right (P32.R, 3) mod 2 ** 5);
3732          P16.G := Unsigned_5 (Shift_Right (P32.G, 3) mod 2 ** 5);
3733          P16.B := Unsigned_5 (Shift_Right (P32.B, 3) mod 2 ** 5);
3734          D.Values (Vshort_Range (Offset)) := To_unsigned_short (P16);
3735          P32 := To_Pixel (VB.Values (Offset));
3736          P16.T := Unsigned_1 (P32.T mod 2 ** 1);
3737          P16.R := Unsigned_5 (Shift_Right (P32.R, 3) mod 2 ** 5);
3738          P16.G := Unsigned_5 (Shift_Right (P32.G, 3) mod 2 ** 5);
3739          P16.B := Unsigned_5 (Shift_Right (P32.B, 3) mod 2 ** 5);
3740          D.Values (Vshort_Range (Offset) + 4) := To_unsigned_short (P16);
3741       end loop;
3742
3743       return To_LL_VSS (To_Vector (D));
3744    end vpkpx;
3745
3746    -------------
3747    -- vpkuhus --
3748    -------------
3749
3750    function vpkuhus (A : LL_VSS; B : LL_VSS) return LL_VSC is
3751       VA : constant VUS_View := To_View (To_LL_VUS (A));
3752       VB : constant VUS_View := To_View (To_LL_VUS (B));
3753       D  : VUC_View;
3754    begin
3755       D.Values := LL_VUC_LL_VUS_Operations.vpkuxus (VA.Values, VB.Values);
3756       return To_LL_VSC (To_Vector (D));
3757    end vpkuhus;
3758
3759    -------------
3760    -- vpkuwus --
3761    -------------
3762
3763    function vpkuwus (A : LL_VSI; B : LL_VSI) return LL_VSS is
3764       VA : constant VUI_View := To_View (To_LL_VUI (A));
3765       VB : constant VUI_View := To_View (To_LL_VUI (B));
3766       D  : VUS_View;
3767    begin
3768       D.Values := LL_VUS_LL_VUI_Operations.vpkuxus (VA.Values, VB.Values);
3769       return To_LL_VSS (To_Vector (D));
3770    end vpkuwus;
3771
3772    -------------
3773    -- vpkshss --
3774    -------------
3775
3776    function vpkshss (A : LL_VSS; B : LL_VSS) return LL_VSC is
3777       VA : constant VSS_View := To_View (A);
3778       VB : constant VSS_View := To_View (B);
3779       D  : VSC_View;
3780    begin
3781       D.Values := LL_VSC_LL_VSS_Operations.vpksxss (VA.Values, VB.Values);
3782       return To_Vector (D);
3783    end vpkshss;
3784
3785    -------------
3786    -- vpkswss --
3787    -------------
3788
3789    function vpkswss (A : LL_VSI; B : LL_VSI) return LL_VSS is
3790       VA : constant VSI_View := To_View (A);
3791       VB : constant VSI_View := To_View (B);
3792       D  : VSS_View;
3793    begin
3794       D.Values := LL_VSS_LL_VSI_Operations.vpksxss (VA.Values, VB.Values);
3795       return To_Vector (D);
3796    end vpkswss;
3797
3798    -------------
3799    -- vpksxus --
3800    -------------
3801
3802    generic
3803       type Signed_Component_Type is range <>;
3804       type Signed_Index_Type is range <>;
3805       type Signed_Varray_Type is
3806         array (Signed_Index_Type) of Signed_Component_Type;
3807       type Unsigned_Component_Type is mod <>;
3808       type Unsigned_Index_Type is range <>;
3809       type Unsigned_Varray_Type is
3810         array (Unsigned_Index_Type) of Unsigned_Component_Type;
3811
3812    function vpksxus
3813      (A : Signed_Varray_Type;
3814       B : Signed_Varray_Type) return Unsigned_Varray_Type;
3815
3816    function vpksxus
3817      (A : Signed_Varray_Type;
3818       B : Signed_Varray_Type) return Unsigned_Varray_Type
3819    is
3820       N             : constant Unsigned_Index_Type :=
3821                         Unsigned_Index_Type (Signed_Index_Type'Last);
3822       Offset        : Unsigned_Index_Type;
3823       Signed_Offset : Signed_Index_Type;
3824       D             : Unsigned_Varray_Type;
3825
3826       function Saturate
3827         (X : Signed_Component_Type) return Unsigned_Component_Type;
3828       --  Saturation, as defined in
3829       --  [PIM-4.1 Vector Status and Control Register]
3830
3831       --------------
3832       -- Saturate --
3833       --------------
3834
3835       function Saturate
3836         (X : Signed_Component_Type) return Unsigned_Component_Type
3837       is
3838          D : Unsigned_Component_Type;
3839
3840       begin
3841          D := Unsigned_Component_Type
3842            (Signed_Component_Type'Max
3843             (Signed_Component_Type (Unsigned_Component_Type'First),
3844              Signed_Component_Type'Min
3845              (Signed_Component_Type (Unsigned_Component_Type'Last),
3846               X)));
3847          if Signed_Component_Type (D) /= X then
3848             VSCR := Write_Bit (VSCR, SAT_POS, 1);
3849          end if;
3850
3851          return D;
3852       end Saturate;
3853
3854       --  Start of processing for vpksxus
3855
3856    begin
3857       for J in 0 .. N - 1 loop
3858          Offset :=
3859            Unsigned_Index_Type (Integer (J)
3860                                 + Integer (Unsigned_Index_Type'First));
3861          Signed_Offset :=
3862            Signed_Index_Type (Integer (J)
3863                               + Integer (Signed_Index_Type'First));
3864          D (Offset) := Saturate (A (Signed_Offset));
3865          D (Offset + N) := Saturate (B (Signed_Offset));
3866       end loop;
3867
3868       return D;
3869    end vpksxus;
3870
3871    -------------
3872    -- vpkshus --
3873    -------------
3874
3875    function vpkshus (A : LL_VSS; B : LL_VSS) return LL_VSC is
3876       function vpkshus_Instance is
3877         new vpksxus (signed_short,
3878                      Vshort_Range,
3879                      Varray_signed_short,
3880                      unsigned_char,
3881                      Vchar_Range,
3882                      Varray_unsigned_char);
3883
3884       VA : constant VSS_View := To_View (A);
3885       VB : constant VSS_View := To_View (B);
3886       D  : VUC_View;
3887
3888    begin
3889       D.Values := vpkshus_Instance (VA.Values, VB.Values);
3890       return To_LL_VSC (To_Vector (D));
3891    end vpkshus;
3892
3893    -------------
3894    -- vpkswus --
3895    -------------
3896
3897    function vpkswus (A : LL_VSI; B : LL_VSI) return LL_VSS is
3898       function vpkswus_Instance is
3899         new vpksxus (signed_int,
3900                      Vint_Range,
3901                      Varray_signed_int,
3902                      unsigned_short,
3903                      Vshort_Range,
3904                      Varray_unsigned_short);
3905
3906       VA : constant VSI_View := To_View (A);
3907       VB : constant VSI_View := To_View (B);
3908       D  : VUS_View;
3909    begin
3910       D.Values := vpkswus_Instance (VA.Values, VB.Values);
3911       return To_LL_VSS (To_Vector (D));
3912    end vpkswus;
3913
3914    ---------------
3915    -- vperm_4si --
3916    ---------------
3917
3918    function vperm_4si (A : LL_VSI; B : LL_VSI; C : LL_VSC) return LL_VSI is
3919       VA : constant VUC_View := To_View (To_LL_VUC (A));
3920       VB : constant VUC_View := To_View (To_LL_VUC (B));
3921       VC : constant VUC_View := To_View (To_LL_VUC (C));
3922       J  : Vchar_Range;
3923       D  : VUC_View;
3924
3925    begin
3926       for N in Vchar_Range'Range loop
3927          J := Vchar_Range (Integer (Bits (VC.Values (N), 4, 7))
3928                            + Integer (Vchar_Range'First));
3929
3930          if Bits (VC.Values (N), 3, 3) = 0 then
3931             D.Values (N) := VA.Values (J);
3932          else
3933             D.Values (N) := VB.Values (J);
3934          end if;
3935       end loop;
3936
3937       return To_LL_VSI (To_Vector (D));
3938    end vperm_4si;
3939
3940    -----------
3941    -- vrefp --
3942    -----------
3943
3944    function vrefp (A : LL_VF) return LL_VF is
3945       VA : constant VF_View := To_View (A);
3946       D  : VF_View;
3947
3948    begin
3949       for J in Vfloat_Range'Range loop
3950          D.Values (J) := FP_Recip_Est (VA.Values (J));
3951       end loop;
3952
3953       return To_Vector (D);
3954    end vrefp;
3955
3956    ----------
3957    -- vrlb --
3958    ----------
3959
3960    function vrlb (A : LL_VSC; B : LL_VSC) return LL_VSC is
3961       VA : constant VUC_View := To_View (To_LL_VUC (A));
3962       VB : constant VUC_View := To_View (To_LL_VUC (B));
3963       D  : VUC_View;
3964    begin
3965       D.Values := LL_VUC_Operations.vrlx (VA.Values, VB.Values, ROTL'Access);
3966       return To_LL_VSC (To_Vector (D));
3967    end vrlb;
3968
3969    ----------
3970    -- vrlh --
3971    ----------
3972
3973    function vrlh (A : LL_VSS; B : LL_VSS) return LL_VSS is
3974       VA : constant VUS_View := To_View (To_LL_VUS (A));
3975       VB : constant VUS_View := To_View (To_LL_VUS (B));
3976       D  : VUS_View;
3977    begin
3978       D.Values := LL_VUS_Operations.vrlx (VA.Values, VB.Values, ROTL'Access);
3979       return To_LL_VSS (To_Vector (D));
3980    end vrlh;
3981
3982    ----------
3983    -- vrlw --
3984    ----------
3985
3986    function vrlw (A : LL_VSI; B : LL_VSI) return LL_VSI is
3987       VA : constant VUI_View := To_View (To_LL_VUI (A));
3988       VB : constant VUI_View := To_View (To_LL_VUI (B));
3989       D  : VUI_View;
3990    begin
3991       D.Values := LL_VUI_Operations.vrlx (VA.Values, VB.Values, ROTL'Access);
3992       return To_LL_VSI (To_Vector (D));
3993    end vrlw;
3994
3995    -----------
3996    -- vrfin --
3997    -----------
3998
3999    function vrfin (A : LL_VF) return LL_VF is
4000       VA : constant VF_View := To_View (A);
4001       D  : VF_View;
4002
4003    begin
4004       for J in Vfloat_Range'Range loop
4005          D.Values (J) := C_float (Rnd_To_FPI_Near (F64 (VA.Values (J))));
4006       end loop;
4007
4008       return To_Vector (D);
4009    end vrfin;
4010
4011    ---------------
4012    -- vrsqrtefp --
4013    ---------------
4014
4015    function vrsqrtefp (A : LL_VF) return LL_VF is
4016       VA : constant VF_View := To_View (A);
4017       D  : VF_View;
4018
4019    begin
4020       for J in Vfloat_Range'Range loop
4021          D.Values (J) := Recip_SQRT_Est (VA.Values (J));
4022       end loop;
4023
4024       return To_Vector (D);
4025    end vrsqrtefp;
4026
4027    --------------
4028    -- vsel_4si --
4029    --------------
4030
4031    function vsel_4si (A : LL_VSI; B : LL_VSI; C : LL_VSI) return LL_VSI is
4032       VA : constant VUI_View := To_View (To_LL_VUI (A));
4033       VB : constant VUI_View := To_View (To_LL_VUI (B));
4034       VC : constant VUI_View := To_View (To_LL_VUI (C));
4035       D  : VUI_View;
4036
4037    begin
4038       for J in Vint_Range'Range loop
4039          D.Values (J) := ((not VC.Values (J)) and VA.Values (J))
4040            or (VC.Values (J) and VB.Values (J));
4041       end loop;
4042
4043       return To_LL_VSI (To_Vector (D));
4044    end vsel_4si;
4045
4046    ----------
4047    -- vslb --
4048    ----------
4049
4050    function vslb (A : LL_VSC; B : LL_VSC) return LL_VSC is
4051       VA : constant VUC_View := To_View (To_LL_VUC (A));
4052       VB : constant VUC_View := To_View (To_LL_VUC (B));
4053       D  : VUC_View;
4054    begin
4055       D.Values :=
4056         LL_VUC_Operations.vsxx (VA.Values, VB.Values, Shift_Left'Access);
4057       return To_LL_VSC (To_Vector (D));
4058    end vslb;
4059
4060    ----------
4061    -- vslh --
4062    ----------
4063
4064    function vslh (A : LL_VSS; B : LL_VSS) return LL_VSS is
4065       VA : constant VUS_View := To_View (To_LL_VUS (A));
4066       VB : constant VUS_View := To_View (To_LL_VUS (B));
4067       D  : VUS_View;
4068    begin
4069       D.Values :=
4070         LL_VUS_Operations.vsxx (VA.Values, VB.Values, Shift_Left'Access);
4071       return To_LL_VSS (To_Vector (D));
4072    end vslh;
4073
4074    ----------
4075    -- vslw --
4076    ----------
4077
4078    function vslw (A : LL_VSI; B : LL_VSI) return LL_VSI is
4079       VA : constant VUI_View := To_View (To_LL_VUI (A));
4080       VB : constant VUI_View := To_View (To_LL_VUI (B));
4081       D  : VUI_View;
4082    begin
4083       D.Values :=
4084         LL_VUI_Operations.vsxx (VA.Values, VB.Values, Shift_Left'Access);
4085       return To_LL_VSI (To_Vector (D));
4086    end vslw;
4087
4088    ----------------
4089    -- vsldoi_4si --
4090    ----------------
4091
4092    function vsldoi_4si (A : LL_VSI; B : LL_VSI; C : c_int) return LL_VSI is
4093       VA     : constant VUC_View := To_View (To_LL_VUC (A));
4094       VB     : constant VUC_View := To_View (To_LL_VUC (B));
4095       Offset : c_int;
4096       Bound  : c_int;
4097       D      : VUC_View;
4098
4099    begin
4100       for J in Vchar_Range'Range loop
4101          Offset := c_int (J) + C;
4102          Bound := c_int (Vchar_Range'First)
4103            + c_int (Varray_unsigned_char'Length);
4104
4105          if Offset < Bound then
4106             D.Values (J) := VA.Values (Vchar_Range (Offset));
4107          else
4108             D.Values (J) :=
4109               VB.Values (Vchar_Range (Offset - Bound
4110                                       + c_int (Vchar_Range'First)));
4111          end if;
4112       end loop;
4113
4114       return To_LL_VSI (To_Vector (D));
4115    end vsldoi_4si;
4116
4117    ----------------
4118    -- vsldoi_8hi --
4119    ----------------
4120
4121    function vsldoi_8hi (A : LL_VSS; B : LL_VSS; C : c_int) return LL_VSS is
4122    begin
4123       return To_LL_VSS (vsldoi_4si (To_LL_VSI (A), To_LL_VSI (B), C));
4124    end vsldoi_8hi;
4125
4126    -----------------
4127    -- vsldoi_16qi --
4128    -----------------
4129
4130    function vsldoi_16qi (A : LL_VSC; B : LL_VSC; C : c_int) return LL_VSC is
4131    begin
4132       return To_LL_VSC (vsldoi_4si (To_LL_VSI (A), To_LL_VSI (B), C));
4133    end vsldoi_16qi;
4134
4135    ----------------
4136    -- vsldoi_4sf --
4137    ----------------
4138
4139    function vsldoi_4sf (A : LL_VF; B : LL_VF; C : c_int) return LL_VF is
4140    begin
4141       return To_LL_VF (vsldoi_4si (To_LL_VSI (A), To_LL_VSI (B), C));
4142    end vsldoi_4sf;
4143
4144    ---------
4145    -- vsl --
4146    ---------
4147
4148    function vsl  (A : LL_VSI; B : LL_VSI) return LL_VSI is
4149       VA : constant VUI_View := To_View (To_LL_VUI (A));
4150       VB : constant VUI_View := To_View (To_LL_VUI (B));
4151       D  : VUI_View;
4152       M  : constant Natural :=
4153              Natural (Bits (VB.Values (Vint_Range'Last), 29, 31));
4154
4155       --  [PIM-4.4 vec_sll] "Note that the three low-order byte elements in B
4156       --  must be the same. Otherwise the value placed into D is undefined."
4157       --  ??? Shall we add a optional check for B?
4158
4159    begin
4160       for J in Vint_Range'Range loop
4161          D.Values (J) := 0;
4162          D.Values (J) := D.Values (J) + Shift_Left (VA.Values (J), M);
4163
4164          if J /= Vint_Range'Last then
4165             D.Values (J) :=
4166               D.Values (J) + Shift_Right (VA.Values (J + 1),
4167                                           signed_int'Size - M);
4168          end if;
4169       end loop;
4170
4171       return To_LL_VSI (To_Vector (D));
4172    end vsl;
4173
4174    ----------
4175    -- vslo --
4176    ----------
4177
4178    function vslo (A : LL_VSI; B : LL_VSI) return LL_VSI is
4179       VA : constant VUC_View := To_View (To_LL_VUC (A));
4180       VB : constant VUC_View := To_View (To_LL_VUC (B));
4181       D  : VUC_View;
4182       M  : constant Natural :=
4183              Natural (Bits (VB.Values (Vchar_Range'Last), 1, 4));
4184       J  : Natural;
4185
4186    begin
4187       for N in Vchar_Range'Range loop
4188          J := Natural (N) + M;
4189
4190          if J <= Natural (Vchar_Range'Last) then
4191             D.Values (N) := VA.Values (Vchar_Range (J));
4192          else
4193             D.Values (N) := 0;
4194          end if;
4195       end loop;
4196
4197       return To_LL_VSI (To_Vector (D));
4198    end vslo;
4199
4200    ------------
4201    -- vspltb --
4202    ------------
4203
4204    function vspltb (A : LL_VSC; B : c_int) return LL_VSC is
4205       VA : constant VSC_View := To_View (A);
4206       D  : VSC_View;
4207    begin
4208       D.Values := LL_VSC_Operations.vspltx (VA.Values, B);
4209       return To_Vector (D);
4210    end vspltb;
4211
4212    ------------
4213    -- vsplth --
4214    ------------
4215
4216    function vsplth (A : LL_VSS; B : c_int) return LL_VSS is
4217       VA : constant VSS_View := To_View (A);
4218       D  : VSS_View;
4219    begin
4220       D.Values := LL_VSS_Operations.vspltx (VA.Values, B);
4221       return To_Vector (D);
4222    end vsplth;
4223
4224    ------------
4225    -- vspltw --
4226    ------------
4227
4228    function vspltw (A : LL_VSI; B : c_int) return LL_VSI is
4229       VA : constant VSI_View := To_View (A);
4230       D  : VSI_View;
4231    begin
4232       D.Values := LL_VSI_Operations.vspltx (VA.Values, B);
4233       return To_Vector (D);
4234    end vspltw;
4235
4236    --------------
4237    -- vspltisb --
4238    --------------
4239
4240    function vspltisb (A : c_int) return LL_VSC is
4241       D : VSC_View;
4242    begin
4243       D.Values := LL_VSC_Operations.vspltisx (A);
4244       return To_Vector (D);
4245    end vspltisb;
4246
4247    --------------
4248    -- vspltish --
4249    --------------
4250
4251    function vspltish (A : c_int) return LL_VSS is
4252       D : VSS_View;
4253    begin
4254       D.Values := LL_VSS_Operations.vspltisx (A);
4255       return To_Vector (D);
4256    end vspltish;
4257
4258    --------------
4259    -- vspltisw --
4260    --------------
4261
4262    function vspltisw (A : c_int) return LL_VSI is
4263       D : VSI_View;
4264    begin
4265       D.Values := LL_VSI_Operations.vspltisx (A);
4266       return To_Vector (D);
4267    end vspltisw;
4268
4269    ----------
4270    -- vsrb --
4271    ----------
4272
4273    function vsrb (A : LL_VSC; B : LL_VSC) return LL_VSC is
4274       VA : constant VUC_View := To_View (To_LL_VUC (A));
4275       VB : constant VUC_View := To_View (To_LL_VUC (B));
4276       D  : VUC_View;
4277    begin
4278       D.Values :=
4279         LL_VUC_Operations.vsxx (VA.Values, VB.Values, Shift_Right'Access);
4280       return To_LL_VSC (To_Vector (D));
4281    end vsrb;
4282
4283    ----------
4284    -- vsrh --
4285    ----------
4286
4287    function vsrh (A : LL_VSS; B : LL_VSS) return LL_VSS is
4288       VA : constant VUS_View := To_View (To_LL_VUS (A));
4289       VB : constant VUS_View := To_View (To_LL_VUS (B));
4290       D  : VUS_View;
4291    begin
4292       D.Values :=
4293         LL_VUS_Operations.vsxx (VA.Values, VB.Values, Shift_Right'Access);
4294       return To_LL_VSS (To_Vector (D));
4295    end vsrh;
4296
4297    ----------
4298    -- vsrw --
4299    ----------
4300
4301    function vsrw (A : LL_VSI; B : LL_VSI) return LL_VSI is
4302       VA : constant VUI_View := To_View (To_LL_VUI (A));
4303       VB : constant VUI_View := To_View (To_LL_VUI (B));
4304       D  : VUI_View;
4305    begin
4306       D.Values :=
4307         LL_VUI_Operations.vsxx (VA.Values, VB.Values, Shift_Right'Access);
4308       return To_LL_VSI (To_Vector (D));
4309    end vsrw;
4310
4311    -----------
4312    -- vsrab --
4313    -----------
4314
4315    function vsrab (A : LL_VSC; B : LL_VSC) return LL_VSC is
4316       VA : constant VSC_View := To_View (A);
4317       VB : constant VSC_View := To_View (B);
4318       D  : VSC_View;
4319    begin
4320       D.Values :=
4321         LL_VSC_Operations.vsrax (VA.Values, VB.Values, Shift_Right_A'Access);
4322       return To_Vector (D);
4323    end vsrab;
4324
4325    -----------
4326    -- vsrah --
4327    -----------
4328
4329    function vsrah (A : LL_VSS; B : LL_VSS) return LL_VSS is
4330       VA : constant VSS_View := To_View (A);
4331       VB : constant VSS_View := To_View (B);
4332       D  : VSS_View;
4333    begin
4334       D.Values :=
4335         LL_VSS_Operations.vsrax (VA.Values, VB.Values, Shift_Right_A'Access);
4336       return To_Vector (D);
4337    end vsrah;
4338
4339    -----------
4340    -- vsraw --
4341    -----------
4342
4343    function vsraw (A : LL_VSI; B : LL_VSI) return LL_VSI is
4344       VA : constant VSI_View := To_View (A);
4345       VB : constant VSI_View := To_View (B);
4346       D  : VSI_View;
4347    begin
4348       D.Values :=
4349         LL_VSI_Operations.vsrax (VA.Values, VB.Values, Shift_Right_A'Access);
4350       return To_Vector (D);
4351    end vsraw;
4352
4353    ---------
4354    -- vsr --
4355    ---------
4356
4357    function vsr  (A : LL_VSI; B : LL_VSI) return LL_VSI is
4358       VA : constant VUI_View := To_View (To_LL_VUI (A));
4359       VB : constant VUI_View := To_View (To_LL_VUI (B));
4360       M  : constant Natural :=
4361              Natural (Bits (VB.Values (Vint_Range'Last), 29, 31));
4362       D  : VUI_View;
4363
4364    begin
4365       for J in Vint_Range'Range loop
4366          D.Values (J) := 0;
4367          D.Values (J) := D.Values (J) + Shift_Right (VA.Values (J), M);
4368
4369          if J /= Vint_Range'First then
4370             D.Values (J) :=
4371               D.Values (J)
4372               + Shift_Left (VA.Values (J - 1), signed_int'Size - M);
4373          end if;
4374       end loop;
4375
4376       return To_LL_VSI (To_Vector (D));
4377    end vsr;
4378
4379    ----------
4380    -- vsro --
4381    ----------
4382
4383    function vsro (A : LL_VSI; B : LL_VSI) return LL_VSI is
4384       VA : constant VUC_View := To_View (To_LL_VUC (A));
4385       VB : constant VUC_View := To_View (To_LL_VUC (B));
4386       M  : constant Natural :=
4387              Natural (Bits (VB.Values (Vchar_Range'Last), 1, 4));
4388       J  : Natural;
4389       D  : VUC_View;
4390
4391    begin
4392       for N in Vchar_Range'Range loop
4393          J := Natural (N) - M;
4394
4395          if J >= Natural (Vchar_Range'First) then
4396             D.Values (N) := VA.Values (Vchar_Range (J));
4397          else
4398             D.Values (N) := 0;
4399          end if;
4400       end loop;
4401
4402       return To_LL_VSI (To_Vector (D));
4403    end vsro;
4404
4405    ----------
4406    -- stvx --
4407    ----------
4408
4409    procedure stvx   (A : LL_VSI; B : c_int; C : c_ptr) is
4410       EA : Integer_Address;
4411
4412    begin
4413       EA := Bound_Align (Integer_Address (B) + To_Integer (C), 16);
4414
4415       declare
4416          D : LL_VSI;
4417          for D'Address use To_Address (EA);
4418       begin
4419          D := A;
4420       end;
4421    end stvx;
4422
4423    ------------
4424    -- stvewx --
4425    ------------
4426
4427    procedure stvebx (A : LL_VSC; B : c_int; C : c_ptr) is
4428       VA : constant VSC_View := To_View (A);
4429    begin
4430       LL_VSC_Operations.stvexx (VA.Values, B, C);
4431    end stvebx;
4432
4433    ------------
4434    -- stvehx --
4435    ------------
4436
4437    procedure stvehx (A : LL_VSS; B : c_int; C : c_ptr) is
4438       VA : constant VSS_View := To_View (A);
4439    begin
4440       LL_VSS_Operations.stvexx (VA.Values, B, C);
4441    end stvehx;
4442
4443    ------------
4444    -- stvewx --
4445    ------------
4446
4447    procedure stvewx (A : LL_VSI; B : c_int; C : c_ptr) is
4448       VA : constant VSI_View := To_View (A);
4449    begin
4450       LL_VSI_Operations.stvexx (VA.Values, B, C);
4451    end stvewx;
4452
4453    -----------
4454    -- stvxl --
4455    -----------
4456
4457    procedure stvxl   (A : LL_VSI; B : c_int; C : c_ptr) renames stvx;
4458
4459    -------------
4460    -- vsububm --
4461    -------------
4462
4463    function vsububm (A : LL_VSC; B : LL_VSC) return LL_VSC is
4464       VA : constant VUC_View := To_View (To_LL_VUC (A));
4465       VB : constant VUC_View := To_View (To_LL_VUC (B));
4466       D  : VUC_View;
4467    begin
4468       D.Values := LL_VUC_Operations.vsubuxm (VA.Values, VB.Values);
4469       return To_LL_VSC (To_Vector (D));
4470    end vsububm;
4471
4472    -------------
4473    -- vsubuhm --
4474    -------------
4475
4476    function vsubuhm (A : LL_VSS; B : LL_VSS) return LL_VSS is
4477       VA : constant VUS_View := To_View (To_LL_VUS (A));
4478       VB : constant VUS_View := To_View (To_LL_VUS (B));
4479       D  : VUS_View;
4480    begin
4481       D.Values := LL_VUS_Operations.vsubuxm (VA.Values, VB.Values);
4482       return To_LL_VSS (To_Vector (D));
4483    end vsubuhm;
4484
4485    -------------
4486    -- vsubuwm --
4487    -------------
4488
4489    function vsubuwm (A : LL_VSI; B : LL_VSI) return LL_VSI is
4490       VA : constant VUI_View := To_View (To_LL_VUI (A));
4491       VB : constant VUI_View := To_View (To_LL_VUI (B));
4492       D  : VUI_View;
4493    begin
4494       D.Values := LL_VUI_Operations.vsubuxm (VA.Values, VB.Values);
4495       return To_LL_VSI (To_Vector (D));
4496    end vsubuwm;
4497
4498    ------------
4499    -- vsubfp --
4500    ------------
4501
4502    function vsubfp (A : LL_VF; B : LL_VF) return LL_VF is
4503       VA : constant VF_View := To_View (A);
4504       VB : constant VF_View := To_View (B);
4505       D  : VF_View;
4506
4507    begin
4508       for J in Vfloat_Range'Range loop
4509          D.Values (J) :=
4510            NJ_Truncate (NJ_Truncate (VA.Values (J))
4511                         - NJ_Truncate (VB.Values (J)));
4512       end loop;
4513
4514       return To_Vector (D);
4515    end vsubfp;
4516
4517    -------------
4518    -- vsubcuw --
4519    -------------
4520
4521    function vsubcuw (A : LL_VSI; B : LL_VSI) return LL_VSI is
4522       Subst_Result : SI64;
4523
4524       VA : constant VUI_View := To_View (To_LL_VUI (A));
4525       VB : constant VUI_View := To_View (To_LL_VUI (B));
4526       D  : VUI_View;
4527
4528    begin
4529       for J in Vint_Range'Range loop
4530          Subst_Result := SI64 (VA.Values (J)) - SI64 (VB.Values (J));
4531
4532          if Subst_Result < SI64 (unsigned_int'First) then
4533             D.Values (J) := 0;
4534          else
4535             D.Values (J) := 1;
4536          end if;
4537       end loop;
4538
4539       return To_LL_VSI (To_Vector (D));
4540    end vsubcuw;
4541
4542    -------------
4543    -- vsububs --
4544    -------------
4545
4546    function vsububs (A : LL_VSC; B : LL_VSC) return LL_VSC is
4547       VA : constant VUC_View := To_View (To_LL_VUC (A));
4548       VB : constant VUC_View := To_View (To_LL_VUC (B));
4549       D  : VUC_View;
4550    begin
4551       D.Values := LL_VUC_Operations.vsubuxs (VA.Values, VB.Values);
4552       return To_LL_VSC (To_Vector (D));
4553    end vsububs;
4554
4555    -------------
4556    -- vsubsbs --
4557    -------------
4558
4559    function vsubsbs (A : LL_VSC; B : LL_VSC) return LL_VSC is
4560       VA : constant VSC_View := To_View (A);
4561       VB : constant VSC_View := To_View (B);
4562       D  : VSC_View;
4563    begin
4564       D.Values := LL_VSC_Operations.vsubsxs (VA.Values, VB.Values);
4565       return To_Vector (D);
4566    end vsubsbs;
4567
4568    -------------
4569    -- vsubuhs --
4570    -------------
4571
4572    function vsubuhs (A : LL_VSS; B : LL_VSS) return LL_VSS is
4573       VA : constant VUS_View := To_View (To_LL_VUS (A));
4574       VB : constant VUS_View := To_View (To_LL_VUS (B));
4575       D  : VUS_View;
4576    begin
4577       D.Values := LL_VUS_Operations.vsubuxs (VA.Values, VB.Values);
4578       return To_LL_VSS (To_Vector (D));
4579    end vsubuhs;
4580
4581    -------------
4582    -- vsubshs --
4583    -------------
4584
4585    function vsubshs (A : LL_VSS; B : LL_VSS) return LL_VSS is
4586       VA : constant VSS_View := To_View (A);
4587       VB : constant VSS_View := To_View (B);
4588       D  : VSS_View;
4589    begin
4590       D.Values := LL_VSS_Operations.vsubsxs (VA.Values, VB.Values);
4591       return To_Vector (D);
4592    end vsubshs;
4593
4594    -------------
4595    -- vsubuws --
4596    -------------
4597
4598    function vsubuws (A : LL_VSI; B : LL_VSI) return LL_VSI is
4599       VA : constant VUI_View := To_View (To_LL_VUI (A));
4600       VB : constant VUI_View := To_View (To_LL_VUI (B));
4601       D  : VUI_View;
4602    begin
4603       D.Values := LL_VUI_Operations.vsubuxs (VA.Values, VB.Values);
4604       return To_LL_VSI (To_Vector (D));
4605    end vsubuws;
4606
4607    -------------
4608    -- vsubsws --
4609    -------------
4610
4611    function vsubsws (A : LL_VSI; B : LL_VSI) return LL_VSI is
4612       VA : constant VSI_View := To_View (A);
4613       VB : constant VSI_View := To_View (B);
4614       D  : VSI_View;
4615    begin
4616       D.Values := LL_VSI_Operations.vsubsxs (VA.Values, VB.Values);
4617       return To_Vector (D);
4618    end vsubsws;
4619
4620    --------------
4621    -- vsum4ubs --
4622    --------------
4623
4624    function vsum4ubs (A : LL_VSC; B : LL_VSI) return LL_VSI is
4625       VA     : constant VUC_View := To_View (To_LL_VUC (A));
4626       VB     : constant VUI_View := To_View (To_LL_VUI (B));
4627       Offset : Vchar_Range;
4628       D      : VUI_View;
4629
4630    begin
4631       for J in 0 .. 3 loop
4632          Offset := Vchar_Range (4 * J + Integer (Vchar_Range'First));
4633          D.Values (Vint_Range (J + Integer (Vint_Range'First))) :=
4634            LL_VUI_Operations.Saturate
4635            (UI64 (VA.Values (Offset))
4636             + UI64 (VA.Values (Offset + 1))
4637             + UI64 (VA.Values (Offset + 2))
4638             + UI64 (VA.Values (Offset + 3))
4639             + UI64 (VB.Values (Vint_Range (J + Integer (Vint_Range'First)))));
4640       end loop;
4641
4642       return To_LL_VSI (To_Vector (D));
4643    end vsum4ubs;
4644
4645    --------------
4646    -- vsum4sbs --
4647    --------------
4648
4649    function vsum4sbs (A : LL_VSC; B : LL_VSI) return LL_VSI is
4650       VA     : constant VSC_View := To_View (A);
4651       VB     : constant VSI_View := To_View (B);
4652       Offset : Vchar_Range;
4653       D      : VSI_View;
4654
4655    begin
4656       for J in 0 .. 3 loop
4657          Offset := Vchar_Range (4 * J + Integer (Vchar_Range'First));
4658          D.Values (Vint_Range (J + Integer (Vint_Range'First))) :=
4659            LL_VSI_Operations.Saturate
4660            (SI64 (VA.Values (Offset))
4661             + SI64 (VA.Values (Offset + 1))
4662             + SI64 (VA.Values (Offset + 2))
4663             + SI64 (VA.Values (Offset + 3))
4664             + SI64 (VB.Values (Vint_Range (J + Integer (Vint_Range'First)))));
4665       end loop;
4666
4667       return To_Vector (D);
4668    end vsum4sbs;
4669
4670    --------------
4671    -- vsum4shs --
4672    --------------
4673
4674    function vsum4shs (A : LL_VSS; B : LL_VSI) return LL_VSI is
4675       VA     : constant VSS_View := To_View (A);
4676       VB     : constant VSI_View := To_View (B);
4677       Offset : Vshort_Range;
4678       D      : VSI_View;
4679
4680    begin
4681       for J in 0 .. 3 loop
4682          Offset := Vshort_Range (2 * J + Integer (Vchar_Range'First));
4683          D.Values (Vint_Range (J + Integer (Vint_Range'First))) :=
4684            LL_VSI_Operations.Saturate
4685            (SI64 (VA.Values (Offset))
4686             + SI64 (VA.Values (Offset + 1))
4687             + SI64 (VB.Values (Vint_Range (J + Integer (Vint_Range'First)))));
4688       end loop;
4689
4690       return To_Vector (D);
4691    end vsum4shs;
4692
4693    --------------
4694    -- vsum2sws --
4695    --------------
4696
4697    function vsum2sws (A : LL_VSI; B : LL_VSI) return LL_VSI is
4698       VA     : constant VSI_View := To_View (A);
4699       VB     : constant VSI_View := To_View (B);
4700       Offset : Vint_Range;
4701       D      : VSI_View;
4702
4703    begin
4704       for J in 0 .. 1 loop
4705          Offset := Vint_Range (2 * J + Integer (Vchar_Range'First));
4706          D.Values (Offset) := 0;
4707          D.Values (Offset + 1) :=
4708            LL_VSI_Operations.Saturate
4709            (SI64 (VA.Values (Offset))
4710             + SI64 (VA.Values (Offset + 1))
4711             + SI64 (VB.Values (Vint_Range (Offset + 1))));
4712       end loop;
4713
4714       return To_Vector (D);
4715    end vsum2sws;
4716
4717    -------------
4718    -- vsumsws --
4719    -------------
4720
4721    function vsumsws (A : LL_VSI; B : LL_VSI) return LL_VSI is
4722       VA         : constant VSI_View := To_View (A);
4723       VB         : constant VSI_View := To_View (B);
4724       D          : VSI_View;
4725       Sum_Buffer : SI64 := 0;
4726
4727    begin
4728       for J in Vint_Range'Range loop
4729          D.Values (J) := 0;
4730          Sum_Buffer := Sum_Buffer + SI64 (VA.Values (J));
4731       end loop;
4732
4733       Sum_Buffer := Sum_Buffer + SI64 (VB.Values (Vint_Range'Last));
4734       D.Values (Vint_Range'Last) := LL_VSI_Operations.Saturate (Sum_Buffer);
4735       return To_Vector (D);
4736    end vsumsws;
4737
4738    -----------
4739    -- vrfiz --
4740    -----------
4741
4742    function vrfiz (A : LL_VF) return LL_VF is
4743       VA : constant VF_View := To_View (A);
4744       D  : VF_View;
4745    begin
4746       for J in Vfloat_Range'Range loop
4747          D.Values (J) := C_float (Rnd_To_FPI_Trunc (F64 (VA.Values (J))));
4748       end loop;
4749
4750       return To_Vector (D);
4751    end vrfiz;
4752
4753    -------------
4754    -- vupkhsb --
4755    -------------
4756
4757    function vupkhsb (A : LL_VSC) return LL_VSS is
4758       VA : constant VSC_View := To_View (A);
4759       D  : VSS_View;
4760    begin
4761       D.Values := LL_VSC_LL_VSS_Operations.vupkxsx (VA.Values, 0);
4762       return To_Vector (D);
4763    end vupkhsb;
4764
4765    -------------
4766    -- vupkhsh --
4767    -------------
4768
4769    function vupkhsh (A : LL_VSS) return LL_VSI is
4770       VA : constant VSS_View := To_View (A);
4771       D  : VSI_View;
4772    begin
4773       D.Values := LL_VSS_LL_VSI_Operations.vupkxsx (VA.Values, 0);
4774       return To_Vector (D);
4775    end vupkhsh;
4776
4777    -------------
4778    -- vupkxpx --
4779    -------------
4780
4781    function vupkxpx (A : LL_VSS; Offset : Natural) return LL_VSI;
4782    --  For vupkhpx and vupklpx (depending on Offset)
4783
4784    function vupkxpx (A : LL_VSS; Offset : Natural) return LL_VSI is
4785       VA  : constant VUS_View := To_View (To_LL_VUS (A));
4786       K   : Vshort_Range;
4787       D   : VUI_View;
4788       P16 : Pixel_16;
4789       P32 : Pixel_32;
4790
4791       function Sign_Extend (X : Unsigned_1) return unsigned_char;
4792
4793       function Sign_Extend (X : Unsigned_1) return unsigned_char is
4794       begin
4795          if X = 1 then
4796             return 16#FF#;
4797          else
4798             return 16#00#;
4799          end if;
4800       end Sign_Extend;
4801
4802    begin
4803       for J in Vint_Range'Range loop
4804          K := Vshort_Range (Integer (J)
4805                             - Integer (Vint_Range'First)
4806                             + Integer (Vshort_Range'First)
4807                             + Offset);
4808          P16 := To_Pixel (VA.Values (K));
4809          P32.T := Sign_Extend (P16.T);
4810          P32.R := unsigned_char (P16.R);
4811          P32.G := unsigned_char (P16.G);
4812          P32.B := unsigned_char (P16.B);
4813          D.Values (J) := To_unsigned_int (P32);
4814       end loop;
4815
4816       return To_LL_VSI (To_Vector (D));
4817    end vupkxpx;
4818
4819    -------------
4820    -- vupkhpx --
4821    -------------
4822
4823    function vupkhpx (A : LL_VSS) return LL_VSI is
4824    begin
4825       return vupkxpx (A, 0);
4826    end vupkhpx;
4827
4828    -------------
4829    -- vupklsb --
4830    -------------
4831
4832    function vupklsb (A : LL_VSC) return LL_VSS is
4833       VA : constant VSC_View := To_View (A);
4834       D  : VSS_View;
4835    begin
4836       D.Values :=
4837         LL_VSC_LL_VSS_Operations.vupkxsx (VA.Values,
4838                                           Varray_signed_short'Length);
4839       return To_Vector (D);
4840    end vupklsb;
4841
4842    -------------
4843    -- vupklsh --
4844    -------------
4845
4846    function vupklsh (A : LL_VSS) return LL_VSI is
4847       VA : constant VSS_View := To_View (A);
4848       D  : VSI_View;
4849    begin
4850       D.Values :=
4851         LL_VSS_LL_VSI_Operations.vupkxsx (VA.Values,
4852                                           Varray_signed_int'Length);
4853       return To_Vector (D);
4854    end vupklsh;
4855
4856    -------------
4857    -- vupklpx --
4858    -------------
4859
4860    function vupklpx (A : LL_VSS) return LL_VSI is
4861    begin
4862       return vupkxpx (A, Varray_signed_int'Length);
4863    end vupklpx;
4864
4865    ----------
4866    -- vxor --
4867    ----------
4868
4869    function vxor (A : LL_VSI; B : LL_VSI) return LL_VSI is
4870       VA : constant VUI_View := To_View (To_LL_VUI (A));
4871       VB : constant VUI_View := To_View (To_LL_VUI (B));
4872       D  : VUI_View;
4873
4874    begin
4875       for J in Vint_Range'Range loop
4876          D.Values (J) := VA.Values (J) xor VB.Values (J);
4877       end loop;
4878
4879       return To_LL_VSI (To_Vector (D));
4880    end vxor;
4881
4882    ----------------
4883    -- vcmpequb_p --
4884    ----------------
4885
4886    function vcmpequb_p (A : c_int; B : LL_VSC; C : LL_VSC) return c_int is
4887       D : LL_VSC;
4888    begin
4889       D := vcmpequb (B, C);
4890       return LL_VSC_Operations.Check_CR6 (A, To_View (D).Values);
4891    end vcmpequb_p;
4892
4893    ----------------
4894    -- vcmpequh_p --
4895    ----------------
4896
4897    function vcmpequh_p (A : c_int; B : LL_VSS; C : LL_VSS) return c_int is
4898       D : LL_VSS;
4899    begin
4900       D := vcmpequh (B, C);
4901       return LL_VSS_Operations.Check_CR6 (A, To_View (D).Values);
4902    end vcmpequh_p;
4903
4904    ----------------
4905    -- vcmpequw_p --
4906    ----------------
4907
4908    function vcmpequw_p (A : c_int; B : LL_VSI; C : LL_VSI) return c_int is
4909       D : LL_VSI;
4910    begin
4911       D := vcmpequw (B, C);
4912       return LL_VSI_Operations.Check_CR6 (A, To_View (D).Values);
4913    end vcmpequw_p;
4914
4915    ----------------
4916    -- vcmpeqfp_p --
4917    ----------------
4918
4919    function vcmpeqfp_p (A : c_int; B : LL_VF; C : LL_VF) return c_int is
4920       D : LL_VSI;
4921    begin
4922       D := vcmpeqfp (B, C);
4923       return LL_VSI_Operations.Check_CR6 (A, To_View (D).Values);
4924    end vcmpeqfp_p;
4925
4926    ----------------
4927    -- vcmpgtub_p --
4928    ----------------
4929
4930    function vcmpgtub_p (A : c_int; B : LL_VSC; C : LL_VSC) return c_int is
4931       D : LL_VSC;
4932    begin
4933       D := vcmpgtub (B, C);
4934       return LL_VSC_Operations.Check_CR6 (A, To_View (D).Values);
4935    end vcmpgtub_p;
4936
4937    ----------------
4938    -- vcmpgtuh_p --
4939    ----------------
4940
4941    function vcmpgtuh_p (A : c_int; B : LL_VSS; C : LL_VSS) return c_int is
4942       D : LL_VSS;
4943    begin
4944       D := vcmpgtuh (B, C);
4945       return LL_VSS_Operations.Check_CR6 (A, To_View (D).Values);
4946    end vcmpgtuh_p;
4947
4948    ----------------
4949    -- vcmpgtuw_p --
4950    ----------------
4951
4952    function vcmpgtuw_p (A : c_int; B : LL_VSI; C : LL_VSI) return c_int is
4953       D : LL_VSI;
4954    begin
4955       D := vcmpgtuw (B, C);
4956       return LL_VSI_Operations.Check_CR6 (A, To_View (D).Values);
4957    end vcmpgtuw_p;
4958
4959    ----------------
4960    -- vcmpgtsb_p --
4961    ----------------
4962
4963    function vcmpgtsb_p (A : c_int; B : LL_VSC; C : LL_VSC) return c_int is
4964       D : LL_VSC;
4965    begin
4966       D := vcmpgtsb (B, C);
4967       return LL_VSC_Operations.Check_CR6 (A, To_View (D).Values);
4968    end vcmpgtsb_p;
4969
4970    ----------------
4971    -- vcmpgtsh_p --
4972    ----------------
4973
4974    function vcmpgtsh_p (A : c_int; B : LL_VSS; C : LL_VSS) return c_int is
4975       D : LL_VSS;
4976    begin
4977       D := vcmpgtsh (B, C);
4978       return LL_VSS_Operations.Check_CR6 (A, To_View (D).Values);
4979    end vcmpgtsh_p;
4980
4981    ----------------
4982    -- vcmpgtsw_p --
4983    ----------------
4984
4985    function vcmpgtsw_p (A : c_int; B : LL_VSI; C : LL_VSI) return c_int is
4986       D : LL_VSI;
4987    begin
4988       D := vcmpgtsw (B, C);
4989       return LL_VSI_Operations.Check_CR6 (A, To_View (D).Values);
4990    end vcmpgtsw_p;
4991
4992    ----------------
4993    -- vcmpgefp_p --
4994    ----------------
4995
4996    function vcmpgefp_p (A : c_int; B : LL_VF; C : LL_VF) return c_int is
4997       D : LL_VSI;
4998    begin
4999       D := vcmpgefp (B, C);
5000       return LL_VSI_Operations.Check_CR6 (A, To_View (D).Values);
5001    end vcmpgefp_p;
5002
5003    ----------------
5004    -- vcmpgtfp_p --
5005    ----------------
5006
5007    function vcmpgtfp_p (A : c_int; B : LL_VF; C : LL_VF) return c_int is
5008       D : LL_VSI;
5009    begin
5010       D := vcmpgtfp (B, C);
5011       return LL_VSI_Operations.Check_CR6 (A, To_View (D).Values);
5012    end vcmpgtfp_p;
5013
5014    ----------------
5015    -- vcmpbfp_p --
5016    ----------------
5017
5018    function vcmpbfp_p (A : c_int; B : LL_VF; C : LL_VF) return c_int is
5019       D : VSI_View;
5020    begin
5021       D := To_View (vcmpbfp (B, C));
5022
5023       for J in Vint_Range'Range loop
5024          --  vcmpbfp is not returning the usual bool vector; do the conversion
5025          if D.Values (J) = 0 then
5026             D.Values (J) := Signed_Bool_False;
5027          else
5028             D.Values (J) := Signed_Bool_True;
5029          end if;
5030       end loop;
5031
5032       return LL_VSI_Operations.Check_CR6 (A, D.Values);
5033    end vcmpbfp_p;
5034
5035 end GNAT.Altivec.Low_Level_Vectors;