path: root/gcc/ada/g-altcon.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--             G N A T . A L T I V E C . C O N V E R S I O N S              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2005-2009, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Unchecked_Conversion;

with System; use System;

package body GNAT.Altivec.Conversions is

   --  All the vector/view conversions operate similarly: bare unchecked
   --  conversion on big endian targets, and elements permutation on little
   --  endian targets. We call "Mirroring" the elements permutation process.

   --  We would like to provide a generic version of the conversion routines
   --  and just have a set of "renaming as body" declarations to satisfy the
   --  public interface. This unfortunately prevents inlining, which we must
   --  preserve at least for the hard binding.

   --  We instead provide a generic version of facilities needed by all the
   --  conversion routines and use them repeatedly.

   generic
      type Vitem_Type is private;

      type Varray_Index_Type is range <>;
      type Varray_Type is array (Varray_Index_Type) of Vitem_Type;

      type Vector_Type is private;
      type View_Type is private;

   package Generic_Conversions is

      subtype Varray is Varray_Type;
      --  This provides an easy common way to refer to the type parameter
      --  in contexts where a specific instance of this package is "use"d.

      procedure Mirror (A : Varray_Type; Into : out Varray_Type);
      pragma Inline (Mirror);
      --  Mirror the elements of A into INTO, not touching the per-element
      --  internal ordering.

      --  A procedure with an out parameter is a bit heavier to use than a
      --  function but reduces the amount of temporary creations around the
      --  call. Instances are typically not front-end inlined. They can still
      --  be back-end inlined on request with the proper command-line option.

      --  Below are Unchecked Conversion routines for various purposes,
      --  relying on internal knowledge about the bits layout in the different
      --  types (all 128 value bits blocks).

      --  View<->Vector straight bitwise conversions on BE targets

      function UNC_To_Vector is
         new Ada.Unchecked_Conversion (View_Type, Vector_Type);

      function UNC_To_View is
         new Ada.Unchecked_Conversion (Vector_Type, View_Type);

      --  Varray->Vector/View for returning mirrored results on LE targets

      function UNC_To_Vector is
         new Ada.Unchecked_Conversion (Varray_Type, Vector_Type);

      function UNC_To_View is
         new Ada.Unchecked_Conversion (Varray_Type, View_Type);

      --  Vector/View->Varray for to-be-permuted source on LE targets

      function UNC_To_Varray is
         new Ada.Unchecked_Conversion (Vector_Type, Varray_Type);

      function UNC_To_Varray is
         new Ada.Unchecked_Conversion (View_Type, Varray_Type);

   end Generic_Conversions;

   package body Generic_Conversions is

      procedure Mirror (A : Varray_Type; Into : out Varray_Type) is
      begin
         for J in A'Range loop
            Into (J) := A (A'Last - J + A'First);
         end loop;
      end Mirror;

   end Generic_Conversions;

   --  Now we declare the instances and implement the interface function
   --  bodies simply calling the instantiated routines.

   ---------------------
   -- Char components --
   ---------------------

   package SC_Conversions is new Generic_Conversions
     (signed_char, Vchar_Range, Varray_signed_char, VSC, VSC_View);

   function To_Vector (S : VSC_View) return VSC is
      use SC_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_Vector (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_Vector (M);
         end;
      end if;
   end To_Vector;

   function To_View (S : VSC) return VSC_View is
      use SC_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_View (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_View (M);
         end;
      end if;
   end To_View;

   --

   package UC_Conversions is new Generic_Conversions
     (unsigned_char, Vchar_Range, Varray_unsigned_char, VUC, VUC_View);

   function To_Vector (S : VUC_View) return VUC is
      use UC_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_Vector (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_Vector (M);
         end;
      end if;
   end To_Vector;

   function To_View (S : VUC) return VUC_View is
      use UC_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_View (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_View (M);
         end;
      end if;
   end To_View;

   --

   package BC_Conversions is new Generic_Conversions
     (bool_char, Vchar_Range, Varray_bool_char, VBC, VBC_View);

   function To_Vector (S : VBC_View) return VBC is
      use BC_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_Vector (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_Vector (M);
         end;
      end if;
   end To_Vector;

   function To_View (S : VBC) return VBC_View is
      use BC_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_View (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_View (M);
         end;
      end if;
   end To_View;

   ----------------------
   -- Short components --
   ----------------------

   package SS_Conversions is new Generic_Conversions
     (signed_short, Vshort_Range, Varray_signed_short, VSS, VSS_View);

   function To_Vector (S : VSS_View) return VSS is
      use SS_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_Vector (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_Vector (M);
         end;
      end if;
   end To_Vector;

   function To_View (S : VSS) return VSS_View is
      use SS_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_View (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_View (M);
         end;
      end if;
   end To_View;

   --

   package US_Conversions is new Generic_Conversions
     (unsigned_short, Vshort_Range, Varray_unsigned_short, VUS, VUS_View);

   function To_Vector (S : VUS_View) return VUS is
      use US_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_Vector (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_Vector (M);
         end;
      end if;
   end To_Vector;

   function To_View (S : VUS) return VUS_View is
      use US_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_View (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_View (M);
         end;
      end if;
   end To_View;

   --

   package BS_Conversions is new Generic_Conversions
     (bool_short, Vshort_Range, Varray_bool_short, VBS, VBS_View);

   function To_Vector (S : VBS_View) return VBS is
      use BS_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_Vector (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_Vector (M);
         end;
      end if;
   end To_Vector;

   function To_View (S : VBS) return VBS_View is
      use BS_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_View (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_View (M);
         end;
      end if;
   end To_View;

   --------------------
   -- Int components --
   --------------------

   package SI_Conversions is new Generic_Conversions
     (signed_int, Vint_Range, Varray_signed_int, VSI, VSI_View);

   function To_Vector (S : VSI_View) return VSI is
      use SI_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_Vector (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_Vector (M);
         end;
      end if;
   end To_Vector;

   function To_View (S : VSI) return VSI_View is
      use SI_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_View (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_View (M);
         end;
      end if;
   end To_View;

   --

   package UI_Conversions is new Generic_Conversions
     (unsigned_int, Vint_Range, Varray_unsigned_int, VUI, VUI_View);

   function To_Vector (S : VUI_View) return VUI is
      use UI_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_Vector (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_Vector (M);
         end;
      end if;
   end To_Vector;

   function To_View (S : VUI) return VUI_View is
      use UI_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_View (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_View (M);
         end;
      end if;
   end To_View;

   --

   package BI_Conversions is new Generic_Conversions
     (bool_int, Vint_Range, Varray_bool_int, VBI, VBI_View);

   function To_Vector (S : VBI_View) return VBI is
      use BI_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_Vector (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_Vector (M);
         end;
      end if;
   end To_Vector;

   function To_View (S : VBI) return VBI_View is
      use BI_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_View (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_View (M);
         end;
      end if;
   end To_View;

   ----------------------
   -- Float components --
   ----------------------

   package F_Conversions is new Generic_Conversions
     (C_float, Vfloat_Range, Varray_float, VF, VF_View);

   function To_Vector (S : VF_View) return VF is
      use F_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_Vector (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_Vector (M);
         end;
      end if;
   end To_Vector;

   function To_View (S : VF) return VF_View is
      use F_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_View (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_View (M);
         end;
      end if;
   end To_View;

   ----------------------
   -- Pixel components --
   ----------------------

   package P_Conversions is new Generic_Conversions
     (pixel, Vpixel_Range, Varray_pixel, VP, VP_View);

   function To_Vector (S : VP_View) return VP is
      use P_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_Vector (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_Vector (M);
         end;
      end if;
   end To_Vector;

   function To_View (S : VP) return VP_View is
      use P_Conversions;
   begin
      if Default_Bit_Order = High_Order_First then
         return UNC_To_View (S);
      else
         declare
            M : Varray;
         begin
            Mirror (UNC_To_Varray (S), Into => M);
            return UNC_To_View (M);
         end;
      end if;
   end To_View;

end GNAT.Altivec.Conversions;