diff options
| author | Arnaud Charlet <charlet@gcc.gnu.org> | 2014-08-01 16:11:18 +0200 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2014-08-01 16:11:18 +0200 |
| commit | 7b53649518674605dd757f4089c8a522e4272273 (patch) | |
| tree | fdb5a56e6066a99a0a05b387130465d401aa5e1c | |
| parent | 41d8ee1d52ca454571226a1083fcd66b169c5cda (diff) | |
| download | gcc-7b53649518674605dd757f4089c8a522e4272273.zip gcc-7b53649518674605dd757f4089c8a522e4272273.tar.gz gcc-7b53649518674605dd757f4089c8a522e4272273.tar.bz2 | |
[multiple changes]
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.
From-SVN: r213471
126 files changed, 7146 insertions, 2572 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9b58a08..dba624f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,75 @@ +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 diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index f7ca0d8..8a18418 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -1310,7 +1310,7 @@ win32_filetime (HANDLE h) /* As above but starting from a FILETIME. */ static void -f2t (const FILETIME *ft, time_t *t) +f2t (const FILETIME *ft, __time64_t *t) { union { @@ -1319,7 +1319,7 @@ f2t (const FILETIME *ft, time_t *t) } 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 @@ -1332,7 +1332,7 @@ __gnat_file_time_name_attr (char* name, struct file_attributes* attr) #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); @@ -1748,7 +1748,7 @@ __gnat_check_OWNER_ACL (TCHAR *wname, BOOL fAccessGranted = FALSE; HANDLE hToken = NULL; DWORD nLength = 0; - SECURITY_DESCRIPTOR* pSD = NULL; + PSECURITY_DESCRIPTOR pSD = NULL; GetFileSecurity (wname, OWNER_SECURITY_INFORMATION | @@ -1808,7 +1808,7 @@ __gnat_check_OWNER_ACL (TCHAR *wname, static void __gnat_set_OWNER_ACL (TCHAR *wname, - DWORD AccessMode, + ACCESS_MODE AccessMode, DWORD AccessPermissions) { PACL pOldDACL = NULL; @@ -2022,7 +2022,7 @@ __gnat_set_writable (char *name) #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]; @@ -2177,7 +2177,7 @@ __gnat_portable_spawn (char *args[] ATTRIBUTE_UNUSED) 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]); @@ -2325,7 +2325,7 @@ add_handle (HANDLE h, int pid) { 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); } @@ -2445,7 +2445,6 @@ win32_wait (int *status) HANDLE *hl; HANDLE h; DWORD res; - int k; int hl_len; if (plist_length == 0) @@ -2454,8 +2453,6 @@ win32_wait (int *status) return -1; } - k = 0; - /* -------------------- critical section -------------------- */ (*Lock_Task) (); diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 033ad01..0214a6b 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -2114,17 +2114,18 @@ package body Exp_Aggr is 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; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index f90c60d..e21e9e4 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -5068,6 +5068,16 @@ package body Exp_Ch3 is -- 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 diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 11833e5..3f82220 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -10835,60 +10835,78 @@ package body Exp_Ch4 is -- 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 diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index be5f7f2..6ff7527 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -1727,6 +1727,7 @@ package body Exp_Pakd is Set_nn : Entity_Id; Subscr : Node_Id; Atyp : Entity_Id; + Rev_SSO : Node_Id; begin if No (Bits_nn) then @@ -1752,6 +1753,12 @@ package body Exp_Pakd is 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 @@ -1767,8 +1774,8 @@ package body Exp_Pakd is 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; @@ -2127,8 +2134,11 @@ package body Exp_Pakd is -- 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 @@ -2158,12 +2168,12 @@ package body Exp_Pakd is 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; ---------------------- diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 8963ad0..fb4241a 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -3701,8 +3701,7 @@ package body Freeze is -- 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 diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 2ed7755..e074b08 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -1243,6 +1243,19 @@ begin 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; @@ -1295,12 +1308,9 @@ begin 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 diff --git a/gcc/ada/s-pack03.adb b/gcc/ada/s-pack03.adb index 3d88c8e..b081dc2 100644 --- a/gcc/ada/s-pack03.adb +++ b/gcc/ada/s-pack03.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_03 is 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; diff --git a/gcc/ada/s-pack03.ads b/gcc/ada/s-pack03.ads index d8f35c7..265246c 100644 --- a/gcc/ada/s-pack03.ads +++ b/gcc/ada/s-pack03.ads @@ -39,11 +39,21 @@ package System.Pack_03 is 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. diff --git a/gcc/ada/s-pack05.adb b/gcc/ada/s-pack05.adb index 42af6b1..645c3a7 100644 --- a/gcc/ada/s-pack05.adb +++ b/gcc/ada/s-pack05.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_05 is 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; diff --git a/gcc/ada/s-pack05.ads b/gcc/ada/s-pack05.ads index 761ae4f..567bdc7 100644 --- a/gcc/ada/s-pack05.ads +++ b/gcc/ada/s-pack05.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_05 is 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. diff --git a/gcc/ada/s-pack06.adb b/gcc/ada/s-pack06.adb index a8cf24e..e467af0 100644 --- a/gcc/ada/s-pack06.adb +++ b/gcc/ada/s-pack06.adb @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_06 is 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. @@ -81,83 +86,165 @@ package body System.Pack_06 is 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; diff --git a/gcc/ada/s-pack06.ads b/gcc/ada/s-pack06.ads index 8d907c1..9db4734 100644 --- a/gcc/ada/s-pack06.ads +++ b/gcc/ada/s-pack06.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_06 is 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 diff --git a/gcc/ada/s-pack07.adb b/gcc/ada/s-pack07.adb index 0dc35e7..45ba8bd 100644 --- a/gcc/ada/s-pack07.adb +++ b/gcc/ada/s-pack07.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_07 is 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; diff --git a/gcc/ada/s-pack07.ads b/gcc/ada/s-pack07.ads index b1b125a..a0fa35d 100644 --- a/gcc/ada/s-pack07.ads +++ b/gcc/ada/s-pack07.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_07 is 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. diff --git a/gcc/ada/s-pack09.adb b/gcc/ada/s-pack09.adb index 26ac890..e0360bb 100644 --- a/gcc/ada/s-pack09.adb +++ b/gcc/ada/s-pack09.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_09 is 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; diff --git a/gcc/ada/s-pack09.ads b/gcc/ada/s-pack09.ads index be99821..78defe0 100644 --- a/gcc/ada/s-pack09.ads +++ b/gcc/ada/s-pack09.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_09 is 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. diff --git a/gcc/ada/s-pack10.adb b/gcc/ada/s-pack10.adb index 0fbd13e..402c9fa 100644 --- a/gcc/ada/s-pack10.adb +++ b/gcc/ada/s-pack10.adb @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_10 is 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. @@ -81,83 +86,165 @@ package body System.Pack_10 is 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; diff --git a/gcc/ada/s-pack10.ads b/gcc/ada/s-pack10.ads index fcd1d12..dc4113e 100644 --- a/gcc/ada/s-pack10.ads +++ b/gcc/ada/s-pack10.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_10 is 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 diff --git a/gcc/ada/s-pack11.adb b/gcc/ada/s-pack11.adb index 62737fb..23edceb 100644 --- a/gcc/ada/s-pack11.adb +++ b/gcc/ada/s-pack11.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_11 is 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; diff --git a/gcc/ada/s-pack11.ads b/gcc/ada/s-pack11.ads index 9c880d2..e812a00 100644 --- a/gcc/ada/s-pack11.ads +++ b/gcc/ada/s-pack11.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_11 is 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. diff --git a/gcc/ada/s-pack12.adb b/gcc/ada/s-pack12.adb index d43cca1..69b090d 100644 --- a/gcc/ada/s-pack12.adb +++ b/gcc/ada/s-pack12.adb @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_12 is 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. @@ -81,83 +86,165 @@ package body System.Pack_12 is 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; diff --git a/gcc/ada/s-pack12.ads b/gcc/ada/s-pack12.ads index ec8b073..ae0af7e 100644 --- a/gcc/ada/s-pack12.ads +++ b/gcc/ada/s-pack12.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_12 is 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 diff --git a/gcc/ada/s-pack13.adb b/gcc/ada/s-pack13.adb index d08b5a1..0970d69 100644 --- a/gcc/ada/s-pack13.adb +++ b/gcc/ada/s-pack13.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_13 is 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; diff --git a/gcc/ada/s-pack13.ads b/gcc/ada/s-pack13.ads index a5b6258..f58fbf7 100644 --- a/gcc/ada/s-pack13.ads +++ b/gcc/ada/s-pack13.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_13 is 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. diff --git a/gcc/ada/s-pack14.adb b/gcc/ada/s-pack14.adb index 0ef322d..8cae0d7 100644 --- a/gcc/ada/s-pack14.adb +++ b/gcc/ada/s-pack14.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_14 is 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. @@ -81,83 +86,165 @@ package body System.Pack_14 is 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; diff --git a/gcc/ada/s-pack14.ads b/gcc/ada/s-pack14.ads index aecd6f0..72cd783 100644 --- a/gcc/ada/s-pack14.ads +++ b/gcc/ada/s-pack14.ads @@ -39,20 +39,37 @@ package System.Pack_14 is 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 diff --git a/gcc/ada/s-pack15.adb b/gcc/ada/s-pack15.adb index 7e9c65f..4df1841 100644 --- a/gcc/ada/s-pack15.adb +++ b/gcc/ada/s-pack15.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_15 is 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; diff --git a/gcc/ada/s-pack15.ads b/gcc/ada/s-pack15.ads index 62dc598..787ca7e 100644 --- a/gcc/ada/s-pack15.ads +++ b/gcc/ada/s-pack15.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_15 is 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. diff --git a/gcc/ada/s-pack17.adb b/gcc/ada/s-pack17.adb index 755dd6b..0fc4938 100644 --- a/gcc/ada/s-pack17.adb +++ b/gcc/ada/s-pack17.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_17 is 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; diff --git a/gcc/ada/s-pack17.ads b/gcc/ada/s-pack17.ads index a81a696..9234b1e 100644 --- a/gcc/ada/s-pack17.ads +++ b/gcc/ada/s-pack17.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_17 is 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. diff --git a/gcc/ada/s-pack18.adb b/gcc/ada/s-pack18.adb index feba763..5e2e33f 100644 --- a/gcc/ada/s-pack18.adb +++ b/gcc/ada/s-pack18.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_18 is 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. @@ -81,83 +86,165 @@ package body System.Pack_18 is 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; diff --git a/gcc/ada/s-pack18.ads b/gcc/ada/s-pack18.ads index 31d6c0b..051d992 100644 --- a/gcc/ada/s-pack18.ads +++ b/gcc/ada/s-pack18.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_18 is 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 diff --git a/gcc/ada/s-pack19.adb b/gcc/ada/s-pack19.adb index 65d3540..3a9c2e7 100644 --- a/gcc/ada/s-pack19.adb +++ b/gcc/ada/s-pack19.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_19 is 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; diff --git a/gcc/ada/s-pack19.ads b/gcc/ada/s-pack19.ads index 052c216..03dedb4 100644 --- a/gcc/ada/s-pack19.ads +++ b/gcc/ada/s-pack19.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_19 is 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. diff --git a/gcc/ada/s-pack20.adb b/gcc/ada/s-pack20.adb index 6061588..b0b9b4b 100644 --- a/gcc/ada/s-pack20.adb +++ b/gcc/ada/s-pack20.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_20 is 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. @@ -81,83 +86,165 @@ package body System.Pack_20 is 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; diff --git a/gcc/ada/s-pack20.ads b/gcc/ada/s-pack20.ads index 800d677..e75f828 100644 --- a/gcc/ada/s-pack20.ads +++ b/gcc/ada/s-pack20.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_20 is 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 diff --git a/gcc/ada/s-pack21.adb b/gcc/ada/s-pack21.adb index 6b78650..8357a69 100644 --- a/gcc/ada/s-pack21.adb +++ b/gcc/ada/s-pack21.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_21 is 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; diff --git a/gcc/ada/s-pack21.ads b/gcc/ada/s-pack21.ads index a0d5939..0454df0 100644 --- a/gcc/ada/s-pack21.ads +++ b/gcc/ada/s-pack21.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_21 is 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. diff --git a/gcc/ada/s-pack22.adb b/gcc/ada/s-pack22.adb index d0e3cdf..ae27d67 100644 --- a/gcc/ada/s-pack22.adb +++ b/gcc/ada/s-pack22.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_22 is 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. @@ -81,83 +86,165 @@ package body System.Pack_22 is 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; diff --git a/gcc/ada/s-pack22.ads b/gcc/ada/s-pack22.ads index d4f1de7..7504ba8 100644 --- a/gcc/ada/s-pack22.ads +++ b/gcc/ada/s-pack22.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_22 is 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 diff --git a/gcc/ada/s-pack23.adb b/gcc/ada/s-pack23.adb index ba14b3b..85f4af9 100644 --- a/gcc/ada/s-pack23.adb +++ b/gcc/ada/s-pack23.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_23 is 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; diff --git a/gcc/ada/s-pack23.ads b/gcc/ada/s-pack23.ads index eaa968e..9057453 100644 --- a/gcc/ada/s-pack23.ads +++ b/gcc/ada/s-pack23.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_23 is 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. diff --git a/gcc/ada/s-pack24.adb b/gcc/ada/s-pack24.adb index 49695e6..96cbabf 100644 --- a/gcc/ada/s-pack24.adb +++ b/gcc/ada/s-pack24.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_24 is 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. @@ -81,83 +86,165 @@ package body System.Pack_24 is 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; diff --git a/gcc/ada/s-pack24.ads b/gcc/ada/s-pack24.ads index 440dc48..fde2fa3 100644 --- a/gcc/ada/s-pack24.ads +++ b/gcc/ada/s-pack24.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_24 is 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 diff --git a/gcc/ada/s-pack25.adb b/gcc/ada/s-pack25.adb index 3d927c2..e3df996c 100644 --- a/gcc/ada/s-pack25.adb +++ b/gcc/ada/s-pack25.adb @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_25 is 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; diff --git a/gcc/ada/s-pack25.ads b/gcc/ada/s-pack25.ads index b7f3ebb..d59beeb 100644 --- a/gcc/ada/s-pack25.ads +++ b/gcc/ada/s-pack25.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_25 is 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. diff --git a/gcc/ada/s-pack26.adb b/gcc/ada/s-pack26.adb index 613558f..d7edc14 100644 --- a/gcc/ada/s-pack26.adb +++ b/gcc/ada/s-pack26.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_26 is 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. @@ -81,83 +86,165 @@ package body System.Pack_26 is 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; diff --git a/gcc/ada/s-pack26.ads b/gcc/ada/s-pack26.ads index d0d56ac..979e892 100644 --- a/gcc/ada/s-pack26.ads +++ b/gcc/ada/s-pack26.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_26 is 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 diff --git a/gcc/ada/s-pack27.adb b/gcc/ada/s-pack27.adb index 7497c09..0a15d87 100644 --- a/gcc/ada/s-pack27.adb +++ b/gcc/ada/s-pack27.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_27 is 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; diff --git a/gcc/ada/s-pack27.ads b/gcc/ada/s-pack27.ads index bfb287e..da77d57 100644 --- a/gcc/ada/s-pack27.ads +++ b/gcc/ada/s-pack27.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_27 is 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. diff --git a/gcc/ada/s-pack28.adb b/gcc/ada/s-pack28.adb index 1342885..35daf6d 100644 --- a/gcc/ada/s-pack28.adb +++ b/gcc/ada/s-pack28.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_28 is 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. @@ -81,83 +86,165 @@ package body System.Pack_28 is 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; diff --git a/gcc/ada/s-pack28.ads b/gcc/ada/s-pack28.ads index 79c1751..996ff25 100644 --- a/gcc/ada/s-pack28.ads +++ b/gcc/ada/s-pack28.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_28 is 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 diff --git a/gcc/ada/s-pack29.adb b/gcc/ada/s-pack29.adb index f0a54c1..73bc62f 100644 --- a/gcc/ada/s-pack29.adb +++ b/gcc/ada/s-pack29.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_29 is 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; diff --git a/gcc/ada/s-pack29.ads b/gcc/ada/s-pack29.ads index ea47957..47bcb23 100644 --- a/gcc/ada/s-pack29.ads +++ b/gcc/ada/s-pack29.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_29 is 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. diff --git a/gcc/ada/s-pack30.adb b/gcc/ada/s-pack30.adb index 04eb5b3..ceab502 100644 --- a/gcc/ada/s-pack30.adb +++ b/gcc/ada/s-pack30.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_30 is 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. @@ -81,83 +86,165 @@ package body System.Pack_30 is 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; diff --git a/gcc/ada/s-pack30.ads b/gcc/ada/s-pack30.ads index b09addf..aa85850 100644 --- a/gcc/ada/s-pack30.ads +++ b/gcc/ada/s-pack30.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_30 is 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 diff --git a/gcc/ada/s-pack31.adb b/gcc/ada/s-pack31.adb index d723601..d0eada3 100644 --- a/gcc/ada/s-pack31.adb +++ b/gcc/ada/s-pack31.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_31 is 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; diff --git a/gcc/ada/s-pack31.ads b/gcc/ada/s-pack31.ads index 4cd0daf..5667e6f 100644 --- a/gcc/ada/s-pack31.ads +++ b/gcc/ada/s-pack31.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_31 is 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. diff --git a/gcc/ada/s-pack33.adb b/gcc/ada/s-pack33.adb index 745d8de..0cbbf65 100644 --- a/gcc/ada/s-pack33.adb +++ b/gcc/ada/s-pack33.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_33 is 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; diff --git a/gcc/ada/s-pack33.ads b/gcc/ada/s-pack33.ads index a0dc085..085298b 100644 --- a/gcc/ada/s-pack33.ads +++ b/gcc/ada/s-pack33.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_33 is 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. diff --git a/gcc/ada/s-pack34.adb b/gcc/ada/s-pack34.adb index 8beafa9..b97c63d 100644 --- a/gcc/ada/s-pack34.adb +++ b/gcc/ada/s-pack34.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_34 is 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. @@ -81,83 +86,165 @@ package body System.Pack_34 is 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; diff --git a/gcc/ada/s-pack34.ads b/gcc/ada/s-pack34.ads index 26dbc98..668f806 100644 --- a/gcc/ada/s-pack34.ads +++ b/gcc/ada/s-pack34.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_34 is 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 diff --git a/gcc/ada/s-pack35.adb b/gcc/ada/s-pack35.adb index 009e667..98bbd85 100644 --- a/gcc/ada/s-pack35.adb +++ b/gcc/ada/s-pack35.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_35 is 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; diff --git a/gcc/ada/s-pack35.ads b/gcc/ada/s-pack35.ads index 17283a9..a1e8e0c 100644 --- a/gcc/ada/s-pack35.ads +++ b/gcc/ada/s-pack35.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_35 is 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. diff --git a/gcc/ada/s-pack36.adb b/gcc/ada/s-pack36.adb index bfd3e55..9303a50 100644 --- a/gcc/ada/s-pack36.adb +++ b/gcc/ada/s-pack36.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_36 is 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. @@ -81,83 +86,165 @@ package body System.Pack_36 is 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; diff --git a/gcc/ada/s-pack36.ads b/gcc/ada/s-pack36.ads index 17633fa..456c7fa 100644 --- a/gcc/ada/s-pack36.ads +++ b/gcc/ada/s-pack36.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_36 is 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 diff --git a/gcc/ada/s-pack37.adb b/gcc/ada/s-pack37.adb index 374ecde..ec4a21a 100644 --- a/gcc/ada/s-pack37.adb +++ b/gcc/ada/s-pack37.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_37 is 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; diff --git a/gcc/ada/s-pack37.ads b/gcc/ada/s-pack37.ads index baa44c6..8b80843 100644 --- a/gcc/ada/s-pack37.ads +++ b/gcc/ada/s-pack37.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_37 is 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. diff --git a/gcc/ada/s-pack38.adb b/gcc/ada/s-pack38.adb index 90cf4c4..b12166e 100644 --- a/gcc/ada/s-pack38.adb +++ b/gcc/ada/s-pack38.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_38 is 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. @@ -81,83 +86,165 @@ package body System.Pack_38 is 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; diff --git a/gcc/ada/s-pack38.ads b/gcc/ada/s-pack38.ads index b246eec..f2a9889 100644 --- a/gcc/ada/s-pack38.ads +++ b/gcc/ada/s-pack38.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_38 is 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 diff --git a/gcc/ada/s-pack39.adb b/gcc/ada/s-pack39.adb index 2583191..85c942a 100644 --- a/gcc/ada/s-pack39.adb +++ b/gcc/ada/s-pack39.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_39 is 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; diff --git a/gcc/ada/s-pack39.ads b/gcc/ada/s-pack39.ads index 90c4eaa..8ba083d 100644 --- a/gcc/ada/s-pack39.ads +++ b/gcc/ada/s-pack39.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_39 is 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. diff --git a/gcc/ada/s-pack40.adb b/gcc/ada/s-pack40.adb index 7267631..993fc95 100644 --- a/gcc/ada/s-pack40.adb +++ b/gcc/ada/s-pack40.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_40 is 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. @@ -81,83 +86,165 @@ package body System.Pack_40 is 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; diff --git a/gcc/ada/s-pack40.ads b/gcc/ada/s-pack40.ads index 9fd948e..1f30ee3 100644 --- a/gcc/ada/s-pack40.ads +++ b/gcc/ada/s-pack40.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_40 is 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 diff --git a/gcc/ada/s-pack41.adb b/gcc/ada/s-pack41.adb index 7ace358..dd580c0 100644 --- a/gcc/ada/s-pack41.adb +++ b/gcc/ada/s-pack41.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_41 is 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; diff --git a/gcc/ada/s-pack41.ads b/gcc/ada/s-pack41.ads index 2ff9f51..8dcae70 100644 --- a/gcc/ada/s-pack41.ads +++ b/gcc/ada/s-pack41.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_41 is 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. diff --git a/gcc/ada/s-pack42.adb b/gcc/ada/s-pack42.adb index 6ba6567..bc8285a 100644 --- a/gcc/ada/s-pack42.adb +++ b/gcc/ada/s-pack42.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_42 is 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. @@ -81,83 +86,165 @@ package body System.Pack_42 is 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; diff --git a/gcc/ada/s-pack42.ads b/gcc/ada/s-pack42.ads index a0740b2..73872fd 100644 --- a/gcc/ada/s-pack42.ads +++ b/gcc/ada/s-pack42.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_42 is 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 diff --git a/gcc/ada/s-pack43.adb b/gcc/ada/s-pack43.adb index 7979fb1..509cb00 100644 --- a/gcc/ada/s-pack43.adb +++ b/gcc/ada/s-pack43.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_43 is 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; diff --git a/gcc/ada/s-pack43.ads b/gcc/ada/s-pack43.ads index 99202f2..f82678f 100644 --- a/gcc/ada/s-pack43.ads +++ b/gcc/ada/s-pack43.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_43 is 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. diff --git a/gcc/ada/s-pack44.adb b/gcc/ada/s-pack44.adb index a3f7f00..f7fe185 100644 --- a/gcc/ada/s-pack44.adb +++ b/gcc/ada/s-pack44.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_44 is 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. @@ -81,83 +86,165 @@ package body System.Pack_44 is 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; diff --git a/gcc/ada/s-pack44.ads b/gcc/ada/s-pack44.ads index d083bf2..89b3f3e 100644 --- a/gcc/ada/s-pack44.ads +++ b/gcc/ada/s-pack44.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_44 is 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 diff --git a/gcc/ada/s-pack45.adb b/gcc/ada/s-pack45.adb index 4a2ce84..2247312 100644 --- a/gcc/ada/s-pack45.adb +++ b/gcc/ada/s-pack45.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_45 is 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; diff --git a/gcc/ada/s-pack45.ads b/gcc/ada/s-pack45.ads index 2c9b60b..2340d48 100644 --- a/gcc/ada/s-pack45.ads +++ b/gcc/ada/s-pack45.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_45 is 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. diff --git a/gcc/ada/s-pack46.adb b/gcc/ada/s-pack46.adb index 7df5199..c2b45f0 100644 --- a/gcc/ada/s-pack46.adb +++ b/gcc/ada/s-pack46.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_46 is 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. @@ -81,83 +86,165 @@ package body System.Pack_46 is 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; diff --git a/gcc/ada/s-pack46.ads b/gcc/ada/s-pack46.ads index 5cdc6a2..6ab8dfe 100644 --- a/gcc/ada/s-pack46.ads +++ b/gcc/ada/s-pack46.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_46 is 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 diff --git a/gcc/ada/s-pack47.adb b/gcc/ada/s-pack47.adb index 1cd3d7f..d63e35d 100644 --- a/gcc/ada/s-pack47.adb +++ b/gcc/ada/s-pack47.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_47 is 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; diff --git a/gcc/ada/s-pack47.ads b/gcc/ada/s-pack47.ads index c44a251..f924965 100644 --- a/gcc/ada/s-pack47.ads +++ b/gcc/ada/s-pack47.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_47 is 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. diff --git a/gcc/ada/s-pack48.adb b/gcc/ada/s-pack48.adb index 615c270..780a157 100644 --- a/gcc/ada/s-pack48.adb +++ b/gcc/ada/s-pack48.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_48 is 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. @@ -81,83 +86,165 @@ package body System.Pack_48 is 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; diff --git a/gcc/ada/s-pack48.ads b/gcc/ada/s-pack48.ads index f91b794..ba1008e 100644 --- a/gcc/ada/s-pack48.ads +++ b/gcc/ada/s-pack48.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_48 is 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 diff --git a/gcc/ada/s-pack49.adb b/gcc/ada/s-pack49.adb index 9e91203..a9cad23 100644 --- a/gcc/ada/s-pack49.adb +++ b/gcc/ada/s-pack49.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_49 is 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; diff --git a/gcc/ada/s-pack49.ads b/gcc/ada/s-pack49.ads index b0ba1f1..649e550 100644 --- a/gcc/ada/s-pack49.ads +++ b/gcc/ada/s-pack49.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_49 is 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. diff --git a/gcc/ada/s-pack50.adb b/gcc/ada/s-pack50.adb index fb2dc15..7cc04e6 100644 --- a/gcc/ada/s-pack50.adb +++ b/gcc/ada/s-pack50.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_50 is 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. @@ -81,83 +86,165 @@ package body System.Pack_50 is 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; diff --git a/gcc/ada/s-pack50.ads b/gcc/ada/s-pack50.ads index 1399b66..699165b 100644 --- a/gcc/ada/s-pack50.ads +++ b/gcc/ada/s-pack50.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_50 is 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 diff --git a/gcc/ada/s-pack51.adb b/gcc/ada/s-pack51.adb index f8e4d99..5617a98 100644 --- a/gcc/ada/s-pack51.adb +++ b/gcc/ada/s-pack51.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_51 is 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; diff --git a/gcc/ada/s-pack51.ads b/gcc/ada/s-pack51.ads index 8e4316c..99bdd51 100644 --- a/gcc/ada/s-pack51.ads +++ b/gcc/ada/s-pack51.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_51 is 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. diff --git a/gcc/ada/s-pack52.adb b/gcc/ada/s-pack52.adb index 6c4fd40..5adf132 100644 --- a/gcc/ada/s-pack52.adb +++ b/gcc/ada/s-pack52.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_52 is 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. @@ -81,83 +86,165 @@ package body System.Pack_52 is 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; diff --git a/gcc/ada/s-pack52.ads b/gcc/ada/s-pack52.ads index 1342a92..fab35ee 100644 --- a/gcc/ada/s-pack52.ads +++ b/gcc/ada/s-pack52.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_52 is 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 diff --git a/gcc/ada/s-pack53.adb b/gcc/ada/s-pack53.adb index c19512b..471d1fc 100644 --- a/gcc/ada/s-pack53.adb +++ b/gcc/ada/s-pack53.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_53 is 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; diff --git a/gcc/ada/s-pack53.ads b/gcc/ada/s-pack53.ads index e0e5683..380278c 100644 --- a/gcc/ada/s-pack53.ads +++ b/gcc/ada/s-pack53.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_53 is 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. diff --git a/gcc/ada/s-pack54.adb b/gcc/ada/s-pack54.adb index d21dbc0..5d02941 100644 --- a/gcc/ada/s-pack54.adb +++ b/gcc/ada/s-pack54.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_54 is 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. @@ -81,83 +86,165 @@ package body System.Pack_54 is 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; diff --git a/gcc/ada/s-pack54.ads b/gcc/ada/s-pack54.ads index 448f6db..5ee9a88 100644 --- a/gcc/ada/s-pack54.ads +++ b/gcc/ada/s-pack54.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_54 is 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 diff --git a/gcc/ada/s-pack55.adb b/gcc/ada/s-pack55.adb index 378d6f2..be264e1 100644 --- a/gcc/ada/s-pack55.adb +++ b/gcc/ada/s-pack55.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_55 is 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; diff --git a/gcc/ada/s-pack55.ads b/gcc/ada/s-pack55.ads index 00d4d93..8dce9fa 100644 --- a/gcc/ada/s-pack55.ads +++ b/gcc/ada/s-pack55.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_55 is 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. diff --git a/gcc/ada/s-pack56.adb b/gcc/ada/s-pack56.adb index b27c408..fd34211 100644 --- a/gcc/ada/s-pack56.adb +++ b/gcc/ada/s-pack56.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_56 is 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. @@ -81,83 +86,165 @@ package body System.Pack_56 is 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; diff --git a/gcc/ada/s-pack56.ads b/gcc/ada/s-pack56.ads index 27c593c..5e6578b 100644 --- a/gcc/ada/s-pack56.ads +++ b/gcc/ada/s-pack56.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_56 is 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 diff --git a/gcc/ada/s-pack57.adb b/gcc/ada/s-pack57.adb index c510baf..b477b2e 100644 --- a/gcc/ada/s-pack57.adb +++ b/gcc/ada/s-pack57.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_57 is 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; diff --git a/gcc/ada/s-pack57.ads b/gcc/ada/s-pack57.ads index 5203deaa..aff3c50 100644 --- a/gcc/ada/s-pack57.ads +++ b/gcc/ada/s-pack57.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_57 is 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. diff --git a/gcc/ada/s-pack58.adb b/gcc/ada/s-pack58.adb index 067928c..1aeb450 100644 --- a/gcc/ada/s-pack58.adb +++ b/gcc/ada/s-pack58.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_58 is 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. @@ -81,83 +86,165 @@ package body System.Pack_58 is 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; diff --git a/gcc/ada/s-pack58.ads b/gcc/ada/s-pack58.ads index a7e31c7..503d990 100644 --- a/gcc/ada/s-pack58.ads +++ b/gcc/ada/s-pack58.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_58 is 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 diff --git a/gcc/ada/s-pack59.adb b/gcc/ada/s-pack59.adb index ea93ebf..35199ce 100644 --- a/gcc/ada/s-pack59.adb +++ b/gcc/ada/s-pack59.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_59 is 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; diff --git a/gcc/ada/s-pack59.ads b/gcc/ada/s-pack59.ads index 585ecd9..2abbbf2 100644 --- a/gcc/ada/s-pack59.ads +++ b/gcc/ada/s-pack59.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_59 is 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. diff --git a/gcc/ada/s-pack60.adb b/gcc/ada/s-pack60.adb index 5ade775..e909f71 100644 --- a/gcc/ada/s-pack60.adb +++ b/gcc/ada/s-pack60.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_60 is 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. @@ -81,83 +86,165 @@ package body System.Pack_60 is 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; diff --git a/gcc/ada/s-pack60.ads b/gcc/ada/s-pack60.ads index cee776b..bc48868 100644 --- a/gcc/ada/s-pack60.ads +++ b/gcc/ada/s-pack60.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_60 is 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 diff --git a/gcc/ada/s-pack61.adb b/gcc/ada/s-pack61.adb index 27f72e4..cd29c81 100644 --- a/gcc/ada/s-pack61.adb +++ b/gcc/ada/s-pack61.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_61 is 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; diff --git a/gcc/ada/s-pack61.ads b/gcc/ada/s-pack61.ads index 0d63bae..ac309a2 100644 --- a/gcc/ada/s-pack61.ads +++ b/gcc/ada/s-pack61.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_61 is 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. diff --git a/gcc/ada/s-pack62.adb b/gcc/ada/s-pack62.adb index faac211..b13754d 100644 --- a/gcc/ada/s-pack62.adb +++ b/gcc/ada/s-pack62.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,8 +71,10 @@ package body System.Pack_62 is 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. @@ -81,83 +86,165 @@ package body System.Pack_62 is 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; diff --git a/gcc/ada/s-pack62.ads b/gcc/ada/s-pack62.ads index 89ad446..b8b19f4 100644 --- a/gcc/ada/s-pack62.ads +++ b/gcc/ada/s-pack62.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,20 +39,37 @@ package System.Pack_62 is 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 diff --git a/gcc/ada/s-pack63.adb b/gcc/ada/s-pack63.adb index c6faee6..109f914 100644 --- a/gcc/ada/s-pack63.adb +++ b/gcc/ada/s-pack63.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -31,10 +31,13 @@ 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; @@ -68,45 +71,87 @@ package body System.Pack_63 is 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; diff --git a/gcc/ada/s-pack63.ads b/gcc/ada/s-pack63.ads index b76eed0..c59678b 100644 --- a/gcc/ada/s-pack63.ads +++ b/gcc/ada/s-pack63.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,11 +39,21 @@ package System.Pack_63 is 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. diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index f454a1e..85b119b 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -3521,7 +3521,7 @@ package body Sem_Ch13 is ------------------------------ 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 diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index a713057..16dc534 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -10323,6 +10323,8 @@ package body Sem_Ch3 is 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 @@ -10376,6 +10378,16 @@ package body Sem_Ch3 is 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; ---------------------- @@ -18034,6 +18046,8 @@ package body Sem_Ch3 is 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", @@ -18078,6 +18092,19 @@ package body Sem_Ch3 is (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; diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 3e5458f..30bad6d 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -6079,9 +6079,18 @@ package body Sem_Eval is -- 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 @@ -6099,14 +6108,10 @@ package body Sem_Eval is 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; @@ -6172,6 +6177,20 @@ package body Sem_Eval is 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; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 9f20397..8921d65 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1061,7 +1061,9 @@ package Sinfo is -- 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 |