[Ada] Robustify traceback symbolization from dwarf info

Symbolization of traceback entries from dwarf info is
failing in multiple cases for addresses originating from
shared libraries.

Part of the problem is a confusion across different functions
regarding the kind of "address" at hand, sometimes full process
runtime addresses (e.g. in traceback entries), sometimes module
relative (e.g. in dwarf info segments).

This change fixes this by introducing the use of distinct types
for the two kinds of addresses, resorting to System.Address
for runtime addresses and to Storage_Elements.Storage_Offset
for module relative values. The accompanying code changes
tidy a few places where we can now use standard operators
to combine offets & addresses, and include a few corrections
of consistency problems at spots where comparisons were done
between runtime addresses and relative offsets.

2018-05-21  Olivier Hainque  <hainque@adacore.com>

gcc/ada/

	* libgnat/s-dwalin.ads (Dwarf_Context): Change type of Load_Address to
	Address, and type of Low, High to Storage_Offset.
	(Low): Rename as Low_Address and convey that the return value is a
	runtime reference accounting for a load address.
	* libgnat/s-dwalin.adb (Read_Aranges_Entry): Adjust to the
	address/offset type changes.
	(Aranges_Lookup): Likewise.
	(Symbolic_Address): Likewise.
	(Symbolic_Traceback): Likewise.
	(Dump_Cache): Likewise.
	(Is_Inside): Likewise.
	(Open): Likewise.
	(Set_Load_Address): Likewise.
	(Low_Address): Likewise, and account for C.Load_Address.
	* libgnat/s-trasym__dwarf.adb (Lt): Use Low_Address instead of Low.
	(Multi_Module_Symbolic_Traceback): Compare address in traceback
	with module Low_Address instead of Low.

From-SVN: r260450

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b14fbed476bdfc965a24f4b0779332da857aacf8..c54f4ad344c40fd5e95bf9b194435cf511eed0e3 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+2018-04-04  Olivier Hainque  <hainque@adacore.com>
+
+       * libgnat/s-dwalin.ads (Dwarf_Context): Change type of Load_Address to
+       Address, and type of Low, High to Storage_Offset.
+       (Low): Rename as Low_Address and convey that the return value is a
+       runtime reference accounting for a load address.
+       * libgnat/s-dwalin.adb (Read_Aranges_Entry): Adjust to the
+       address/offset type changes.
+       (Aranges_Lookup): Likewise.
+       (Symbolic_Address): Likewise.
+       (Symbolic_Traceback): Likewise.
+       (Dump_Cache): Likewise.
+       (Is_Inside): Likewise.
+       (Open): Likewise.
+       (Set_Load_Address): Likewise.
+       (Low_Address): Likewise, and account for C.Load_Address.
+       * libgnat/s-trasym__dwarf.adb (Lt): Use Low_Address instead of Low.
+       (Multi_Module_Symbolic_Traceback): Compare address in traceback
+       with module Low_Address instead of Low.
+
 2018-04-04  Olivier Hainque  <hainque@adacore.com>
 
        * libgnat/s-dwalin.ads (Dwarf_Context): Rename Load_Slide as

diff --git a/gcc/ada/libgnat/s-dwalin.adb b/gcc/ada/libgnat/s-dwalin.adb
index 70f0125516595de5cd663f43e5c13c5d858a6a7d..a83dae707665d94f87d5e52514ee9c88340132a1 100644 (file)
--- a/gcc/ada/libgnat/s-dwalin.adb
+++ b/gcc/ada/libgnat/s-dwalin.adb
@@ -74,7 +74,7 @@ package body System.Dwarf_Lines is
 
    procedure Read_Aranges_Entry
      (C     : in out Dwarf_Context;
-      Start :    out Integer_Address;
+      Start :    out Storage_Offset;
       Len   :    out Storage_Count);
    --  Read a single .debug_aranges pair
 
@@ -86,7 +86,7 @@ package body System.Dwarf_Lines is
 
    procedure Aranges_Lookup
      (C           : in out Dwarf_Context;
-      Addr        :        Address;
+      Addr        :        Storage_Offset;
       Info_Offset :    out Offset;
       Success     :    out Boolean);
    --  Search for Addr in .debug_aranges and return offset Info_Offset in
@@ -151,7 +151,7 @@ package body System.Dwarf_Lines is
 
    procedure Symbolic_Address
      (C           : in out Dwarf_Context;
-      Addr        :        Address;
+      Addr        :        Storage_Offset;
       Dir_Name    :    out Str_Access;
       File_Name   :    out Str_Access;
       Subprg_Name :    out String_Ptr_Len;
@@ -296,20 +296,22 @@ package body System.Dwarf_Lines is
          return;
       end if;
       for I in Cache'Range loop
-         Put (System.Address_Image (C.Low + Storage_Count (Cache (I).First)));
-         Put (" - ");
-         Put
-           (System.Address_Image
-              (C.Low + Storage_Count (Cache (I).First + Cache (I).Size)));
-         Put (" l@");
-         Put
-           (System.Address_Image
-              (To_Address (Integer_Address (Cache (I).Line))));
-         Put (": ");
-         S    := Read_Symbol (C.Obj.all, Offset (Cache (I).Sym));
-         Name := Object_Reader.Name (C.Obj.all, S);
-         Put (String (Name.Ptr (1 .. Name.Len)));
-         New_Line;
+         declare
+            E : Search_Entry renames Cache (I);
+            Base_Address : constant System.Address :=
+              To_Address (Integer_Address (C.Low + Storage_Count (E.First)));
+         begin
+            Put (System.Address_Image (Base_Address));
+            Put (" - ");
+            Put (System.Address_Image (Base_Address + Storage_Count (E.Size)));
+            Put (" l@");
+            Put (System.Address_Image (To_Address (Integer_Address (E.Line))));
+            Put (": ");
+            S    := Read_Symbol (C.Obj.all, Offset (E.Sym));
+            Name := Object_Reader.Name (C.Obj.all, S);
+            Put (String (Name.Ptr (1 .. Name.Len)));
+            New_Line;
+         end;
       end loop;
    end Dump_Cache;
 
@@ -372,18 +374,19 @@ package body System.Dwarf_Lines is
 
    function Is_Inside (C : Dwarf_Context; Addr : Address) return Boolean is
    begin
-      return (Addr >= To_Address (To_Integer (C.Low) + C.Load_Address)
-                and Addr <= To_Address (To_Integer (C.High) + C.Load_Address));
+      return (Addr >= C.Low + C.Load_Address
+                and then Addr <= C.High + C.Load_Address);
    end Is_Inside;
 
-   ---------
-   -- Low --
-   ---------
+   -----------------
+   -- Low_Address --
+   -----------------
 
-   function Low (C : Dwarf_Context) return Address is
+   function Low_Address (C : Dwarf_Context)
+      return System.Address is
    begin
-      return C.Low;
-   end Low;
+      return C.Load_Address + C.Low;
+   end Low_Address;
 
    ----------
    -- Open --
@@ -414,8 +417,8 @@ package body System.Dwarf_Lines is
       --  Get memory bounds
 
       Get_Memory_Bounds (C.Obj.all, Lo, Hi);
-      C.Low  := Address (Lo);
-      C.High := Address (Hi);
+      C.Low  := Storage_Offset (Lo);
+      C.High := Storage_Offset (Hi);
 
       --  Create a stream for debug sections
 
@@ -779,7 +782,7 @@ package body System.Dwarf_Lines is
 
    procedure Set_Load_Address (C : in out Dwarf_Context; Addr : Address) is
    begin
-      C.Load_Address := To_Integer (Addr);
+      C.Load_Address := Addr;
    end Set_Load_Address;
 
    ------------------
@@ -874,7 +877,7 @@ package body System.Dwarf_Lines is
 
    procedure Aranges_Lookup
      (C           : in out Dwarf_Context;
-      Addr        :        Address;
+      Addr        :        Storage_Offset;
       Info_Offset :    out Offset;
       Success     :    out Boolean)
    is
@@ -887,13 +890,13 @@ package body System.Dwarf_Lines is
 
          loop
             declare
-               Start : Integer_Address;
+               Start : Storage_Offset;
                Len   : Storage_Count;
             begin
                Read_Aranges_Entry (C, Start, Len);
                exit when Start = 0 and Len = 0;
-               if Addr >= To_Address (Start)
-                 and then Addr < To_Address (Start) + Len
+               if Addr >= Start
+                 and then Addr < Start + Len
                then
                   Success := True;
                   return;
@@ -1160,7 +1163,7 @@ package body System.Dwarf_Lines is
 
    procedure Read_Aranges_Entry
      (C     : in out Dwarf_Context;
-      Start :    out Integer_Address;
+      Start :    out Storage_Offset;
       Len   :    out Storage_Count)
    is
    begin
@@ -1171,7 +1174,7 @@ package body System.Dwarf_Lines is
          begin
             S     := Read (C.Aranges);
             L     := Read (C.Aranges);
-            Start := Integer_Address (S);
+            Start := Storage_Offset (S);
             Len   := Storage_Count (L);
          end;
       elsif Address'Size = 64 then
@@ -1180,7 +1183,7 @@ package body System.Dwarf_Lines is
          begin
             S     := Read (C.Aranges);
             L     := Read (C.Aranges);
-            Start := Integer_Address (S);
+            Start := Storage_Offset (S);
             Len   := Storage_Count (L);
          end;
       else
@@ -1249,7 +1252,7 @@ package body System.Dwarf_Lines is
          Info_Offset : Offset;
          Line_Offset : Offset;
          Success     : Boolean;
-         Ar_Start    : Integer_Address;
+         Ar_Start    : Storage_Offset;
          Ar_Len      : Storage_Count;
          Start, Len  : uint32;
          First, Last : Natural;
@@ -1270,7 +1273,7 @@ package body System.Dwarf_Lines is
                exit when Ar_Start = 0 and Ar_Len = 0;
 
                Len   := uint32 (Ar_Len);
-               Start := uint32 (Ar_Start - To_Integer (C.Low));
+               Start := uint32 (Ar_Start - C.Low);
 
                --  Search START in the array
                First := Cache'First;
@@ -1319,7 +1322,7 @@ package body System.Dwarf_Lines is
 
    procedure Symbolic_Address
      (C           : in out Dwarf_Context;
-      Addr        :        Address;
+      Addr        :        Storage_Offset;
       Dir_Name    :    out Str_Access;
       File_Name   :    out Str_Access;
       Subprg_Name :    out String_Ptr_Len;
@@ -1384,7 +1387,7 @@ package body System.Dwarf_Lines is
          Line_Num := Natural (Match.Line);
       end Set_Result;
 
-      Addr_Int     : constant Integer_Address := To_Integer (Addr);
+      Addr_Int     : constant uint64 := uint64 (Addr);
       Previous_Row : Line_Info_Registers;
       Info_Offset  : Offset;
       Line_Offset  : Offset;
@@ -1431,7 +1434,7 @@ package body System.Dwarf_Lines is
          --  Search symbol
          S := First_Symbol (C.Obj.all);
          while S /= Null_Symbol loop
-            if Spans (S, uint64 (Addr_Int)) then
+            if Spans (S, Addr_Int) then
                Subprg_Name := Object_Reader.Name (C.Obj.all, S);
                exit;
             end if;
@@ -1479,13 +1482,13 @@ package body System.Dwarf_Lines is
 
          if C.Registers.Is_Row then
             if not Previous_Row.End_Sequence
-              and then Addr_Int >= Integer_Address (Previous_Row.Address)
-              and then Addr_Int < Integer_Address (C.Registers.Address)
+              and then Addr_Int >= Previous_Row.Address
+              and then Addr_Int < C.Registers.Address
             then
                Set_Result (Previous_Row);
                return;
 
-            elsif Addr_Int = Integer_Address (C.Registers.Address) then
+            elsif Addr_Int = C.Registers.Address then
                Set_Result (C.Registers);
                return;
             end if;
@@ -1526,7 +1529,7 @@ package body System.Dwarf_Lines is
       C : Dwarf_Context := Cin;
 
       Addr_In_Traceback : Address;
-      Addr_To_Lookup    : Address;
+      Offset_To_Lookup  : Storage_Offset;
 
       Dir_Name    : Str_Access;
       File_Name   : Str_Access;
@@ -1547,12 +1550,11 @@ package body System.Dwarf_Lines is
 
          Addr_In_Traceback := PC_For (Traceback (J));
 
-         Addr_To_Lookup := To_Address
-           (To_Integer (Addr_In_Traceback) - C.Load_Address);
+         Offset_To_Lookup := Addr_In_Traceback - C.Load_Address;
 
          Symbolic_Address
            (C,
-            Addr_To_Lookup,
+            Offset_To_Lookup,
             Dir_Name,
             File_Name,
             Subprg_Name,

diff --git a/gcc/ada/libgnat/s-dwalin.ads b/gcc/ada/libgnat/s-dwalin.ads
index 58cbf2cf4d058239c4eef4e1733f83593c63dd26..8a1595b020a2d058a4787ab881c76a101a0525e9 100644 (file)
--- a/gcc/ada/libgnat/s-dwalin.ads
+++ b/gcc/ada/libgnat/s-dwalin.ads
@@ -75,9 +75,10 @@ package System.Dwarf_Lines is
    pragma Inline (Is_Inside);
    --  Return true iff a run-time address Addr is within the module
 
-   function Low (C : Dwarf_Context) return Address;
-   pragma Inline (Low);
-   --  Return the lowest address of C, from the module object file
+   function Low_Address (C : Dwarf_Context)
+      return System.Address;
+   pragma Inline (Low_Address);
+   --  Return the lowest address of C, accounting for the module load address
 
    procedure Dump (C : in out Dwarf_Context);
    --  Dump each row found in the object's .debug_lines section to standard out
@@ -163,13 +164,15 @@ private
    type Search_Array_Access is access Search_Array;
 
    type Dwarf_Context (In_Exception : Boolean := False) is record
-      Load_Address : System.Storage_Elements.Integer_Address := 0;
-      Low, High  : Address;
+      Low, High  : System.Storage_Elements.Storage_Offset;
       --  Bounds of the module, per the module object file
 
       Obj : SOR.Object_File_Access;
       --  The object file containing dwarf sections
 
+      Load_Address : System.Address := System.Null_Address;
+      --  The address at which the object file was loaded at run time
+
       Has_Debug : Boolean;
       --  True if all debug sections are available
 

diff --git a/gcc/ada/libgnat/s-trasym__dwarf.adb b/gcc/ada/libgnat/s-trasym__dwarf.adb
index 5330e4a270f365ddfead2b11db0c9662d294de62..fb35b6066482be08b6797af82fb3d8e7cc7f57ea 100644 (file)
--- a/gcc/ada/libgnat/s-trasym__dwarf.adb
+++ b/gcc/ada/libgnat/s-trasym__dwarf.adb
@@ -263,7 +263,7 @@ package body System.Traceback.Symbolic is
 
    function Lt (Left, Right : Module_Cache_Acc) return Boolean is
    begin
-      return Low (Left.C) < Low (Right.C);
+      return Low_Address (Left.C) < Low_Address (Right.C);
    end Lt;
 
    -----------------------------
@@ -469,7 +469,7 @@ package body System.Traceback.Symbolic is
             Hi := Modules_Cache'Last;
             while Lo <= Hi loop
                Mid := (Lo + Hi) / 2;
-               if Addr < Low (Modules_Cache (Mid).C) then
+               if Addr < Low_Address (Modules_Cache (Mid).C) then
                   Hi := Mid - 1;
                elsif Is_Inside (Modules_Cache (Mid).C, Addr) then
                   Multi_Module_Symbolic_Traceback