OSDN Git Service

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