s-aoinar$(objext) \
s-aomoar$(objext) \
s-aotase$(objext) \
+ s-aridou$(objext) \
s-arit64$(objext) \
s-assert$(objext) \
s-atacco$(objext) \
s-explli$(objext) \
s-expllu$(objext) \
s-expmod$(objext) \
+ s-exponn$(objext) \
+ s-expont$(objext) \
+ s-exponu$(objext) \
s-expuns$(objext) \
s-fatflt$(objext) \
s-fatgen$(objext) \
TRASYM_DWARF_MINGW_OBJS = $(TRASYM_DWARF_COMMON_OBJS)
+GNATRTL_128BIT_PAIRS = \
+ s-scaval.ads<libgnat/s-scaval__128.ads \
+ s-scaval.adb<libgnat/s-scaval__128.adb
+
+# Objects needed for 128-bit types
+GNATRTL_128BIT_OBJS = \
+ s-arit128$(objext) \
+ s-casi128$(objext) \
+ s-caun128$(objext) \
+ s-exnllli$(objext) \
+ s-expllli$(objext) \
+ s-explllu$(objext) \
+ s-pack65$(objext) \
+ s-pack66$(objext) \
+ s-pack67$(objext) \
+ s-pack68$(objext) \
+ s-pack69$(objext) \
+ s-pack70$(objext) \
+ s-pack71$(objext) \
+ s-pack72$(objext) \
+ s-pack73$(objext) \
+ s-pack74$(objext) \
+ s-pack75$(objext) \
+ s-pack76$(objext) \
+ s-pack77$(objext) \
+ s-pack78$(objext) \
+ s-pack79$(objext) \
+ s-pack80$(objext) \
+ s-pack81$(objext) \
+ s-pack82$(objext) \
+ s-pack83$(objext) \
+ s-pack84$(objext) \
+ s-pack85$(objext) \
+ s-pack86$(objext) \
+ s-pack87$(objext) \
+ s-pack88$(objext) \
+ s-pack89$(objext) \
+ s-pack90$(objext) \
+ s-pack91$(objext) \
+ s-pack92$(objext) \
+ s-pack93$(objext) \
+ s-pack94$(objext) \
+ s-pack95$(objext) \
+ s-pack96$(objext) \
+ s-pack97$(objext) \
+ s-pack98$(objext) \
+ s-pack99$(objext) \
+ s-pack100$(objext) \
+ s-pack101$(objext) \
+ s-pack102$(objext) \
+ s-pack103$(objext) \
+ s-pack104$(objext) \
+ s-pack105$(objext) \
+ s-pack106$(objext) \
+ s-pack107$(objext) \
+ s-pack108$(objext) \
+ s-pack109$(objext) \
+ s-pack110$(objext) \
+ s-pack111$(objext) \
+ s-pack112$(objext) \
+ s-pack113$(objext) \
+ s-pack114$(objext) \
+ s-pack115$(objext) \
+ s-pack116$(objext) \
+ s-pack117$(objext) \
+ s-pack118$(objext) \
+ s-pack119$(objext) \
+ s-pack120$(objext) \
+ s-pack121$(objext) \
+ s-pack122$(objext) \
+ s-pack123$(objext) \
+ s-pack124$(objext) \
+ s-pack125$(objext) \
+ s-pack126$(objext) \
+ s-pack127$(objext)
+
# Shared library version
LIB_VERSION = $(strip $(shell grep ' Library_Version :' $(GNAT_SRC)/gnatvsn.ads | sed -e 's/.*"\(.*\)".*/\1/'))
LIBGNAT_TARGET_PAIRS += $(X86_TARGET_PAIRS)
SO_OPTS= -m32 -Wl,-soname,
else
- LIBGNAT_TARGET_PAIRS += $(X86_64_TARGET_PAIRS)
+ LIBGNAT_TARGET_PAIRS += $(X86_64_TARGET_PAIRS) $(GNATRTL_128BIT_PAIRS)
+ EXTRA_GNATRTL_NONTASKING_OBJS += $(GNATRTL_128BIT_OBJS)
SO_OPTS = -m64 -Wl,-soname,
endif
else
ifeq ($(strip $(MULTISUBDIR)),/64)
- LIBGNAT_TARGET_PAIRS += $(X86_64_TARGET_PAIRS)
+ LIBGNAT_TARGET_PAIRS += $(X86_64_TARGET_PAIRS) $(GNATRTL_128BIT_PAIRS)
+ EXTRA_GNATRTL_NONTASKING_OBJS += $(GNATRTL_128BIT_OBJS)
SO_OPTS = -m64 -Wl,-soname,
else
LIBGNAT_TARGET_PAIRS += $(X86_TARGET_PAIRS)
s-tsmona.adb<libgnat/s-tsmona__linux.adb \
$(ATOMICS_TARGET_PAIRS) \
$(X86_64_TARGET_PAIRS) \
+ $(GNATRTL_128BIT_PAIRS) \
system.ads<libgnat/system-linux-x86.ads
TOOLS_TARGET_PAIRS = indepsw.adb<indepsw-gnu.adb
EXTRA_GNATRTL_NONTASKING_OBJS += g-sse.o g-ssvety.o
EXTRA_GNATRTL_NONTASKING_OBJS += $(TRASYM_DWARF_UNIX_OBJS)
+ EXTRA_GNATRTL_NONTASKING_OBJS += $(GNATRTL_128BIT_OBJS)
EXTRA_GNATRTL_TASKING_OBJS=s-linux.o a-exetim.o
EH_MECHANISM=-gcc
return 64;
end Get_Long_Long_Size;
+ -----------------------------
+ -- Get_Long_Long_Long_Size --
+ -----------------------------
+
+ function Get_Long_Long_Long_Size return Pos is
+ begin
+ return 64;
+ end Get_Long_Long_Long_Size;
+
----------------------
-- Get_Pointer_Size --
----------------------
-- Now see if an overflow check is required
declare
- Siz : constant Int := UI_To_Int (Esize (Rtyp));
- Dsiz : constant Int := Siz * 2;
+ Dsiz : constant Uint := 2 * Esize (Rtyp);
Opnod : Node_Id;
Ctyp : Entity_Id;
Opnd : Node_Id;
-- an integer type of sufficient length to hold the largest possible
-- result.
- -- If the size of check type exceeds the size of Long_Long_Integer,
+ -- If the size of the check type exceeds the maximum integer size,
-- we use a different approach, expanding to:
- -- typ (xxx_With_Ovflo_Check (Integer_64 (x), Integer (y)))
+ -- typ (xxx_With_Ovflo_Check (Integer_NN (x), Integer_NN (y)))
-- where xxx is Add, Multiply or Subtract as appropriate
-- Find check type if one exists
- if Dsiz <= Standard_Integer_Size then
- Ctyp := Standard_Integer;
-
- elsif Dsiz <= Standard_Long_Long_Integer_Size then
- Ctyp := Standard_Long_Long_Integer;
+ if Dsiz <= System_Max_Integer_Size then
+ Ctyp := Integer_Type_For (Dsiz, Uns => False);
-- No check type exists, use runtime call
else
+ if System_Max_Integer_Size = 64 then
+ Ctyp := RTE (RE_Integer_64);
+ else
+ Ctyp := RTE (RE_Integer_128);
+ end if;
+
if Nkind (N) = N_Op_Add then
- Cent := RE_Add_With_Ovflo_Check;
+ if System_Max_Integer_Size = 64 then
+ Cent := RE_Add_With_Ovflo_Check64;
+ else
+ Cent := RE_Add_With_Ovflo_Check128;
+ end if;
- elsif Nkind (N) = N_Op_Multiply then
- Cent := RE_Multiply_With_Ovflo_Check;
+ elsif Nkind (N) = N_Op_Subtract then
+ if System_Max_Integer_Size = 64 then
+ Cent := RE_Subtract_With_Ovflo_Check64;
+ else
+ Cent := RE_Subtract_With_Ovflo_Check128;
+ end if;
- else
- pragma Assert (Nkind (N) = N_Op_Subtract);
- Cent := RE_Subtract_With_Ovflo_Check;
+ else pragma Assert (Nkind (N) = N_Op_Multiply);
+ if System_Max_Integer_Size = 64 then
+ Cent := RE_Multiply_With_Ovflo_Check64;
+ else
+ Cent := RE_Multiply_With_Ovflo_Check128;
+ end if;
end if;
Rewrite (N,
Make_Function_Call (Loc,
Name => New_Occurrence_Of (RTE (Cent), Loc),
Parameter_Associations => New_List (
- OK_Convert_To (RTE (RE_Integer_64), Left_Opnd (N)),
- OK_Convert_To (RTE (RE_Integer_64), Right_Opnd (N))))));
+ OK_Convert_To (Ctyp, Left_Opnd (N)),
+ OK_Convert_To (Ctyp, Right_Opnd (N))))));
Analyze_And_Resolve (N, Typ);
return;
(Standard_Long_Long_Integer, Standard_Long_Long_Integer_Size);
Set_Is_Implementation_Defined (Standard_Long_Long_Integer);
+ Build_Signed_Integer_Type
+ (Standard_Long_Long_Long_Integer,
+ Standard_Long_Long_Long_Integer_Size);
+ Set_Is_Implementation_Defined (Standard_Long_Long_Long_Integer);
+
Create_Unconstrained_Base_Type
(Standard_Short_Short_Integer, E_Signed_Integer_Subtype);
Create_Unconstrained_Base_Type
(Standard_Long_Long_Integer, E_Signed_Integer_Subtype);
+ Create_Unconstrained_Base_Type
+ (Standard_Long_Long_Long_Integer, E_Signed_Integer_Subtype);
+
Create_Float_Types;
-- Create type definition node for type Character. Note that we do not
Set_Elem_Alignment (Any_Fixed);
Any_Integer := New_Standard_Entity ("an integer type");
- Set_Ekind (Any_Integer, E_Signed_Integer_Type);
- Set_Scope (Any_Integer, Standard_Standard);
- Set_Etype (Any_Integer, Standard_Long_Long_Integer);
- Init_Size (Any_Integer, Standard_Long_Long_Integer_Size);
- Set_Elem_Alignment (Any_Integer);
+ Set_Ekind (Any_Integer, E_Signed_Integer_Type);
+ Set_Scope (Any_Integer, Standard_Standard);
+ Set_Etype (Any_Integer, Standard_Long_Long_Long_Integer);
+ Init_Size (Any_Integer, Standard_Long_Long_Long_Integer_Size);
+ Set_Elem_Alignment (Any_Integer);
Set_Integer_Bounds
(Any_Integer,
Hb => Intval (High_Bound (Scalar_Range (Standard_Integer))));
Any_Modular := New_Standard_Entity ("a modular type");
- Set_Ekind (Any_Modular, E_Modular_Integer_Type);
- Set_Scope (Any_Modular, Standard_Standard);
- Set_Etype (Any_Modular, Standard_Long_Long_Integer);
- Init_Size (Any_Modular, Standard_Long_Long_Integer_Size);
- Set_Elem_Alignment (Any_Modular);
- Set_Is_Unsigned_Type (Any_Modular);
+ Set_Ekind (Any_Modular, E_Modular_Integer_Type);
+ Set_Scope (Any_Modular, Standard_Standard);
+ Set_Etype (Any_Modular, Standard_Long_Long_Long_Integer);
+ Init_Size (Any_Modular, Standard_Long_Long_Long_Integer_Size);
+ Set_Elem_Alignment (Any_Modular);
+ Set_Is_Unsigned_Type (Any_Modular);
Any_Numeric := New_Standard_Entity ("a numeric type");
- Set_Ekind (Any_Numeric, E_Signed_Integer_Type);
- Set_Scope (Any_Numeric, Standard_Standard);
- Set_Etype (Any_Numeric, Standard_Long_Long_Integer);
- Init_Size (Any_Numeric, Standard_Long_Long_Integer_Size);
- Set_Elem_Alignment (Any_Numeric);
+ Set_Ekind (Any_Numeric, E_Signed_Integer_Type);
+ Set_Scope (Any_Numeric, Standard_Standard);
+ Set_Etype (Any_Numeric, Standard_Long_Long_Long_Integer);
+ Init_Size (Any_Numeric, Standard_Long_Long_Long_Integer_Size);
+ Set_Elem_Alignment (Any_Numeric);
Any_Real := New_Standard_Entity ("a real type");
Set_Ekind (Any_Real, E_Floating_Point_Type);
Build_Unsigned_Integer_Type
(Standard_Long_Unsigned, Standard_Long_Integer_Size);
- Standard_Long_Long_Unsigned
- := New_Standard_Entity ("long_long_unsigned");
+ Standard_Long_Long_Unsigned :=
+ New_Standard_Entity ("long_long_unsigned");
Build_Unsigned_Integer_Type
(Standard_Long_Long_Unsigned, Standard_Long_Long_Integer_Size);
+ Standard_Long_Long_Long_Unsigned :=
+ New_Standard_Entity ("long_long_long_unsigned");
+ Build_Unsigned_Integer_Type
+ (Standard_Long_Long_Long_Unsigned,
+ Standard_Long_Long_Long_Integer_Size);
+
-- Standard_Unsigned_64 is not user visible, but is used internally. It
-- is an unsigned type mod 2**64 with 64 bits size.
-- Note: universal integer and universal real are constructed as fully
-- formed signed numeric types, with parameters corresponding to the
- -- longest runtime types (Long_Long_Integer and Long_Long_Float). This
- -- allows Gigi to properly process references to universal types that
- -- are not folded at compile time.
+ -- longest runtime types (Long_Long_Long_Integer and Long_Long_Float).
+ -- This allows Gigi to properly process references to universal types
+ -- that are not folded at compile time.
Universal_Integer := New_Standard_Entity ("universal_integer");
Decl := New_Node (N_Full_Type_Declaration, Stloc);
Set_Defining_Identifier (Decl, Universal_Integer);
Set_Scope (Universal_Integer, Standard_Standard);
Build_Signed_Integer_Type
- (Universal_Integer, Standard_Long_Long_Integer_Size);
+ (Universal_Integer, Standard_Long_Long_Long_Integer_Size);
Universal_Real := New_Standard_Entity ("universal_real");
Decl := New_Node (N_Full_Type_Declaration, Stloc);
P (";");
Write_Eol;
+ Write_Str (" type Long_Long_Long_Integer");
+ P_Int_Range (Standard_Long_Long_Long_Integer_Size);
+ Write_Str (" for Long_Long_Long_Integer'Size use ");
+ Write_Int (Standard_Long_Long_Long_Integer_Size);
+ P (";");
+ Write_Eol;
+
-- Floating point types
P_Float_Type (Standard_Short_Float);
-- b) The integer value is negative. In this case, we know that the
-- result is modulus + value, where the value might be as small as
-- -modulus. The trouble is what type do we use to do the subtract.
- -- No type will do, since modulus can be as big as 2**64, and no
+ -- No type will do, since modulus can be as big as 2**128, and no
-- integer type accommodates this value. Let's do bit of algebra
-- modulus + value
Scal_Typ := Name_Unsigned_16;
elsif Size_To_Use <= 32 then
Scal_Typ := Name_Unsigned_32;
- else
+ elsif Size_To_Use <= 64 then
Scal_Typ := Name_Unsigned_64;
+ else
+ Scal_Typ := Name_Unsigned_128;
end if;
-- Signed types
Scal_Typ := Name_Signed_16;
elsif Size_To_Use <= 32 then
Scal_Typ := Name_Signed_32;
- else
+ elsif Size_To_Use <= 64 then
Scal_Typ := Name_Signed_64;
+ else
+ Scal_Typ := Name_Signed_128;
end if;
end if;
then
Expr := Make_Integer_Literal (Loc, 2 ** Size_To_Use - 1);
- -- Resolve as Long_Long_Unsigned, because the largest number
+ -- Resolve as Long_Long_Long_Unsigned, because the largest number
-- we can generate is out of range of universal integer.
- Analyze_And_Resolve (Expr, Standard_Long_Long_Unsigned);
+ Analyze_And_Resolve (Expr, Standard_Long_Long_Long_Unsigned);
-- Case of signed types
end if;
-- The maximum size to use is System_Max_Integer_Size bits. This
- -- will create values of type Long_Long_Unsigned and the range
+ -- will create values of type Long_Long_Long_Unsigned and the range
-- must fit this type.
if Size_To_Use /= No_Uint
-- (left'address, right'address, left'length, right'length) <op> 0
-- x = U for unsigned, S for signed
- -- n = 8,16,32,64 for component size
+ -- n = 8,16,32,64,128 for component size
-- Add _Unaligned if length < 4 and component size is 8.
-- <op> is the standard comparison operator
Comp := RE_Compare_Array_S32;
end if;
- else pragma Assert (Component_Size (Typ1) = 64);
+ elsif Component_Size (Typ1) = 64 then
if Is_Unsigned_Type (Ctyp) then
Comp := RE_Compare_Array_U64;
else
Comp := RE_Compare_Array_S64;
end if;
+
+ else pragma Assert (Component_Size (Typ1) = 128);
+ if Is_Unsigned_Type (Ctyp) then
+ Comp := RE_Compare_Array_U128;
+ else
+ Comp := RE_Compare_Array_S128;
+ end if;
end if;
if RTE_Available (Comp) then
Make_Integer_Literal (Loc, Modulus (Rtyp)),
Exp))));
- -- Binary modular case, in this case, we call one of two routines,
+ -- Binary modular case, in this case, we call one of three routines,
-- either the unsigned integer case, or the unsigned long long
- -- integer case, with a final "and" operation to do the required mod.
+ -- integer case, or the unsigned long long long integer case, with a
+ -- final "and" operation to do the required mod.
else
- if UI_To_Int (Esize (Rtyp)) <= Standard_Integer_Size then
+ if Esize (Rtyp) <= Standard_Integer_Size then
Ent := RTE (RE_Exp_Unsigned);
- else
+ elsif Esize (Rtyp) <= Standard_Long_Long_Integer_Size then
Ent := RTE (RE_Exp_Long_Long_Unsigned);
+ else
+ Ent := RTE (RE_Exp_Long_Long_Long_Unsigned);
end if;
Rewrite (N,
Analyze_And_Resolve (N, Typ);
return;
- -- Signed integer cases, done using either Integer or Long_Long_Integer.
- -- It is not worth having routines for Short_[Short_]Integer, since for
- -- most machines it would not help, and it would generate more code that
- -- might need certification when a certified run time is required.
+ -- Signed integer cases, using either Integer, Long_Long_Integer or
+ -- Long_Long_Long_Integer. It is not worth also having routines for
+ -- Short_[Short_]Integer, since for most machines it would not help,
+ -- and it would generate more code that might need certification when
+ -- a certified run time is required.
-- In the integer cases, we have two routines, one for when overflow
-- checks are required, and one when they are not required, since there
-- is a real gain in omitting checks on many machines.
- elsif Rtyp = Base_Type (Standard_Long_Long_Integer)
- or else (Rtyp = Base_Type (Standard_Long_Integer)
- and then
- Esize (Standard_Long_Integer) > Esize (Standard_Integer))
- or else Rtyp = Universal_Integer
- then
- Etyp := Standard_Long_Long_Integer;
+ elsif Is_Signed_Integer_Type (Rtyp) then
+ if Esize (Rtyp) <= Standard_Integer_Size then
+ Etyp := Standard_Integer;
- if Ovflo then
- Rent := RE_Exp_Long_Long_Integer;
- else
- Rent := RE_Exn_Long_Long_Integer;
- end if;
+ if Ovflo then
+ Rent := RE_Exp_Integer;
+ else
+ Rent := RE_Exn_Integer;
+ end if;
- elsif Is_Signed_Integer_Type (Rtyp) then
- Etyp := Standard_Integer;
+ elsif Esize (Rtyp) <= Standard_Long_Long_Integer_Size then
+ Etyp := Standard_Long_Long_Integer;
+
+ if Ovflo then
+ Rent := RE_Exp_Long_Long_Integer;
+ else
+ Rent := RE_Exn_Long_Long_Integer;
+ end if;
- if Ovflo then
- Rent := RE_Exp_Integer;
else
- Rent := RE_Exn_Integer;
+ Etyp := Standard_Long_Long_Long_Integer;
+
+ if Ovflo then
+ Rent := RE_Exp_Long_Long_Long_Integer;
+ else
+ Rent := RE_Exn_Long_Long_Long_Integer;
+ end if;
end if;
-- Floating-point cases. We do not need separate routines for the
elsif Is_OK_For_Range (Uint_64) then
return Uint_64;
+ -- If the size of Typ is 128 then check 127
+
+ elsif Tsiz = Uint_128 and then Is_OK_For_Range (Uint_127) then
+ return Uint_127;
+
else
return Uint_128;
end if;
-- type instead of the first subtype because operations are done in
-- the base type, so this avoids the need for useless conversions.
- if Nsiz <= Standard_Integer_Size then
- Ntyp := Etype (Standard_Integer);
-
- elsif Nsiz <= Standard_Long_Long_Integer_Size then
- Ntyp := Etype (Standard_Long_Long_Integer);
-
+ if Nsiz <= System_Max_Integer_Size then
+ Ntyp := Etype (Integer_Type_For (Nsiz, Uns => False));
else
return;
end if;
-- Here we check if the static bounds match the natural size, which is
-- the size passed through with the debugging information. This is the
- -- Esize rounded up to 8, 16, 32 or 64 as appropriate.
+ -- Esize rounded up to 8, 16, 32, 64 or 128 as appropriate.
else
declare
Siz := Uint_16;
elsif Esize (E) <= 32 then
Siz := Uint_32;
- else
+ elsif Esize (E) <= 64 then
Siz := Uint_64;
+ else
+ Siz := Uint_128;
end if;
if Is_Modular_Integer_Type (E) or else Is_Enumeration_Type (E) then
Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
Make_Procedure_Call_Statement (Loc,
- Name => New_Occurrence_Of (RTE (RE_Double_Divide), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Double_Divide64), Loc),
Parameter_Associations => New_List (
Build_Conversion (N, QR_Typ, X),
Build_Conversion (N, QR_Typ, Y),
Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
Make_Procedure_Call_Statement (Loc,
- Name => New_Occurrence_Of (RTE (RE_Scaled_Divide), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Scaled_Divide64), Loc),
Parameter_Associations => New_List (
Build_Conversion (N, QR_Typ, X),
Build_Conversion (N, QR_Typ, Y),
return;
end if;
- -- Use Unsigned_32 for sizes of 32 or below, else Unsigned_64
+ -- Use the appropriate type for the size
- if Siz > 32 then
- T3 := RTE (RE_Unsigned_64);
- else
+ if Siz <= 32 then
T3 := RTE (RE_Unsigned_32);
+
+ elsif Siz <= 64 then
+ T3 := RTE (RE_Unsigned_64);
+
+ else pragma Assert (Siz <= 128);
+ T3 := RTE (RE_Unsigned_128);
end if;
-- Copy operator node, and reset type and entity fields, for
elsif T_Size <= 32 then
Swap_RE := RE_Bswap_32;
- else pragma Assert (T_Size <= 64);
+ elsif T_Size <= 64 then
Swap_RE := RE_Bswap_64;
+
+ else pragma Assert (T_Size <= 128);
+ Swap_RE := RE_Bswap_128;
end if;
Swap_F := RTE (Swap_RE);
-- Entity Tables for Packed Access Routines --
----------------------------------------------
- -- For the cases of component size = 3,5-7,9-15,17-31,33-63 we call library
- -- routines. These tables provide the entity for the proper routine. They
- -- are exposed in the spec to allow checking for the presence of the needed
- -- routine when an array is subject to pragma Pack.
+ -- For the cases of component size = 3,5-7,9-15,17-31,33-63,65-127 we call
+ -- library routines. These tables provide the entity for the right routine.
+ -- They are exposed in the spec to allow checking for the presence of the
+ -- needed routine when an array is subject to pragma Pack.
- type E_Array is array (Int range 01 .. 63) of RE_Id;
+ type E_Array is array (Int range 1 .. 127) of RE_Id;
-- Array of Bits_nn entities. Note that we do not use library routines
-- for the 8-bit and 16-bit cases, but we still fill in the table, using
60 => RE_Bits_60,
61 => RE_Bits_61,
62 => RE_Bits_62,
- 63 => RE_Bits_63);
+ 63 => RE_Bits_63,
+ 64 => RE_Unsigned_64,
+ 65 => RE_Bits_65,
+ 66 => RE_Bits_66,
+ 67 => RE_Bits_67,
+ 68 => RE_Bits_68,
+ 69 => RE_Bits_69,
+ 70 => RE_Bits_70,
+ 71 => RE_Bits_71,
+ 72 => RE_Bits_72,
+ 73 => RE_Bits_73,
+ 74 => RE_Bits_74,
+ 75 => RE_Bits_75,
+ 76 => RE_Bits_76,
+ 77 => RE_Bits_77,
+ 78 => RE_Bits_78,
+ 79 => RE_Bits_79,
+ 80 => RE_Bits_80,
+ 81 => RE_Bits_81,
+ 82 => RE_Bits_82,
+ 83 => RE_Bits_83,
+ 84 => RE_Bits_84,
+ 85 => RE_Bits_85,
+ 86 => RE_Bits_86,
+ 87 => RE_Bits_87,
+ 88 => RE_Bits_88,
+ 89 => RE_Bits_89,
+ 90 => RE_Bits_90,
+ 91 => RE_Bits_91,
+ 92 => RE_Bits_92,
+ 93 => RE_Bits_93,
+ 94 => RE_Bits_94,
+ 95 => RE_Bits_95,
+ 96 => RE_Bits_96,
+ 97 => RE_Bits_97,
+ 98 => RE_Bits_98,
+ 99 => RE_Bits_99,
+ 100 => RE_Bits_100,
+ 101 => RE_Bits_101,
+ 102 => RE_Bits_102,
+ 103 => RE_Bits_103,
+ 104 => RE_Bits_104,
+ 105 => RE_Bits_105,
+ 106 => RE_Bits_106,
+ 107 => RE_Bits_107,
+ 108 => RE_Bits_108,
+ 109 => RE_Bits_109,
+ 110 => RE_Bits_110,
+ 111 => RE_Bits_111,
+ 112 => RE_Bits_112,
+ 113 => RE_Bits_113,
+ 114 => RE_Bits_114,
+ 115 => RE_Bits_115,
+ 116 => RE_Bits_116,
+ 117 => RE_Bits_117,
+ 118 => RE_Bits_118,
+ 119 => RE_Bits_119,
+ 120 => RE_Bits_120,
+ 121 => RE_Bits_121,
+ 122 => RE_Bits_122,
+ 123 => RE_Bits_123,
+ 124 => RE_Bits_124,
+ 125 => RE_Bits_125,
+ 126 => RE_Bits_126,
+ 127 => RE_Bits_127);
-- Array of Get routine entities. These are used to obtain an element from
-- a packed array. The N'th entry is used to obtain elements from a packed
60 => RE_Get_60,
61 => RE_Get_61,
62 => RE_Get_62,
- 63 => RE_Get_63);
+ 63 => RE_Get_63,
+ 64 => RE_Null,
+ 65 => RE_Get_65,
+ 66 => RE_Get_66,
+ 67 => RE_Get_67,
+ 68 => RE_Get_68,
+ 69 => RE_Get_69,
+ 70 => RE_Get_70,
+ 71 => RE_Get_71,
+ 72 => RE_Get_72,
+ 73 => RE_Get_73,
+ 74 => RE_Get_74,
+ 75 => RE_Get_75,
+ 76 => RE_Get_76,
+ 77 => RE_Get_77,
+ 78 => RE_Get_78,
+ 79 => RE_Get_79,
+ 80 => RE_Get_80,
+ 81 => RE_Get_81,
+ 82 => RE_Get_82,
+ 83 => RE_Get_83,
+ 84 => RE_Get_84,
+ 85 => RE_Get_85,
+ 86 => RE_Get_86,
+ 87 => RE_Get_87,
+ 88 => RE_Get_88,
+ 89 => RE_Get_89,
+ 90 => RE_Get_90,
+ 91 => RE_Get_91,
+ 92 => RE_Get_92,
+ 93 => RE_Get_93,
+ 94 => RE_Get_94,
+ 95 => RE_Get_95,
+ 96 => RE_Get_96,
+ 97 => RE_Get_97,
+ 98 => RE_Get_98,
+ 99 => RE_Get_99,
+ 100 => RE_Get_100,
+ 101 => RE_Get_101,
+ 102 => RE_Get_102,
+ 103 => RE_Get_103,
+ 104 => RE_Get_104,
+ 105 => RE_Get_105,
+ 106 => RE_Get_106,
+ 107 => RE_Get_107,
+ 108 => RE_Get_108,
+ 109 => RE_Get_109,
+ 110 => RE_Get_110,
+ 111 => RE_Get_111,
+ 112 => RE_Get_112,
+ 113 => RE_Get_113,
+ 114 => RE_Get_114,
+ 115 => RE_Get_115,
+ 116 => RE_Get_116,
+ 117 => RE_Get_117,
+ 118 => RE_Get_118,
+ 119 => RE_Get_119,
+ 120 => RE_Get_120,
+ 121 => RE_Get_121,
+ 122 => RE_Get_122,
+ 123 => RE_Get_123,
+ 124 => RE_Get_124,
+ 125 => RE_Get_125,
+ 126 => RE_Get_126,
+ 127 => RE_Get_127);
-- Array of Get routine entities to be used in the case where the packed
-- array is itself a component of a packed structure, and therefore may not
60 => RE_GetU_60,
61 => RE_Get_61,
62 => RE_GetU_62,
- 63 => RE_Get_63);
+ 63 => RE_Get_63,
+ 64 => RE_Null,
+ 65 => RE_Get_65,
+ 66 => RE_GetU_66,
+ 67 => RE_Get_67,
+ 68 => RE_GetU_68,
+ 69 => RE_Get_69,
+ 70 => RE_GetU_70,
+ 71 => RE_Get_71,
+ 72 => RE_GetU_72,
+ 73 => RE_Get_73,
+ 74 => RE_GetU_74,
+ 75 => RE_Get_75,
+ 76 => RE_GetU_76,
+ 77 => RE_Get_77,
+ 78 => RE_GetU_78,
+ 79 => RE_Get_79,
+ 80 => RE_GetU_80,
+ 81 => RE_Get_81,
+ 82 => RE_GetU_82,
+ 83 => RE_Get_83,
+ 84 => RE_GetU_84,
+ 85 => RE_Get_85,
+ 86 => RE_GetU_86,
+ 87 => RE_Get_87,
+ 88 => RE_GetU_88,
+ 89 => RE_Get_89,
+ 90 => RE_GetU_90,
+ 91 => RE_Get_91,
+ 92 => RE_GetU_92,
+ 93 => RE_Get_93,
+ 94 => RE_GetU_94,
+ 95 => RE_Get_95,
+ 96 => RE_GetU_96,
+ 97 => RE_Get_97,
+ 98 => RE_GetU_98,
+ 99 => RE_Get_99,
+ 100 => RE_GetU_100,
+ 101 => RE_Get_101,
+ 102 => RE_GetU_102,
+ 103 => RE_Get_103,
+ 104 => RE_GetU_104,
+ 105 => RE_Get_105,
+ 106 => RE_GetU_106,
+ 107 => RE_Get_107,
+ 108 => RE_GetU_108,
+ 109 => RE_Get_109,
+ 110 => RE_GetU_110,
+ 111 => RE_Get_111,
+ 112 => RE_GetU_112,
+ 113 => RE_Get_113,
+ 114 => RE_GetU_114,
+ 115 => RE_Get_115,
+ 116 => RE_GetU_116,
+ 117 => RE_Get_117,
+ 118 => RE_GetU_118,
+ 119 => RE_Get_119,
+ 120 => RE_GetU_120,
+ 121 => RE_Get_121,
+ 122 => RE_GetU_122,
+ 123 => RE_Get_123,
+ 124 => RE_GetU_124,
+ 125 => RE_Get_125,
+ 126 => RE_GetU_126,
+ 127 => RE_Get_127);
-- Array of Set routine entities. These are used to assign an element of a
-- packed array. The N'th entry is used to assign elements for a packed
60 => RE_Set_60,
61 => RE_Set_61,
62 => RE_Set_62,
- 63 => RE_Set_63);
+ 63 => RE_Set_63,
+ 64 => RE_Null,
+ 65 => RE_Set_65,
+ 66 => RE_Set_66,
+ 67 => RE_Set_67,
+ 68 => RE_Set_68,
+ 69 => RE_Set_69,
+ 70 => RE_Set_70,
+ 71 => RE_Set_71,
+ 72 => RE_Set_72,
+ 73 => RE_Set_73,
+ 74 => RE_Set_74,
+ 75 => RE_Set_75,
+ 76 => RE_Set_76,
+ 77 => RE_Set_77,
+ 78 => RE_Set_78,
+ 79 => RE_Set_79,
+ 80 => RE_Set_80,
+ 81 => RE_Set_81,
+ 82 => RE_Set_82,
+ 83 => RE_Set_83,
+ 84 => RE_Set_84,
+ 85 => RE_Set_85,
+ 86 => RE_Set_86,
+ 87 => RE_Set_87,
+ 88 => RE_Set_88,
+ 89 => RE_Set_89,
+ 90 => RE_Set_90,
+ 91 => RE_Set_91,
+ 92 => RE_Set_92,
+ 93 => RE_Set_93,
+ 94 => RE_Set_94,
+ 95 => RE_Set_95,
+ 96 => RE_Set_96,
+ 97 => RE_Set_97,
+ 98 => RE_Set_98,
+ 99 => RE_Set_99,
+ 100 => RE_Set_100,
+ 101 => RE_Set_101,
+ 102 => RE_Set_102,
+ 103 => RE_Set_103,
+ 104 => RE_Set_104,
+ 105 => RE_Set_105,
+ 106 => RE_Set_106,
+ 107 => RE_Set_107,
+ 108 => RE_Set_108,
+ 109 => RE_Set_109,
+ 110 => RE_Set_110,
+ 111 => RE_Set_111,
+ 112 => RE_Set_112,
+ 113 => RE_Set_113,
+ 114 => RE_Set_114,
+ 115 => RE_Set_115,
+ 116 => RE_Set_116,
+ 117 => RE_Set_117,
+ 118 => RE_Set_118,
+ 119 => RE_Set_119,
+ 120 => RE_Set_120,
+ 121 => RE_Set_121,
+ 122 => RE_Set_122,
+ 123 => RE_Set_123,
+ 124 => RE_Set_124,
+ 125 => RE_Set_125,
+ 126 => RE_Set_126,
+ 127 => RE_Set_127);
-- Array of Set routine entities to be used in the case where the packed
-- array is itself a component of a packed structure, and therefore may not
60 => RE_SetU_60,
61 => RE_Set_61,
62 => RE_SetU_62,
- 63 => RE_Set_63);
+ 63 => RE_Set_63,
+ 64 => RE_Null,
+ 65 => RE_Set_65,
+ 66 => RE_SetU_66,
+ 67 => RE_Set_67,
+ 68 => RE_SetU_68,
+ 69 => RE_Set_69,
+ 70 => RE_SetU_70,
+ 71 => RE_Set_71,
+ 72 => RE_SetU_72,
+ 73 => RE_Set_73,
+ 74 => RE_SetU_74,
+ 75 => RE_Set_75,
+ 76 => RE_SetU_76,
+ 77 => RE_Set_77,
+ 78 => RE_SetU_78,
+ 79 => RE_Set_79,
+ 80 => RE_SetU_80,
+ 81 => RE_Set_81,
+ 82 => RE_SetU_82,
+ 83 => RE_Set_83,
+ 84 => RE_SetU_84,
+ 85 => RE_Set_85,
+ 86 => RE_SetU_86,
+ 87 => RE_Set_87,
+ 88 => RE_SetU_88,
+ 89 => RE_Set_89,
+ 90 => RE_SetU_90,
+ 91 => RE_Set_91,
+ 92 => RE_SetU_92,
+ 93 => RE_Set_93,
+ 94 => RE_SetU_94,
+ 95 => RE_Set_95,
+ 96 => RE_SetU_96,
+ 97 => RE_Set_97,
+ 98 => RE_SetU_98,
+ 99 => RE_Set_99,
+ 100 => RE_SetU_100,
+ 101 => RE_Set_101,
+ 102 => RE_SetU_102,
+ 103 => RE_Set_103,
+ 104 => RE_SetU_104,
+ 105 => RE_Set_105,
+ 106 => RE_SetU_106,
+ 107 => RE_Set_107,
+ 108 => RE_SetU_108,
+ 109 => RE_Set_109,
+ 110 => RE_SetU_110,
+ 111 => RE_Set_111,
+ 112 => RE_SetU_112,
+ 113 => RE_Set_113,
+ 114 => RE_SetU_114,
+ 115 => RE_Set_115,
+ 116 => RE_SetU_116,
+ 117 => RE_Set_117,
+ 118 => RE_SetU_118,
+ 119 => RE_Set_119,
+ 120 => RE_SetU_120,
+ 121 => RE_Set_121,
+ 122 => RE_SetU_122,
+ 123 => RE_Set_123,
+ 124 => RE_SetU_124,
+ 125 => RE_Set_125,
+ 126 => RE_SetU_126,
+ 127 => RE_Set_127);
-----------------
-- Subprograms --
return Standard_Long_Long_Integer;
end if;
+ -- This is the canonical 128-bit type
+
+ elsif S <= Standard_Long_Long_Long_Integer_Size then
+ if Uns then
+ return Standard_Long_Long_Long_Unsigned;
+ else
+ return Standard_Long_Long_Long_Integer;
+ end if;
+
else
raise Program_Error;
end if;
return Standard_Long_Long_Integer;
end if;
+ elsif S <= Standard_Long_Long_Long_Integer_Size then
+ if Uns then
+ return Standard_Long_Long_Long_Unsigned;
+ else
+ return Standard_Long_Long_Long_Integer;
+ end if;
+
else
raise Program_Error;
end if;
Renamings_Included : Boolean := True) return Boolean
is
begin
- -- Definitely false if longer than 12 characters (8.3)
- -- except for the Interfaces packages
+ -- Definitely false if longer than 12 characters (8.3), except for the
+ -- Interfaces packages and also the implementation units of the 128-bit
+ -- types under System.
if Fname'Length > 12
and then Fname (Fname'First .. Fname'First + 1) /= "i-"
+ and then Fname (Fname'First .. Fname'First + 1) /= "s-"
then
return False;
end if;
-- Typ is a type that is being frozen. If no size clause is given,
-- but a default Esize has been computed, then this default Esize is
-- adjusted up if necessary to be consistent with a given alignment,
- -- but never to a value greater than Long_Long_Integer'Size. This
- -- is used for all discrete types and for fixed-point types.
+ -- but never to a value greater than System_Max_Integer_Size. This is
+ -- used for all discrete types and for fixed-point types.
procedure Build_And_Analyze_Renamed_Body
(Decl : Node_Id;
if Known_Esize (Typ) and then Known_Alignment (Typ) then
Align := Alignment_In_Bits (Typ);
- if Align > Esize (Typ)
- and then Align <= Standard_Long_Long_Integer_Size
- then
+ if Align > Esize (Typ) and then Align <= System_Max_Integer_Size then
Set_Esize (Typ, Align);
end if;
end if;
-- generated a message on the template.
procedure Check_Suspicious_Modulus (Utype : Entity_Id);
- -- Give warning for modulus of 8, 16, 32, or 64 given as an explicit
+ -- Give warning for modulus of 8, 16, 32, 64 or 128 given as an explicit
-- integer literal without an explicit corresponding size clause. The
-- caller has checked that Utype is a modular integer type.
end if;
end if;
- -- Bit packing is never needed for 8, 16, 32, 64
+ -- Bit packing is never needed for 8, 16, 32, 64 or 128
if Addressable (Csiz) then
return C_Get_Long_Long_Size;
end Get_Long_Long_Size;
+ -----------------------------
+ -- Get_Long_Long_Long_Size --
+ -----------------------------
+
+ function Get_Long_Long_Long_Size return Pos is
+ function C_Get_Long_Long_Long_Size return Pos;
+ pragma Import (C, C_Get_Long_Long_Long_Size,
+ "get_target_long_long_long_size");
+ begin
+ return C_Get_Long_Long_Long_Size;
+ end Get_Long_Long_Long_Size;
+
----------------------
-- Get_Pointer_Size --
----------------------
function Width_From_Size (Size : Pos) return Pos is
begin
case Size is
- when 8 => return 4;
- when 16 => return 6;
- when 32 => return 11;
- when 64 => return 21;
+ when 8 => return 4;
+ when 16 => return 6;
+ when 32 => return 11;
+ when 64 => return 21;
+ when 128 => return 40;
when others => raise Program_Error;
end case;
end Width_From_Size;
function Get_Long_Long_Size return Pos;
-- Size of Standard.Long_Long_Integer
+ function Get_Long_Long_Long_Size return Pos;
+ -- Size of Standard.Long_Long_Long_Integer
+
function Get_Pointer_Size return Pos;
-- Size of System.Address
Set_Standard_Output;
end if;
+ -- Enable or disable the support for 128-bit types
+
+ if Enable_128bit_Types then
+ if Ttypes.Standard_Long_Long_Long_Integer_Size < 128 then
+ Write_Line
+ ("128-bit types not implemented in this configuration");
+ raise Unrecoverable_Error;
+ end if;
+
+ -- In GNAT mode the support is automatically enabled if available,
+ -- so that the runtime is compiled with the support enabled.
+
+ elsif GNAT_Mode then
+ Enable_128bit_Types :=
+ Ttypes.Standard_Long_Long_Long_Integer_Size = 128;
+
+ else
+ Ttypes.Standard_Long_Long_Long_Integer_Size :=
+ Ttypes.Standard_Long_Long_Integer_Size;
+ Ttypes.Standard_Long_Long_Long_Integer_Width :=
+ Ttypes.Standard_Long_Long_Integer_Width;
+ Ttypes.System_Max_Integer_Size :=
+ Ttypes.Standard_Long_Long_Integer_Size;
+ Ttypes.System_Max_Binary_Modulus_Power :=
+ Ttypes.Standard_Long_Long_Integer_Size;
+ end if;
+
-- Finally capture adjusted value of Suppress_Options as the initial
-- value for Scope_Suppress, which will be modified as we move from
-- scope to scope (by Suppress/Unsuppress/Overflow_Checks pragmas).
function Get_Kind_Of_File (File : String) return Kind_Of_Unit is
pragma Assert (File'First = 1);
- Buffer : String (1 .. 8);
+ Buffer : String (1 .. 9);
begin
Error_Msg_Strlen := 0;
return Ada_95_Unit;
end if;
- -- If length of file name is greater than 12, not predefined. The value
- -- 12 here is an 8 char name with extension .ads.
-
- if File'Length > 12 then
- return Not_Predefined_Unit;
- end if;
-
-- Not predefined if file name does not start with a- g- s- i-
if File'Length < 3
return Not_Predefined_Unit;
end if;
+ -- If length of file name is greater than 12, not predefined. The value
+ -- 12 here is an 8 char name with extension .ads. The exception of 13 is
+ -- for the implementation units of the 128-bit types under System.
+
+ if File'Length > 12
+ and then not (File'Length = 13 and then File (1) = 's')
+ then
+ return Not_Predefined_Unit;
+ end if;
+
-- Not predefined if file name does not end in .ads. This can happen
-- when non-standard file names are being used.
-- See if name is in 95 list
for J in Non_Imp_File_Names_95'Range loop
- if Buffer = Non_Imp_File_Names_95 (J).Fname then
+ if Buffer (1 .. 8) = Non_Imp_File_Names_95 (J).Fname then
return Ada_95_Unit;
end if;
end loop;
-- See if name is in 2005 list
for J in Non_Imp_File_Names_05'Range loop
- if Buffer = Non_Imp_File_Names_05 (J).Fname then
+ if Buffer (1 .. 8) = Non_Imp_File_Names_05 (J).Fname then
return Ada_2005_Unit;
end if;
end loop;
-- See if name is in 2012 list
for J in Non_Imp_File_Names_12'Range loop
- if Buffer = Non_Imp_File_Names_12 (J).Fname then
+ if Buffer (1 .. 8) = Non_Imp_File_Names_12 (J).Fname then
return Ada_2012_Unit;
end if;
end loop;
-- See if name is in 202X list
for J in Non_Imp_File_Names_2X'Range loop
- if Buffer = Non_Imp_File_Names_2X (J).Fname then
+ if Buffer (1 .. 8) = Non_Imp_File_Names_2X (J).Fname then
return Ada_202X_Unit;
end if;
end loop;
return True;
end if;
- -- If length of file name is greater than 12, then it's a user unit
- -- and not a GNAT implementation defined unit.
-
- if Name_Len > 12 then
- return True;
- end if;
-
-- Implementation defined if unit in the gnat hierarchy
if (Name_Len = 8 and then Name_Buffer (1 .. 8) = "gnat.ads")
return True;
end if;
+ -- If length of file name is greater than 12, not predefined. The value
+ -- 12 here is an 8 char name with extension .ads. The exception of 13 is
+ -- for the implementation units of the 128-bit types under System.
+
+ if Name_Len > 12
+ and then not (Name_Len = 13 and then Name_Buffer (1) = 's')
+ then
+ return True;
+ end if;
+
-- Not impl-defined if file name does not end in .ads. This can happen
-- when non-standard file names are being used.
Startloc := 3;
Buffer (2 .. Len - 5) := Buffer (7 .. Len);
Curlen := Len - 5;
- Krlen := 8;
+ if Buffer (Curlen - 2 .. Curlen) = "128"
+ or else Buffer (3 .. 9) = "exn_lll"
+ or else Buffer (3 .. 9) = "exp_lll"
+ or else (Buffer (3 .. 6) = "pack" and then Curlen = 10)
+ then
+ if Buffer (3 .. 15) = "compare_array" then
+ Buffer (3 .. 4) := "ca";
+ Buffer (5 .. Curlen - 11) := Buffer (16 .. Curlen);
+ Curlen := Curlen - 11;
+ end if;
+ Krlen := 9;
+ else
+ Krlen := 8;
+ end if;
elsif Len >= 11 and then Buffer (1 .. 11) = "interfaces-" then
Startloc := 3;
-- we replace the prefix ada.wide_wide_text_io- by a-zt- and then
-- the normal crunching rules are applied.
+-- The units implementing the support of 128-bit types are crunched to 9 and
+-- System.Compare_Array_* is replaced with System.CA_* before crunching.
+
-- These are the only irregularity required (so far) to keep the file names
-- unique in the standard predefined libraries.
end if;
-- For array base types, set the component size if object size of the
- -- component type is known and is a small power of 2 (8, 16, 32, 64),
- -- since this is what will always be used, except if a very large
- -- alignment was specified and so Adjust_Esize_For_Alignment gave up
- -- because, in this case, the object size is not a multiple of the
- -- alignment and, therefore, cannot be the component size.
+ -- component type is known and is a small power of 2 (8, 16, 32, 64
+ -- or 128), since this is what will always be used, except if a very
+ -- large alignment was specified and so Adjust_Esize_For_Alignment
+ -- gave up because, in this case, the object size is not a multiple
+ -- of the alignment and, therefore, cannot be the component size.
if Ekind (E) = E_Array_Type and then Unknown_Component_Size (E) then
declare
and then Known_Static_Esize (CT)
and then not (Known_Alignment (CT)
and then Alignment_In_Bits (CT) >
- Standard_Long_Long_Integer_Size)
+ System_Max_Integer_Size)
then
declare
S : constant Uint := Esize (CT);
YY := 10**(Integer'Min (Max_Digits, AA - (J - 1) * Max_Digits));
end if;
- Scaled_Divide (XX, YY, Z, Q (J), R => XX, Round => False);
+ Scaled_Divide64 (XX, YY, Z, Q (J), R => XX, Round => False);
end loop;
if -E > A then
-- such as SPARK or CodePeer. In the normal case Long_Long_Integer is
-- always 64-bits so we get the desired 64-bit type.
- type Unsigned_8 is mod 2 ** 8;
+ type Integer_128 is new Long_Long_Long_Integer;
+ -- Note: we use Long_Long_Long_Integer instead of literal bounds to allow
+ -- this unit to be compiled with compilers not supporting 128-bit integers.
+ -- We do not put a confirming size clause of 128 bits for the same reason.
+
+ type Unsigned_8 is mod 2 ** 8;
for Unsigned_8'Size use 8;
type Unsigned_16 is mod 2 ** 16;
for Unsigned_64'Size use 64;
-- See comment on Integer_64 above
+ type Unsigned_128 is mod 2 ** Long_Long_Long_Integer'Size;
+ -- See comment on Integer_128 above
+
function Shift_Left
(Value : Unsigned_8;
Amount : Natural) return Unsigned_8
Amount : Natural) return Unsigned_64
with Import, Convention => Intrinsic, Static;
+ function Shift_Left
+ (Value : Unsigned_128;
+ Amount : Natural) return Unsigned_128
+ with Import, Convention => Intrinsic, Static;
+
+ function Shift_Right
+ (Value : Unsigned_128;
+ Amount : Natural) return Unsigned_128
+ with Import, Convention => Intrinsic, Static;
+
+ function Shift_Right_Arithmetic
+ (Value : Unsigned_128;
+ Amount : Natural) return Unsigned_128
+ with Import, Convention => Intrinsic, Static;
+
+ function Rotate_Left
+ (Value : Unsigned_128;
+ Amount : Natural) return Unsigned_128
+ with Import, Convention => Intrinsic, Static;
+
+ function Rotate_Right
+ (Value : Unsigned_128;
+ Amount : Natural) return Unsigned_128
+ with Import, Convention => Intrinsic, Static;
+
-- IEEE Floating point types
type IEEE_Float_32 is digits 6;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . A R I T H _ D O U B L E --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with Ada.Unchecked_Conversion;
+
+package body System.Arith_Double is
+
+ pragma Suppress (Overflow_Check);
+ pragma Suppress (Range_Check);
+
+ function To_Uns is new Ada.Unchecked_Conversion (Double_Int, Double_Uns);
+ function To_Int is new Ada.Unchecked_Conversion (Double_Uns, Double_Int);
+
+ Double_Size : constant Natural := Double_Int'Size;
+ Single_Size : constant Natural := Double_Int'Size / 2;
+
+ -----------------------
+ -- Local Subprograms --
+ -----------------------
+
+ function "+" (A, B : Single_Uns) return Double_Uns is
+ (Double_Uns (A) + Double_Uns (B));
+ function "+" (A : Double_Uns; B : Single_Uns) return Double_Uns is
+ (A + Double_Uns (B));
+ -- Length doubling additions
+
+ function "*" (A, B : Single_Uns) return Double_Uns is
+ (Double_Uns (A) * Double_Uns (B));
+ -- Length doubling multiplication
+
+ function "/" (A : Double_Uns; B : Single_Uns) return Double_Uns is
+ (A / Double_Uns (B));
+ -- Length doubling division
+
+ function "&" (Hi, Lo : Single_Uns) return Double_Uns is
+ (Shift_Left (Double_Uns (Hi), Single_Size) or Double_Uns (Lo));
+ -- Concatenate hi, lo values to form double result
+
+ function "abs" (X : Double_Int) return Double_Uns is
+ (if X = Double_Int'First
+ then 2 ** (Double_Size - 1)
+ else Double_Uns (Double_Int'(abs X)));
+ -- Convert absolute value of X to unsigned. Note that we can't just use
+ -- the expression of the Else since it overflows for X = Double_Int'First.
+
+ function "rem" (A : Double_Uns; B : Single_Uns) return Double_Uns is
+ (A rem Double_Uns (B));
+ -- Length doubling remainder
+
+ function Le3 (X1, X2, X3, Y1, Y2, Y3 : Single_Uns) return Boolean;
+ -- Determines if (3 * Single_Size)-bit value X1&X2&X3 <= Y1&Y2&Y3
+
+ function Lo (A : Double_Uns) return Single_Uns is
+ (Single_Uns (A and (2 ** Single_Size - 1)));
+ -- Low order half of double value
+
+ function Hi (A : Double_Uns) return Single_Uns is
+ (Single_Uns (Shift_Right (A, Single_Size)));
+ -- High order half of double value
+
+ procedure Sub3 (X1, X2, X3 : in out Single_Uns; Y1, Y2, Y3 : Single_Uns);
+ -- Computes X1&X2&X3 := X1&X2&X3 - Y1&Y1&Y3 mod 2 ** (3 * Single_Size)
+
+ function To_Neg_Int (A : Double_Uns) return Double_Int;
+ -- Convert to negative integer equivalent. If the input is in the range
+ -- 0 .. 2 ** (Double_Size - 1), then the corresponding nonpositive signed
+ -- integer (obtained by negating the given value) is returned, otherwise
+ -- constraint error is raised.
+
+ function To_Pos_Int (A : Double_Uns) return Double_Int;
+ -- Convert to positive integer equivalent. If the input is in the range
+ -- 0 .. 2 ** (Double_Size - 1) - 1, then the corresponding non-negative
+ -- signed integer is returned, otherwise constraint error is raised.
+
+ procedure Raise_Error;
+ pragma No_Return (Raise_Error);
+ -- Raise constraint error with appropriate message
+
+ --------------------------
+ -- Add_With_Ovflo_Check --
+ --------------------------
+
+ function Add_With_Ovflo_Check (X, Y : Double_Int) return Double_Int is
+ R : constant Double_Int := To_Int (To_Uns (X) + To_Uns (Y));
+
+ begin
+ if X >= 0 then
+ if Y < 0 or else R >= 0 then
+ return R;
+ end if;
+
+ else -- X < 0
+ if Y > 0 or else R < 0 then
+ return R;
+ end if;
+ end if;
+
+ Raise_Error;
+ end Add_With_Ovflo_Check;
+
+ -------------------
+ -- Double_Divide --
+ -------------------
+
+ procedure Double_Divide
+ (X, Y, Z : Double_Int;
+ Q, R : out Double_Int;
+ Round : Boolean)
+ is
+ Xu : constant Double_Uns := abs X;
+ Yu : constant Double_Uns := abs Y;
+
+ Yhi : constant Single_Uns := Hi (Yu);
+ Ylo : constant Single_Uns := Lo (Yu);
+
+ Zu : constant Double_Uns := abs Z;
+ Zhi : constant Single_Uns := Hi (Zu);
+ Zlo : constant Single_Uns := Lo (Zu);
+
+ T1, T2 : Double_Uns;
+ Du, Qu, Ru : Double_Uns;
+ Den_Pos : Boolean;
+
+ begin
+ if Yu = 0 or else Zu = 0 then
+ Raise_Error;
+ end if;
+
+ -- Set final signs (RM 4.5.5(27-30))
+
+ Den_Pos := (Y < 0) = (Z < 0);
+
+ -- Compute Y * Z. Note that if the result overflows Double_Uns, then
+ -- the rounded result is zero, except for the very special case where
+ -- X = -2 ** (Double_Size - 1) and abs(Y*Z) = 2 ** Double_Size, when
+ -- Round is True.
+
+ if Yhi /= 0 then
+ if Zhi /= 0 then
+
+ -- Handle the special case when Round is True
+
+ if Yhi = 1
+ and then Zhi = 1
+ and then Ylo = 0
+ and then Zlo = 0
+ and then X = Double_Int'First
+ and then Round
+ then
+ Q := (if Den_Pos then -1 else 1);
+ else
+ Q := 0;
+ end if;
+
+ R := X;
+ return;
+ else
+ T2 := Yhi * Zlo;
+ end if;
+
+ else
+ T2 := Ylo * Zhi;
+ end if;
+
+ T1 := Ylo * Zlo;
+ T2 := T2 + Hi (T1);
+
+ if Hi (T2) /= 0 then
+
+ -- Handle the special case when Round is True
+
+ if Hi (T2) = 1
+ and then Lo (T2) = 0
+ and then Lo (T1) = 0
+ and then X = Double_Int'First
+ and then Round
+ then
+ Q := (if Den_Pos then -1 else 1);
+ else
+ Q := 0;
+ end if;
+
+ R := X;
+ return;
+ end if;
+
+ Du := Lo (T2) & Lo (T1);
+
+ -- Check overflow case of largest negative number divided by -1
+
+ if X = Double_Int'First and then Du = 1 and then not Den_Pos then
+ Raise_Error;
+ end if;
+
+ -- Perform the actual division
+
+ pragma Assert (Du /= 0);
+ -- Multiplication of 2-limb arguments Yu and Zu leads to 4-limb result
+ -- (where each limb is a single value). Cases where 4 limbs are needed
+ -- require Yhi/=0 and Zhi/=0 and lead to early exit. Remaining cases
+ -- where 3 limbs are needed correspond to Hi(T2)/=0 and lead to early
+ -- exit. Thus, at this point, the result fits in 2 limbs which are
+ -- exactly Lo(T2) and Lo(T1), which corresponds to the value of Du.
+ -- As the case where one of Yu or Zu is null also led to early exit,
+ -- we have Du/=0 here.
+ Qu := Xu / Du;
+ Ru := Xu rem Du;
+
+ -- Deal with rounding case
+
+ if Round and then Ru > (Du - Double_Uns'(1)) / Double_Uns'(2) then
+ Qu := Qu + Double_Uns'(1);
+ end if;
+
+ -- Case of dividend (X) sign positive
+
+ if X >= 0 then
+ R := To_Int (Ru);
+ Q := (if Den_Pos then To_Int (Qu) else -To_Int (Qu));
+
+ -- Case of dividend (X) sign negative
+
+ -- We perform the unary minus operation on the unsigned value
+ -- before conversion to signed, to avoid a possible overflow
+ -- for value -2 ** (Double_Size - 1), both for computing R and Q.
+
+ else
+ R := To_Int (-Ru);
+ Q := (if Den_Pos then To_Int (-Qu) else To_Int (Qu));
+ end if;
+ end Double_Divide;
+
+ ---------
+ -- Le3 --
+ ---------
+
+ function Le3 (X1, X2, X3, Y1, Y2, Y3 : Single_Uns) return Boolean is
+ begin
+ if X1 < Y1 then
+ return True;
+ elsif X1 > Y1 then
+ return False;
+ elsif X2 < Y2 then
+ return True;
+ elsif X2 > Y2 then
+ return False;
+ else
+ return X3 <= Y3;
+ end if;
+ end Le3;
+
+ -------------------------------
+ -- Multiply_With_Ovflo_Check --
+ -------------------------------
+
+ function Multiply_With_Ovflo_Check (X, Y : Double_Int) return Double_Int is
+ Xu : constant Double_Uns := abs X;
+ Xhi : constant Single_Uns := Hi (Xu);
+ Xlo : constant Single_Uns := Lo (Xu);
+
+ Yu : constant Double_Uns := abs Y;
+ Yhi : constant Single_Uns := Hi (Yu);
+ Ylo : constant Single_Uns := Lo (Yu);
+
+ T1, T2 : Double_Uns;
+
+ begin
+ if Xhi /= 0 then
+ if Yhi /= 0 then
+ Raise_Error;
+ else
+ T2 := Xhi * Ylo;
+ end if;
+
+ elsif Yhi /= 0 then
+ T2 := Xlo * Yhi;
+
+ else -- Yhi = Xhi = 0
+ T2 := 0;
+ end if;
+
+ -- Here we have T2 set to the contribution to the upper half of the
+ -- result from the upper halves of the input values.
+
+ T1 := Xlo * Ylo;
+ T2 := T2 + Hi (T1);
+
+ if Hi (T2) /= 0 then
+ Raise_Error;
+ end if;
+
+ T2 := Lo (T2) & Lo (T1);
+
+ if X >= 0 then
+ if Y >= 0 then
+ return To_Pos_Int (T2);
+ pragma Annotate (CodePeer, Intentional, "precondition",
+ "Intentional Unsigned->Signed conversion");
+ else
+ return To_Neg_Int (T2);
+ end if;
+ else -- X < 0
+ if Y < 0 then
+ return To_Pos_Int (T2);
+ pragma Annotate (CodePeer, Intentional, "precondition",
+ "Intentional Unsigned->Signed conversion");
+ else
+ return To_Neg_Int (T2);
+ end if;
+ end if;
+
+ end Multiply_With_Ovflo_Check;
+
+ -----------------
+ -- Raise_Error --
+ -----------------
+
+ procedure Raise_Error is
+ begin
+ raise Constraint_Error with "Double arithmetic overflow";
+ end Raise_Error;
+
+ -------------------
+ -- Scaled_Divide --
+ -------------------
+
+ procedure Scaled_Divide
+ (X, Y, Z : Double_Int;
+ Q, R : out Double_Int;
+ Round : Boolean)
+ is
+ Xu : constant Double_Uns := abs X;
+ Xhi : constant Single_Uns := Hi (Xu);
+ Xlo : constant Single_Uns := Lo (Xu);
+
+ Yu : constant Double_Uns := abs Y;
+ Yhi : constant Single_Uns := Hi (Yu);
+ Ylo : constant Single_Uns := Lo (Yu);
+
+ Zu : Double_Uns := abs Z;
+ Zhi : Single_Uns := Hi (Zu);
+ Zlo : Single_Uns := Lo (Zu);
+
+ D : array (1 .. 4) of Single_Uns;
+ -- The dividend, four digits (D(1) is high order)
+
+ Qd : array (1 .. 2) of Single_Uns;
+ -- The quotient digits, two digits (Qd(1) is high order)
+
+ S1, S2, S3 : Single_Uns;
+ -- Value to subtract, three digits (S1 is high order)
+
+ Qu : Double_Uns;
+ Ru : Double_Uns;
+ -- Unsigned quotient and remainder
+
+ Mask : Single_Uns;
+ -- Mask of bits used to compute the scaling factor below
+
+ Scale : Natural;
+ -- Scaling factor used for multiple-precision divide. Dividend and
+ -- Divisor are multiplied by 2 ** Scale, and the final remainder is
+ -- divided by the scaling factor. The reason for this scaling is to
+ -- allow more accurate estimation of quotient digits.
+
+ Shift : Natural;
+ -- Shift factor used to compute the scaling factor above
+
+ T1, T2, T3 : Double_Uns;
+ -- Temporary values
+
+ begin
+ -- First do the multiplication, giving the four digit dividend
+
+ T1 := Xlo * Ylo;
+ D (4) := Lo (T1);
+ D (3) := Hi (T1);
+
+ if Yhi /= 0 then
+ T1 := Xlo * Yhi;
+ T2 := D (3) + Lo (T1);
+ D (3) := Lo (T2);
+ D (2) := Hi (T1) + Hi (T2);
+
+ if Xhi /= 0 then
+ T1 := Xhi * Ylo;
+ T2 := D (3) + Lo (T1);
+ D (3) := Lo (T2);
+ T3 := D (2) + Hi (T1);
+ T3 := T3 + Hi (T2);
+ D (2) := Lo (T3);
+ D (1) := Hi (T3);
+
+ T1 := (D (1) & D (2)) + Double_Uns'(Xhi * Yhi);
+ D (1) := Hi (T1);
+ D (2) := Lo (T1);
+
+ else
+ D (1) := 0;
+ end if;
+
+ else
+ if Xhi /= 0 then
+ T1 := Xhi * Ylo;
+ T2 := D (3) + Lo (T1);
+ D (3) := Lo (T2);
+ D (2) := Hi (T1) + Hi (T2);
+
+ else
+ D (2) := 0;
+ end if;
+
+ D (1) := 0;
+ end if;
+
+ -- Now it is time for the dreaded multiple precision division. First an
+ -- easy case, check for the simple case of a one digit divisor.
+
+ if Zhi = 0 then
+ if D (1) /= 0 or else D (2) >= Zlo then
+ Raise_Error;
+
+ -- Here we are dividing at most three digits by one digit
+
+ else
+ T1 := D (2) & D (3);
+ T2 := Lo (T1 rem Zlo) & D (4);
+
+ Qu := Lo (T1 / Zlo) & Lo (T2 / Zlo);
+ Ru := T2 rem Zlo;
+ end if;
+
+ -- If divisor is double digit and dividend is too large, raise error
+
+ elsif (D (1) & D (2)) >= Zu then
+ Raise_Error;
+
+ -- This is the complex case where we definitely have a double digit
+ -- divisor and a dividend of at least three digits. We use the classical
+ -- multiple-precision division algorithm (see section (4.3.1) of Knuth's
+ -- "The Art of Computer Programming", Vol. 2 for a description
+ -- (algorithm D).
+
+ else
+ -- First normalize the divisor so that it has the leading bit on.
+ -- We do this by finding the appropriate left shift amount.
+
+ Shift := Single_Size / 2;
+ Mask := Shift_Left (2 ** (Single_Size / 2) - 1, Shift);
+ Scale := 0;
+
+ while Shift /= 0 loop
+ if (Hi (Zu) and Mask) = 0 then
+ Scale := Scale + Shift;
+ Zu := Shift_Left (Zu, Shift);
+ end if;
+
+ Shift := Shift / 2;
+ Mask := Shift_Left (Mask, Shift);
+ end loop;
+
+ Zhi := Hi (Zu);
+ Zlo := Lo (Zu);
+
+ pragma Assert (Zhi /= 0);
+ -- We have Hi(Zu)/=0 before normalization. The sequence of Shift_Left
+ -- operations results in the leading bit of Zu being 1 by moving the
+ -- leftmost 1-bit in Zu to leading position, thus Zhi=Hi(Zu)/=0 here.
+
+ -- Note that when we scale up the dividend, it still fits in four
+ -- digits, since we already tested for overflow, and scaling does
+ -- not change the invariant that (D (1) & D (2)) < Zu.
+
+ T1 := Shift_Left (D (1) & D (2), Scale);
+ D (1) := Hi (T1);
+ T2 := Shift_Left (0 & D (3), Scale);
+ D (2) := Lo (T1) or Hi (T2);
+ T3 := Shift_Left (0 & D (4), Scale);
+ D (3) := Lo (T2) or Hi (T3);
+ D (4) := Lo (T3);
+
+ -- Loop to compute quotient digits, runs twice for Qd(1) and Qd(2)
+
+ for J in 0 .. 1 loop
+
+ -- Compute next quotient digit. We have to divide three digits by
+ -- two digits. We estimate the quotient by dividing the leading
+ -- two digits by the leading digit. Given the scaling we did above
+ -- which ensured the first bit of the divisor is set, this gives
+ -- an estimate of the quotient that is at most two too high.
+
+ Qd (J + 1) := (if D (J + 1) = Zhi
+ then 2 ** Single_Size - 1
+ else Lo ((D (J + 1) & D (J + 2)) / Zhi));
+
+ -- Compute amount to subtract
+
+ T1 := Qd (J + 1) * Zlo;
+ T2 := Qd (J + 1) * Zhi;
+ S3 := Lo (T1);
+ T1 := Hi (T1) + Lo (T2);
+ S2 := Lo (T1);
+ S1 := Hi (T1) + Hi (T2);
+
+ -- Adjust quotient digit if it was too high
+
+ -- We use the version of the algorithm in the 2nd Edition of
+ -- "The Art of Computer Programming". This had a bug not
+ -- discovered till 1995, see Vol 2 errata:
+ -- http://www-cs-faculty.stanford.edu/~uno/err2-2e.ps.gz.
+ -- Under rare circumstances the expression in the test could
+ -- overflow. This version was further corrected in 2005, see
+ -- Vol 2 errata:
+ -- http://www-cs-faculty.stanford.edu/~uno/all2-pre.ps.gz.
+ -- This implementation is not impacted by these bugs, due to the
+ -- use of a word-size comparison done in function Le3 instead of
+ -- a comparison on two-word integer quantities in the original
+ -- algorithm.
+
+ loop
+ exit when Le3 (S1, S2, S3, D (J + 1), D (J + 2), D (J + 3));
+ Qd (J + 1) := Qd (J + 1) - 1;
+ Sub3 (S1, S2, S3, 0, Zhi, Zlo);
+ end loop;
+
+ -- Now subtract S1&S2&S3 from D1&D2&D3 ready for next step
+
+ Sub3 (D (J + 1), D (J + 2), D (J + 3), S1, S2, S3);
+ end loop;
+
+ -- The two quotient digits are now set, and the remainder of the
+ -- scaled division is in D3&D4. To get the remainder for the
+ -- original unscaled division, we rescale this dividend.
+
+ -- We rescale the divisor as well, to make the proper comparison
+ -- for rounding below.
+
+ Qu := Qd (1) & Qd (2);
+ Ru := Shift_Right (D (3) & D (4), Scale);
+ Zu := Shift_Right (Zu, Scale);
+ end if;
+
+ -- Deal with rounding case
+
+ if Round and then Ru > (Zu - Double_Uns'(1)) / Double_Uns'(2) then
+
+ -- Protect against wrapping around when rounding, by signaling
+ -- an overflow when the quotient is too large.
+
+ if Qu = Double_Uns'Last then
+ Raise_Error;
+ end if;
+
+ Qu := Qu + Double_Uns'(1);
+ end if;
+
+ -- Set final signs (RM 4.5.5(27-30))
+
+ -- Case of dividend (X * Y) sign positive
+
+ if (X >= 0 and then Y >= 0) or else (X < 0 and then Y < 0) then
+ R := To_Pos_Int (Ru);
+ Q := (if Z > 0 then To_Pos_Int (Qu) else To_Neg_Int (Qu));
+
+ -- Case of dividend (X * Y) sign negative
+
+ else
+ R := To_Neg_Int (Ru);
+ Q := (if Z > 0 then To_Neg_Int (Qu) else To_Pos_Int (Qu));
+ end if;
+ end Scaled_Divide;
+
+ ----------
+ -- Sub3 --
+ ----------
+
+ procedure Sub3 (X1, X2, X3 : in out Single_Uns; Y1, Y2, Y3 : Single_Uns) is
+ begin
+ if Y3 > X3 then
+ if X2 = 0 then
+ X1 := X1 - 1;
+ end if;
+
+ X2 := X2 - 1;
+ end if;
+
+ X3 := X3 - Y3;
+
+ if Y2 > X2 then
+ X1 := X1 - 1;
+ end if;
+
+ X2 := X2 - Y2;
+ X1 := X1 - Y1;
+ end Sub3;
+
+ -------------------------------
+ -- Subtract_With_Ovflo_Check --
+ -------------------------------
+
+ function Subtract_With_Ovflo_Check (X, Y : Double_Int) return Double_Int is
+ R : constant Double_Int := To_Int (To_Uns (X) - To_Uns (Y));
+
+ begin
+ if X >= 0 then
+ if Y > 0 or else R >= 0 then
+ return R;
+ end if;
+
+ else -- X < 0
+ if Y <= 0 or else R < 0 then
+ return R;
+ end if;
+ end if;
+
+ Raise_Error;
+ end Subtract_With_Ovflo_Check;
+
+ ----------------
+ -- To_Neg_Int --
+ ----------------
+
+ function To_Neg_Int (A : Double_Uns) return Double_Int is
+ R : constant Double_Int :=
+ (if A = 2 ** (Double_Size - 1) then Double_Int'First else -To_Int (A));
+ -- Note that we can't just use the expression of the Else, because it
+ -- overflows for A = 2 ** (Double_Size - 1).
+ begin
+ if R <= 0 then
+ return R;
+ else
+ Raise_Error;
+ end if;
+ end To_Neg_Int;
+
+ ----------------
+ -- To_Pos_Int --
+ ----------------
+
+ function To_Pos_Int (A : Double_Uns) return Double_Int is
+ R : constant Double_Int := To_Int (A);
+ begin
+ if R >= 0 then
+ return R;
+ else
+ Raise_Error;
+ end if;
+ end To_Pos_Int;
+
+end System.Arith_Double;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . A R I T H _ D O U B L E --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package provides software routines for doing arithmetic on "double"
+-- signed integer values in cases where either overflow checking is required,
+-- or intermediate results are longer than the result type.
+
+generic
+
+ type Double_Int is range <>;
+
+ type Double_Uns is mod <>;
+
+ type Single_Uns is mod <>;
+
+ with function Shift_Left (A : Double_Uns; B : Natural) return Double_Uns
+ is <>;
+
+ with function Shift_Right (A : Double_Uns; B : Natural) return Double_Uns
+ is <>;
+
+ with function Shift_Left (A : Single_Uns; B : Natural) return Single_Uns
+ is <>;
+
+package System.Arith_Double is
+ pragma Pure;
+
+ function Add_With_Ovflo_Check (X, Y : Double_Int) return Double_Int;
+ -- Raises Constraint_Error if sum of operands overflows Double_Int,
+ -- otherwise returns the signed integer sum.
+
+ function Subtract_With_Ovflo_Check (X, Y : Double_Int) return Double_Int;
+ -- Raises Constraint_Error if difference of operands overflows Double_Int,
+ -- otherwise returns the signed integer difference.
+
+ function Multiply_With_Ovflo_Check (X, Y : Double_Int) return Double_Int;
+ pragma Convention (C, Multiply_With_Ovflo_Check);
+ -- Raises Constraint_Error if product of operands overflows Double_Int,
+ -- otherwise returns the signed integer product. Gigi may also call this
+ -- routine directly.
+
+ procedure Scaled_Divide
+ (X, Y, Z : Double_Int;
+ Q, R : out Double_Int;
+ Round : Boolean);
+ -- Performs the division of (X * Y) / Z, storing the quotient in Q
+ -- and the remainder in R. Constraint_Error is raised if Z is zero,
+ -- or if the quotient does not fit in Double_Int. Round indicates if
+ -- the result should be rounded. If Round is False, then Q, R are
+ -- the normal quotient and remainder from a truncating division.
+ -- If Round is True, then Q is the rounded quotient. The remainder
+ -- R is not affected by the setting of the Round flag.
+
+ procedure Double_Divide
+ (X, Y, Z : Double_Int;
+ Q, R : out Double_Int;
+ Round : Boolean);
+ -- Performs the division X / (Y * Z), storing the quotient in Q and
+ -- the remainder in R. Constraint_Error is raised if Y or Z is zero,
+ -- or if the quotient does not fit in Double_Int. Round indicates if the
+ -- result should be rounded. If Round is False, then Q, R are the normal
+ -- quotient and remainder from a truncating division. If Round is True,
+ -- then Q is the rounded quotient. The remainder R is not affected by the
+ -- setting of the Round flag.
+
+end System.Arith_Double;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . A R I T H _ 1 2 8 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Arith_Double;
+
+package body System.Arith_128 is
+
+ subtype Uns128 is Interfaces.Unsigned_128;
+ subtype Uns64 is Interfaces.Unsigned_64;
+
+ use Interfaces;
+
+ package Impl is new Arith_Double (Int128, Uns128, Uns64);
+
+ function Add_With_Ovflo_Check128 (X, Y : Int128) return Int128
+ renames Impl.Add_With_Ovflo_Check;
+
+ function Subtract_With_Ovflo_Check128 (X, Y : Int128) return Int128
+ renames Impl.Subtract_With_Ovflo_Check;
+
+ function Multiply_With_Ovflo_Check128 (X, Y : Int128) return Int128
+ renames Impl.Multiply_With_Ovflo_Check;
+
+ procedure Scaled_Divide128
+ (X, Y, Z : Int128;
+ Q, R : out Int128;
+ Round : Boolean)
+ renames Impl.Scaled_Divide;
+
+ procedure Double_Divide128
+ (X, Y, Z : Int128;
+ Q, R : out Int128;
+ Round : Boolean)
+ renames Impl.Double_Divide;
+
+end System.Arith_128;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . A R I T H _ 1 2 8 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This unit provides software routines for doing arithmetic on 128-bit
+-- signed integer values in cases where either overflow checking is
+-- required, or intermediate results are longer than 128 bits.
+
+pragma Restrictions (No_Elaboration_Code);
+-- Allow direct call from gigi generated code
+
+with Interfaces;
+
+package System.Arith_128 is
+ pragma Pure;
+
+ subtype Int128 is Interfaces.Integer_128;
+
+ function Add_With_Ovflo_Check128 (X, Y : Int128) return Int128;
+ -- Raises Constraint_Error if sum of operands overflows 128 bits,
+ -- otherwise returns the 128-bit signed integer sum.
+
+ function Subtract_With_Ovflo_Check128 (X, Y : Int128) return Int128;
+ -- Raises Constraint_Error if difference of operands overflows 128
+ -- bits, otherwise returns the 128-bit signed integer difference.
+
+ function Multiply_With_Ovflo_Check128 (X, Y : Int128) return Int128;
+ pragma Export (C, Multiply_With_Ovflo_Check128, "__gnat_mulv128");
+ -- Raises Constraint_Error if product of operands overflows 128
+ -- bits, otherwise returns the 128-bit signed integer product.
+ -- Gigi may also call this routine directly.
+
+ procedure Scaled_Divide128
+ (X, Y, Z : Int128;
+ Q, R : out Int128;
+ Round : Boolean);
+ -- Performs the division of (X * Y) / Z, storing the quotient in Q
+ -- and the remainder in R. Constraint_Error is raised if Z is zero,
+ -- or if the quotient does not fit in 128 bits. Round indicates if
+ -- the result should be rounded. If Round is False, then Q, R are
+ -- the normal quotient and remainder from a truncating division.
+ -- If Round is True, then Q is the rounded quotient. The remainder
+ -- R is not affected by the setting of the Round flag.
+
+ procedure Double_Divide128
+ (X, Y, Z : Int128;
+ Q, R : out Int128;
+ Round : Boolean);
+ -- Performs the division X / (Y * Z), storing the quotient in Q and
+ -- the remainder in R. Constraint_Error is raised if Y or Z is zero,
+ -- or if the quotient does not fit in 128 bits. Round indicates if the
+ -- result should be rounded. If Round is False, then Q, R are the normal
+ -- quotient and remainder from a truncating division. If Round is True,
+ -- then Q is the rounded quotient. The remainder R is not affected by the
+ -- setting of the Round flag.
+
+end System.Arith_128;
-- --
------------------------------------------------------------------------------
-with Interfaces; use Interfaces;
-
-with Ada.Unchecked_Conversion;
+with System.Arith_Double;
package body System.Arith_64 is
- pragma Suppress (Overflow_Check);
- pragma Suppress (Range_Check);
-
- subtype Uns64 is Unsigned_64;
- function To_Uns is new Ada.Unchecked_Conversion (Int64, Uns64);
- function To_Int is new Ada.Unchecked_Conversion (Uns64, Int64);
-
- subtype Uns32 is Unsigned_32;
-
- -----------------------
- -- Local Subprograms --
- -----------------------
-
- function "+" (A, B : Uns32) return Uns64 is (Uns64 (A) + Uns64 (B));
- function "+" (A : Uns64; B : Uns32) return Uns64 is (A + Uns64 (B));
- -- Length doubling additions
-
- function "*" (A, B : Uns32) return Uns64 is (Uns64 (A) * Uns64 (B));
- -- Length doubling multiplication
-
- function "/" (A : Uns64; B : Uns32) return Uns64 is (A / Uns64 (B));
- -- Length doubling division
-
- function "&" (Hi, Lo : Uns32) return Uns64 is
- (Shift_Left (Uns64 (Hi), 32) or Uns64 (Lo));
- -- Concatenate hi, lo values to form 64-bit result
-
- function "abs" (X : Int64) return Uns64 is
- (if X = Int64'First then 2**63 else Uns64 (Int64'(abs X)));
- -- Convert absolute value of X to unsigned. Note that we can't just use
- -- the expression of the Else, because it overflows for X = Int64'First.
-
- function "rem" (A : Uns64; B : Uns32) return Uns64 is (A rem Uns64 (B));
- -- Length doubling remainder
-
- function Le3 (X1, X2, X3 : Uns32; Y1, Y2, Y3 : Uns32) return Boolean;
- -- Determines if 96 bit value X1&X2&X3 <= Y1&Y2&Y3
-
- function Lo (A : Uns64) return Uns32 is (Uns32 (A and 16#FFFF_FFFF#));
- -- Low order half of 64-bit value
-
- function Hi (A : Uns64) return Uns32 is (Uns32 (Shift_Right (A, 32)));
- -- High order half of 64-bit value
-
- procedure Sub3 (X1, X2, X3 : in out Uns32; Y1, Y2, Y3 : Uns32);
- -- Computes X1&X2&X3 := X1&X2&X3 - Y1&Y1&Y3 with mod 2**96 wrap
-
- function To_Neg_Int (A : Uns64) return Int64 with Inline;
- -- Convert to negative integer equivalent. If the input is in the range
- -- 0 .. 2 ** 63, then the corresponding negative signed integer (obtained
- -- by negating the given value) is returned, otherwise constraint error
- -- is raised.
-
- function To_Pos_Int (A : Uns64) return Int64 with Inline;
- -- Convert to positive integer equivalent. If the input is in the range
- -- 0 .. 2 ** 63-1, then the corresponding non-negative signed integer is
- -- returned, otherwise constraint error is raised.
-
- procedure Raise_Error with Inline;
- pragma No_Return (Raise_Error);
- -- Raise constraint error with appropriate message
-
- --------------------------
- -- Add_With_Ovflo_Check --
- --------------------------
+ subtype Uns64 is Interfaces.Unsigned_64;
+ subtype Uns32 is Interfaces.Unsigned_32;
- function Add_With_Ovflo_Check (X, Y : Int64) return Int64 is
- R : constant Int64 := To_Int (To_Uns (X) + To_Uns (Y));
+ use Interfaces;
- begin
- if X >= 0 then
- if Y < 0 or else R >= 0 then
- return R;
- end if;
+ package Impl is new Arith_Double (Int64, Uns64, Uns32);
- else -- X < 0
- if Y > 0 or else R < 0 then
- return R;
- end if;
- end if;
+ function Add_With_Ovflo_Check64 (X, Y : Int64) return Int64
+ renames Impl.Add_With_Ovflo_Check;
- Raise_Error;
- end Add_With_Ovflo_Check;
+ function Subtract_With_Ovflo_Check64 (X, Y : Int64) return Int64
+ renames Impl.Subtract_With_Ovflo_Check;
- -------------------
- -- Double_Divide --
- -------------------
+ function Multiply_With_Ovflo_Check64 (X, Y : Int64) return Int64
+ renames Impl.Multiply_With_Ovflo_Check;
- procedure Double_Divide
+ procedure Scaled_Divide64
(X, Y, Z : Int64;
Q, R : out Int64;
Round : Boolean)
- is
- Xu : constant Uns64 := abs X;
- Yu : constant Uns64 := abs Y;
-
- Yhi : constant Uns32 := Hi (Yu);
- Ylo : constant Uns32 := Lo (Yu);
-
- Zu : constant Uns64 := abs Z;
- Zhi : constant Uns32 := Hi (Zu);
- Zlo : constant Uns32 := Lo (Zu);
-
- T1, T2 : Uns64;
- Du, Qu, Ru : Uns64;
- Den_Pos : Boolean;
-
- begin
- if Yu = 0 or else Zu = 0 then
- Raise_Error;
- end if;
-
- -- Set final signs (RM 4.5.5(27-30))
-
- Den_Pos := (Y < 0) = (Z < 0);
-
- -- Compute Y * Z. Note that if the result overflows 64 bits unsigned,
- -- then the rounded result is zero, except for the very special case
- -- where X = -2**63 and abs(Y*Z) = 2**64, when Round is True.
-
- if Yhi /= 0 then
- if Zhi /= 0 then
-
- -- Handle the special case when Round is True
-
- if Yhi = 1
- and then Zhi = 1
- and then Ylo = 0
- and then Zlo = 0
- and then X = Int64'First
- and then Round
- then
- Q := (if Den_Pos then -1 else 1);
- else
- Q := 0;
- end if;
-
- R := X;
- return;
- else
- T2 := Yhi * Zlo;
- end if;
-
- else
- T2 := Ylo * Zhi;
- end if;
-
- T1 := Ylo * Zlo;
- T2 := T2 + Hi (T1);
-
- if Hi (T2) /= 0 then
-
- -- Handle the special case when Round is True
-
- if Hi (T2) = 1
- and then Lo (T2) = 0
- and then Lo (T1) = 0
- and then X = Int64'First
- and then Round
- then
- Q := (if Den_Pos then -1 else 1);
- else
- Q := 0;
- end if;
-
- R := X;
- return;
- end if;
+ renames Impl.Scaled_Divide;
- Du := Lo (T2) & Lo (T1);
-
- -- Check overflow case of largest negative number divided by -1
-
- if X = Int64'First and then Du = 1 and then not Den_Pos then
- Raise_Error;
- end if;
-
- -- Perform the actual division
-
- pragma Assert (Du /= 0);
- -- Multiplication of 2-limbs arguments Yu and Zu leads to 4-limbs
- -- result (where each limb is 32bits). Cases where 4 limbs are needed
- -- require Yhi/=0 and Zhi/=0 and lead to early exit. Remaining cases
- -- where 3 limbs are needed correspond to Hi(T2)/=0 and lead to
- -- early exit. Thus at this point result fits in 2 limbs which are
- -- exactly Lo(T2) and Lo(T1), which corresponds to the value of Du.
- -- As the case where one of Yu or Zu is null also led to early exit,
- -- Du/=0 here.
- Qu := Xu / Du;
- Ru := Xu rem Du;
-
- -- Deal with rounding case
-
- if Round and then Ru > (Du - Uns64'(1)) / Uns64'(2) then
- Qu := Qu + Uns64'(1);
- end if;
-
- -- Case of dividend (X) sign positive
-
- if X >= 0 then
- R := To_Int (Ru);
- Q := (if Den_Pos then To_Int (Qu) else -To_Int (Qu));
-
- -- Case of dividend (X) sign negative
-
- -- We perform the unary minus operation on the unsigned value
- -- before conversion to signed, to avoid a possible overflow for
- -- value -2**63, both for computing R and Q.
-
- else
- R := To_Int (-Ru);
- Q := (if Den_Pos then To_Int (-Qu) else To_Int (Qu));
- end if;
- end Double_Divide;
-
- ---------
- -- Le3 --
- ---------
-
- function Le3 (X1, X2, X3 : Uns32; Y1, Y2, Y3 : Uns32) return Boolean is
- begin
- if X1 < Y1 then
- return True;
- elsif X1 > Y1 then
- return False;
- elsif X2 < Y2 then
- return True;
- elsif X2 > Y2 then
- return False;
- else
- return X3 <= Y3;
- end if;
- end Le3;
-
- -------------------------------
- -- Multiply_With_Ovflo_Check --
- -------------------------------
-
- function Multiply_With_Ovflo_Check (X, Y : Int64) return Int64 is
- Xu : constant Uns64 := abs X;
- Xhi : constant Uns32 := Hi (Xu);
- Xlo : constant Uns32 := Lo (Xu);
-
- Yu : constant Uns64 := abs Y;
- Yhi : constant Uns32 := Hi (Yu);
- Ylo : constant Uns32 := Lo (Yu);
-
- T1, T2 : Uns64;
-
- begin
- if Xhi /= 0 then
- if Yhi /= 0 then
- Raise_Error;
- else
- T2 := Xhi * Ylo;
- end if;
-
- elsif Yhi /= 0 then
- T2 := Xlo * Yhi;
-
- else -- Yhi = Xhi = 0
- T2 := 0;
- end if;
-
- -- Here we have T2 set to the contribution to the upper half of the
- -- result from the upper halves of the input values.
-
- T1 := Xlo * Ylo;
- T2 := T2 + Hi (T1);
-
- if Hi (T2) /= 0 then
- Raise_Error;
- end if;
-
- T2 := Lo (T2) & Lo (T1);
-
- if X >= 0 then
- if Y >= 0 then
- return To_Pos_Int (T2);
- pragma Annotate (CodePeer, Intentional, "precondition",
- "Intentional Unsigned->Signed conversion");
- else
- return To_Neg_Int (T2);
- end if;
- else -- X < 0
- if Y < 0 then
- return To_Pos_Int (T2);
- pragma Annotate (CodePeer, Intentional, "precondition",
- "Intentional Unsigned->Signed conversion");
- else
- return To_Neg_Int (T2);
- end if;
- end if;
-
- end Multiply_With_Ovflo_Check;
-
- -----------------
- -- Raise_Error --
- -----------------
-
- procedure Raise_Error is
- begin
- raise Constraint_Error with "64-bit arithmetic overflow";
- end Raise_Error;
-
- -------------------
- -- Scaled_Divide --
- -------------------
-
- procedure Scaled_Divide
+ procedure Double_Divide64
(X, Y, Z : Int64;
Q, R : out Int64;
Round : Boolean)
- is
- Xu : constant Uns64 := abs X;
- Xhi : constant Uns32 := Hi (Xu);
- Xlo : constant Uns32 := Lo (Xu);
-
- Yu : constant Uns64 := abs Y;
- Yhi : constant Uns32 := Hi (Yu);
- Ylo : constant Uns32 := Lo (Yu);
-
- Zu : Uns64 := abs Z;
- Zhi : Uns32 := Hi (Zu);
- Zlo : Uns32 := Lo (Zu);
-
- D : array (1 .. 4) of Uns32;
- -- The dividend, four digits (D(1) is high order)
-
- Qd : array (1 .. 2) of Uns32;
- -- The quotient digits, two digits (Qd(1) is high order)
-
- S1, S2, S3 : Uns32;
- -- Value to subtract, three digits (S1 is high order)
-
- Qu : Uns64;
- Ru : Uns64;
- -- Unsigned quotient and remainder
-
- Scale : Natural;
- -- Scaling factor used for multiple-precision divide. Dividend and
- -- Divisor are multiplied by 2 ** Scale, and the final remainder is
- -- divided by the scaling factor. The reason for this scaling is to
- -- allow more accurate estimation of quotient digits.
-
- T1, T2, T3 : Uns64;
- -- Temporary values
-
- begin
- -- First do the multiplication, giving the four digit dividend
-
- T1 := Xlo * Ylo;
- D (4) := Lo (T1);
- D (3) := Hi (T1);
-
- if Yhi /= 0 then
- T1 := Xlo * Yhi;
- T2 := D (3) + Lo (T1);
- D (3) := Lo (T2);
- D (2) := Hi (T1) + Hi (T2);
-
- if Xhi /= 0 then
- T1 := Xhi * Ylo;
- T2 := D (3) + Lo (T1);
- D (3) := Lo (T2);
- T3 := D (2) + Hi (T1);
- T3 := T3 + Hi (T2);
- D (2) := Lo (T3);
- D (1) := Hi (T3);
-
- T1 := (D (1) & D (2)) + Uns64'(Xhi * Yhi);
- D (1) := Hi (T1);
- D (2) := Lo (T1);
-
- else
- D (1) := 0;
- end if;
-
- else
- if Xhi /= 0 then
- T1 := Xhi * Ylo;
- T2 := D (3) + Lo (T1);
- D (3) := Lo (T2);
- D (2) := Hi (T1) + Hi (T2);
-
- else
- D (2) := 0;
- end if;
-
- D (1) := 0;
- end if;
-
- -- Now it is time for the dreaded multiple precision division. First an
- -- easy case, check for the simple case of a one digit divisor.
-
- if Zhi = 0 then
- if D (1) /= 0 or else D (2) >= Zlo then
- Raise_Error;
-
- -- Here we are dividing at most three digits by one digit
-
- else
- T1 := D (2) & D (3);
- T2 := Lo (T1 rem Zlo) & D (4);
-
- Qu := Lo (T1 / Zlo) & Lo (T2 / Zlo);
- Ru := T2 rem Zlo;
- end if;
-
- -- If divisor is double digit and dividend is too large, raise error
-
- elsif (D (1) & D (2)) >= Zu then
- Raise_Error;
-
- -- This is the complex case where we definitely have a double digit
- -- divisor and a dividend of at least three digits. We use the classical
- -- multiple-precision division algorithm (see section (4.3.1) of Knuth's
- -- "The Art of Computer Programming", Vol. 2 for a description
- -- (algorithm D).
-
- else
- -- First normalize the divisor so that it has the leading bit on.
- -- We do this by finding the appropriate left shift amount.
-
- Scale := 0;
-
- if (Zhi and 16#FFFF0000#) = 0 then
- Scale := 16;
- Zu := Shift_Left (Zu, 16);
- end if;
-
- if (Hi (Zu) and 16#FF00_0000#) = 0 then
- Scale := Scale + 8;
- Zu := Shift_Left (Zu, 8);
- end if;
-
- if (Hi (Zu) and 16#F000_0000#) = 0 then
- Scale := Scale + 4;
- Zu := Shift_Left (Zu, 4);
- end if;
-
- if (Hi (Zu) and 16#C000_0000#) = 0 then
- Scale := Scale + 2;
- Zu := Shift_Left (Zu, 2);
- end if;
-
- if (Hi (Zu) and 16#8000_0000#) = 0 then
- Scale := Scale + 1;
- Zu := Shift_Left (Zu, 1);
- end if;
-
- Zhi := Hi (Zu);
- Zlo := Lo (Zu);
-
- pragma Assert (Zhi /= 0);
- -- Hi(Zu)/=0 before normalization. The sequence of Shift_Left
- -- operations results in the leading bit of Zu being 1 by moving
- -- the leftmost 1-bit in Zu to leading position, thus Zhi=Hi(Zu)/=0
- -- here.
-
- -- Note that when we scale up the dividend, it still fits in four
- -- digits, since we already tested for overflow, and scaling does
- -- not change the invariant that (D (1) & D (2)) < Zu.
-
- T1 := Shift_Left (D (1) & D (2), Scale);
- D (1) := Hi (T1);
- T2 := Shift_Left (0 & D (3), Scale);
- D (2) := Lo (T1) or Hi (T2);
- T3 := Shift_Left (0 & D (4), Scale);
- D (3) := Lo (T2) or Hi (T3);
- D (4) := Lo (T3);
-
- -- Loop to compute quotient digits, runs twice for Qd(1) and Qd(2)
-
- for J in 0 .. 1 loop
-
- -- Compute next quotient digit. We have to divide three digits by
- -- two digits. We estimate the quotient by dividing the leading
- -- two digits by the leading digit. Given the scaling we did above
- -- which ensured the first bit of the divisor is set, this gives
- -- an estimate of the quotient that is at most two too high.
-
- Qd (J + 1) := (if D (J + 1) = Zhi
- then 2 ** 32 - 1
- else Lo ((D (J + 1) & D (J + 2)) / Zhi));
-
- -- Compute amount to subtract
-
- T1 := Qd (J + 1) * Zlo;
- T2 := Qd (J + 1) * Zhi;
- S3 := Lo (T1);
- T1 := Hi (T1) + Lo (T2);
- S2 := Lo (T1);
- S1 := Hi (T1) + Hi (T2);
-
- -- Adjust quotient digit if it was too high
-
- -- We use the version of the algorithm in the 2nd Edition of
- -- "The Art of Computer Programming". This had a bug not
- -- discovered till 1995, see Vol 2 errata:
- -- http://www-cs-faculty.stanford.edu/~uno/err2-2e.ps.gz.
- -- Under rare circumstances the expression in the test could
- -- overflow. This version was further corrected in 2005, see
- -- Vol 2 errata:
- -- http://www-cs-faculty.stanford.edu/~uno/all2-pre.ps.gz.
- -- This implementation is not impacted by these bugs, due to the
- -- use of a word-size comparison done in function Le3 instead of
- -- a comparison on two-word integer quantities in the original
- -- algorithm.
-
- loop
- exit when Le3 (S1, S2, S3, D (J + 1), D (J + 2), D (J + 3));
- Qd (J + 1) := Qd (J + 1) - 1;
- Sub3 (S1, S2, S3, 0, Zhi, Zlo);
- end loop;
-
- -- Now subtract S1&S2&S3 from D1&D2&D3 ready for next step
-
- Sub3 (D (J + 1), D (J + 2), D (J + 3), S1, S2, S3);
- end loop;
-
- -- The two quotient digits are now set, and the remainder of the
- -- scaled division is in D3&D4. To get the remainder for the
- -- original unscaled division, we rescale this dividend.
-
- -- We rescale the divisor as well, to make the proper comparison
- -- for rounding below.
-
- Qu := Qd (1) & Qd (2);
- Ru := Shift_Right (D (3) & D (4), Scale);
- Zu := Shift_Right (Zu, Scale);
- end if;
-
- -- Deal with rounding case
-
- if Round and then Ru > (Zu - Uns64'(1)) / Uns64'(2) then
-
- -- Protect against wrapping around when rounding, by signaling
- -- an overflow when the quotient is too large.
-
- if Qu = Uns64'Last then
- Raise_Error;
- end if;
-
- Qu := Qu + Uns64 (1);
- end if;
-
- -- Set final signs (RM 4.5.5(27-30))
-
- -- Case of dividend (X * Y) sign positive
-
- if (X >= 0 and then Y >= 0) or else (X < 0 and then Y < 0) then
- R := To_Pos_Int (Ru);
- Q := (if Z > 0 then To_Pos_Int (Qu) else To_Neg_Int (Qu));
-
- -- Case of dividend (X * Y) sign negative
-
- else
- R := To_Neg_Int (Ru);
- Q := (if Z > 0 then To_Neg_Int (Qu) else To_Pos_Int (Qu));
- end if;
- end Scaled_Divide;
-
- ----------
- -- Sub3 --
- ----------
-
- procedure Sub3 (X1, X2, X3 : in out Uns32; Y1, Y2, Y3 : Uns32) is
- begin
- if Y3 > X3 then
- if X2 = 0 then
- X1 := X1 - 1;
- end if;
-
- X2 := X2 - 1;
- end if;
-
- X3 := X3 - Y3;
-
- if Y2 > X2 then
- X1 := X1 - 1;
- end if;
-
- X2 := X2 - Y2;
- X1 := X1 - Y1;
- end Sub3;
-
- -------------------------------
- -- Subtract_With_Ovflo_Check --
- -------------------------------
-
- function Subtract_With_Ovflo_Check (X, Y : Int64) return Int64 is
- R : constant Int64 := To_Int (To_Uns (X) - To_Uns (Y));
-
- begin
- if X >= 0 then
- if Y > 0 or else R >= 0 then
- return R;
- end if;
-
- else -- X < 0
- if Y <= 0 or else R < 0 then
- return R;
- end if;
- end if;
-
- Raise_Error;
- end Subtract_With_Ovflo_Check;
-
- ----------------
- -- To_Neg_Int --
- ----------------
-
- function To_Neg_Int (A : Uns64) return Int64 is
- R : constant Int64 := (if A = 2**63 then Int64'First else -To_Int (A));
- -- Note that we can't just use the expression of the Else, because it
- -- overflows for A = 2**63.
- begin
- if R <= 0 then
- return R;
- else
- Raise_Error;
- end if;
- end To_Neg_Int;
-
- ----------------
- -- To_Pos_Int --
- ----------------
-
- function To_Pos_Int (A : Uns64) return Int64 is
- R : constant Int64 := To_Int (A);
- begin
- if R >= 0 then
- return R;
- else
- Raise_Error;
- end if;
- end To_Pos_Int;
+ renames Impl.Double_Divide;
end System.Arith_64;
subtype Int64 is Interfaces.Integer_64;
- function Add_With_Ovflo_Check (X, Y : Int64) return Int64;
+ function Add_With_Ovflo_Check64 (X, Y : Int64) return Int64;
-- Raises Constraint_Error if sum of operands overflows 64 bits,
-- otherwise returns the 64-bit signed integer sum.
- function Subtract_With_Ovflo_Check (X, Y : Int64) return Int64;
+ function Subtract_With_Ovflo_Check64 (X, Y : Int64) return Int64;
-- Raises Constraint_Error if difference of operands overflows 64
-- bits, otherwise returns the 64-bit signed integer difference.
- function Multiply_With_Ovflo_Check (X, Y : Int64) return Int64;
- pragma Export (C, Multiply_With_Ovflo_Check, "__gnat_mulv64");
+ function Multiply_With_Ovflo_Check64 (X, Y : Int64) return Int64;
+ pragma Export (C, Multiply_With_Ovflo_Check64, "__gnat_mulv64");
-- Raises Constraint_Error if product of operands overflows 64
-- bits, otherwise returns the 64-bit signed integer product.
- -- GIGI may also call this routine directly.
+ -- Gigi may also call this routine directly.
- procedure Scaled_Divide
+ procedure Scaled_Divide64
(X, Y, Z : Int64;
Q, R : out Int64;
Round : Boolean);
-- Performs the division of (X * Y) / Z, storing the quotient in Q
-- and the remainder in R. Constraint_Error is raised if Z is zero,
- -- or if the quotient does not fit in 64-bits. Round indicates if
+ -- or if the quotient does not fit in 64 bits. Round indicates if
-- the result should be rounded. If Round is False, then Q, R are
-- the normal quotient and remainder from a truncating division.
-- If Round is True, then Q is the rounded quotient. The remainder
-- R is not affected by the setting of the Round flag.
- procedure Double_Divide
+ procedure Scaled_Divide
+ (X, Y, Z : Int64;
+ Q, R : out Int64;
+ Round : Boolean) renames Scaled_Divide64;
+ -- Renamed procedure to preserve compatibility with earlier versions
+
+ procedure Double_Divide64
(X, Y, Z : Int64;
Q, R : out Int64;
Round : Boolean);
-- Performs the division X / (Y * Z), storing the quotient in Q and
-- the remainder in R. Constraint_Error is raised if Y or Z is zero,
- -- or if the quotient does not fit in 64-bits. Round indicates if the
+ -- or if the quotient does not fit in 64 bits. Round indicates if the
-- result should be rounded. If Round is False, then Q, R are the normal
-- quotient and remainder from a truncating division. If Round is True,
-- then Q is the rounded quotient. The remainder R is not affected by the
-- setting of the Round flag.
+ procedure Double_Divide
+ (X, Y, Z : Int64;
+ Q, R : out Int64;
+ Round : Boolean) renames Double_Divide64;
+ -- Renamed procedure to preserve compatibility with earlier versions
+
end System.Arith_64;
-- (supporting alternative byte ordering), and by the GNAT.Byte_Swapping run
-- time package which provides user level routines for byte swapping.
+with Interfaces;
+
package System.Byte_Swapping is
pragma Pure;
- type U16 is mod 2**16;
- type U32 is mod 2**32;
- type U64 is mod 2**64;
+ subtype U16 is Interfaces.Unsigned_16;
+ subtype U32 is Interfaces.Unsigned_32;
+ subtype U64 is Interfaces.Unsigned_64;
+ subtype U128 is Interfaces.Unsigned_128;
function Bswap_16 (X : U16) return U16;
pragma Import (Intrinsic, Bswap_16, "__builtin_bswap16");
function Bswap_64 (X : U64) return U64;
pragma Import (Intrinsic, Bswap_64, "__builtin_bswap64");
+ function Bswap_128 (X : U128) return U128;
+ pragma Import (Intrinsic, Bswap_128, "__builtin_bswap128");
+
end System.Byte_Swapping;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME LIBRARY COMPONENTS --
+-- --
+-- S Y S T E M . C O M P A R E _ A R R A Y _ S I G N E D _ 1 2 8 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2002-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Address_Operations; use System.Address_Operations;
+
+with Ada.Unchecked_Conversion;
+
+package body System.Compare_Array_Signed_128 is
+
+ type Word is range -2**127 .. 2**127 - 1;
+ for Word'Size use 128;
+ -- Used to process operands by 128-bit words
+
+ type Uword is new Word;
+ for Uword'Alignment use 1;
+ -- Used to process operands when unaligned
+
+ type WP is access Word;
+ type UP is access Uword;
+
+ function W is new Ada.Unchecked_Conversion (Address, WP);
+ function U is new Ada.Unchecked_Conversion (Address, UP);
+
+ ------------------------
+ -- Compare_Array_S128 --
+ ------------------------
+
+ function Compare_Array_S128
+ (Left : System.Address;
+ Right : System.Address;
+ Left_Len : Natural;
+ Right_Len : Natural) return Integer
+ is
+ Clen : Natural := Natural'Min (Left_Len, Right_Len);
+ -- Number of elements left to compare
+
+ L : Address := Left;
+ R : Address := Right;
+ -- Pointers to next elements to compare
+
+ begin
+ -- Case of going by aligned quadruple words
+
+ if ModA (OrA (Left, Right), 16) = 0 then
+ while Clen /= 0 loop
+ if W (L).all /= W (R).all then
+ if W (L).all > W (R).all then
+ return +1;
+ else
+ return -1;
+ end if;
+ end if;
+
+ Clen := Clen - 1;
+ L := AddA (L, 16);
+ R := AddA (R, 16);
+ end loop;
+
+ -- Case of going by unaligned quadruple words
+
+ else
+ while Clen /= 0 loop
+ if U (L).all /= U (R).all then
+ if U (L).all > U (R).all then
+ return +1;
+ else
+ return -1;
+ end if;
+ end if;
+
+ Clen := Clen - 1;
+ L := AddA (L, 16);
+ R := AddA (R, 16);
+ end loop;
+ end if;
+
+ -- Here if common section equal, result decided by lengths
+
+ if Left_Len = Right_Len then
+ return 0;
+ elsif Left_Len > Right_Len then
+ return +1;
+ else
+ return -1;
+ end if;
+ end Compare_Array_S128;
+
+end System.Compare_Array_Signed_128;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME LIBRARY COMPONENTS --
+-- --
+-- S Y S T E M . C O M P A R E _ A R R A Y _ S I G N E D _ 1 2 8 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2002-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package contains functions for runtime comparisons on arrays whose
+-- elements are 128-bit discrete type values to be treated as signed.
+
+package System.Compare_Array_Signed_128 is
+
+ -- Note: although the functions in this package are in a sense Pure, the
+ -- package cannot be declared as Pure, since the arguments are addresses,
+ -- not the data, and the result is not pure wrt the address values.
+
+ function Compare_Array_S128
+ (Left : System.Address;
+ Right : System.Address;
+ Left_Len : Natural;
+ Right_Len : Natural) return Integer;
+ -- Compare the array starting at address Left of length Left_Len
+ -- with the array starting at address Right of length Right_Len.
+ -- The comparison is in the normal Ada semantic sense of array
+ -- comparison. The result is -1,0,+1 for Left<Right, Left=Right,
+ -- Left>Right respectively.
+
+end System.Compare_Array_Signed_128;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME LIBRARY COMPONENTS --
+-- --
+-- S Y S T E M . C O M P A R E _ A R R A Y _ U N S I G N E D _ 1 2 8 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2002-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Address_Operations; use System.Address_Operations;
+
+with Ada.Unchecked_Conversion;
+
+package body System.Compare_Array_Unsigned_128 is
+
+ type Word is mod 2 ** 128;
+ -- Used to process operands by 128-bit words
+
+ type Uword is new Word;
+ for Uword'Alignment use 1;
+ -- Used to process operands when unaligned
+
+ type WP is access Word;
+ type UP is access Uword;
+
+ function W is new Ada.Unchecked_Conversion (Address, WP);
+ function U is new Ada.Unchecked_Conversion (Address, UP);
+
+ ------------------------
+ -- Compare_Array_U128 --
+ ------------------------
+
+ function Compare_Array_U128
+ (Left : System.Address;
+ Right : System.Address;
+ Left_Len : Natural;
+ Right_Len : Natural) return Integer
+ is
+ Clen : Natural := Natural'Min (Left_Len, Right_Len);
+ -- Number of elements left to compare
+
+ L : Address := Left;
+ R : Address := Right;
+ -- Pointers to next elements to compare
+
+ begin
+ -- Case of going by aligned quadruple words
+
+ if ModA (OrA (Left, Right), 16) = 0 then
+ while Clen /= 0 loop
+ if W (L).all /= W (R).all then
+ if W (L).all > W (R).all then
+ return +1;
+ else
+ return -1;
+ end if;
+ end if;
+
+ Clen := Clen - 1;
+ L := AddA (L, 16);
+ R := AddA (R, 16);
+ end loop;
+
+ -- Case of going by unaligned quadruple words
+
+ else
+ while Clen /= 0 loop
+ if U (L).all /= U (R).all then
+ if U (L).all > U (R).all then
+ return +1;
+ else
+ return -1;
+ end if;
+ end if;
+
+ Clen := Clen - 1;
+ L := AddA (L, 16);
+ R := AddA (R, 16);
+ end loop;
+ end if;
+
+ -- Here if common section equal, result decided by lengths
+
+ if Left_Len = Right_Len then
+ return 0;
+ elsif Left_Len > Right_Len then
+ return +1;
+ else
+ return -1;
+ end if;
+ end Compare_Array_U128;
+
+end System.Compare_Array_Unsigned_128;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME LIBRARY COMPONENTS --
+-- --
+-- S Y S T E M . C O M P A R E _ A R R A Y _ U N S I G N E D _ 1 2 8 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2002-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package contains functions for runtime comparisons on arrays whose
+-- elements are 128-bit discrete type values to be treated as unsigned.
+
+package System.Compare_Array_Unsigned_128 is
+
+ -- Note: although the functions in this package are in a sense Pure, the
+ -- package cannot be declared as Pure, since the arguments are addresses,
+ -- not the data, and the result is not pure wrt the address values.
+
+ function Compare_Array_U128
+ (Left : System.Address;
+ Right : System.Address;
+ Left_Len : Natural;
+ Right_Len : Natural) return Integer;
+ -- Compare the array starting at address Left of length Left_Len
+ -- with the array starting at address Right of length Right_Len.
+ -- The comparison is in the normal Ada semantic sense of array
+ -- comparison. The result is -1,0,+1 for Left<Right, Left=Right,
+ -- Left>Right respectively.
+
+end System.Compare_Array_Unsigned_128;
-- --
------------------------------------------------------------------------------
-package body System.Exn_Int is
+-- This package does not require a body, since it is an instantiation. We
+-- provide a dummy file containing a No_Body pragma so that previous versions
+-- of the body (which did exist) will not interfere.
- -----------------
- -- Exn_Integer --
- -----------------
-
- function Exn_Integer (Left : Integer; Right : Natural) return Integer is
- pragma Suppress (Division_Check);
- pragma Suppress (Overflow_Check);
-
- Result : Integer := 1;
- Factor : Integer := Left;
- Exp : Natural := Right;
-
- begin
- -- We use the standard logarithmic approach, Exp gets shifted right
- -- testing successive low order bits and Factor is the value of the
- -- base raised to the next power of 2.
-
- -- Note: it is not worth special casing base values -1, 0, +1 since
- -- the expander does this when the base is a literal, and other cases
- -- will be extremely rare.
-
- if Exp /= 0 then
- loop
- if Exp rem 2 /= 0 then
- Result := Result * Factor;
- end if;
-
- Exp := Exp / 2;
- exit when Exp = 0;
- Factor := Factor * Factor;
- end loop;
- end if;
-
- return Result;
- end Exn_Integer;
-
-end System.Exn_Int;
+pragma No_Body;
-- Integer exponentiation (checks off)
+with System.Exponn;
+
package System.Exn_Int is
- pragma Pure;
- function Exn_Integer (Left : Integer; Right : Natural) return Integer;
+ function Exn_Integer is new Exponn (Integer);
+ pragma Pure_Function (Exn_Integer);
end System.Exn_Int;
-- --
------------------------------------------------------------------------------
-package body System.Exn_LLI is
+-- This package does not require a body, since it is an instantiation. We
+-- provide a dummy file containing a No_Body pragma so that previous versions
+-- of the body (which did exist) will not interfere.
- ---------------------------
- -- Exn_Long_Long_Integer --
- ---------------------------
-
- function Exn_Long_Long_Integer
- (Left : Long_Long_Integer;
- Right : Natural)
- return Long_Long_Integer
- is
- pragma Suppress (Division_Check);
- pragma Suppress (Overflow_Check);
-
- Result : Long_Long_Integer := 1;
- Factor : Long_Long_Integer := Left;
- Exp : Natural := Right;
-
- begin
- -- We use the standard logarithmic approach, Exp gets shifted right
- -- testing successive low order bits and Factor is the value of the
- -- base raised to the next power of 2.
-
- -- Note: it is not worth special casing base values -1, 0, +1 since
- -- the expander does this when the base is a literal, and other cases
- -- will be extremely rare.
-
- if Exp /= 0 then
- loop
- if Exp rem 2 /= 0 then
- Result := Result * Factor;
- end if;
-
- Exp := Exp / 2;
- exit when Exp = 0;
- Factor := Factor * Factor;
- end loop;
- end if;
-
- return Result;
- end Exn_Long_Long_Integer;
-
-end System.Exn_LLI;
+pragma No_Body;
-- Long_Long_Integer exponentiation (checks off)
+with System.Exponn;
+
package System.Exn_LLI is
- pragma Pure;
- function Exn_Long_Long_Integer
- (Left : Long_Long_Integer;
- Right : Natural)
- return Long_Long_Integer;
+ function Exn_Long_Long_Integer is new Exponn (Long_Long_Integer);
+ pragma Pure_Function (Exn_Long_Long_Integer);
end System.Exn_LLI;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . E X N _ L L L I --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Long_Long_Long_Integer exponentiation (checks off)
+
+with System.Exponn;
+
+package System.Exn_LLLI is
+
+ function Exn_Long_Long_Long_Integer is new Exponn (Long_Long_Long_Integer);
+ pragma Pure_Function (Exn_Long_Long_Long_Integer);
+
+end System.Exn_LLLI;
-- --
------------------------------------------------------------------------------
-package body System.Exp_Int is
+-- This package does not require a body, since it is an instantiation. We
+-- provide a dummy file containing a No_Body pragma so that previous versions
+-- of the body (which did exist) will not interfere.
- -----------------
- -- Exp_Integer --
- -----------------
-
- -- Note that negative exponents get a constraint error because the
- -- subtype of the Right argument (the exponent) is Natural.
-
- function Exp_Integer
- (Left : Integer;
- Right : Natural)
- return Integer
- is
- Result : Integer := 1;
- Factor : Integer := Left;
- Exp : Natural := Right;
-
- begin
- -- We use the standard logarithmic approach, Exp gets shifted right
- -- testing successive low order bits and Factor is the value of the
- -- base raised to the next power of 2.
-
- -- Note: it is not worth special casing base values -1, 0, +1 since
- -- the expander does this when the base is a literal, and other cases
- -- will be extremely rare.
-
- if Exp /= 0 then
- loop
- if Exp rem 2 /= 0 then
- declare
- pragma Unsuppress (All_Checks);
- begin
- Result := Result * Factor;
- end;
- end if;
-
- Exp := Exp / 2;
- exit when Exp = 0;
-
- declare
- pragma Unsuppress (All_Checks);
- begin
- Factor := Factor * Factor;
- end;
- end loop;
- end if;
-
- return Result;
- end Exp_Integer;
-
-end System.Exp_Int;
+pragma No_Body;
-- Integer exponentiation (checks on)
+with System.Expont;
+
package System.Exp_Int is
- pragma Pure;
- function Exp_Integer
- (Left : Integer;
- Right : Natural)
- return Integer;
+ function Exp_Integer is new Expont (Integer);
+ pragma Pure_Function (Exp_Integer);
end System.Exp_Int;
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
--- S Y S T E M . E X P L L I --
+-- S Y S T E M . E X P _ L L I --
-- --
-- B o d y --
-- --
-- --
------------------------------------------------------------------------------
-package body System.Exp_LLI is
+-- This package does not require a body, since it is an instantiation. We
+-- provide a dummy file containing a No_Body pragma so that previous versions
+-- of the body (which did exist) will not interfere.
- ---------------------------
- -- Exp_Long_Long_Integer --
- ---------------------------
-
- -- Note that negative exponents get a constraint error because the
- -- subtype of the Right argument (the exponent) is Natural.
-
- function Exp_Long_Long_Integer
- (Left : Long_Long_Integer;
- Right : Natural)
- return Long_Long_Integer
- is
- Result : Long_Long_Integer := 1;
- Factor : Long_Long_Integer := Left;
- Exp : Natural := Right;
-
- begin
- -- We use the standard logarithmic approach, Exp gets shifted right
- -- testing successive low order bits and Factor is the value of the
- -- base raised to the next power of 2.
-
- -- Note: it is not worth special casing base values -1, 0, +1 since
- -- the expander does this when the base is a literal, and other cases
- -- will be extremely rare.
-
- if Exp /= 0 then
- loop
- if Exp rem 2 /= 0 then
- declare
- pragma Unsuppress (All_Checks);
- begin
- Result := Result * Factor;
- end;
- end if;
-
- Exp := Exp / 2;
- exit when Exp = 0;
-
- declare
- pragma Unsuppress (All_Checks);
- begin
- Factor := Factor * Factor;
- end;
- end loop;
- end if;
-
- return Result;
- end Exp_Long_Long_Integer;
-
-end System.Exp_LLI;
+pragma No_Body;
-- --
------------------------------------------------------------------------------
--- Long_Long_Integer exponentiation
+-- Long_Long_Integer exponentiation (checks on)
+
+with System.Expont;
package System.Exp_LLI is
- pragma Pure;
- function Exp_Long_Long_Integer
- (Left : Long_Long_Integer;
- Right : Natural)
- return Long_Long_Integer;
+ function Exp_Long_Long_Integer is new Expont (Long_Long_Integer);
+ pragma Pure_Function (Exp_Long_Long_Integer);
end System.Exp_LLI;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . E X P _ L L L I --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Long_Long_Long_Integer exponentiation (checks on)
+
+with System.Expont;
+
+package System.Exp_LLLI is
+
+ function Exp_Long_Long_Long_Integer is new Expont (Long_Long_Long_Integer);
+ pragma Pure_Function (Exp_Long_Long_Long_Integer);
+
+end System.Exp_LLLI;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . E X P _ L L L U --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This function performs exponentiation of unsigned types with binary modulus
+-- values exceeding that of System.Unsigned_Types.Long_Long_Unsigned.
+-- The result is always full width, the caller must do a masking operation if
+-- the modulus is less than 2 ** Long_Long_Long_Unsigned'Size.
+
+with System.Exponu;
+with System.Unsigned_Types;
+
+package System.Exp_LLLU is
+
+ subtype Long_Long_Long_Unsigned is Unsigned_Types.Long_Long_Long_Unsigned;
+
+ function Exp_Long_Long_Long_Unsigned is
+ new Exponu (Long_Long_Long_Unsigned);
+ pragma Pure_Function (Exp_Long_Long_Long_Unsigned);
+
+end System.Exp_LLLU;
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
--- S Y S T E M . X P _ B M L --
+-- S Y S T E M . E X P _ L L U --
-- --
-- B o d y --
-- --
-- --
------------------------------------------------------------------------------
-with System.Unsigned_Types; use System.Unsigned_Types;
+-- This package does not require a body, since it is an instantiation. We
+-- provide a dummy file containing a No_Body pragma so that previous versions
+-- of the body (which did exist) will not interfere.
-package body System.Exp_LLU is
-
- ----------------------------
- -- Exp_Long_Long_Unsigned --
- ----------------------------
-
- function Exp_Long_Long_Unsigned
- (Left : Long_Long_Unsigned;
- Right : Natural)
- return Long_Long_Unsigned
- is
- Result : Long_Long_Unsigned := 1;
- Factor : Long_Long_Unsigned := Left;
- Exp : Natural := Right;
-
- begin
- -- We use the standard logarithmic approach, Exp gets shifted right
- -- testing successive low order bits and Factor is the value of the
- -- base raised to the next power of 2.
-
- -- Note: it is not worth special casing the cases of base values -1,0,+1
- -- since the expander does this when the base is a literal, and other
- -- cases will be extremely rare.
-
- if Exp /= 0 then
- loop
- if Exp rem 2 /= 0 then
- Result := Result * Factor;
- end if;
-
- Exp := Exp / 2;
- exit when Exp = 0;
- Factor := Factor * Factor;
- end loop;
- end if;
-
- return Result;
-
- end Exp_Long_Long_Unsigned;
-
-end System.Exp_LLU;
+pragma No_Body;
-- --
------------------------------------------------------------------------------
--- This function performs exponentiation of unsigned types (with binary
--- modulus values exceeding that of Unsigned_Types.Unsigned). The result
--- is always full width, the caller must do a masking operation if the
--- modulus is less than 2 ** (Long_Long_Unsigned'Size).
+-- This function performs exponentiation of unsigned types with binary modulus
+-- values exceeding that of System.Unsigned_Types.Unsigned.
+-- The result is always full width, the caller must do a masking operation if
+-- the modulus is less than 2 ** Long_Long_Unsigned'Size.
+with System.Exponu;
with System.Unsigned_Types;
package System.Exp_LLU is
- pragma Pure;
- function Exp_Long_Long_Unsigned
- (Left : System.Unsigned_Types.Long_Long_Unsigned;
- Right : Natural)
- return System.Unsigned_Types.Long_Long_Unsigned;
+ subtype Long_Long_Unsigned is Unsigned_Types.Long_Long_Unsigned;
+
+ function Exp_Long_Long_Unsigned is new Exponu (Long_Long_Unsigned);
+ pragma Pure_Function (Exp_Long_Long_Unsigned);
end System.Exp_LLU;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . E X P O N N --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+function System.Exponn (Left : Int; Right : Natural) return Int is
+
+ -- Note that negative exponents get a constraint error because the
+ -- subtype of the Right argument (the exponent) is Natural.
+
+ Result : Int := 1;
+ Factor : Int := Left;
+ Exp : Natural := Right;
+
+begin
+ -- We use the standard logarithmic approach, Exp gets shifted right
+ -- testing successive low order bits and Factor is the value of the
+ -- base raised to the next power of 2.
+
+ -- Note: it is not worth special casing base values -1, 0, +1 since
+ -- the expander does this when the base is a literal, and other cases
+ -- will be extremely rare.
+
+ if Exp /= 0 then
+ loop
+ if Exp rem 2 /= 0 then
+ declare
+ pragma Suppress (Overflow_Check);
+ begin
+ Result := Result * Factor;
+ end;
+ end if;
+
+ Exp := Exp / 2;
+ exit when Exp = 0;
+
+ declare
+ pragma Suppress (Overflow_Check);
+ begin
+ Factor := Factor * Factor;
+ end;
+ end loop;
+ end if;
+
+ return Result;
+end System.Exponn;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . E X P O N N --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Signed integer exponentiation (checks off)
+
+generic
+
+ type Int is range <>;
+
+function System.Exponn (Left : Int; Right : Natural) return Int;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . E X P O N T --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+function System.Expont (Left : Int; Right : Natural) return Int is
+
+ -- Note that negative exponents get a constraint error because the
+ -- subtype of the Right argument (the exponent) is Natural.
+
+ Result : Int := 1;
+ Factor : Int := Left;
+ Exp : Natural := Right;
+
+begin
+ -- We use the standard logarithmic approach, Exp gets shifted right
+ -- testing successive low order bits and Factor is the value of the
+ -- base raised to the next power of 2.
+
+ -- Note: it is not worth special casing base values -1, 0, +1 since
+ -- the expander does this when the base is a literal, and other cases
+ -- will be extremely rare.
+
+ if Exp /= 0 then
+ loop
+ if Exp rem 2 /= 0 then
+ declare
+ pragma Unsuppress (Overflow_Check);
+ begin
+ Result := Result * Factor;
+ end;
+ end if;
+
+ Exp := Exp / 2;
+ exit when Exp = 0;
+
+ declare
+ pragma Unsuppress (Overflow_Check);
+ begin
+ Factor := Factor * Factor;
+ end;
+ end loop;
+ end if;
+
+ return Result;
+end System.Expont;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . E X P O N T --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Signed integer exponentiation (checks on)
+
+generic
+
+ type Int is range <>;
+
+function System.Expont (Left : Int; Right : Natural) return Int;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . E X P O N U --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+function System.Exponu (Left : Int; Right : Natural) return Int is
+
+ -- Note that negative exponents get a constraint error because the
+ -- subtype of the Right argument (the exponent) is Natural.
+
+ Result : Int := 1;
+ Factor : Int := Left;
+ Exp : Natural := Right;
+
+begin
+ -- We use the standard logarithmic approach, Exp gets shifted right
+ -- testing successive low order bits and Factor is the value of the
+ -- base raised to the next power of 2.
+
+ -- Note: it is not worth special casing base values -1, 0, +1 since
+ -- the expander does this when the base is a literal, and other cases
+ -- will be extremely rare.
+
+ if Exp /= 0 then
+ loop
+ if Exp rem 2 /= 0 then
+ Result := Result * Factor;
+ end if;
+
+ Exp := Exp / 2;
+ exit when Exp = 0;
+ Factor := Factor * Factor;
+ end loop;
+ end if;
+
+ return Result;
+end System.Exponu;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . E X P O N U --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Modular integer exponentiation
+
+generic
+
+ type Int is mod <>;
+
+function System.Exponu (Left : Int; Right : Natural) return Int;
-- --
------------------------------------------------------------------------------
-with System.Unsigned_Types; use System.Unsigned_Types;
+-- This package does not require a body, since it is an instantiation. We
+-- provide a dummy file containing a No_Body pragma so that previous versions
+-- of the body (which did exist) will not interfere.
-package body System.Exp_Uns is
-
- ------------------
- -- Exp_Unsigned --
- ------------------
-
- function Exp_Unsigned
- (Left : Unsigned;
- Right : Natural)
- return Unsigned
- is
- Result : Unsigned := 1;
- Factor : Unsigned := Left;
- Exp : Natural := Right;
-
- begin
- -- We use the standard logarithmic approach, Exp gets shifted right
- -- testing successive low order bits and Factor is the value of the
- -- base raised to the next power of 2.
-
- -- Note: it is not worth special casing the cases of base values -1,0,+1
- -- since the expander does this when the base is a literal, and other
- -- cases will be extremely rare.
-
- if Exp /= 0 then
- loop
- if Exp rem 2 /= 0 then
- Result := Result * Factor;
- end if;
-
- Exp := Exp / 2;
- exit when Exp = 0;
- Factor := Factor * Factor;
- end loop;
- end if;
-
- return Result;
- end Exp_Unsigned;
-
-end System.Exp_Uns;
+pragma No_Body;
-- --
------------------------------------------------------------------------------
--- This function performs exponentiation of unsigned types (with binary
--- modulus values up to and including that of Unsigned_Types.Unsigned).
--- The result is always full width, the caller must do a masking operation
--- the modulus is less than 2 ** (Unsigned'Size).
+-- This function performs exponentiation of unsigned types with binary modulus
+-- values up to and including that of System.Unsigned_Types.Unsigned.
+-- The result is always full width, the caller must do a masking operation if
+-- the modulus is less than 2 ** Unsigned'Size.
+with System.Exponu;
with System.Unsigned_Types;
package System.Exp_Uns is
- pragma Pure;
- function Exp_Unsigned
- (Left : System.Unsigned_Types.Unsigned;
- Right : Natural)
- return System.Unsigned_Types.Unsigned;
+ subtype Unsigned is Unsigned_Types.Unsigned;
+
+ function Exp_Unsigned is new Exponu (Unsigned);
+ pragma Pure_Function (Exp_Unsigned);
end System.Exp_Uns;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 0 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_100 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_100;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_100 or SetU_100 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_100 --
+ ------------
+
+ function Get_100
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_100
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_100;
+
+ -------------
+ -- GetU_100 --
+ -------------
+
+ function GetU_100
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_100
+ 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
+ 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_100;
+
+ ------------
+ -- Set_100 --
+ ------------
+
+ procedure Set_100
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_100;
+ 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
+ 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_100;
+
+ -------------
+ -- SetU_100 --
+ -------------
+
+ procedure SetU_100
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_100;
+ 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
+ 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_100;
+
+end System.Pack_100;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 0 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 100
+
+package System.Pack_100 is
+ pragma Preelaborate;
+
+ Bits : constant := 100;
+
+ type Bits_100 is mod 2 ** Bits;
+ for Bits_100'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_100
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_100 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_100
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_100;
+ 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_100
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_100 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_100
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_100;
+ 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
+
+end System.Pack_100;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 1 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_101 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_101;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_101 --
+ ------------
+
+ function Get_101
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_101
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_101;
+
+ ------------
+ -- Set_101 --
+ ------------
+
+ procedure Set_101
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_101;
+ 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
+ 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_101;
+
+end System.Pack_101;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 1 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 101
+
+package System.Pack_101 is
+ pragma Preelaborate;
+
+ Bits : constant := 101;
+
+ type Bits_101 is mod 2 ** Bits;
+ for Bits_101'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_101
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_101 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_101
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_101;
+ 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.
+
+end System.Pack_101;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 2 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_102 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_102;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_102 or SetU_102 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_102 --
+ ------------
+
+ function Get_102
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_102
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_102;
+
+ -------------
+ -- GetU_102 --
+ -------------
+
+ function GetU_102
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_102
+ 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
+ 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_102;
+
+ ------------
+ -- Set_102 --
+ ------------
+
+ procedure Set_102
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_102;
+ 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
+ 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_102;
+
+ -------------
+ -- SetU_102 --
+ -------------
+
+ procedure SetU_102
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_102;
+ 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
+ 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_102;
+
+end System.Pack_102;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 2 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 102
+
+package System.Pack_102 is
+ pragma Preelaborate;
+
+ Bits : constant := 102;
+
+ type Bits_102 is mod 2 ** Bits;
+ for Bits_102'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_102
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_102 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_102
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_102;
+ 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_102
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_102 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_102
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_102;
+ 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
+
+end System.Pack_102;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 3 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_103 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_103;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_103 --
+ ------------
+
+ function Get_103
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_103
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_103;
+
+ ------------
+ -- Set_103 --
+ ------------
+
+ procedure Set_103
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_103;
+ 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
+ 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_103;
+
+end System.Pack_103;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 3 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 103
+
+package System.Pack_103 is
+ pragma Preelaborate;
+
+ Bits : constant := 103;
+
+ type Bits_103 is mod 2 ** Bits;
+ for Bits_103'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_103
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_103 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_103
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_103;
+ 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.
+
+end System.Pack_103;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 4 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_104 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_104;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_104 or SetU_104 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_104 --
+ ------------
+
+ function Get_104
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_104
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_104;
+
+ -------------
+ -- GetU_104 --
+ -------------
+
+ function GetU_104
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_104
+ 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
+ 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_104;
+
+ ------------
+ -- Set_104 --
+ ------------
+
+ procedure Set_104
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_104;
+ 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
+ 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_104;
+
+ -------------
+ -- SetU_104 --
+ -------------
+
+ procedure SetU_104
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_104;
+ 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
+ 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_104;
+
+end System.Pack_104;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 4 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 104
+
+package System.Pack_104 is
+ pragma Preelaborate;
+
+ Bits : constant := 104;
+
+ type Bits_104 is mod 2 ** Bits;
+ for Bits_104'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_104
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_104 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_104
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_104;
+ 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_104
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_104 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_104
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_104;
+ 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
+
+end System.Pack_104;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 5 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_105 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_105;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_105 --
+ ------------
+
+ function Get_105
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_105
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_105;
+
+ ------------
+ -- Set_105 --
+ ------------
+
+ procedure Set_105
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_105;
+ 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
+ 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_105;
+
+end System.Pack_105;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 5 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 105
+
+package System.Pack_105 is
+ pragma Preelaborate;
+
+ Bits : constant := 105;
+
+ type Bits_105 is mod 2 ** Bits;
+ for Bits_105'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_105
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_105 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_105
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_105;
+ 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.
+
+end System.Pack_105;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 6 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_106 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_106;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_106 or SetU_106 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_106 --
+ ------------
+
+ function Get_106
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_106
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_106;
+
+ -------------
+ -- GetU_106 --
+ -------------
+
+ function GetU_106
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_106
+ 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
+ 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_106;
+
+ ------------
+ -- Set_106 --
+ ------------
+
+ procedure Set_106
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_106;
+ 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
+ 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_106;
+
+ -------------
+ -- SetU_106 --
+ -------------
+
+ procedure SetU_106
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_106;
+ 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
+ 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_106;
+
+end System.Pack_106;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 6 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 106
+
+package System.Pack_106 is
+ pragma Preelaborate;
+
+ Bits : constant := 106;
+
+ type Bits_106 is mod 2 ** Bits;
+ for Bits_106'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_106
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_106 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_106
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_106;
+ 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_106
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_106 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_106
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_106;
+ 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
+
+end System.Pack_106;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 7 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_107 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_107;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_107 --
+ ------------
+
+ function Get_107
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_107
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_107;
+
+ ------------
+ -- Set_107 --
+ ------------
+
+ procedure Set_107
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_107;
+ 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
+ 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_107;
+
+end System.Pack_107;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 7 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 107
+
+package System.Pack_107 is
+ pragma Preelaborate;
+
+ Bits : constant := 107;
+
+ type Bits_107 is mod 2 ** Bits;
+ for Bits_107'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_107
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_107 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_107
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_107;
+ 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.
+
+end System.Pack_107;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 8 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_108 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_108;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_108 or SetU_108 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_108 --
+ ------------
+
+ function Get_108
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_108
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_108;
+
+ -------------
+ -- GetU_108 --
+ -------------
+
+ function GetU_108
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_108
+ 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
+ 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_108;
+
+ ------------
+ -- Set_108 --
+ ------------
+
+ procedure Set_108
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_108;
+ 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
+ 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_108;
+
+ -------------
+ -- SetU_108 --
+ -------------
+
+ procedure SetU_108
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_108;
+ 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
+ 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_108;
+
+end System.Pack_108;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 8 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 108
+
+package System.Pack_108 is
+ pragma Preelaborate;
+
+ Bits : constant := 108;
+
+ type Bits_108 is mod 2 ** Bits;
+ for Bits_108'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_108
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_108 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_108
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_108;
+ 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_108
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_108 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_108
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_108;
+ 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
+
+end System.Pack_108;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 9 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_109 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_109;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_109 --
+ ------------
+
+ function Get_109
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_109
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_109;
+
+ ------------
+ -- Set_109 --
+ ------------
+
+ procedure Set_109
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_109;
+ 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
+ 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_109;
+
+end System.Pack_109;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 0 9 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 109
+
+package System.Pack_109 is
+ pragma Preelaborate;
+
+ Bits : constant := 109;
+
+ type Bits_109 is mod 2 ** Bits;
+ for Bits_109'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_109
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_109 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_109
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_109;
+ 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.
+
+end System.Pack_109;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 0 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_110 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_110;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_110 or SetU_110 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_110 --
+ ------------
+
+ function Get_110
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_110
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_110;
+
+ -------------
+ -- GetU_110 --
+ -------------
+
+ function GetU_110
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_110
+ 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
+ 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_110;
+
+ ------------
+ -- Set_110 --
+ ------------
+
+ procedure Set_110
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_110;
+ 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
+ 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_110;
+
+ -------------
+ -- SetU_110 --
+ -------------
+
+ procedure SetU_110
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_110;
+ 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
+ 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_110;
+
+end System.Pack_110;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 0 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 110
+
+package System.Pack_110 is
+ pragma Preelaborate;
+
+ Bits : constant := 110;
+
+ type Bits_110 is mod 2 ** Bits;
+ for Bits_110'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_110
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_110 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_110
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_110;
+ 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_110
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_110 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_110
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_110;
+ 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
+
+end System.Pack_110;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 1 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_111 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_111;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_111 --
+ ------------
+
+ function Get_111
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_111
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_111;
+
+ ------------
+ -- Set_111 --
+ ------------
+
+ procedure Set_111
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_111;
+ 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
+ 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_111;
+
+end System.Pack_111;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 1 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 111
+
+package System.Pack_111 is
+ pragma Preelaborate;
+
+ Bits : constant := 111;
+
+ type Bits_111 is mod 2 ** Bits;
+ for Bits_111'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_111
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_111 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_111
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_111;
+ 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.
+
+end System.Pack_111;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 2 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_112 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_112;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_112 or SetU_112 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_112 --
+ ------------
+
+ function Get_112
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_112
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_112;
+
+ -------------
+ -- GetU_112 --
+ -------------
+
+ function GetU_112
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_112
+ 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
+ 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_112;
+
+ ------------
+ -- Set_112 --
+ ------------
+
+ procedure Set_112
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_112;
+ 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
+ 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_112;
+
+ -------------
+ -- SetU_112 --
+ -------------
+
+ procedure SetU_112
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_112;
+ 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
+ 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_112;
+
+end System.Pack_112;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 2 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 112
+
+package System.Pack_112 is
+ pragma Preelaborate;
+
+ Bits : constant := 112;
+
+ type Bits_112 is mod 2 ** Bits;
+ for Bits_112'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_112
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_112 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_112
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_112;
+ 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_112
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_112 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_112
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_112;
+ 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
+
+end System.Pack_112;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 3 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_113 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_113;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_113 --
+ ------------
+
+ function Get_113
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_113
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_113;
+
+ ------------
+ -- Set_113 --
+ ------------
+
+ procedure Set_113
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_113;
+ 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
+ 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_113;
+
+end System.Pack_113;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 3 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 113
+
+package System.Pack_113 is
+ pragma Preelaborate;
+
+ Bits : constant := 113;
+
+ type Bits_113 is mod 2 ** Bits;
+ for Bits_113'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_113
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_113 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_113
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_113;
+ 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.
+
+end System.Pack_113;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 4 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_114 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_114;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_114 or SetU_114 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_114 --
+ ------------
+
+ function Get_114
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_114
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_114;
+
+ -------------
+ -- GetU_114 --
+ -------------
+
+ function GetU_114
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_114
+ 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
+ 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_114;
+
+ ------------
+ -- Set_114 --
+ ------------
+
+ procedure Set_114
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_114;
+ 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
+ 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_114;
+
+ -------------
+ -- SetU_114 --
+ -------------
+
+ procedure SetU_114
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_114;
+ 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
+ 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_114;
+
+end System.Pack_114;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 4 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 114
+
+package System.Pack_114 is
+ pragma Preelaborate;
+
+ Bits : constant := 114;
+
+ type Bits_114 is mod 2 ** Bits;
+ for Bits_114'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_114
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_114 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_114
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_114;
+ 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_114
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_114 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_114
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_114;
+ 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
+
+end System.Pack_114;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 5 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_115 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_115;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_115 --
+ ------------
+
+ function Get_115
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_115
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_115;
+
+ ------------
+ -- Set_115 --
+ ------------
+
+ procedure Set_115
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_115;
+ 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
+ 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_115;
+
+end System.Pack_115;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 5 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 115
+
+package System.Pack_115 is
+ pragma Preelaborate;
+
+ Bits : constant := 115;
+
+ type Bits_115 is mod 2 ** Bits;
+ for Bits_115'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_115
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_115 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_115
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_115;
+ 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.
+
+end System.Pack_115;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 6 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_116 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_116;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_116 or SetU_116 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_116 --
+ ------------
+
+ function Get_116
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_116
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_116;
+
+ -------------
+ -- GetU_116 --
+ -------------
+
+ function GetU_116
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_116
+ 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
+ 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_116;
+
+ ------------
+ -- Set_116 --
+ ------------
+
+ procedure Set_116
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_116;
+ 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
+ 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_116;
+
+ -------------
+ -- SetU_116 --
+ -------------
+
+ procedure SetU_116
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_116;
+ 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
+ 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_116;
+
+end System.Pack_116;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 6 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 116
+
+package System.Pack_116 is
+ pragma Preelaborate;
+
+ Bits : constant := 116;
+
+ type Bits_116 is mod 2 ** Bits;
+ for Bits_116'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_116
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_116 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_116
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_116;
+ 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_116
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_116 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_116
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_116;
+ 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
+
+end System.Pack_116;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 7 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_117 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_117;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_117 --
+ ------------
+
+ function Get_117
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_117
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_117;
+
+ ------------
+ -- Set_117 --
+ ------------
+
+ procedure Set_117
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_117;
+ 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
+ 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_117;
+
+end System.Pack_117;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 7 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 117
+
+package System.Pack_117 is
+ pragma Preelaborate;
+
+ Bits : constant := 117;
+
+ type Bits_117 is mod 2 ** Bits;
+ for Bits_117'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_117
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_117 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_117
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_117;
+ 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.
+
+end System.Pack_117;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 8 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_118 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_118;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_118 or SetU_118 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_118 --
+ ------------
+
+ function Get_118
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_118
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_118;
+
+ -------------
+ -- GetU_118 --
+ -------------
+
+ function GetU_118
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_118
+ 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
+ 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_118;
+
+ ------------
+ -- Set_118 --
+ ------------
+
+ procedure Set_118
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_118;
+ 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
+ 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_118;
+
+ -------------
+ -- SetU_118 --
+ -------------
+
+ procedure SetU_118
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_118;
+ 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
+ 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_118;
+
+end System.Pack_118;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 8 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 118
+
+package System.Pack_118 is
+ pragma Preelaborate;
+
+ Bits : constant := 118;
+
+ type Bits_118 is mod 2 ** Bits;
+ for Bits_118'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_118
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_118 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_118
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_118;
+ 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_118
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_118 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_118
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_118;
+ 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
+
+end System.Pack_118;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 9 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_119 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_119;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_119 --
+ ------------
+
+ function Get_119
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_119
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_119;
+
+ ------------
+ -- Set_119 --
+ ------------
+
+ procedure Set_119
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_119;
+ 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
+ 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_119;
+
+end System.Pack_119;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 1 9 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 119
+
+package System.Pack_119 is
+ pragma Preelaborate;
+
+ Bits : constant := 119;
+
+ type Bits_119 is mod 2 ** Bits;
+ for Bits_119'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_119
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_119 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_119
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_119;
+ 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.
+
+end System.Pack_119;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 2 0 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_120 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_120;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_120 or SetU_120 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_120 --
+ ------------
+
+ function Get_120
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_120
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_120;
+
+ -------------
+ -- GetU_120 --
+ -------------
+
+ function GetU_120
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_120
+ 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
+ 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_120;
+
+ ------------
+ -- Set_120 --
+ ------------
+
+ procedure Set_120
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_120;
+ 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
+ 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_120;
+
+ -------------
+ -- SetU_120 --
+ -------------
+
+ procedure SetU_120
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_120;
+ 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
+ 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_120;
+
+end System.Pack_120;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 2 0 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 120
+
+package System.Pack_120 is
+ pragma Preelaborate;
+
+ Bits : constant := 120;
+
+ type Bits_120 is mod 2 ** Bits;
+ for Bits_120'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_120
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_120 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_120
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_120;
+ 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_120
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_120 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_120
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_120;
+ 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
+
+end System.Pack_120;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 2 1 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_121 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_121;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_121 --
+ ------------
+
+ function Get_121
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_121
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_121;
+
+ ------------
+ -- Set_121 --
+ ------------
+
+ procedure Set_121
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_121;
+ 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
+ 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_121;
+
+end System.Pack_121;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 2 1 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 121
+
+package System.Pack_121 is
+ pragma Preelaborate;
+
+ Bits : constant := 121;
+
+ type Bits_121 is mod 2 ** Bits;
+ for Bits_121'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_121
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_121 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_121
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_121;
+ 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.
+
+end System.Pack_121;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 2 2 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_122 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_122;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_122 or SetU_122 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_122 --
+ ------------
+
+ function Get_122
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_122
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_122;
+
+ -------------
+ -- GetU_122 --
+ -------------
+
+ function GetU_122
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_122
+ 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
+ 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_122;
+
+ ------------
+ -- Set_122 --
+ ------------
+
+ procedure Set_122
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_122;
+ 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
+ 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_122;
+
+ -------------
+ -- SetU_122 --
+ -------------
+
+ procedure SetU_122
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_122;
+ 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
+ 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_122;
+
+end System.Pack_122;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 2 2 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 122
+
+package System.Pack_122 is
+ pragma Preelaborate;
+
+ Bits : constant := 122;
+
+ type Bits_122 is mod 2 ** Bits;
+ for Bits_122'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_122
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_122 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_122
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_122;
+ 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_122
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_122 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_122
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_122;
+ 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
+
+end System.Pack_122;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 2 3 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_123 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_123;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_123 --
+ ------------
+
+ function Get_123
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_123
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_123;
+
+ ------------
+ -- Set_123 --
+ ------------
+
+ procedure Set_123
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_123;
+ 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
+ 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_123;
+
+end System.Pack_123;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 2 3 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 123
+
+package System.Pack_123 is
+ pragma Preelaborate;
+
+ Bits : constant := 123;
+
+ type Bits_123 is mod 2 ** Bits;
+ for Bits_123'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_123
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_123 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_123
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_123;
+ 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.
+
+end System.Pack_123;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 2 4 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_124 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_124;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_124 or SetU_124 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_124 --
+ ------------
+
+ function Get_124
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_124
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_124;
+
+ -------------
+ -- GetU_124 --
+ -------------
+
+ function GetU_124
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_124
+ 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
+ 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_124;
+
+ ------------
+ -- Set_124 --
+ ------------
+
+ procedure Set_124
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_124;
+ 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
+ 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_124;
+
+ -------------
+ -- SetU_124 --
+ -------------
+
+ procedure SetU_124
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_124;
+ 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
+ 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_124;
+
+end System.Pack_124;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 2 4 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 124
+
+package System.Pack_124 is
+ pragma Preelaborate;
+
+ Bits : constant := 124;
+
+ type Bits_124 is mod 2 ** Bits;
+ for Bits_124'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_124
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_124 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_124
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_124;
+ 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_124
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_124 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_124
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_124;
+ 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
+
+end System.Pack_124;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 2 5 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_125 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_125;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_125 --
+ ------------
+
+ function Get_125
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_125
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_125;
+
+ ------------
+ -- Set_125 --
+ ------------
+
+ procedure Set_125
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_125;
+ 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
+ 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_125;
+
+end System.Pack_125;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 2 5 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 125
+
+package System.Pack_125 is
+ pragma Preelaborate;
+
+ Bits : constant := 125;
+
+ type Bits_125 is mod 2 ** Bits;
+ for Bits_125'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_125
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_125 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_125
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_125;
+ 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.
+
+end System.Pack_125;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 2 6 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_126 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_126;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_126 or SetU_126 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_126 --
+ ------------
+
+ function Get_126
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_126
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_126;
+
+ -------------
+ -- GetU_126 --
+ -------------
+
+ function GetU_126
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_126
+ 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
+ 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_126;
+
+ ------------
+ -- Set_126 --
+ ------------
+
+ procedure Set_126
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_126;
+ 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
+ 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_126;
+
+ -------------
+ -- SetU_126 --
+ -------------
+
+ procedure SetU_126
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_126;
+ 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
+ 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_126;
+
+end System.Pack_126;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 2 6 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 126
+
+package System.Pack_126 is
+ pragma Preelaborate;
+
+ Bits : constant := 126;
+
+ type Bits_126 is mod 2 ** Bits;
+ for Bits_126'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_126
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_126 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_126
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_126;
+ 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_126
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_126 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_126
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_126;
+ 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
+
+end System.Pack_126;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 2 7 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_127 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_127;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_127 --
+ ------------
+
+ function Get_127
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_127
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_127;
+
+ ------------
+ -- Set_127 --
+ ------------
+
+ procedure Set_127
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_127;
+ 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
+ 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_127;
+
+end System.Pack_127;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 1 2 7 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 127
+
+package System.Pack_127 is
+ pragma Preelaborate;
+
+ Bits : constant := 127;
+
+ type Bits_127 is mod 2 ** Bits;
+ for Bits_127'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_127
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_127 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_127
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_127;
+ 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.
+
+end System.Pack_127;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 6 5 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_65 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_65;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_65 --
+ ------------
+
+ function Get_65
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_65
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_65;
+
+ ------------
+ -- Set_65 --
+ ------------
+
+ procedure Set_65
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_65;
+ 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
+ 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_65;
+
+end System.Pack_65;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 6 5 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 65
+
+package System.Pack_65 is
+ pragma Preelaborate;
+
+ Bits : constant := 65;
+
+ type Bits_65 is mod 2 ** Bits;
+ for Bits_65'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_65
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_65 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_65
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_65;
+ 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.
+
+end System.Pack_65;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 6 6 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_66 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_66;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_66 or SetU_66 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_66 --
+ ------------
+
+ function Get_66
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_66
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_66;
+
+ -------------
+ -- GetU_66 --
+ -------------
+
+ function GetU_66
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_66
+ 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
+ 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_66;
+
+ ------------
+ -- Set_66 --
+ ------------
+
+ procedure Set_66
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_66;
+ 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
+ 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_66;
+
+ -------------
+ -- SetU_66 --
+ -------------
+
+ procedure SetU_66
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_66;
+ 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
+ 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_66;
+
+end System.Pack_66;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 6 6 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 66
+
+package System.Pack_66 is
+ pragma Preelaborate;
+
+ Bits : constant := 66;
+
+ type Bits_66 is mod 2 ** Bits;
+ for Bits_66'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_66
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_66 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_66
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_66;
+ 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_66
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_66 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_66
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_66;
+ 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
+
+end System.Pack_66;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 6 7 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_67 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_67;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_67 --
+ ------------
+
+ function Get_67
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_67
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_67;
+
+ ------------
+ -- Set_67 --
+ ------------
+
+ procedure Set_67
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_67;
+ 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
+ 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_67;
+
+end System.Pack_67;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 6 7 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 67
+
+package System.Pack_67 is
+ pragma Preelaborate;
+
+ Bits : constant := 67;
+
+ type Bits_67 is mod 2 ** Bits;
+ for Bits_67'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_67
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_67 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_67
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_67;
+ 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.
+
+end System.Pack_67;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 6 8 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_68 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_68;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_68 or SetU_68 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_68 --
+ ------------
+
+ function Get_68
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_68
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_68;
+
+ -------------
+ -- GetU_68 --
+ -------------
+
+ function GetU_68
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_68
+ 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
+ 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_68;
+
+ ------------
+ -- Set_68 --
+ ------------
+
+ procedure Set_68
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_68;
+ 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
+ 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_68;
+
+ -------------
+ -- SetU_68 --
+ -------------
+
+ procedure SetU_68
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_68;
+ 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
+ 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_68;
+
+end System.Pack_68;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 6 8 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 68
+
+package System.Pack_68 is
+ pragma Preelaborate;
+
+ Bits : constant := 68;
+
+ type Bits_68 is mod 2 ** Bits;
+ for Bits_68'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_68
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_68 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_68
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_68;
+ 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_68
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_68 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_68
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_68;
+ 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
+
+end System.Pack_68;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 6 9 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_69 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_69;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_69 --
+ ------------
+
+ function Get_69
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_69
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_69;
+
+ ------------
+ -- Set_69 --
+ ------------
+
+ procedure Set_69
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_69;
+ 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
+ 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_69;
+
+end System.Pack_69;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 6 9 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 69
+
+package System.Pack_69 is
+ pragma Preelaborate;
+
+ Bits : constant := 69;
+
+ type Bits_69 is mod 2 ** Bits;
+ for Bits_69'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_69
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_69 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_69
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_69;
+ 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.
+
+end System.Pack_69;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 0 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_70 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_70;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_70 or SetU_70 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_70 --
+ ------------
+
+ function Get_70
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_70
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_70;
+
+ -------------
+ -- GetU_70 --
+ -------------
+
+ function GetU_70
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_70
+ 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
+ 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_70;
+
+ ------------
+ -- Set_70 --
+ ------------
+
+ procedure Set_70
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_70;
+ 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
+ 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_70;
+
+ -------------
+ -- SetU_70 --
+ -------------
+
+ procedure SetU_70
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_70;
+ 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
+ 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_70;
+
+end System.Pack_70;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 0 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 70
+
+package System.Pack_70 is
+ pragma Preelaborate;
+
+ Bits : constant := 70;
+
+ type Bits_70 is mod 2 ** Bits;
+ for Bits_70'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_70
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_70 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_70
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_70;
+ 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_70
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_70 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_70
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_70;
+ 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
+
+end System.Pack_70;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 1 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_71 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_71;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_71 --
+ ------------
+
+ function Get_71
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_71
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_71;
+
+ ------------
+ -- Set_71 --
+ ------------
+
+ procedure Set_71
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_71;
+ 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
+ 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_71;
+
+end System.Pack_71;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 1 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 71
+
+package System.Pack_71 is
+ pragma Preelaborate;
+
+ Bits : constant := 71;
+
+ type Bits_71 is mod 2 ** Bits;
+ for Bits_71'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_71
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_71 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_71
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_71;
+ 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.
+
+end System.Pack_71;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 2 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_72 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_72;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_72 or SetU_72 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_72 --
+ ------------
+
+ function Get_72
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_72
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_72;
+
+ -------------
+ -- GetU_72 --
+ -------------
+
+ function GetU_72
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_72
+ 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
+ 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_72;
+
+ ------------
+ -- Set_72 --
+ ------------
+
+ procedure Set_72
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_72;
+ 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
+ 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_72;
+
+ -------------
+ -- SetU_72 --
+ -------------
+
+ procedure SetU_72
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_72;
+ 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
+ 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_72;
+
+end System.Pack_72;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 2 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 72
+
+package System.Pack_72 is
+ pragma Preelaborate;
+
+ Bits : constant := 72;
+
+ type Bits_72 is mod 2 ** Bits;
+ for Bits_72'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_72
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_72 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_72
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_72;
+ 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_72
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_72 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_72
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_72;
+ 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
+
+end System.Pack_72;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 3 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_73 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_73;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_73 --
+ ------------
+
+ function Get_73
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_73
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_73;
+
+ ------------
+ -- Set_73 --
+ ------------
+
+ procedure Set_73
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_73;
+ 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
+ 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_73;
+
+end System.Pack_73;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 3 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 73
+
+package System.Pack_73 is
+ pragma Preelaborate;
+
+ Bits : constant := 73;
+
+ type Bits_73 is mod 2 ** Bits;
+ for Bits_73'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_73
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_73 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_73
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_73;
+ 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.
+
+end System.Pack_73;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 4 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_74 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_74;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_74 or SetU_74 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_74 --
+ ------------
+
+ function Get_74
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_74
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_74;
+
+ -------------
+ -- GetU_74 --
+ -------------
+
+ function GetU_74
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_74
+ 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
+ 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_74;
+
+ ------------
+ -- Set_74 --
+ ------------
+
+ procedure Set_74
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_74;
+ 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
+ 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_74;
+
+ -------------
+ -- SetU_74 --
+ -------------
+
+ procedure SetU_74
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_74;
+ 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
+ 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_74;
+
+end System.Pack_74;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 4 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 74
+
+package System.Pack_74 is
+ pragma Preelaborate;
+
+ Bits : constant := 74;
+
+ type Bits_74 is mod 2 ** Bits;
+ for Bits_74'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_74
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_74 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_74
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_74;
+ 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_74
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_74 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_74
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_74;
+ 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
+
+end System.Pack_74;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 5 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_75 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_75;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_75 --
+ ------------
+
+ function Get_75
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_75
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_75;
+
+ ------------
+ -- Set_75 --
+ ------------
+
+ procedure Set_75
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_75;
+ 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
+ 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_75;
+
+end System.Pack_75;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 5 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 75
+
+package System.Pack_75 is
+ pragma Preelaborate;
+
+ Bits : constant := 75;
+
+ type Bits_75 is mod 2 ** Bits;
+ for Bits_75'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_75
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_75 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_75
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_75;
+ 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.
+
+end System.Pack_75;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 6 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_76 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_76;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_76 or SetU_76 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_76 --
+ ------------
+
+ function Get_76
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_76
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_76;
+
+ -------------
+ -- GetU_76 --
+ -------------
+
+ function GetU_76
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_76
+ 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
+ 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_76;
+
+ ------------
+ -- Set_76 --
+ ------------
+
+ procedure Set_76
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_76;
+ 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
+ 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_76;
+
+ -------------
+ -- SetU_76 --
+ -------------
+
+ procedure SetU_76
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_76;
+ 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
+ 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_76;
+
+end System.Pack_76;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 6 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 76
+
+package System.Pack_76 is
+ pragma Preelaborate;
+
+ Bits : constant := 76;
+
+ type Bits_76 is mod 2 ** Bits;
+ for Bits_76'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_76
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_76 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_76
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_76;
+ 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_76
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_76 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_76
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_76;
+ 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
+
+end System.Pack_76;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 7 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_77 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_77;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_77 --
+ ------------
+
+ function Get_77
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_77
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_77;
+
+ ------------
+ -- Set_77 --
+ ------------
+
+ procedure Set_77
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_77;
+ 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
+ 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_77;
+
+end System.Pack_77;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 7 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 77
+
+package System.Pack_77 is
+ pragma Preelaborate;
+
+ Bits : constant := 77;
+
+ type Bits_77 is mod 2 ** Bits;
+ for Bits_77'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_77
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_77 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_77
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_77;
+ 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.
+
+end System.Pack_77;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 8 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_78 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_78;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_78 or SetU_78 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_78 --
+ ------------
+
+ function Get_78
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_78
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_78;
+
+ -------------
+ -- GetU_78 --
+ -------------
+
+ function GetU_78
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_78
+ 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
+ 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_78;
+
+ ------------
+ -- Set_78 --
+ ------------
+
+ procedure Set_78
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_78;
+ 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
+ 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_78;
+
+ -------------
+ -- SetU_78 --
+ -------------
+
+ procedure SetU_78
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_78;
+ 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
+ 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_78;
+
+end System.Pack_78;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 8 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 78
+
+package System.Pack_78 is
+ pragma Preelaborate;
+
+ Bits : constant := 78;
+
+ type Bits_78 is mod 2 ** Bits;
+ for Bits_78'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_78
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_78 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_78
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_78;
+ 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_78
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_78 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_78
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_78;
+ 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
+
+end System.Pack_78;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 9 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_79 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_79;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_79 --
+ ------------
+
+ function Get_79
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_79
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_79;
+
+ ------------
+ -- Set_79 --
+ ------------
+
+ procedure Set_79
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_79;
+ 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
+ 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_79;
+
+end System.Pack_79;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 7 9 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 79
+
+package System.Pack_79 is
+ pragma Preelaborate;
+
+ Bits : constant := 79;
+
+ type Bits_79 is mod 2 ** Bits;
+ for Bits_79'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_79
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_79 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_79
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_79;
+ 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.
+
+end System.Pack_79;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 0 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_80 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_80;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_80 or SetU_80 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_80 --
+ ------------
+
+ function Get_80
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_80
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_80;
+
+ -------------
+ -- GetU_80 --
+ -------------
+
+ function GetU_80
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_80
+ 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
+ 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_80;
+
+ ------------
+ -- Set_80 --
+ ------------
+
+ procedure Set_80
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_80;
+ 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
+ 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_80;
+
+ -------------
+ -- SetU_80 --
+ -------------
+
+ procedure SetU_80
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_80;
+ 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
+ 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_80;
+
+end System.Pack_80;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 0 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 80
+
+package System.Pack_80 is
+ pragma Preelaborate;
+
+ Bits : constant := 80;
+
+ type Bits_80 is mod 2 ** Bits;
+ for Bits_80'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_80
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_80 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_80
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_80;
+ 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_80
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_80 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_80
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_80;
+ 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
+
+end System.Pack_80;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 1 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_81 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_81;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_81 --
+ ------------
+
+ function Get_81
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_81
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_81;
+
+ ------------
+ -- Set_81 --
+ ------------
+
+ procedure Set_81
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_81;
+ 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
+ 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_81;
+
+end System.Pack_81;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 1 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 81
+
+package System.Pack_81 is
+ pragma Preelaborate;
+
+ Bits : constant := 81;
+
+ type Bits_81 is mod 2 ** Bits;
+ for Bits_81'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_81
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_81 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_81
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_81;
+ 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.
+
+end System.Pack_81;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 2 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_82 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_82;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_82 or SetU_82 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_82 --
+ ------------
+
+ function Get_82
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_82
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_82;
+
+ -------------
+ -- GetU_82 --
+ -------------
+
+ function GetU_82
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_82
+ 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
+ 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_82;
+
+ ------------
+ -- Set_82 --
+ ------------
+
+ procedure Set_82
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_82;
+ 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
+ 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_82;
+
+ -------------
+ -- SetU_82 --
+ -------------
+
+ procedure SetU_82
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_82;
+ 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
+ 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_82;
+
+end System.Pack_82;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 2 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 82
+
+package System.Pack_82 is
+ pragma Preelaborate;
+
+ Bits : constant := 82;
+
+ type Bits_82 is mod 2 ** Bits;
+ for Bits_82'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_82
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_82 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_82
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_82;
+ 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_82
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_82 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_82
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_82;
+ 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
+
+end System.Pack_82;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 3 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_83 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_83;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_83 --
+ ------------
+
+ function Get_83
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_83
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_83;
+
+ ------------
+ -- Set_83 --
+ ------------
+
+ procedure Set_83
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_83;
+ 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
+ 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_83;
+
+end System.Pack_83;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 3 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 83
+
+package System.Pack_83 is
+ pragma Preelaborate;
+
+ Bits : constant := 83;
+
+ type Bits_83 is mod 2 ** Bits;
+ for Bits_83'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_83
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_83 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_83
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_83;
+ 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.
+
+end System.Pack_83;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 4 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_84 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_84;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_84 or SetU_84 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_84 --
+ ------------
+
+ function Get_84
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_84
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_84;
+
+ -------------
+ -- GetU_84 --
+ -------------
+
+ function GetU_84
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_84
+ 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
+ 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_84;
+
+ ------------
+ -- Set_84 --
+ ------------
+
+ procedure Set_84
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_84;
+ 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
+ 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_84;
+
+ -------------
+ -- SetU_84 --
+ -------------
+
+ procedure SetU_84
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_84;
+ 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
+ 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_84;
+
+end System.Pack_84;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 4 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 84
+
+package System.Pack_84 is
+ pragma Preelaborate;
+
+ Bits : constant := 84;
+
+ type Bits_84 is mod 2 ** Bits;
+ for Bits_84'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_84
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_84 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_84
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_84;
+ 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_84
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_84 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_84
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_84;
+ 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
+
+end System.Pack_84;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 5 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_85 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_85;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_85 --
+ ------------
+
+ function Get_85
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_85
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_85;
+
+ ------------
+ -- Set_85 --
+ ------------
+
+ procedure Set_85
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_85;
+ 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
+ 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_85;
+
+end System.Pack_85;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 5 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 85
+
+package System.Pack_85 is
+ pragma Preelaborate;
+
+ Bits : constant := 85;
+
+ type Bits_85 is mod 2 ** Bits;
+ for Bits_85'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_85
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_85 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_85
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_85;
+ 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.
+
+end System.Pack_85;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 6 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_86 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_86;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_86 or SetU_86 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_86 --
+ ------------
+
+ function Get_86
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_86
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_86;
+
+ -------------
+ -- GetU_86 --
+ -------------
+
+ function GetU_86
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_86
+ 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
+ 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_86;
+
+ ------------
+ -- Set_86 --
+ ------------
+
+ procedure Set_86
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_86;
+ 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
+ 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_86;
+
+ -------------
+ -- SetU_86 --
+ -------------
+
+ procedure SetU_86
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_86;
+ 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
+ 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_86;
+
+end System.Pack_86;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 6 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 86
+
+package System.Pack_86 is
+ pragma Preelaborate;
+
+ Bits : constant := 86;
+
+ type Bits_86 is mod 2 ** Bits;
+ for Bits_86'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_86
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_86 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_86
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_86;
+ 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_86
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_86 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_86
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_86;
+ 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
+
+end System.Pack_86;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 7 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_87 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_87;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_87 --
+ ------------
+
+ function Get_87
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_87
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_87;
+
+ ------------
+ -- Set_87 --
+ ------------
+
+ procedure Set_87
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_87;
+ 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
+ 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_87;
+
+end System.Pack_87;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 7 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 87
+
+package System.Pack_87 is
+ pragma Preelaborate;
+
+ Bits : constant := 87;
+
+ type Bits_87 is mod 2 ** Bits;
+ for Bits_87'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_87
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_87 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_87
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_87;
+ 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.
+
+end System.Pack_87;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 8 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_88 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_88;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_88 or SetU_88 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_88 --
+ ------------
+
+ function Get_88
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_88
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_88;
+
+ -------------
+ -- GetU_88 --
+ -------------
+
+ function GetU_88
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_88
+ 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
+ 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_88;
+
+ ------------
+ -- Set_88 --
+ ------------
+
+ procedure Set_88
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_88;
+ 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
+ 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_88;
+
+ -------------
+ -- SetU_88 --
+ -------------
+
+ procedure SetU_88
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_88;
+ 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
+ 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_88;
+
+end System.Pack_88;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 8 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 88
+
+package System.Pack_88 is
+ pragma Preelaborate;
+
+ Bits : constant := 88;
+
+ type Bits_88 is mod 2 ** Bits;
+ for Bits_88'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_88
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_88 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_88
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_88;
+ 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_88
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_88 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_88
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_88;
+ 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
+
+end System.Pack_88;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 9 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_89 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_89;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_89 --
+ ------------
+
+ function Get_89
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_89
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_89;
+
+ ------------
+ -- Set_89 --
+ ------------
+
+ procedure Set_89
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_89;
+ 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
+ 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_89;
+
+end System.Pack_89;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 8 9 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 89
+
+package System.Pack_89 is
+ pragma Preelaborate;
+
+ Bits : constant := 89;
+
+ type Bits_89 is mod 2 ** Bits;
+ for Bits_89'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_89
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_89 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_89
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_89;
+ 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.
+
+end System.Pack_89;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 0 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_90 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_90;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_90 or SetU_90 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_90 --
+ ------------
+
+ function Get_90
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_90
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_90;
+
+ -------------
+ -- GetU_90 --
+ -------------
+
+ function GetU_90
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_90
+ 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
+ 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_90;
+
+ ------------
+ -- Set_90 --
+ ------------
+
+ procedure Set_90
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_90;
+ 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
+ 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_90;
+
+ -------------
+ -- SetU_90 --
+ -------------
+
+ procedure SetU_90
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_90;
+ 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
+ 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_90;
+
+end System.Pack_90;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 0 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 90
+
+package System.Pack_90 is
+ pragma Preelaborate;
+
+ Bits : constant := 90;
+
+ type Bits_90 is mod 2 ** Bits;
+ for Bits_90'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_90
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_90 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_90
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_90;
+ 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_90
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_90 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_90
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_90;
+ 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
+
+end System.Pack_90;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 1 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_91 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_91;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_91 --
+ ------------
+
+ function Get_91
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_91
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_91;
+
+ ------------
+ -- Set_91 --
+ ------------
+
+ procedure Set_91
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_91;
+ 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
+ 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_91;
+
+end System.Pack_91;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 1 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 91
+
+package System.Pack_91 is
+ pragma Preelaborate;
+
+ Bits : constant := 91;
+
+ type Bits_91 is mod 2 ** Bits;
+ for Bits_91'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_91
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_91 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_91
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_91;
+ 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.
+
+end System.Pack_91;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 2 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_92 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_92;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_92 or SetU_92 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_92 --
+ ------------
+
+ function Get_92
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_92
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_92;
+
+ -------------
+ -- GetU_92 --
+ -------------
+
+ function GetU_92
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_92
+ 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
+ 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_92;
+
+ ------------
+ -- Set_92 --
+ ------------
+
+ procedure Set_92
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_92;
+ 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
+ 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_92;
+
+ -------------
+ -- SetU_92 --
+ -------------
+
+ procedure SetU_92
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_92;
+ 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
+ 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_92;
+
+end System.Pack_92;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 2 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 92
+
+package System.Pack_92 is
+ pragma Preelaborate;
+
+ Bits : constant := 92;
+
+ type Bits_92 is mod 2 ** Bits;
+ for Bits_92'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_92
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_92 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_92
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_92;
+ 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_92
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_92 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_92
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_92;
+ 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
+
+end System.Pack_92;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 3 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_93 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_93;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_93 --
+ ------------
+
+ function Get_93
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_93
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_93;
+
+ ------------
+ -- Set_93 --
+ ------------
+
+ procedure Set_93
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_93;
+ 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
+ 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_93;
+
+end System.Pack_93;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 3 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 93
+
+package System.Pack_93 is
+ pragma Preelaborate;
+
+ Bits : constant := 93;
+
+ type Bits_93 is mod 2 ** Bits;
+ for Bits_93'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_93
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_93 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_93
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_93;
+ 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.
+
+end System.Pack_93;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 4 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_94 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_94;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_94 or SetU_94 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_94 --
+ ------------
+
+ function Get_94
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_94
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_94;
+
+ -------------
+ -- GetU_94 --
+ -------------
+
+ function GetU_94
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_94
+ 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
+ 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_94;
+
+ ------------
+ -- Set_94 --
+ ------------
+
+ procedure Set_94
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_94;
+ 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
+ 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_94;
+
+ -------------
+ -- SetU_94 --
+ -------------
+
+ procedure SetU_94
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_94;
+ 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
+ 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_94;
+
+end System.Pack_94;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 4 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 94
+
+package System.Pack_94 is
+ pragma Preelaborate;
+
+ Bits : constant := 94;
+
+ type Bits_94 is mod 2 ** Bits;
+ for Bits_94'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_94
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_94 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_94
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_94;
+ 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_94
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_94 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_94
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_94;
+ 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
+
+end System.Pack_94;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 5 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_95 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_95;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_95 --
+ ------------
+
+ function Get_95
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_95
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_95;
+
+ ------------
+ -- Set_95 --
+ ------------
+
+ procedure Set_95
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_95;
+ 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
+ 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_95;
+
+end System.Pack_95;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 5 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 95
+
+package System.Pack_95 is
+ pragma Preelaborate;
+
+ Bits : constant := 95;
+
+ type Bits_95 is mod 2 ** Bits;
+ for Bits_95'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_95
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_95 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_95
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_95;
+ 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.
+
+end System.Pack_95;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 6 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_96 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_96;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_96 or SetU_96 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_96 --
+ ------------
+
+ function Get_96
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_96
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_96;
+
+ -------------
+ -- GetU_96 --
+ -------------
+
+ function GetU_96
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_96
+ 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
+ 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_96;
+
+ ------------
+ -- Set_96 --
+ ------------
+
+ procedure Set_96
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_96;
+ 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
+ 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_96;
+
+ -------------
+ -- SetU_96 --
+ -------------
+
+ procedure SetU_96
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_96;
+ 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
+ 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_96;
+
+end System.Pack_96;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 6 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 96
+
+package System.Pack_96 is
+ pragma Preelaborate;
+
+ Bits : constant := 96;
+
+ type Bits_96 is mod 2 ** Bits;
+ for Bits_96'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_96
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_96 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_96
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_96;
+ 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_96
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_96 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_96
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_96;
+ 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
+
+end System.Pack_96;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 7 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_97 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_97;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_97 --
+ ------------
+
+ function Get_97
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_97
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_97;
+
+ ------------
+ -- Set_97 --
+ ------------
+
+ procedure Set_97
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_97;
+ 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
+ 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_97;
+
+end System.Pack_97;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 7 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 97
+
+package System.Pack_97 is
+ pragma Preelaborate;
+
+ Bits : constant := 97;
+
+ type Bits_97 is mod 2 ** Bits;
+ for Bits_97'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_97
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_97 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_97
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_97;
+ 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.
+
+end System.Pack_97;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 8 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_98 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_98;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_98 or SetU_98 is not guaranteed to be aligned.
+ -- These routines are used when the packed array is itself a
+ -- component of a packed record, and therefore may not be aligned.
+
+ type ClusterU is new Cluster;
+ for ClusterU'Alignment use 1;
+
+ type ClusterU_Ref is access ClusterU;
+
+ 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_98 --
+ ------------
+
+ function Get_98
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_98
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_98;
+
+ -------------
+ -- GetU_98 --
+ -------------
+
+ function GetU_98
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_98
+ 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
+ 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_98;
+
+ ------------
+ -- Set_98 --
+ ------------
+
+ procedure Set_98
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_98;
+ 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
+ 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_98;
+
+ -------------
+ -- SetU_98 --
+ -------------
+
+ procedure SetU_98
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_98;
+ 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
+ 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_98;
+
+end System.Pack_98;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 8 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 98
+
+package System.Pack_98 is
+ pragma Preelaborate;
+
+ Bits : constant := 98;
+
+ type Bits_98 is mod 2 ** Bits;
+ for Bits_98'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_98
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_98 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_98
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_98;
+ 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_98
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_98 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_98
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_98;
+ 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
+
+end System.Pack_98;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 9 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements;
+with System.Unsigned_Types;
+
+package body System.Pack_99 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;
+
+ use type System.Storage_Elements.Storage_Offset;
+ use type System.Unsigned_Types.Unsigned;
+
+ type Cluster is record
+ E0, E1, E2, E3, E4, E5, E6, E7 : Bits_99;
+ end record;
+
+ for Cluster use record
+ E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
+ E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
+ E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
+ E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
+ E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
+ E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
+ E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
+ E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
+ end record;
+
+ for Cluster'Size use Bits * 8;
+
+ for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
+ 1 +
+ 1 * Boolean'Pos (Bits mod 2 = 0) +
+ 2 * Boolean'Pos (Bits mod 4 = 0));
+ -- Use maximum possible alignment, given the bit field size, since this
+ -- will result in the most efficient code possible for the field.
+
+ type Cluster_Ref is access Cluster;
+
+ 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_99 --
+ ------------
+
+ function Get_99
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_99
+ is
+ A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+ C : Cluster_Ref with Address => A'Address, Import;
+ RC : Rev_Cluster_Ref with Address => A'Address, Import;
+ begin
+ 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_99;
+
+ ------------
+ -- Set_99 --
+ ------------
+
+ procedure Set_99
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_99;
+ 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
+ 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_99;
+
+end System.Pack_99;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . P A C K _ 9 9 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Handling of packed arrays with Component_Size = 99
+
+package System.Pack_99 is
+ pragma Preelaborate;
+
+ Bits : constant := 99;
+
+ type Bits_99 is mod 2 ** Bits;
+ for Bits_99'Size use Bits;
+
+ -- In all subprograms below, Rev_SSO is set True if the array has the
+ -- non-default scalar storage order.
+
+ function Get_99
+ (Arr : System.Address;
+ N : Natural;
+ Rev_SSO : Boolean) return Bits_99 with Inline;
+ -- Arr is the address of the packed array, N is the zero-based
+ -- subscript. This element is extracted and returned.
+
+ procedure Set_99
+ (Arr : System.Address;
+ N : Natural;
+ E : Bits_99;
+ 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.
+
+end System.Pack_99;
or Unsigned_64 (Unsigned_32'(Random (Gen)));
end Random;
+ function Random (Gen : Generator) return Unsigned_128 is
+ begin
+ return Shift_Left (Unsigned_128 (Unsigned_64'(Random (Gen))), 64)
+ or Unsigned_128 (Unsigned_64'(Random (Gen)));
+ end Random;
+
---------------------
-- Random_Discrete --
---------------------
function Random (Gen : Generator) return Interfaces.Unsigned_32;
function Random (Gen : Generator) return Interfaces.Unsigned_64;
+ function Random (Gen : Generator) return Interfaces.Unsigned_128;
-- Return pseudo-random numbers uniformly distributed on T'First .. T'Last
-- for builtin integer types.
package body System.Scalar_Values is
+ use Interfaces;
+
----------------
-- Initialize --
----------------
-- are used by the generated code, which are linked to the actual values
-- by the use of pragma Import.
+with Interfaces;
+
package System.Scalar_Values is
-- Note: logically this package should be Pure since it can be accessed
-- access this from generated code, and the compiler knows that it is
-- OK to access this unit from generated code.
- type Byte1 is mod 2 ** 8;
- type Byte2 is mod 2 ** 16;
- type Byte4 is mod 2 ** 32;
- type Byte8 is mod 2 ** 64;
+ subtype Byte1 is Interfaces.Unsigned_8;
+ subtype Byte2 is Interfaces.Unsigned_16;
+ subtype Byte4 is Interfaces.Unsigned_32;
+ subtype Byte8 is Interfaces.Unsigned_64;
-- The explicit initializations here are not really required, since these
-- variables are always set by System.Scalar_Values.Initialize.
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . S C A L A R _ V A L U E S --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2003-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with Ada.Unchecked_Conversion;
+
+package body System.Scalar_Values is
+
+ use Interfaces;
+
+ ----------------
+ -- Initialize --
+ ----------------
+
+ procedure Initialize (Mode1 : Character; Mode2 : Character) is
+ C1 : Character := Mode1;
+ C2 : Character := Mode2;
+
+ procedure Get_Env_Value_Ptr (Name, Length, Ptr : Address);
+ pragma Import (C, Get_Env_Value_Ptr, "__gnat_getenv");
+
+ subtype String2 is String (1 .. 2);
+ type String2_Ptr is access all String2;
+
+ Env_Value_Ptr : aliased String2_Ptr;
+ Env_Value_Length : aliased Integer;
+
+ EV_Val : aliased constant String :=
+ "GNAT_INIT_SCALARS" & ASCII.NUL;
+
+ B : Byte1;
+
+ EFloat : constant Boolean := Long_Long_Float'Size > Long_Float'Size;
+ -- Set True if we are on an x86 with 96-bit floats for extended
+
+ AFloat : constant Boolean :=
+ Long_Float'Size = 48 and then Long_Long_Float'Size = 48;
+ -- Set True if we are on an AAMP with 48-bit extended floating point
+
+ type ByteLF is array (0 .. 7 - 2 * Boolean'Pos (AFloat)) of Byte1;
+
+ for ByteLF'Component_Size use 8;
+
+ -- Type used to hold Long_Float values on all targets and to initialize
+ -- 48-bit Long_Float values used on AAMP. On AAMP, this type is 6 bytes.
+ -- On other targets the type is 8 bytes, and type Byte8 is used for
+ -- values that are then converted to ByteLF.
+
+ pragma Warnings (Off); -- why ???
+ function To_ByteLF is new Ada.Unchecked_Conversion (Byte8, ByteLF);
+ pragma Warnings (On);
+
+ type ByteLLF is
+ array (0 .. 7 + 4 * Boolean'Pos (EFloat) - 2 * Boolean'Pos (AFloat))
+ of Byte1;
+
+ for ByteLLF'Component_Size use 8;
+
+ -- Type used to initialize Long_Long_Float values used on x86 and
+ -- any other target with the same 80-bit floating-point values that
+ -- GCC always stores in 96-bits. Note that we are assuming Intel
+ -- format little-endian addressing for this type. On non-Intel
+ -- architectures, this is the same length as Byte8 and holds
+ -- a Long_Float value.
+
+ -- The following variables are used to initialize the float values
+ -- by overlay. We can't assign directly to the float values, since
+ -- we may be assigning signalling Nan's that will cause a trap if
+ -- loaded into a floating-point register.
+
+ IV_Isf : aliased Byte4; -- Initialize short float
+ IV_Ifl : aliased Byte4; -- Initialize float
+ IV_Ilf : aliased ByteLF; -- Initialize long float
+ IV_Ill : aliased ByteLLF; -- Initialize long long float
+
+ for IV_Isf'Address use IS_Isf'Address;
+ for IV_Ifl'Address use IS_Ifl'Address;
+ for IV_Ilf'Address use IS_Ilf'Address;
+ for IV_Ill'Address use IS_Ill'Address;
+
+ -- The following pragmas are used to suppress initialization
+
+ pragma Import (Ada, IV_Isf);
+ pragma Import (Ada, IV_Ifl);
+ pragma Import (Ada, IV_Ilf);
+ pragma Import (Ada, IV_Ill);
+
+ begin
+ -- Acquire environment variable value if necessary
+
+ if C1 = 'E' and then C2 = 'V' then
+ Get_Env_Value_Ptr
+ (EV_Val'Address, Env_Value_Length'Address, Env_Value_Ptr'Address);
+
+ -- Ignore if length is not 2
+
+ if Env_Value_Length /= 2 then
+ C1 := 'I';
+ C2 := 'N';
+
+ -- Length is 2, see if it is a valid value
+
+ else
+ -- Acquire two characters and fold to upper case
+
+ C1 := Env_Value_Ptr (1);
+ C2 := Env_Value_Ptr (2);
+
+ if C1 in 'a' .. 'z' then
+ C1 := Character'Val (Character'Pos (C1) - 32);
+ end if;
+
+ if C2 in 'a' .. 'z' then
+ C2 := Character'Val (Character'Pos (C2) - 32);
+ end if;
+
+ -- IN/LO/HI are ok values
+
+ if (C1 = 'I' and then C2 = 'N')
+ or else
+ (C1 = 'L' and then C2 = 'O')
+ or else
+ (C1 = 'H' and then C2 = 'I')
+ then
+ null;
+
+ -- Try for valid hex digits
+
+ elsif (C1 in '0' .. '9' or else C1 in 'A' .. 'Z')
+ or else
+ (C2 in '0' .. '9' or else C2 in 'A' .. 'Z')
+ then
+ null;
+
+ -- Otherwise environment value is bad, ignore and use IN (invalid)
+
+ else
+ C1 := 'I';
+ C2 := 'N';
+ end if;
+ end if;
+ end if;
+
+ -- IN (invalid value)
+
+ if C1 = 'I' and then C2 = 'N' then
+ IS_Is1 := 16#80#;
+ IS_Is2 := 16#8000#;
+ IS_Is4 := 16#8000_0000#;
+ IS_Is8 := 16#8000_0000_0000_0000#;
+ IS_Is16 := 16#8000_0000_0000_0000_0000_0000_0000_0000#;
+
+ IS_Iu1 := 16#FF#;
+ IS_Iu2 := 16#FFFF#;
+ IS_Iu4 := 16#FFFF_FFFF#;
+ IS_Iu8 := 16#FFFF_FFFF_FFFF_FFFF#;
+ IS_Iu16 := 16#FFFF_FFFF_FFFF_FFFF_FFFF_FFFF_FFFF_FFFF#;
+
+ IS_Iz1 := 16#00#;
+ IS_Iz2 := 16#0000#;
+ IS_Iz4 := 16#0000_0000#;
+ IS_Iz8 := 16#0000_0000_0000_0000#;
+ IS_Iz16 := 16#0000_0000_0000_0000_0000_0000_0000_0000#;
+
+ if AFloat then
+ IV_Isf := 16#FFFF_FF00#;
+ IV_Ifl := 16#FFFF_FF00#;
+ IV_Ilf := (0, 16#FF#, 16#FF#, 16#FF#, 16#FF#, 16#FF#);
+
+ else
+ IV_Isf := IS_Iu4;
+ IV_Ifl := IS_Iu4;
+ IV_Ilf := To_ByteLF (IS_Iu8);
+ end if;
+
+ if EFloat then
+ IV_Ill := (0, 0, 0, 0, 0, 0, 0, 16#C0#, 16#FF#, 16#FF#, 0, 0);
+ end if;
+
+ -- LO (Low values)
+
+ elsif C1 = 'L' and then C2 = 'O' then
+ IS_Is1 := 16#80#;
+ IS_Is2 := 16#8000#;
+ IS_Is4 := 16#8000_0000#;
+ IS_Is8 := 16#8000_0000_0000_0000#;
+ IS_Is16 := 16#8000_0000_0000_0000_0000_0000_0000_0000#;
+
+ IS_Iu1 := 16#00#;
+ IS_Iu2 := 16#0000#;
+ IS_Iu4 := 16#0000_0000#;
+ IS_Iu8 := 16#0000_0000_0000_0000#;
+ IS_Iu16 := 16#0000_0000_0000_0000_0000_0000_0000_0000#;
+
+ IS_Iz1 := 16#00#;
+ IS_Iz2 := 16#0000#;
+ IS_Iz4 := 16#0000_0000#;
+ IS_Iz8 := 16#0000_0000_0000_0000#;
+ IS_Iz16 := 16#0000_0000_0000_0000_0000_0000_0000_0000#;
+
+ if AFloat then
+ IV_Isf := 16#0000_0001#;
+ IV_Ifl := 16#0000_0001#;
+ IV_Ilf := (1, 0, 0, 0, 0, 0);
+
+ else
+ IV_Isf := 16#FF80_0000#;
+ IV_Ifl := 16#FF80_0000#;
+ IV_Ilf := To_ByteLF (16#FFF0_0000_0000_0000#);
+ end if;
+
+ if EFloat then
+ IV_Ill := (0, 0, 0, 0, 0, 0, 0, 16#80#, 16#FF#, 16#FF#, 0, 0);
+ end if;
+
+ -- HI (High values)
+
+ elsif C1 = 'H' and then C2 = 'I' then
+ IS_Is1 := 16#7F#;
+ IS_Is2 := 16#7FFF#;
+ IS_Is4 := 16#7FFF_FFFF#;
+ IS_Is8 := 16#7FFF_FFFF_FFFF_FFFF#;
+ IS_Is16 := 16#7FFF_FFFF_FFFF_FFFF_FFFF_FFFF_FFFF_FFFF#;
+
+ IS_Iu1 := 16#FF#;
+ IS_Iu2 := 16#FFFF#;
+ IS_Iu4 := 16#FFFF_FFFF#;
+ IS_Iu8 := 16#FFFF_FFFF_FFFF_FFFF#;
+ IS_Iu16 := 16#FFFF_FFFF_FFFF_FFFF_FFFF_FFFF_FFFF_FFFF#;
+
+ IS_Iz1 := 16#FF#;
+ IS_Iz2 := 16#FFFF#;
+ IS_Iz4 := 16#FFFF_FFFF#;
+ IS_Iz8 := 16#FFFF_FFFF_FFFF_FFFF#;
+ IS_Iz16 := 16#FFFF_FFFF_FFFF_FFFF_FFFF_FFFF_FFFF_FFFF#;
+
+ if AFloat then
+ IV_Isf := 16#7FFF_FFFF#;
+ IV_Ifl := 16#7FFF_FFFF#;
+ IV_Ilf := (16#FF#, 16#FF#, 16#FF#, 16#FF#, 16#FF#, 16#7F#);
+
+ else
+ IV_Isf := 16#7F80_0000#;
+ IV_Ifl := 16#7F80_0000#;
+ IV_Ilf := To_ByteLF (16#7FF0_0000_0000_0000#);
+ end if;
+
+ if EFloat then
+ IV_Ill := (0, 0, 0, 0, 0, 0, 0, 16#80#, 16#FF#, 16#7F#, 0, 0);
+ end if;
+
+ -- -Shh (hex byte)
+
+ else
+ -- Convert the two hex digits (we know they are valid here)
+
+ B := 16 * (Character'Pos (C1)
+ - (if C1 in '0' .. '9'
+ then Character'Pos ('0')
+ else Character'Pos ('A') - 10))
+ + (Character'Pos (C2)
+ - (if C2 in '0' .. '9'
+ then Character'Pos ('0')
+ else Character'Pos ('A') - 10));
+
+ -- Initialize data values from the hex value
+
+ IS_Is1 := B;
+ IS_Is2 := 2**8 * Byte2 (IS_Is1) + Byte2 (IS_Is1);
+ IS_Is4 := 2**16 * Byte4 (IS_Is2) + Byte4 (IS_Is2);
+ IS_Is8 := 2**32 * Byte8 (IS_Is4) + Byte8 (IS_Is4);
+ IS_Is16 := 2**64 * Byte16 (IS_Is8) + Byte16 (IS_Is8);
+
+ IS_Iu1 := IS_Is1;
+ IS_Iu2 := IS_Is2;
+ IS_Iu4 := IS_Is4;
+ IS_Iu8 := IS_Is8;
+ IS_Iu16 := IS_Is16;
+
+ IS_Iz1 := IS_Is1;
+ IS_Iz2 := IS_Is2;
+ IS_Iz4 := IS_Is4;
+ IS_Iz8 := IS_Is8;
+ IS_Iz16 := IS_Is16;
+
+ IV_Isf := IS_Is4;
+ IV_Ifl := IS_Is4;
+
+ if AFloat then
+ IV_Ill := (B, B, B, B, B, B);
+ else
+ IV_Ilf := To_ByteLF (IS_Is8);
+ end if;
+
+ if EFloat then
+ IV_Ill := (B, B, B, B, B, B, B, B, B, B, B, B);
+ end if;
+ end if;
+
+ -- If no separate Long_Long_Float, then use Long_Float value as
+ -- Long_Long_Float initial value.
+
+ if not EFloat then
+ declare
+ pragma Warnings (Off); -- why???
+ function To_ByteLLF is
+ new Ada.Unchecked_Conversion (ByteLF, ByteLLF);
+ pragma Warnings (On);
+ begin
+ IV_Ill := To_ByteLLF (IV_Ilf);
+ end;
+ end if;
+ end Initialize;
+
+end System.Scalar_Values;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . S C A L A R _ V A L U E S --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2001-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package defines the constants used for initializing scalar values
+-- when pragma Initialize_Scalars is used. The actual values are defined
+-- in the binder generated file. This package contains the Ada names that
+-- are used by the generated code, which are linked to the actual values
+-- by the use of pragma Import.
+
+-- This is the 128-bit version of the package
+
+with Interfaces;
+
+package System.Scalar_Values is
+
+ -- Note: logically this package should be Pure since it can be accessed
+ -- from pure units, but the IS_xxx variables below get set at run time,
+ -- so they have to be library level variables. In fact we only ever
+ -- access this from generated code, and the compiler knows that it is
+ -- OK to access this unit from generated code.
+
+ subtype Byte1 is Interfaces.Unsigned_8;
+ subtype Byte2 is Interfaces.Unsigned_16;
+ subtype Byte4 is Interfaces.Unsigned_32;
+ subtype Byte8 is Interfaces.Unsigned_64;
+ subtype Byte16 is Interfaces.Unsigned_128;
+
+ -- The explicit initializations here are not really required, since these
+ -- variables are always set by System.Scalar_Values.Initialize.
+
+ IS_Is1 : Byte1 := 0; -- Initialize 1 byte signed
+ IS_Is2 : Byte2 := 0; -- Initialize 2 byte signed
+ IS_Is4 : Byte4 := 0; -- Initialize 4 byte signed
+ IS_Is8 : Byte8 := 0; -- Initialize 8 byte signed
+ IS_Is16 : Byte16 := 0; -- Initialize 8 byte signed
+ -- For the above cases, the undefined value (set by the binder -Sin switch)
+ -- is the largest negative number (1 followed by all zero bits).
+
+ IS_Iu1 : Byte1 := 0; -- Initialize 1 byte unsigned
+ IS_Iu2 : Byte2 := 0; -- Initialize 2 byte unsigned
+ IS_Iu4 : Byte4 := 0; -- Initialize 4 byte unsigned
+ IS_Iu8 : Byte8 := 0; -- Initialize 8 byte unsigned
+ IS_Iu16 : Byte16 := 0; -- Initialize 8 byte unsigned
+ -- For the above cases, the undefined value (set by the binder -Sin switch)
+ -- is the largest unsigned number (all 1 bits).
+
+ IS_Iz1 : Byte1 := 0; -- Initialize 1 byte zeroes
+ IS_Iz2 : Byte2 := 0; -- Initialize 2 byte zeroes
+ IS_Iz4 : Byte4 := 0; -- Initialize 4 byte zeroes
+ IS_Iz8 : Byte8 := 0; -- Initialize 8 byte zeroes
+ IS_Iz16 : Byte16 := 0; -- Initialize 8 byte zeroes
+ -- For the above cases, the undefined value (set by the binder -Sin switch)
+ -- is the zero (all 0 bits). This is used when zero is known to be an
+ -- invalid value.
+
+ -- The float definitions are aliased, because we use overlays to set them
+
+ IS_Isf : aliased Short_Float := 0.0; -- Initialize short float
+ IS_Ifl : aliased Float := 0.0; -- Initialize float
+ IS_Ilf : aliased Long_Float := 0.0; -- Initialize long float
+ IS_Ill : aliased Long_Long_Float := 0.0; -- Initialize long long float
+
+ procedure Initialize (Mode1 : Character; Mode2 : Character);
+ -- This procedure is called from the binder when Initialize_Scalars mode
+ -- is active. The arguments are the two characters from the -S switch,
+ -- with letters forced upper case. So for example if -S5a is given, then
+ -- Mode1 will be '5' and Mode2 will be 'A'. If the parameters are EV,
+ -- then this routine reads the environment variable GNAT_INIT_SCALARS.
+ -- The possible settings are the same as those for the -S switch (except
+ -- for EV), i.e. IN/LO/HO/xx, xx = 2 hex digits. If no -S switch is given
+ -- then the default of IN (invalid values) is passed on the call.
+
+end System.Scalar_Values;
pragma Pure;
pragma No_Elaboration_Code_All;
- type Short_Short_Unsigned is mod 2 ** Short_Short_Integer'Size;
- type Short_Unsigned is mod 2 ** Short_Integer'Size;
- type Unsigned is mod 2 ** Integer'Size;
- type Long_Unsigned is mod 2 ** Long_Integer'Size;
- type Long_Long_Unsigned is mod 2 ** Long_Long_Integer'Size;
-
- type Float_Unsigned is mod 2 ** Float'Size;
+ type Short_Short_Unsigned is mod 2 ** Short_Short_Integer'Size;
+ type Short_Unsigned is mod 2 ** Short_Integer'Size;
+ type Unsigned is mod 2 ** Integer'Size;
+ type Long_Unsigned is mod 2 ** Long_Integer'Size;
+ type Long_Long_Unsigned is mod 2 ** Long_Long_Integer'Size;
+ type Long_Long_Long_Unsigned is mod Max_Binary_Modulus;
+
+ type Float_Unsigned is mod 2 ** Float'Size;
-- Used in the implementation of Is_Negative intrinsic (see Exp_Intr)
type Packed_Byte is mod 2 ** 8;
(Value : Long_Long_Unsigned;
Amount : Natural) return Long_Long_Unsigned;
+ function Shift_Left
+ (Value : Long_Long_Long_Unsigned;
+ Amount : Natural) return Long_Long_Long_Unsigned;
+
+ function Shift_Right
+ (Value : Long_Long_Long_Unsigned;
+ Amount : Natural) return Long_Long_Long_Unsigned;
+
+ function Shift_Right_Arithmetic
+ (Value : Long_Long_Long_Unsigned;
+ Amount : Natural) return Long_Long_Long_Unsigned;
+
+ function Rotate_Left
+ (Value : Long_Long_Long_Unsigned;
+ Amount : Natural) return Long_Long_Long_Unsigned;
+
+ function Rotate_Right
+ (Value : Long_Long_Long_Unsigned;
+ Amount : Natural) return Long_Long_Long_Unsigned;
+
pragma Import (Intrinsic, Shift_Left);
pragma Import (Intrinsic, Shift_Right);
pragma Import (Intrinsic, Shift_Right_Arithmetic);
System_Address_Image,
System_Address_To_Access_Conversions,
System_Arith_64,
+ System_Arith_128,
System_AST_Handling,
System_Assertions,
System_Atomic_Primitives,
System_Boolean_Array_Operations,
System_Byte_Swapping,
System_Checked_Pools,
+ System_Compare_Array_Signed_8,
System_Compare_Array_Signed_16,
System_Compare_Array_Signed_32,
System_Compare_Array_Signed_64,
- System_Compare_Array_Signed_8,
+ System_Compare_Array_Signed_128,
+ System_Compare_Array_Unsigned_8,
System_Compare_Array_Unsigned_16,
System_Compare_Array_Unsigned_32,
System_Compare_Array_Unsigned_64,
- System_Compare_Array_Unsigned_8,
+ System_Compare_Array_Unsigned_128,
System_Concat_2,
System_Concat_3,
System_Concat_4,
System_Exn_Int,
System_Exn_LLF,
System_Exn_LLI,
+ System_Exn_LLLI,
System_Exp_Int,
- System_Exp_LInt,
System_Exp_LLI,
+ System_Exp_LLLI,
System_Exp_LLU,
+ System_Exp_LLLU,
System_Exp_Mod,
System_Exp_Uns,
System_Fat_Flt,
System_Pack_61,
System_Pack_62,
System_Pack_63,
+ System_Pack_65,
+ System_Pack_66,
+ System_Pack_67,
+ System_Pack_68,
+ System_Pack_69,
+ System_Pack_70,
+ System_Pack_71,
+ System_Pack_72,
+ System_Pack_73,
+ System_Pack_74,
+ System_Pack_75,
+ System_Pack_76,
+ System_Pack_77,
+ System_Pack_78,
+ System_Pack_79,
+ System_Pack_80,
+ System_Pack_81,
+ System_Pack_82,
+ System_Pack_83,
+ System_Pack_84,
+ System_Pack_85,
+ System_Pack_86,
+ System_Pack_87,
+ System_Pack_88,
+ System_Pack_89,
+ System_Pack_90,
+ System_Pack_91,
+ System_Pack_92,
+ System_Pack_93,
+ System_Pack_94,
+ System_Pack_95,
+ System_Pack_96,
+ System_Pack_97,
+ System_Pack_98,
+ System_Pack_99,
+ System_Pack_100,
+ System_Pack_101,
+ System_Pack_102,
+ System_Pack_103,
+ System_Pack_104,
+ System_Pack_105,
+ System_Pack_106,
+ System_Pack_107,
+ System_Pack_108,
+ System_Pack_109,
+ System_Pack_110,
+ System_Pack_111,
+ System_Pack_112,
+ System_Pack_113,
+ System_Pack_114,
+ System_Pack_115,
+ System_Pack_116,
+ System_Pack_117,
+ System_Pack_118,
+ System_Pack_119,
+ System_Pack_120,
+ System_Pack_121,
+ System_Pack_122,
+ System_Pack_123,
+ System_Pack_124,
+ System_Pack_125,
+ System_Pack_126,
+ System_Pack_127,
System_Parameters,
System_Partition_Interface,
System_Pool_32_Global,
RE_Integer_16, -- Interfaces
RE_Integer_32, -- Interfaces
RE_Integer_64, -- Interfaces
+ RE_Integer_128, -- Interfaces
RE_Unsigned_8, -- Interfaces
RE_Unsigned_16, -- Interfaces
RE_Unsigned_32, -- Interfaces
RE_Unsigned_64, -- Interfaces
+ RE_Unsigned_128, -- Interfaces
RO_IC_Unsigned, -- Interfaces.C
RO_IC_Unsigned_Long_Long, -- Interfaces.C
RE_Address_Image, -- System.Address_Image
- RE_Add_With_Ovflo_Check, -- System.Arith_64
- RE_Double_Divide, -- System.Arith_64
- RE_Multiply_With_Ovflo_Check, -- System.Arith_64
- RE_Scaled_Divide, -- System.Arith_64
- RE_Subtract_With_Ovflo_Check, -- System.Arith_64
+ RE_Add_With_Ovflo_Check64, -- System.Arith_64
+ RE_Double_Divide64, -- System.Arith_64
+ RE_Multiply_With_Ovflo_Check64, -- System.Arith_64
+ RE_Scaled_Divide64, -- System.Arith_64
+ RE_Subtract_With_Ovflo_Check64, -- System.Arith_64
+
+ RE_Add_With_Ovflo_Check128, -- System.Arith_128
+ RE_Multiply_With_Ovflo_Check128, -- System.Arith_128
+ RE_Subtract_With_Ovflo_Check128, -- System.Arith_128
RE_Create_AST_Handler, -- System.AST_Handling
RE_Bswap_16, -- System.Byte_Swapping
RE_Bswap_32, -- System.Byte_Swapping
RE_Bswap_64, -- System.Byte_Swapping
+ RE_Bswap_128, -- System.Byte_Swapping
RE_Checked_Pool, -- System.Checked_Pools
RE_Compare_Array_S8_Unaligned, -- System.Compare_Array_Signed_8
RE_Compare_Array_S16, -- System.Compare_Array_Signed_16
- RE_Compare_Array_S32, -- System.Compare_Array_Signed_16
- RE_Compare_Array_S64, -- System.Compare_Array_Signed_16
+ RE_Compare_Array_S32, -- System.Compare_Array_Signed_32
+ RE_Compare_Array_S64, -- System.Compare_Array_Signed_64
+ RE_Compare_Array_S128, -- System.Compare_Array_Signed_128
RE_Compare_Array_U8, -- System.Compare_Array_Unsigned_8
RE_Compare_Array_U8_Unaligned, -- System.Compare_Array_Unsigned_8
RE_Compare_Array_U16, -- System.Compare_Array_Unsigned_16
- RE_Compare_Array_U32, -- System.Compare_Array_Unsigned_16
- RE_Compare_Array_U64, -- System.Compare_Array_Unsigned_16
+ RE_Compare_Array_U32, -- System.Compare_Array_Unsigned_32
+ RE_Compare_Array_U64, -- System.Compare_Array_Unsigned_64
+ RE_Compare_Array_U128, -- System.Compare_Array_Unsigned_128
RE_Str_Concat_2, -- System.Concat_2
RE_Str_Concat_3, -- System.Concat_3
RE_Exn_Long_Long_Integer, -- System.Exn_LLI
+ RE_Exn_Long_Long_Long_Integer, -- System.Exn_LLLI
+
RE_Exp_Integer, -- System.Exp_Int
RE_Exp_Long_Long_Integer, -- System.Exp_LLI
+ RE_Exp_Long_Long_Long_Integer, -- System.Exp_LLLI
+
RE_Exp_Long_Long_Unsigned, -- System.Exp_LLU
+ RE_Exp_Long_Long_Long_Unsigned, -- System.Exp_LLLU
+
RE_Exp_Modular, -- System.Exp_Mod
RE_Exp_Unsigned, -- System.Exp_Uns
RE_Get_63, -- System.Pack_63
RE_Set_63, -- System.Pack_63
+ RE_Bits_65, -- System.Pack_65
+ RE_Get_65, -- System.Pack_65
+ RE_Set_65, -- System.Pack_65
+
+ RE_Bits_66, -- System.Pack_66
+ RE_Get_66, -- System.Pack_66
+ RE_GetU_66, -- System.Pack_66
+ RE_Set_66, -- System.Pack_66
+ RE_SetU_66, -- System.Pack_66
+
+ RE_Bits_67, -- System.Pack_67
+ RE_Get_67, -- System.Pack_67
+ RE_Set_67, -- System.Pack_67
+
+ RE_Bits_68, -- System.Pack_68
+ RE_Get_68, -- System.Pack_68
+ RE_GetU_68, -- System.Pack_68
+ RE_Set_68, -- System.Pack_68
+ RE_SetU_68, -- System.Pack_68
+
+ RE_Bits_69, -- System.Pack_69
+ RE_Get_69, -- System.Pack_69
+ RE_Set_69, -- System.Pack_69
+
+ RE_Bits_70, -- System.Pack_70
+ RE_Get_70, -- System.Pack_70
+ RE_GetU_70, -- System.Pack_70
+ RE_Set_70, -- System.Pack_70
+ RE_SetU_70, -- System.Pack_70
+
+ RE_Bits_71, -- System.Pack_71
+ RE_Get_71, -- System.Pack_71
+ RE_Set_71, -- System.Pack_71
+
+ RE_Bits_72, -- System.Pack_72
+ RE_Get_72, -- System.Pack_72
+ RE_GetU_72, -- System.Pack_72
+ RE_Set_72, -- System.Pack_72
+ RE_SetU_72, -- System.Pack_72
+
+ RE_Bits_73, -- System.Pack_73
+ RE_Get_73, -- System.Pack_73
+ RE_Set_73, -- System.Pack_73
+
+ RE_Bits_74, -- System.Pack_74
+ RE_Get_74, -- System.Pack_74
+ RE_GetU_74, -- System.Pack_74
+ RE_Set_74, -- System.Pack_74
+ RE_SetU_74, -- System.Pack_74
+
+ RE_Bits_75, -- System.Pack_75
+ RE_Get_75, -- System.Pack_75
+ RE_Set_75, -- System.Pack_75
+
+ RE_Bits_76, -- System.Pack_76
+ RE_Get_76, -- System.Pack_76
+ RE_GetU_76, -- System.Pack_76
+ RE_Set_76, -- System.Pack_76
+ RE_SetU_76, -- System.Pack_76
+
+ RE_Bits_77, -- System.Pack_77
+ RE_Get_77, -- System.Pack_77
+ RE_Set_77, -- System.Pack_77
+
+ RE_Bits_78, -- System.Pack_78
+ RE_Get_78, -- System.Pack_78
+ RE_GetU_78, -- System.Pack_78
+ RE_Set_78, -- System.Pack_78
+ RE_SetU_78, -- System.Pack_78
+
+ RE_Bits_79, -- System.Pack_79
+ RE_Get_79, -- System.Pack_79
+ RE_Set_79, -- System.Pack_79
+
+ RE_Bits_80, -- System.Pack_80
+ RE_Get_80, -- System.Pack_80
+ RE_GetU_80, -- System.Pack_80
+ RE_Set_80, -- System.Pack_80
+ RE_SetU_80, -- System.Pack_80
+
+ RE_Bits_81, -- System.Pack_81
+ RE_Get_81, -- System.Pack_81
+ RE_Set_81, -- System.Pack_81
+
+ RE_Bits_82, -- System.Pack_82
+ RE_Get_82, -- System.Pack_82
+ RE_GetU_82, -- System.Pack_82
+ RE_Set_82, -- System.Pack_82
+ RE_SetU_82, -- System.Pack_82
+
+ RE_Bits_83, -- System.Pack_83
+ RE_Get_83, -- System.Pack_83
+ RE_Set_83, -- System.Pack_83
+
+ RE_Bits_84, -- System.Pack_84
+ RE_Get_84, -- System.Pack_84
+ RE_GetU_84, -- System.Pack_84
+ RE_Set_84, -- System.Pack_84
+ RE_SetU_84, -- System.Pack_84
+
+ RE_Bits_85, -- System.Pack_85
+ RE_Get_85, -- System.Pack_85
+ RE_Set_85, -- System.Pack_85
+
+ RE_Bits_86, -- System.Pack_86
+ RE_Get_86, -- System.Pack_86
+ RE_GetU_86, -- System.Pack_86
+ RE_Set_86, -- System.Pack_86
+ RE_SetU_86, -- System.Pack_86
+
+ RE_Bits_87, -- System.Pack_87
+ RE_Get_87, -- System.Pack_87
+ RE_Set_87, -- System.Pack_87
+
+ RE_Bits_88, -- System.Pack_88
+ RE_Get_88, -- System.Pack_88
+ RE_GetU_88, -- System.Pack_88
+ RE_Set_88, -- System.Pack_88
+ RE_SetU_88, -- System.Pack_88
+
+ RE_Bits_89, -- System.Pack_89
+ RE_Get_89, -- System.Pack_89
+ RE_Set_89, -- System.Pack_89
+
+ RE_Bits_90, -- System.Pack_90
+ RE_Get_90, -- System.Pack_90
+ RE_GetU_90, -- System.Pack_90
+ RE_Set_90, -- System.Pack_90
+ RE_SetU_90, -- System.Pack_90
+
+ RE_Bits_91, -- System.Pack_91
+ RE_Get_91, -- System.Pack_91
+ RE_Set_91, -- System.Pack_91
+
+ RE_Bits_92, -- System.Pack_92
+ RE_Get_92, -- System.Pack_92
+ RE_GetU_92, -- System.Pack_92
+ RE_Set_92, -- System.Pack_92
+ RE_SetU_92, -- System.Pack_92
+
+ RE_Bits_93, -- System.Pack_93
+ RE_Get_93, -- System.Pack_93
+ RE_Set_93, -- System.Pack_93
+
+ RE_Bits_94, -- System.Pack_94
+ RE_Get_94, -- System.Pack_94
+ RE_GetU_94, -- System.Pack_94
+ RE_Set_94, -- System.Pack_94
+ RE_SetU_94, -- System.Pack_94
+
+ RE_Bits_95, -- System.Pack_95
+ RE_Get_95, -- System.Pack_95
+ RE_Set_95, -- System.Pack_95
+
+ RE_Bits_96, -- System.Pack_96
+ RE_Get_96, -- System.Pack_96
+ RE_GetU_96, -- System.Pack_96
+ RE_Set_96, -- System.Pack_96
+ RE_SetU_96, -- System.Pack_96
+
+ RE_Bits_97, -- System.Pack_97
+ RE_Get_97, -- System.Pack_97
+ RE_Set_97, -- System.Pack_97
+
+ RE_Bits_98, -- System.Pack_98
+ RE_Get_98, -- System.Pack_98
+ RE_GetU_98, -- System.Pack_98
+ RE_Set_98, -- System.Pack_98
+ RE_SetU_98, -- System.Pack_98
+
+ RE_Bits_99, -- System.Pack_99
+ RE_Get_99, -- System.Pack_99
+ RE_Set_99, -- System.Pack_99
+
+ RE_Bits_100, -- System.Pack_100
+ RE_Get_100, -- System.Pack_100
+ RE_GetU_100, -- System.Pack_100
+ RE_Set_100, -- System.Pack_100
+ RE_SetU_100, -- System.Pack_100
+
+ RE_Bits_101, -- System.Pack_101
+ RE_Get_101, -- System.Pack_101
+ RE_Set_101, -- System.Pack_101
+
+ RE_Bits_102, -- System.Pack_102
+ RE_Get_102, -- System.Pack_102
+ RE_GetU_102, -- System.Pack_102
+ RE_Set_102, -- System.Pack_102
+ RE_SetU_102, -- System.Pack_102
+
+ RE_Bits_103, -- System.Pack_103
+ RE_Get_103, -- System.Pack_103
+ RE_Set_103, -- System.Pack_103
+
+ RE_Bits_104, -- System.Pack_104
+ RE_Get_104, -- System.Pack_104
+ RE_GetU_104, -- System.Pack_104
+ RE_Set_104, -- System.Pack_104
+ RE_SetU_104, -- System.Pack_104
+
+ RE_Bits_105, -- System.Pack_105
+ RE_Get_105, -- System.Pack_105
+ RE_Set_105, -- System.Pack_105
+
+ RE_Bits_106, -- System.Pack_106
+ RE_Get_106, -- System.Pack_106
+ RE_GetU_106, -- System.Pack_106
+ RE_Set_106, -- System.Pack_106
+ RE_SetU_106, -- System.Pack_106
+
+ RE_Bits_107, -- System.Pack_107
+ RE_Get_107, -- System.Pack_107
+ RE_Set_107, -- System.Pack_107
+
+ RE_Bits_108, -- System.Pack_108
+ RE_Get_108, -- System.Pack_108
+ RE_GetU_108, -- System.Pack_108
+ RE_Set_108, -- System.Pack_108
+ RE_SetU_108, -- System.Pack_108
+
+ RE_Bits_109, -- System.Pack_109
+ RE_Get_109, -- System.Pack_109
+ RE_Set_109, -- System.Pack_109
+
+ RE_Bits_110, -- System.Pack_110
+ RE_Get_110, -- System.Pack_110
+ RE_GetU_110, -- System.Pack_110
+ RE_Set_110, -- System.Pack_110
+ RE_SetU_110, -- System.Pack_110
+
+ RE_Bits_111, -- System.Pack_111
+ RE_Get_111, -- System.Pack_111
+ RE_Set_111, -- System.Pack_111
+
+ RE_Bits_112, -- System.Pack_112
+ RE_Get_112, -- System.Pack_112
+ RE_GetU_112, -- System.Pack_112
+ RE_Set_112, -- System.Pack_112
+ RE_SetU_112, -- System.Pack_112
+
+ RE_Bits_113, -- System.Pack_113
+ RE_Get_113, -- System.Pack_113
+ RE_Set_113, -- System.Pack_113
+
+ RE_Bits_114, -- System.Pack_114
+ RE_Get_114, -- System.Pack_114
+ RE_GetU_114, -- System.Pack_114
+ RE_Set_114, -- System.Pack_114
+ RE_SetU_114, -- System.Pack_114
+
+ RE_Bits_115, -- System.Pack_115
+ RE_Get_115, -- System.Pack_115
+ RE_Set_115, -- System.Pack_115
+
+ RE_Bits_116, -- System.Pack_116
+ RE_Get_116, -- System.Pack_116
+ RE_GetU_116, -- System.Pack_116
+ RE_Set_116, -- System.Pack_116
+ RE_SetU_116, -- System.Pack_116
+
+ RE_Bits_117, -- System.Pack_117
+ RE_Get_117, -- System.Pack_117
+ RE_Set_117, -- System.Pack_117
+
+ RE_Bits_118, -- System.Pack_118
+ RE_Get_118, -- System.Pack_118
+ RE_GetU_118, -- System.Pack_118
+ RE_Set_118, -- System.Pack_118
+ RE_SetU_118, -- System.Pack_118
+
+ RE_Bits_119, -- System.Pack_119
+ RE_Get_119, -- System.Pack_119
+ RE_Set_119, -- System.Pack_119
+
+ RE_Bits_120, -- System.Pack_120
+ RE_Get_120, -- System.Pack_120
+ RE_GetU_120, -- System.Pack_120
+ RE_Set_120, -- System.Pack_120
+ RE_SetU_120, -- System.Pack_120
+
+ RE_Bits_121, -- System.Pack_121
+ RE_Get_121, -- System.Pack_121
+ RE_Set_121, -- System.Pack_121
+
+ RE_Bits_122, -- System.Pack_122
+ RE_Get_122, -- System.Pack_122
+ RE_GetU_122, -- System.Pack_122
+ RE_Set_122, -- System.Pack_122
+ RE_SetU_122, -- System.Pack_122
+
+ RE_Bits_123, -- System.Pack_123
+ RE_Get_123, -- System.Pack_123
+ RE_Set_123, -- System.Pack_123
+
+ RE_Bits_124, -- System.Pack_124
+ RE_Get_124, -- System.Pack_124
+ RE_GetU_124, -- System.Pack_124
+ RE_Set_124, -- System.Pack_124
+ RE_SetU_124, -- System.Pack_124
+
+ RE_Bits_125, -- System.Pack_125
+ RE_Get_125, -- System.Pack_125
+ RE_Set_125, -- System.Pack_125
+
+ RE_Bits_126, -- System.Pack_126
+ RE_Get_126, -- System.Pack_126
+ RE_GetU_126, -- System.Pack_126
+ RE_Set_126, -- System.Pack_126
+ RE_SetU_126, -- System.Pack_126
+
+ RE_Bits_127, -- System.Pack_127
+ RE_Get_127, -- System.Pack_127
+ RE_Set_127, -- System.Pack_127
+
RE_Adjust_Storage_Size, -- System.Parameters
RE_Default_Secondary_Stack_Size, -- System.Parameters
RE_Default_Stack_Size, -- System.Parameters
RE_IS_Is2, -- System.Scalar_Values
RE_IS_Is4, -- System.Scalar_Values
RE_IS_Is8, -- System.Scalar_Values
+ RE_IS_Is16, -- System.Scalar_Values
RE_IS_Iu1, -- System.Scalar_Values
RE_IS_Iu2, -- System.Scalar_Values
RE_IS_Iu4, -- System.Scalar_Values
RE_IS_Iu8, -- System.Scalar_Values
- RE_IS_Iz1, -- System.Scalar_Values
- RE_IS_Iz2, -- System.Scalar_Values
- RE_IS_Iz4, -- System.Scalar_Values
- RE_IS_Iz8, -- System.Scalar_Values
+ RE_IS_Iu16, -- System.Scalar_Values
RE_IS_Isf, -- System.Scalar_Values
RE_IS_Ifl, -- System.Scalar_Values
RE_IS_Ilf, -- System.Scalar_Values
RE_Bits_2, -- System.Unsigned_Types
RE_Bits_4, -- System.Unsigned_Types
RE_Float_Unsigned, -- System.Unsigned_Types
- RE_Long_Unsigned, -- System.Unsigned_Types
RE_Long_Long_Unsigned, -- System.Unsigned_Types
RE_Packed_Byte, -- System.Unsigned_Types
RE_Packed_Bytes1, -- System.Unsigned_Types
RE_Rev_Packed_Bytes1, -- System.Unsigned_Types
RE_Rev_Packed_Bytes2, -- System.Unsigned_Types
RE_Rev_Packed_Bytes4, -- System.Unsigned_Types
- RE_Short_Unsigned, -- System.Unsigned_Types
- RE_Short_Short_Unsigned, -- System.Unsigned_Types
RE_Unsigned, -- System.Unsigned_Types
RE_Value_Boolean, -- System.Val_Bool
RE_Integer_16 => Interfaces,
RE_Integer_32 => Interfaces,
RE_Integer_64 => Interfaces,
+ RE_Integer_128 => Interfaces,
RE_Unsigned_8 => Interfaces,
RE_Unsigned_16 => Interfaces,
RE_Unsigned_32 => Interfaces,
RE_Unsigned_64 => Interfaces,
+ RE_Unsigned_128 => Interfaces,
RO_IC_Unsigned => Interfaces_C,
RO_IC_Unsigned_Long_Long => Interfaces_C,
RE_Address_Image => System_Address_Image,
- RE_Add_With_Ovflo_Check => System_Arith_64,
- RE_Double_Divide => System_Arith_64,
- RE_Multiply_With_Ovflo_Check => System_Arith_64,
- RE_Scaled_Divide => System_Arith_64,
- RE_Subtract_With_Ovflo_Check => System_Arith_64,
+ RE_Add_With_Ovflo_Check64 => System_Arith_64,
+ RE_Double_Divide64 => System_Arith_64,
+ RE_Multiply_With_Ovflo_Check64 => System_Arith_64,
+ RE_Scaled_Divide64 => System_Arith_64,
+ RE_Subtract_With_Ovflo_Check64 => System_Arith_64,
+
+ RE_Add_With_Ovflo_Check128 => System_Arith_128,
+ RE_Multiply_With_Ovflo_Check128 => System_Arith_128,
+ RE_Subtract_With_Ovflo_Check128 => System_Arith_128,
RE_Create_AST_Handler => System_AST_Handling,
RE_Bswap_16 => System_Byte_Swapping,
RE_Bswap_32 => System_Byte_Swapping,
RE_Bswap_64 => System_Byte_Swapping,
+ RE_Bswap_128 => System_Byte_Swapping,
RE_Compare_Array_S8 => System_Compare_Array_Signed_8,
RE_Compare_Array_S8_Unaligned => System_Compare_Array_Signed_8,
RE_Compare_Array_S64 => System_Compare_Array_Signed_64,
+ RE_Compare_Array_S128 => System_Compare_Array_Signed_128,
+
RE_Compare_Array_U8 => System_Compare_Array_Unsigned_8,
RE_Compare_Array_U8_Unaligned => System_Compare_Array_Unsigned_8,
RE_Compare_Array_U64 => System_Compare_Array_Unsigned_64,
+ RE_Compare_Array_U128 => System_Compare_Array_Unsigned_128,
+
RE_Str_Concat_2 => System_Concat_2,
RE_Str_Concat_3 => System_Concat_3,
RE_Str_Concat_4 => System_Concat_4,
RE_Exn_Long_Long_Integer => System_Exn_LLI,
+ RE_Exn_Long_Long_Long_Integer => System_Exn_LLLI,
+
RE_Exp_Integer => System_Exp_Int,
RE_Exp_Long_Long_Integer => System_Exp_LLI,
+ RE_Exp_Long_Long_Long_Integer => System_Exp_LLLI,
+
RE_Exp_Long_Long_Unsigned => System_Exp_LLU,
+ RE_Exp_Long_Long_Long_Unsigned => System_Exp_LLLU,
+
RE_Exp_Modular => System_Exp_Mod,
RE_Exp_Unsigned => System_Exp_Uns,
RE_Get_63 => System_Pack_63,
RE_Set_63 => System_Pack_63,
+ RE_Bits_65 => System_Pack_65,
+ RE_Get_65 => System_Pack_65,
+ RE_Set_65 => System_Pack_65,
+
+ RE_Bits_66 => System_Pack_66,
+ RE_Get_66 => System_Pack_66,
+ RE_GetU_66 => System_Pack_66,
+ RE_Set_66 => System_Pack_66,
+ RE_SetU_66 => System_Pack_66,
+
+ RE_Bits_67 => System_Pack_67,
+ RE_Get_67 => System_Pack_67,
+ RE_Set_67 => System_Pack_67,
+
+ RE_Bits_68 => System_Pack_68,
+ RE_Get_68 => System_Pack_68,
+ RE_GetU_68 => System_Pack_68,
+ RE_Set_68 => System_Pack_68,
+ RE_SetU_68 => System_Pack_68,
+
+ RE_Bits_69 => System_Pack_69,
+ RE_Get_69 => System_Pack_69,
+ RE_Set_69 => System_Pack_69,
+
+ RE_Bits_70 => System_Pack_70,
+ RE_Get_70 => System_Pack_70,
+ RE_GetU_70 => System_Pack_70,
+ RE_Set_70 => System_Pack_70,
+ RE_SetU_70 => System_Pack_70,
+
+ RE_Bits_71 => System_Pack_71,
+ RE_Get_71 => System_Pack_71,
+ RE_Set_71 => System_Pack_71,
+
+ RE_Bits_72 => System_Pack_72,
+ RE_Get_72 => System_Pack_72,
+ RE_GetU_72 => System_Pack_72,
+ RE_Set_72 => System_Pack_72,
+ RE_SetU_72 => System_Pack_72,
+
+ RE_Bits_73 => System_Pack_73,
+ RE_Get_73 => System_Pack_73,
+ RE_Set_73 => System_Pack_73,
+
+ RE_Bits_74 => System_Pack_74,
+ RE_Get_74 => System_Pack_74,
+ RE_GetU_74 => System_Pack_74,
+ RE_Set_74 => System_Pack_74,
+ RE_SetU_74 => System_Pack_74,
+
+ RE_Bits_75 => System_Pack_75,
+ RE_Get_75 => System_Pack_75,
+ RE_Set_75 => System_Pack_75,
+
+ RE_Bits_76 => System_Pack_76,
+ RE_Get_76 => System_Pack_76,
+ RE_GetU_76 => System_Pack_76,
+ RE_Set_76 => System_Pack_76,
+ RE_SetU_76 => System_Pack_76,
+
+ RE_Bits_77 => System_Pack_77,
+ RE_Get_77 => System_Pack_77,
+ RE_Set_77 => System_Pack_77,
+
+ RE_Bits_78 => System_Pack_78,
+ RE_Get_78 => System_Pack_78,
+ RE_GetU_78 => System_Pack_78,
+ RE_Set_78 => System_Pack_78,
+ RE_SetU_78 => System_Pack_78,
+
+ RE_Bits_79 => System_Pack_79,
+ RE_Get_79 => System_Pack_79,
+ RE_Set_79 => System_Pack_79,
+
+ RE_Bits_80 => System_Pack_80,
+ RE_Get_80 => System_Pack_80,
+ RE_GetU_80 => System_Pack_80,
+ RE_Set_80 => System_Pack_80,
+ RE_SetU_80 => System_Pack_80,
+
+ RE_Bits_81 => System_Pack_81,
+ RE_Get_81 => System_Pack_81,
+ RE_Set_81 => System_Pack_81,
+
+ RE_Bits_82 => System_Pack_82,
+ RE_Get_82 => System_Pack_82,
+ RE_GetU_82 => System_Pack_82,
+ RE_Set_82 => System_Pack_82,
+ RE_SetU_82 => System_Pack_82,
+
+ RE_Bits_83 => System_Pack_83,
+ RE_Get_83 => System_Pack_83,
+ RE_Set_83 => System_Pack_83,
+
+ RE_Bits_84 => System_Pack_84,
+ RE_Get_84 => System_Pack_84,
+ RE_GetU_84 => System_Pack_84,
+ RE_Set_84 => System_Pack_84,
+ RE_SetU_84 => System_Pack_84,
+
+ RE_Bits_85 => System_Pack_85,
+ RE_Get_85 => System_Pack_85,
+ RE_Set_85 => System_Pack_85,
+
+ RE_Bits_86 => System_Pack_86,
+ RE_Get_86 => System_Pack_86,
+ RE_GetU_86 => System_Pack_86,
+ RE_Set_86 => System_Pack_86,
+ RE_SetU_86 => System_Pack_86,
+
+ RE_Bits_87 => System_Pack_87,
+ RE_Get_87 => System_Pack_87,
+ RE_Set_87 => System_Pack_87,
+
+ RE_Bits_88 => System_Pack_88,
+ RE_Get_88 => System_Pack_88,
+ RE_GetU_88 => System_Pack_88,
+ RE_Set_88 => System_Pack_88,
+ RE_SetU_88 => System_Pack_88,
+
+ RE_Bits_89 => System_Pack_89,
+ RE_Get_89 => System_Pack_89,
+ RE_Set_89 => System_Pack_89,
+
+ RE_Bits_90 => System_Pack_90,
+ RE_Get_90 => System_Pack_90,
+ RE_GetU_90 => System_Pack_90,
+ RE_Set_90 => System_Pack_90,
+ RE_SetU_90 => System_Pack_90,
+
+ RE_Bits_91 => System_Pack_91,
+ RE_Get_91 => System_Pack_91,
+ RE_Set_91 => System_Pack_91,
+
+ RE_Bits_92 => System_Pack_92,
+ RE_Get_92 => System_Pack_92,
+ RE_GetU_92 => System_Pack_92,
+ RE_Set_92 => System_Pack_92,
+ RE_SetU_92 => System_Pack_92,
+
+ RE_Bits_93 => System_Pack_93,
+ RE_Get_93 => System_Pack_93,
+ RE_Set_93 => System_Pack_93,
+
+ RE_Bits_94 => System_Pack_94,
+ RE_Get_94 => System_Pack_94,
+ RE_GetU_94 => System_Pack_94,
+ RE_Set_94 => System_Pack_94,
+ RE_SetU_94 => System_Pack_94,
+
+ RE_Bits_95 => System_Pack_95,
+ RE_Get_95 => System_Pack_95,
+ RE_Set_95 => System_Pack_95,
+
+ RE_Bits_96 => System_Pack_96,
+ RE_Get_96 => System_Pack_96,
+ RE_GetU_96 => System_Pack_96,
+ RE_Set_96 => System_Pack_96,
+ RE_SetU_96 => System_Pack_96,
+
+ RE_Bits_97 => System_Pack_97,
+ RE_Get_97 => System_Pack_97,
+ RE_Set_97 => System_Pack_97,
+
+ RE_Bits_98 => System_Pack_98,
+ RE_Get_98 => System_Pack_98,
+ RE_GetU_98 => System_Pack_98,
+ RE_Set_98 => System_Pack_98,
+ RE_SetU_98 => System_Pack_98,
+
+ RE_Bits_99 => System_Pack_99,
+ RE_Get_99 => System_Pack_99,
+ RE_Set_99 => System_Pack_99,
+
+ RE_Bits_100 => System_Pack_100,
+ RE_Get_100 => System_Pack_100,
+ RE_GetU_100 => System_Pack_100,
+ RE_Set_100 => System_Pack_100,
+ RE_SetU_100 => System_Pack_100,
+
+ RE_Bits_101 => System_Pack_101,
+ RE_Get_101 => System_Pack_101,
+ RE_Set_101 => System_Pack_101,
+
+ RE_Bits_102 => System_Pack_102,
+ RE_Get_102 => System_Pack_102,
+ RE_GetU_102 => System_Pack_102,
+ RE_Set_102 => System_Pack_102,
+ RE_SetU_102 => System_Pack_102,
+
+ RE_Bits_103 => System_Pack_103,
+ RE_Get_103 => System_Pack_103,
+ RE_Set_103 => System_Pack_103,
+
+ RE_Bits_104 => System_Pack_104,
+ RE_Get_104 => System_Pack_104,
+ RE_GetU_104 => System_Pack_104,
+ RE_Set_104 => System_Pack_104,
+ RE_SetU_104 => System_Pack_104,
+
+ RE_Bits_105 => System_Pack_105,
+ RE_Get_105 => System_Pack_105,
+ RE_Set_105 => System_Pack_105,
+
+ RE_Bits_106 => System_Pack_106,
+ RE_Get_106 => System_Pack_106,
+ RE_GetU_106 => System_Pack_106,
+ RE_Set_106 => System_Pack_106,
+ RE_SetU_106 => System_Pack_106,
+
+ RE_Bits_107 => System_Pack_107,
+ RE_Get_107 => System_Pack_107,
+ RE_Set_107 => System_Pack_107,
+
+ RE_Bits_108 => System_Pack_108,
+ RE_Get_108 => System_Pack_108,
+ RE_GetU_108 => System_Pack_108,
+ RE_Set_108 => System_Pack_108,
+ RE_SetU_108 => System_Pack_108,
+
+ RE_Bits_109 => System_Pack_109,
+ RE_Get_109 => System_Pack_109,
+ RE_Set_109 => System_Pack_109,
+
+ RE_Bits_110 => System_Pack_110,
+ RE_Get_110 => System_Pack_110,
+ RE_GetU_110 => System_Pack_110,
+ RE_Set_110 => System_Pack_110,
+ RE_SetU_110 => System_Pack_110,
+
+ RE_Bits_111 => System_Pack_111,
+ RE_Get_111 => System_Pack_111,
+ RE_Set_111 => System_Pack_111,
+
+ RE_Bits_112 => System_Pack_112,
+ RE_Get_112 => System_Pack_112,
+ RE_GetU_112 => System_Pack_112,
+ RE_Set_112 => System_Pack_112,
+ RE_SetU_112 => System_Pack_112,
+
+ RE_Bits_113 => System_Pack_113,
+ RE_Get_113 => System_Pack_113,
+ RE_Set_113 => System_Pack_113,
+
+ RE_Bits_114 => System_Pack_114,
+ RE_Get_114 => System_Pack_114,
+ RE_GetU_114 => System_Pack_114,
+ RE_Set_114 => System_Pack_114,
+ RE_SetU_114 => System_Pack_114,
+
+ RE_Bits_115 => System_Pack_115,
+ RE_Get_115 => System_Pack_115,
+ RE_Set_115 => System_Pack_115,
+
+ RE_Bits_116 => System_Pack_116,
+ RE_Get_116 => System_Pack_116,
+ RE_GetU_116 => System_Pack_116,
+ RE_Set_116 => System_Pack_116,
+ RE_SetU_116 => System_Pack_116,
+
+ RE_Bits_117 => System_Pack_117,
+ RE_Get_117 => System_Pack_117,
+ RE_Set_117 => System_Pack_117,
+
+ RE_Bits_118 => System_Pack_118,
+ RE_Get_118 => System_Pack_118,
+ RE_GetU_118 => System_Pack_118,
+ RE_Set_118 => System_Pack_118,
+ RE_SetU_118 => System_Pack_118,
+
+ RE_Bits_119 => System_Pack_119,
+ RE_Get_119 => System_Pack_119,
+ RE_Set_119 => System_Pack_119,
+
+ RE_Bits_120 => System_Pack_120,
+ RE_Get_120 => System_Pack_120,
+ RE_GetU_120 => System_Pack_120,
+ RE_Set_120 => System_Pack_120,
+ RE_SetU_120 => System_Pack_120,
+
+ RE_Bits_121 => System_Pack_121,
+ RE_Get_121 => System_Pack_121,
+ RE_Set_121 => System_Pack_121,
+
+ RE_Bits_122 => System_Pack_122,
+ RE_Get_122 => System_Pack_122,
+ RE_GetU_122 => System_Pack_122,
+ RE_Set_122 => System_Pack_122,
+ RE_SetU_122 => System_Pack_122,
+
+ RE_Bits_123 => System_Pack_123,
+ RE_Get_123 => System_Pack_123,
+ RE_Set_123 => System_Pack_123,
+
+ RE_Bits_124 => System_Pack_124,
+ RE_Get_124 => System_Pack_124,
+ RE_GetU_124 => System_Pack_124,
+ RE_Set_124 => System_Pack_124,
+ RE_SetU_124 => System_Pack_124,
+
+ RE_Bits_125 => System_Pack_125,
+ RE_Get_125 => System_Pack_125,
+ RE_Set_125 => System_Pack_125,
+
+ RE_Bits_126 => System_Pack_126,
+ RE_Get_126 => System_Pack_126,
+ RE_GetU_126 => System_Pack_126,
+ RE_Set_126 => System_Pack_126,
+ RE_SetU_126 => System_Pack_126,
+
+ RE_Bits_127 => System_Pack_127,
+ RE_Get_127 => System_Pack_127,
+ RE_Set_127 => System_Pack_127,
+
RE_Adjust_Storage_Size => System_Parameters,
RE_Default_Secondary_Stack_Size => System_Parameters,
RE_Default_Stack_Size => System_Parameters,
RE_IS_Is2 => System_Scalar_Values,
RE_IS_Is4 => System_Scalar_Values,
RE_IS_Is8 => System_Scalar_Values,
+ RE_IS_Is16 => System_Scalar_Values,
RE_IS_Iu1 => System_Scalar_Values,
RE_IS_Iu2 => System_Scalar_Values,
RE_IS_Iu4 => System_Scalar_Values,
RE_IS_Iu8 => System_Scalar_Values,
- RE_IS_Iz1 => System_Scalar_Values,
- RE_IS_Iz2 => System_Scalar_Values,
- RE_IS_Iz4 => System_Scalar_Values,
- RE_IS_Iz8 => System_Scalar_Values,
+ RE_IS_Iu16 => System_Scalar_Values,
RE_IS_Isf => System_Scalar_Values,
RE_IS_Ifl => System_Scalar_Values,
RE_IS_Ilf => System_Scalar_Values,
RE_Bits_2 => System_Unsigned_Types,
RE_Bits_4 => System_Unsigned_Types,
RE_Float_Unsigned => System_Unsigned_Types,
- RE_Long_Unsigned => System_Unsigned_Types,
RE_Long_Long_Unsigned => System_Unsigned_Types,
RE_Packed_Byte => System_Unsigned_Types,
RE_Packed_Bytes1 => System_Unsigned_Types,
RE_Rev_Packed_Bytes1 => System_Unsigned_Types,
RE_Rev_Packed_Bytes2 => System_Unsigned_Types,
RE_Rev_Packed_Bytes4 => System_Unsigned_Types,
- RE_Short_Unsigned => System_Unsigned_Types,
- RE_Short_Short_Unsigned => System_Unsigned_Types,
RE_Unsigned => System_Unsigned_Types,
RE_Value_Boolean => System_Val_Bool,
return Standard_Long_Unsigned;
elsif Siz = Esize (Standard_Long_Long_Integer) then
return Standard_Long_Long_Unsigned;
+ elsif Siz = Esize (Standard_Long_Long_Long_Integer) then
+ return Standard_Long_Long_Long_Unsigned;
else
raise Program_Error;
end if;
elsif B = Base_Type (Standard_Long_Long_Integer) then
return Standard_Long_Long_Integer;
+ elsif B = Base_Type (Standard_Long_Long_Long_Integer) then
+ return Standard_Long_Long_Long_Integer;
+
elsif Is_Generic_Type (Typ) then
if Present (Parent (B)) then
return Defining_Identifier (Parent (B));
else
if Is_Elementary_Type (Etyp)
and then Size /= System_Storage_Unit
- and then Size /= System_Storage_Unit * 2
- and then Size /= System_Storage_Unit * 4
- and then Size /= System_Storage_Unit * 8
+ and then Size /= 16
+ and then Size /= 32
+ and then Size /= 64
+ and then Size /= System_Max_Integer_Size
then
Error_Msg_Uint_1 := UI_From_Int (System_Storage_Unit);
- Error_Msg_Uint_2 := Error_Msg_Uint_1 * 8;
+ Error_Msg_Uint_2 := UI_From_Int (System_Max_Integer_Size);
Error_Msg_N
("size for primitive object must be a power of 2 in "
& "the range ^-^", N);
begin
Init_Alignment (T);
- -- Find the minimum standard size (8,16,32,64) that fits
+ -- Find the minimum standard size (8,16,32,64,128) that fits
Lo := Enumeration_Rep (Entity (Type_Low_Bound (T)));
Hi := Enumeration_Rep (Entity (Type_High_Bound (T)));
elsif Lo >= -Uint_2**31 and then Hi < Uint_2**31 then
Sz := 32;
- else pragma Assert (Lo >= -Uint_2**63 and then Hi < Uint_2**63);
+ elsif Lo >= -Uint_2**63 and then Hi < Uint_2**63 then
Sz := 64;
+
+ else pragma Assert (Lo >= -Uint_2**127 and then Hi < Uint_2**127);
+ Sz := 128;
end if;
else
elsif Hi < Uint_2**32 then
Sz := 32;
- else pragma Assert (Hi < Uint_2**63);
+ elsif Hi < Uint_2**64 then
Sz := 64;
+
+ else pragma Assert (Hi < Uint_2**128);
+ Sz := 128;
end if;
end if;
----------------------
procedure Set_Modular_Size (Bits : Int) is
+ Siz : Int;
+
begin
Set_RM_Size (T, UI_From_Int (Bits));
- if Bits <= 8 then
- Init_Esize (T, 8);
+ if Bits < System_Max_Binary_Modulus_Power then
+ Siz := 8;
- elsif Bits <= 16 then
- Init_Esize (T, 16);
+ while Siz < 128 loop
+ exit when Bits <= Siz;
+ Siz := Siz * 2;
+ end loop;
- elsif Bits <= 32 then
- Init_Esize (T, 32);
+ Init_Esize (T, Siz);
else
Init_Esize (T, System_Max_Binary_Modulus_Power);
begin
-- If the mod expression is (exactly) 2 * literal, where literal is
- -- 64 or less,then almost certainly the * was meant to be **. Warn.
+ -- 128 or less,then almost certainly the * was meant to be **. Warn.
if Warn_On_Suspicious_Modulus_Value
and then Nkind (Mod_Expr) = N_Op_Multiply
and then Nkind (Left_Opnd (Mod_Expr)) = N_Integer_Literal
and then Intval (Left_Opnd (Mod_Expr)) = Uint_2
and then Nkind (Right_Opnd (Mod_Expr)) = N_Integer_Literal
- and then Intval (Right_Opnd (Mod_Expr)) <= Uint_64
+ and then Intval (Right_Opnd (Mod_Expr)) <= Uint_128
then
Error_Msg_N
("suspicious MOD value, was '*'* intended'??M?", Mod_Expr);
Check_Bound (Hi);
if Errs then
- Hi := Type_High_Bound (Standard_Long_Long_Integer);
- Lo := Type_Low_Bound (Standard_Long_Long_Integer);
+ Hi := Type_High_Bound (Standard_Long_Long_Long_Integer);
+ Lo := Type_Low_Bound (Standard_Long_Long_Long_Integer);
end if;
-- Find type to derive from
Check_Restriction (No_Long_Long_Integers, Def);
Base_Typ := Base_Type (Standard_Long_Long_Integer);
+ elsif Can_Derive_From (Standard_Long_Long_Long_Integer) then
+ Check_Restriction (No_Long_Long_Integers, Def);
+ Base_Typ := Base_Type (Standard_Long_Long_Long_Integer);
+
else
- Base_Typ := Base_Type (Standard_Long_Long_Integer);
+ Base_Typ := Base_Type (Standard_Long_Long_Long_Integer);
Error_Msg_N ("integer type definition bounds out of range", Def);
- Hi := Type_High_Bound (Standard_Long_Long_Integer);
- Lo := Type_Low_Bound (Standard_Long_Long_Integer);
+ Hi := Type_High_Bound (Standard_Long_Long_Long_Integer);
+ Lo := Type_Low_Bound (Standard_Long_Long_Long_Integer);
end if;
end if;
begin
-- A special warning check, if we have an expression of the form:
-- expr mod 2 * literal
- -- where literal is 64 or less, then probably what was meant was
+ -- where literal is 128 or less, then probably what was meant was
-- expr mod 2 ** literal
-- so issue an appropriate warning.
and then Intval (Right_Opnd (N)) = Uint_2
and then Nkind (Parent (N)) = N_Op_Multiply
and then Nkind (Right_Opnd (Parent (N))) = N_Integer_Literal
- and then Intval (Right_Opnd (Parent (N))) <= Uint_64
+ and then Intval (Right_Opnd (Parent (N))) <= Uint_128
then
Error_Msg_N
("suspicious MOD value, was '*'* intended'??M?", Parent (N));
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
+with Ttypes; use Ttypes;
with Uintp; use Uintp;
package body Sem_Intr is
if Size /= 8 and then
Size /= 16 and then
Size /= 32 and then
- Size /= 64
+ Size /= 64 and then
+ Size /= System_Max_Integer_Size
then
- Errint
- ("first argument for shift must have size 8, 16, 32 or 64",
- Ptyp1, N, Relaxed => True);
+ if System_Max_Integer_Size > 64 then
+ Errint
+ ("first argument for shift must have size 8, 16, 32, 64 or 128",
+ Ptyp1, N, Relaxed => True);
+ else
+ Errint
+ ("first argument for shift must have size 8, 16, 32 or 64",
+ Ptyp1, N, Relaxed => True);
+ end if;
return;
elsif Non_Binary_Modulus (Typ1) then
and then Modulus (Typ1) /= Uint_2 ** 16
and then Modulus (Typ1) /= Uint_2 ** 32
and then Modulus (Typ1) /= Uint_2 ** 64
+ and then Modulus (Typ1) /= Uint_2 ** System_Max_Binary_Modulus_Power
then
- Errint
- ("modular type for shift must have modulus of 2'*'*8, "
- & "2'*'*16, 2'*'*32, or 2'*'*64", Ptyp1, N, Relaxed => True);
+ if System_Max_Binary_Modulus_Power > 64 then
+ Errint
+ ("modular type for shift must have modulus of 2'*'*8, "
+ & "2'*'*16, 2'*'*32, 2'*'*64 or 2'*'*128", Ptyp1, N,
+ Relaxed => True);
+ else
+ Errint
+ ("modular type for shift must have modulus of 2'*'*8, "
+ & "2'*'*16, 2'*'*32, or 2'*'*64", Ptyp1, N,
+ Relaxed => True);
+ end if;
elsif Etype (Arg1) /= Etype (E) then
Errint
-- Short_Float
-- | Float
-- | Long_Float
- -- | Long_Long_Flat
+ -- | Long_Long_Float
-- | Signed_8
-- | Signed_16
-- | Signed_32
-- | Signed_64
+ -- | Signed_128
-- | Unsigned_8
-- | Unsigned_16
-- | Unsigned_32
-- | Unsigned_64
+ -- | Unsigned_128
when Pragma_Initialize_Scalars => Do_Initialize_Scalars : declare
Seen : array (Scalar_Id) of Node_Id := (others => Empty);
begin
Analyze_And_Resolve (Val_Expr, Any_Integer);
- if Is_OK_Static_Expression (Val_Expr) then
+ if (Scal_Typ = Name_Signed_128
+ or else Scal_Typ = Name_Unsigned_128)
+ and then Ttypes.System_Max_Integer_Size < 128
+ then
+ Error_Msg_Name_1 := Scal_Typ;
+ Error_Msg_N ("value cannot be set for type %", Val_Expr);
+
+ elsif Is_OK_Static_Expression (Val_Expr) then
Set_Invalid_Scalar_Value (Scal_Typ, Expr_Value (Val_Expr));
else
-- Addressable --
-----------------
- -- For now, just 8/16/32/64
-
function Addressable (V : Uint) return Boolean is
begin
return V = Uint_8 or else
V = Uint_16 or else
V = Uint_32 or else
- V = Uint_64;
+ V = Uint_64 or else
+ (V = Uint_128 and then System_Max_Integer_Size = 128);
end Addressable;
function Addressable (V : Int) return Boolean is
return V = 8 or else
V = 16 or else
V = 32 or else
- V = 64;
+ V = 64 or else
+ V = System_Max_Integer_Size;
end Addressable;
---------------------------------
Name_Signed_16 => RTE (RE_IS_Is2),
Name_Signed_32 => RTE (RE_IS_Is4),
Name_Signed_64 => RTE (RE_IS_Is8),
+ Name_Signed_128 => Empty,
Name_Unsigned_8 => RTE (RE_IS_Iu1),
Name_Unsigned_16 => RTE (RE_IS_Iu2),
Name_Unsigned_32 => RTE (RE_IS_Iu4),
- Name_Unsigned_64 => RTE (RE_IS_Iu8));
+ Name_Unsigned_64 => RTE (RE_IS_Iu8),
+ Name_Unsigned_128 => Empty);
+
+ if System_Max_Integer_Size < 128 then
+ Invalid_Binder_Values (Name_Signed_128) := RTE (RE_IS_Is8);
+ Invalid_Binder_Values (Name_Unsigned_128) := RTE (RE_IS_Iu8);
+ else
+ Invalid_Binder_Values (Name_Signed_128) := RTE (RE_IS_Is16);
+ Invalid_Binder_Values (Name_Unsigned_128) := RTE (RE_IS_Iu16);
+ end if;
end if;
end Set_Invalid_Binder_Values;
function Addressable (V : Int) return Boolean;
pragma Inline (Addressable);
-- Returns True if the value of V is the word size or an addressable factor
- -- of the word size (typically 8, 16, 32 or 64).
+ -- or multiple of the word size (typically 8, 16, 32, 64 or 128).
procedure Aggregate_Constraint_Checks
(Exp : Node_Id;
S_Float_Words_BE : constant Str := "Float_Words_BE";
S_Int_Size : constant Str := "Int_Size";
S_Long_Double_Size : constant Str := "Long_Double_Size";
+ S_Long_Long_Long_Size : constant Str := "Long_Long_Long_Size";
S_Long_Long_Size : constant Str := "Long_Long_Size";
S_Long_Size : constant Str := "Long_Size";
S_Maximum_Alignment : constant Str := "Maximum_Alignment";
S_Float_Size 'Unrestricted_Access,
S_Float_Words_BE 'Unrestricted_Access,
S_Int_Size 'Unrestricted_Access,
+ S_Long_Long_Long_Size 'Unrestricted_Access,
S_Long_Double_Size 'Unrestricted_Access,
S_Long_Long_Size 'Unrestricted_Access,
S_Long_Size 'Unrestricted_Access,
Float_Words_BE 'Address,
Int_Size 'Address,
Long_Double_Size 'Address,
+ Long_Long_Long_Size 'Address,
Long_Long_Size 'Address,
Long_Size 'Address,
Maximum_Alignment 'Address,
Double_Scalar_Alignment := Get_Double_Scalar_Alignment;
Float_Words_BE := Get_Float_Words_BE;
Int_Size := Get_Int_Size;
+ Long_Long_Long_Size := Get_Long_Long_Long_Size;
Long_Long_Size := Get_Long_Long_Size;
Long_Size := Get_Long_Size;
Maximum_Alignment := Get_Maximum_Alignment;
Float_Words_BE : Nat; -- Float words stored big-endian?
Int_Size : Pos; -- Standard.Integer'Size
Long_Double_Size : Pos; -- Standard.Long_Long_Float'Size
+ Long_Long_Long_Size : Pos; -- Standard.Long_Long_Long_Integer'Size
Long_Long_Size : Pos; -- Standard.Long_Long_Integer'Size
Long_Size : Pos; -- Standard.Long_Integer'Size
Maximum_Alignment : Pos; -- Maximum permitted alignment
Name_Signed_16 : constant Name_Id := N + $; -- GNAT
Name_Signed_32 : constant Name_Id := N + $; -- GNAT
Name_Signed_64 : constant Name_Id := N + $; -- GNAT
+ Name_Signed_128 : constant Name_Id := N + $; -- GNAT
Name_Unsigned_8 : constant Name_Id := N + $; -- GNAT
Name_Unsigned_16 : constant Name_Id := N + $; -- GNAT
Name_Unsigned_32 : constant Name_Id := N + $; -- GNAT
Name_Unsigned_64 : constant Name_Id := N + $; -- GNAT
+ Name_Unsigned_128 : constant Name_Id := N + $; -- GNAT
subtype Scalar_Id is Name_Id
- range Name_Short_Float .. Name_Unsigned_64;
+ range Name_Short_Float .. Name_Unsigned_128;
subtype Float_Scalar_Id is Name_Id
range Name_Short_Float .. Name_Long_Long_Float;
subtype Integer_Scalar_Id is Name_Id
- range Name_Signed_8 .. Name_Unsigned_64;
+ range Name_Signed_8 .. Name_Unsigned_128;
-- Names of recognized checks for pragma Suppress
Universal_Integer : Entity_Id;
-- Entity for universal integer type. The bounds of this type correspond
- -- to the largest supported integer type (i.e. Long_Long_Integer). It is
- -- the type used for runtime calculations in type universal integer.
+ -- to the largest supported integer type (i.e. Long_Long_Long_Integer).
+ -- It is the type used for runtime calculations in type universal integer.
Universal_Real : Entity_Id;
-- Entity for universal real type. The bounds of this type correspond to
-- These are signed integer types with the indicated sizes. Used for the
-- underlying implementation types for fixed-point and enumeration types.
- Standard_Short_Short_Unsigned : Entity_Id;
- Standard_Short_Unsigned : Entity_Id;
- Standard_Unsigned : Entity_Id;
- Standard_Long_Unsigned : Entity_Id;
- Standard_Long_Long_Unsigned : Entity_Id;
+ Standard_Short_Short_Unsigned : Entity_Id;
+ Standard_Short_Unsigned : Entity_Id;
+ Standard_Unsigned : Entity_Id;
+ Standard_Long_Unsigned : Entity_Id;
+ Standard_Long_Long_Unsigned : Entity_Id;
+ Standard_Long_Long_Long_Unsigned : Entity_Id;
-- Unsigned types with same Esize as corresponding signed integer types
Standard_Unsigned_64 : Entity_Id;
Disable_Switch_Storing;
Ptr := Ptr + 1;
+ -- -gnate128 (Enable 128-bit types)
+
+ when '1' =>
+ if Ptr = Max then
+ Bad_Switch ("-gnate1");
+ end if;
+
+ Ptr := Ptr + 1;
+
+ if Switch_Chars (Ptr) /= '2' then
+ Bad_Switch ("-gnate1" & Switch_Chars (Ptr .. Max));
+ end if;
+
+ Ptr := Ptr + 1;
+
+ if Switch_Chars (Ptr) /= '8' then
+ Bad_Switch ("-gnate12" & Switch_Chars (Ptr .. Max));
+ end if;
+
+ Enable_128bit_Types := True;
+ Ptr := Ptr + 1;
+
-- All other -gnate? switches are unassigned
when others =>
Get_Targ.Width_From_Size
(Standard_Long_Long_Integer_Size);
+ Standard_Long_Long_Long_Integer_Size : Pos :=
+ Set_Targ.Long_Long_Long_Size;
+ Standard_Long_Long_Long_Integer_Width : Pos :=
+ Get_Targ.Width_From_Size
+ (Standard_Long_Long_Long_Integer_Size);
+
Standard_Short_Float_Size : constant Pos :=
Set_Targ.Float_Size;
Standard_Short_Float_Digits : constant Pos :=
System_Address_Size : constant Pos := Set_Targ.Pointer_Size;
-- System.Address'Size (also size of all thin pointers)
- System_Max_Integer_Size : constant Pos := Standard_Long_Long_Integer_Size;
+ System_Max_Integer_Size : Pos := Standard_Long_Long_Long_Integer_Size;
- System_Max_Binary_Modulus_Power : constant Pos :=
- Standard_Long_Long_Integer_Size;
+ System_Max_Binary_Modulus_Power : Pos :=
+ Standard_Long_Long_Long_Integer_Size;
System_Max_Nonbinary_Modulus_Power : constant Pos := Standard_Integer_Size;
Uint_Int_Last : Uint;
-- Uint value containing Int'Last value set by Initialize
- UI_Power_2 : array (Int range 0 .. 64) of Uint;
+ UI_Power_2 : array (Int range 0 .. 128) of Uint;
-- This table is used to memoize exponentiations by powers of 2. The Nth
-- entry, if set, contains the Uint value 2**N. Initially UI_Power_2_Set
-- is zero and only the 0'th entry is set, the invariant being that all
UI_Power_2_Set : Nat;
-- Number of entries set in UI_Power_2;
- UI_Power_10 : array (Int range 0 .. 64) of Uint;
+ UI_Power_10 : array (Int range 0 .. 128) of Uint;
-- This table is used to memoize exponentiations by powers of 10 in the
-- same manner as described above for UI_Power_2.
-- Cases which can be done by table lookup
- elsif Right <= Uint_64 then
+ elsif Right <= Uint_128 then
- -- 2**N for N in 2 .. 64
+ -- 2**N for N in 2 .. 128
if Left = Uint_2 then
declare
return UI_Power_2 (Right_Int);
end;
- -- 10**N for N in 2 .. 64
+ -- 10**N for N in 2 .. 128
elsif Left = Uint_10 then
declare
Uint_63 : constant Uint;
Uint_64 : constant Uint;
Uint_80 : constant Uint;
+ Uint_127 : constant Uint;
Uint_128 : constant Uint;
Uint_Minus_1 : constant Uint;
Uint_63 : constant Uint := Uint (Uint_Direct_Bias + 63);
Uint_64 : constant Uint := Uint (Uint_Direct_Bias + 64);
Uint_80 : constant Uint := Uint (Uint_Direct_Bias + 80);
+ Uint_127 : constant Uint := Uint (Uint_Direct_Bias + 127);
Uint_128 : constant Uint := Uint (Uint_Direct_Bias + 128);
Uint_Minus_1 : constant Uint := Uint (Uint_Direct_Bias - 1);
-- No line for -gnatez : internal switch
+ -- Line for -gnate128 switch
+
+ Write_Switch_Char ("e128");
+ Write_Line ("Enable support for 128-bit types");
+
-- Line for -gnatE switch
Write_Switch_Char ("E");
raise Program_Error;
exception
when Exc : Constraint_Error =>
- if Exception_Message (Exc) /= "System.Arith_64.Raise_Error: 64-bit arithmetic overflow" then
+ if Exception_Message (Exc) /= "System.Arith_64.Impl.Raise_Error: Double arithmetic overflow" then
raise Program_Error;
end if;
-end Multfixed;
\ No newline at end of file
+end Multfixed;
projects / thirdparty / gcc.git / commitdiff
