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