From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1285) id 005EB3857C4F; Thu, 30 Sep 2021 11:48:02 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 005EB3857C4F MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Eric Botcazou To: gcc-cvs@gcc.gnu.org Subject: [gcc r11-9042] [Ada] Add support for PE-COFF PIE to System.Dwarf_Line X-Act-Checkin: gcc X-Git-Author: Eric Botcazou X-Git-Refname: refs/heads/releases/gcc-11 X-Git-Oldrev: d039346359fb429c19c98ef768eba33651adc1d8 X-Git-Newrev: 632dde0c5ed81e7b9e41ff2ddcf90dc0a87faa49 Message-Id: <20210930114803.005EB3857C4F@sourceware.org> Date: Thu, 30 Sep 2021 11:48:02 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 30 Sep 2021 11:48:03 -0000 https://gcc.gnu.org/g:632dde0c5ed81e7b9e41ff2ddcf90dc0a87faa49 commit r11-9042-g632dde0c5ed81e7b9e41ff2ddcf90dc0a87faa49 Author: Eric Botcazou 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;