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