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