[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.

1 files changed, 157 insertions, 0 deletions

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;