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