+2014-08-01 Thomas Quinot <quinot@adacore.com>
+
+ * freeze.adb: Minor reformatting.
+
+2014-08-01 Thomas Quinot <quinot@adacore.com>
+
+ * exp_ch3.adb (Default_Initialize_Object): Do not generate
+ default initialization for an imported object.
+
+2014-08-01 Olivier Hainque <hainque@adacore.com>
+
+ * seh_init.c (__gnat_map_SEH): Cast argument of IsBadCodePtr
+ to the expected FARPROC type instead of void *.
+ * adaint.c (f2t): Expect __time64_t * as second argument, in line with
+ other datastructures.
+ (__gnat_file_time_name_attr): Adjust accordingly.
+ (__gnat_check_OWNER_ACL): Declare pSD as PSECURITY_DESCRIPTOR,
+ in line with uses.
+ (__gnat_check_OWNER_ACL): Declare AccessMode
+ parameter as ACCESS_MODE instead of DWORD, in line with callers
+ and uses.
+ (__gnat_set_executable): Add ATTRIBUTE_UNUSED on mode,
+ unused on win32. Correct cast of "args" on call to spawnvp.
+ (add_handle): Cast realloc calls into their destination types.
+ (win32_wait): Remove declaration and initialization of unused variable.
+ (__gnat_locate_exec_on_path): Cast alloca calls
+ into their destination types.
+ * initialize.c (append_arg, __gnat_initialize): Cast xmalloc calls into
+ their destination types.
+
+2014-08-01 Gary Dismukes <dismukes@adacore.com>
+
+ * exp_ch4.adb (Expand_N_Type_Conversion): Expand
+ range checks for conversions between floating-point subtypes
+ when the target and source types are the same.
+
+2014-08-01 Robert Dewar <dewar@adacore.com>
+
+ * exp_aggr.adb: Minor reformatting.
+
+2014-08-01 Eric Botcazou <ebotcazou@adacore.com>
+
+ * sem_ch13.adb (Check_Indexing_Functions): Initialize
+ Indexing_Found.
+
+2014-08-01 Arnaud Charlet <charlet@adacore.com>
+
+ * gnat1drv.adb (Gnat1drv): In gnatprove mode, we now write the
+ ALI file before we call the backend (so that gnat2why can append
+ to it).
+
+2014-08-01 Thomas Quinot <quinot@adacore.com>
+
+ * exp_pakd.adb (Expand_Bit_Packed_Element_Set,
+ Expand_Packed_Element_Reference): Pass additional Rev_SSO
+ parameter indicating whether the packed array type has reverse
+ scalar storage order to the s-pack* Set/Get routines.
+ * s-pack*.ad* (Get, Set, GetU, SetU): New formal Rev_SSO
+ indicating reverse scalar storage order.
+
+2014-08-01 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch3.adb (Check_Initialization): Set Do_Range_Check
+ for initial component value in -gnatc or GNATprove mode.
+ (Process_Discriminants): Same fix for default discriminant values.
+ * sem_eval.adb (Test_In_Range): Improve accuracy of results by
+ checking subtypes.
+
+2014-08-01 Robert Dewar <dewar@adacore.com>
+
+ * sinfo.ads: Minor comment clarification.
+
2014-08-01 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch13.adb (Analyze_Aspect_Specifications): Code
/* As above but starting from a FILETIME. */
static void
-f2t (const FILETIME *ft, time_t *t)
+f2t (const FILETIME *ft, __time64_t *t)
{
union
{
} t_write;
t_write.ft_time = *ft;
- *t = (time_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
+ *t = (__time64_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
}
#endif
#if defined (_WIN32) && !defined (RTX)
BOOL res;
WIN32_FILE_ATTRIBUTE_DATA fad;
- time_t ret = -1;
+ __time64_t ret = -1;
TCHAR wname[GNAT_MAX_PATH_LEN];
S2WSC (wname, name, GNAT_MAX_PATH_LEN);
BOOL fAccessGranted = FALSE;
HANDLE hToken = NULL;
DWORD nLength = 0;
- SECURITY_DESCRIPTOR* pSD = NULL;
+ PSECURITY_DESCRIPTOR pSD = NULL;
GetFileSecurity
(wname, OWNER_SECURITY_INFORMATION |
static void
__gnat_set_OWNER_ACL (TCHAR *wname,
- DWORD AccessMode,
+ ACCESS_MODE AccessMode,
DWORD AccessPermissions)
{
PACL pOldDACL = NULL;
#define S_OTHERS 4
void
-__gnat_set_executable (char *name, int mode)
+__gnat_set_executable (char *name, int mode ATTRIBUTE_UNUSED)
{
#if defined (_WIN32) && !defined (RTX)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
strcat (args[0], args_0);
strcat (args[0], "\"");
- status = spawnvp (P_WAIT, args_0, (char* const*)args);
+ status = spawnvp (P_WAIT, args_0, (char ** const)args);
/* restore previous value */
free (args[0]);
{
plist_max_length += 1000;
HANDLES_LIST =
- (void **) xrealloc (HANDLES_LIST, sizeof (HANDLE) * plist_max_length);
+ (HANDLE *) xrealloc (HANDLES_LIST, sizeof (HANDLE) * plist_max_length);
PID_LIST =
(int *) xrealloc (PID_LIST, sizeof (int) * plist_max_length);
}
HANDLE *hl;
HANDLE h;
DWORD res;
- int k;
int hl_len;
if (plist_length == 0)
return -1;
}
- k = 0;
-
/* -------------------- critical section -------------------- */
(*Lock_Task) ();
Discr_Val : Elmt_Id;
begin
- Btype := Base_Type (Typ);
-
- -- The constraints on the hidden discriminants, if present, are
- -- kep in the Stored_Constraint list of the type itself, or in
- -- that of the base type.
+ -- The constraints on the hidden discriminants, if present, are kept
+ -- in the Stored_Constraint list of the type itself, or in that of
+ -- the base type.
+ Btype := Base_Type (Typ);
while Is_Derived_Type (Btype)
and then (Present (Stored_Constraint (Btype))
- or else Present (Stored_Constraint (Typ)))
+ or else
+ Present (Stored_Constraint (Typ)))
loop
Parent_Type := Etype (Btype);
+
if not Has_Discriminants (Parent_Type) then
return;
end if;
-- Start of processing for Default_Initialize_Object
begin
+ -- Default initialization is suppressed for objects that are already
+ -- known to be imported (i.e. whose declaration specifies the Import
+ -- aspect). Note that for objects with a pragma Import, we generate
+ -- initialization here, and then remove it downstream when processing
+ -- the pragma.
+
+ if Is_Imported (Def_Id) then
+ return;
+ end if;
+
-- Step 1: Initialize the object
if Needs_Finalization (Typ) and then not No_Initialization (N) then
-- The only remaining step is to generate a range check if we still have
-- a type conversion at this stage and Do_Range_Check is set. For now we
- -- do this only for conversions of discrete types.
+ -- do this only for conversions of discrete types and for floating-point
+ -- conversions where the base types of source and target are the same.
- if Nkind (N) = N_Type_Conversion
- and then Is_Discrete_Type (Etype (N))
- then
- declare
- Expr : constant Node_Id := Expression (N);
- Ftyp : Entity_Id;
- Ityp : Entity_Id;
+ if Nkind (N) = N_Type_Conversion then
- begin
- if Do_Range_Check (Expr)
- and then Is_Discrete_Type (Etype (Expr))
- then
- Set_Do_Range_Check (Expr, False);
+ -- For now we only support floating-point cases where the base types
+ -- of the target type and source expression are the same, so there's
+ -- potentially only a range check. Conversions where the source and
+ -- target have different base types are still TBD. ???
- -- Before we do a range check, we have to deal with treating a
- -- fixed-point operand as an integer. The way we do this is
- -- simply to do an unchecked conversion to an appropriate
- -- integer type large enough to hold the result.
+ if Is_Floating_Point_Type (Etype (N))
+ and then
+ Base_Type (Etype (N)) = Base_Type (Etype (Expression (N)))
+ then
+ if Do_Range_Check (Expression (N))
+ and then Is_Floating_Point_Type (Target_Type)
+ then
+ Generate_Range_Check
+ (Expression (N), Target_Type, CE_Range_Check_Failed);
+ end if;
- -- This code is not active yet, because we are only dealing
- -- with discrete types so far ???
+ elsif Is_Discrete_Type (Etype (N)) then
+ declare
+ Expr : constant Node_Id := Expression (N);
+ Ftyp : Entity_Id;
+ Ityp : Entity_Id;
- if Nkind (Expr) in N_Has_Treat_Fixed_As_Integer
- and then Treat_Fixed_As_Integer (Expr)
+ begin
+ if Do_Range_Check (Expr)
+ and then Is_Discrete_Type (Etype (Expr))
then
- Ftyp := Base_Type (Etype (Expr));
+ Set_Do_Range_Check (Expr, False);
- if Esize (Ftyp) >= Esize (Standard_Integer) then
- Ityp := Standard_Long_Long_Integer;
- else
- Ityp := Standard_Integer;
- end if;
+ -- Before we do a range check, we have to deal with treating
+ -- a fixed-point operand as an integer. The way we do this
+ -- is simply to do an unchecked conversion to an appropriate
+ -- integer type large enough to hold the result.
- Rewrite (Expr, Unchecked_Convert_To (Ityp, Expr));
- end if;
+ -- This code is not active yet, because we are only dealing
+ -- with discrete types so far ???
- -- Reset overflow flag, since the range check will include
- -- dealing with possible overflow, and generate the check. If
- -- Address is either a source type or target type, suppress
- -- range check to avoid typing anomalies when it is a visible
- -- integer type.
+ if Nkind (Expr) in N_Has_Treat_Fixed_As_Integer
+ and then Treat_Fixed_As_Integer (Expr)
+ then
+ Ftyp := Base_Type (Etype (Expr));
- Set_Do_Overflow_Check (N, False);
+ if Esize (Ftyp) >= Esize (Standard_Integer) then
+ Ityp := Standard_Long_Long_Integer;
+ else
+ Ityp := Standard_Integer;
+ end if;
- if not Is_Descendent_Of_Address (Etype (Expr))
- and then not Is_Descendent_Of_Address (Target_Type)
- then
- Generate_Range_Check
- (Expr, Target_Type, CE_Range_Check_Failed);
+ Rewrite (Expr, Unchecked_Convert_To (Ityp, Expr));
+ end if;
+
+ -- Reset overflow flag, since the range check will include
+ -- dealing with possible overflow, and generate the check.
+ -- If Address is either a source type or target type,
+ -- suppress range check to avoid typing anomalies when
+ -- it is a visible integer type.
+
+ Set_Do_Overflow_Check (N, False);
+
+ if not Is_Descendent_Of_Address (Etype (Expr))
+ and then not Is_Descendent_Of_Address (Target_Type)
+ then
+ Generate_Range_Check
+ (Expr, Target_Type, CE_Range_Check_Failed);
+ end if;
end if;
- end if;
- end;
+ end;
+ end if;
end if;
-- Here at end of processing
Set_nn : Entity_Id;
Subscr : Node_Id;
Atyp : Entity_Id;
+ Rev_SSO : Node_Id;
begin
if No (Bits_nn) then
Atyp := Etype (Obj);
Compute_Linear_Subscript (Atyp, Lhs, Subscr);
+ -- Set indication of whether the packed array has reverse SSO
+
+ Rev_SSO :=
+ New_Occurrence_Of
+ (Boolean_Literals (Reverse_Storage_Order (Atyp)), Loc);
+
-- Below we must make the assumption that Obj is
-- at least byte aligned, since otherwise its address
-- cannot be taken. The assumption holds since the
Prefix => Obj,
Attribute_Name => Name_Address),
Subscr,
- Unchecked_Convert_To (Bits_nn,
- Convert_To (Ctyp, Rhs)))));
+ Unchecked_Convert_To (Bits_nn, Convert_To (Ctyp, Rhs)),
+ Rev_SSO)));
end;
end if;
-- where Subscr is the computed linear subscript
declare
- Get_nn : Entity_Id;
- Subscr : Node_Id;
+ Get_nn : Entity_Id;
+ Subscr : Node_Id;
+ Rev_SSO : constant Node_Id :=
+ New_Occurrence_Of
+ (Boolean_Literals (Reverse_Storage_Order (Atyp)), Loc);
begin
-- Acquire proper Get entity. We use the aligned or unaligned
Make_Attribute_Reference (Loc,
Prefix => Obj,
Attribute_Name => Name_Address),
- Subscr))));
+ Subscr,
+ Rev_SSO))));
end;
end if;
Analyze_And_Resolve (N, Ctyp, Suppress => All_Checks);
-
end Expand_Packed_Element_Reference;
----------------------
-- Acquire copy of Inline pragma
- Iprag :=
- Copy_Separate_Tree (Import_Pragma (E));
+ Iprag := Copy_Separate_Tree (Import_Pragma (E));
-- Fix up spec to be not imported any more
Prepcomp.Add_Dependencies;
+ -- In gnatprove mode we're writing the ALI much earlier than usual
+ -- as flow analysis needs the file present in order to append its
+ -- own globals to it.
+
+ if GNATprove_Mode then
+
+ -- Note: In GNATprove mode, an "object" file is always generated as
+ -- the result of calling gnat1 or gnat2why, although this is not the
+ -- same as the object file produced for compilation.
+
+ Write_ALI (Object => True);
+ end if;
+
-- Back end needs to explicitly unlock tables it needs to touch
Atree.Lock;
Exit_Program (E_Errors);
end if;
- -- In GNATprove mode, an "object" file is always generated as the
- -- result of calling gnat1 or gnat2why, although this is not the
- -- same as the object file produced for compilation.
-
- Write_ALI (Object => (Back_End_Mode = Generate_Object
- or else GNATprove_Mode));
+ if not GNATprove_Mode then
+ Write_ALI (Object => (Back_End_Mode = Generate_Object));
+ end if;
if not Compilation_Errors then
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_03 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_03 --
------------
- function Get_03 (Arr : System.Address; N : Natural) return Bits_03 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_03
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_03
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_03;
------------
-- Set_03 --
------------
- procedure Set_03 (Arr : System.Address; N : Natural; E : Bits_03) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_03
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_03;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_03;
end System.Pack_03;
type Bits_03 is mod 2 ** Bits;
for Bits_03'Size use Bits;
- function Get_03 (Arr : System.Address; N : Natural) return Bits_03;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_03
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_03 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_03 (Arr : System.Address; N : Natural; E : Bits_03);
+ procedure Set_03
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_03;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_05 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_05 --
------------
- function Get_05 (Arr : System.Address; N : Natural) return Bits_05 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_05
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_05
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_05;
------------
-- Set_05 --
------------
- procedure Set_05 (Arr : System.Address; N : Natural; E : Bits_05) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_05
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_05;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_05;
end System.Pack_05;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_05 is mod 2 ** Bits;
for Bits_05'Size use Bits;
- function Get_05 (Arr : System.Address; N : Natural) return Bits_05;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_05
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_05 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_05 (Arr : System.Address; N : Natural; E : Bits_05);
+ procedure Set_05
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_05;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_06 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_06 or SetU_06 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_06 --
------------
- function Get_06 (Arr : System.Address; N : Natural) return Bits_06 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_06
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_06
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_06;
-------------
-- GetU_06 --
-------------
- function GetU_06 (Arr : System.Address; N : Natural) return Bits_06 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_06
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_06
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_06;
------------
-- Set_06 --
------------
- procedure Set_06 (Arr : System.Address; N : Natural; E : Bits_06) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_06
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_06;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_06;
-------------
-- SetU_06 --
-------------
- procedure SetU_06 (Arr : System.Address; N : Natural; E : Bits_06) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_06
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_06;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_06;
end System.Pack_06;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_06 is mod 2 ** Bits;
for Bits_06'Size use Bits;
- function Get_06 (Arr : System.Address; N : Natural) return Bits_06;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_06
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_06 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_06 (Arr : System.Address; N : Natural; E : Bits_06);
+ procedure Set_06
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_06;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_06 (Arr : System.Address; N : Natural) return Bits_06;
+ function GetU_06
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_06 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_06 (Arr : System.Address; N : Natural; E : Bits_06);
+ procedure SetU_06
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_06;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_07 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_07 --
------------
- function Get_07 (Arr : System.Address; N : Natural) return Bits_07 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_07
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_07
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_07;
------------
-- Set_07 --
------------
- procedure Set_07 (Arr : System.Address; N : Natural; E : Bits_07) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_07
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_07;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_07;
end System.Pack_07;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_07 is mod 2 ** Bits;
for Bits_07'Size use Bits;
- function Get_07 (Arr : System.Address; N : Natural) return Bits_07;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_07
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_07 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_07 (Arr : System.Address; N : Natural; E : Bits_07);
+ procedure Set_07
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_07;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_09 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_09 --
------------
- function Get_09 (Arr : System.Address; N : Natural) return Bits_09 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_09
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_09
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_09;
------------
-- Set_09 --
------------
- procedure Set_09 (Arr : System.Address; N : Natural; E : Bits_09) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_09
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_09;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_09;
end System.Pack_09;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_09 is mod 2 ** Bits;
for Bits_09'Size use Bits;
- function Get_09 (Arr : System.Address; N : Natural) return Bits_09;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_09
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_09 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_09 (Arr : System.Address; N : Natural; E : Bits_09);
+ procedure Set_09
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_09;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_10 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_10 or SetU_10 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_10 --
------------
- function Get_10 (Arr : System.Address; N : Natural) return Bits_10 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_10
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_10
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_10;
-------------
-- GetU_10 --
-------------
- function GetU_10 (Arr : System.Address; N : Natural) return Bits_10 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_10
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_10
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_10;
------------
-- Set_10 --
------------
- procedure Set_10 (Arr : System.Address; N : Natural; E : Bits_10) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_10
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_10;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_10;
-------------
-- SetU_10 --
-------------
- procedure SetU_10 (Arr : System.Address; N : Natural; E : Bits_10) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_10
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_10;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_10;
end System.Pack_10;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_10 is mod 2 ** Bits;
for Bits_10'Size use Bits;
- function Get_10 (Arr : System.Address; N : Natural) return Bits_10;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_10
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_10 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_10 (Arr : System.Address; N : Natural; E : Bits_10);
+ procedure Set_10
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_10;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_10 (Arr : System.Address; N : Natural) return Bits_10;
+ function GetU_10
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_10 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_10 (Arr : System.Address; N : Natural; E : Bits_10);
+ procedure SetU_10
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_10;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_11 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_11 --
------------
- function Get_11 (Arr : System.Address; N : Natural) return Bits_11 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_11
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_11
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_11;
------------
-- Set_11 --
------------
- procedure Set_11 (Arr : System.Address; N : Natural; E : Bits_11) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_11
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_11;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_11;
end System.Pack_11;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_11 is mod 2 ** Bits;
for Bits_11'Size use Bits;
- function Get_11 (Arr : System.Address; N : Natural) return Bits_11;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_11
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_11 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_11 (Arr : System.Address; N : Natural; E : Bits_11);
+ procedure Set_11
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_11;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_12 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_12 or SetU_12 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_12 --
------------
- function Get_12 (Arr : System.Address; N : Natural) return Bits_12 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_12
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_12
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_12;
-------------
-- GetU_12 --
-------------
- function GetU_12 (Arr : System.Address; N : Natural) return Bits_12 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_12
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_12
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_12;
------------
-- Set_12 --
------------
- procedure Set_12 (Arr : System.Address; N : Natural; E : Bits_12) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_12
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_12;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_12;
-------------
-- SetU_12 --
-------------
- procedure SetU_12 (Arr : System.Address; N : Natural; E : Bits_12) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_12
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_12;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_12;
end System.Pack_12;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_12 is mod 2 ** Bits;
for Bits_12'Size use Bits;
- function Get_12 (Arr : System.Address; N : Natural) return Bits_12;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_12
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_12 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_12 (Arr : System.Address; N : Natural; E : Bits_12);
+ procedure Set_12
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_12;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_12 (Arr : System.Address; N : Natural) return Bits_12;
+ function GetU_12
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_12 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_12 (Arr : System.Address; N : Natural; E : Bits_12);
+ procedure SetU_12
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_12;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_13 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_13 --
------------
- function Get_13 (Arr : System.Address; N : Natural) return Bits_13 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_13
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_13
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_13;
------------
-- Set_13 --
------------
- procedure Set_13 (Arr : System.Address; N : Natural; E : Bits_13) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_13
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_13;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_13;
end System.Pack_13;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_13 is mod 2 ** Bits;
for Bits_13'Size use Bits;
- function Get_13 (Arr : System.Address; N : Natural) return Bits_13;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_13
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_13 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_13 (Arr : System.Address; N : Natural; E : Bits_13);
+ procedure Set_13
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_13;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_14 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_14 or SetU_14 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_14 --
------------
- function Get_14 (Arr : System.Address; N : Natural) return Bits_14 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_14
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_14
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_14;
-------------
-- GetU_14 --
-------------
- function GetU_14 (Arr : System.Address; N : Natural) return Bits_14 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_14
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_14
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_14;
------------
-- Set_14 --
------------
- procedure Set_14 (Arr : System.Address; N : Natural; E : Bits_14) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_14
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_14;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_14;
-------------
-- SetU_14 --
-------------
- procedure SetU_14 (Arr : System.Address; N : Natural; E : Bits_14) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_14
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_14;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_14;
end System.Pack_14;
type Bits_14 is mod 2 ** Bits;
for Bits_14'Size use Bits;
- function Get_14 (Arr : System.Address; N : Natural) return Bits_14;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_14
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_14 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_14 (Arr : System.Address; N : Natural; E : Bits_14);
+ procedure Set_14
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_14;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_14 (Arr : System.Address; N : Natural) return Bits_14;
+ function GetU_14
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_14 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_14 (Arr : System.Address; N : Natural; E : Bits_14);
+ procedure SetU_14
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_14;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_15 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_15 --
------------
- function Get_15 (Arr : System.Address; N : Natural) return Bits_15 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_15
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_15
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_15;
------------
-- Set_15 --
------------
- procedure Set_15 (Arr : System.Address; N : Natural; E : Bits_15) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_15
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_15;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_15;
end System.Pack_15;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_15 is mod 2 ** Bits;
for Bits_15'Size use Bits;
- function Get_15 (Arr : System.Address; N : Natural) return Bits_15;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_15
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_15 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_15 (Arr : System.Address; N : Natural; E : Bits_15);
+ procedure Set_15
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_15;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_17 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_17 --
------------
- function Get_17 (Arr : System.Address; N : Natural) return Bits_17 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_17
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_17
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_17;
------------
-- Set_17 --
------------
- procedure Set_17 (Arr : System.Address; N : Natural; E : Bits_17) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_17
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_17;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_17;
end System.Pack_17;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_17 is mod 2 ** Bits;
for Bits_17'Size use Bits;
- function Get_17 (Arr : System.Address; N : Natural) return Bits_17;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_17
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_17 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_17 (Arr : System.Address; N : Natural; E : Bits_17);
+ procedure Set_17
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_17;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_18 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_18 or SetU_18 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_18 --
------------
- function Get_18 (Arr : System.Address; N : Natural) return Bits_18 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_18
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_18
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_18;
-------------
-- GetU_18 --
-------------
- function GetU_18 (Arr : System.Address; N : Natural) return Bits_18 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_18
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_18
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_18;
------------
-- Set_18 --
------------
- procedure Set_18 (Arr : System.Address; N : Natural; E : Bits_18) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_18
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_18;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_18;
-------------
-- SetU_18 --
-------------
- procedure SetU_18 (Arr : System.Address; N : Natural; E : Bits_18) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_18
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_18;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_18;
end System.Pack_18;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_18 is mod 2 ** Bits;
for Bits_18'Size use Bits;
- function Get_18 (Arr : System.Address; N : Natural) return Bits_18;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_18
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_18 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_18 (Arr : System.Address; N : Natural; E : Bits_18);
+ procedure Set_18
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_18;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_18 (Arr : System.Address; N : Natural) return Bits_18;
+ function GetU_18
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_18 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_18 (Arr : System.Address; N : Natural; E : Bits_18);
+ procedure SetU_18
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_18;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_19 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_19 --
------------
- function Get_19 (Arr : System.Address; N : Natural) return Bits_19 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_19
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_19
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_19;
------------
-- Set_19 --
------------
- procedure Set_19 (Arr : System.Address; N : Natural; E : Bits_19) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_19
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_19;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_19;
end System.Pack_19;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_19 is mod 2 ** Bits;
for Bits_19'Size use Bits;
- function Get_19 (Arr : System.Address; N : Natural) return Bits_19;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_19
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_19 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_19 (Arr : System.Address; N : Natural; E : Bits_19);
+ procedure Set_19
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_19;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_20 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_20 or SetU_20 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_20 --
------------
- function Get_20 (Arr : System.Address; N : Natural) return Bits_20 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_20
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_20
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_20;
-------------
-- GetU_20 --
-------------
- function GetU_20 (Arr : System.Address; N : Natural) return Bits_20 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_20
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_20
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_20;
------------
-- Set_20 --
------------
- procedure Set_20 (Arr : System.Address; N : Natural; E : Bits_20) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_20
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_20;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_20;
-------------
-- SetU_20 --
-------------
- procedure SetU_20 (Arr : System.Address; N : Natural; E : Bits_20) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_20
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_20;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_20;
end System.Pack_20;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_20 is mod 2 ** Bits;
for Bits_20'Size use Bits;
- function Get_20 (Arr : System.Address; N : Natural) return Bits_20;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_20
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_20 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_20 (Arr : System.Address; N : Natural; E : Bits_20);
+ procedure Set_20
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_20;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_20 (Arr : System.Address; N : Natural) return Bits_20;
+ function GetU_20
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_20 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_20 (Arr : System.Address; N : Natural; E : Bits_20);
+ procedure SetU_20
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_20;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_21 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_21 --
------------
- function Get_21 (Arr : System.Address; N : Natural) return Bits_21 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_21
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_21
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_21;
------------
-- Set_21 --
------------
- procedure Set_21 (Arr : System.Address; N : Natural; E : Bits_21) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_21
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_21;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_21;
end System.Pack_21;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_21 is mod 2 ** Bits;
for Bits_21'Size use Bits;
- function Get_21 (Arr : System.Address; N : Natural) return Bits_21;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_21
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_21 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_21 (Arr : System.Address; N : Natural; E : Bits_21);
+ procedure Set_21
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_21;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_22 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_22 or SetU_22 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_22 --
------------
- function Get_22 (Arr : System.Address; N : Natural) return Bits_22 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_22
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_22
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_22;
-------------
-- GetU_22 --
-------------
- function GetU_22 (Arr : System.Address; N : Natural) return Bits_22 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_22
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_22
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_22;
------------
-- Set_22 --
------------
- procedure Set_22 (Arr : System.Address; N : Natural; E : Bits_22) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_22
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_22;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_22;
-------------
-- SetU_22 --
-------------
- procedure SetU_22 (Arr : System.Address; N : Natural; E : Bits_22) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_22
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_22;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_22;
end System.Pack_22;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_22 is mod 2 ** Bits;
for Bits_22'Size use Bits;
- function Get_22 (Arr : System.Address; N : Natural) return Bits_22;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_22
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_22 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_22 (Arr : System.Address; N : Natural; E : Bits_22);
+ procedure Set_22
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_22;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_22 (Arr : System.Address; N : Natural) return Bits_22;
+ function GetU_22
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_22 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_22 (Arr : System.Address; N : Natural; E : Bits_22);
+ procedure SetU_22
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_22;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_23 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_23 --
------------
- function Get_23 (Arr : System.Address; N : Natural) return Bits_23 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_23
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_23
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_23;
------------
-- Set_23 --
------------
- procedure Set_23 (Arr : System.Address; N : Natural; E : Bits_23) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_23
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_23;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_23;
end System.Pack_23;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_23 is mod 2 ** Bits;
for Bits_23'Size use Bits;
- function Get_23 (Arr : System.Address; N : Natural) return Bits_23;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_23
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_23 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_23 (Arr : System.Address; N : Natural; E : Bits_23);
+ procedure Set_23
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_23;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_24 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_24 or SetU_24 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_24 --
------------
- function Get_24 (Arr : System.Address; N : Natural) return Bits_24 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_24
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_24
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_24;
-------------
-- GetU_24 --
-------------
- function GetU_24 (Arr : System.Address; N : Natural) return Bits_24 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_24
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_24
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_24;
------------
-- Set_24 --
------------
- procedure Set_24 (Arr : System.Address; N : Natural; E : Bits_24) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_24
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_24;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_24;
-------------
-- SetU_24 --
-------------
- procedure SetU_24 (Arr : System.Address; N : Natural; E : Bits_24) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_24
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_24;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_24;
end System.Pack_24;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_24 is mod 2 ** Bits;
for Bits_24'Size use Bits;
- function Get_24 (Arr : System.Address; N : Natural) return Bits_24;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_24
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_24 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_24 (Arr : System.Address; N : Natural; E : Bits_24);
+ procedure Set_24
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_24;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_24 (Arr : System.Address; N : Natural) return Bits_24;
+ function GetU_24
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_24 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_24 (Arr : System.Address; N : Natural; E : Bits_24);
+ procedure SetU_24
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_24;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_25 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_25 --
------------
- function Get_25 (Arr : System.Address; N : Natural) return Bits_25 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_25
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_25
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_25;
------------
-- Set_25 --
------------
- procedure Set_25 (Arr : System.Address; N : Natural; E : Bits_25) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_25
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_25;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_25;
end System.Pack_25;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_25 is mod 2 ** Bits;
for Bits_25'Size use Bits;
- function Get_25 (Arr : System.Address; N : Natural) return Bits_25;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_25
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_25 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_25 (Arr : System.Address; N : Natural; E : Bits_25);
+ procedure Set_25
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_25;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_26 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_26 or SetU_26 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_26 --
------------
- function Get_26 (Arr : System.Address; N : Natural) return Bits_26 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_26
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_26
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_26;
-------------
-- GetU_26 --
-------------
- function GetU_26 (Arr : System.Address; N : Natural) return Bits_26 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_26
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_26
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_26;
------------
-- Set_26 --
------------
- procedure Set_26 (Arr : System.Address; N : Natural; E : Bits_26) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_26
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_26;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_26;
-------------
-- SetU_26 --
-------------
- procedure SetU_26 (Arr : System.Address; N : Natural; E : Bits_26) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_26
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_26;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_26;
end System.Pack_26;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_26 is mod 2 ** Bits;
for Bits_26'Size use Bits;
- function Get_26 (Arr : System.Address; N : Natural) return Bits_26;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_26
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_26 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_26 (Arr : System.Address; N : Natural; E : Bits_26);
+ procedure Set_26
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_26;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_26 (Arr : System.Address; N : Natural) return Bits_26;
+ function GetU_26
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_26 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_26 (Arr : System.Address; N : Natural; E : Bits_26);
+ procedure SetU_26
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_26;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_27 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_27 --
------------
- function Get_27 (Arr : System.Address; N : Natural) return Bits_27 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_27
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_27
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_27;
------------
-- Set_27 --
------------
- procedure Set_27 (Arr : System.Address; N : Natural; E : Bits_27) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_27
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_27;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_27;
end System.Pack_27;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_27 is mod 2 ** Bits;
for Bits_27'Size use Bits;
- function Get_27 (Arr : System.Address; N : Natural) return Bits_27;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_27
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_27 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_27 (Arr : System.Address; N : Natural; E : Bits_27);
+ procedure Set_27
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_27;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_28 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_28 or SetU_28 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_28 --
------------
- function Get_28 (Arr : System.Address; N : Natural) return Bits_28 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_28
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_28
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_28;
-------------
-- GetU_28 --
-------------
- function GetU_28 (Arr : System.Address; N : Natural) return Bits_28 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_28
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_28
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_28;
------------
-- Set_28 --
------------
- procedure Set_28 (Arr : System.Address; N : Natural; E : Bits_28) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_28
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_28;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_28;
-------------
-- SetU_28 --
-------------
- procedure SetU_28 (Arr : System.Address; N : Natural; E : Bits_28) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_28
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_28;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_28;
end System.Pack_28;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_28 is mod 2 ** Bits;
for Bits_28'Size use Bits;
- function Get_28 (Arr : System.Address; N : Natural) return Bits_28;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_28
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_28 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_28 (Arr : System.Address; N : Natural; E : Bits_28);
+ procedure Set_28
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_28;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_28 (Arr : System.Address; N : Natural) return Bits_28;
+ function GetU_28
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_28 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_28 (Arr : System.Address; N : Natural; E : Bits_28);
+ procedure SetU_28
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_28;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_29 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_29 --
------------
- function Get_29 (Arr : System.Address; N : Natural) return Bits_29 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_29
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_29
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_29;
------------
-- Set_29 --
------------
- procedure Set_29 (Arr : System.Address; N : Natural; E : Bits_29) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_29
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_29;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_29;
end System.Pack_29;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_29 is mod 2 ** Bits;
for Bits_29'Size use Bits;
- function Get_29 (Arr : System.Address; N : Natural) return Bits_29;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_29
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_29 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_29 (Arr : System.Address; N : Natural; E : Bits_29);
+ procedure Set_29
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_29;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_30 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_30 or SetU_30 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_30 --
------------
- function Get_30 (Arr : System.Address; N : Natural) return Bits_30 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_30
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_30
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_30;
-------------
-- GetU_30 --
-------------
- function GetU_30 (Arr : System.Address; N : Natural) return Bits_30 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_30
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_30
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_30;
------------
-- Set_30 --
------------
- procedure Set_30 (Arr : System.Address; N : Natural; E : Bits_30) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_30
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_30;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_30;
-------------
-- SetU_30 --
-------------
- procedure SetU_30 (Arr : System.Address; N : Natural; E : Bits_30) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_30
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_30;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_30;
end System.Pack_30;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_30 is mod 2 ** Bits;
for Bits_30'Size use Bits;
- function Get_30 (Arr : System.Address; N : Natural) return Bits_30;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_30
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_30 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_30 (Arr : System.Address; N : Natural; E : Bits_30);
+ procedure Set_30
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_30;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_30 (Arr : System.Address; N : Natural) return Bits_30;
+ function GetU_30
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_30 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_30 (Arr : System.Address; N : Natural; E : Bits_30);
+ procedure SetU_30
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_30;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_31 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_31 --
------------
- function Get_31 (Arr : System.Address; N : Natural) return Bits_31 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_31
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_31
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_31;
------------
-- Set_31 --
------------
- procedure Set_31 (Arr : System.Address; N : Natural; E : Bits_31) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_31
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_31;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_31;
end System.Pack_31;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_31 is mod 2 ** Bits;
for Bits_31'Size use Bits;
- function Get_31 (Arr : System.Address; N : Natural) return Bits_31;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_31
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_31 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_31 (Arr : System.Address; N : Natural; E : Bits_31);
+ procedure Set_31
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_31;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_33 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_33 --
------------
- function Get_33 (Arr : System.Address; N : Natural) return Bits_33 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_33
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_33
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_33;
------------
-- Set_33 --
------------
- procedure Set_33 (Arr : System.Address; N : Natural; E : Bits_33) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_33
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_33;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_33;
end System.Pack_33;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_33 is mod 2 ** Bits;
for Bits_33'Size use Bits;
- function Get_33 (Arr : System.Address; N : Natural) return Bits_33;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_33
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_33 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_33 (Arr : System.Address; N : Natural; E : Bits_33);
+ procedure Set_33
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_33;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_34 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_34 or SetU_34 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_34 --
------------
- function Get_34 (Arr : System.Address; N : Natural) return Bits_34 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_34
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_34
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_34;
-------------
-- GetU_34 --
-------------
- function GetU_34 (Arr : System.Address; N : Natural) return Bits_34 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_34
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_34
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_34;
------------
-- Set_34 --
------------
- procedure Set_34 (Arr : System.Address; N : Natural; E : Bits_34) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_34
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_34;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_34;
-------------
-- SetU_34 --
-------------
- procedure SetU_34 (Arr : System.Address; N : Natural; E : Bits_34) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_34
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_34;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_34;
end System.Pack_34;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_34 is mod 2 ** Bits;
for Bits_34'Size use Bits;
- function Get_34 (Arr : System.Address; N : Natural) return Bits_34;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_34
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_34 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_34 (Arr : System.Address; N : Natural; E : Bits_34);
+ procedure Set_34
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_34;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_34 (Arr : System.Address; N : Natural) return Bits_34;
+ function GetU_34
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_34 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_34 (Arr : System.Address; N : Natural; E : Bits_34);
+ procedure SetU_34
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_34;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_35 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_35 --
------------
- function Get_35 (Arr : System.Address; N : Natural) return Bits_35 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_35
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_35
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_35;
------------
-- Set_35 --
------------
- procedure Set_35 (Arr : System.Address; N : Natural; E : Bits_35) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_35
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_35;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_35;
end System.Pack_35;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_35 is mod 2 ** Bits;
for Bits_35'Size use Bits;
- function Get_35 (Arr : System.Address; N : Natural) return Bits_35;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_35
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_35 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_35 (Arr : System.Address; N : Natural; E : Bits_35);
+ procedure Set_35
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_35;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_36 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_36 or SetU_36 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_36 --
------------
- function Get_36 (Arr : System.Address; N : Natural) return Bits_36 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_36
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_36
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_36;
-------------
-- GetU_36 --
-------------
- function GetU_36 (Arr : System.Address; N : Natural) return Bits_36 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_36
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_36
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_36;
------------
-- Set_36 --
------------
- procedure Set_36 (Arr : System.Address; N : Natural; E : Bits_36) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_36
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_36;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_36;
-------------
-- SetU_36 --
-------------
- procedure SetU_36 (Arr : System.Address; N : Natural; E : Bits_36) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_36
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_36;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_36;
end System.Pack_36;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_36 is mod 2 ** Bits;
for Bits_36'Size use Bits;
- function Get_36 (Arr : System.Address; N : Natural) return Bits_36;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_36
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_36 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_36 (Arr : System.Address; N : Natural; E : Bits_36);
+ procedure Set_36
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_36;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_36 (Arr : System.Address; N : Natural) return Bits_36;
+ function GetU_36
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_36 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_36 (Arr : System.Address; N : Natural; E : Bits_36);
+ procedure SetU_36
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_36;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_37 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_37 --
------------
- function Get_37 (Arr : System.Address; N : Natural) return Bits_37 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_37
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_37
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_37;
------------
-- Set_37 --
------------
- procedure Set_37 (Arr : System.Address; N : Natural; E : Bits_37) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_37
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_37;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_37;
end System.Pack_37;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_37 is mod 2 ** Bits;
for Bits_37'Size use Bits;
- function Get_37 (Arr : System.Address; N : Natural) return Bits_37;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_37
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_37 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_37 (Arr : System.Address; N : Natural; E : Bits_37);
+ procedure Set_37
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_37;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_38 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_38 or SetU_38 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_38 --
------------
- function Get_38 (Arr : System.Address; N : Natural) return Bits_38 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_38
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_38
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_38;
-------------
-- GetU_38 --
-------------
- function GetU_38 (Arr : System.Address; N : Natural) return Bits_38 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_38
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_38
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_38;
------------
-- Set_38 --
------------
- procedure Set_38 (Arr : System.Address; N : Natural; E : Bits_38) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_38
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_38;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_38;
-------------
-- SetU_38 --
-------------
- procedure SetU_38 (Arr : System.Address; N : Natural; E : Bits_38) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_38
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_38;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_38;
end System.Pack_38;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_38 is mod 2 ** Bits;
for Bits_38'Size use Bits;
- function Get_38 (Arr : System.Address; N : Natural) return Bits_38;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_38
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_38 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_38 (Arr : System.Address; N : Natural; E : Bits_38);
+ procedure Set_38
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_38;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_38 (Arr : System.Address; N : Natural) return Bits_38;
+ function GetU_38
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_38 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_38 (Arr : System.Address; N : Natural; E : Bits_38);
+ procedure SetU_38
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_38;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_39 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_39 --
------------
- function Get_39 (Arr : System.Address; N : Natural) return Bits_39 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_39
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_39
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_39;
------------
-- Set_39 --
------------
- procedure Set_39 (Arr : System.Address; N : Natural; E : Bits_39) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_39
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_39;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_39;
end System.Pack_39;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_39 is mod 2 ** Bits;
for Bits_39'Size use Bits;
- function Get_39 (Arr : System.Address; N : Natural) return Bits_39;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_39
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_39 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_39 (Arr : System.Address; N : Natural; E : Bits_39);
+ procedure Set_39
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_39;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_40 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_40 or SetU_40 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_40 --
------------
- function Get_40 (Arr : System.Address; N : Natural) return Bits_40 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_40
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_40
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_40;
-------------
-- GetU_40 --
-------------
- function GetU_40 (Arr : System.Address; N : Natural) return Bits_40 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_40
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_40
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_40;
------------
-- Set_40 --
------------
- procedure Set_40 (Arr : System.Address; N : Natural; E : Bits_40) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_40
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_40;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_40;
-------------
-- SetU_40 --
-------------
- procedure SetU_40 (Arr : System.Address; N : Natural; E : Bits_40) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_40
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_40;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_40;
end System.Pack_40;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_40 is mod 2 ** Bits;
for Bits_40'Size use Bits;
- function Get_40 (Arr : System.Address; N : Natural) return Bits_40;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_40
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_40 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_40 (Arr : System.Address; N : Natural; E : Bits_40);
+ procedure Set_40
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_40;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_40 (Arr : System.Address; N : Natural) return Bits_40;
+ function GetU_40
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_40 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_40 (Arr : System.Address; N : Natural; E : Bits_40);
+ procedure SetU_40
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_40;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_41 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_41 --
------------
- function Get_41 (Arr : System.Address; N : Natural) return Bits_41 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_41
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_41
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_41;
------------
-- Set_41 --
------------
- procedure Set_41 (Arr : System.Address; N : Natural; E : Bits_41) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_41
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_41;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_41;
end System.Pack_41;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_41 is mod 2 ** Bits;
for Bits_41'Size use Bits;
- function Get_41 (Arr : System.Address; N : Natural) return Bits_41;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_41
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_41 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_41 (Arr : System.Address; N : Natural; E : Bits_41);
+ procedure Set_41
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_41;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_42 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_42 or SetU_42 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_42 --
------------
- function Get_42 (Arr : System.Address; N : Natural) return Bits_42 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_42
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_42
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_42;
-------------
-- GetU_42 --
-------------
- function GetU_42 (Arr : System.Address; N : Natural) return Bits_42 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_42
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_42
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_42;
------------
-- Set_42 --
------------
- procedure Set_42 (Arr : System.Address; N : Natural; E : Bits_42) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_42
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_42;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_42;
-------------
-- SetU_42 --
-------------
- procedure SetU_42 (Arr : System.Address; N : Natural; E : Bits_42) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_42
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_42;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_42;
end System.Pack_42;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_42 is mod 2 ** Bits;
for Bits_42'Size use Bits;
- function Get_42 (Arr : System.Address; N : Natural) return Bits_42;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_42
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_42 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_42 (Arr : System.Address; N : Natural; E : Bits_42);
+ procedure Set_42
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_42;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_42 (Arr : System.Address; N : Natural) return Bits_42;
+ function GetU_42
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_42 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_42 (Arr : System.Address; N : Natural; E : Bits_42);
+ procedure SetU_42
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_42;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_43 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_43 --
------------
- function Get_43 (Arr : System.Address; N : Natural) return Bits_43 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_43
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_43
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_43;
------------
-- Set_43 --
------------
- procedure Set_43 (Arr : System.Address; N : Natural; E : Bits_43) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_43
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_43;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_43;
end System.Pack_43;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_43 is mod 2 ** Bits;
for Bits_43'Size use Bits;
- function Get_43 (Arr : System.Address; N : Natural) return Bits_43;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_43
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_43 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_43 (Arr : System.Address; N : Natural; E : Bits_43);
+ procedure Set_43
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_43;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_44 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_44 or SetU_44 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_44 --
------------
- function Get_44 (Arr : System.Address; N : Natural) return Bits_44 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_44
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_44
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_44;
-------------
-- GetU_44 --
-------------
- function GetU_44 (Arr : System.Address; N : Natural) return Bits_44 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_44
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_44
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_44;
------------
-- Set_44 --
------------
- procedure Set_44 (Arr : System.Address; N : Natural; E : Bits_44) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_44
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_44;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_44;
-------------
-- SetU_44 --
-------------
- procedure SetU_44 (Arr : System.Address; N : Natural; E : Bits_44) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_44
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_44;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_44;
end System.Pack_44;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_44 is mod 2 ** Bits;
for Bits_44'Size use Bits;
- function Get_44 (Arr : System.Address; N : Natural) return Bits_44;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_44
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_44 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_44 (Arr : System.Address; N : Natural; E : Bits_44);
+ procedure Set_44
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_44;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_44 (Arr : System.Address; N : Natural) return Bits_44;
+ function GetU_44
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_44 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_44 (Arr : System.Address; N : Natural; E : Bits_44);
+ procedure SetU_44
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_44;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_45 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_45 --
------------
- function Get_45 (Arr : System.Address; N : Natural) return Bits_45 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_45
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_45
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_45;
------------
-- Set_45 --
------------
- procedure Set_45 (Arr : System.Address; N : Natural; E : Bits_45) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_45
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_45;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_45;
end System.Pack_45;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_45 is mod 2 ** Bits;
for Bits_45'Size use Bits;
- function Get_45 (Arr : System.Address; N : Natural) return Bits_45;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_45
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_45 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_45 (Arr : System.Address; N : Natural; E : Bits_45);
+ procedure Set_45
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_45;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_46 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_46 or SetU_46 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_46 --
------------
- function Get_46 (Arr : System.Address; N : Natural) return Bits_46 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_46
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_46
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_46;
-------------
-- GetU_46 --
-------------
- function GetU_46 (Arr : System.Address; N : Natural) return Bits_46 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_46
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_46
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_46;
------------
-- Set_46 --
------------
- procedure Set_46 (Arr : System.Address; N : Natural; E : Bits_46) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_46
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_46;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_46;
-------------
-- SetU_46 --
-------------
- procedure SetU_46 (Arr : System.Address; N : Natural; E : Bits_46) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_46
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_46;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_46;
end System.Pack_46;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_46 is mod 2 ** Bits;
for Bits_46'Size use Bits;
- function Get_46 (Arr : System.Address; N : Natural) return Bits_46;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_46
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_46 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_46 (Arr : System.Address; N : Natural; E : Bits_46);
+ procedure Set_46
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_46;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_46 (Arr : System.Address; N : Natural) return Bits_46;
+ function GetU_46
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_46 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_46 (Arr : System.Address; N : Natural; E : Bits_46);
+ procedure SetU_46
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_46;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_47 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_47 --
------------
- function Get_47 (Arr : System.Address; N : Natural) return Bits_47 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_47
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_47
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_47;
------------
-- Set_47 --
------------
- procedure Set_47 (Arr : System.Address; N : Natural; E : Bits_47) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_47
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_47;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_47;
end System.Pack_47;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_47 is mod 2 ** Bits;
for Bits_47'Size use Bits;
- function Get_47 (Arr : System.Address; N : Natural) return Bits_47;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_47
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_47 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_47 (Arr : System.Address; N : Natural; E : Bits_47);
+ procedure Set_47
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_47;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_48 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_48 or SetU_48 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_48 --
------------
- function Get_48 (Arr : System.Address; N : Natural) return Bits_48 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_48
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_48
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_48;
-------------
-- GetU_48 --
-------------
- function GetU_48 (Arr : System.Address; N : Natural) return Bits_48 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_48
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_48
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_48;
------------
-- Set_48 --
------------
- procedure Set_48 (Arr : System.Address; N : Natural; E : Bits_48) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_48
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_48;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_48;
-------------
-- SetU_48 --
-------------
- procedure SetU_48 (Arr : System.Address; N : Natural; E : Bits_48) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_48
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_48;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_48;
end System.Pack_48;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_48 is mod 2 ** Bits;
for Bits_48'Size use Bits;
- function Get_48 (Arr : System.Address; N : Natural) return Bits_48;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_48
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_48 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_48 (Arr : System.Address; N : Natural; E : Bits_48);
+ procedure Set_48
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_48;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_48 (Arr : System.Address; N : Natural) return Bits_48;
+ function GetU_48
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_48 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_48 (Arr : System.Address; N : Natural; E : Bits_48);
+ procedure SetU_48
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_48;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_49 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_49 --
------------
- function Get_49 (Arr : System.Address; N : Natural) return Bits_49 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_49
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_49
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_49;
------------
-- Set_49 --
------------
- procedure Set_49 (Arr : System.Address; N : Natural; E : Bits_49) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_49
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_49;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_49;
end System.Pack_49;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_49 is mod 2 ** Bits;
for Bits_49'Size use Bits;
- function Get_49 (Arr : System.Address; N : Natural) return Bits_49;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_49
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_49 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_49 (Arr : System.Address; N : Natural; E : Bits_49);
+ procedure Set_49
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_49;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_50 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_50 or SetU_50 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_50 --
------------
- function Get_50 (Arr : System.Address; N : Natural) return Bits_50 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_50
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_50
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_50;
-------------
-- GetU_50 --
-------------
- function GetU_50 (Arr : System.Address; N : Natural) return Bits_50 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_50
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_50
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_50;
------------
-- Set_50 --
------------
- procedure Set_50 (Arr : System.Address; N : Natural; E : Bits_50) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_50
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_50;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_50;
-------------
-- SetU_50 --
-------------
- procedure SetU_50 (Arr : System.Address; N : Natural; E : Bits_50) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_50
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_50;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_50;
end System.Pack_50;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_50 is mod 2 ** Bits;
for Bits_50'Size use Bits;
- function Get_50 (Arr : System.Address; N : Natural) return Bits_50;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_50
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_50 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_50 (Arr : System.Address; N : Natural; E : Bits_50);
+ procedure Set_50
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_50;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_50 (Arr : System.Address; N : Natural) return Bits_50;
+ function GetU_50
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_50 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_50 (Arr : System.Address; N : Natural; E : Bits_50);
+ procedure SetU_50
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_50;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_51 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_51 --
------------
- function Get_51 (Arr : System.Address; N : Natural) return Bits_51 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_51
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_51
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_51;
------------
-- Set_51 --
------------
- procedure Set_51 (Arr : System.Address; N : Natural; E : Bits_51) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_51
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_51;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_51;
end System.Pack_51;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_51 is mod 2 ** Bits;
for Bits_51'Size use Bits;
- function Get_51 (Arr : System.Address; N : Natural) return Bits_51;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_51
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_51 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_51 (Arr : System.Address; N : Natural; E : Bits_51);
+ procedure Set_51
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_51;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_52 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_52 or SetU_52 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_52 --
------------
- function Get_52 (Arr : System.Address; N : Natural) return Bits_52 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_52
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_52
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_52;
-------------
-- GetU_52 --
-------------
- function GetU_52 (Arr : System.Address; N : Natural) return Bits_52 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_52
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_52
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_52;
------------
-- Set_52 --
------------
- procedure Set_52 (Arr : System.Address; N : Natural; E : Bits_52) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_52
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_52;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_52;
-------------
-- SetU_52 --
-------------
- procedure SetU_52 (Arr : System.Address; N : Natural; E : Bits_52) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_52
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_52;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_52;
end System.Pack_52;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_52 is mod 2 ** Bits;
for Bits_52'Size use Bits;
- function Get_52 (Arr : System.Address; N : Natural) return Bits_52;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_52
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_52 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_52 (Arr : System.Address; N : Natural; E : Bits_52);
+ procedure Set_52
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_52;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_52 (Arr : System.Address; N : Natural) return Bits_52;
+ function GetU_52
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_52 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_52 (Arr : System.Address; N : Natural; E : Bits_52);
+ procedure SetU_52
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_52;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_53 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_53 --
------------
- function Get_53 (Arr : System.Address; N : Natural) return Bits_53 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_53
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_53
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_53;
------------
-- Set_53 --
------------
- procedure Set_53 (Arr : System.Address; N : Natural; E : Bits_53) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_53
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_53;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_53;
end System.Pack_53;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_53 is mod 2 ** Bits;
for Bits_53'Size use Bits;
- function Get_53 (Arr : System.Address; N : Natural) return Bits_53;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_53
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_53 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_53 (Arr : System.Address; N : Natural; E : Bits_53);
+ procedure Set_53
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_53;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_54 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_54 or SetU_54 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_54 --
------------
- function Get_54 (Arr : System.Address; N : Natural) return Bits_54 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_54
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_54
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_54;
-------------
-- GetU_54 --
-------------
- function GetU_54 (Arr : System.Address; N : Natural) return Bits_54 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_54
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_54
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_54;
------------
-- Set_54 --
------------
- procedure Set_54 (Arr : System.Address; N : Natural; E : Bits_54) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_54
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_54;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_54;
-------------
-- SetU_54 --
-------------
- procedure SetU_54 (Arr : System.Address; N : Natural; E : Bits_54) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_54
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_54;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_54;
end System.Pack_54;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_54 is mod 2 ** Bits;
for Bits_54'Size use Bits;
- function Get_54 (Arr : System.Address; N : Natural) return Bits_54;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_54
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_54 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_54 (Arr : System.Address; N : Natural; E : Bits_54);
+ procedure Set_54
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_54;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_54 (Arr : System.Address; N : Natural) return Bits_54;
+ function GetU_54
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_54 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_54 (Arr : System.Address; N : Natural; E : Bits_54);
+ procedure SetU_54
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_54;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_55 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_55 --
------------
- function Get_55 (Arr : System.Address; N : Natural) return Bits_55 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_55
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_55
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_55;
------------
-- Set_55 --
------------
- procedure Set_55 (Arr : System.Address; N : Natural; E : Bits_55) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_55
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_55;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_55;
end System.Pack_55;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_55 is mod 2 ** Bits;
for Bits_55'Size use Bits;
- function Get_55 (Arr : System.Address; N : Natural) return Bits_55;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_55
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_55 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_55 (Arr : System.Address; N : Natural; E : Bits_55);
+ procedure Set_55
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_55;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_56 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_56 or SetU_56 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_56 --
------------
- function Get_56 (Arr : System.Address; N : Natural) return Bits_56 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_56
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_56
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_56;
-------------
-- GetU_56 --
-------------
- function GetU_56 (Arr : System.Address; N : Natural) return Bits_56 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_56
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_56
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_56;
------------
-- Set_56 --
------------
- procedure Set_56 (Arr : System.Address; N : Natural; E : Bits_56) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_56
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_56;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_56;
-------------
-- SetU_56 --
-------------
- procedure SetU_56 (Arr : System.Address; N : Natural; E : Bits_56) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_56
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_56;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_56;
end System.Pack_56;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_56 is mod 2 ** Bits;
for Bits_56'Size use Bits;
- function Get_56 (Arr : System.Address; N : Natural) return Bits_56;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_56
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_56 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_56 (Arr : System.Address; N : Natural; E : Bits_56);
+ procedure Set_56
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_56;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_56 (Arr : System.Address; N : Natural) return Bits_56;
+ function GetU_56
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_56 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_56 (Arr : System.Address; N : Natural; E : Bits_56);
+ procedure SetU_56
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_56;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_57 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_57 --
------------
- function Get_57 (Arr : System.Address; N : Natural) return Bits_57 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_57
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_57
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_57;
------------
-- Set_57 --
------------
- procedure Set_57 (Arr : System.Address; N : Natural; E : Bits_57) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_57
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_57;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_57;
end System.Pack_57;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_57 is mod 2 ** Bits;
for Bits_57'Size use Bits;
- function Get_57 (Arr : System.Address; N : Natural) return Bits_57;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_57
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_57 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_57 (Arr : System.Address; N : Natural; E : Bits_57);
+ procedure Set_57
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_57;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_58 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_58 or SetU_58 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_58 --
------------
- function Get_58 (Arr : System.Address; N : Natural) return Bits_58 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_58
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_58
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_58;
-------------
-- GetU_58 --
-------------
- function GetU_58 (Arr : System.Address; N : Natural) return Bits_58 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_58
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_58
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_58;
------------
-- Set_58 --
------------
- procedure Set_58 (Arr : System.Address; N : Natural; E : Bits_58) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_58
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_58;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_58;
-------------
-- SetU_58 --
-------------
- procedure SetU_58 (Arr : System.Address; N : Natural; E : Bits_58) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_58
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_58;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_58;
end System.Pack_58;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_58 is mod 2 ** Bits;
for Bits_58'Size use Bits;
- function Get_58 (Arr : System.Address; N : Natural) return Bits_58;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_58
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_58 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_58 (Arr : System.Address; N : Natural; E : Bits_58);
+ procedure Set_58
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_58;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_58 (Arr : System.Address; N : Natural) return Bits_58;
+ function GetU_58
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_58 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_58 (Arr : System.Address; N : Natural; E : Bits_58);
+ procedure SetU_58
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_58;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_59 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_59 --
------------
- function Get_59 (Arr : System.Address; N : Natural) return Bits_59 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_59
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_59
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_59;
------------
-- Set_59 --
------------
- procedure Set_59 (Arr : System.Address; N : Natural; E : Bits_59) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_59
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_59;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_59;
end System.Pack_59;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_59 is mod 2 ** Bits;
for Bits_59'Size use Bits;
- function Get_59 (Arr : System.Address; N : Natural) return Bits_59;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_59
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_59 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_59 (Arr : System.Address; N : Natural; E : Bits_59);
+ procedure Set_59
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_59;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_60 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_60 or SetU_60 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_60 --
------------
- function Get_60 (Arr : System.Address; N : Natural) return Bits_60 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_60
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_60
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_60;
-------------
-- GetU_60 --
-------------
- function GetU_60 (Arr : System.Address; N : Natural) return Bits_60 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_60
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_60
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_60;
------------
-- Set_60 --
------------
- procedure Set_60 (Arr : System.Address; N : Natural; E : Bits_60) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_60
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_60;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_60;
-------------
-- SetU_60 --
-------------
- procedure SetU_60 (Arr : System.Address; N : Natural; E : Bits_60) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_60
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_60;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_60;
end System.Pack_60;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_60 is mod 2 ** Bits;
for Bits_60'Size use Bits;
- function Get_60 (Arr : System.Address; N : Natural) return Bits_60;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_60
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_60 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_60 (Arr : System.Address; N : Natural; E : Bits_60);
+ procedure Set_60
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_60;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_60 (Arr : System.Address; N : Natural) return Bits_60;
+ function GetU_60
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_60 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_60 (Arr : System.Address; N : Natural; E : Bits_60);
+ procedure SetU_60
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_60;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_61 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_61 --
------------
- function Get_61 (Arr : System.Address; N : Natural) return Bits_61 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_61
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_61
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_61;
------------
-- Set_61 --
------------
- procedure Set_61 (Arr : System.Address; N : Natural; E : Bits_61) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_61
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_61;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_61;
end System.Pack_61;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_61 is mod 2 ** Bits;
for Bits_61'Size use Bits;
- function Get_61 (Arr : System.Address; N : Natural) return Bits_61;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_61
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_61 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_61 (Arr : System.Address; N : Natural; E : Bits_61);
+ procedure Set_61
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_61;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_62 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
-- The following declarations are for the case where the address
-- passed to GetU_62 or SetU_62 is not guaranteed to be aligned.
type ClusterU_Ref is access ClusterU;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, ClusterU_Ref);
+ type Rev_ClusterU is new ClusterU
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_ClusterU_Ref is access Rev_ClusterU;
------------
-- Get_62 --
------------
- function Get_62 (Arr : System.Address; N : Natural) return Bits_62 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_62
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_62
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_62;
-------------
-- GetU_62 --
-------------
- function GetU_62 (Arr : System.Address; N : Natural) return Bits_62 is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function GetU_62
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_62
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end GetU_62;
------------
-- Set_62 --
------------
- procedure Set_62 (Arr : System.Address; N : Natural; E : Bits_62) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_62
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_62;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_62;
-------------
-- SetU_62 --
-------------
- procedure SetU_62 (Arr : System.Address; N : Natural; E : Bits_62) is
- C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure SetU_62
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_62;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : ClusterU_Ref with Address => A'Address, Import;
+ RC : Rev_ClusterU_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end SetU_62;
end System.Pack_62;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_62 is mod 2 ** Bits;
for Bits_62'Size use Bits;
- function Get_62 (Arr : System.Address; N : Natural) return Bits_62;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_62
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_62 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_62 (Arr : System.Address; N : Natural; E : Bits_62);
+ procedure Set_62
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_62;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
- function GetU_62 (Arr : System.Address; N : Natural) return Bits_62;
+ function GetU_62
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_62 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned. This version
-- is used when Arr may represent an unaligned address.
- procedure SetU_62 (Arr : System.Address; N : Natural; E : Bits_62);
+ procedure SetU_62
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_62;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value. This version
-- is used when Arr may represent an unaligned address
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
with System.Storage_Elements;
with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
package body System.Pack_63 is
+ subtype Bit_Order is System.Bit_Order;
+ Reverse_Bit_Order : constant Bit_Order :=
+ Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
subtype Ofs is System.Storage_Elements.Storage_Offset;
subtype Uns is System.Unsigned_Types.Unsigned;
subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
type Cluster_Ref is access Cluster;
- function To_Ref is new
- Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+ type Rev_Cluster is new Cluster
+ with Bit_Order => Reverse_Bit_Order,
+ Scalar_Storage_Order => Reverse_Bit_Order;
+ type Rev_Cluster_Ref is access Rev_Cluster;
------------
-- Get_63 --
------------
- function Get_63 (Arr : System.Address; N : Natural) return Bits_63 is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ function Get_63
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_63
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => return C.E0;
- when 1 => return C.E1;
- when 2 => return C.E2;
- when 3 => return C.E3;
- when 4 => return C.E4;
- when 5 => return C.E5;
- when 6 => return C.E6;
- when 7 => return C.E7;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => return RC.E0;
+ when 1 => return RC.E1;
+ when 2 => return RC.E2;
+ when 3 => return RC.E3;
+ when 4 => return RC.E4;
+ when 5 => return RC.E5;
+ when 6 => return RC.E6;
+ when 7 => return RC.E7;
+ end case;
+
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => return C.E0;
+ when 1 => return C.E1;
+ when 2 => return C.E2;
+ when 3 => return C.E3;
+ when 4 => return C.E4;
+ when 5 => return C.E5;
+ when 6 => return C.E6;
+ when 7 => return C.E7;
+ end case;
+ end if;
end Get_63;
------------
-- Set_63 --
------------
- procedure Set_63 (Arr : System.Address; N : Natural; E : Bits_63) is
- C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+ procedure Set_63
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_63;
+ Rev_SSO : Boolean)
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
begin
- case N07 (Uns (N) mod 8) is
- when 0 => C.E0 := E;
- when 1 => C.E1 := E;
- when 2 => C.E2 := E;
- when 3 => C.E3 := E;
- when 4 => C.E4 := E;
- when 5 => C.E5 := E;
- when 6 => C.E6 := E;
- when 7 => C.E7 := E;
- end case;
+ if Rev_SSO then
+ case N07 (Uns (N) mod 8) is
+ when 0 => RC.E0 := E;
+ when 1 => RC.E1 := E;
+ when 2 => RC.E2 := E;
+ when 3 => RC.E3 := E;
+ when 4 => RC.E4 := E;
+ when 5 => RC.E5 := E;
+ when 6 => RC.E6 := E;
+ when 7 => RC.E7 := E;
+ end case;
+ else
+ case N07 (Uns (N) mod 8) is
+ when 0 => C.E0 := E;
+ when 1 => C.E1 := E;
+ when 2 => C.E2 := E;
+ when 3 => C.E3 := E;
+ when 4 => C.E4 := E;
+ when 5 => C.E5 := E;
+ when 6 => C.E6 := E;
+ when 7 => C.E7 := E;
+ end case;
+ end if;
end Set_63;
end System.Pack_63;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
type Bits_63 is mod 2 ** Bits;
for Bits_63'Size use Bits;
- function Get_63 (Arr : System.Address; N : Natural) return Bits_63;
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_63
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_63 with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is extracted and returned.
- procedure Set_63 (Arr : System.Address; N : Natural; E : Bits_63);
+ procedure Set_63
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_63;
+ Rev_SSO : Boolean) with Inline;
-- Arr is the address of the packed array, N is the zero-based
-- subscript. This element is set to the given value.
------------------------------
procedure Check_Indexing_Functions is
- Indexing_Found : Boolean;
+ Indexing_Found : Boolean := False;
procedure Check_One_Function (Subp : Entity_Id);
-- Check one possible interpretation. Sets Indexing_Found True if a
procedure Check_Initialization (T : Entity_Id; Exp : Node_Id) is
begin
+ -- Special processing for limited types
+
if Is_Limited_Type (T)
and then not In_Instance
and then not In_Inlined_Body
end if;
end if;
end if;
+
+ -- In gnatc or gnatprove mode, make sure set Do_Range_Check flag gets
+ -- set unless we can be sure that no range check is required.
+
+ if (not Expander_Active and not GNATprove_Mode)
+ and then Is_Scalar_Type (T)
+ and then not Is_In_Range (Exp, T, Assume_Valid => True)
+ then
+ Set_Do_Range_Check (Exp);
+ end if;
end Check_Initialization;
----------------------
if Present (Expression (Discr)) then
Preanalyze_Spec_Expression (Expression (Discr), Discr_Type);
+ -- Legaity checks
+
if Nkind (N) = N_Formal_Type_Declaration then
Error_Msg_N
("discriminant defaults not allowed for formal type",
(Defining_Identifier (Discr), Expression (Discr));
end if;
+ -- In gnatc or gnatprove mode, make sure set Do_Range_Check flag
+ -- gets set unless we can be sure that no range check is required.
+
+ if (not Expander_Active and not GNATprove_Mode)
+ and then not
+ Is_In_Range
+ (Expression (Discr), Discr_Type, Assume_Valid => True)
+ then
+ Set_Do_Range_Check (Expression (Discr));
+ end if;
+
+ -- No default discriminant value given
+
else
Default_Not_Present := True;
end if;
-- to get the information in the variable case as well.
begin
+ -- Expression that raises constraint error is an odd case. We certainly
+ -- do not want to consider it to be in range. It might make sense to
+ -- consider it always out of range, but this causes incorrect error
+ -- messages about static expressions out of range. So we just return
+ -- Unknown, which is always safe.
+
+ if Raises_Constraint_Error (N) then
+ return Unknown;
+
-- Universal types have no range limits, so always in range
- if Typ = Universal_Integer or else Typ = Universal_Real then
+ elsif Typ = Universal_Integer or else Typ = Universal_Real then
return In_Range;
-- Never known if not scalar type. Don't know if this can actually
elsif Is_Generic_Type (Typ) then
return Unknown;
- -- Never known unless we have a compile time known value
+ -- Case of a known compile time value, where we can check if it is in
+ -- the bounds of the given type.
- elsif not Compile_Time_Known_Value (N) then
- return Unknown;
-
- -- General processing with a known compile time value
-
- else
+ elsif Compile_Time_Known_Value (N) then
declare
Lo : Node_Id;
Hi : Node_Id;
end if;
end if;
end;
+
+ -- Here for value not known at compile time. Case of expression subtype
+ -- is Typ or is a subtype of Typ, and we can assume expression is valid.
+ -- In this case we know it is in range without knowing its value.
+
+ elsif Assume_Valid
+ and then (Etype (N) = Typ or else Is_Subtype_Of (Etype (N), Typ))
+ then
+ return In_Range;
+
+ -- For all other cases, result is unknown
+
+ else
+ return Unknown;
end if;
end Test_In_Range;
-- Initialization expression for the initial value in an object
-- declaration. In this case the Do_Range_Check flag is set on
-- the initialization expression, and the check is against the
- -- range of the type of the object being declared.
+ -- range of the type of the object being declared. This includes the
+ -- cases of expressions providing default discriminant values, and
+ -- expressions used to initialize record components.
-- The expression of a type conversion. In this case the range check is
-- against the target type of the conversion. See also the use of
projects / gcc.git / commitdiff