From: Patrick Bernardi <berna...@adacore.com> The runtime used label addresses to determine the code address of subprograms because the subprogram's canonical address on some targets is a descriptor or a stub. Simplify the code by using the Code_Address attribute instead, which is designed to return the code address of a subprogram. This also works around a current GNAT-LLVM limitation where the address of a label is incorrectly calculated when using -O1. As a result, we can now build a-except.adb and g-debpoo.adb at -O1 again with GNAT-LLVM.
gcc/ada/ * libgnat/a-excach.adb (Call_Chain): Replace Code_Address_For_AAA/ZZZ functions with AAA/ZZZ'Code_Address. * libgnat/a-except.adb (Code_Address_For_AAA/ZZZ): Delete. (AAA/ZZZ): New null procedures. * libgnat/g-debpoo.adb (Code_Address_For_Allocate_End): Delete. (Code_Address_For_Deallocate_End): Delete. (Code_Address_For_Dereference_End): Delete. (Allocate): Remove label and use Code_Address attribute to determine subprogram addresses. (Dellocate): Likewise. (Dereference): Likewise. (Allocate_End): Convert to null procedure. (Dellocate_End): Likewise. (Dereference_End): Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/a-excach.adb | 4 +- gcc/ada/libgnat/a-except.adb | 60 ++++++++++++----------------- gcc/ada/libgnat/g-debpoo.adb | 73 +++++++++++------------------------- 3 files changed, 48 insertions(+), 89 deletions(-) diff --git a/gcc/ada/libgnat/a-excach.adb b/gcc/ada/libgnat/a-excach.adb index 840da0c439f..784194d421e 100644 --- a/gcc/ada/libgnat/a-excach.adb +++ b/gcc/ada/libgnat/a-excach.adb @@ -66,8 +66,8 @@ begin (Traceback => Excep.Tracebacks, Max_Len => Max_Tracebacks, Len => Excep.Num_Tracebacks, - Exclude_Min => Code_Address_For_AAA, - Exclude_Max => Code_Address_For_ZZZ, + Exclude_Min => AAA'Code_Address, + Exclude_Max => ZZZ'Code_Address, Skip_Frames => 3); end if; diff --git a/gcc/ada/libgnat/a-except.adb b/gcc/ada/libgnat/a-except.adb index 7d728d6acfa..20a773661ae 100644 --- a/gcc/ada/libgnat/a-except.adb +++ b/gcc/ada/libgnat/a-except.adb @@ -65,29 +65,32 @@ package body Ada.Exceptions is -- from C clients using the given external name, even though they are not -- technically visible in the Ada sense. - function Code_Address_For_AAA return System.Address; - function Code_Address_For_ZZZ return System.Address; - -- Return start and end of procedures in this package + procedure AAA; + procedure ZZZ; + -- Start and end of procedures in this package -- - -- These procedures are used to provide exclusion bounds in - -- calls to Call_Chain at exception raise points from this unit. The - -- purpose is to arrange for the exception tracebacks not to include - -- frames from subprograms involved in the raise process, as these are - -- meaningless from the user's standpoint. + -- These procedures are used to provide exclusion bounds in calls to + -- Call_Chain at exception raise points from this unit. The purpose is + -- to arrange for the exception tracebacks not to include frames from + -- subprograms involved in the raise process, as these are meaningless + -- from the user's standpoint. -- -- For these bounds to be meaningful, we need to ensure that the object - -- code for the subprograms involved in processing a raise is located - -- after the object code Code_Address_For_AAA and before the object - -- code Code_Address_For_ZZZ. This will indeed be the case as long as - -- the following rules are respected: + -- code for the subprograms involved in processing a raise is located after + -- the object code AAA and before the object code ZZZ. This will indeed be + -- the case as long as the following rules are respected: -- -- 1) The bodies of the subprograms involved in processing a raise - -- are located after the body of Code_Address_For_AAA and before the - -- body of Code_Address_For_ZZZ. + -- are located after the body of AAA and before the body of ZZZ. -- -- 2) No pragma Inline applies to any of these subprograms, as this -- could delay the corresponding assembly output until the end of -- the unit. + -- + -- To obtain the address of AAA and ZZZ, use the Code_Address attribute + -- instead of the Address attribute as the latter will return the address + -- of a stub or descriptor on some platforms. This include IA-64, + -- PowerPC/AIX, big-endian PowerPC64 and HPUX. procedure Call_Chain (Excep : EOA); -- Store up to Max_Tracebacks in Excep, corresponding to the current @@ -771,24 +774,15 @@ package body Ada.Exceptions is Rmsg_36 : constant String := "stream operation not allowed" & NUL; Rmsg_37 : constant String := "build-in-place mismatch" & NUL; - -------------------------- - -- Code_Address_For_AAA -- - -------------------------- + --------- + -- AAA -- + --------- -- This function gives us the start of the PC range for addresses within -- the exception unit itself. We hope that gigi/gcc keep all the procedures -- in their original order. - function Code_Address_For_AAA return System.Address is - begin - -- We are using a label instead of Code_Address_For_AAA'Address because - -- on some platforms the latter does not yield the address we want, but - -- the address of a stub or of a descriptor instead. This is the case at - -- least on PA-HPUX. - - <<Start_Of_AAA>> - return Start_Of_AAA'Address; - end Code_Address_For_AAA; + procedure AAA is null; ---------------- -- Call_Chain -- @@ -1816,18 +1810,14 @@ package body Ada.Exceptions is return W (1 .. L); end Wide_Wide_Exception_Name; - -------------------------- - -- Code_Address_For_ZZZ -- - -------------------------- + --------- + -- ZZZ -- + --------- -- This function gives us the end of the PC range for addresses -- within the exception unit itself. We hope that gigi/gcc keeps all the -- procedures in their original order. - function Code_Address_For_ZZZ return System.Address is - begin - <<Start_Of_ZZZ>> - return Start_Of_ZZZ'Address; - end Code_Address_For_ZZZ; + procedure ZZZ is null; end Ada.Exceptions; diff --git a/gcc/ada/libgnat/g-debpoo.adb b/gcc/ada/libgnat/g-debpoo.adb index 521570f9ff6..93be9b1f445 100644 --- a/gcc/ada/libgnat/g-debpoo.adb +++ b/gcc/ada/libgnat/g-debpoo.adb @@ -362,13 +362,6 @@ package body GNAT.Debug_Pools is -- These procedures are used as markers when computing the stacktraces, -- so that addresses in the debug pool itself are not reported to the user. - Code_Address_For_Allocate_End : System.Address := System.Null_Address; - Code_Address_For_Deallocate_End : System.Address; - Code_Address_For_Dereference_End : System.Address; - -- Taking the address of the above procedures will not work on some - -- architectures (HPUX for instance). Thus we do the same thing that - -- is done in a-except.adb, and get the address of labels instead. - procedure Skip_Levels (Depth : Natural; Trace : Tracebacks_Array; @@ -944,8 +937,6 @@ package body GNAT.Debug_Pools is pragma Unreferenced (Lock); begin - <<Allocate_Label>> - if Disable then Storage_Address := System.CRTL.malloc (System.CRTL.size_t (Size_In_Storage_Elements)); @@ -1022,8 +1013,8 @@ package body GNAT.Debug_Pools is (Pool => Pool, Kind => Alloc, Size => Size_In_Storage_Elements, - Ignored_Frame_Start => Allocate_Label'Address, - Ignored_Frame_End => Code_Address_For_Allocate_End); + Ignored_Frame_Start => Allocate'Code_Address, + Ignored_Frame_End => Allocate_End'Code_Address); pragma Warnings (Off); -- Turn warning on alignment for convert call off. We know that in fact @@ -1073,8 +1064,8 @@ package body GNAT.Debug_Pools is Put (Output_File (Pool), "), at "); Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null, - Allocate_Label'Address, - Code_Address_For_Deallocate_End); + Allocate'Code_Address, + Deallocate_End'Code_Address); end if; -- Update internal data @@ -1106,11 +1097,7 @@ package body GNAT.Debug_Pools is -- is done in a-except, so that we can hide the traceback frames internal -- to this package - procedure Allocate_End is - begin - <<Allocate_End_Label>> - Code_Address_For_Allocate_End := Allocate_End_Label'Address; - end Allocate_End; + procedure Allocate_End is null; ------------------- -- Set_Dead_Beef -- @@ -1476,8 +1463,6 @@ package body GNAT.Debug_Pools is Header_Block_Size_Was_Less_Than_0 : Boolean := True; begin - <<Deallocate_Label>> - declare Lock : Scope_Lock; pragma Unreferenced (Lock); @@ -1518,8 +1503,8 @@ package body GNAT.Debug_Pools is Put (Output_File (Pool), "), at "); Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null, - Deallocate_Label'Address, - Code_Address_For_Deallocate_End); + Deallocate'Code_Address, + Deallocate_End'Code_Address); Print_Traceback (Output_File (Pool), " Memory was allocated at ", Header.Alloc_Traceback); @@ -1569,8 +1554,8 @@ package body GNAT.Debug_Pools is (Find_Or_Create_Traceback (Pool, Dealloc, Header.Block_Size, - Deallocate_Label'Address, - Code_Address_For_Deallocate_End)), + Deallocate'Code_Address, + Deallocate_End'Code_Address)), Next => System.Null_Address, Block_Size => -Header.Block_Size); @@ -1608,8 +1593,8 @@ package body GNAT.Debug_Pools is Put (Output_File (Pool), "error: Freeing Null_Address, at "); Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null, - Deallocate_Label'Address, - Code_Address_For_Deallocate_End); + Deallocate'Code_Address, + Deallocate_End'Code_Address); return; end if; end if; @@ -1629,8 +1614,8 @@ package body GNAT.Debug_Pools is Put (Output_File (Pool), "error: Freeing not allocated storage, at "); Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null, - Deallocate_Label'Address, - Code_Address_For_Deallocate_End); + Deallocate'Code_Address, + Deallocate_End'Code_Address); end if; elsif Header_Block_Size_Was_Less_Than_0 then @@ -1640,8 +1625,8 @@ package body GNAT.Debug_Pools is Put (Output_File (Pool), "error: Freeing already deallocated storage, at "); Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null, - Deallocate_Label'Address, - Code_Address_For_Deallocate_End); + Deallocate'Code_Address, + Deallocate_End'Code_Address); Print_Traceback (Output_File (Pool), " Memory already deallocated at ", To_Traceback (Header.Dealloc_Traceback)); @@ -1661,11 +1646,7 @@ package body GNAT.Debug_Pools is -- This is making assumptions about code order that may be invalid ??? - procedure Deallocate_End is - begin - <<Deallocate_End_Label>> - Code_Address_For_Deallocate_End := Deallocate_End_Label'Address; - end Deallocate_End; + procedure Deallocate_End is null; ----------------- -- Dereference -- @@ -1690,8 +1671,6 @@ package body GNAT.Debug_Pools is -- now invalid pointer would appear as valid). Instead, we prefer -- optimum performance for dereferences. - <<Dereference_Label>> - if not Valid then if Pool.Raise_Exceptions then raise Accessing_Not_Allocated_Storage; @@ -1699,8 +1678,8 @@ package body GNAT.Debug_Pools is Put (Output_File (Pool), "error: Accessing not allocated storage, at "); Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null, - Dereference_Label'Address, - Code_Address_For_Dereference_End); + Deallocate'Code_Address, + Dereference_End'Code_Address); end if; else @@ -1714,8 +1693,8 @@ package body GNAT.Debug_Pools is "error: Accessing deallocated storage, at "); Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null, - Dereference_Label'Address, - Code_Address_For_Dereference_End); + Deallocate'Code_Address, + Dereference_End'Code_Address); Print_Traceback (Output_File (Pool), " First deallocation at ", To_Traceback (Header.Dealloc_Traceback)); Print_Traceback (Output_File (Pool), " Initial allocation at ", @@ -1735,11 +1714,7 @@ package body GNAT.Debug_Pools is -- This is making assumptions about code order that may be invalid ??? - procedure Dereference_End is - begin - <<Dereference_End_Label>> - Code_Address_For_Dereference_End := Dereference_End_Label'Address; - end Dereference_End; + procedure Dereference_End is null; ---------------- -- Print_Info -- @@ -2512,10 +2487,4 @@ package body GNAT.Debug_Pools is Put_Line (Standard_Output, S); end Stdout_Put_Line; --- Package initialization - -begin - Allocate_End; - Deallocate_End; - Dereference_End; end GNAT.Debug_Pools; -- 2.40.0