515 lines
15 KiB
Ada
515 lines
15 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- 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;
|