diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/Makefile.rtl | 3 | ||||
| -rw-r--r-- | gcc/ada/exp_atag.adb | 41 | ||||
| -rw-r--r-- | gcc/ada/exp_atag.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/exp_disp.adb | 27 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/Make-lang.in | 2 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-tags.ads | 1 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-addima.adb | 48 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-imad32.ads | 43 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-imad64.ads | 43 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-imagea.adb | 80 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-imagea.ads | 45 | ||||
| -rw-r--r-- | gcc/ada/rtsfind.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/rtsfind.ads | 9 |
13 files changed, 289 insertions, 59 deletions
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 0f5ebb8..1512c01 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -611,6 +611,9 @@ GNATRTL_NONTASKING_OBJS= \ s-geveop$(objext) \ s-gloloc$(objext) \ s-htable$(objext) \ + s-imad32$(objext) \ + s-imad64$(objext) \ + s-imagea$(objext) \ s-imageb$(objext) \ s-imaged$(objext) \ s-imagef$(objext) \ diff --git a/gcc/ada/exp_atag.adb b/gcc/ada/exp_atag.adb index 12c7d8c..70bdd16 100644 --- a/gcc/ada/exp_atag.adb +++ b/gcc/ada/exp_atag.adb @@ -36,6 +36,7 @@ with Opt; use Opt; with Rtsfind; use Rtsfind; with Sinfo; use Sinfo; with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sem_Aux; use Sem_Aux; with Sem_Disp; use Sem_Disp; with Sem_Util; use Sem_Util; @@ -776,19 +777,45 @@ package body Exp_Atag is function Build_Set_Size_Function (Loc : Source_Ptr; - Tag_Node : Node_Id; - Size_Func : Entity_Id) return Node_Id is + Typ : Entity_Id; + Size_Func : Entity_Id) return Node_Id + is + F_Nod : constant Node_Id := Freeze_Node (Typ); + + Act : Node_Id; + begin pragma Assert (Chars (Size_Func) = Name_uSize - and then RTE_Record_Component_Available (RE_Size_Func)); + and then RTE_Record_Component_Available (RE_Size_Func) + and then Present (F_Nod)); + + -- Find the declaration of the TSD object in the freeze actions + + Act := First (Actions (F_Nod)); + while Present (Act) loop + if Nkind (Act) = N_Object_Declaration + and then Nkind (Object_Definition (Act)) = N_Subtype_Indication + and then Is_Entity_Name (Subtype_Mark (Object_Definition (Act))) + and then Is_RTE (Entity (Subtype_Mark (Object_Definition (Act))), + RE_Type_Specific_Data) + then + exit; + end if; + + Next (Act); + end loop; + + pragma Assert (Present (Act)); + + -- Generate: + -- TSD.Size_Func := Size_Ptr!(Size_Func'Unrestricted_Access); + return Make_Assignment_Statement (Loc, Name => Make_Selected_Component (Loc, - Prefix => - Make_Explicit_Dereference (Loc, - Build_TSD (Loc, - Unchecked_Convert_To (RTE (RE_Address), Tag_Node))), + Prefix => + New_Occurrence_Of (Defining_Identifier (Act), Loc), Selector_Name => New_Occurrence_Of (RTE_Record_Component (RE_Size_Func), Loc)), diff --git a/gcc/ada/exp_atag.ads b/gcc/ada/exp_atag.ads index 96cb566..7e987f1 100644 --- a/gcc/ada/exp_atag.ads +++ b/gcc/ada/exp_atag.ads @@ -162,9 +162,9 @@ package Exp_Atag is function Build_Set_Size_Function (Loc : Source_Ptr; - Tag_Node : Node_Id; + Typ : Entity_Id; Size_Func : Entity_Id) return Node_Id; - -- Build code that saves in the TSD the address of the function + -- Build code that saves in the TSD of Typ the address of the function -- calculating _size of the object. function Build_Set_Static_Offset_To_Top diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 1a19c1e..666f84ec 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -70,6 +70,7 @@ with Stringt; use Stringt; with Strub; use Strub; with SCIL_LL; use SCIL_LL; with Tbuild; use Tbuild; +with Ttypes; use Ttypes; package body Exp_Disp is @@ -5217,8 +5218,10 @@ package body Exp_Disp is Chars => New_External_Name (Tname, 'A')); Full_Name : constant String_Id := Fully_Qualified_Name_String (First_Subtype (Typ)); - Str1_Id : String_Id; - Str2_Id : String_Id; + + Address_Image : RE_Id; + Str1_Id : String_Id; + Str2_Id : String_Id; begin -- Generate: @@ -5240,7 +5243,17 @@ package body Exp_Disp is -- Exname : constant String := -- Str1 & Address_Image (Tag) & Str2; - if RTE_Available (RE_Address_Image) then + -- We use Address_Image64 for Morello because Integer_Address + -- is 64-bit large even though Address is 128-bit large. + + case System_Address_Size is + when 32 => Address_Image := RE_Address_Image32; + when 64 => Address_Image := RE_Address_Image64; + when 128 => Address_Image := RE_Address_Image64; + when others => raise Program_Error; + end case; + + if RTE_Available (Address_Image) then Append_To (Result, Make_Object_Declaration (Loc, Defining_Identifier => Exname, @@ -5256,7 +5269,7 @@ package body Exp_Disp is Make_Function_Call (Loc, Name => New_Occurrence_Of - (RTE (RE_Address_Image), Loc), + (RTE (Address_Image), Loc), Parameter_Associations => New_List ( Unchecked_Convert_To (RTE (RE_Address), New_Occurrence_Of (DT_Ptr, Loc)))), @@ -7565,11 +7578,7 @@ package body Exp_Disp is if Chars (Prim) = Name_uSize and then RTE_Record_Component_Available (RE_Size_Func) then - DT_Ptr := Node (First_Elmt (Access_Disp_Table (Tag_Typ))); - Append_To (L, - Build_Set_Size_Function (Loc, - Tag_Node => New_Occurrence_Of (DT_Ptr, Loc), - Size_Func => Prim)); + Append_To (L, Build_Set_Size_Function (Loc, Tag_Typ, Prim)); end if; else diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 4f1b310..3cbbf50 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -528,6 +528,8 @@ GNAT_ADA_OBJS+= \ ada/libgnat/s-excmac.o \ ada/libgnat/s-exctab.o \ ada/libgnat/s-htable.o \ + ada/libgnat/s-imad32.o \ + ada/libgnat/s-imad64.o \ ada/libgnat/s-imgint.o \ ada/libgnat/s-mastop.o \ ada/libgnat/s-memory.o \ diff --git a/gcc/ada/libgnat/a-tags.ads b/gcc/ada/libgnat/a-tags.ads index a36d2df..25a6f7e 100644 --- a/gcc/ada/libgnat/a-tags.ads +++ b/gcc/ada/libgnat/a-tags.ads @@ -260,6 +260,7 @@ private type Prim_Ptr is access procedure; type Address_Array is array (Positive range <>) of Prim_Ptr; + pragma Suppress_Initialization (Address_Array); subtype Dispatch_Table is Address_Array (1 .. 1); -- Used by GDB to identify the _tags and traverse the run-time structure diff --git a/gcc/ada/libgnat/s-addima.adb b/gcc/ada/libgnat/s-addima.adb index 61933ed..f1488b6 100644 --- a/gcc/ada/libgnat/s-addima.adb +++ b/gcc/ada/libgnat/s-addima.adb @@ -29,44 +29,18 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Unchecked_Conversion; +with System.Img_Address_32; +with System.Img_Address_64; function System.Address_Image (A : Address) return String is - - Result : String (1 .. 2 * Address'Size / Storage_Unit); - - type Byte is mod 2 ** 8; - for Byte'Size use 8; - - Hexdigs : - constant array (Byte range 0 .. 15) of Character := "0123456789ABCDEF"; - - type Bytes is array (1 .. Address'Size / Storage_Unit) of Byte; - for Bytes'Size use Address'Size; - - function To_Bytes is new Ada.Unchecked_Conversion (Address, Bytes); - - Byte_Sequence : constant Bytes := To_Bytes (A); - - LE : constant := Standard'Default_Bit_Order; - BE : constant := 1 - LE; - -- Set to 1/0 for True/False for Little-Endian/Big-Endian - - Start : constant Natural := BE * (1) + LE * (Bytes'Length); - Incr : constant Integer := BE * (1) + LE * (-1); - -- Start and increment for accessing characters of address string - - Ptr : Natural; - -- Scan address string - begin - Ptr := Start; - for N in Bytes'Range loop - Result (2 * N - 1) := Hexdigs (Byte_Sequence (Ptr) / 16); - Result (2 * N) := Hexdigs (Byte_Sequence (Ptr) mod 16); - Ptr := Ptr + Incr; - end loop; - - return Result; - + -- We use Address_Image64 for Morello because Integer_Address is 64-bit + -- large even though Address is 128-bit large. + + case Address'Size is + when 32 => return String (System.Img_Address_32.Address_Image32 (A)); + when 64 => return String (System.Img_Address_64.Address_Image64 (A)); + when 128 => return String (System.Img_Address_64.Address_Image64 (A)); + when others => raise Program_Error; + end case; end System.Address_Image; diff --git a/gcc/ada/libgnat/s-imad32.ads b/gcc/ada/libgnat/s-imad32.ads new file mode 100644 index 0000000..9130c3a --- /dev/null +++ b/gcc/ada/libgnat/s-imad32.ads @@ -0,0 +1,43 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M . I M G _ A D D R E S S _ 3 2 -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2024, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.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 Interfaces; +with System.Image_A; + +package System.Img_Address_32 is + pragma Pure; + + package Impl is new Image_A (Interfaces.Unsigned_32); + + function Address_Image32 (A : Address) return Impl.Address_String + renames Impl.Address_Image; + +end System.Img_Address_32; diff --git a/gcc/ada/libgnat/s-imad64.ads b/gcc/ada/libgnat/s-imad64.ads new file mode 100644 index 0000000..c8da3ee --- /dev/null +++ b/gcc/ada/libgnat/s-imad64.ads @@ -0,0 +1,43 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M . I M G _ A D D R E S S _ 6 4 -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2024, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.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 Interfaces; +with System.Image_A; + +package System.Img_Address_64 is + pragma Pure; + + package Impl is new Image_A (Interfaces.Unsigned_64); + + function Address_Image64 (A : Address) return Impl.Address_String + renames Impl.Address_Image; + +end System.Img_Address_64; diff --git a/gcc/ada/libgnat/s-imagea.adb b/gcc/ada/libgnat/s-imagea.adb new file mode 100644 index 0000000..abcb883 --- /dev/null +++ b/gcc/ada/libgnat/s-imagea.adb @@ -0,0 +1,80 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M . I M A G E _ A -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2024, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.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; + +with System.Storage_Elements; use System.Storage_Elements; + +package body System.Image_A is + + ------------------- + -- Address_Image -- + ------------------- + + function Address_Image (A : Address) return Address_String is + Result : Address_String; + + type Byte is mod 2 ** 8; + for Byte'Size use 8; + + Hexdigs : + constant array (Byte range 0 .. 15) of Character := "0123456789ABCDEF"; + + type Bytes is array (1 .. Uns'Size / Storage_Unit) of Byte; + + function To_Bytes is new Ada.Unchecked_Conversion (Uns, Bytes); + + Byte_Sequence : constant Bytes := To_Bytes (Uns (Integer_Address (A))); + + LE : constant := Standard'Default_Bit_Order; + BE : constant := 1 - LE; + -- Set to 1/0 for True/False for Little-Endian/Big-Endian + + Start : constant Natural := BE * (1) + LE * (Bytes'Length); + Incr : constant Integer := BE * (1) + LE * (-1); + -- Start and increment for accessing characters of address string + + Ptr : Natural; + -- Scan address string + + begin + Ptr := Start; + + for N in Bytes'Range loop + Result (2 * N - 1) := Hexdigs (Byte_Sequence (Ptr) / 16); + Result (2 * N) := Hexdigs (Byte_Sequence (Ptr) mod 16); + Ptr := Ptr + Incr; + end loop; + + return Result; + end Address_Image; + +end System.Image_A; diff --git a/gcc/ada/libgnat/s-imagea.ads b/gcc/ada/libgnat/s-imagea.ads new file mode 100644 index 0000000..56b42bc --- /dev/null +++ b/gcc/ada/libgnat/s-imagea.ads @@ -0,0 +1,45 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M . I M A G E _ A -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2024, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +generic + + type Uns is mod <>; + +package System.Image_A is + pragma Pure; + + subtype Address_String is String (1 .. 2 * Uns'Size / Storage_Unit); + + function Address_Image (A : Address) return Address_String; + -- Return a string made up of hexadecimal digits with upper case letters + -- and without prefix representing the (lower part of) address A. + +end System.Image_A; diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index 7c9935e..4cfd9fe 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -605,7 +605,7 @@ package body Rtsfind is range Interfaces_C_Strings .. Interfaces_C_Strings; subtype System_Descendant is RTU_Id - range System_Address_Image .. System_Tasking_Stages; + range System_Address_To_Access_Conversions .. System_Tasking_Stages; subtype System_Atomic_Operations_Descendant is System_Descendant range System_Atomic_Operations_Test_And_Set .. diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 50c7786..f4566b4 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -199,7 +199,6 @@ package Rtsfind is -- Children of System - System_Address_Image, System_Address_To_Access_Conversions, System_Arith_64, System_Arith_128, @@ -263,6 +262,8 @@ package Rtsfind is System_Fore_Fixed_64, System_Fore_Fixed_128, System_Fore_Real, + System_Img_Address_32, + System_Img_Address_64, System_Img_Bool, System_Img_Char, System_Img_Decimal_32, @@ -756,7 +757,8 @@ package Rtsfind is RE_Null_Address, -- System RE_Priority, -- System - RE_Address_Image, -- System.Address_Image + RE_Address_Image32, -- System.Img_Address_32 + RE_Address_Image64, -- System.Img_Address_64 RE_Add_With_Ovflo_Check64, -- System.Arith_64 RE_Double_Divide64, -- System.Arith_64 @@ -2401,7 +2403,8 @@ package Rtsfind is RE_Null_Address => System, RE_Priority => System, - RE_Address_Image => System_Address_Image, + RE_Address_Image32 => System_Img_Address_32, + RE_Address_Image64 => System_Img_Address_64, RE_Add_With_Ovflo_Check64 => System_Arith_64, RE_Double_Divide64 => System_Arith_64, |