mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 22:29:23 +01:00
36668a6ec5
(and hence those directories were interpreted as source files themselves)
+ added -gostabsabsincludes option to make the compiler store absolute
paths to include files in Stabs debugging information (since no
search paths are used). This is not the default because it breaks
when only the base path of an entire source tree changes (relative
paths, which are the previous behaviour and the current default,
work fine, but the absolute paths don't anymore; this can happen
with shared network drives, and possibly with distros shipping
external .dbg files)
git-svn-id: trunk@12933 -
1622 lines
61 KiB
ObjectPascal
1622 lines
61 KiB
ObjectPascal
{
|
|
Copyright (c) 2003-2004 by Peter Vreman and Florian Klaempfl
|
|
|
|
This units contains support for STABS 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
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
|
****************************************************************************
|
|
}
|
|
unit dbgstabs;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
cclasses,
|
|
dbgbase,
|
|
symtype,symdef,symsym,symtable,symbase,
|
|
aasmtai,aasmdata;
|
|
|
|
const
|
|
{ stab types }
|
|
N_GSYM = $20;
|
|
N_STSYM = 38; { initialized const }
|
|
N_LCSYM = 40; { non initialized variable}
|
|
N_Function = $24; { function or const }
|
|
N_TextLine = $44;
|
|
N_DataLine = $46;
|
|
N_BssLine = $48;
|
|
N_RSYM = $40; { register variable }
|
|
N_LSYM = $80;
|
|
N_tsym = 160;
|
|
N_SourceFile = $64;
|
|
{ APPLE LOCAL N_OSO: This is the stab that associated the .o file with the
|
|
N_SO stab, in the case where debug info is mostly stored in the .o file. }
|
|
N_OSO = $66;
|
|
N_IncludeFile = $84;
|
|
N_BINCL = $82;
|
|
N_EINCL = $A2;
|
|
N_LBRAC = $C0;
|
|
N_EXCL = $C2;
|
|
N_RBRAC = $E0;
|
|
|
|
type
|
|
TDebugInfoStabs=class(TDebugInfo)
|
|
private
|
|
writing_def_stabs : boolean;
|
|
global_stab_number : word;
|
|
defnumberlist : TFPObjectList;
|
|
{ tsym writing }
|
|
function sym_var_value(const s:string;arg:pointer):string;
|
|
function sym_stabstr_evaluate(sym:tsym;const s:string;const vars:array of string):ansistring;
|
|
procedure write_sym_stabstr(list:TAsmList;sym:tsym;const ss:ansistring);
|
|
procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override;
|
|
procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override;
|
|
procedure appendsym_localvar(list:TAsmList;sym:tlocalvarsym);override;
|
|
procedure appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);override;
|
|
procedure appendsym_const(list:TAsmList;sym:tconstsym);override;
|
|
procedure appendsym_type(list:TAsmList;sym:ttypesym);override;
|
|
procedure appendsym_label(list:TAsmList;sym:tlabelsym);override;
|
|
{ tdef writing }
|
|
function def_stab_number(def:tdef):string;
|
|
function def_stab_classnumber(def:tobjectdef):string;
|
|
function def_var_value(const s:string;arg:pointer):string;
|
|
function def_stabstr_evaluate(def:tdef;const s:string;const vars:array of string):ansistring;
|
|
procedure write_def_stabstr(list:TAsmList;def:tdef;const ss:ansistring);
|
|
procedure field_add_stabstr(p:TObject;arg:pointer);
|
|
procedure method_add_stabstr(p:TObject;arg:pointer);
|
|
procedure field_write_defs(p:TObject;arg:pointer);
|
|
procedure beforeappenddef(list:TAsmList;def:tdef);override;
|
|
procedure appenddef_ord(list:TAsmList;def:torddef);override;
|
|
procedure appenddef_float(list:TAsmList;def:tfloatdef);override;
|
|
procedure appenddef_file(list:TAsmList;def:tfiledef);override;
|
|
procedure appenddef_enum(list:TAsmList;def:tenumdef);override;
|
|
procedure appenddef_array(list:TAsmList;def:tarraydef);override;
|
|
procedure appenddef_record(list:TAsmList;def:trecorddef);override;
|
|
procedure appenddef_object(list:TAsmList;def:tobjectdef);override;
|
|
procedure appenddef_pointer(list:TAsmList;def:tpointerdef);override;
|
|
procedure appenddef_string(list:TAsmList;def:tstringdef);override;
|
|
procedure appenddef_procvar(list:TAsmList;def:tprocvardef);override;
|
|
procedure appenddef_variant(list:TAsmList;def:tvariantdef);override;
|
|
procedure appenddef_set(list:TAsmList;def:tsetdef);override;
|
|
procedure appenddef_formal(list:TAsmList;def:tformaldef);override;
|
|
procedure appenddef_undefined(list:TAsmList;def: tundefineddef);override;
|
|
procedure appendprocdef(list:TAsmList;def:tprocdef);override;
|
|
public
|
|
procedure inserttypeinfo;override;
|
|
procedure insertmoduleinfo;override;
|
|
procedure insertlineinfo(list:TAsmList);override;
|
|
procedure referencesections(list:TAsmList);override;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils,cutils,cfileutl,
|
|
systems,globals,globtype,verbose,constexp,
|
|
symconst,defutil,
|
|
cpuinfo,cpubase,cgbase,paramgr,
|
|
aasmbase,procinfo,
|
|
finput,fmodule,ppu;
|
|
|
|
function GetSymName(Sym : TSymEntry) : string;
|
|
begin
|
|
if Not (cs_stabs_preservecase in current_settings.globalswitches) then
|
|
result := Sym.Name
|
|
else
|
|
result := Sym.RealName;
|
|
end;
|
|
|
|
function GetSymTableName(SymTable : TSymTable) : string;
|
|
begin
|
|
if Not (cs_stabs_preservecase in current_settings.globalswitches) then
|
|
result := SymTable.Name^
|
|
else
|
|
result := SymTable.RealName^;
|
|
end;
|
|
|
|
const
|
|
memsizeinc = 512;
|
|
|
|
tagtypes = [
|
|
recorddef,
|
|
enumdef,
|
|
stringdef,
|
|
filedef,
|
|
objectdef
|
|
];
|
|
|
|
type
|
|
get_var_value_proc=function(const s:string;arg:pointer):string of object;
|
|
|
|
|
|
function string_evaluate(s:string;get_var_value:get_var_value_proc;get_var_value_arg:pointer;const vars:array of string):ansistring;
|
|
(*
|
|
S contains a prototype of a result. Stabstr_evaluate will expand
|
|
variables and parameters.
|
|
|
|
Output is s in ASCIIZ format, with the following expanded:
|
|
|
|
${varname} - The variable name is expanded.
|
|
$n - The parameter n is expanded.
|
|
$$ - Is expanded to $
|
|
*)
|
|
|
|
const maxvalue=9;
|
|
maxdata=1023;
|
|
|
|
var i,j:byte;
|
|
varname:string[63];
|
|
varno,varcounter:byte;
|
|
varvalues:array[0..9] of pshortstring;
|
|
{1 kb of parameters is the limit. 256 extra bytes are allocated to
|
|
ensure buffer integrity.}
|
|
varvaluedata:array[0..maxdata+256] of char;
|
|
varptr:Pchar;
|
|
varidx : byte;
|
|
len:longint;
|
|
r:Pchar;
|
|
|
|
begin
|
|
{Two pass approach, first, calculate the length and receive variables.}
|
|
i:=1;
|
|
len:=0;
|
|
varcounter:=0;
|
|
varptr:=@varvaluedata[0];
|
|
while i<=length(s) do
|
|
begin
|
|
if (s[i]='$') and (i<length(s)) then
|
|
begin
|
|
if s[i+1]='$' then
|
|
begin
|
|
inc(len);
|
|
inc(i);
|
|
end
|
|
else if (s[i+1]='{') and (length(s)>2) and (i<length(s)-2) then
|
|
begin
|
|
varname:='';
|
|
inc(i,2);
|
|
repeat
|
|
inc(varname[0]);
|
|
varname[length(varname)]:=s[i];
|
|
s[i]:=char(varcounter);
|
|
inc(i);
|
|
until s[i]='}';
|
|
varvalues[varcounter]:=pshortstring(varptr);
|
|
if varptr>@varvaluedata[maxdata] then
|
|
internalerrorproc(200411152);
|
|
pshortstring(varptr)^:=get_var_value(varname,get_var_value_arg);
|
|
inc(len,length(pshortstring(varptr)^));
|
|
inc(varptr,length(pshortstring(varptr)^)+1);
|
|
inc(varcounter);
|
|
end
|
|
else if s[i+1] in ['1'..'9'] then
|
|
begin
|
|
varidx:=byte(s[i+1])-byte('1');
|
|
if varidx>high(vars) then
|
|
internalerror(200509263);
|
|
inc(len,length(vars[varidx]));
|
|
inc(i);
|
|
end;
|
|
end
|
|
else
|
|
inc(len);
|
|
inc(i);
|
|
end;
|
|
|
|
{Second pass, writeout result.}
|
|
setlength(result,len);
|
|
r:=pchar(result);
|
|
i:=1;
|
|
while i<=length(s) do
|
|
begin
|
|
if (s[i]='$') and (i<length(s)) then
|
|
begin
|
|
if s[i+1]='$' then
|
|
begin
|
|
r^:='$';
|
|
inc(r);
|
|
inc(i);
|
|
end
|
|
else if (s[i+1]='{') and (length(s)>2) and (i<length(s)-2) then
|
|
begin
|
|
varname:='';
|
|
inc(i,2);
|
|
varno:=byte(s[i]);
|
|
repeat
|
|
inc(i);
|
|
until s[i]='}';
|
|
for j:=1 to length(varvalues[varno]^) do
|
|
begin
|
|
r^:=varvalues[varno]^[j];
|
|
inc(r);
|
|
end;
|
|
end
|
|
else if s[i+1] in ['0'..'9'] then
|
|
begin
|
|
for j:=1 to length(vars[byte(s[i+1])-byte('1')]) do
|
|
begin
|
|
r^:=vars[byte(s[i+1])-byte('1')][j];
|
|
inc(r);
|
|
end;
|
|
inc(i);
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
r^:=s[i];
|
|
inc(r);
|
|
end;
|
|
inc(i);
|
|
end;
|
|
{ verify that the length was correct }
|
|
if r^<>#0 then
|
|
internalerror(200802031);
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TDef support
|
|
****************************************************************************}
|
|
|
|
function TDebugInfoStabs.def_stab_number(def:tdef):string;
|
|
begin
|
|
{ procdefs only need a number, mark them as already written
|
|
so they won't be written implicitly }
|
|
if (def.typ=procdef) then
|
|
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.dbg_state in [dbg_state_writing,dbg_state_written,dbg_state_queued]) 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.dbg_state=dbg_state_unused then
|
|
def.dbg_state:=dbg_state_used;
|
|
{ Need a new number? }
|
|
if def.stab_number=0 then
|
|
begin
|
|
inc(global_stab_number);
|
|
{ classes require 2 numbers }
|
|
if is_class(def) then
|
|
inc(global_stab_number);
|
|
def.stab_number:=global_stab_number;
|
|
if global_stab_number>=defnumberlist.count then
|
|
defnumberlist.count:=global_stab_number+250;
|
|
defnumberlist[global_stab_number]:=def;
|
|
end;
|
|
result:=tostr(def.stab_number);
|
|
end;
|
|
|
|
|
|
function TDebugInfoStabs.def_stab_classnumber(def:tobjectdef):string;
|
|
begin
|
|
if def.stab_number=0 then
|
|
def_stab_number(def);
|
|
if (def.objecttype=odt_class) then
|
|
result:=tostr(def.stab_number-1)
|
|
else
|
|
result:=tostr(def.stab_number);
|
|
end;
|
|
|
|
|
|
function TDebugInfoStabs.def_var_value(const s:string;arg:pointer):string;
|
|
var
|
|
def : tdef;
|
|
begin
|
|
def:=tdef(arg);
|
|
result:='';
|
|
if s='numberstring' then
|
|
result:=def_stab_number(def)
|
|
else if s='sym_name' then
|
|
begin
|
|
if assigned(def.typesym) then
|
|
result:=GetSymName(Ttypesym(def.typesym));
|
|
end
|
|
else if s='N_LSYM' then
|
|
result:=tostr(N_LSYM)
|
|
else if s='savesize' then
|
|
result:=tostr(def.size);
|
|
end;
|
|
|
|
|
|
function TDebugInfoStabs.def_stabstr_evaluate(def:tdef;const s:string;const vars:array of string):ansistring;
|
|
begin
|
|
result:=string_evaluate(s,@def_var_value,def,vars);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.field_add_stabstr(p:TObject;arg:pointer);
|
|
var
|
|
spec : string[3];
|
|
varsize : aint;
|
|
newss : ansistring;
|
|
ss : pansistring absolute arg;
|
|
begin
|
|
if (tsym(p).visibility=vis_hidden) then
|
|
exit;
|
|
{ static variables from objects are like global objects }
|
|
if (Tsym(p).typ=fieldvarsym) and
|
|
not(sp_static in Tsym(p).symoptions) then
|
|
begin
|
|
case tsym(p).visibility of
|
|
vis_private,
|
|
vis_strictprivate :
|
|
spec:='/0';
|
|
vis_protected,
|
|
vis_strictprotected :
|
|
spec:='/1';
|
|
else
|
|
spec:='';
|
|
end;
|
|
if (tabstractrecordsymtable(tsym(p).owner).usefieldalignment<>bit_alignment) then
|
|
begin
|
|
varsize:=tfieldvarsym(p).vardef.size;
|
|
{ open arrays made overflows !! }
|
|
{ how can a record/object/class contain an open array? (JM) }
|
|
if varsize>$fffffff then
|
|
varsize:=$fffffff;
|
|
newss:=def_stabstr_evaluate(nil,'$1:$2,$3,$4;',[GetSymName(tfieldvarsym(p)),
|
|
spec+def_stab_number(tfieldvarsym(p).vardef),
|
|
tostr(TConstExprInt(tfieldvarsym(p).fieldoffset)*8),tostr(varsize*8)])
|
|
end
|
|
else
|
|
newss:=def_stabstr_evaluate(nil,'$1:$2,$3,$4;',[GetSymName(tfieldvarsym(p)),
|
|
spec+def_stab_number(tfieldvarsym(p).vardef),
|
|
tostr(TConstExprInt(tfieldvarsym(p).fieldoffset)),tostr(tfieldvarsym(p).vardef.packedbitsize)]);
|
|
ss^:=ss^+newss;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.method_add_stabstr(p:TObject;arg:pointer);
|
|
var
|
|
virtualind,argnames : string;
|
|
pd : tprocdef;
|
|
lindex : longint;
|
|
arglength : byte;
|
|
sp : char;
|
|
i : integer;
|
|
parasym : tparavarsym;
|
|
newss : ansistring;
|
|
ss : pansistring absolute arg;
|
|
begin
|
|
if tsym(p).typ = procsym then
|
|
begin
|
|
pd :=tprocdef(tprocsym(p).ProcdefList[0]);
|
|
if (po_virtualmethod in pd.procoptions) then
|
|
begin
|
|
lindex := pd.extnumber;
|
|
{doesnt seem to be necessary
|
|
lindex := lindex or $80000000;}
|
|
virtualind := '*'+tostr(lindex)+';'+def_stab_classnumber(pd._class)+';'
|
|
end
|
|
else
|
|
virtualind := '.';
|
|
|
|
{ used by gdbpas to recognize constructor and destructors }
|
|
if (pd.proctypeoption=potype_constructor) then
|
|
argnames:='__ct__'
|
|
else if (pd.proctypeoption=potype_destructor) then
|
|
argnames:='__dt__'
|
|
else
|
|
argnames := '';
|
|
|
|
{ arguments are not listed here }
|
|
{we don't need another definition}
|
|
for i:=0 to pd.paras.count-1 do
|
|
begin
|
|
parasym:=tparavarsym(pd.paras[i]);
|
|
if Parasym.vardef.typ = formaldef then
|
|
begin
|
|
case Parasym.varspez of
|
|
vs_var :
|
|
argnames := argnames+'3var';
|
|
vs_const :
|
|
argnames:=argnames+'5const';
|
|
vs_out :
|
|
argnames:=argnames+'3out';
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ if the arg definition is like (v: ^byte;..
|
|
there is no sym attached to data !!! }
|
|
if assigned(Parasym.vardef.typesym) then
|
|
begin
|
|
arglength := length(GetSymName(Parasym.vardef.typesym));
|
|
argnames := argnames + tostr(arglength)+GetSymName(Parasym.vardef.typesym);
|
|
end
|
|
else
|
|
argnames:=argnames+'11unnamedtype';
|
|
end;
|
|
end;
|
|
{ here 2A must be changed for private and protected }
|
|
{ 0 is private 1 protected and 2 public }
|
|
case tsym(p).visibility of
|
|
vis_private,
|
|
vis_strictprivate :
|
|
sp:='0';
|
|
vis_protected,
|
|
vis_strictprotected :
|
|
sp:='1'
|
|
else
|
|
sp:='2';
|
|
end;
|
|
newss:=def_stabstr_evaluate(nil,'$1::$2=##$3;:$4;$5A$6;',[GetSymName(tsym(p)),def_stab_number(pd),
|
|
def_stab_number(pd.returndef),argnames,sp,
|
|
virtualind]);
|
|
ss^:=ss^+newss;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.field_write_defs(p:TObject;arg:pointer);
|
|
begin
|
|
if (Tsym(p).typ=fieldvarsym) and
|
|
not(sp_static in Tsym(p).symoptions) then
|
|
appenddef(TAsmList(arg),tfieldvarsym(p).vardef);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.write_def_stabstr(list:TAsmList;def:tdef;const ss:ansistring);
|
|
var
|
|
stabchar : string[2];
|
|
symname : string[20];
|
|
st : ansistring;
|
|
p : pchar;
|
|
begin
|
|
{ type prefix }
|
|
if def.typ in tagtypes then
|
|
stabchar := 'Tt'
|
|
else
|
|
stabchar := 't';
|
|
{ in case of writing the class record structure, we always have to
|
|
use the class name (so it refers both to the struct and the
|
|
pointer to the struct), otherwise gdb crashes (see tests/webtbs/tw9766.pp) }
|
|
if is_class(def) and
|
|
tobjectdef(def).writing_class_record_dbginfo then
|
|
st:=def_stabstr_evaluate(def,'"${sym_name}:$1$2=',[stabchar,def_stab_classnumber(tobjectdef(def))])
|
|
else
|
|
begin
|
|
{ Type names for types defined in the current unit are already written in
|
|
the typesym }
|
|
if (def.owner.symtabletype=globalsymtable) and
|
|
not(def.owner.iscurrentunit) then
|
|
symname:='${sym_name}'
|
|
else
|
|
symname:='';
|
|
st:=def_stabstr_evaluate(def,'"'+symname+':$1$2=',[stabchar,def_stab_number(def)]);
|
|
end;
|
|
st:=st+ss;
|
|
{ line info is set to 0 for all defs, because the def can be in an other
|
|
unit and then the linenumber is invalid in the current sourcefile }
|
|
st:=st+def_stabstr_evaluate(def,'",${N_LSYM},0,0,0',[]);
|
|
{ add to list }
|
|
getmem(p,length(st)+1);
|
|
move(pchar(st)^,p^,length(st)+1);
|
|
list.concat(Tai_stab.create(stab_stabs,p));
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appenddef_string(list:TAsmList;def:tstringdef);
|
|
var
|
|
bytest,charst,longst : string;
|
|
ss : ansistring;
|
|
slen : longint;
|
|
begin
|
|
ss:='';
|
|
case def.stringtype of
|
|
st_shortstring:
|
|
begin
|
|
{ fix length of openshortstring }
|
|
slen:=def.len;
|
|
if slen=0 then
|
|
slen:=255;
|
|
charst:=def_stab_number(cchartype);
|
|
bytest:=def_stab_number(u8inttype);
|
|
ss:=def_stabstr_evaluate(def,'s$1length:$2,0,8;st:ar$2;1;$3;$4,8,$5;;',
|
|
[tostr(slen+1),bytest,tostr(slen),charst,tostr(slen*8)]);
|
|
end;
|
|
st_longstring:
|
|
begin
|
|
charst:=def_stab_number(cchartype);
|
|
bytest:=def_stab_number(u8inttype);
|
|
longst:=def_stab_number(u32inttype);
|
|
ss:=def_stabstr_evaluate(def,'s$1length:$2,0,32;dummy:$6,32,8;st:ar$2;1;$3;$4,40,$5;;',
|
|
[tostr(def.len+5),longst,tostr(def.len),charst,tostr(def.len*8),bytest]);
|
|
end;
|
|
st_ansistring:
|
|
begin
|
|
{ looks like a pchar }
|
|
ss:='*'+def_stab_number(cchartype);
|
|
end;
|
|
st_unicodestring,
|
|
st_widestring:
|
|
begin
|
|
{ looks like a pwidechar }
|
|
ss:='*'+def_stab_number(cwidechartype);
|
|
end;
|
|
end;
|
|
write_def_stabstr(list,def,ss);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appenddef_enum(list:TAsmList;def:tenumdef);
|
|
var
|
|
st : ansistring;
|
|
p : Tenumsym;
|
|
begin
|
|
{ we can specify the size with @s<size>; prefix PM }
|
|
if def.size <> std_param_align then
|
|
st:='@s'+tostr(def.size*8)+';e'
|
|
else
|
|
st:='e';
|
|
p := tenumsym(def.firstenum);
|
|
while assigned(p) do
|
|
begin
|
|
st:=st+GetSymName(p)+':'+tostr(p.value)+',';
|
|
p:=p.nextenum;
|
|
end;
|
|
{ the final ',' is required to have a valid stabs }
|
|
st:=st+';';
|
|
write_def_stabstr(list,def,st);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appenddef_ord(list:TAsmList;def:torddef);
|
|
var
|
|
ss : ansistring;
|
|
begin
|
|
ss:='';
|
|
if cs_gdb_valgrind in current_settings.globalswitches then
|
|
begin
|
|
case def.ordtype of
|
|
uvoid :
|
|
ss:=def_stab_number(def);
|
|
pasbool,
|
|
bool8bit,
|
|
bool16bit,
|
|
bool32bit,
|
|
bool64bit :
|
|
ss:=def_stabstr_evaluate(def,'r${numberstring};0;255;',[]);
|
|
u32bit,
|
|
s64bit,
|
|
u64bit :
|
|
ss:=def_stabstr_evaluate(def,'r${numberstring};0;-1;',[]);
|
|
else
|
|
ss:=def_stabstr_evaluate(def,'r${numberstring};$1;$2;',[tostr(longint(def.low.svalue)),tostr(longint(def.high.svalue))]);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
case def.ordtype of
|
|
uvoid :
|
|
ss:=def_stab_number(def);
|
|
uchar :
|
|
ss:='-20;';
|
|
uwidechar :
|
|
ss:='-30;';
|
|
pasbool,
|
|
bool8bit :
|
|
ss:='-21;';
|
|
bool16bit :
|
|
ss:='-22;';
|
|
bool32bit :
|
|
ss:='-23;';
|
|
bool64bit :
|
|
{ no clue if this is correct (FK) }
|
|
ss:='-23;';
|
|
u64bit :
|
|
ss:='-32;';
|
|
s64bit :
|
|
ss:='-31;';
|
|
{u32bit : result:=def_stab_number(s32inttype)+';0;-1;'); }
|
|
else
|
|
ss:=def_stabstr_evaluate(def,'r${numberstring};$1;$2;',[tostr(longint(def.low.svalue)),tostr(longint(def.high.svalue))]);
|
|
end;
|
|
end;
|
|
write_def_stabstr(list,def,ss);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appenddef_float(list:TAsmList;def:tfloatdef);
|
|
var
|
|
ss : ansistring;
|
|
begin
|
|
ss:='';
|
|
case def.floattype of
|
|
s32real,
|
|
s64real,
|
|
s80real:
|
|
ss:=def_stabstr_evaluate(def,'r$1;${savesize};0;',[def_stab_number(s32inttype)]);
|
|
s64currency,
|
|
s64comp:
|
|
ss:=def_stabstr_evaluate(def,'r$1;-${savesize};0;',[def_stab_number(s32inttype)]);
|
|
else
|
|
internalerror(200509261);
|
|
end;
|
|
write_def_stabstr(list,def,ss);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appenddef_file(list:TAsmList;def:tfiledef);
|
|
var
|
|
ss : ansistring;
|
|
begin
|
|
{$ifdef cpu64bitaddr}
|
|
ss:=def_stabstr_evaluate(def,'s${savesize}HANDLE:$1,0,32;MODE:$1,32,32;RECSIZE:$2,64,64;'+
|
|
'_PRIVATE:ar$1;1;64;$3,128,256;USERDATA:ar$1;1;16;$3,384,128;'+
|
|
'NAME:ar$1;0;255;$4,512,2048;;',[def_stab_number(s32inttype),
|
|
def_stab_number(s64inttype),
|
|
def_stab_number(u8inttype),
|
|
def_stab_number(cchartype)]);
|
|
{$else cpu64bitaddr}
|
|
ss:=def_stabstr_evaluate(def,'s${savesize}HANDLE:$1,0,32;MODE:$1,32,32;RECSIZE:$1,64,32;'+
|
|
'_PRIVATE:ar$1;1;32;$3,96,256;USERDATA:ar$1;1;16;$2,352,128;'+
|
|
'NAME:ar$1;0;255;$3,480,2048;;',[def_stab_number(s32inttype),
|
|
def_stab_number(u8inttype),
|
|
def_stab_number(cchartype)]);
|
|
{$endif cpu64bitaddr}
|
|
write_def_stabstr(list,def,ss);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appenddef_record(list:TAsmList;def:trecorddef);
|
|
var
|
|
ss : ansistring;
|
|
begin
|
|
ss:='s'+tostr(def.size);
|
|
def.symtable.SymList.ForEachCall(@field_add_stabstr,@ss);
|
|
ss[length(ss)]:=';';
|
|
write_def_stabstr(list,def,ss);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appenddef_object(list:TAsmList;def:tobjectdef);
|
|
|
|
procedure do_write_object(list:TAsmList;def:tobjectdef);
|
|
var
|
|
ss : ansistring;
|
|
anc : tobjectdef;
|
|
begin
|
|
ss:='';
|
|
{ Write the invisible pointer for the class? }
|
|
if (def.objecttype=odt_class) and
|
|
(not def.writing_class_record_dbginfo) then
|
|
begin
|
|
ss:='*'+def_stab_classnumber(def);
|
|
write_def_stabstr(list,def,ss);
|
|
exit;
|
|
end;
|
|
|
|
ss:='s'+tostr(tobjecTSymtable(def.symtable).datasize);
|
|
if assigned(def.childof) then
|
|
begin
|
|
{only one ancestor not virtual, public, at base offset 0 }
|
|
{ !1 , 0 2 0 , }
|
|
ss:=ss+'!1,020,'+def_stab_classnumber(def.childof)+';';
|
|
end;
|
|
|
|
{virtual table to implement yet}
|
|
def.symtable.symList.ForEachCall(@field_add_stabstr,@ss);
|
|
|
|
if (oo_has_vmt in def.objectoptions) and
|
|
(
|
|
not assigned(def.childof) or
|
|
not(oo_has_vmt in def.childof.objectoptions)
|
|
) then
|
|
ss:=ss+'$vf'+def_stab_classnumber(def)+':'+def_stab_number(vmtarraytype)+','+tostr(def.vmt_offset*8)+';';
|
|
def.symtable.symList.ForEachCall(@method_add_stabstr,@ss);
|
|
if (oo_has_vmt in def.objectoptions) then
|
|
begin
|
|
anc := def;
|
|
while assigned(anc.childof) and (oo_has_vmt in anc.childof.objectoptions) do
|
|
anc := anc.childof;
|
|
{ just in case anc = self }
|
|
ss:=ss+';~%'+def_stab_classnumber(anc)+';';
|
|
end
|
|
else
|
|
ss:=ss+';';
|
|
write_def_stabstr(list,def,ss);
|
|
end;
|
|
|
|
var
|
|
oldtypesym : tsym;
|
|
begin
|
|
{ classes require special code to write the record and the invisible pointer }
|
|
if is_class(def) then
|
|
begin
|
|
{ Write the record class itself }
|
|
tobjectdef(def).writing_class_record_dbginfo:=true;
|
|
do_write_object(list,def);
|
|
tobjectdef(def).writing_class_record_dbginfo:=false;
|
|
{ Write the invisible pointer class }
|
|
oldtypesym:=def.typesym;
|
|
def.typesym:=nil;
|
|
do_write_object(list,def);
|
|
def.typesym:=oldtypesym;
|
|
end
|
|
else
|
|
do_write_object(list,def);
|
|
{ VMT symbol }
|
|
if (oo_has_vmt in tobjectdef(def).objectoptions) and
|
|
assigned(def.owner) and
|
|
assigned(def.owner.name) then
|
|
list.concat(Tai_stab.create(stab_stabs,strpnew('"vmt_'+GetSymTableName(def.owner)+tobjectdef(def).objname^+':S'+
|
|
def_stab_number(vmttype)+'",'+tostr(N_STSYM)+',0,0,'+tobjectdef(def).vmt_mangledname)));
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appenddef_variant(list:TAsmList;def:tvariantdef);
|
|
var
|
|
ss : ansistring;
|
|
begin
|
|
ss:=def_stabstr_evaluate(def,'${numberstring};',[]);
|
|
write_def_stabstr(list,def,ss);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appenddef_pointer(list:TAsmList;def:tpointerdef);
|
|
var
|
|
ss : ansistring;
|
|
begin
|
|
ss:='*'+def_stab_number(tpointerdef(def).pointeddef);
|
|
write_def_stabstr(list,def,ss);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appenddef_set(list:TAsmList;def:tsetdef);
|
|
var
|
|
ss : ansistring;
|
|
begin
|
|
ss:=def_stabstr_evaluate(def,'@s$1;S$2',[tostr(def.size*8),def_stab_number(tsetdef(def).elementdef)]);
|
|
write_def_stabstr(list,def,ss);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appenddef_formal(list:TAsmList;def:tformaldef);
|
|
var
|
|
ss : ansistring;
|
|
begin
|
|
ss:=def_stabstr_evaluate(def,'${numberstring};',[]);
|
|
write_def_stabstr(list,def,ss);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appenddef_array(list:TAsmList;def:tarraydef);
|
|
var
|
|
tempstr: shortstring;
|
|
ss : ansistring;
|
|
begin
|
|
if not is_packed_array(def) then
|
|
begin
|
|
tempstr:='ar$1;$2;$3;$4';
|
|
if is_dynamic_array(def) then
|
|
tempstr:='*'+tempstr;
|
|
ss:=def_stabstr_evaluate(def,tempstr,[def_stab_number(tarraydef(def).rangedef),
|
|
tostr(tarraydef(def).lowrange),tostr(tarraydef(def).highrange),def_stab_number(tarraydef(def).elementdef)])
|
|
end
|
|
else
|
|
begin
|
|
// the @P seems to be ignored by gdb
|
|
tempstr:=def_stabstr_evaluate(tarraydef(def).rangedef,'r${numberstring};$1;$2;',
|
|
[tostr(tarraydef(def).lowrange),tostr(tarraydef(def).highrange)]);
|
|
// will only show highrange-lowrange+1 bits in gdb
|
|
ss:=def_stabstr_evaluate(def,'@s$1;@S;S$2',
|
|
[tostr(TConstExprInt(tarraydef(def).elepackedbitsize) * tarraydef(def).elecount),tempstr]);
|
|
end;
|
|
write_def_stabstr(list,def,ss);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appenddef_procvar(list:TAsmList;def:tprocvardef);
|
|
var
|
|
ss : ansistring;
|
|
begin
|
|
ss:='*f'+def_stab_number(tprocvardef(def).returndef);
|
|
write_def_stabstr(list,def,ss);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appenddef_undefined(list:TAsmList;def:tundefineddef);
|
|
var
|
|
ss : ansistring;
|
|
begin
|
|
ss:=def_stabstr_evaluate(def,'${numberstring};',[]);
|
|
write_def_stabstr(list,def,ss);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.beforeappenddef(list:TAsmList;def:tdef);
|
|
var
|
|
anc : tobjectdef;
|
|
i : longint;
|
|
begin
|
|
{ write dependencies first }
|
|
case def.typ of
|
|
stringdef :
|
|
begin
|
|
if tstringdef(def).stringtype in [st_widestring,st_unicodestring] then
|
|
appenddef(list,cwidechartype)
|
|
else
|
|
begin
|
|
appenddef(list,cchartype);
|
|
appenddef(list,u8inttype);
|
|
end;
|
|
end;
|
|
floatdef :
|
|
appenddef(list,s32inttype);
|
|
filedef :
|
|
begin
|
|
appenddef(list,s32inttype);
|
|
{$ifdef cpu64bitaddr}
|
|
appenddef(list,s64inttype);
|
|
{$endif cpu64bitaddr}
|
|
appenddef(list,u8inttype);
|
|
appenddef(list,cchartype);
|
|
end;
|
|
classrefdef :
|
|
appenddef(list,pvmttype);
|
|
pointerdef :
|
|
appenddef(list,tpointerdef(def).pointeddef);
|
|
setdef :
|
|
appenddef(list,tsetdef(def).elementdef);
|
|
procvardef :
|
|
begin
|
|
appenddef(list,tprocvardef(def).returndef);
|
|
if assigned(tprocvardef(def).parast) then
|
|
write_symtable_defs(list,tprocvardef(def).parast);
|
|
end;
|
|
procdef :
|
|
begin
|
|
appenddef(list,tprocdef(def).returndef);
|
|
if assigned(tprocdef(def).parast) then
|
|
write_symtable_defs(list,tprocdef(def).parast);
|
|
if assigned(tprocdef(def).localst) and
|
|
(tprocdef(def).localst.symtabletype=localsymtable) then
|
|
write_symtable_defs(list,tprocdef(def).localst);
|
|
end;
|
|
arraydef :
|
|
begin
|
|
appenddef(list,tarraydef(def).rangedef);
|
|
appenddef(list,tarraydef(def).elementdef);
|
|
end;
|
|
recorddef :
|
|
trecorddef(def).symtable.symList.ForEachCall(@field_write_defs,list);
|
|
enumdef :
|
|
if assigned(tenumdef(def).basedef) then
|
|
appenddef(list,tenumdef(def).basedef);
|
|
objectdef :
|
|
begin
|
|
{ make sure we don't write child classdefs before their parent }
|
|
{ classdefs, because this crashes gdb }
|
|
anc:=tobjectdef(def);
|
|
while assigned(anc.childof) do
|
|
begin
|
|
anc:=anc.childof;
|
|
if (anc.dbg_state=dbg_state_writing) then
|
|
{ happens in case a field of a parent is of the (forward }
|
|
{ defined) child type }
|
|
begin
|
|
{ We don't explicitly requeue it, but the fact that }
|
|
{ a child type was used in a parent before the child }
|
|
{ type was fully defined means that it was forward }
|
|
{ declared, and will still be encountered later (it }
|
|
{ cannot have been declared in another unit, because }
|
|
{ then this and that other unit would depend on }
|
|
{ eachother's interface) }
|
|
{ Setting the state to queued however allows us to }
|
|
{ get the def number already without an IE }
|
|
def.dbg_state:=dbg_state_queued;
|
|
exit;
|
|
end;
|
|
end;
|
|
appenddef(list,vmtarraytype);
|
|
if assigned(tobjectdef(def).ImplementedInterfaces) then
|
|
for i:=0 to tobjectdef(def).ImplementedInterfaces.Count-1 do
|
|
appenddef(list,TImplementedInterface(tobjectdef(def).ImplementedInterfaces[i]).IntfDef);
|
|
{ first the parents }
|
|
anc:=tobjectdef(def);
|
|
while assigned(anc.childof) do
|
|
begin
|
|
anc:=anc.childof;
|
|
appenddef(list,anc);
|
|
if assigned(anc.ImplementedInterfaces) then
|
|
for i:=0 to anc.ImplementedInterfaces.Count-1 do
|
|
appenddef(list,TImplementedInterface(anc.ImplementedInterfaces[i]).IntfDef);
|
|
end;
|
|
tobjectdef(def).symtable.symList.ForEachCall(@field_write_defs,list);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appendprocdef(list:TAsmList;def:tprocdef);
|
|
var
|
|
templist : TAsmList;
|
|
stabsendlabel : tasmlabel;
|
|
p : pchar;
|
|
RType : Char;
|
|
Obj,Info : String;
|
|
hs : string;
|
|
ss : ansistring;
|
|
begin
|
|
if not assigned(def.procstarttai) then
|
|
exit;
|
|
|
|
{ mark as used so the local type defs also be written }
|
|
def.dbg_state:=dbg_state_used;
|
|
|
|
templist:=TAsmList.create;
|
|
|
|
{ end of procedure }
|
|
current_asmdata.getlabel(stabsendlabel,alt_dbgtype);
|
|
|
|
if assigned(def.funcretsym) and
|
|
(tabstractnormalvarsym(def.funcretsym).refs>0) then
|
|
begin
|
|
if tabstractnormalvarsym(def.funcretsym).localloc.loc=LOC_REFERENCE then
|
|
begin
|
|
{ TODO: Need to add gdb support for ret in param register calling}
|
|
if paramanager.ret_in_param(def.returndef,def.proccalloption) then
|
|
hs:='X*'
|
|
else
|
|
hs:='X';
|
|
templist.concat(Tai_stab.create(stab_stabs,strpnew(
|
|
'"'+GetSymName(def.procsym)+':'+hs+def_stab_number(def.returndef)+'",'+
|
|
tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(def.funcretsym).localloc.reference.offset))));
|
|
if (m_result in current_settings.modeswitches) then
|
|
templist.concat(Tai_stab.create(stab_stabs,strpnew(
|
|
'"RESULT:'+hs+def_stab_number(def.returndef)+'",'+
|
|
tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(def.funcretsym).localloc.reference.offset))));
|
|
end;
|
|
end;
|
|
// LBRAC
|
|
ss:=tostr(N_LBRAC)+',0,0,';
|
|
if target_info.cpu=cpu_powerpc64 then
|
|
ss:=ss+'.';
|
|
ss:=ss+def.mangledname;
|
|
if (tf_use_function_relative_addresses in target_info.flags) then
|
|
begin
|
|
ss:=ss+'-';
|
|
if target_info.cpu=cpu_powerpc64 then
|
|
ss:=ss+'.';
|
|
ss:=ss+def.mangledname;
|
|
end;
|
|
getmem(p,length(ss)+1);
|
|
move(pchar(ss)^,p^,length(ss)+1);
|
|
templist.concat(Tai_stab.Create(stab_stabn,p));
|
|
// RBRAC
|
|
ss:=tostr(N_RBRAC)+',0,0,'+stabsendlabel.name;
|
|
if (tf_use_function_relative_addresses in target_info.flags) then
|
|
begin
|
|
ss:=ss+'-';
|
|
if target_info.cpu=cpu_powerpc64 then
|
|
ss:=ss+'.';
|
|
ss:=ss+def.mangledname;
|
|
end;
|
|
getmem(p,length(ss)+1);
|
|
move(pchar(ss)^,p^,length(ss)+1);
|
|
templist.concat(Tai_stab.Create(stab_stabn,p));
|
|
|
|
{ the stabsendlabel must come after all other stabs for this }
|
|
{ function }
|
|
templist.concat(tai_label.create(stabsendlabel));
|
|
|
|
{ Add a "size" stab as described in the last paragraph of 2.5 at }
|
|
{ http://sourceware.org/gdb/current/onlinedocs/stabs_2.html#SEC12 }
|
|
{ This works at least on Darwin (and is needed on Darwin to get }
|
|
{ correct smartlinking of stabs), but I don't know which binutils }
|
|
{ version is required on other platforms }
|
|
{ This stab must come after all other stabs for the procedure, }
|
|
{ including the LBRAC/RBRAC ones }
|
|
if (target_info.system in systems_darwin) then
|
|
templist.concat(Tai_stab.create(stab_stabs,
|
|
strpnew('"",'+tostr(N_FUNCTION)+',0,0,'+stabsendlabel.name+'-'+def.mangledname)));
|
|
|
|
current_asmdata.asmlists[al_procedures].insertlistafter(def.procendtai,templist);
|
|
|
|
{ "The stab representing a procedure is located immediately
|
|
following the code of the procedure. This stab is in turn
|
|
directly followed by a group of other stabs describing
|
|
elements of the procedure. These other stabs describe the
|
|
procedure's parameters, its block local variables, and its
|
|
block structure." (stab docs) }
|
|
{ this is however incorrect in case "include source" statements }
|
|
{ appear in the block, in that case the procedure stab must }
|
|
{ appear before this include stabs (and we generate such an }
|
|
{ stabs for all functions) (JM) }
|
|
|
|
{ FUNC stabs }
|
|
obj := GetSymName(def.procsym);
|
|
info := '';
|
|
if (po_global in def.procoptions) then
|
|
RType := 'F'
|
|
else
|
|
RType := 'f';
|
|
if assigned(def.owner) then
|
|
begin
|
|
if (def.owner.symtabletype = objecTSymtable) then
|
|
obj := GetSymTableName(def.owner)+'__'+GetSymName(def.procsym);
|
|
if not(cs_gdb_valgrind in current_settings.globalswitches) and
|
|
(def.owner.symtabletype=localsymtable) and
|
|
assigned(def.owner.defowner) and
|
|
assigned(tprocdef(def.owner.defowner).procsym) then
|
|
info := ','+GetSymName(def.procsym)+','+GetSymName(tprocdef(def.owner.defowner).procsym);
|
|
end;
|
|
ss:='"'+ansistring(obj)+':'+RType+def_stab_number(def.returndef)+info+'",'+tostr(n_function)+',0,'+tostr(def.fileinfo.line)+','+ansistring(def.mangledname);
|
|
getmem(p,length(ss)+1);
|
|
move(pchar(ss)^,p^,length(ss)+1);
|
|
templist.concat(Tai_stab.Create(stab_stabs,p));
|
|
|
|
current_asmdata.asmlists[al_procedures].insertlistbefore(def.procstarttai,templist);
|
|
|
|
{ para types }
|
|
if assigned(def.parast) then
|
|
write_symtable_syms(templist,def.parast);
|
|
{ local type defs and vars should not be written
|
|
inside the main proc stab }
|
|
if assigned(def.localst) and
|
|
(def.localst.symtabletype=localsymtable) then
|
|
write_symtable_syms(templist,def.localst);
|
|
|
|
current_asmdata.asmlists[al_procedures].insertlistbefore(def.procstarttai,templist);
|
|
|
|
templist.free;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TSym support
|
|
****************************************************************************}
|
|
|
|
function TDebugInfoStabs.sym_var_value(const s:string;arg:pointer):string;
|
|
var
|
|
sym : tsym absolute arg;
|
|
begin
|
|
result:='';
|
|
if s='name' then
|
|
result:=GetSymName(sym)
|
|
else if s='mangledname' then
|
|
result:=sym.mangledname
|
|
else if s='ownername' then
|
|
result:=GetSymTableName(sym.owner)
|
|
else if s='line' then
|
|
result:=tostr(sym.fileinfo.line)
|
|
else if s='N_LSYM' then
|
|
result:=tostr(N_LSYM)
|
|
else if s='N_LCSYM' then
|
|
result:=tostr(N_LCSYM)
|
|
else if s='N_RSYM' then
|
|
result:=tostr(N_RSYM)
|
|
else if s='N_TSYM' then
|
|
result:=tostr(N_TSYM)
|
|
else if s='N_STSYM' then
|
|
result:=tostr(N_STSYM)
|
|
else if s='N_FUNCTION' then
|
|
result:=tostr(N_FUNCTION)
|
|
else
|
|
internalerror(200401152);
|
|
end;
|
|
|
|
|
|
function TDebugInfoStabs.sym_stabstr_evaluate(sym:tsym;const s:string;const vars:array of string):ansistring;
|
|
begin
|
|
result:=string_evaluate(s,@sym_var_value,sym,vars);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.write_sym_stabstr(list:TAsmList;sym:tsym;const ss:ansistring);
|
|
var
|
|
p : pchar;
|
|
begin
|
|
if ss='' then
|
|
exit;
|
|
{ add to list }
|
|
getmem(p,length(ss)+1);
|
|
move(pchar(ss)^,p^,length(ss)+1);
|
|
list.concat(Tai_stab.create(stab_stabs,p));
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);
|
|
var
|
|
ss : ansistring;
|
|
begin
|
|
ss:='';
|
|
if (sym.owner.symtabletype=objecTSymtable) and
|
|
(sp_static in sym.symoptions) then
|
|
ss:=sym_stabstr_evaluate(sym,'"${ownername}__${name}:S$1",${N_LCSYM},0,${line},${mangledname}',
|
|
[def_stab_number(sym.vardef)]);
|
|
write_sym_stabstr(list,sym,ss);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);
|
|
var
|
|
ss : ansistring;
|
|
st : string;
|
|
threadvaroffset : string;
|
|
regidx : Tregisterindex;
|
|
nsym : string[7];
|
|
begin
|
|
{ external symbols can't be resolved at link time, so we
|
|
can't generate stabs for them }
|
|
if vo_is_external in sym.varoptions then
|
|
exit;
|
|
ss:='';
|
|
st:=def_stab_number(sym.vardef);
|
|
case sym.localloc.loc of
|
|
LOC_REGISTER,
|
|
LOC_CREGISTER,
|
|
LOC_MMREGISTER,
|
|
LOC_CMMREGISTER,
|
|
LOC_FPUREGISTER,
|
|
LOC_CFPUREGISTER :
|
|
begin
|
|
regidx:=findreg_by_number(sym.localloc.register);
|
|
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
|
|
{ this is the register order for GDB}
|
|
if regidx<>0 then
|
|
ss:=sym_stabstr_evaluate(sym,'"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
|
|
end;
|
|
else
|
|
begin
|
|
if (vo_is_thread_var in sym.varoptions) then
|
|
threadvaroffset:='+'+tostr(sizeof(pint))
|
|
else
|
|
threadvaroffset:='';
|
|
if (vo_is_typed_const in sym.varoptions) then
|
|
nsym:='N_STSYM'
|
|
else
|
|
nsym:='N_LCSYM';
|
|
{ Here we used S instead of
|
|
because with G GDB doesn't look at the address field
|
|
but searches the same name or with a leading underscore
|
|
but these names don't exist in pascal !}
|
|
st:='S'+st;
|
|
ss:=sym_stabstr_evaluate(sym,'"${name}:$1",${'+nsym+'},0,${line},${mangledname}$2',[st,threadvaroffset]);
|
|
end;
|
|
end;
|
|
write_sym_stabstr(list,sym,ss);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appendsym_localvar(list:TAsmList;sym:tlocalvarsym);
|
|
var
|
|
ss : ansistring;
|
|
st : string;
|
|
regidx : Tregisterindex;
|
|
begin
|
|
{ There is no space allocated for not referenced locals }
|
|
if (sym.owner.symtabletype=localsymtable) and (sym.refs=0) then
|
|
exit;
|
|
|
|
ss:='';
|
|
st:=def_stab_number(sym.vardef);
|
|
case sym.localloc.loc of
|
|
LOC_REGISTER,
|
|
LOC_CREGISTER,
|
|
LOC_MMREGISTER,
|
|
LOC_CMMREGISTER,
|
|
LOC_FPUREGISTER,
|
|
LOC_CFPUREGISTER :
|
|
begin
|
|
regidx:=findreg_by_number(sym.localloc.register);
|
|
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
|
|
{ this is the register order for GDB}
|
|
if regidx<>0 then
|
|
ss:=sym_stabstr_evaluate(sym,'"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
|
|
end;
|
|
LOC_REFERENCE :
|
|
{ offset to ebp => will not work if the framepointer is esp
|
|
so some optimizing will make things harder to debug }
|
|
ss:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(sym.localloc.reference.offset)])
|
|
else
|
|
internalerror(2003091814);
|
|
end;
|
|
write_sym_stabstr(list,sym,ss);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appendsym_paravar(list:TAsmList;sym:tparavarsym);
|
|
var
|
|
ss : ansistring;
|
|
st : string;
|
|
regidx : Tregisterindex;
|
|
c : char;
|
|
begin
|
|
ss:='';
|
|
{ set loc to LOC_REFERENCE to get somewhat usable debugging info for -Or }
|
|
{ while stabs aren't adapted for regvars yet }
|
|
if (vo_is_self in sym.varoptions) then
|
|
begin
|
|
case sym.localloc.loc of
|
|
LOC_REGISTER,
|
|
LOC_CREGISTER:
|
|
regidx:=findreg_by_number(sym.localloc.register);
|
|
LOC_REFERENCE: ;
|
|
else
|
|
internalerror(2003091815);
|
|
end;
|
|
if (po_classmethod in tabstractprocdef(sym.owner.defowner).procoptions) or
|
|
(po_staticmethod in tabstractprocdef(sym.owner.defowner).procoptions) then
|
|
begin
|
|
if (sym.localloc.loc=LOC_REFERENCE) then
|
|
ss:=sym_stabstr_evaluate(sym,'"pvmt:p$1",${N_TSYM},0,0,$2',
|
|
[def_stab_number(pvmttype),tostr(sym.localloc.reference.offset)])
|
|
else
|
|
begin
|
|
regidx:=findreg_by_number(sym.localloc.register);
|
|
ss:=sym_stabstr_evaluate(sym,'"pvmt:r$1",${N_RSYM},0,0,$2',
|
|
[def_stab_number(pvmttype),tostr(regstabs_table[regidx])]);
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
if not(is_class(tprocdef(sym.owner.defowner)._class)) then
|
|
c:='v'
|
|
else
|
|
c:='p';
|
|
if (sym.localloc.loc=LOC_REFERENCE) then
|
|
ss:=sym_stabstr_evaluate(sym,'"$$t:$1",${N_TSYM},0,0,$2',
|
|
[c+def_stab_number(tprocdef(sym.owner.defowner)._class),tostr(sym.localloc.reference.offset)])
|
|
else
|
|
begin
|
|
regidx:=findreg_by_number(sym.localloc.register);
|
|
ss:=sym_stabstr_evaluate(sym,'"$$t:r$1",${N_RSYM},0,0,$2',
|
|
[c+def_stab_number(tprocdef(sym.owner.defowner)._class),tostr(regstabs_table[regidx])]);
|
|
end
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
st:=def_stab_number(sym.vardef);
|
|
|
|
if paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
|
|
not(vo_has_local_copy in sym.varoptions) and
|
|
not is_open_string(sym.vardef) then
|
|
c:='v' { should be 'i' but 'i' doesn't work }
|
|
else
|
|
c:='p';
|
|
case sym.localloc.loc of
|
|
LOC_REGISTER,
|
|
LOC_CREGISTER,
|
|
LOC_MMREGISTER,
|
|
LOC_CMMREGISTER,
|
|
LOC_FPUREGISTER,
|
|
LOC_CFPUREGISTER :
|
|
begin
|
|
if c='p' then
|
|
c:='R'
|
|
else
|
|
c:='a';
|
|
st:=c+st;
|
|
regidx:=findreg_by_number(sym.localloc.register);
|
|
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
|
|
{ this is the register order for GDB}
|
|
if regidx<>0 then
|
|
ss:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_RSYM},0,${line},$2',[st,tostr(longint(regstabs_table[regidx]))]);
|
|
end;
|
|
LOC_REFERENCE :
|
|
begin
|
|
st:=c+st;
|
|
{ offset to ebp => will not work if the framepointer is esp
|
|
so some optimizing will make things harder to debug }
|
|
ss:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(sym.localloc.reference.offset)])
|
|
end;
|
|
else
|
|
internalerror(2003091814);
|
|
end;
|
|
end;
|
|
write_sym_stabstr(list,sym,ss);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appendsym_const(list:TAsmList;sym:tconstsym);
|
|
var
|
|
st : string;
|
|
ss : ansistring;
|
|
begin
|
|
ss:='';
|
|
{ Don't write info for default parameter values, the N_Func breaks
|
|
the N_Func for the function itself.
|
|
Valgrind does not support constants }
|
|
if (sym.owner.symtabletype=parasymtable) or
|
|
(cs_gdb_valgrind in current_settings.globalswitches) then
|
|
exit;
|
|
case sym.consttyp of
|
|
conststring:
|
|
begin
|
|
if sym.value.len<200 then
|
|
st:='s'''+backspace_quote(octal_quote(strpas(pchar(sym.value.valueptr)),[#0..#9,#11,#12,#14..#31,'''']),['"','\',#10,#13])+''''
|
|
else
|
|
st:='<constant string too long>';
|
|
end;
|
|
constord:
|
|
st:='i'+tostr(sym.value.valueord);
|
|
constpointer:
|
|
st:='i'+tostr(sym.value.valueordptr);
|
|
constreal:
|
|
begin
|
|
system.str(pbestreal(sym.value.valueptr)^,st);
|
|
st := 'r'+st;
|
|
end;
|
|
else
|
|
begin
|
|
{ if we don't know just put zero !! }
|
|
st:='i0';
|
|
end;
|
|
end;
|
|
ss:=sym_stabstr_evaluate(sym,'"${name}:c=$1;",${N_FUNCTION},0,${line},0',[st]);
|
|
write_sym_stabstr(list,sym,ss);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appendsym_type(list:TAsmList;sym:ttypesym);
|
|
var
|
|
ss : ansistring;
|
|
stabchar : string[2];
|
|
begin
|
|
ss:='';
|
|
if not assigned(sym.typedef) then
|
|
internalerror(200509262);
|
|
if sym.typedef.typ in tagtypes then
|
|
stabchar:='Tt'
|
|
else
|
|
stabchar:='t';
|
|
ss:=sym_stabstr_evaluate(sym,'"${name}:$1$2",${N_LSYM},0,${line},0',[stabchar,def_stab_number(sym.typedef)]);
|
|
write_sym_stabstr(list,sym,ss);
|
|
end;
|
|
|
|
|
|
procedure TDebugInfoStabs.appendsym_label(list:TAsmList;sym:tlabelsym);
|
|
var
|
|
ss : ansistring;
|
|
begin
|
|
ss:=sym_stabstr_evaluate(sym,'"${name}",${N_LSYM},0,${line},0',[]);
|
|
write_sym_stabstr(list,sym,ss);
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
Proc/Module support
|
|
****************************************************************************}
|
|
|
|
procedure tdebuginfostabs.inserttypeinfo;
|
|
var
|
|
stabsvarlist,
|
|
stabstypelist : TAsmList;
|
|
storefilepos : tfileposinfo;
|
|
i : longint;
|
|
begin
|
|
storefilepos:=current_filepos;
|
|
current_filepos:=current_module.mainfilepos;
|
|
|
|
global_stab_number:=0;
|
|
defnumberlist:=TFPObjectlist.create(false);
|
|
stabsvarlist:=TAsmList.create;
|
|
stabstypelist:=TAsmList.create;
|
|
|
|
{ include symbol that will be referenced from the main to be sure to
|
|
include this debuginfo .o file }
|
|
current_module.flags:=current_module.flags or uf_has_debuginfo;
|
|
if not(target_info.system in systems_darwin) then
|
|
begin
|
|
new_section(current_asmdata.asmlists[al_stabs],sec_data,GetSymTableName(current_module.localsymtable),0);
|
|
current_asmdata.asmlists[al_stabs].concat(tai_symbol.Createname_global(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0));
|
|
end
|
|
else
|
|
new_section(current_asmdata.asmlists[al_stabs],sec_code,GetSymTableName(current_module.localsymtable),0);
|
|
|
|
{ write all global/local variables. This will flag all required tdefs }
|
|
if assigned(current_module.globalsymtable) then
|
|
write_symtable_syms(stabsvarlist,current_module.globalsymtable);
|
|
if assigned(current_module.localsymtable) then
|
|
write_symtable_syms(stabsvarlist,current_module.localsymtable);
|
|
|
|
{ write all procedures and methods. This will flag all required tdefs }
|
|
if assigned(current_module.globalsymtable) then
|
|
write_symtable_procdefs(stabsvarlist,current_module.globalsymtable);
|
|
if assigned(current_module.localsymtable) then
|
|
write_symtable_procdefs(stabsvarlist,current_module.localsymtable);
|
|
|
|
{ reset unit type info flag }
|
|
reset_unit_type_info;
|
|
|
|
{ write used types from the used units }
|
|
write_used_unit_type_info(stabstypelist,current_module);
|
|
{ last write the types from this unit }
|
|
if assigned(current_module.globalsymtable) then
|
|
write_symtable_defs(stabstypelist,current_module.globalsymtable);
|
|
if assigned(current_module.localsymtable) then
|
|
write_symtable_defs(stabstypelist,current_module.localsymtable);
|
|
|
|
current_asmdata.asmlists[al_stabs].concatlist(stabstypelist);
|
|
current_asmdata.asmlists[al_stabs].concatlist(stabsvarlist);
|
|
|
|
{ reset stab numbers }
|
|
for i:=0 to defnumberlist.count-1 do
|
|
begin
|
|
if assigned(defnumberlist[i]) then
|
|
begin
|
|
tdef(defnumberlist[i]).stab_number:=0;
|
|
tdef(defnumberlist[i]).dbg_state:=dbg_state_unused;
|
|
end;
|
|
end;
|
|
|
|
defnumberlist.free;
|
|
defnumberlist:=nil;
|
|
|
|
stabsvarlist.free;
|
|
stabstypelist.free;
|
|
current_filepos:=storefilepos;
|
|
end;
|
|
|
|
|
|
procedure tdebuginfostabs.insertlineinfo(list:TAsmList);
|
|
var
|
|
currfileinfo,
|
|
lastfileinfo : tfileposinfo;
|
|
currfuncname : pshortstring;
|
|
currsectype : TAsmSectiontype;
|
|
hlabel : tasmlabel;
|
|
hp : tai;
|
|
infile : tinputfile;
|
|
begin
|
|
FillChar(lastfileinfo,sizeof(lastfileinfo),0);
|
|
currfuncname:=nil;
|
|
currsectype:=sec_code;
|
|
hp:=Tai(list.first);
|
|
while assigned(hp) do
|
|
begin
|
|
case hp.typ of
|
|
ait_section :
|
|
currsectype:=tai_section(hp).sectype;
|
|
ait_function_name :
|
|
currfuncname:=tai_function_name(hp).funcname;
|
|
ait_force_line :
|
|
lastfileinfo.line:=-1;
|
|
end;
|
|
|
|
if (currsectype=sec_code) and
|
|
(hp.typ=ait_instruction) then
|
|
begin
|
|
currfileinfo:=tailineinfo(hp).fileinfo;
|
|
{ file changed ? (must be before line info) }
|
|
if (currfileinfo.fileindex<>0) and
|
|
((lastfileinfo.fileindex<>currfileinfo.fileindex) or
|
|
(lastfileinfo.moduleindex<>currfileinfo.moduleindex)) then
|
|
begin
|
|
infile:=get_module(currfileinfo.moduleindex).sourcefiles.get_file(currfileinfo.fileindex);
|
|
if assigned(infile) then
|
|
begin
|
|
current_asmdata.getlabel(hlabel,alt_dbgfile);
|
|
{ emit stabs }
|
|
if not(ds_stabs_abs_include_files in current_settings.debugswitches) or
|
|
path_absolute(infile.path^) then
|
|
list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+FixFileName(infile.name^)+'",'+tostr(n_includefile)+
|
|
',0,0,'+hlabel.name),hp)
|
|
else
|
|
list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(getcurrentdir,false)+FixPath(infile.path^,false))+FixFileName(infile.name^)+'",'+tostr(n_includefile)+
|
|
',0,0,'+hlabel.name),hp);
|
|
list.insertbefore(tai_label.create(hlabel),hp);
|
|
{ force new line info }
|
|
lastfileinfo.line:=-1;
|
|
end;
|
|
end;
|
|
|
|
{ line changed ? }
|
|
if (currfileinfo.line>lastfileinfo.line) and (currfileinfo.line<>0) then
|
|
begin
|
|
if assigned(currfuncname) and
|
|
(tf_use_function_relative_addresses in target_info.flags) then
|
|
begin
|
|
current_asmdata.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;
|
|
end;
|
|
|
|
hp:=tai(hp.next);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tdebuginfostabs.insertmoduleinfo;
|
|
var
|
|
hlabel : tasmlabel;
|
|
infile : tinputfile;
|
|
begin
|
|
{ emit main source n_sourcefile for start of module }
|
|
current_asmdata.getlabel(hlabel,alt_dbgfile);
|
|
infile:=current_module.sourcefiles.get_file(1);
|
|
new_section(current_asmdata.asmlists[al_start],sec_code,make_mangledname('DEBUGSTART',current_module.localsymtable,''),0,secorder_begin);
|
|
if not(target_info.system in systems_darwin) then
|
|
current_asmdata.asmlists[al_start].concat(tai_symbol.Createname_global(make_mangledname('DEBUGSTART',current_module.localsymtable,''),AT_DATA,0));
|
|
current_asmdata.asmlists[al_start].concat(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(getcurrentdir,false))+'",'+tostr(n_sourcefile)+
|
|
',0,0,'+hlabel.name));
|
|
current_asmdata.asmlists[al_start].concat(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+FixFileName(infile.name^)+'",'+tostr(n_sourcefile)+
|
|
',0,0,'+hlabel.name));
|
|
current_asmdata.asmlists[al_start].concat(tai_label.create(hlabel));
|
|
{ for darwin, you need a "module marker" too to work around }
|
|
{ either some assembler or gdb bug (radar 4386531 according to a }
|
|
{ comment in dbxout.c of Apple's gcc) }
|
|
if (target_info.system in systems_darwin) then
|
|
current_asmdata.asmlists[al_end].concat(Tai_stab.Create_str(stab_stabs,'"",'+tostr(N_OSO)+',0,0,0'));
|
|
{ emit empty n_sourcefile for end of module }
|
|
current_asmdata.getlabel(hlabel,alt_dbgfile);
|
|
new_section(current_asmdata.asmlists[al_end],sec_code,make_mangledname('DEBUGEND',current_module.localsymtable,''),0,secorder_end);
|
|
if not(target_info.system in systems_darwin) then
|
|
current_asmdata.asmlists[al_end].concat(tai_symbol.Createname_global(make_mangledname('DEBUGEND',current_module.localsymtable,''),AT_DATA,0));
|
|
current_asmdata.asmlists[al_end].concat(Tai_stab.Create_str(stab_stabs,'"",'+tostr(n_sourcefile)+',0,0,'+hlabel.name));
|
|
current_asmdata.asmlists[al_end].concat(tai_label.create(hlabel));
|
|
end;
|
|
|
|
|
|
procedure tdebuginfostabs.referencesections(list:TAsmList);
|
|
var
|
|
hp : tmodule;
|
|
dbgtable : tai_symbol;
|
|
begin
|
|
{ Reference all DEBUGINFO sections from the main .fpc section }
|
|
if (target_info.system in ([system_powerpc_macos]+systems_darwin)) then
|
|
exit;
|
|
list.concat(Tai_section.create(sec_fpc,'links',0));
|
|
{ make sure the debuginfo doesn't get stripped out }
|
|
if (target_info.system in systems_darwin) then
|
|
begin
|
|
dbgtable:=tai_symbol.createname('DEBUGINFOTABLE',AT_DATA,0);
|
|
list.concat(tai_directive.create(asd_no_dead_strip,dbgtable.sym.name));
|
|
list.concat(dbgtable);
|
|
end;
|
|
{ include reference to all debuginfo sections of used units }
|
|
hp:=tmodule(loaded_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
If (hp.flags and uf_has_debuginfo)=uf_has_debuginfo then
|
|
begin
|
|
list.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.localsymtable,''),0));
|
|
list.concat(Tai_const.Createname(make_mangledname('DEBUGSTART',hp.localsymtable,''),0));
|
|
list.concat(Tai_const.Createname(make_mangledname('DEBUGEND',hp.localsymtable,''),0));
|
|
end;
|
|
hp:=tmodule(hp.next);
|
|
end;
|
|
end;
|
|
|
|
|
|
const
|
|
dbg_stabs_info : tdbginfo =
|
|
(
|
|
id : dbg_stabs;
|
|
idtxt : 'STABS';
|
|
);
|
|
|
|
initialization
|
|
RegisterDebugInfo(dbg_stabs_info,TDebugInfoStabs);
|
|
end.
|