[Ada] Add support for PE-COFF PIE to System.Dwarf_Line

gcc/ada/

	* adaint.c (__gnat_get_executable_load_address): Add Win32 support.
	* libgnat/s-objrea.ads (Get_Xcode_Bounds): Fix typo in comment.
	(Object_File): Minor reformatting.
	(ELF_Object_File): Uncomment predicate.
	(PECOFF_Object_File): Likewise.
	(XCOFF32_Object_File): Likewise.
	* libgnat/s-objrea.adb: Minor reformatting throughout.
	(Get_Load_Address): Implement for PE-COFF.
	* libgnat/s-dwalin.ads: Remove clause for System.Storage_Elements
	and use consistent wording in comments.
	(Dwarf_Context): Set type of Low, High and Load_Address to Address.
	* libgnat/s-dwalin.adb (Get_Load_Displacement): New function.
	(Is_Inside): Call Get_Load_Displacement.
	(Low_Address): Likewise.
	(Open): Adjust to type change.
	(Aranges_Lookup): Change type of Addr to Address.
	(Read_Aranges_Entry): Likewise for Start and adjust.
	(Enable_Cach): Adjust to type change.
	(Symbolic_Address): Change type of Addr to Address.
	(Symbolic_Traceback): Call Get_Load_Displacement.

5 files changed, 111 insertions, 67 deletions

diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 06a4895..d4445f0 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -3542,6 +3542,9 @@ __gnat_get_executable_load_address (void)
 
   return (const void *)map->l_addr;
 
+#elif defined (_WIN32)
+  return GetModuleHandle (NULL);
+
 #else
   return NULL;
 #endif
diff --git a/gcc/ada/libgnat/s-dwalin.adb b/gcc/ada/libgnat/s-dwalin.adb
index 56564c5..530b802 100644
--- a/gcc/ada/libgnat/s-dwalin.adb
+++ b/gcc/ada/libgnat/s-dwalin.adb
@@ -47,6 +47,10 @@ package body System.Dwarf_Lines is
 
    SSU : constant := System.Storage_Unit;
 
+   function Get_Load_Displacement (C : Dwarf_Context) return Storage_Offset;
+   --  Return the displacement between the load address present in the binary
+   --  and the run-time address at which it is loaded (i.e. non-zero for PIE).
+
    function String_Length (Str : Str_Access) return Natural;
    --  Return the length of the C string Str
 
@@ -74,7 +78,7 @@ package body System.Dwarf_Lines is
 
    procedure Read_Aranges_Entry
      (C     : in out Dwarf_Context;
-      Start :    out Storage_Offset;
+      Start :    out Address;
       Len   :    out Storage_Count);
    --  Read a single .debug_aranges pair
 
@@ -86,7 +90,7 @@ package body System.Dwarf_Lines is
 
    procedure Aranges_Lookup
      (C           : in out Dwarf_Context;
-      Addr        :        Storage_Offset;
+      Addr        :        Address;
       Info_Offset :    out Offset;
       Success     :    out Boolean);
    --  Search for Addr in .debug_aranges and return offset Info_Offset in
@@ -151,7 +155,7 @@ package body System.Dwarf_Lines is
 
    procedure Symbolic_Address
      (C           : in out Dwarf_Context;
-      Addr        :        Storage_Offset;
+      Addr        :        Address;
       Dir_Name    :    out Str_Access;
       File_Name   :    out Str_Access;
       Subprg_Name :    out String_Ptr_Len;
@@ -368,6 +372,19 @@ package body System.Dwarf_Lines is
       end loop;
    end For_Each_Row;
 
+   ---------------------------
+   -- Get_Load_Displacement --
+   ---------------------------
+
+   function Get_Load_Displacement (C : Dwarf_Context) return Storage_Offset is
+   begin
+      if C.Load_Address /= Null_Address then
+         return C.Load_Address - Address (Get_Load_Address (C.Obj.all));
+      else
+         return 0;
+      end if;
+   end Get_Load_Displacement;
+
    ---------------------
    -- Initialize_Pass --
    ---------------------
@@ -403,18 +420,19 @@ package body System.Dwarf_Lines is
    ---------------
 
    function Is_Inside (C : Dwarf_Context; Addr : Address) return Boolean is
+      Disp : constant Storage_Offset := Get_Load_Displacement (C);
+
    begin
-      return (Addr >= C.Low + C.Load_Address
-                and then Addr <= C.High + C.Load_Address);
+      return Addr >= C.Low + Disp and then Addr <= C.High + Disp;
    end Is_Inside;
 
    -----------------
    -- Low_Address --
    -----------------
 
-   function Low_Address (C : Dwarf_Context) return System.Address is
+   function Low_Address (C : Dwarf_Context) return Address is
    begin
-      return C.Load_Address + C.Low;
+      return C.Low + Get_Load_Displacement (C);
    end Low_Address;
 
    ----------
@@ -448,12 +466,12 @@ package body System.Dwarf_Lines is
 
       Success := True;
 
-      --  Get memory bounds for executable code.  Note that such code
+      --  Get address bounds for executable code. Note that such code
       --  might come from multiple sections.
 
       Get_Xcode_Bounds (C.Obj.all, Lo, Hi);
-      C.Low  := Storage_Offset (Lo);
-      C.High := Storage_Offset (Hi);
+      C.Low  := Address (Lo);
+      C.High := Address (Hi);
 
       --  Create a stream for debug sections
 
@@ -1046,7 +1064,7 @@ package body System.Dwarf_Lines is
 
    procedure Aranges_Lookup
      (C           : in out Dwarf_Context;
-      Addr        :        Storage_Offset;
+      Addr        :        Address;
       Info_Offset :    out Offset;
       Success     :    out Boolean)
    is
@@ -1060,7 +1078,7 @@ package body System.Dwarf_Lines is
 
          loop
             declare
-               Start : Storage_Offset;
+               Start : Address;
                Len   : Storage_Count;
             begin
                Read_Aranges_Entry (C, Start, Len);
@@ -1391,7 +1409,7 @@ package body System.Dwarf_Lines is
 
    procedure Read_Aranges_Entry
      (C     : in out Dwarf_Context;
-      Start :    out Storage_Offset;
+      Start :    out Address;
       Len   :    out Storage_Count)
    is
    begin
@@ -1403,7 +1421,7 @@ package body System.Dwarf_Lines is
          begin
             S     := Read (C.Aranges);
             L     := Read (C.Aranges);
-            Start := Storage_Offset (S);
+            Start := Address (S);
             Len   := Storage_Count (L);
          end;
 
@@ -1413,7 +1431,7 @@ package body System.Dwarf_Lines is
          begin
             S     := Read (C.Aranges);
             L     := Read (C.Aranges);
-            Start := Storage_Offset (S);
+            Start := Address (S);
             Len   := Storage_Count (L);
          end;
 
@@ -1503,11 +1521,12 @@ package body System.Dwarf_Lines is
          Info_Offset : Offset;
          Line_Offset : Offset;
          Success     : Boolean;
-         Ar_Start    : Storage_Offset;
+         Ar_Start    : Address;
          Ar_Len      : Storage_Count;
          Start, Len  : uint32;
          First, Last : Natural;
          Mid         : Natural;
+
       begin
          Seek (C.Aranges, 0);
 
@@ -1522,7 +1541,7 @@ package body System.Dwarf_Lines is
 
             loop
                Read_Aranges_Entry (C, Ar_Start, Ar_Len);
-               exit when Ar_Start = 0 and Ar_Len = 0;
+               exit when Ar_Start = Null_Address and Ar_Len = 0;
 
                Len   := uint32 (Ar_Len);
                Start := uint32 (Ar_Start - C.Low);
@@ -1578,7 +1597,7 @@ package body System.Dwarf_Lines is
 
    procedure Symbolic_Address
      (C           : in out Dwarf_Context;
-      Addr        :        Storage_Offset;
+      Addr        :        Address;
       Dir_Name    :    out Str_Access;
       File_Name   :    out Str_Access;
       Subprg_Name :    out String_Ptr_Len;
@@ -1871,7 +1890,6 @@ package body System.Dwarf_Lines is
       C : Dwarf_Context := Cin;
 
       Addr_In_Traceback : Address;
-      Offset_To_Lookup  : Storage_Offset;
 
       Dir_Name    : Str_Access;
       File_Name   : Str_Access;
@@ -1893,11 +1911,9 @@ package body System.Dwarf_Lines is
 
          Addr_In_Traceback := STE.PC_For (Traceback (J));
 
-         Offset_To_Lookup := Addr_In_Traceback - C.Load_Address;
-
          Symbolic_Address
            (C,
-            Offset_To_Lookup,
+            Addr_In_Traceback - Get_Load_Displacement (C),
             Dir_Name,
             File_Name,
             Subprg_Name,
diff --git a/gcc/ada/libgnat/s-dwalin.ads b/gcc/ada/libgnat/s-dwalin.ads
index 23ec275..bd86e5e 100644
--- a/gcc/ada/libgnat/s-dwalin.ads
+++ b/gcc/ada/libgnat/s-dwalin.ads
@@ -37,7 +37,6 @@
 
 with System.Bounded_Strings;
 with System.Object_Reader;
-with System.Storage_Elements;
 with System.Traceback_Entries;
 
 package System.Dwarf_Lines is
@@ -57,19 +56,19 @@ package System.Dwarf_Lines is
       C         : out Dwarf_Context;
       Success   : out Boolean);
    procedure Close (C : in out Dwarf_Context);
-   --  Open and close files
+   --  Open and close a file
 
    procedure Set_Load_Address (C : in out Dwarf_Context; Addr : Address);
-   --  Set the load address of a file. This is used to rebase PIE (Position
+   --  Set the run-time load address of a file. Used to rebase PIE (Position
    --  Independent Executable) binaries.
 
    function Is_Inside (C : Dwarf_Context; Addr : Address) return Boolean;
    pragma Inline (Is_Inside);
-   --  Return true iff a run-time address Addr is within the module
+   --  Return whether a run-time address Addr lies within the file
 
-   function Low_Address (C : Dwarf_Context) return System.Address;
+   function Low_Address (C : Dwarf_Context) return Address;
    pragma Inline (Low_Address);
-   --  Return the lowest address of C, accounting for the module load address
+   --  Return the lowest run-time address of the file
 
    procedure Dump (C : in out Dwarf_Context);
    --  Dump each row found in the object's .debug_lines section to standard out
@@ -174,13 +173,13 @@ private
    type Search_Array_Access is access Search_Array;
 
    type Dwarf_Context (In_Exception : Boolean := False) is record
-      Low, High  : System.Storage_Elements.Storage_Offset;
-      --  Bounds of the module, per the module object file
+      Low, High : Address;
+      --  Address bounds for executable code
 
       Obj : SOR.Object_File_Access;
       --  The object file containing dwarf sections
 
-      Load_Address : System.Address := System.Null_Address;
+      Load_Address : Address := Null_Address;
       --  The address at which the object file was loaded at run time
 
       Has_Debug : Boolean;
diff --git a/gcc/ada/libgnat/s-objrea.adb b/gcc/ada/libgnat/s-objrea.adb
index 9dd8c1f..e46c470 100644
--- a/gcc/ada/libgnat/s-objrea.adb
+++ b/gcc/ada/libgnat/s-objrea.adb
@@ -36,6 +36,7 @@ with Interfaces.C;
 with System.CRTL;
 
 package body System.Object_Reader is
+
    use Interfaces;
    use Interfaces.C;
    use System.Mmap;
@@ -220,7 +221,6 @@ package body System.Object_Reader is
          Characteristics      : uint16;
          Variant              : uint16;
       end record;
-
       pragma Pack (Header);
 
       type Optional_Header_PE32 is record
@@ -306,7 +306,6 @@ package body System.Object_Reader is
          NumberOfLinenumbers  : uint16;
          Characteristics      : uint32;
       end record;
-
       pragma Pack (Section_Header);
 
       IMAGE_SCN_CNT_CODE : constant := 16#0020#;
@@ -319,7 +318,6 @@ package body System.Object_Reader is
          StorageClass          : uint8;
          NumberOfAuxSymbols    : uint8;
       end record;
-
       pragma Pack (Symtab_Entry);
 
       type Auxent_Section is record
@@ -435,7 +433,6 @@ package body System.Object_Reader is
          s_nlnno   : uint16;
          s_flags   : uint32;
       end record;
-
       pragma Pack (Section_Header);
 
       STYP_TEXT : constant := 16#0020#;
@@ -460,7 +457,6 @@ package body System.Object_Reader is
          x_snstab   : uint16;
       end record;
       for Aux_Entry'Size use 18 * 8;
-
       pragma Pack (Aux_Entry);
 
       C_EXT     : constant := 2;
@@ -549,6 +545,7 @@ package body System.Object_Reader is
          Shnum : uint32) return Object_Section
       is
          SHdr : constant Section_Header := Read_Section_Header (Obj, Shnum);
+
       begin
          return (Shnum,
                  Offset (SHdr.Sh_Offset),
@@ -680,6 +677,7 @@ package body System.Object_Reader is
 
       function Read_Header (F : in out Mapped_Stream) return Header is
          Hdr : Header;
+
       begin
          Seek (F, 0);
          Read_Raw (F, Hdr'Address, uint32 (Hdr'Size / SSU));
@@ -695,6 +693,7 @@ package body System.Object_Reader is
          Shnum : uint32) return Section_Header
       is
          Shdr : Section_Header;
+
       begin
          Seek (Obj.Sectab_Stream, Offset (Shnum * Section_Header'Size / SSU));
          Read_Raw (Obj.Sectab_Stream, Shdr'Address, Section_Header'Size / SSU);
@@ -749,6 +748,7 @@ package body System.Object_Reader is
          Sec : Object_Section) return String
       is
          SHdr : Section_Header;
+
       begin
          SHdr := Read_Section_Header (Obj, Sec.Num);
          return Offset_To_String (Obj.Secstr_Stream, Offset (SHdr.Sh_Name));
@@ -861,7 +861,8 @@ package body System.Object_Reader is
       ------------------
 
       function First_Symbol
-        (Obj : in out PECOFF_Object_File) return Object_Symbol is
+        (Obj : in out PECOFF_Object_File) return Object_Symbol
+      is
       begin
          --  Return Null_Symbol in the case that the symbol table is empty
 
@@ -881,6 +882,7 @@ package body System.Object_Reader is
          Index : uint32) return Object_Section
       is
          Sec : constant Section_Header := Read_Section_Header (Obj, Index);
+
       begin
          --  Use VirtualSize instead of SizeOfRawData. The latter is rounded to
          --  the page size, so it may add garbage to the content. On the other
@@ -938,6 +940,7 @@ package body System.Object_Reader is
          Hdr_Offset : Offset;
          Opt_Offset : File_Size;
          Opt_Stream : Mapped_Stream;
+
       begin
          Res.MF := F;
          Res.In_Exception := In_Exception;
@@ -1180,7 +1183,8 @@ package body System.Object_Reader is
 
       function String_Table
         (Obj   : in out PECOFF_Object_File;
-         Index : Offset) return String is
+         Index : Offset) return String
+      is
       begin
          --  An index of zero is used to represent an empty string, as the
          --  first word of the string table is specified to contain the length
@@ -1361,6 +1365,7 @@ package body System.Object_Reader is
       is
          Res : XCOFF32_Object_File (Format => XCOFF32);
          Strtab_Sz : uint32;
+
       begin
          Res.Mf := F;
          Res.In_Exception := In_Exception;
@@ -1401,6 +1406,7 @@ package body System.Object_Reader is
          Index : uint32) return Object_Section
       is
          Sec : constant Section_Header := Read_Section_Header (Obj, Index);
+
       begin
          return (Index, Offset (Sec.s_scnptr),
                  uint64 (Sec.s_vaddr),
@@ -1414,6 +1420,7 @@ package body System.Object_Reader is
 
       function Read_Header (F : in out Mapped_Stream) return Header is
          Hdr : Header;
+
       begin
          Seek (F, 0);
          Read_Raw (F, Hdr'Address, uint32 (Hdr'Size / SSU));
@@ -1428,7 +1435,7 @@ package body System.Object_Reader is
         (Obj   : in out XCOFF32_Object_File;
          Index : uint32) return Section_Header
       is
-         Sec     : Section_Header;
+         Sec : Section_Header;
 
       begin
          --  Seek to the end of the object header
@@ -1451,6 +1458,7 @@ package body System.Object_Reader is
          Sec : Object_Section) return String
       is
          Hdr : Section_Header;
+
       begin
          Hdr := Read_Section_Header (Obj, Sec.Num);
          return Trim_Trailing_Nuls (Hdr.s_name);
@@ -1520,7 +1528,8 @@ package body System.Object_Reader is
 
    function Create_Stream
      (Obj : Object_File;
-      Sec : Object_Section) return Mapped_Stream is
+      Sec : Object_Section) return Mapped_Stream
+   is
    begin
       return Create_Stream (Obj.Mf, File_Size (Sec.Off), File_Size (Sec.Size));
    end Create_Stream;
@@ -1573,7 +1582,8 @@ package body System.Object_Reader is
 
    function Strip_Leading_Char
      (Obj : in out Object_File;
-      Sym : String_Ptr_Len) return Positive is
+      Sym : String_Ptr_Len) return Positive
+   is
    begin
       if (Obj.Format = PECOFF  and then Sym.Ptr (1) = '_')
         or else
@@ -1605,6 +1615,7 @@ package body System.Object_Reader is
         String (Sym.Ptr (1 .. Sym.Len)) & ASCII.NUL;
       Decoded : char_array (0 .. size_t (Sym.Len) * 2 + 60);
       Off     : Natural;
+
    begin
       --  In the PECOFF case most but not all symbol table entries have an
       --  extra leading underscore. In this case we trim it.
@@ -1645,8 +1656,12 @@ package body System.Object_Reader is
 
    function Get_Load_Address (Obj : Object_File) return uint64 is
    begin
-      raise Format_Error with "Get_Load_Address not implemented";
-      return 0;
+      if Obj.Format in Any_PECOFF then
+         return Obj.ImageBase;
+
+      else
+         raise Format_Error with "Get_Load_Address not implemented";
+      end if;
    end Get_Load_Address;
 
    -----------------
@@ -1655,7 +1670,8 @@ package body System.Object_Reader is
 
    function Get_Section
      (Obj   : in out Object_File;
-      Shnum : uint32) return Object_Section is
+      Shnum : uint32) return Object_Section
+   is
    begin
       case Obj.Format is
          when ELF32      => return ELF32_Ops.Get_Section   (Obj, Shnum);
@@ -1692,9 +1708,11 @@ package body System.Object_Reader is
    ----------------------
 
    procedure Get_Xcode_Bounds
-     (Obj   : in out Object_File;
-      Low, High : out uint64) is
+     (Obj       : in out Object_File;
+      Low, High : out uint64)
+   is
       Sec : Object_Section;
+
    begin
       --  First set as an empty range
       Low := uint64'Last;
@@ -1721,7 +1739,8 @@ package body System.Object_Reader is
 
    function Name
      (Obj : in out Object_File;
-      Sec : Object_Section) return String is
+      Sec : Object_Section) return String
+   is
    begin
       case Obj.Format is
          when ELF32      => return ELF32_Ops.Name   (Obj, Sec);
@@ -1733,7 +1752,8 @@ package body System.Object_Reader is
 
    function Name
      (Obj : in out Object_File;
-      Sym : Object_Symbol) return String_Ptr_Len is
+      Sym : Object_Symbol) return String_Ptr_Len
+   is
    begin
       case Obj.Format is
          when ELF32      => return ELF32_Ops.Name   (Obj, Sym);
@@ -1749,7 +1769,8 @@ package body System.Object_Reader is
 
    function Next_Symbol
      (Obj  : in out Object_File;
-      Prev : Object_Symbol) return Object_Symbol is
+      Prev : Object_Symbol) return Object_Symbol
+   is
    begin
       --  Test whether we've reached the end of the symbol table
 
@@ -1801,6 +1822,7 @@ package body System.Object_Reader is
       Off : Offset) return String
    is
       Buf     : Buffer;
+
    begin
       Seek (S, Off);
       Read_C_String (S, Buf);
@@ -1922,10 +1944,10 @@ package body System.Object_Reader is
    -- Read --
    ----------
 
-   function Read (S : in out Mapped_Stream) return Mmap.Str_Access
-   is
+   function Read (S : in out Mapped_Stream) return Mmap.Str_Access is
       function To_Str_Access is
          new Ada.Unchecked_Conversion (Address, Str_Access);
+
    begin
       return To_Str_Access (Data (S.Region) (Natural (S.Off + 1))'Address);
    end Read;
@@ -1949,8 +1971,8 @@ package body System.Object_Reader is
    is
       function To_Str_Access is
          new Ada.Unchecked_Conversion (Address, Str_Access);
-
       Sz : constant Offset := Offset (Size);
+
    begin
       --  Check size
 
@@ -2027,7 +2049,8 @@ package body System.Object_Reader is
    ------------------
 
    function Read_Address
-     (Obj : Object_File; S : in out Mapped_Stream) return uint64 is
+     (Obj : Object_File; S : in out Mapped_Stream) return uint64
+   is
       Address_32 : uint32;
       Address_64 : uint64;
 
@@ -2147,7 +2170,8 @@ package body System.Object_Reader is
 
    function Read_Symbol
      (Obj : in out Object_File;
-      Off : Offset) return Object_Symbol is
+      Off : Offset) return Object_Symbol
+   is
    begin
       case Obj.Format is
          when ELF32      => return ELF32_Ops.Read_Symbol   (Obj, Off);
@@ -2221,7 +2245,8 @@ package body System.Object_Reader is
 
    function To_String_Ptr_Len
      (Ptr : Mmap.Str_Access;
-      Max_Len : Natural := Natural'Last) return String_Ptr_Len is
+      Max_Len : Natural := Natural'Last) return String_Ptr_Len
+   is
    begin
       for I in 1 .. Max_Len loop
          if Ptr (I) = ASCII.NUL then
diff --git a/gcc/ada/libgnat/s-objrea.ads b/gcc/ada/libgnat/s-objrea.ads
index a83ca53..d20a53d 100644
--- a/gcc/ada/libgnat/s-objrea.ads
+++ b/gcc/ada/libgnat/s-objrea.ads
@@ -287,7 +287,7 @@ package System.Object_Reader is
      (Obj   : in out Object_File;
       Low, High : out uint64);
    --  Return the low and high addresses of the code for the object file. Can
-   --  be used to check if an address in within this object file. This
+   --  be used to check if an address lies within this object file. This
    --  procedure is not efficient and the result should be saved to avoid
    --  recomputation.
 
@@ -381,9 +381,8 @@ private
    subtype Any_PECOFF is Object_Format range PECOFF .. PECOFF_PLUS;
 
    type Object_File (Format : Object_Format) is record
-      Mf           : System.Mmap.Mapped_File :=
-                        System.Mmap.Invalid_Mapped_File;
-      Arch         : Object_Arch := Unknown;
+      Mf   : System.Mmap.Mapped_File := System.Mmap.Invalid_Mapped_File;
+      Arch : Object_Arch := Unknown;
 
       Num_Sections : uint32 := 0;
       --  Number of sections
@@ -406,6 +405,7 @@ private
          when ELF =>
             Secstr_Stream : Mapped_Stream;
             --  Section strings
+
          when Any_PECOFF =>
             ImageBase   : uint64;       --  ImageBase value from header
 
@@ -413,19 +413,20 @@ private
 
             GSVA_Sec  : uint32 := uint32'Last;
             GSVA_Addr : uint64;
+
          when XCOFF32 =>
             null;
       end case;
    end record;
 
-   subtype ELF_Object_File is Object_File; -- with
-   --  Predicate => ELF_Object_File.Format in ELF;
-   subtype PECOFF_Object_File is Object_File; -- with
-   --  Predicate => PECOFF_Object_File.Format in Any_PECOFF;
-   subtype XCOFF32_Object_File is Object_File; -- with
-   --  Predicate => XCOFF32_Object_File.Format in XCOFF32;
-   --  ???Above predicates cause the compiler to crash when instantiating
-   --  ELF64_Ops (see package body).
+   subtype ELF_Object_File is Object_File
+     with Predicate => ELF_Object_File.Format in ELF;
+
+   subtype PECOFF_Object_File is Object_File
+     with Predicate => PECOFF_Object_File.Format in Any_PECOFF;
+
+   subtype XCOFF32_Object_File is Object_File
+     with Predicate => XCOFF32_Object_File.Format in XCOFF32;
 
    type Object_Section is record
       Num        : uint32 := 0;