Skip to content

R
riscv-gcc-1
Commit 7b536495 by Arnaud Charlet
Options

[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
parent 41d8ee1d
Showing with 2661 additions and 965 deletions
gcc/ada/ChangeLog
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
......
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) ();
......
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;
......
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
......
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
......
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;
----------------------
......
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
......
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
......
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;
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.
......
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;
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.
......
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;
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
......
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;
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.
......
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;
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.
......
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;
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
......
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;
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.
......
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;
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
......
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;
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.
......
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;
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
......
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;
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.
......
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;
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.
......
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;
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
......
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;
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.
......
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;
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
......
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;
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.
......
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;
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
......
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;
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.
......
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;
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
......
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;
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.
......
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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment