public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r11-9042] [Ada] Add support for PE-COFF PIE to System.Dwarf_Line
@ 2021-09-30 11:48 Eric Botcazou
0 siblings, 0 replies; only message in thread
From: Eric Botcazou @ 2021-09-30 11:48 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:632dde0c5ed81e7b9e41ff2ddcf90dc0a87faa49
commit r11-9042-g632dde0c5ed81e7b9e41ff2ddcf90dc0a87faa49
Author: Eric Botcazou <ebotcazou@adacore.com>
Date: Thu Jun 24 12:19:36 2021 +0200
[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.
Diff:
---
gcc/ada/adaint.c | 3 ++
gcc/ada/libgnat/s-dwalin.adb | 60 +++++++++++++++++++++++-------------
gcc/ada/libgnat/s-dwalin.ads | 17 +++++------
gcc/ada/libgnat/s-objrea.adb | 73 +++++++++++++++++++++++++++++---------------
gcc/ada/libgnat/s-objrea.ads | 25 +++++++--------
5 files changed, 111 insertions(+), 67 deletions(-)
diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 0a90c92402c..2e54e69643a 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -3543,6 +3543,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 ecee3e12ec1..3a5f20fbc71 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 ea84e8f0eef..807108074a7 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 0cfa522ab30..2bd69292331 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;
@@ -219,7 +220,6 @@ package body System.Object_Reader is
Characteristics : uint16;
Variant : uint16;
end record;
-
pragma Pack (Header);
type Optional_Header_PE32 is record
@@ -305,7 +305,6 @@ package body System.Object_Reader is
NumberOfLinenumbers : uint16;
Characteristics : uint32;
end record;
-
pragma Pack (Section_Header);
IMAGE_SCN_CNT_CODE : constant := 16#0020#;
@@ -318,7 +317,6 @@ package body System.Object_Reader is
StorageClass : uint8;
NumberOfAuxSymbols : uint8;
end record;
-
pragma Pack (Symtab_Entry);
type Auxent_Section is record
@@ -434,7 +432,6 @@ package body System.Object_Reader is
s_nlnno : uint16;
s_flags : uint32;
end record;
-
pragma Pack (Section_Header);
STYP_TEXT : constant := 16#0020#;
@@ -459,7 +456,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;
@@ -548,6 +544,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),
@@ -676,6 +673,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));
@@ -691,6 +689,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);
@@ -745,6 +744,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));
@@ -857,7 +857,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
@@ -877,6 +878,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
@@ -934,6 +936,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;
@@ -1176,7 +1179,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
@@ -1357,6 +1361,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;
@@ -1397,6 +1402,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),
@@ -1410,6 +1416,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));
@@ -1424,7 +1431,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
@@ -1447,6 +1454,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);
@@ -1516,7 +1524,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;
@@ -1569,7 +1578,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
@@ -1601,6 +1611,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.
@@ -1641,8 +1652,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;
-----------------
@@ -1651,7 +1666,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);
@@ -1688,9 +1704,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;
@@ -1717,7 +1735,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);
@@ -1729,7 +1748,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);
@@ -1745,7 +1765,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
@@ -1797,6 +1818,7 @@ package body System.Object_Reader is
Off : Offset) return String
is
Buf : Buffer;
+
begin
Seek (S, Off);
Read_C_String (S, Buf);
@@ -1918,10 +1940,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;
@@ -1945,8 +1967,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
@@ -2023,7 +2045,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;
@@ -2142,7 +2165,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);
@@ -2216,7 +2240,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 b3cfe13ab06..bd268b8be48 100644
--- a/gcc/ada/libgnat/s-objrea.ads
+++ b/gcc/ada/libgnat/s-objrea.ads
@@ -284,7 +284,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.
@@ -378,9 +378,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
@@ -403,6 +402,7 @@ private
when ELF =>
Secstr_Stream : Mapped_Stream;
-- Section strings
+
when Any_PECOFF =>
ImageBase : uint64; -- ImageBase value from header
@@ -410,19 +410,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;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-09-30 11:48 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-09-30 11:48 [gcc r11-9042] [Ada] Add support for PE-COFF PIE to System.Dwarf_Line Eric Botcazou
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).