OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [ada/] [g-alleve.adb] - Blame information for rev 847

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.