If s-trasym.adb (System.Traceback.Symbolic, used as a renaming by
GNAT.Traceback.Symbolic) is given a traceback from a
position-independent executable, it does not include the executable's
load address in the report. This is necessary in order to decode the
traceback report.
Note, this has already been done for s-trasym__dwarf.adb, which really
does produce a symbolic traceback; s-trasym.adb is the version used in
systems which don't actually support symbolication.
Bootstrapped and regtested (ada onlyj) on x86_64-apple-darwin.
* gcc/ada/libgnat/s-trasym.adb: Returns the traceback in the required
form. Note that leading zeros are trimmed from hexadecimal strings.
(Symbolic_Traceback): Import Executable_Load_Address.
(Trim_Hex): New internal function to trim leading '0' characters
from a hexadecimal string.
(Load_Address): New, from call to Executable_Load_Address.
(One_If_Executable_Is_PI): New, 0 if Load_Address is null, 1 if
not.
(Max_Image_Length): New, found by calling System.Address_Image on
the first address in the traceback. NB, doesn't include "0x".
(Load_Address_Prefix): New, String containing the required value.
(Max_Length_Needed): New, computed using the number of elements
in the traceback plus the load address, if the executable is PIE.
(Result): New String of the required length (which will be an
overestimate).
2024-11-13 Simon Wright <si...@pushface.org>
gcc/ada/Changelog:
PR target/117538
* libgnat/s-trasym.adb: Returns the traceback in the required
form. Note that leading zeros are trimmed from hexadecimal strings.
—
diff --git a/gcc/ada/libgnat/s-trasym.adb b/gcc/ada/libgnat/s-trasym.adb
index 894fcf37ffd..7172214453f 100644
--- a/gcc/ada/libgnat/s-trasym.adb
+++ b/gcc/ada/libgnat/s-trasym.adb
@@ -53,19 +53,75 @@ package body System.Traceback.Symbolic is
else
declare
- Img : String := System.Address_Image (Traceback (Traceback'First));
-
- Result : String (1 .. (Img'Length + 3) * Traceback'Length);
- Last : Natural := 0;
+ function Executable_Load_Address return System.Address;
+ pragma Import
+ (C, Executable_Load_Address,
+ "__gnat_get_executable_load_address");
+
+ function Trim_Hex (S : String) return String;
+ function Trim_Hex (S : String) return String is
+ Non_0 : Positive;
+ begin
+ for J in S'Range loop
+ if S (J) /= '0' or else J = S'Last then
+ Non_0 := J;
+ exit;
+ end if;
+ end loop;
+ return S (Non_0 .. S'Last);
+ end Trim_Hex;
+
+ Load_Address : constant System.Address :=
+ Executable_Load_Address;
+ One_If_Executable_Is_PI : constant Natural :=
+ Boolean'Pos (Load_Address /= Null_Address);
+
+ -- How long is an Address_Image?
+ Max_Image_Length : constant Natural :=
+ System.Address_Image (Traceback (Traceback'First))'
+ Length;
+
+ Load_Address_Prefix : constant String :=
+ "Load address: ";
+
+ Max_Length_Needed : constant Positive :=
+ (Load_Address_Prefix'Length *
+ One_If_Executable_Is_PI) +
+ (Max_Image_Length + 3) *
+ (Traceback'Length + One_If_Executable_Is_PI) +
+ 2;
+
+ Result : String (1 .. Max_Length_Needed);
+
+ Last : Natural := 0;
begin
+
+ if One_If_Executable_Is_PI /= 0 then
+ declare
+ item : constant String :=
+ Load_Address_Prefix & "0x" &
+ Trim_Hex
+ (System.Address_Image (Load_Address)) &
+ ASCII.LF;
+ begin
+ Last := item'Length;
+ Result (1 .. Last) := item;
+ end;
+ end if;
+
for J in Traceback'Range loop
- Img := System.Address_Image (Traceback (J));
- Result (Last + 1 .. Last + 2) := "0x";
- Last := Last + 2;
- Result (Last + 1 .. Last + Img'Length) := Img;
- Last := Last + Img'Length + 1;
- Result (Last) := ' ';
+ declare
+ Img : constant String :=
+ Trim_Hex
+ (System.Address_Image (Traceback (J)));
+ begin
+ Result (Last + 1 .. Last + 2) := "0x";
+ Last := Last + 2;
+ Result (Last + 1 .. Last + Img'Length) := Img;
+ Last := Last + Img'Length + 1;
+ Result (Last) := ' ';
+ end;
end loop;
Result (Last) := ASCII.LF;
