gcc/ada/g-altcon.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --             G N A T . A L T I V E C . C O N V E R S I O N S              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2005-2009, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with Ada.Unchecked_Conversion;
  33
  34 with System; use System;
  35
  36 package body GNAT.Altivec.Conversions is
  37
  38    --  All the vector/view conversions operate similarly: bare unchecked
  39    --  conversion on big endian targets, and elements permutation on little
  40    --  endian targets. We call "Mirroring" the elements permutation process.
  41
  42    --  We would like to provide a generic version of the conversion routines
  43    --  and just have a set of "renaming as body" declarations to satisfy the
  44    --  public interface. This unfortunately prevents inlining, which we must
  45    --  preserve at least for the hard binding.
  46
  47    --  We instead provide a generic version of facilities needed by all the
  48    --  conversion routines and use them repeatedly.
  49
  50    generic
  51       type Vitem_Type is private;
  52
  53       type Varray_Index_Type is range <>;
  54       type Varray_Type is array (Varray_Index_Type) of Vitem_Type;
  55
  56       type Vector_Type is private;
  57       type View_Type is private;
  58
  59    package Generic_Conversions is
  60
  61       subtype Varray is Varray_Type;
  62       --  This provides an easy common way to refer to the type parameter
  63       --  in contexts where a specific instance of this package is "use"d.
  64
  65       procedure Mirror (A : Varray_Type; Into : out Varray_Type);
  66       pragma Inline (Mirror);
  67       --  Mirror the elements of A into INTO, not touching the per-element
  68       --  internal ordering.
  69
  70       --  A procedure with an out parameter is a bit heavier to use than a
  71       --  function but reduces the amount of temporary creations around the
  72       --  call. Instances are typically not front-end inlined. They can still
  73       --  be back-end inlined on request with the proper command-line option.
  74
  75       --  Below are Unchecked Conversion routines for various purposes,
  76       --  relying on internal knowledge about the bits layout in the different
  77       --  types (all 128 value bits blocks).
  78
  79       --  View<->Vector straight bitwise conversions on BE targets
  80
  81       function UNC_To_Vector is
  82          new Ada.Unchecked_Conversion (View_Type, Vector_Type);
  83
  84       function UNC_To_View is
  85          new Ada.Unchecked_Conversion (Vector_Type, View_Type);
  86
  87       --  Varray->Vector/View for returning mirrored results on LE targets
  88
  89       function UNC_To_Vector is
  90          new Ada.Unchecked_Conversion (Varray_Type, Vector_Type);
  91
  92       function UNC_To_View is
  93          new Ada.Unchecked_Conversion (Varray_Type, View_Type);
  94
  95       --  Vector/View->Varray for to-be-permuted source on LE targets
  96
  97       function UNC_To_Varray is
  98          new Ada.Unchecked_Conversion (Vector_Type, Varray_Type);
  99
 100       function UNC_To_Varray is
 101          new Ada.Unchecked_Conversion (View_Type, Varray_Type);
 102
 103    end Generic_Conversions;
 104
 105    package body Generic_Conversions is
 106
 107       procedure Mirror (A : Varray_Type; Into : out Varray_Type) is
 108       begin
 109          for J in A'Range loop
 110             Into (J) := A (A'Last - J + A'First);
 111          end loop;
 112       end Mirror;
 113
 114    end Generic_Conversions;
 115
 116    --  Now we declare the instances and implement the interface function
 117    --  bodies simply calling the instantiated routines.
 118
 119    ---------------------
 120    -- Char components --
 121    ---------------------
 122
 123    package SC_Conversions is new Generic_Conversions
 124      (signed_char, Vchar_Range, Varray_signed_char, VSC, VSC_View);
 125
 126    function To_Vector (S : VSC_View) return VSC is
 127       use SC_Conversions;
 128    begin
 129       if Default_Bit_Order = High_Order_First then
 130          return UNC_To_Vector (S);
 131       else
 132          declare
 133             M : Varray;
 134          begin
 135             Mirror (UNC_To_Varray (S), Into => M);
 136             return UNC_To_Vector (M);
 137          end;
 138       end if;
 139    end To_Vector;
 140
 141    function To_View (S : VSC) return VSC_View is
 142       use SC_Conversions;
 143    begin
 144       if Default_Bit_Order = High_Order_First then
 145          return UNC_To_View (S);
 146       else
 147          declare
 148             M : Varray;
 149          begin
 150             Mirror (UNC_To_Varray (S), Into => M);
 151             return UNC_To_View (M);
 152          end;
 153       end if;
 154    end To_View;
 155
 156    --
 157
 158    package UC_Conversions is new Generic_Conversions
 159      (unsigned_char, Vchar_Range, Varray_unsigned_char, VUC, VUC_View);
 160
 161    function To_Vector (S : VUC_View) return VUC is
 162       use UC_Conversions;
 163    begin
 164       if Default_Bit_Order = High_Order_First then
 165          return UNC_To_Vector (S);
 166       else
 167          declare
 168             M : Varray;
 169          begin
 170             Mirror (UNC_To_Varray (S), Into => M);
 171             return UNC_To_Vector (M);
 172          end;
 173       end if;
 174    end To_Vector;
 175
 176    function To_View (S : VUC) return VUC_View is
 177       use UC_Conversions;
 178    begin
 179       if Default_Bit_Order = High_Order_First then
 180          return UNC_To_View (S);
 181       else
 182          declare
 183             M : Varray;
 184          begin
 185             Mirror (UNC_To_Varray (S), Into => M);
 186             return UNC_To_View (M);
 187          end;
 188       end if;
 189    end To_View;
 190
 191    --
 192
 193    package BC_Conversions is new Generic_Conversions
 194      (bool_char, Vchar_Range, Varray_bool_char, VBC, VBC_View);
 195
 196    function To_Vector (S : VBC_View) return VBC is
 197       use BC_Conversions;
 198    begin
 199       if Default_Bit_Order = High_Order_First then
 200          return UNC_To_Vector (S);
 201       else
 202          declare
 203             M : Varray;
 204          begin
 205             Mirror (UNC_To_Varray (S), Into => M);
 206             return UNC_To_Vector (M);
 207          end;
 208       end if;
 209    end To_Vector;
 210
 211    function To_View (S : VBC) return VBC_View is
 212       use BC_Conversions;
 213    begin
 214       if Default_Bit_Order = High_Order_First then
 215          return UNC_To_View (S);
 216       else
 217          declare
 218             M : Varray;
 219          begin
 220             Mirror (UNC_To_Varray (S), Into => M);
 221             return UNC_To_View (M);
 222          end;
 223       end if;
 224    end To_View;
 225
 226    ----------------------
 227    -- Short components --
 228    ----------------------
 229
 230    package SS_Conversions is new Generic_Conversions
 231      (signed_short, Vshort_Range, Varray_signed_short, VSS, VSS_View);
 232
 233    function To_Vector (S : VSS_View) return VSS is
 234       use SS_Conversions;
 235    begin
 236       if Default_Bit_Order = High_Order_First then
 237          return UNC_To_Vector (S);
 238       else
 239          declare
 240             M : Varray;
 241          begin
 242             Mirror (UNC_To_Varray (S), Into => M);
 243             return UNC_To_Vector (M);
 244          end;
 245       end if;
 246    end To_Vector;
 247
 248    function To_View (S : VSS) return VSS_View is
 249       use SS_Conversions;
 250    begin
 251       if Default_Bit_Order = High_Order_First then
 252          return UNC_To_View (S);
 253       else
 254          declare
 255             M : Varray;
 256          begin
 257             Mirror (UNC_To_Varray (S), Into => M);
 258             return UNC_To_View (M);
 259          end;
 260       end if;
 261    end To_View;
 262
 263    --
 264
 265    package US_Conversions is new Generic_Conversions
 266      (unsigned_short, Vshort_Range, Varray_unsigned_short, VUS, VUS_View);
 267
 268    function To_Vector (S : VUS_View) return VUS is
 269       use US_Conversions;
 270    begin
 271       if Default_Bit_Order = High_Order_First then
 272          return UNC_To_Vector (S);
 273       else
 274          declare
 275             M : Varray;
 276          begin
 277             Mirror (UNC_To_Varray (S), Into => M);
 278             return UNC_To_Vector (M);
 279          end;
 280       end if;
 281    end To_Vector;
 282
 283    function To_View (S : VUS) return VUS_View is
 284       use US_Conversions;
 285    begin
 286       if Default_Bit_Order = High_Order_First then
 287          return UNC_To_View (S);
 288       else
 289          declare
 290             M : Varray;
 291          begin
 292             Mirror (UNC_To_Varray (S), Into => M);
 293             return UNC_To_View (M);
 294          end;
 295       end if;
 296    end To_View;
 297
 298    --
 299
 300    package BS_Conversions is new Generic_Conversions
 301      (bool_short, Vshort_Range, Varray_bool_short, VBS, VBS_View);
 302
 303    function To_Vector (S : VBS_View) return VBS is
 304       use BS_Conversions;
 305    begin
 306       if Default_Bit_Order = High_Order_First then
 307          return UNC_To_Vector (S);
 308       else
 309          declare
 310             M : Varray;
 311          begin
 312             Mirror (UNC_To_Varray (S), Into => M);
 313             return UNC_To_Vector (M);
 314          end;
 315       end if;
 316    end To_Vector;
 317
 318    function To_View (S : VBS) return VBS_View is
 319       use BS_Conversions;
 320    begin
 321       if Default_Bit_Order = High_Order_First then
 322          return UNC_To_View (S);
 323       else
 324          declare
 325             M : Varray;
 326          begin
 327             Mirror (UNC_To_Varray (S), Into => M);
 328             return UNC_To_View (M);
 329          end;
 330       end if;
 331    end To_View;
 332
 333    --------------------
 334    -- Int components --
 335    --------------------
 336
 337    package SI_Conversions is new Generic_Conversions
 338      (signed_int, Vint_Range, Varray_signed_int, VSI, VSI_View);
 339
 340    function To_Vector (S : VSI_View) return VSI is
 341       use SI_Conversions;
 342    begin
 343       if Default_Bit_Order = High_Order_First then
 344          return UNC_To_Vector (S);
 345       else
 346          declare
 347             M : Varray;
 348          begin
 349             Mirror (UNC_To_Varray (S), Into => M);
 350             return UNC_To_Vector (M);
 351          end;
 352       end if;
 353    end To_Vector;
 354
 355    function To_View (S : VSI) return VSI_View is
 356       use SI_Conversions;
 357    begin
 358       if Default_Bit_Order = High_Order_First then
 359          return UNC_To_View (S);
 360       else
 361          declare
 362             M : Varray;
 363          begin
 364             Mirror (UNC_To_Varray (S), Into => M);
 365             return UNC_To_View (M);
 366          end;
 367       end if;
 368    end To_View;
 369
 370    --
 371
 372    package UI_Conversions is new Generic_Conversions
 373      (unsigned_int, Vint_Range, Varray_unsigned_int, VUI, VUI_View);
 374
 375    function To_Vector (S : VUI_View) return VUI is
 376       use UI_Conversions;
 377    begin
 378       if Default_Bit_Order = High_Order_First then
 379          return UNC_To_Vector (S);
 380       else
 381          declare
 382             M : Varray;
 383          begin
 384             Mirror (UNC_To_Varray (S), Into => M);
 385             return UNC_To_Vector (M);
 386          end;
 387       end if;
 388    end To_Vector;
 389
 390    function To_View (S : VUI) return VUI_View is
 391       use UI_Conversions;
 392    begin
 393       if Default_Bit_Order = High_Order_First then
 394          return UNC_To_View (S);
 395       else
 396          declare
 397             M : Varray;
 398          begin
 399             Mirror (UNC_To_Varray (S), Into => M);
 400             return UNC_To_View (M);
 401          end;
 402       end if;
 403    end To_View;
 404
 405    --
 406
 407    package BI_Conversions is new Generic_Conversions
 408      (bool_int, Vint_Range, Varray_bool_int, VBI, VBI_View);
 409
 410    function To_Vector (S : VBI_View) return VBI is
 411       use BI_Conversions;
 412    begin
 413       if Default_Bit_Order = High_Order_First then
 414          return UNC_To_Vector (S);
 415       else
 416          declare
 417             M : Varray;
 418          begin
 419             Mirror (UNC_To_Varray (S), Into => M);
 420             return UNC_To_Vector (M);
 421          end;
 422       end if;
 423    end To_Vector;
 424
 425    function To_View (S : VBI) return VBI_View is
 426       use BI_Conversions;
 427    begin
 428       if Default_Bit_Order = High_Order_First then
 429          return UNC_To_View (S);
 430       else
 431          declare
 432             M : Varray;
 433          begin
 434             Mirror (UNC_To_Varray (S), Into => M);
 435             return UNC_To_View (M);
 436          end;
 437       end if;
 438    end To_View;
 439
 440    ----------------------
 441    -- Float components --
 442    ----------------------
 443
 444    package F_Conversions is new Generic_Conversions
 445      (C_float, Vfloat_Range, Varray_float, VF, VF_View);
 446
 447    function To_Vector (S : VF_View) return VF is
 448       use F_Conversions;
 449    begin
 450       if Default_Bit_Order = High_Order_First then
 451          return UNC_To_Vector (S);
 452       else
 453          declare
 454             M : Varray;
 455          begin
 456             Mirror (UNC_To_Varray (S), Into => M);
 457             return UNC_To_Vector (M);
 458          end;
 459       end if;
 460    end To_Vector;
 461
 462    function To_View (S : VF) return VF_View is
 463       use F_Conversions;
 464    begin
 465       if Default_Bit_Order = High_Order_First then
 466          return UNC_To_View (S);
 467       else
 468          declare
 469             M : Varray;
 470          begin
 471             Mirror (UNC_To_Varray (S), Into => M);
 472             return UNC_To_View (M);
 473          end;
 474       end if;
 475    end To_View;
 476
 477    ----------------------
 478    -- Pixel components --
 479    ----------------------
 480
 481    package P_Conversions is new Generic_Conversions
 482      (pixel, Vpixel_Range, Varray_pixel, VP, VP_View);
 483
 484    function To_Vector (S : VP_View) return VP is
 485       use P_Conversions;
 486    begin
 487       if Default_Bit_Order = High_Order_First then
 488          return UNC_To_Vector (S);
 489       else
 490          declare
 491             M : Varray;
 492          begin
 493             Mirror (UNC_To_Varray (S), Into => M);
 494             return UNC_To_Vector (M);
 495          end;
 496       end if;
 497    end To_Vector;
 498
 499    function To_View (S : VP) return VP_View is
 500       use P_Conversions;
 501    begin
 502       if Default_Bit_Order = High_Order_First then
 503          return UNC_To_View (S);
 504       else
 505          declare
 506             M : Varray;
 507          begin
 508             Mirror (UNC_To_Varray (S), Into => M);
 509             return UNC_To_View (M);
 510          end;
 511       end if;
 512    end To_View;
 513
 514 end GNAT.Altivec.Conversions;