File : g-alleve.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- G N A T . A L T I V E C . L O W _ L E V E L _ V E C T O R S --
6 -- --
7 -- B o d y --
8 -- (Soft Binding Version) --
9 -- --
10 -- Copyright (C) 2004-2015, 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 -- --
20 -- --
21 -- --
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_VUI; B : c_int) return LL_VF is
2528 VA : constant VUI_View := To_View (A);
2529 D : VF_View;
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_VUI 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_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;