paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-04 19:10:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ basic dwarf support for variables and types

Browse Source 
git-svn-id: trunk@2353 -
This commit is contained in:
florian 2006-01-28 16:06:08 +00:00
parent db07870443
commit 8cd8e4ba8d
13 changed files with 1247 additions and 214 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
compiler/aasmbase.pas
View File

@ -64,7 +64,7 @@ interface
sec_debug_frame,
sec_debug_info,
sec_debug_line,
sec_debug_abrev,
sec_debug_abbrev,
{ ELF resources }
sec_fpc,
{ Table of contents section }
@ -587,7 +587,7 @@ implementation
function TAsmObjectData.sectionname(atype:tasmsectiontype;const aname:string):string;
const
secnames : array[tasmsectiontype] of string[12] = ('',
secnames : array[tasmsectiontype] of string[13] = ('',
'code','data','rodata','bss','threadvar',
'common',
'note',
@ -595,7 +595,7 @@ implementation
'stab','stabstr',
'idata2','idata4','idata5','idata6','idata7','edata',
'eh_frame',
'debug_frame','debug_info','debug_line','debug_abrev',
'debug_frame','debug_info','debug_line','debug_abbrev',
'fpc',
'toc'
);

16
compiler/aasmtai.pas
View File

@ -1,5 +1,5 @@
{
Copyright (c) 1998-2002 by Florian Klaempfl
Copyright (c) 1998-2006 by Florian Klaempfl
This unit implements an abstract asmoutput class for all processor types
@ -620,7 +620,7 @@ interface
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
first (PFV) }
Tasmlist=(al_stabsstart,
Tasmlist=(al_start,
al_stabs,
al_procedures,
al_globals,
@ -633,12 +633,15 @@ interface
al_resources,
al_rtti,
al_dwarf,
al_dwarf_info,
al_dwarf_abbrev,
al_dwarf_line,
al_picdata,
al_resourcestrings,
al_stabsend);
al_end);
const
TasmlistStr : array[tasmlist] of string[24] =(
'al_stabsstart',
'al_begin',
'al_stabs',
'al_procedures',
'al_globals',
@ -651,9 +654,12 @@ interface
'al_resources',
'al_rtti',
'al_dwarf',
'al_dwarf_info',
'al_dwarf_abbrev',
'al_dwarf_line',
'al_picdata',
'al_resourcestrings',
'al_stabsend');
'al_end');
regallocstr : array[tregalloctype] of string[10]=('allocated','released','sync','resized');
tempallocstr : array[boolean] of string[10]=('released','allocated');

8
compiler/aggas.pas
View File

@ -203,7 +203,7 @@ implementation
function TGNUAssembler.sectionname(atype:tasmsectiontype;const aname:string):string;
const
secnames : array[tasmsectiontype] of string[12] = ('',
secnames : array[tasmsectiontype] of string[13] = ('',
{$warning TODO .rodata not yet working}
'.text','.data','.data','.bss','.threadvar',
'common',
@ -212,11 +212,11 @@ implementation
'.stab','.stabstr',
'.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
'.eh_frame',
'.debug_frame','.debug_info','.debug_line','.debug_abrev',
'.debug_frame','.debug_info','.debug_line','.debug_abbrev',
'fpc.resptrs',
'.toc'
);
secnames_pic : array[tasmsectiontype] of string[12] = ('',
secnames_pic : array[tasmsectiontype] of string[13] = ('',
'.text','.data.rel','.data.rel','.bss','.threadvar',
'common',
'.note',
@ -224,7 +224,7 @@ implementation
'.stab','.stabstr',
'.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
'.eh_frame',
'.debug_frame','.debug_info','.debug_line','.debug_abrev',
'.debug_frame','.debug_info','.debug_line','.debug_abbrev',
'fpc.resptrs',
'.toc'
);

74
compiler/dbgbase.pas
View File

@ -1,7 +1,7 @@
{
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 debug info generation
This units contains the base class for debug info generation
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@ -26,18 +26,28 @@ unit dbgbase;
interface
uses
cclasses,
systems,
symdef,symtype,
symsym,
symconst,symbase,symdef,symtype,symsym,symtable,
fmodule,
aasmtai;
type
TDebugInfo=class
constructor Create;virtual;
procedure reset_unit_type_info;
procedure inserttypeinfo;virtual;
procedure insertmoduleinfo;virtual;
procedure insertlineinfo(list:taasmoutput);virtual;
procedure referencesections(list:taasmoutput);virtual;
procedure insertdef(list:taasmoutput;def:tdef);virtual;abstract;
procedure write_symtable_defs(list:taasmoutput;st:tsymtable);virtual;abstract;
procedure write_used_unit_type_info(list:taasmoutput;hp:tmodule);
procedure field_write_defs(p:Tnamedindexitem;arg:pointer);
procedure method_write_defs(p :tnamedindexitem;arg:pointer);
end;
TDebugInfoClass=class of TDebugInfo;
@ -81,6 +91,62 @@ implementation
end;
procedure tdebuginfo.reset_unit_type_info;
var
hp : tmodule;
begin
hp:=tmodule(loaded_units.first);
while assigned(hp) do
begin
hp.is_dbginfo_written:=false;
hp:=tmodule(hp.next);
end;
end;
procedure TDebugInfo.field_write_defs(p:Tnamedindexitem;arg:pointer);
begin
if (Tsym(p).typ=fieldvarsym) and
not(sp_static in Tsym(p).symoptions) then
insertdef(taasmoutput(arg),tfieldvarsym(p).vartype.def);
end;
procedure TDebugInfo.method_write_defs(p :tnamedindexitem;arg:pointer);
var
pd : tprocdef;
begin
if tsym(p).typ = procsym then
begin
pd:=tprocsym(p).first_procdef;
insertdef(taasmoutput(arg),pd.rettype.def);
end;
end;
procedure TDebugInfo.write_used_unit_type_info(list:taasmoutput;hp:tmodule);
var
pu : tused_unit;
begin
pu:=tused_unit(hp.used_units.first);
while assigned(pu) do
begin
if not pu.u.is_dbginfo_written then
begin
{ prevent infinte loop for circular dependencies }
pu.u.is_dbginfo_written:=true;
{ write type info from used units, use a depth first
strategy to reduce the recursion in writing all
dependent stabs }
write_used_unit_type_info(list,pu.u);
if assigned(pu.u.globalsymtable) then
write_symtable_defs(list,pu.u.globalsymtable);
end;
pu:=tused_unit(pu.next);
end;
end;
procedure InitDebugInfo;
begin
if not assigned(CDebugInfo[target_dbg.id]) then

1225
compiler/dbgdwarf.pas
View File

File diff suppressed because it is too large Load Diff

93
compiler/dbgstabs.pas
View File

@ -50,17 +50,15 @@ interface
procedure method_add_stabstr(p:Tnamedindexitem;arg:pointer);
function def_stabstr(def:tdef):pchar;
procedure write_def_stabstr(list:taasmoutput;def:tdef);
procedure field_write_defs(p:Tnamedindexitem;arg:pointer);
procedure method_write_defs(p :tnamedindexitem;arg:pointer);
procedure write_symtable_defs(list:taasmoutput;st:tsymtable);
procedure write_procdef(list:taasmoutput;pd:tprocdef);
procedure insertsym(list:taasmoutput;sym:tsym);
procedure insertdef(list:taasmoutput;def:tdef);
public
procedure inserttypeinfo;override;
procedure insertmoduleinfo;override;
procedure insertlineinfo(list:taasmoutput);override;
procedure referencesections(list:taasmoutput);override;
procedure insertdef(list:taasmoutput;def:tdef);override;
procedure write_symtable_defs(list:taasmoutput;st:tsymtable);override;
end;
@ -246,16 +244,16 @@ implementation
{ procdefs only need a number, mark them as already written
so they won't be written implicitly }
if (def.deftype=procdef) then
def.stab_state:=stab_state_written;
def.dbg_state:=dbg_state_written;
{ Stab must already be written, or we must be busy writing it }
if writing_def_stabs and
not(def.stab_state in [stab_state_writing,stab_state_written]) then
not(def.dbg_state in [dbg_state_writing,dbg_state_written]) then
internalerror(200403091);
{ Keep track of used stabs, this info is only usefull for stabs
referenced by the symbols. Definitions will always include all
required stabs }
if def.stab_state=stab_state_unused then
def.stab_state:=stab_state_used;
if def.dbg_state=dbg_state_unused then
def.dbg_state:=dbg_state_used;
{ Need a new number? }
if def.stab_number=0 then
begin
@ -653,7 +651,7 @@ implementation
begin
{ Write the invisible pointer for the class? }
if (def.objecttype=odt_class) and
(not def.writing_class_record_stab) then
(not def.writing_class_record_dbginfo) then
begin
result:=strpnew('*'+def_stab_classnumber(def));
exit;
@ -759,7 +757,7 @@ implementation
stabchar := 't';
{ Here we maybe generate a type, so we have to use numberstring }
if is_class(def) and
tobjectdef(def).writing_class_record_stab then
tobjectdef(def).writing_class_record_dbginfo then
st:=def_stabstr_evaluate(def,'"${sym_name}:$1$2=',[stabchar,def_stab_classnumber(tobjectdef(def))])
else
st:=def_stabstr_evaluate(def,'"${sym_name}:$1$2=',[stabchar,def_stab_number(def)]);
@ -778,41 +776,21 @@ implementation
end;
procedure TDebugInfoStabs.field_write_defs(p:Tnamedindexitem;arg:pointer);
begin
if (Tsym(p).typ=fieldvarsym) and
not(sp_static in Tsym(p).symoptions) then
insertdef(taasmoutput(arg),tfieldvarsym(p).vartype.def);
end;
procedure TDebugInfoStabs.method_write_defs(p :tnamedindexitem;arg:pointer);
var
pd : tprocdef;
begin
if tsym(p).typ = procsym then
begin
pd:=tprocsym(p).first_procdef;
insertdef(taasmoutput(arg),pd.rettype.def);
end;
end;
procedure TDebugInfoStabs.insertdef(list:taasmoutput;def:tdef);
var
anc : tobjectdef;
oldtypesym : tsym;
begin
if (def.stab_state in [stab_state_writing,stab_state_written]) then
if (def.dbg_state in [dbg_state_writing,dbg_state_written]) then
exit;
{ never write generic template defs }
if df_generic in def.defoptions then
begin
def.stab_state:=stab_state_written;
def.dbg_state:=dbg_state_written;
exit;
end;
{ to avoid infinite loops }
def.stab_state := stab_state_writing;
def.dbg_state := dbg_state_writing;
{ write dependencies first }
case def.deftype of
stringdef :
@ -874,9 +852,9 @@ implementation
if is_class(def) then
begin
{ Write the record class itself }
tobjectdef(def).writing_class_record_stab:=true;
tobjectdef(def).writing_class_record_dbginfo:=true;
write_def_stabstr(list,def);
tobjectdef(def).writing_class_record_stab:=false;
tobjectdef(def).writing_class_record_dbginfo:=false;
{ Write the invisible pointer class }
oldtypesym:=def.typesym;
def.typesym:=nil;
@ -900,7 +878,7 @@ implementation
write_def_stabstr(list,def);
end;
def.stab_state := stab_state_written;
def.dbg_state := dbg_state_written;
end;
@ -913,7 +891,7 @@ implementation
p:=tdef(st.defindex.first);
while assigned(p) do
begin
if (p.stab_state=stab_state_used) then
if (p.dbg_state=dbg_state_used) then
insertdef(list,p);
p:=tdef(p.indexnext);
end;
@ -1337,41 +1315,6 @@ implementation
****************************************************************************}
procedure tdebuginfostabs.inserttypeinfo;
procedure reset_unit_type_info;
var
hp : tmodule;
begin
hp:=tmodule(loaded_units.first);
while assigned(hp) do
begin
hp.is_stab_written:=false;
hp:=tmodule(hp.next);
end;
end;
procedure write_used_unit_type_info(list:taasmoutput;hp:tmodule);
var
pu : tused_unit;
begin
pu:=tused_unit(hp.used_units.first);
while assigned(pu) do
begin
if not pu.u.is_stab_written then
begin
{ prevent infinte loop for circular dependencies }
pu.u.is_stab_written:=true;
{ write type info from used units, use a depth first
strategy to reduce the recursion in writing all
dependent stabs }
write_used_unit_type_info(list,pu.u);
if assigned(pu.u.globalsymtable) then
write_symtable_defs(list,pu.u.globalsymtable);
end;
pu:=tused_unit(pu.next);
end;
end;
var
stabsvarlist,
stabstypelist : taasmoutput;
@ -1425,7 +1368,7 @@ implementation
if assigned(defnumberlist[i]) then
begin
tdef(defnumberlist[i]).stab_number:=0;
tdef(defnumberlist[i]).stab_state:=stab_state_unused;
tdef(defnumberlist[i]).dbg_state:=dbg_state_unused;
end;
end;
@ -1526,7 +1469,7 @@ implementation
templist.concat(Tai_stab.Create_str(stab_stabs,'"'+FixFileName(infile.name^)+'",'+tostr(n_sourcefile)+
',0,0,'+hlabel.name));
templist.concat(tai_label.create(hlabel));
asmlist[al_stabsstart].insertlist(templist);
asmlist[al_start].insertlist(templist);
templist.free;
{ emit empty n_sourcefile for end of module }
objectlibrary.getlabel(hlabel,alt_dbgfile);
@ -1534,7 +1477,7 @@ implementation
new_section(templist,sec_code,'',0);
templist.concat(Tai_stab.Create_str(stab_stabs,'"",'+tostr(n_sourcefile)+',0,0,'+hlabel.name));
templist.concat(tai_label.create(hlabel));
asmlist[al_stabsend].insertlist(templist);
asmlist[al_end].insertlist(templist);
templist.free;
end;

6
compiler/fmodule.pas
View File

@ -99,7 +99,7 @@ interface
do_compile, { need to compile the sources }
sources_avail, { if all sources are reachable }
interface_compiled, { if the interface section has been parsed/compiled/loaded }
is_stab_written,
is_dbginfo_written,
is_reset,
is_unit,
in_interface, { processing the implementation part? }
@ -447,7 +447,7 @@ implementation
in_global:=true;
is_unit:=_is_unit;
islibrary:=false;
is_stab_written:=false;
is_dbginfo_written:=false;
is_reset:=false;
mode_switch_allowed:= true;
uses_imports:=false;
@ -653,7 +653,7 @@ implementation
in_interface:=true;
in_global:=true;
mode_switch_allowed:=true;
is_stab_written:=false;
is_dbginfo_written:=false;
is_reset:=false;
crc:=0;
interface_crc:=0;

4
compiler/i386/ag386nsm.pas
View File

@ -354,7 +354,7 @@ interface
procedure T386NasmAssembler.WriteSection(atype:tasmsectiontype;const aname:string);
const
secnames : array[tasmsectiontype] of string[12] = ('',
secnames : array[tasmsectiontype] of string[13] = ('',
'.text','.data','.rodata','.bss','.tbss',
'common',
'.note',
@ -362,7 +362,7 @@ interface
'.stab','.stabstr',
'.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
'.eh_frame',
'.debug_frame','.debug_info','.debug_line','.debug_abrev',
'.debug_frame','.debug_info','.debug_line','.debug_abbrev',
'.fpc',
''
);

2
compiler/ogcoff.pas
View File

@ -560,7 +560,7 @@ const go32v2stub : array[0..2047] of byte=(
'.stab','.stabstr',
'.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
'.eh_frame',
'.debug_frame','.debug_info','.debug_line','.debug_abrev',
'.debug_frame','.debug_info','.debug_line','.debug_abbrev',
'.fpc',
''
);

4
compiler/ogelf.pas
View File

@ -343,7 +343,7 @@ implementation
function telf32objectdata.sectionname(atype:tasmsectiontype;const aname:string):string;
const
secnames : array[tasmsectiontype] of string[12] = ('',
secnames : array[tasmsectiontype] of string[13] = ('',
{$ifdef userodata}
'.text','.data','.rodata','.bss','.threadvar',
{$else userodata}
@ -355,7 +355,7 @@ implementation
'.stab','.stabstr',
'.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
'.eh_frame',
'.debug_frame','.debug_info','.debug_line','.debug_abrev',
'.debug_frame','.debug_info','.debug_line','.debug_abbrev',
'fpc',
''
);

10
compiler/symconst.pas
View File

@ -389,11 +389,11 @@ type
te_exact
);
tdefstabstatus = (
stab_state_unused,
stab_state_used,
stab_state_writing,
stab_state_written
tdefdbgstatus = (
dbg_state_unused,
dbg_state_used,
dbg_state_writing,
dbg_state_written
);

6
compiler/symdef.pas
View File

@ -241,7 +241,7 @@ interface
{ to be able to have a variable vmt position }
{ and no vmt field for objects without virtuals }
vmt_offset : longint;
writing_class_record_stab : boolean;
writing_class_record_dbginfo : boolean;
objecttype : tobjectdeftype;
iidguid: pguid;
iidstr: pstring;
@ -4251,7 +4251,7 @@ implementation
implementedinterfaces:=timplementedinterfaces.create
else
implementedinterfaces:=nil;
writing_class_record_stab:=false;
writing_class_record_dbginfo:=false;
end;
@ -4312,7 +4312,7 @@ implementation
(objecttype=odt_interfacecom) and
(objname^='IUNKNOWN') then
interface_iunknown:=self;
writing_class_record_stab:=false;
writing_class_record_dbginfo:=false;
end;
destructor tobjectdef.destroy;

7
compiler/symtype.pas
View File

@ -69,9 +69,12 @@ interface
tdef = class(tdefentry)
typesym : tsym; { which type the definition was generated this def }
{ maybe it's useful to merge the dwarf and stabs debugging info with some hacking }
{ dwarf debugging }
dwarf_lab : tasmlabel;
{ stabs debugging }
stab_number : word;
stab_state : tdefstabstatus;
dbg_state : tdefdbgstatus;
defoptions : tdefoptions;
constructor create;
procedure buildderef;virtual;abstract;
@ -244,7 +247,7 @@ implementation
owner := nil;
typesym := nil;
defoptions:=[];
stab_state:=stab_state_unused;
dbg_state:=dbg_state_unused;
stab_number:=0;
end;