diff options
| author | Eric Botcazou <ebotcazou@adacore.com> | 2020-08-07 15:41:06 +0200 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-10-21 03:22:49 -0400 |
| commit | a5476382a7f9a9732b1c0095cbd9cbc3ecd99edb (patch) | |
| tree | 6d805d80a6ff2d321ce601626721119f0c96568d /gcc | |
| parent | 6551e4cb27c82db40a6f7dc24f609423a0f6b49d (diff) | |
| download | gcc-a5476382a7f9a9732b1c0095cbd9cbc3ecd99edb.zip gcc-a5476382a7f9a9732b1c0095cbd9cbc3ecd99edb.tar.gz gcc-a5476382a7f9a9732b1c0095cbd9cbc3ecd99edb.tar.bz2 | |
[Ada] Basic support for 128-bit types
gcc/ada/
* Makefile.rtl (GNATRTL_128BIT_PAIRS): New variable.
(GNATRTL_128BIT_OBJS): Likewise.
(Windows): In 64-bit mode, add the former to LIBGNAT_TARGET_PAIRS and
the latter to EXTRA_GNATRTL_NONTASKING_OBJS.
(x86_64/linux): Likewise, but unconditionally.
(GNATRTL_NONTASKING_OBJS): Add s-aridou, s-exponn, s-expont,
s-exponu.
* ada_get_targ.adb (Get_Long_Long_Long_Size): New function.
* checks.adb (Apply_Arithmetic_Overflow_Strict): Use Integer_Type_For
to find an appropriate integer type; if it does not exist and the max
integer size is larger than 64, use the 128-bit arithmetic routines.
* cstand.adb (Create_Standard): Build Standard_Long_Long_Long_Integer
and its base type. Use it for Etype of Any_Integer, Any_Modular and
Any_Numeric. Use its size for Build Standard_Long_Long_Long_Unsigned
and Universal_Integer.
(Print_Standard): Print Long_Long_Long_Integer.
* exp_attr.adb (Expand_N_Attribute_Reference) <Attribute_Mod>: Adjust
comment.
* exp_ch3.adb (Simple_Init_Initialize_Scalars_Type): Deal with 128-bit
types.
* exp_ch4.adb (Expand_Array_Comparison): Likewise.
(Expand_N_Op_Expon): Likewise.
(Narrow_Large_Operation): Likewise.
* exp_dbug.adb (Bounds_Match_Size): Handle 128-bit size.
* exp_fixd.adb (Build_Double_Divide_Code): Use RE_Double_Divide64.
* exp_intr.adb (Expand_Binary_Operator_Call): Handle 128-bit size.
* exp_pakd.ads (E_Array): Extend range to 127.
(Bits_Id): Fill in up to 127.
(Get_Id): Likewise.
(GetU_Id): Likewise.
(Set_Id): Likewise.
(SetU_Id): Likewise.
* exp_pakd.adb (Revert_Storage_Order): Handle 128-bit size.
* exp_util.adb (Integer_Type_For): Likewise.
(Small_Integer_Type_For): Likewise.
* fname.adb (Is_Predefined_File_Name): Do not return False for names
larger than 12 characters if they start with "s-".
* freeze.adb (Adjust_Esize_For_Alignment): Change the maximum value
to System_Max_Integer_Size.
(Check_Suspicious_Modulus): Adjust comment.
(Freeze_Entity): Likewise.
* get_targ.ads (Get_Long_Long_Long_Size): New function.
* get_targ.adb (Get_Long_Long_Long_Size): Likewise.
(Width_From_Size): Deal with 128-bit size.
* gnat1drv.adb (Adjust_Global_Switches): Deal with 128-bit types.
* impunit.adb (Get_Kind_Of_File): Bump buffer size. Accept files with
13 characters if they start with 's'. Compare slice of Buffer.
(Not_Impl_Defined_Unit): Accept files with 13 characters if they start
with 's'.
* krunch.ads: Document length for 128-bit support units.
* krunch.adb (Krunch): Set length to 9 for 128-bit support units.
* layout.adb (Layout_Type): Use System_Max_Integer_Size as alignment
limit.
* rtsfind.ads (RTU_Id): Add System_Arith_128,
System_Compare_Array_Signed_128, System_Compare_Array_Unsigned_128,
System_Exn_LLLI, System_Exp_LLLU, System_Pack_[65..127].
(RE_Id): Add RE_Integer_128, RE_Unsigned_128, RE_Add_With_Ovflo_Check128
RE_Multiply_With_Ovflo_Check128, RE_Subtract_With_Ovflo_Check128,
RE_Bswap_128, RE_Compare_Array_S128, RE_Compare_Array_U128,
RE_Exn_Long_Long_Long_Integer, RE_Exp_Long_Long_Long_Integer,
RE_Exp_Long_Long_Long_Unsigned, RE_Bits_[65-127], RE_Get_[65-127],
RE_Set_[65-127], RE_IS_Is16, RE_IS_Iu16, RE_Integer_128 and
RE_Unsigned_128. Rename RE_Add_With_Ovflo_Check, RE_Double_Divide,
RE_Multiply_With_Ovflo_Check, RE_Scaled_Divide and
RE_Subtract_With_Ovflo_Check. Remove RE_IS_Iz1, RE_IS_Iz2, RE_IS_Iz4,
RE_IS_Iz8, RE_Long_Unsigned, RE_Short_Unsigned, RE_Short_Short_Unsigned
(RE_Unit_Table): Likewise.
* sem_aux.adb (Corresponding_Unsigned_Type): Deal with a size equal to
that of Standard_Long_Long_Long_Integer.
(First_Subtype): Deal with Standard_Long_Long_Long_Integer'Base.
* sem_ch13.adb (Analyze_Attribute_Definition_Clause) <Attribute_Size>:
Check the size against powers of 2 and System_Max_Integer_Size for
objects as well.
(Set_Enum_Esize): Deal with 128-bit bounds.
* sem_ch3.adb (Set_Modular_Size): Handle 128-bit size.
(Modular_Type_Declaration): Deal with 128-bit types.
(Signed_Integer_Type_Declaration): Support derivation from
Standard_Long_Long_Long_Integer.
* sem_ch4.adb (Analyze_Mod): Handle 128-bit modulus.
* sem_intr.adb: Add with and use clauses for Ttypes.
(Check_Shift): Handle 128-bit size and modulus.
* sem_prag.adb (Analyze_Pragma) <Pragma_Initialize_Scalars>: Deal
with Signed_128 and Unsigned_128.
(Analyze_Integer_Value): Handle 128-bit size.
* sem_util.ads (Addressable): Adjust description.
* sem_util.adb (Addressable): Return true for 128 if the system
supports 128 bits.
(Set_Invalid_Binder_Values): Deal with Signed_128 and Unsigned_128.
* set_targ.ads (Long_Long_Long_Size): New variable.
* set_targ.adb (S_Long_Long_Long_Size): New constant.
(DTN): Add entry for S_Long_Long_Long_Size.
(DTV): Add entry for Long_Long_Long_Size.
(Set_Targ): Set Long_Long_Long_Size.
* snames.ads-tmpl (Name_Max_Integer_Size): New attribute name.
(Name_Signed_128): New scalar name.
(Name_Unsigned_128): Likewise.
(Scalar_Id): Adjust.
(Integer_Scalar_Id): Likewise.
(Attribute_Id): Add Attribute_Max_Integer_Size.
* stand.ads (Standard_Entity_Type): Add S_Long_Long_Long_Integer.
(Standard_Long_Long_Long_Integer): New renaming.
(Universal_Integer): Adjust description.
(Standard_Long_Long_Long_Unsigned): New variable.
* switch-c.adb (Scan_Front_End_Switches): Deal with -gnate128.
* ttypes.ads (Standard_Long_Long_Long_Integer_Size): New variable.
(Standard_Long_Long_Long_Integer_Width): Likewise.
(System_Max_Integer_Size): Turn into variable.
(System_Max_Binary_Modulus_Power): Likewise.
* uintp.ads (Uint_127): New constant.
* uintp.adb (UI_Power_2): Extednd to 128.
(UI_Power_10): Likewise.
(UI_Expon): Deal with exponent up to 128 specially.
* usage.adb (Write_Switch_Char): Print -gnate128 switch.
* libgnat/a-tifiio.adb (Put_Scaled): Call Scaled_Divide64.
* libgnat/interfac__2020.ads (Integer_128): New integer type.
(Unsigned_128): New modular type.
(Shift_Left, Shift_Right, Shift_Right_Arithmetic, Rotate_Left,
Rotate_Right): New intrinsic functions operating on it.
* libgnat/s-aridou.ads, libgnat/s-aridou.adb: New generic
package.
* libgnat/s-arit64.ads, libgnat/s-arit64.adb: Instantiate
System.Arithmetic_Double.
* libgnat/s-arit128.ads, libgnat/s-arit128.adb: Likewise.
* libgnat/s-bytswa.ads: Add with clause for Interfaces, use subtypes
of unsigned types defined in Interfaces and add Bswap_128.
* libgnat/s-casi128.ads, libgnat/s-casi128.adb: New package.
* libgnat/s-caun128.ads, libgnat/s-caun128.adb: Likewise.
* libgnat/s-exnint.ads: Instantiate System.Exponn.
* libgnat/s-exnint.adb: Add pragma No_Body.
* libgnat/s-exnlli.ads: Instantiate System.Exponn.
* libgnat/s-exnlli.adb: Add pragma No_Body.
* libgnat/s-exnllli.ads: Instantiate System.Exponn.
* libgnat/s-expint.ads: Likewise.
* libgnat/s-expint.adb: Add pragma No_Body.
* libgnat/s-explli.ads: Instantiate System.Exponn.
* libgnat/s-explli.adb: Add pragma No_Body.
* libgnat/s-expllli.ads: Instantiate System.Exponn.
* libgnat/s-explllu.ads: Instantiate System.Exponu.
* libgnat/s-expllu.ads: Likewise.
* libgnat/s-expllu.adb: Add pragma No_Body.
* libgnat/s-exponn.ads, libgnat/s-exponn.adb: New generic
function.
* libgnat/s-expont.ads, libgnat/s-expont.adb: Likewise.
* libgnat/s-exponu.ads, libgnat/s-exponu.adb: Likewise.
* libgnat/s-expuns.ads, libgnat/s-expuns.adb: Likewise.
* libgnat/s-pack65.ads, libgnat/s-pack65.adb: New package.
* libgnat/s-pack66.ads, libgnat/s-pack66.adb: New package.
* libgnat/s-pack67.ads, libgnat/s-pack67.adb: New package.
* libgnat/s-pack68.ads, libgnat/s-pack68.adb: New package.
* libgnat/s-pack69.ads, libgnat/s-pack69.adb: New package.
* libgnat/s-pack70.ads, libgnat/s-pack70.adb: New package.
* libgnat/s-pack71.ads, libgnat/s-pack71.adb: New package.
* libgnat/s-pack72.ads, libgnat/s-pack72.adb: New package.
* libgnat/s-pack73.ads, libgnat/s-pack73.adb: New package.
* libgnat/s-pack74.ads, libgnat/s-pack74.adb: New package.
* libgnat/s-pack75.ads, libgnat/s-pack75.adb: New package.
* libgnat/s-pack76.ads, libgnat/s-pack76.adb: New package.
* libgnat/s-pack77.ads, libgnat/s-pack77.adb: New package.
* libgnat/s-pack78.ads, libgnat/s-pack78.adb: New package.
* libgnat/s-pack79.ads, libgnat/s-pack79.adb: New package.
* libgnat/s-pack80.ads, libgnat/s-pack80.adb: New package.
* libgnat/s-pack81.ads, libgnat/s-pack81.adb: New package.
* libgnat/s-pack82.ads, libgnat/s-pack82.adb: New package.
* libgnat/s-pack83.ads, libgnat/s-pack83.adb: New package.
* libgnat/s-pack84.ads, libgnat/s-pack84.adb: New package.
* libgnat/s-pack85.ads, libgnat/s-pack85.adb: New package.
* libgnat/s-pack86.ads, libgnat/s-pack86.adb: New package.
* libgnat/s-pack87.ads, libgnat/s-pack87.adb: New package.
* libgnat/s-pack88.ads, libgnat/s-pack88.adb: New package.
* libgnat/s-pack89.ads, libgnat/s-pack89.adb: New package.
* libgnat/s-pack90.ads, libgnat/s-pack90.adb: New package.
* libgnat/s-pack91.ads, libgnat/s-pack91.adb: New package.
* libgnat/s-pack92.ads, libgnat/s-pack92.adb: New package.
* libgnat/s-pack93.ads, libgnat/s-pack93.adb: New package.
* libgnat/s-pack94.ads, libgnat/s-pack94.adb: New package.
* libgnat/s-pack95.ads, libgnat/s-pack95.adb: New package.
* libgnat/s-pack96.ads, libgnat/s-pack96.adb: New package.
* libgnat/s-pack97.ads, libgnat/s-pack97.adb: New package.
* libgnat/s-pack98.ads, libgnat/s-pack98.adb: New package.
* libgnat/s-pack99.ads, libgnat/s-pack99.adb: New package.
* libgnat/s-pack100.ads, libgnat/s-pack100.adb: New package.
* libgnat/s-pack101.ads, libgnat/s-pack101.adb: New package.
* libgnat/s-pack102.ads, libgnat/s-pack102.adb: New package.
* libgnat/s-pack103.ads, libgnat/s-pack103.adb: New package.
* libgnat/s-pack104.ads, libgnat/s-pack104.adb: New package.
* libgnat/s-pack105.ads, libgnat/s-pack105.adb: New package.
* libgnat/s-pack106.ads, libgnat/s-pack106.adb: New package.
* libgnat/s-pack107.ads, libgnat/s-pack107.adb: New package.
* libgnat/s-pack108.ads, libgnat/s-pack108.adb: New package.
* libgnat/s-pack109.ads, libgnat/s-pack109.adb: New package.
* libgnat/s-pack110.ads, libgnat/s-pack110.adb: New package.
* libgnat/s-pack111.ads, libgnat/s-pack111.adb: New package.
* libgnat/s-pack112.ads, libgnat/s-pack112.adb: New package.
* libgnat/s-pack113.ads, libgnat/s-pack113.adb: New package.
* libgnat/s-pack114.ads, libgnat/s-pack114.adb: New package.
* libgnat/s-pack115.ads, libgnat/s-pack115.adb: New package.
* libgnat/s-pack116.ads, libgnat/s-pack116.adb: New package.
* libgnat/s-pack117.ads, libgnat/s-pack117.adb: New package.
* libgnat/s-pack118.ads, libgnat/s-pack118.adb: New package.
* libgnat/s-pack119.ads, libgnat/s-pack119.adb: New package.
* libgnat/s-pack120.ads, libgnat/s-pack120.adb: New package.
* libgnat/s-pack121.ads, libgnat/s-pack121.adb: New package.
* libgnat/s-pack122.ads, libgnat/s-pack122.adb: New package.
* libgnat/s-pack123.ads, libgnat/s-pack123.adb: New package.
* libgnat/s-pack124.ads, libgnat/s-pack124.adb: New package.
* libgnat/s-pack125.ads, libgnat/s-pack125.adb: New package.
* libgnat/s-pack126.ads, libgnat/s-pack126.adb: New package.
* libgnat/s-pack127.ads, libgnat/s-pack127.adb: New package.
* libgnat/s-rannum.ads (Random): New function returning 128-bit.
* libgnat/s-rannum.adb (Random): Implement it.
* libgnat/s-scaval.ads: Add with clause for Interfaces, use subtypes
of unsigned types defined in Interfaces.
* libgnat/s-scaval.adb: Add use clause for Interfaces.
* libgnat/s-scaval__128.ads, libgnat/s-scaval__128.adb: New
package.
* libgnat/s-unstyp.ads (Long_Long_Long_Unsigned): New modular type.
(Shift_Left, Shift_Right, Shift_Right_Arithmetic, Rotate_Left,
Rotate_Right): New intrinsic functions operating on it.
gcc/testsuite/
* gnat.dg/multfixed.adb: Update expected exception message.
Diffstat (limited to 'gcc')
208 files changed, 21014 insertions, 1181 deletions
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 4ab8d5f..6437a4d 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -518,6 +518,7 @@ GNATRTL_NONTASKING_OBJS= \ s-aoinar$(objext) \ s-aomoar$(objext) \ s-aotase$(objext) \ + s-aridou$(objext) \ s-arit64$(objext) \ s-assert$(objext) \ s-atacco$(objext) \ @@ -582,6 +583,9 @@ GNATRTL_NONTASKING_OBJS= \ 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) \ @@ -867,6 +871,82 @@ TRASYM_DWARF_UNIX_OBJS = $(TRASYM_DWARF_COMMON_OBJS) s-mmauni$(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/')) @@ -2023,12 +2103,14 @@ ifeq ($(strip $(filter-out cygwin% mingw32% pe,$(target_os))),) 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) @@ -2420,12 +2502,14 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(target_cpu) $(target_os))),) 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 diff --git a/gcc/ada/ada_get_targ.adb b/gcc/ada/ada_get_targ.adb index 0183340..ddaca1a 100644 --- a/gcc/ada/ada_get_targ.adb +++ b/gcc/ada/ada_get_targ.adb @@ -100,6 +100,15 @@ package body Get_Targ is 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 -- ---------------------- diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index cfbb4bc..b7c6110 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -1013,8 +1013,7 @@ package body Checks is -- 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; @@ -1050,33 +1049,47 @@ package body Checks is -- 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, @@ -1084,8 +1097,8 @@ package body Checks is 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; diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 71d40e9..fa335c1 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -719,6 +719,11 @@ package body CStand is (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); @@ -734,6 +739,9 @@ package body CStand is 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 @@ -1238,11 +1246,11 @@ package body CStand is 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, @@ -1251,19 +1259,19 @@ package body CStand is 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); @@ -1339,11 +1347,17 @@ package body CStand is 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. @@ -1358,16 +1372,16 @@ package body CStand is -- 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); @@ -1955,6 +1969,13 @@ package body CStand is 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); diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index c596659..fdd4e05b 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -4586,7 +4586,7 @@ package body Exp_Attr is -- 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 diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index c5cc496..3e677e6 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -8565,8 +8565,10 @@ package body Exp_Ch3 is 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 @@ -8578,8 +8580,10 @@ package body Exp_Ch3 is 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; @@ -8633,10 +8637,10 @@ package body Exp_Ch3 is 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 @@ -8724,7 +8728,7 @@ package body Exp_Ch3 is 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 diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 526bec2..5af4c4c 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -1385,7 +1385,7 @@ package body Exp_Ch4 is -- (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 @@ -1422,12 +1422,19 @@ package body Exp_Ch4 is 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 @@ -8992,15 +8999,18 @@ package body Exp_Ch4 is 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, @@ -9022,36 +9032,43 @@ package body Exp_Ch4 is 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 @@ -14101,6 +14118,11 @@ package body Exp_Ch4 is 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; @@ -14220,12 +14242,8 @@ package body Exp_Ch4 is -- 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; diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb index b973fb6..c2e7741 100644 --- a/gcc/ada/exp_dbug.adb +++ b/gcc/ada/exp_dbug.adb @@ -247,7 +247,7 @@ package body Exp_Dbug is -- 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 @@ -261,8 +261,10 @@ package body Exp_Dbug is 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 diff --git a/gcc/ada/exp_fixd.adb b/gcc/ada/exp_fixd.adb index d956278..1cb0188 100644 --- a/gcc/ada/exp_fixd.adb +++ b/gcc/ada/exp_fixd.adb @@ -620,7 +620,7 @@ package body Exp_Fixd is 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), @@ -977,7 +977,7 @@ package body Exp_Fixd is 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), diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index 04ad92b..78bde89 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -205,12 +205,16 @@ package body Exp_Intr is 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 diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index c620caa..07a05a5 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -233,8 +233,11 @@ package body Exp_Pakd is 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); diff --git a/gcc/ada/exp_pakd.ads b/gcc/ada/exp_pakd.ads index 33726ba..559f54a 100644 --- a/gcc/ada/exp_pakd.ads +++ b/gcc/ada/exp_pakd.ads @@ -217,12 +217,12 @@ package Exp_Pakd is -- 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 @@ -292,7 +292,71 @@ package Exp_Pakd is 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 @@ -362,7 +426,71 @@ package Exp_Pakd is 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 @@ -432,7 +560,71 @@ package Exp_Pakd is 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 @@ -502,7 +694,71 @@ package Exp_Pakd is 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 @@ -572,7 +828,71 @@ package Exp_Pakd is 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 -- diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 67c3a36..866044f 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -7751,6 +7751,15 @@ package body Exp_Util is 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; @@ -13593,6 +13602,13 @@ package body Exp_Util is 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; diff --git a/gcc/ada/fname.adb b/gcc/ada/fname.adb index ad316eb..ee130fd 100644 --- a/gcc/ada/fname.adb +++ b/gcc/ada/fname.adb @@ -140,11 +140,13 @@ package body Fname is 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; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 08c78a3..52abb7f 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -80,8 +80,8 @@ package body Freeze is -- 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; @@ -231,9 +231,7 @@ package body Freeze is 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; @@ -2204,7 +2202,7 @@ package body Freeze is -- 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. @@ -2896,7 +2894,7 @@ package body Freeze is 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 diff --git a/gcc/ada/get_targ.adb b/gcc/ada/get_targ.adb index ef307f2..8b35b1c 100644 --- a/gcc/ada/get_targ.adb +++ b/gcc/ada/get_targ.adb @@ -126,6 +126,18 @@ package body Get_Targ is 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 -- ---------------------- @@ -309,10 +321,11 @@ package body Get_Targ is 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; diff --git a/gcc/ada/get_targ.ads b/gcc/ada/get_targ.ads index 5a21418..676e117 100644 --- a/gcc/ada/get_targ.ads +++ b/gcc/ada/get_targ.ads @@ -68,6 +68,9 @@ package Get_Targ is 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 diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 1a9cef5..51904f0 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -799,6 +799,33 @@ procedure Gnat1drv is 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). diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index 2cfda7c..9eb7174 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -687,7 +687,7 @@ package body Impunit is 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; @@ -701,13 +701,6 @@ package body Impunit is 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 @@ -721,6 +714,16 @@ package body Impunit is 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. @@ -739,7 +742,7 @@ package body Impunit is -- 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; @@ -747,7 +750,7 @@ package body Impunit is -- 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; @@ -755,7 +758,7 @@ package body Impunit is -- 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; @@ -763,7 +766,7 @@ package body Impunit is -- 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; @@ -927,13 +930,6 @@ package body Impunit is 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") @@ -955,6 +951,16 @@ package body Impunit is 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. diff --git a/gcc/ada/krunch.adb b/gcc/ada/krunch.adb index ac9af73..2b67849 100644 --- a/gcc/ada/krunch.adb +++ b/gcc/ada/krunch.adb @@ -89,7 +89,20 @@ begin 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; diff --git a/gcc/ada/krunch.ads b/gcc/ada/krunch.ads index 42896b8..d5fdf84 100644 --- a/gcc/ada/krunch.ads +++ b/gcc/ada/krunch.ads @@ -114,6 +114,9 @@ -- 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. diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index 684fae6..6fde60a 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -436,11 +436,11 @@ package body Layout is 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 @@ -455,7 +455,7 @@ package body Layout is 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); diff --git a/gcc/ada/libgnat/a-tifiio.adb b/gcc/ada/libgnat/a-tifiio.adb index 4098f0e..440a77d 100644 --- a/gcc/ada/libgnat/a-tifiio.adb +++ b/gcc/ada/libgnat/a-tifiio.adb @@ -580,7 +580,7 @@ package body Ada.Text_IO.Fixed_IO is 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 diff --git a/gcc/ada/libgnat/interfac__2020.ads b/gcc/ada/libgnat/interfac__2020.ads index 3f85599..2865fc2 100644 --- a/gcc/ada/libgnat/interfac__2020.ads +++ b/gcc/ada/libgnat/interfac__2020.ads @@ -60,7 +60,12 @@ package Interfaces is -- 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; @@ -78,6 +83,9 @@ package Interfaces is 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 @@ -178,6 +186,31 @@ package Interfaces is 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; diff --git a/gcc/ada/libgnat/s-aridou.adb b/gcc/ada/libgnat/s-aridou.adb new file mode 100644 index 0000000..05a8c9f --- /dev/null +++ b/gcc/ada/libgnat/s-aridou.adb @@ -0,0 +1,678 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-aridou.ads b/gcc/ada/libgnat/s-aridou.ads new file mode 100644 index 0000000..f9c03e5 --- /dev/null +++ b/gcc/ada/libgnat/s-aridou.ads @@ -0,0 +1,94 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-arit128.adb b/gcc/ada/libgnat/s-arit128.adb new file mode 100644 index 0000000..82c8fc3 --- /dev/null +++ b/gcc/ada/libgnat/s-arit128.adb @@ -0,0 +1,64 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-arit128.ads b/gcc/ada/libgnat/s-arit128.ads new file mode 100644 index 0000000..55154da --- /dev/null +++ b/gcc/ada/libgnat/s-arit128.ads @@ -0,0 +1,84 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-arit64.adb b/gcc/ada/libgnat/s-arit64.adb index 937490e..a4d60f2 100644 --- a/gcc/ada/libgnat/s-arit64.adb +++ b/gcc/ada/libgnat/s-arit64.adb @@ -29,649 +29,36 @@ -- -- ------------------------------------------------------------------------------ -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; diff --git a/gcc/ada/libgnat/s-arit64.ads b/gcc/ada/libgnat/s-arit64.ads index 479515f..90d5c25 100644 --- a/gcc/ada/libgnat/s-arit64.ads +++ b/gcc/ada/libgnat/s-arit64.ads @@ -43,42 +43,54 @@ package System.Arith_64 is 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; diff --git a/gcc/ada/libgnat/s-bytswa.ads b/gcc/ada/libgnat/s-bytswa.ads index 76d8ded..1eac50d 100644 --- a/gcc/ada/libgnat/s-bytswa.ads +++ b/gcc/ada/libgnat/s-bytswa.ads @@ -33,13 +33,16 @@ -- (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"); @@ -50,4 +53,7 @@ package System.Byte_Swapping is 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; diff --git a/gcc/ada/libgnat/s-casi128.adb b/gcc/ada/libgnat/s-casi128.adb new file mode 100644 index 0000000..96a8f3d --- /dev/null +++ b/gcc/ada/libgnat/s-casi128.adb @@ -0,0 +1,116 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-casi128.ads b/gcc/ada/libgnat/s-casi128.ads new file mode 100644 index 0000000..0893bad --- /dev/null +++ b/gcc/ada/libgnat/s-casi128.ads @@ -0,0 +1,52 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-caun128.adb b/gcc/ada/libgnat/s-caun128.adb new file mode 100644 index 0000000..bb69793 --- /dev/null +++ b/gcc/ada/libgnat/s-caun128.adb @@ -0,0 +1,115 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-caun128.ads b/gcc/ada/libgnat/s-caun128.ads new file mode 100644 index 0000000..c96983d --- /dev/null +++ b/gcc/ada/libgnat/s-caun128.ads @@ -0,0 +1,52 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-exnint.adb b/gcc/ada/libgnat/s-exnint.adb index fccd675..3914192 100644 --- a/gcc/ada/libgnat/s-exnint.adb +++ b/gcc/ada/libgnat/s-exnint.adb @@ -29,42 +29,8 @@ -- -- ------------------------------------------------------------------------------ -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; diff --git a/gcc/ada/libgnat/s-exnint.ads b/gcc/ada/libgnat/s-exnint.ads index 29303a3..ac64e58 100644 --- a/gcc/ada/libgnat/s-exnint.ads +++ b/gcc/ada/libgnat/s-exnint.ads @@ -31,9 +31,11 @@ -- 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; diff --git a/gcc/ada/libgnat/s-exnlli.adb b/gcc/ada/libgnat/s-exnlli.adb index dc486d6..b1c33ea 100644 --- a/gcc/ada/libgnat/s-exnlli.adb +++ b/gcc/ada/libgnat/s-exnlli.adb @@ -29,46 +29,8 @@ -- -- ------------------------------------------------------------------------------ -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; diff --git a/gcc/ada/libgnat/s-exnlli.ads b/gcc/ada/libgnat/s-exnlli.ads index f6d94de..3c2786b 100644 --- a/gcc/ada/libgnat/s-exnlli.ads +++ b/gcc/ada/libgnat/s-exnlli.ads @@ -31,12 +31,11 @@ -- 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; diff --git a/gcc/ada/libgnat/s-exnllli.ads b/gcc/ada/libgnat/s-exnllli.ads new file mode 100644 index 0000000..9573d7d --- /dev/null +++ b/gcc/ada/libgnat/s-exnllli.ads @@ -0,0 +1,41 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-expint.adb b/gcc/ada/libgnat/s-expint.adb index aa3445c..489d768 100644 --- a/gcc/ada/libgnat/s-expint.adb +++ b/gcc/ada/libgnat/s-expint.adb @@ -29,55 +29,8 @@ -- -- ------------------------------------------------------------------------------ -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; diff --git a/gcc/ada/libgnat/s-expint.ads b/gcc/ada/libgnat/s-expint.ads index 584564a..70d16e0 100644 --- a/gcc/ada/libgnat/s-expint.ads +++ b/gcc/ada/libgnat/s-expint.ads @@ -31,12 +31,11 @@ -- 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; diff --git a/gcc/ada/libgnat/s-explli.adb b/gcc/ada/libgnat/s-explli.adb index 4f244cd..98946dc 100644 --- a/gcc/ada/libgnat/s-explli.adb +++ b/gcc/ada/libgnat/s-explli.adb @@ -2,7 +2,7 @@ -- -- -- 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 -- -- -- @@ -29,55 +29,8 @@ -- -- ------------------------------------------------------------------------------ -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; diff --git a/gcc/ada/libgnat/s-explli.ads b/gcc/ada/libgnat/s-explli.ads index f1283cd..bf58a9a 100644 --- a/gcc/ada/libgnat/s-explli.ads +++ b/gcc/ada/libgnat/s-explli.ads @@ -29,14 +29,13 @@ -- -- ------------------------------------------------------------------------------ --- 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; diff --git a/gcc/ada/libgnat/s-expllli.ads b/gcc/ada/libgnat/s-expllli.ads new file mode 100644 index 0000000..0e4375d --- /dev/null +++ b/gcc/ada/libgnat/s-expllli.ads @@ -0,0 +1,41 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-explllu.ads b/gcc/ada/libgnat/s-explllu.ads new file mode 100644 index 0000000..2f7c6a9 --- /dev/null +++ b/gcc/ada/libgnat/s-explllu.ads @@ -0,0 +1,48 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-expllu.adb b/gcc/ada/libgnat/s-expllu.adb index 5615e4a..3a383f7 100644 --- a/gcc/ada/libgnat/s-expllu.adb +++ b/gcc/ada/libgnat/s-expllu.adb @@ -2,7 +2,7 @@ -- -- -- 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 -- -- -- @@ -29,46 +29,8 @@ -- -- ------------------------------------------------------------------------------ -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; diff --git a/gcc/ada/libgnat/s-expllu.ads b/gcc/ada/libgnat/s-expllu.ads index 2127aaa..9e30090 100644 --- a/gcc/ada/libgnat/s-expllu.ads +++ b/gcc/ada/libgnat/s-expllu.ads @@ -29,19 +29,19 @@ -- -- ------------------------------------------------------------------------------ --- 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; diff --git a/gcc/ada/libgnat/s-exponn.adb b/gcc/ada/libgnat/s-exponn.adb new file mode 100644 index 0000000..f1522d0 --- /dev/null +++ b/gcc/ada/libgnat/s-exponn.adb @@ -0,0 +1,72 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-exponn.ads b/gcc/ada/libgnat/s-exponn.ads new file mode 100644 index 0000000..f4cd18f --- /dev/null +++ b/gcc/ada/libgnat/s-exponn.ads @@ -0,0 +1,38 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-expont.adb b/gcc/ada/libgnat/s-expont.adb new file mode 100644 index 0000000..bcdcae4 --- /dev/null +++ b/gcc/ada/libgnat/s-expont.adb @@ -0,0 +1,72 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-expont.ads b/gcc/ada/libgnat/s-expont.ads new file mode 100644 index 0000000..7a519fd --- /dev/null +++ b/gcc/ada/libgnat/s-expont.ads @@ -0,0 +1,38 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-exponu.adb b/gcc/ada/libgnat/s-exponu.adb new file mode 100644 index 0000000..d2b9305 --- /dev/null +++ b/gcc/ada/libgnat/s-exponu.adb @@ -0,0 +1,63 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-exponu.ads b/gcc/ada/libgnat/s-exponu.ads new file mode 100644 index 0000000..2a913d6 --- /dev/null +++ b/gcc/ada/libgnat/s-exponu.ads @@ -0,0 +1,38 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-expuns.adb b/gcc/ada/libgnat/s-expuns.adb index da43763..f513da2 100644 --- a/gcc/ada/libgnat/s-expuns.adb +++ b/gcc/ada/libgnat/s-expuns.adb @@ -29,45 +29,8 @@ -- -- ------------------------------------------------------------------------------ -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; diff --git a/gcc/ada/libgnat/s-expuns.ads b/gcc/ada/libgnat/s-expuns.ads index a0d8085..3826f4f 100644 --- a/gcc/ada/libgnat/s-expuns.ads +++ b/gcc/ada/libgnat/s-expuns.ads @@ -29,19 +29,19 @@ -- -- ------------------------------------------------------------------------------ --- 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; diff --git a/gcc/ada/libgnat/s-pack100.adb b/gcc/ada/libgnat/s-pack100.adb new file mode 100644 index 0000000..bae251c --- /dev/null +++ b/gcc/ada/libgnat/s-pack100.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack100.ads b/gcc/ada/libgnat/s-pack100.ads new file mode 100644 index 0000000..dfb3e62 --- /dev/null +++ b/gcc/ada/libgnat/s-pack100.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack101.adb b/gcc/ada/libgnat/s-pack101.adb new file mode 100644 index 0000000..dfa1cf3 --- /dev/null +++ b/gcc/ada/libgnat/s-pack101.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack101.ads b/gcc/ada/libgnat/s-pack101.ads new file mode 100644 index 0000000..2e77051 --- /dev/null +++ b/gcc/ada/libgnat/s-pack101.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack102.adb b/gcc/ada/libgnat/s-pack102.adb new file mode 100644 index 0000000..ebf1094 --- /dev/null +++ b/gcc/ada/libgnat/s-pack102.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack102.ads b/gcc/ada/libgnat/s-pack102.ads new file mode 100644 index 0000000..065f338 --- /dev/null +++ b/gcc/ada/libgnat/s-pack102.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack103.adb b/gcc/ada/libgnat/s-pack103.adb new file mode 100644 index 0000000..b5df31e --- /dev/null +++ b/gcc/ada/libgnat/s-pack103.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack103.ads b/gcc/ada/libgnat/s-pack103.ads new file mode 100644 index 0000000..ad12b0e --- /dev/null +++ b/gcc/ada/libgnat/s-pack103.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack104.adb b/gcc/ada/libgnat/s-pack104.adb new file mode 100644 index 0000000..573fe4a --- /dev/null +++ b/gcc/ada/libgnat/s-pack104.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack104.ads b/gcc/ada/libgnat/s-pack104.ads new file mode 100644 index 0000000..3dee1a7 --- /dev/null +++ b/gcc/ada/libgnat/s-pack104.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack105.adb b/gcc/ada/libgnat/s-pack105.adb new file mode 100644 index 0000000..b5e2aab --- /dev/null +++ b/gcc/ada/libgnat/s-pack105.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack105.ads b/gcc/ada/libgnat/s-pack105.ads new file mode 100644 index 0000000..2faf652 --- /dev/null +++ b/gcc/ada/libgnat/s-pack105.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack106.adb b/gcc/ada/libgnat/s-pack106.adb new file mode 100644 index 0000000..645b5a2 --- /dev/null +++ b/gcc/ada/libgnat/s-pack106.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack106.ads b/gcc/ada/libgnat/s-pack106.ads new file mode 100644 index 0000000..27c7efa --- /dev/null +++ b/gcc/ada/libgnat/s-pack106.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack107.adb b/gcc/ada/libgnat/s-pack107.adb new file mode 100644 index 0000000..7e1a86a --- /dev/null +++ b/gcc/ada/libgnat/s-pack107.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack107.ads b/gcc/ada/libgnat/s-pack107.ads new file mode 100644 index 0000000..3eba81d --- /dev/null +++ b/gcc/ada/libgnat/s-pack107.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack108.adb b/gcc/ada/libgnat/s-pack108.adb new file mode 100644 index 0000000..afe28a5 --- /dev/null +++ b/gcc/ada/libgnat/s-pack108.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack108.ads b/gcc/ada/libgnat/s-pack108.ads new file mode 100644 index 0000000..e751654 --- /dev/null +++ b/gcc/ada/libgnat/s-pack108.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack109.adb b/gcc/ada/libgnat/s-pack109.adb new file mode 100644 index 0000000..e976ed4 --- /dev/null +++ b/gcc/ada/libgnat/s-pack109.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack109.ads b/gcc/ada/libgnat/s-pack109.ads new file mode 100644 index 0000000..2ea8b42 --- /dev/null +++ b/gcc/ada/libgnat/s-pack109.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack110.adb b/gcc/ada/libgnat/s-pack110.adb new file mode 100644 index 0000000..a85eb3d --- /dev/null +++ b/gcc/ada/libgnat/s-pack110.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack110.ads b/gcc/ada/libgnat/s-pack110.ads new file mode 100644 index 0000000..570a994 --- /dev/null +++ b/gcc/ada/libgnat/s-pack110.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack111.adb b/gcc/ada/libgnat/s-pack111.adb new file mode 100644 index 0000000..168877b --- /dev/null +++ b/gcc/ada/libgnat/s-pack111.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack111.ads b/gcc/ada/libgnat/s-pack111.ads new file mode 100644 index 0000000..784b861 --- /dev/null +++ b/gcc/ada/libgnat/s-pack111.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack112.adb b/gcc/ada/libgnat/s-pack112.adb new file mode 100644 index 0000000..b8acf56 --- /dev/null +++ b/gcc/ada/libgnat/s-pack112.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack112.ads b/gcc/ada/libgnat/s-pack112.ads new file mode 100644 index 0000000..6b36a8b --- /dev/null +++ b/gcc/ada/libgnat/s-pack112.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack113.adb b/gcc/ada/libgnat/s-pack113.adb new file mode 100644 index 0000000..58f84d4 --- /dev/null +++ b/gcc/ada/libgnat/s-pack113.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack113.ads b/gcc/ada/libgnat/s-pack113.ads new file mode 100644 index 0000000..2f0bfc2 --- /dev/null +++ b/gcc/ada/libgnat/s-pack113.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack114.adb b/gcc/ada/libgnat/s-pack114.adb new file mode 100644 index 0000000..079abeb --- /dev/null +++ b/gcc/ada/libgnat/s-pack114.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack114.ads b/gcc/ada/libgnat/s-pack114.ads new file mode 100644 index 0000000..046026e --- /dev/null +++ b/gcc/ada/libgnat/s-pack114.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack115.adb b/gcc/ada/libgnat/s-pack115.adb new file mode 100644 index 0000000..0459777 --- /dev/null +++ b/gcc/ada/libgnat/s-pack115.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack115.ads b/gcc/ada/libgnat/s-pack115.ads new file mode 100644 index 0000000..a2063a6 --- /dev/null +++ b/gcc/ada/libgnat/s-pack115.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack116.adb b/gcc/ada/libgnat/s-pack116.adb new file mode 100644 index 0000000..d03c857 --- /dev/null +++ b/gcc/ada/libgnat/s-pack116.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack116.ads b/gcc/ada/libgnat/s-pack116.ads new file mode 100644 index 0000000..3cd556d --- /dev/null +++ b/gcc/ada/libgnat/s-pack116.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack117.adb b/gcc/ada/libgnat/s-pack117.adb new file mode 100644 index 0000000..92da470 --- /dev/null +++ b/gcc/ada/libgnat/s-pack117.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack117.ads b/gcc/ada/libgnat/s-pack117.ads new file mode 100644 index 0000000..478663a --- /dev/null +++ b/gcc/ada/libgnat/s-pack117.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack118.adb b/gcc/ada/libgnat/s-pack118.adb new file mode 100644 index 0000000..aa1d763 --- /dev/null +++ b/gcc/ada/libgnat/s-pack118.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack118.ads b/gcc/ada/libgnat/s-pack118.ads new file mode 100644 index 0000000..0902c5c --- /dev/null +++ b/gcc/ada/libgnat/s-pack118.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack119.adb b/gcc/ada/libgnat/s-pack119.adb new file mode 100644 index 0000000..9003175 --- /dev/null +++ b/gcc/ada/libgnat/s-pack119.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack119.ads b/gcc/ada/libgnat/s-pack119.ads new file mode 100644 index 0000000..75d1c4a --- /dev/null +++ b/gcc/ada/libgnat/s-pack119.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack120.adb b/gcc/ada/libgnat/s-pack120.adb new file mode 100644 index 0000000..774085c --- /dev/null +++ b/gcc/ada/libgnat/s-pack120.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack120.ads b/gcc/ada/libgnat/s-pack120.ads new file mode 100644 index 0000000..ae5580a --- /dev/null +++ b/gcc/ada/libgnat/s-pack120.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack121.adb b/gcc/ada/libgnat/s-pack121.adb new file mode 100644 index 0000000..a44f144 --- /dev/null +++ b/gcc/ada/libgnat/s-pack121.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack121.ads b/gcc/ada/libgnat/s-pack121.ads new file mode 100644 index 0000000..5f4f5ed --- /dev/null +++ b/gcc/ada/libgnat/s-pack121.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack122.adb b/gcc/ada/libgnat/s-pack122.adb new file mode 100644 index 0000000..13c59ac --- /dev/null +++ b/gcc/ada/libgnat/s-pack122.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack122.ads b/gcc/ada/libgnat/s-pack122.ads new file mode 100644 index 0000000..0094896 --- /dev/null +++ b/gcc/ada/libgnat/s-pack122.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack123.adb b/gcc/ada/libgnat/s-pack123.adb new file mode 100644 index 0000000..27d7417 --- /dev/null +++ b/gcc/ada/libgnat/s-pack123.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack123.ads b/gcc/ada/libgnat/s-pack123.ads new file mode 100644 index 0000000..f40fe87 --- /dev/null +++ b/gcc/ada/libgnat/s-pack123.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack124.adb b/gcc/ada/libgnat/s-pack124.adb new file mode 100644 index 0000000..2e6d9c0 --- /dev/null +++ b/gcc/ada/libgnat/s-pack124.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack124.ads b/gcc/ada/libgnat/s-pack124.ads new file mode 100644 index 0000000..3a4f159 --- /dev/null +++ b/gcc/ada/libgnat/s-pack124.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack125.adb b/gcc/ada/libgnat/s-pack125.adb new file mode 100644 index 0000000..ffc2c1c --- /dev/null +++ b/gcc/ada/libgnat/s-pack125.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack125.ads b/gcc/ada/libgnat/s-pack125.ads new file mode 100644 index 0000000..dc4fdc9 --- /dev/null +++ b/gcc/ada/libgnat/s-pack125.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack126.adb b/gcc/ada/libgnat/s-pack126.adb new file mode 100644 index 0000000..c566fc9 --- /dev/null +++ b/gcc/ada/libgnat/s-pack126.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack126.ads b/gcc/ada/libgnat/s-pack126.ads new file mode 100644 index 0000000..fd83f78 --- /dev/null +++ b/gcc/ada/libgnat/s-pack126.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack127.adb b/gcc/ada/libgnat/s-pack127.adb new file mode 100644 index 0000000..3895c1f --- /dev/null +++ b/gcc/ada/libgnat/s-pack127.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack127.ads b/gcc/ada/libgnat/s-pack127.ads new file mode 100644 index 0000000..c37ae59 --- /dev/null +++ b/gcc/ada/libgnat/s-pack127.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack65.adb b/gcc/ada/libgnat/s-pack65.adb new file mode 100644 index 0000000..c5b7310 --- /dev/null +++ b/gcc/ada/libgnat/s-pack65.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack65.ads b/gcc/ada/libgnat/s-pack65.ads new file mode 100644 index 0000000..8752c9c --- /dev/null +++ b/gcc/ada/libgnat/s-pack65.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack66.adb b/gcc/ada/libgnat/s-pack66.adb new file mode 100644 index 0000000..5e90ceb --- /dev/null +++ b/gcc/ada/libgnat/s-pack66.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack66.ads b/gcc/ada/libgnat/s-pack66.ads new file mode 100644 index 0000000..b45d317 --- /dev/null +++ b/gcc/ada/libgnat/s-pack66.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack67.adb b/gcc/ada/libgnat/s-pack67.adb new file mode 100644 index 0000000..d7c77e8 --- /dev/null +++ b/gcc/ada/libgnat/s-pack67.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack67.ads b/gcc/ada/libgnat/s-pack67.ads new file mode 100644 index 0000000..f77b651 --- /dev/null +++ b/gcc/ada/libgnat/s-pack67.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack68.adb b/gcc/ada/libgnat/s-pack68.adb new file mode 100644 index 0000000..03a0361 --- /dev/null +++ b/gcc/ada/libgnat/s-pack68.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack68.ads b/gcc/ada/libgnat/s-pack68.ads new file mode 100644 index 0000000..5565b32 --- /dev/null +++ b/gcc/ada/libgnat/s-pack68.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack69.adb b/gcc/ada/libgnat/s-pack69.adb new file mode 100644 index 0000000..f383029 --- /dev/null +++ b/gcc/ada/libgnat/s-pack69.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack69.ads b/gcc/ada/libgnat/s-pack69.ads new file mode 100644 index 0000000..76a221d --- /dev/null +++ b/gcc/ada/libgnat/s-pack69.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack70.adb b/gcc/ada/libgnat/s-pack70.adb new file mode 100644 index 0000000..7dab227 --- /dev/null +++ b/gcc/ada/libgnat/s-pack70.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack70.ads b/gcc/ada/libgnat/s-pack70.ads new file mode 100644 index 0000000..b978d1c --- /dev/null +++ b/gcc/ada/libgnat/s-pack70.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack71.adb b/gcc/ada/libgnat/s-pack71.adb new file mode 100644 index 0000000..f3560de --- /dev/null +++ b/gcc/ada/libgnat/s-pack71.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack71.ads b/gcc/ada/libgnat/s-pack71.ads new file mode 100644 index 0000000..842a232 --- /dev/null +++ b/gcc/ada/libgnat/s-pack71.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack72.adb b/gcc/ada/libgnat/s-pack72.adb new file mode 100644 index 0000000..14fbb15 --- /dev/null +++ b/gcc/ada/libgnat/s-pack72.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack72.ads b/gcc/ada/libgnat/s-pack72.ads new file mode 100644 index 0000000..b1add35 --- /dev/null +++ b/gcc/ada/libgnat/s-pack72.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack73.adb b/gcc/ada/libgnat/s-pack73.adb new file mode 100644 index 0000000..f4853cb --- /dev/null +++ b/gcc/ada/libgnat/s-pack73.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack73.ads b/gcc/ada/libgnat/s-pack73.ads new file mode 100644 index 0000000..5f103de --- /dev/null +++ b/gcc/ada/libgnat/s-pack73.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack74.adb b/gcc/ada/libgnat/s-pack74.adb new file mode 100644 index 0000000..984b4c0 --- /dev/null +++ b/gcc/ada/libgnat/s-pack74.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack74.ads b/gcc/ada/libgnat/s-pack74.ads new file mode 100644 index 0000000..5dde51b --- /dev/null +++ b/gcc/ada/libgnat/s-pack74.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack75.adb b/gcc/ada/libgnat/s-pack75.adb new file mode 100644 index 0000000..6c7c14f --- /dev/null +++ b/gcc/ada/libgnat/s-pack75.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack75.ads b/gcc/ada/libgnat/s-pack75.ads new file mode 100644 index 0000000..551833a --- /dev/null +++ b/gcc/ada/libgnat/s-pack75.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack76.adb b/gcc/ada/libgnat/s-pack76.adb new file mode 100644 index 0000000..6a7c5fa --- /dev/null +++ b/gcc/ada/libgnat/s-pack76.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack76.ads b/gcc/ada/libgnat/s-pack76.ads new file mode 100644 index 0000000..6a600c9 --- /dev/null +++ b/gcc/ada/libgnat/s-pack76.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack77.adb b/gcc/ada/libgnat/s-pack77.adb new file mode 100644 index 0000000..f29cdf1 --- /dev/null +++ b/gcc/ada/libgnat/s-pack77.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack77.ads b/gcc/ada/libgnat/s-pack77.ads new file mode 100644 index 0000000..9308a78 --- /dev/null +++ b/gcc/ada/libgnat/s-pack77.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack78.adb b/gcc/ada/libgnat/s-pack78.adb new file mode 100644 index 0000000..e321c1e --- /dev/null +++ b/gcc/ada/libgnat/s-pack78.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack78.ads b/gcc/ada/libgnat/s-pack78.ads new file mode 100644 index 0000000..54fdd95 --- /dev/null +++ b/gcc/ada/libgnat/s-pack78.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack79.adb b/gcc/ada/libgnat/s-pack79.adb new file mode 100644 index 0000000..75fb14c --- /dev/null +++ b/gcc/ada/libgnat/s-pack79.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack79.ads b/gcc/ada/libgnat/s-pack79.ads new file mode 100644 index 0000000..337be86 --- /dev/null +++ b/gcc/ada/libgnat/s-pack79.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack80.adb b/gcc/ada/libgnat/s-pack80.adb new file mode 100644 index 0000000..d66588b --- /dev/null +++ b/gcc/ada/libgnat/s-pack80.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack80.ads b/gcc/ada/libgnat/s-pack80.ads new file mode 100644 index 0000000..c1f0de4 --- /dev/null +++ b/gcc/ada/libgnat/s-pack80.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack81.adb b/gcc/ada/libgnat/s-pack81.adb new file mode 100644 index 0000000..5157882 --- /dev/null +++ b/gcc/ada/libgnat/s-pack81.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack81.ads b/gcc/ada/libgnat/s-pack81.ads new file mode 100644 index 0000000..9f17734 --- /dev/null +++ b/gcc/ada/libgnat/s-pack81.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack82.adb b/gcc/ada/libgnat/s-pack82.adb new file mode 100644 index 0000000..7e409dd --- /dev/null +++ b/gcc/ada/libgnat/s-pack82.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack82.ads b/gcc/ada/libgnat/s-pack82.ads new file mode 100644 index 0000000..96a75bf --- /dev/null +++ b/gcc/ada/libgnat/s-pack82.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack83.adb b/gcc/ada/libgnat/s-pack83.adb new file mode 100644 index 0000000..5fe2441 --- /dev/null +++ b/gcc/ada/libgnat/s-pack83.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack83.ads b/gcc/ada/libgnat/s-pack83.ads new file mode 100644 index 0000000..75ccd5b --- /dev/null +++ b/gcc/ada/libgnat/s-pack83.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack84.adb b/gcc/ada/libgnat/s-pack84.adb new file mode 100644 index 0000000..29b6454 --- /dev/null +++ b/gcc/ada/libgnat/s-pack84.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack84.ads b/gcc/ada/libgnat/s-pack84.ads new file mode 100644 index 0000000..c3055f9 --- /dev/null +++ b/gcc/ada/libgnat/s-pack84.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack85.adb b/gcc/ada/libgnat/s-pack85.adb new file mode 100644 index 0000000..6edf9d1 --- /dev/null +++ b/gcc/ada/libgnat/s-pack85.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack85.ads b/gcc/ada/libgnat/s-pack85.ads new file mode 100644 index 0000000..71bb986 --- /dev/null +++ b/gcc/ada/libgnat/s-pack85.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack86.adb b/gcc/ada/libgnat/s-pack86.adb new file mode 100644 index 0000000..39e8bca --- /dev/null +++ b/gcc/ada/libgnat/s-pack86.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack86.ads b/gcc/ada/libgnat/s-pack86.ads new file mode 100644 index 0000000..0dee449 --- /dev/null +++ b/gcc/ada/libgnat/s-pack86.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack87.adb b/gcc/ada/libgnat/s-pack87.adb new file mode 100644 index 0000000..8bfc7b4 --- /dev/null +++ b/gcc/ada/libgnat/s-pack87.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack87.ads b/gcc/ada/libgnat/s-pack87.ads new file mode 100644 index 0000000..ad80713 --- /dev/null +++ b/gcc/ada/libgnat/s-pack87.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack88.adb b/gcc/ada/libgnat/s-pack88.adb new file mode 100644 index 0000000..638581a --- /dev/null +++ b/gcc/ada/libgnat/s-pack88.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack88.ads b/gcc/ada/libgnat/s-pack88.ads new file mode 100644 index 0000000..bd38bd7 --- /dev/null +++ b/gcc/ada/libgnat/s-pack88.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack89.adb b/gcc/ada/libgnat/s-pack89.adb new file mode 100644 index 0000000..eff29c0 --- /dev/null +++ b/gcc/ada/libgnat/s-pack89.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack89.ads b/gcc/ada/libgnat/s-pack89.ads new file mode 100644 index 0000000..5ab8102 --- /dev/null +++ b/gcc/ada/libgnat/s-pack89.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack90.adb b/gcc/ada/libgnat/s-pack90.adb new file mode 100644 index 0000000..bed4845 --- /dev/null +++ b/gcc/ada/libgnat/s-pack90.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack90.ads b/gcc/ada/libgnat/s-pack90.ads new file mode 100644 index 0000000..2960293 --- /dev/null +++ b/gcc/ada/libgnat/s-pack90.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack91.adb b/gcc/ada/libgnat/s-pack91.adb new file mode 100644 index 0000000..25c9f14 --- /dev/null +++ b/gcc/ada/libgnat/s-pack91.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack91.ads b/gcc/ada/libgnat/s-pack91.ads new file mode 100644 index 0000000..065c1b5 --- /dev/null +++ b/gcc/ada/libgnat/s-pack91.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack92.adb b/gcc/ada/libgnat/s-pack92.adb new file mode 100644 index 0000000..b9ea0a6 --- /dev/null +++ b/gcc/ada/libgnat/s-pack92.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack92.ads b/gcc/ada/libgnat/s-pack92.ads new file mode 100644 index 0000000..5184bc6 --- /dev/null +++ b/gcc/ada/libgnat/s-pack92.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack93.adb b/gcc/ada/libgnat/s-pack93.adb new file mode 100644 index 0000000..1fe486c --- /dev/null +++ b/gcc/ada/libgnat/s-pack93.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack93.ads b/gcc/ada/libgnat/s-pack93.ads new file mode 100644 index 0000000..618ab64 --- /dev/null +++ b/gcc/ada/libgnat/s-pack93.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack94.adb b/gcc/ada/libgnat/s-pack94.adb new file mode 100644 index 0000000..5a65908 --- /dev/null +++ b/gcc/ada/libgnat/s-pack94.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack94.ads b/gcc/ada/libgnat/s-pack94.ads new file mode 100644 index 0000000..692a4dc --- /dev/null +++ b/gcc/ada/libgnat/s-pack94.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack95.adb b/gcc/ada/libgnat/s-pack95.adb new file mode 100644 index 0000000..f8d6be6 --- /dev/null +++ b/gcc/ada/libgnat/s-pack95.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack95.ads b/gcc/ada/libgnat/s-pack95.ads new file mode 100644 index 0000000..288a787 --- /dev/null +++ b/gcc/ada/libgnat/s-pack95.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack96.adb b/gcc/ada/libgnat/s-pack96.adb new file mode 100644 index 0000000..1371ee1 --- /dev/null +++ b/gcc/ada/libgnat/s-pack96.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack96.ads b/gcc/ada/libgnat/s-pack96.ads new file mode 100644 index 0000000..355f00a --- /dev/null +++ b/gcc/ada/libgnat/s-pack96.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack97.adb b/gcc/ada/libgnat/s-pack97.adb new file mode 100644 index 0000000..000f8ed --- /dev/null +++ b/gcc/ada/libgnat/s-pack97.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack97.ads b/gcc/ada/libgnat/s-pack97.ads new file mode 100644 index 0000000..4c8a936 --- /dev/null +++ b/gcc/ada/libgnat/s-pack97.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack98.adb b/gcc/ada/libgnat/s-pack98.adb new file mode 100644 index 0000000..1ac4c66 --- /dev/null +++ b/gcc/ada/libgnat/s-pack98.adb @@ -0,0 +1,250 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack98.ads b/gcc/ada/libgnat/s-pack98.ads new file mode 100644 index 0000000..239eca1 --- /dev/null +++ b/gcc/ada/libgnat/s-pack98.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack99.adb b/gcc/ada/libgnat/s-pack99.adb new file mode 100644 index 0000000..a8bde88 --- /dev/null +++ b/gcc/ada/libgnat/s-pack99.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-pack99.ads b/gcc/ada/libgnat/s-pack99.ads new file mode 100644 index 0000000..fa805c4 --- /dev/null +++ b/gcc/ada/libgnat/s-pack99.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-rannum.adb b/gcc/ada/libgnat/s-rannum.adb index 01a6e91..e65e6a7 100644 --- a/gcc/ada/libgnat/s-rannum.adb +++ b/gcc/ada/libgnat/s-rannum.adb @@ -387,6 +387,12 @@ is 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 -- --------------------- diff --git a/gcc/ada/libgnat/s-rannum.ads b/gcc/ada/libgnat/s-rannum.ads index 1851b69..6cbba3e 100644 --- a/gcc/ada/libgnat/s-rannum.ads +++ b/gcc/ada/libgnat/s-rannum.ads @@ -76,6 +76,7 @@ is 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. diff --git a/gcc/ada/libgnat/s-scaval.adb b/gcc/ada/libgnat/s-scaval.adb index 9815fbd..5a88111 100644 --- a/gcc/ada/libgnat/s-scaval.adb +++ b/gcc/ada/libgnat/s-scaval.adb @@ -33,6 +33,8 @@ with Ada.Unchecked_Conversion; package body System.Scalar_Values is + use Interfaces; + ---------------- -- Initialize -- ---------------- diff --git a/gcc/ada/libgnat/s-scaval.ads b/gcc/ada/libgnat/s-scaval.ads index bd9c9c5..6d13262 100644 --- a/gcc/ada/libgnat/s-scaval.ads +++ b/gcc/ada/libgnat/s-scaval.ads @@ -35,6 +35,8 @@ -- 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 @@ -43,10 +45,10 @@ package System.Scalar_Values is -- 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. diff --git a/gcc/ada/libgnat/s-scaval__128.adb b/gcc/ada/libgnat/s-scaval__128.adb new file mode 100644 index 0000000..53110c2 --- /dev/null +++ b/gcc/ada/libgnat/s-scaval__128.adb @@ -0,0 +1,342 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-scaval__128.ads b/gcc/ada/libgnat/s-scaval__128.ads new file mode 100644 index 0000000..8eb1b65 --- /dev/null +++ b/gcc/ada/libgnat/s-scaval__128.ads @@ -0,0 +1,101 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-unstyp.ads b/gcc/ada/libgnat/s-unstyp.ads index 0f6c73c..86c5d7f 100644 --- a/gcc/ada/libgnat/s-unstyp.ads +++ b/gcc/ada/libgnat/s-unstyp.ads @@ -41,13 +41,14 @@ package System.Unsigned_Types is 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; @@ -215,6 +216,26 @@ package System.Unsigned_Types is (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); diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 1c8a294..28c6aca 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -192,6 +192,7 @@ package Rtsfind is System_Address_Image, System_Address_To_Access_Conversions, System_Arith_64, + System_Arith_128, System_AST_Handling, System_Assertions, System_Atomic_Primitives, @@ -202,14 +203,16 @@ package Rtsfind is 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, @@ -227,10 +230,12 @@ package Rtsfind is 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, @@ -322,6 +327,69 @@ package Rtsfind is 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, @@ -647,10 +715,12 @@ package Rtsfind is 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 @@ -673,11 +743,15 @@ package Rtsfind is 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 @@ -753,6 +827,7 @@ package Rtsfind is 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 @@ -760,15 +835,17 @@ package Rtsfind is 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 @@ -808,12 +885,18 @@ package Rtsfind is 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 @@ -1184,6 +1267,320 @@ package Rtsfind is 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 @@ -1371,14 +1768,12 @@ package Rtsfind is 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 @@ -1569,7 +1964,6 @@ package Rtsfind is 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 @@ -1578,8 +1972,6 @@ package Rtsfind is 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 @@ -1953,10 +2345,12 @@ package Rtsfind is 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, @@ -1979,11 +2373,15 @@ package Rtsfind is 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, @@ -2061,6 +2459,7 @@ package Rtsfind is 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, @@ -2071,6 +2470,8 @@ package Rtsfind is 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, @@ -2080,6 +2481,8 @@ package Rtsfind is 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, @@ -2118,12 +2521,18 @@ package Rtsfind is 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, @@ -2494,6 +2903,320 @@ package Rtsfind is 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, @@ -2681,14 +3404,12 @@ package Rtsfind is 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, @@ -2879,7 +3600,6 @@ package Rtsfind is 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, @@ -2888,8 +3608,6 @@ package Rtsfind is 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, diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 4a16c12..b4872f0 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -163,6 +163,8 @@ package body Sem_Aux is 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; @@ -364,6 +366,9 @@ package body Sem_Aux is 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)); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index ab00b59..636d44f 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -7028,12 +7028,13 @@ package body Sem_Ch13 is 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); @@ -15418,7 +15419,7 @@ package body Sem_Ch13 is 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))); @@ -15433,8 +15434,11 @@ package body Sem_Ch13 is 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 @@ -15447,8 +15451,11 @@ package body Sem_Ch13 is 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; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index afd044d..e103793 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -19439,17 +19439,20 @@ package body Sem_Ch3 is ---------------------- 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); @@ -19464,14 +19467,14 @@ package body Sem_Ch3 is 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); @@ -22470,8 +22473,8 @@ package body Sem_Ch3 is 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 @@ -22495,11 +22498,15 @@ package body Sem_Ch3 is 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; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index beb981d..0efe8f3 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3136,7 +3136,7 @@ package body Sem_Ch4 is 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. @@ -3145,7 +3145,7 @@ package body Sem_Ch4 is 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)); diff --git a/gcc/ada/sem_intr.adb b/gcc/ada/sem_intr.adb index 15bb146..f3d9f44 100644 --- a/gcc/ada/sem_intr.adb +++ b/gcc/ada/sem_intr.adb @@ -38,6 +38,7 @@ with Sinfo; use Sinfo; 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 @@ -430,11 +431,18 @@ 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 @@ -449,10 +457,19 @@ package body Sem_Intr is 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 diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 67b3d35..ba86723 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -17807,15 +17807,17 @@ package body Sem_Prag is -- 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); @@ -17868,7 +17870,14 @@ package body Sem_Prag is 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 diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 985d789..f59df36 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -428,14 +428,13 @@ package body Sem_Util is -- 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 @@ -443,7 +442,8 @@ package body Sem_Util 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; --------------------------------- @@ -14281,10 +14281,20 @@ package body Sem_Util is 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; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 0ddeed6..9c7b8ca 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -80,7 +80,7 @@ package Sem_Util is 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; diff --git a/gcc/ada/set_targ.adb b/gcc/ada/set_targ.adb index d707c12..c1c83cb 100644 --- a/gcc/ada/set_targ.adb +++ b/gcc/ada/set_targ.adb @@ -55,6 +55,7 @@ package body Set_Targ is 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"; @@ -83,6 +84,7 @@ package body Set_Targ is 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, @@ -111,6 +113,7 @@ package body Set_Targ is 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, @@ -934,6 +937,7 @@ begin 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; diff --git a/gcc/ada/set_targ.ads b/gcc/ada/set_targ.ads index aa37770..e25f351 100644 --- a/gcc/ada/set_targ.ads +++ b/gcc/ada/set_targ.ads @@ -71,6 +71,7 @@ package Set_Targ is 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 diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 8d457b5..af69d77 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -1191,19 +1191,21 @@ package Snames is 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 diff --git a/gcc/ada/stand.ads b/gcc/ada/stand.ads index 57b4d55..be9d215 100644 --- a/gcc/ada/stand.ads +++ b/gcc/ada/stand.ads @@ -440,8 +440,8 @@ package Stand is 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 @@ -464,11 +464,12 @@ package Stand is -- 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; diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index e086a5d..0851307 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -844,6 +844,28 @@ package body Switch.C is 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 => diff --git a/gcc/ada/ttypes.ads b/gcc/ada/ttypes.ads index 73c860e..ebd02b3 100644 --- a/gcc/ada/ttypes.ads +++ b/gcc/ada/ttypes.ads @@ -130,6 +130,12 @@ package Ttypes is 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 := @@ -176,10 +182,10 @@ package Ttypes is 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; diff --git a/gcc/ada/uintp.adb b/gcc/ada/uintp.adb index 5f479b4..060971c 100644 --- a/gcc/ada/uintp.adb +++ b/gcc/ada/uintp.adb @@ -49,7 +49,7 @@ package body Uintp is 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 @@ -58,7 +58,7 @@ package body Uintp is 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. @@ -1317,9 +1317,9 @@ package body Uintp is -- 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 @@ -1339,7 +1339,7 @@ package body Uintp is 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 diff --git a/gcc/ada/uintp.ads b/gcc/ada/uintp.ads index 652145e..895aeb1 100644 --- a/gcc/ada/uintp.ads +++ b/gcc/ada/uintp.ads @@ -73,6 +73,7 @@ package Uintp is 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; @@ -479,6 +480,7 @@ private 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); diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index f986484..133e34f 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -270,6 +270,11 @@ begin -- 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"); diff --git a/gcc/testsuite/gnat.dg/multfixed.adb b/gcc/testsuite/gnat.dg/multfixed.adb index 2eca3cd..572cd32 100644 --- a/gcc/testsuite/gnat.dg/multfixed.adb +++ b/gcc/testsuite/gnat.dg/multfixed.adb @@ -18,7 +18,7 @@ begin 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; |