paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-26 00:17:22 +01:00
Code Issues Packages Projects Releases Wiki Activity

* use exeinfo unit to find .debug_line section

Browse Source 
git-svn-id: trunk@9801 -
This commit is contained in:
peter 2008-01-19 22:09:58 +00:00
parent c553583486
commit a504c974ab
1 changed files with 164 additions and 412 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

576
rtl/inc/lnfodwrf.pp
View File

@ -3,7 +3,7 @@
Copyright (c) 2006 by Thomas Schatzl, member of the FreePascal
Development team
Parts (c) 2000 Peter Vreman (adapted from original stabs line
Parts (c) 2000 Peter Vreman (adapted from original dwarfs line
reader)
Dwarf LineInfo Retriever
@ -19,35 +19,15 @@
unit lnfodwrf;
interface
{ disable stack checking }
{$mode objfpc}
{$S-}
procedure GetLineInfo(addr:ptruint;var func,source:string;var line:longint);
implementation
{ Note to implementors of other OS loaders:
- add a LoadXXX() function which has no parameters and returns a Boolean
in the "OS loaders section" enclosing it using the OS specific define.
This method should set the
DwarfOpened,
DwarfOffset and
DwarfSize
global variables properly (see comments at variable definition for more
information).
Additionally this method should return true if DWARF line info information
could be found.
The file variable which can be used for file I/O is the global "infile"
variable.
- in OpenDwarf(), add a call to this initializer function after the
"run OS specific initializer" comment, again enclosed in the system
specific define.
}
uses
exeinfo;
{ Current issues:
@ -55,365 +35,29 @@ implementation
- slow
}
{ some type definitions }
type
{$IFDEF CPU32}
UInt = DWord;
Int = Longint;
{$ENDIF}
{$IFDEF CPU64}
UInt = QWord;
Int = Int64;
{$ENDIF}
Bool8 = ByteBool;
var
{ the input file to read DWARF debug info from, i.e. paramstr(0) }
infile : File;
{ size of the current file, cached }
DwarfFilesize : Int64;
{ these variables should be set by the LoadXXX() methods for proper function }
{ set to true if DWARF debug info could be found in the file.
The DwarfOffset and DwarfSize variables must be valid after setting this }
DwarfOpened : Boolean;
{ the offset to the DWARF debug_line section in the file }
DwarfOffset : Int64;
{ the size of the DWARF .debug_line section in the file in bytes }
DwarfSize : SizeInt;
{$MACRO ON}
//{$DEFINE DEBUG_DWARF_PARSER}
{$ifdef DEBUG_DWARF_PARSER}
{$define DEBUG_WRITELN := WriteLn}
{$define DEBUG_COMMENT := }
{$define DEBUG_WRITELN := WriteLn}
{$define DEBUG_COMMENT := }
{$else}
{$define DEBUG_WRITELN := //}
{$define DEBUG_COMMENT := //}
{$define DEBUG_WRITELN := //}
{$define DEBUG_COMMENT := //}
{$endif}
{---------------------------------------------------------------------------
I/O utility functions
---------------------------------------------------------------------------}
var
base, limit : SizeInt;
index : SizeInt;
function Init(aBase, aLimit : Int64) : Boolean;
begin
base := aBase;
limit := aLimit;
Init := (aBase + limit) <= DwarfFilesize;
seek(infile, base);
index := 0;
end;
function Init(aBase : Int64) : Boolean;
begin
Init := Init(aBase, limit - (aBase - base));
end;
function Pos() : Int64;
begin
Pos := index;
end;
procedure Seek(const newIndex : Int64);
begin
index := newIndex;
system.seek(infile, base + index);
end;
{ Returns the next Byte from the input stream, or -1 if there has been
an error }
function ReadNext() : Int;
var
bytesread : SizeInt;
b : Byte;
begin
ReadNext := -1;
if (index < limit) then begin
blockread(infile, b, 1, bytesread);
ReadNext := b;
inc(index);
end;
if (bytesread <> 1) then
ReadNext := -1;
end;
{ Reads the next size bytes into dest. Returns true if successful,
false otherwise. Note that dest may be partially overwritten after
returning false. }
function ReadNext(var dest; size : SizeInt) : Boolean;
var
bytesread : SizeInt;
begin
bytesread := 0;
if ((index + size) < limit) then begin
blockread(infile, dest, size, bytesread);
inc(index, size);
end;
ReadNext := (bytesread = size);
end;
{---------------------------------------------------------------------------
OS specific loaders
---------------------------------------------------------------------------}
{$ifdef LINUX}
{$packrecords c}
{ ELF Header structures types}
{ some type definitions }
type
Elf32_Half = Word;
Elf64_Half = Word;
{ Types for signed and unsigned 32-bit quantities. }
Elf32_Word = DWord;
Elf32_Sword = Longint;
Elf64_Word = DWord;
Elf64_Sword = Longint;
{ Types for signed and unsigned 64-bit quantities. }
Elf32_Xword = QWord;
Elf32_Sxword = Int64;
Elf64_Xword = QWord;
Elf64_Sxword = Int64;
{ Type of addresses. }
Elf32_Addr = DWord;
Elf64_Addr = QWord;
{ Type of file offsets. }
Elf32_Off = DWord;
Elf64_Off = QWord;
{ Type for section indices, which are 16-bit quantities. }
Elf32_Section = Word;
Elf64_Section = Word;
{ Type for version symbol information. }
Elf32_Versym = Elf32_Half;
Elf64_Versym = Elf64_Half;
{ some constants from the corresponding header files }
const
El_NIDENT = 16;
{ some important indices into the e_ident signature of an ELF file }
EI_MAG0 = 0;
EI_MAG1 = 1;
EI_MAG2 = 2;
EI_MAG3 = 3;
EI_CLASS = 4;
{ the first byte of the e_ident array must be of this value }
ELFMAG0 = $7f;
{ the second byte of the e_ident array must be of this value }
ELFMAG1 = Byte('E');
{ the third byte of the e_ident array must be of this value }
ELFMAG2 = Byte('L');
{ the fourth byte of the e_ident array must be of this value }
ELFMAG3 = Byte('F');
Bool8 = ByteBool;
{ the fifth byte specifies the bitness of the header; all other values are invalid }
ELFCLASS32 = 1;
ELFCLASS64 = 2;
ELFCLASS = {$IFDEF CPU32}ELFCLASS32{$ENDIF}{$IFDEF CPU64}ELFCLASS64{$ENDIF};
type
{ The ELF file header. This appears at the start of every ELF file, 32 bit version }
TElf32_Ehdr = record
e_ident : array[0..El_NIDENT-1] of Byte; { file identification }
e_type : Elf32_Half; { file type }
e_machine : Elf32_Half; { machine architecture }
e_version : Elf32_Word; { ELF format version }
e_entry : Elf32_Addr; { entry point }
e_phoff : Elf32_Off; { program header file offset }
e_shoff : Elf32_Off; { section header file offset }
e_flags : Elf32_Word; { architecture specific flags }
e_ehsize : Elf32_Half; { size of ELF header in bytes }
e_phentsize : Elf32_Half; { size of program header entry }
e_phnum : Elf32_Half; { number of program header entries }
e_shentsize : Elf32_Half; { size of section header entry }
e_shnum : Elf32_Half; { number of section header entry }
e_shstrndx : Elf32_Half; { section name strings section index }
end;
{ ELF32 Section header }
TElf32_Shdr = record
sh_name : Elf32_Word; { section name }
sh_type : Elf32_Word; { section type }
sh_flags : Elf32_Word; { section flags }
sh_addr : Elf32_Addr; { virtual address }
sh_offset : Elf32_Off; { file offset }
sh_size : Elf32_Word; { section size }
sh_link : Elf32_Word; { misc info }
sh_info : Elf32_Word; { misc info }
sh_addralign : Elf32_Word; { memory alignment }
sh_entsize : Elf32_Word; { entry size if table }
end;
{ The ELF file header. This appears at the start of every ELF file, 64 bit version }
TElf64_Ehdr = record
e_ident : array[0..El_NIDENT-1] of Byte;
e_type : Elf64_Half;
e_machine : Elf64_Half;
e_version : Elf64_Word;
e_entry : Elf64_Addr;
e_phoff : Elf64_Off;
e_shoff : Elf64_Off;
e_flags : Elf64_Word;
e_ehsize : Elf64_Half;
e_phentsize : Elf64_Half;
e_phnum : Elf64_Half;
e_shentsize : Elf64_Half;
e_shnum : Elf64_Half;
e_shstrndx : Elf64_Half;
end;
{ ELF64 Section header }
TElf64_Shdr = record
sh_name : Elf64_Word;
sh_type : Elf64_Word;
sh_flags : Elf64_Xword;
sh_addr : Elf64_Addr;
sh_offset : Elf64_Off;
sh_size : Elf64_Xword;
sh_link : Elf64_Word;
sh_info : Elf64_Word;
sh_addralign : Elf64_Xword;
sh_entsize : Elf64_Xword;
end;
TElf_Shdr = {$ifdef cpu32}TElf32_Shdr{$endif}{$ifdef cpu64}TElf64_Shdr{$endif};
TElf_Ehdr = {$ifdef cpu32}TElf32_Ehdr{$endif}{$ifdef cpu64}TElf64_Ehdr{$endif};
{ use globals to save stack space }
var
header : TElf_Ehdr;
strtab_header : TElf_Shdr;
cursec_header : TElf_Shdr;
{ the input file to read DWARF debug info from, i.e. paramstr(0) }
e : TExeFile;
DwarfErr : boolean;
{ the offset and size of the DWARF debug_line section in the file }
DwarfOffset : longint;
DwarfSize : longint;
buf : array[0..20] of char;
function LoadLinux() : Boolean;
var
i : Integer;
begin
LoadLinux := false;
Init(0, DwarfFilesize);
if (not ReadNext(header, sizeof(header))) then begin
DEBUG_WRITELN('Could not read header');
exit;
end;
{ more paranoia checks }
if ((header.e_ident[EI_MAG0] <> ELFMAG0) or (header.e_ident[EI_MAG1] <> ELFMAG1) or
(header.e_ident[EI_MAG2] <> ELFMAG2) or (header.e_ident[EI_MAG3] <> ELFMAG3)) then begin
DEBUG_WRITELN('Invalid ELF magic header. Exiting');
exit;
end;
if (header.e_ident[EI_CLASS] <> ELFCLASS) then begin
DEBUG_WRITELN('Invalid ELF header bitness. Exiting');
exit;
end;
{ check e_version = , e_shentsize > 0, e_shnum > 0 }
{ seek to the start of section headers }
{ first get string section header }
Init(header.e_shoff + (header.e_shstrndx * header.e_shentsize));
if (not ReadNext(strtab_header, sizeof(strtab_header))) then begin
DEBUG_WRITELN('Could not read string section header');
exit;
end;
for i := 0 to (header.e_shnum-1) do begin
Init(header.e_shoff + (i * header.e_shentsize));
if (not ReadNext(cursec_header, sizeof(cursec_header))) then begin
DEBUG_WRITELN('Could not read next section header');
exit;
end;
{ paranoia TODO: check cursec_header.e_shentsize }
Init(strtab_header.sh_offset + cursec_header.sh_name);
if (not ReadNext(buf, sizeof(buf))) then begin
DEBUG_WRITELN('Could not read section name');
exit;
end;
buf[sizeof(buf)-1] := #0;
DEBUG_WRITELN('This section is "', pchar(@buf[0]), '", offset ', cursec_header.sh_offset, ' size ', cursec_header.sh_size);
if (pchar(@buf[0]) = '.debug_line') then begin
DEBUG_WRITELN('.debug_line section found');
DwarfOffset := cursec_header.sh_offset;
DwarfSize := cursec_header.sh_size;
{ more checks }
LoadLinux := (DwarfOffset >= 0) and (DwarfSize > 0);
end;
end;
end;
{$endif LINUX}
{---------------------------------------------------------------------------
Generic Dwarf lineinfo reader
The line info reader is based on the information contained in
DWARF Debugging Information Format Version 3
Chapter 6.2 "Line Number Information"
from the
DWARF Debugging Information Format Workgroup.
For more information on this document see also
http://dwarf.freestandards.org/
---------------------------------------------------------------------------}
procedure CloseDwarf();
begin
if (DwarfOpened) then
close(infile);
DwarfOpened := false;
end;
function OpenDwarf() : Boolean;
var
oldfilemode : Word;
begin
OpenDwarf := false;
{ open input file }
assign(infile, paramstr(0));
{$I-}
oldfilemode := filemode;
filemode := $40;
reset(infile, 1);
filemode := oldfilemode;
{$I+}
if (ioresult <> 0) then begin
DEBUG_WRITELN('Could not open file');
exit;
end;
DwarfFilesize := filesize(infile);
DwarfOpened := true;
{ run OS specific initializer }
{$ifdef linux}
if (LoadLinux()) then begin
OpenDwarf := true;
exit;
end;
{$endif}
CloseDwarf();
end;
{$packrecords default}
{ DWARF 2 default opcodes}
const
{ Extended opcodes }
@ -475,31 +119,104 @@ type
opcode_base : Byte;
end;
{ initializes the line info state to the default values }
procedure InitStateRegisters(var state : TMachineState; const aIs_Stmt : Bool8);
{---------------------------------------------------------------------------
I/O utility functions
---------------------------------------------------------------------------}
var
base, limit : SizeInt;
index : SizeInt;
function Opendwarf:boolean;
begin
with state do begin
address := 0;
file_id := 1;
line := 1;
column := 0;
is_stmt := aIs_Stmt;
basic_block := false;
end_sequence := false;
prolouge_end := false;
epilouge_begin := false;
isa := 0;
append_row := false;
end;
result:=false;
if dwarferr then
exit;
if not OpenExeFile(e,paramstr(0)) then
exit;
if FindExeSection(e,'.debug_line',dwarfoffset,dwarfsize) then
result:=true
else
begin
dwarferr:=true;
exit;
end;
end;
procedure Closedwarf;
begin
CloseExeFile(e);
end;
function Init(aBase, aLimit : Int64) : Boolean;
begin
base := aBase;
limit := aLimit;
Init := (aBase + limit) <= e.size;
seek(e.f, base);
index := 0;
end;
function Init(aBase : Int64) : Boolean;
begin
Init := Init(aBase, limit - (aBase - base));
end;
function Pos() : Int64;
begin
Pos := index;
end;
procedure Seek(const newIndex : Int64);
begin
index := newIndex;
system.seek(e.f, base + index);
end;
{ Returns the next Byte from the input stream, or -1 if there has been
an error }
function ReadNext() : Longint;
var
bytesread : SizeInt;
b : Byte;
begin
ReadNext := -1;
if (index < limit) then begin
blockread(e.f, b, 1, bytesread);
ReadNext := b;
inc(index);
end;
if (bytesread <> 1) then
ReadNext := -1;
end;
{ Reads the next size bytes into dest. Returns true if successful,
false otherwise. Note that dest may be partially overwritten after
returning false. }
function ReadNext(var dest; size : SizeInt) : Boolean;
var
bytesread : SizeInt;
begin
bytesread := 0;
if ((index + size) < limit) then begin
blockread(e.f, dest, size, bytesread);
inc(index, size);
end;
ReadNext := (bytesread = size);
end;
{ Reads an unsigned LEB encoded number from the input stream }
function ReadULEB128() : QWord;
var
shift : Byte;
data : Int;
data : PtrInt;
val : QWord;
result : QWord;
begin
shift := 0;
result := 0;
@ -512,16 +229,14 @@ begin
break;
data := ReadNext();
end;
ReadULEB128 := result;
end;
{ Reads a signed LEB encoded number from the input stream }
function ReadLEB128() : Int64;
var
shift : Byte;
data : Int;
data : PtrInt;
val : Int64;
result : Int64;
begin
shift := 0;
result := 0;
@ -540,23 +255,21 @@ begin
ReadLEB128 := result;
end;
{ Reads an address from the current input stream }
function ReadAddress() : PtrUInt;
var
result : PtrUInt;
begin
ReadNext(result, sizeof(result));
ReadAddress := result;
end;
{ Reads a zero-terminated string from the current input stream. If the
string is larger than 255 chars (maximum allowed number of elements in
a ShortString, excess characters will be chopped off. }
function ReadString() : ShortString;
var
temp : Int;
i : UInt;
result : ShortString;
temp : PtrInt;
i : PtrUInt;
begin
i := 1;
temp := ReadNext();
@ -577,18 +290,54 @@ begin
result := ''
else
Byte(result[0]) := i-1;
ReadString := result;
end;
{ Reads an unsigned Half from the current input stream }
function ReadUHalf() : Word;
var
result : Word;
begin
ReadNext(result, sizeof(result));
ReadUHalf := result;
end;
{---------------------------------------------------------------------------
Generic Dwarf lineinfo reader
The line info reader is based on the information contained in
DWARF Debugging Information Format Version 3
Chapter 6.2 "Line Number Information"
from the
DWARF Debugging Information Format Workgroup.
For more information on this document see also
http://dwarf.freestandards.org/
---------------------------------------------------------------------------}
{ initializes the line info state to the default values }
procedure InitStateRegisters(var state : TMachineState; const aIs_Stmt : Bool8);
begin
with state do begin
address := 0;
file_id := 1;
line := 1;
column := 0;
is_stmt := aIs_Stmt;
basic_block := false;
end_sequence := false;
prolouge_end := false;
epilouge_begin := false;
isa := 0;
append_row := false;
end;
end;
{ Skips all line info directory entries }
procedure SkipDirectories();
var s : ShortString;
@ -625,11 +374,8 @@ begin
end;
function CalculateAddressIncrement(opcode : Byte; const header : TLineNumberProgramHeader64) : Int64;
var
result : Int64;
begin
result := (Int64(opcode) - header.opcode_base) div header.line_range * header.minimum_instruction_length;
CalculateAddressIncrement := result;
end;
function GetFullFilename(const filenameStart, directoryStart : Int64; const file_id : DWord) : ShortString;
@ -669,6 +415,7 @@ begin
GetFullFilename := directory + filename;
end;
function ParseCompilationUnit(const addr : PtrUInt; const file_offset : QWord;
var source : String; var line : longint; var found : Boolean) : QWord;
var
@ -679,10 +426,10 @@ var
adjusted_opcode : Int64;
opcode : Int;
opcode : PtrInt;
extended_opcode : Byte;
extended_opcode_length : Int;
i, addrIncrement, lineIncrement : Int;
extended_opcode_length : PtrInt;
i, addrIncrement, lineIncrement : PtrInt;
{$ifdef DEBUG_DWARF_PARSER}
s : ShortString;
@ -921,8 +668,13 @@ begin
source := '';
found := false;
if (not DwarfOpened) and (not OpenDwarf()) then
if DwarfErr then
exit;
if not e.isopen then
begin
if not OpenDwarf then
exit;
end;
current_offset := DwarfOffset;
end_offset := DwarfOffset + DwarfSize;
@ -961,15 +713,15 @@ begin
end;
DwarfBackTraceStr := DwarfBackTraceStr + ' of ' + source;
end;
if (DwarfOpened) then
if e.IsOpen then
BackTraceStrFunc := Store;
end;
initialization
DwarfOpened := false;
BackTraceStrFunc := @DwarfBacktraceStr;
finalization
CloseDwarf();
if e.isopen then
CloseDwarf();
end.