paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 13:19:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ first implementation of dwarf line info generation using .file and .loc, little use with binary writers though ...

Browse Source 
git-svn-id: trunk@2327 -
This commit is contained in:
florian 2006-01-22 15:59:26 +00:00
parent 6ba68594be
commit 6af88cec0f
4 changed files with 243 additions and 124 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

302
compiler/aasmtai.pas
View File

@ -51,7 +51,8 @@ interface
ait_instruction, ait_instruction,
ait_datablock, ait_datablock,
ait_symbol, ait_symbol,
ait_symbol_end, { needed to calc the size of a symbol } { needed to calc the size of a symbol }
ait_symbol_end,
ait_directive, ait_directive,
ait_label, ait_label,
ait_const, ait_const,
@ -83,8 +84,8 @@ interface
ait_marker, ait_marker,
{ new source file (dwarf) } { new source file (dwarf) }
ait_file, ait_file,
{ new line in source file (dwarf) } { new line/loc in source file (dwarf) }
ait_line ait_loc
); );
taiconst_type = ( taiconst_type = (
@ -207,7 +208,8 @@ interface
a new ait type! } a new ait type! }
SkipInstr = [ait_comment, ait_symbol,ait_section SkipInstr = [ait_comment, ait_symbol,ait_section
,ait_stab, ait_function_name, ait_force_line ,ait_stab, ait_function_name, ait_force_line
,ait_regalloc, ait_tempalloc, ait_symbol_end, ait_directive]; ,ait_regalloc, ait_tempalloc, ait_symbol_end, ait_directive
,ait_file,ait_loc];
{ ait_* types which do not have line information (and hence which are of type { ait_* types which do not have line information (and hence which are of type
tai, otherwise, they are of type tailineinfo } tai, otherwise, they are of type tailineinfo }
@ -216,7 +218,8 @@ interface
ait_stab,ait_function_name, ait_stab,ait_function_name,
ait_cutobject,ait_marker,ait_align,ait_section,ait_comment, ait_cutobject,ait_marker,ait_align,ait_section,ait_comment,
ait_const, ait_const,
ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_real_128bit ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_real_128bit,
ait_file,ait_loc
]; ];
@ -514,104 +517,125 @@ interface
procedure ppuwrite(ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override;
end; end;
Taasmoutput=class; { Generates a dwarf file location }
tai_file = class(tai)
str : pchar;
idx : longint;
constructor Create(_str : string;_idx : longint);
destructor Destroy; override;
constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
function getcopy:tlinkedlistitem;override;
end;
tadd_reg_instruction_proc=procedure(instr:Tai;r:tregister) of object; { Generates a dwarf line location }
Trggetproc=procedure(list:Taasmoutput;position:Tai;subreg:Tsubregister;var result:Tregister) of object; tai_loc = class(tai)
Trgungetproc=procedure(list:Taasmoutput;position:Tai;r:Tregister) of object; fileidx,
line,
column : longint;
constructor Create(_fileidx,_line,_column : longint);
constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
end;
{ Class template for assembler instructions Taasmoutput=class;
}
tai_cpu_abstract = class(tailineinfo) tadd_reg_instruction_proc=procedure(instr:Tai;r:tregister) of object;
protected Trggetproc=procedure(list:Taasmoutput;position:Tai;subreg:Tsubregister;var result:Tregister) of object;
procedure ppuloadoper(ppufile:tcompilerppufile;var o:toper);virtual;abstract; Trgungetproc=procedure(list:Taasmoutput;position:Tai;r:Tregister) of object;
procedure ppuwriteoper(ppufile:tcompilerppufile;const o:toper);virtual;abstract;
procedure ppubuildderefimploper(var o:toper);virtual;abstract; { Class template for assembler instructions
procedure ppuderefoper(var o:toper);virtual;abstract; }
public tai_cpu_abstract = class(tailineinfo)
{ Condition flags for instruction } protected
condition : TAsmCond; procedure ppuloadoper(ppufile:tcompilerppufile;var o:toper);virtual;abstract;
{ Number of operands to instruction } procedure ppuwriteoper(ppufile:tcompilerppufile;const o:toper);virtual;abstract;
ops : byte; procedure ppubuildderefimploper(var o:toper);virtual;abstract;
{ Number of allocate oper structures } procedure ppuderefoper(var o:toper);virtual;abstract;
opercnt : byte; public
{ Operands of instruction } { Condition flags for instruction }
oper : array[0..max_operands-1] of poper; condition : TAsmCond;
{ Actual opcode of instruction } { Number of operands to instruction }
opcode : tasmop; ops : byte;
{ Number of allocate oper structures }
opercnt : byte;
{ Operands of instruction }
oper : array[0..max_operands-1] of poper;
{ Actual opcode of instruction }
opcode : tasmop;
{$ifdef x86} {$ifdef x86}
segprefix : tregister; segprefix : tregister;
{$endif x86} {$endif x86}
{ true if instruction is a jmp } { true if instruction is a jmp }
is_jmp : boolean; { is this instruction a jump? (needed for optimizer) } is_jmp : boolean; { is this instruction a jump? (needed for optimizer) }
Constructor Create(op : tasmop);virtual; Constructor Create(op : tasmop);virtual;
Destructor Destroy;override; Destructor Destroy;override;
function getcopy:TLinkedListItem;override; function getcopy:TLinkedListItem;override;
constructor ppuload(t:taitype;ppufile:tcompilerppufile);override; constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure buildderefimpl;override; procedure buildderefimpl;override;
procedure derefimpl;override; procedure derefimpl;override;
procedure SetCondition(const c:TAsmCond); procedure SetCondition(const c:TAsmCond);
procedure allocate_oper(opers:longint); procedure allocate_oper(opers:longint);
procedure loadconst(opidx:longint;l:aint); procedure loadconst(opidx:longint;l:aint);
procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint); procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
procedure loadlocal(opidx:longint;s:pointer;sofs:longint;indexreg:tregister;scale:byte;getoffset,forceref:boolean); procedure loadlocal(opidx:longint;s:pointer;sofs:longint;indexreg:tregister;scale:byte;getoffset,forceref:boolean);
procedure loadref(opidx:longint;const r:treference); procedure loadref(opidx:longint;const r:treference);
procedure loadreg(opidx:longint;r:tregister); procedure loadreg(opidx:longint;r:tregister);
procedure loadoper(opidx:longint;o:toper); procedure loadoper(opidx:longint;o:toper);
procedure clearop(opidx:longint); procedure clearop(opidx:longint);
{ register allocator } { register allocator }
function is_same_reg_move(regtype: Tregistertype):boolean;virtual; function is_same_reg_move(regtype: Tregistertype):boolean;virtual;
function spilling_get_operation_type(opnr: longint): topertype;virtual; function spilling_get_operation_type(opnr: longint): topertype;virtual;
function spilling_get_operation_type_ref(opnr: longint; reg: tregister): topertype;virtual; function spilling_get_operation_type_ref(opnr: longint; reg: tregister): topertype;virtual;
function Pass1(offset:longint):longint;virtual;abstract; function Pass1(offset:longint):longint;virtual;abstract;
procedure Pass2(objdata:TAsmObjectdata);virtual;abstract; procedure Pass2(objdata:TAsmObjectdata);virtual;abstract;
end; end;
tai_cpu_class = class of tai_cpu_abstract; tai_cpu_class = class of tai_cpu_abstract;
{ alignment for operator } { alignment for operator }
tai_align_abstract = class(tai) tai_align_abstract = class(tai)
aligntype : byte; { 1 = no align, 2 = word align, 4 = dword align } aligntype : byte; { 1 = no align, 2 = word align, 4 = dword align }
fillsize : byte; { real size to fill } fillsize : byte; { real size to fill }
fillop : byte; { value to fill with - optional } fillop : byte; { value to fill with - optional }
use_op : boolean; use_op : boolean;
constructor Create(b:byte);virtual; constructor Create(b:byte);virtual;
constructor Create_op(b: byte; _op: byte);virtual; constructor Create_op(b: byte; _op: byte);virtual;
constructor Create_zeros(b:byte); constructor Create_zeros(b:byte);
constructor ppuload(t:taitype;ppufile:tcompilerppufile);override; constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override;
function calculatefillbuf(var buf : tfillbuffer):pchar;virtual; function calculatefillbuf(var buf : tfillbuffer):pchar;virtual;
end; end;
tai_align_class = class of tai_align_abstract; tai_align_class = class of tai_align_abstract;
taasmoutput = class(tlinkedlist) taasmoutput = class(tlinkedlist)
constructor create; constructor create;
function empty : boolean; function empty : boolean;
function getlasttaifilepos : pfileposinfo; function getlasttaifilepos : pfileposinfo;
procedure InsertAfter(Item,Loc : TLinkedListItem);override; procedure InsertAfter(Item,Loc : TLinkedListItem);override;
end; end;
{ Type of asmlists. The order is important for the layout of the { Type of asmlists. The order is important for the layout of the
information in the .o file. The stabs for the types must be defined information in the .o file. The stabs for the types must be defined
before they can be referenced and therefor they need to be written before they can be referenced and therefor they need to be written
first (PFV) } first (PFV) }
Tasmlist=(al_stabsstart, Tasmlist=(al_stabsstart,
al_stabs, al_stabs,
al_procedures, al_procedures,
al_globals, al_globals,
al_const, al_const,
al_typedconsts, al_typedconsts,
al_rotypedconsts, al_rotypedconsts,
al_threadvars, al_threadvars,
al_imports, al_imports,
al_exports, al_exports,
al_resources, al_resources,
al_rtti, al_rtti,
al_dwarf, al_dwarf,
al_picdata, al_picdata,
al_resourcestrings, al_resourcestrings,
al_stabsend); al_stabsend);
const const
TasmlistStr : array[tasmlist] of string[24] =( TasmlistStr : array[tasmlist] of string[24] =(
'al_stabsstart', 'al_stabsstart',
@ -1900,6 +1924,93 @@ implementation
end; end;
{****************************************************************************
tai_file
****************************************************************************}
constructor tai_file.Create(_str : string;_idx : longint);
begin
inherited Create;
typ:=ait_file;
str:=strpnew(_str);
idx:=_idx;
end;
destructor tai_file.destroy;
begin
strdispose(str);
inherited Destroy;
end;
constructor tai_file.ppuload(t:taitype;ppufile:tcompilerppufile);
var
len : longint;
begin
inherited ppuload(t,ppufile);
len:=ppufile.getlongint;
getmem(str,len+1);
ppufile.getdata(str^,len);
str[len]:=#0;
idx:=ppufile.getlongint;
end;
procedure tai_file.ppuwrite(ppufile:tcompilerppufile);
var
len : longint;
begin
inherited ppuwrite(ppufile);
len:=strlen(str);
ppufile.putlongint(len);
ppufile.putdata(str^,len);
ppufile.putlongint(idx);
end;
function tai_file.getcopy : tlinkedlistitem;
var
p : tlinkedlistitem;
begin
p:=inherited getcopy;
getmem(tai_comment(p).str,strlen(str)+1);
move(str^,tai_comment(p).str^,strlen(str)+1);
getcopy:=p;
end;
{****************************************************************************
tai_loc
****************************************************************************}
constructor tai_loc.Create(_fileidx,_line,_column : longint);
begin
inherited Create;
typ:=ait_loc;
fileidx:=_fileidx;
line:=_line;
column:=_column;
end;
constructor tai_loc.ppuload(t:taitype;ppufile:tcompilerppufile);
begin
inherited ppuload(t,ppufile);
fileidx:=ppufile.getlongint;
line:=ppufile.getlongint;
column:=ppufile.getlongint;
end;
procedure tai_loc.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwrite(ppufile);
ppufile.putlongint(fileidx);
ppufile.putlongint(line);
ppufile.putlongint(column);
end;
{***************************************************************************** {*****************************************************************************
TaiInstruction TaiInstruction
*****************************************************************************} *****************************************************************************}
@ -1994,7 +2105,6 @@ implementation
end; end;
procedure tai_cpu_abstract.loadref(opidx:longint;const r:treference); procedure tai_cpu_abstract.loadref(opidx:longint;const r:treference);
begin begin
allocate_oper(opidx+1); allocate_oper(opidx+1);

20
compiler/aggas.pas
View File

@ -1,5 +1,5 @@
{ {
Copyright (c) 1998-2004 by the Free Pascal team Copyright (c) 1998-2006 by the Free Pascal team
This unit implements generic GNU assembler (v2.8 or later) This unit implements generic GNU assembler (v2.8 or later)
@ -793,6 +793,7 @@ implementation
AsmWriteLn(':'); AsmWriteLn(':');
end; end;
end; end;
ait_symbol : ait_symbol :
begin begin
if tai_symbol(hp).is_global then if tai_symbol(hp).is_global then
@ -877,6 +878,21 @@ implementation
end; end;
end; end;
ait_file :
begin
AsmWrite(#9'.file '+tostr(tai_file(hp).idx)+' "');
AsmWritePChar(tai_file(hp).str);
AsmWrite('"');
AsmLn;
end;
ait_loc :
begin
AsmWrite(#9'.loc '+tostr(tai_loc(hp).fileidx)+' '+tostr(tai_loc(hp).line)+' '+tostr(tai_loc(hp).column));
AsmLn;
end;
ait_force_line, ait_force_line,
ait_function_name : ; ait_function_name : ;
@ -921,7 +937,7 @@ implementation
end; end;
else else
internalerror(10000); internalerror(2006012201);
end; end;
hp:=tai(hp.next); hp:=tai(hp.next);
end; end;

43
compiler/dbgdwarf.pas
View File

@ -1,5 +1,5 @@
{ {
Copyright (c) 2003-2004 by Peter Vreman and Florian Klaempfl Copyright (c) 2003-2006 by Peter Vreman and Florian Klaempfl
This units contains support for DWARF debug info generation This units contains support for DWARF debug info generation
@ -31,13 +31,19 @@ interface
type type
TDebugInfoDwarf=class(TDebugInfo) TDebugInfoDwarf=class(TDebugInfo)
currfileidx : longint;
procedure insertlineinfo(list:taasmoutput);override; procedure insertlineinfo(list:taasmoutput);override;
end; end;
implementation implementation
uses uses
Systems; cutils,
globals,
Systems,
aasmbase,
finput,
fmodule;
const const
dbg_dwarf_info : tdbginfo = dbg_dwarf_info : tdbginfo =
@ -47,9 +53,6 @@ implementation
); );
procedure tdebuginfodwarf.insertlineinfo(list:taasmoutput); procedure tdebuginfodwarf.insertlineinfo(list:taasmoutput);
begin
end;
{
var var
currfileinfo, currfileinfo,
lastfileinfo : tfileposinfo; lastfileinfo : tfileposinfo;
@ -85,14 +88,14 @@ implementation
infile:=current_module.sourcefiles.get_file(currfileinfo.fileindex); infile:=current_module.sourcefiles.get_file(currfileinfo.fileindex);
if assigned(infile) then if assigned(infile) then
begin begin
objectlibrary.getlabel(hlabel,alt_dbgfile); inc(currfileidx);
{ emit stabs }
if (infile.path^<>'') then if (infile.path^<>'') then
list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+'",'+tostr(n_includefile)+ list.insertbefore(tai_file.create(
',0,0,'+hlabel.name),hp); BsToSlash(FixPath(infile.path^,false)+FixFileName(infile.name^)),currfileidx
list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+FixFileName(infile.name^)+'",'+tostr(n_includefile)+ ),hp)
',0,0,'+hlabel.name),hp); else
list.insertbefore(tai_label.create(hlabel),hp); list.insertbefore(tai_file.create(
FixFileName(infile.name^),currfileidx),hp);
{ force new line info } { force new line info }
lastfileinfo.line:=-1; lastfileinfo.line:=-1;
end; end;
@ -100,26 +103,14 @@ implementation
{ line changed ? } { line changed ? }
if (lastfileinfo.line<>currfileinfo.line) and (currfileinfo.line<>0) then if (lastfileinfo.line<>currfileinfo.line) and (currfileinfo.line<>0) then
begin list.insertbefore(tai_loc.create(
if assigned(currfuncname) and currfileidx,currfileinfo.line,currfileinfo.column),hp);
(tf_use_function_relative_addresses in target_info.flags) then
begin
objectlibrary.getlabel(hlabel,alt_dbgline);
list.insertbefore(Tai_stab.Create_str(stab_stabn,tostr(n_textline)+',0,'+tostr(currfileinfo.line)+','+
hlabel.name+' - '+{$IFDEF POWERPC64}'.'+{$ENDIF POWERPC64}currfuncname^),hp);
list.insertbefore(tai_label.create(hlabel),hp);
end
else
list.insertbefore(Tai_stab.Create_str(stab_stabd,tostr(n_textline)+',0,'+tostr(currfileinfo.line)),hp);
end;
lastfileinfo:=currfileinfo; lastfileinfo:=currfileinfo;
end; end;
hp:=tai(hp.next); hp:=tai(hp.next);
end; end;
end; end;
}
initialization initialization
RegisterDebugInfo(dbg_dwarf_info,TDebugInfoDwarf); RegisterDebugInfo(dbg_dwarf_info,TDebugInfoDwarf);

2
compiler/psystem.pas
View File

@ -526,6 +526,8 @@ implementation
aiclass[ait_regalloc]:=tai_regalloc; aiclass[ait_regalloc]:=tai_regalloc;
aiclass[ait_tempalloc]:=tai_tempalloc; aiclass[ait_tempalloc]:=tai_tempalloc;
aiclass[ait_marker]:=tai_marker; aiclass[ait_marker]:=tai_marker;
aiclass[ait_file]:=tai_file;
aiclass[ait_loc]:=tai_loc;
end; end;
end. end.