What I didn’t say before is that, if for example an exception is raised 
in Ada Language Server and the code uses s-trasym to output a report,
what you get on macOS is, for example,

ALS.MAIN] in GNATformat Format
[ALS.MAIN] raised CONSTRAINT_ERROR : erroneous memory access
_ALS.MAIN_ 0x0000000105847D68 0x0000000105847DA0 0x00000001058EA6AC
0x00000001058EB5F4 0x0000000104B292C5 0x0000000104B36C5C
0x0000000104A8C0A0 0x0000000104A3C29C 0x00000001049DB52C
0x0000000104A03844 0x0000000104A02DE8 0x0000000104A03058
0x0000000104A03C0C 0x0000000104A03240 0x0000000104A03854
0x0000000104A03884 0x0000000104A02DE8 0x0000000104A04F8C
0x00000001049996E8 0x00000001035BD344 0x00000001035BD620
0x00000001034AFBC8 0x00000001034962DC 0x000000010354930C
0x000000010353D33C 0x000000010252074C 0x000000010252D25C
0x000000010350A53C 0x0000000105831980 0x000000019EE8F2E0

which is useless without the program load address. (A symbolic traceback would 
be even better, but that would be a different and more difficult project).

What should I do to get this change pushed?

> On 13 Nov 2024, at 17:15, Simon Wright <si...@pushface.org> wrote:
> 
> 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;
> 
> 

Reply via email to