return (const void *)map->l_addr;
+#elif defined (_WIN32)
+ return GetModuleHandle (NULL);
+
#else
return NULL;
#endif
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
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
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
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;
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 --
---------------------
---------------
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;
----------
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
procedure Aranges_Lookup
(C : in out Dwarf_Context;
- Addr : Storage_Offset;
+ Addr : Address;
Info_Offset : out Offset;
Success : out Boolean)
is
loop
declare
- Start : Storage_Offset;
+ Start : Address;
Len : Storage_Count;
begin
Read_Aranges_Entry (C, Start, Len);
procedure Read_Aranges_Entry
(C : in out Dwarf_Context;
- Start : out Storage_Offset;
+ Start : out Address;
Len : out Storage_Count)
is
begin
begin
S := Read (C.Aranges);
L := Read (C.Aranges);
- Start := Storage_Offset (S);
+ Start := Address (S);
Len := Storage_Count (L);
end;
begin
S := Read (C.Aranges);
L := Read (C.Aranges);
- Start := Storage_Offset (S);
+ Start := Address (S);
Len := Storage_Count (L);
end;
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);
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);
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;
C : Dwarf_Context := Cin;
Addr_In_Traceback : Address;
- Offset_To_Lookup : Storage_Offset;
Dir_Name : Str_Access;
File_Name : Str_Access;
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,
with System.Bounded_Strings;
with System.Object_Reader;
-with System.Storage_Elements;
with System.Traceback_Entries;
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
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;
with System.CRTL;
package body System.Object_Reader is
+
use Interfaces;
use Interfaces.C;
use System.Mmap;
Characteristics : uint16;
Variant : uint16;
end record;
-
pragma Pack (Header);
type Optional_Header_PE32 is record
NumberOfLinenumbers : uint16;
Characteristics : uint32;
end record;
-
pragma Pack (Section_Header);
IMAGE_SCN_CNT_CODE : constant := 16#0020#;
StorageClass : uint8;
NumberOfAuxSymbols : uint8;
end record;
-
pragma Pack (Symtab_Entry);
type Auxent_Section is record
s_nlnno : uint16;
s_flags : uint32;
end record;
-
pragma Pack (Section_Header);
STYP_TEXT : constant := 16#0020#;
x_snstab : uint16;
end record;
for Aux_Entry'Size use 18 * 8;
-
pragma Pack (Aux_Entry);
C_EXT : constant := 2;
Shnum : uint32) return Object_Section
is
SHdr : constant Section_Header := Read_Section_Header (Obj, Shnum);
+
begin
return (Shnum,
Offset (SHdr.Sh_Offset),
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));
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);
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));
------------------
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
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
Hdr_Offset : Offset;
Opt_Offset : File_Size;
Opt_Stream : Mapped_Stream;
+
begin
Res.MF := F;
Res.In_Exception := In_Exception;
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
is
Res : XCOFF32_Object_File (Format => XCOFF32);
Strtab_Sz : uint32;
+
begin
Res.Mf := F;
Res.In_Exception := In_Exception;
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),
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));
(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
Sec : Object_Section) return String
is
Hdr : Section_Header;
+
begin
Hdr := Read_Section_Header (Obj, Sec.Num);
return Trim_Trailing_Nuls (Hdr.s_name);
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;
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
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.
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;
-----------------
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);
----------------------
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;
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);
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);
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
Off : Offset) return String
is
Buf : Buffer;
+
begin
Seek (S, Off);
Read_C_String (S, Buf);
-- 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;
is
function To_Str_Access is
new Ada.Unchecked_Conversion (Address, Str_Access);
-
Sz : constant Offset := Offset (Size);
+
begin
-- Check size
------------------
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;
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);
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
(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.
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
when ELF =>
Secstr_Stream : Mapped_Stream;
-- Section strings
+
when Any_PECOFF =>
ImageBase : uint64; -- ImageBase value from header
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;
git://gcc.gnu.org / gcc.git / commitdiff