summaryrefslogtreecommitdiff
path: root/compiler/dbgstabs.pas
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/dbgstabs.pas')
-rw-r--r--compiler/dbgstabs.pas1589
1 files changed, 1589 insertions, 0 deletions
diff --git a/compiler/dbgstabs.pas b/compiler/dbgstabs.pas
new file mode 100644
index 0000000000..bfdd181c68
--- /dev/null
+++ b/compiler/dbgstabs.pas
@@ -0,0 +1,1589 @@
+{
+ 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;
+
+ type
+ TDebugInfoStabs=class(TDebugInfo)
+ private
+ writing_def_stabs : boolean;
+ global_stab_number : word;
+ defnumberlist : tlist;
+ { 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):Pchar;
+ procedure write_symtable_syms(list:taasmoutput;st:tsymtable);
+ { 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):Pchar;
+ procedure field_add_stabstr(p:Tnamedindexitem;arg:pointer);
+ 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;
+ end;
+
+
+implementation
+
+ uses
+ strings,cutils,
+ systems,globals,globtype,verbose,
+ symconst,defutil,
+ cpuinfo,cpubase,cgbase,paramgr,
+ aasmbase,procinfo,
+ finput,fmodule,ppu;
+
+ const
+ memsizeinc = 512;
+
+ 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;
+ N_IncludeFile = $84;
+ N_BINCL = $82;
+ N_EINCL = $A2;
+ N_EXCL = $C2;
+
+ tagtypes = [
+ recorddef,
+ enumdef,
+ stringdef,
+ filedef,
+ objectdef
+ ];
+
+ type
+ get_var_value_proc=function(const s:string;arg:pointer):string of object;
+
+ Trecord_stabgen_state=record
+ stabstring:Pchar;
+ stabsize,staballoc,recoffset:integer;
+ end;
+ Precord_stabgen_state=^Trecord_stabgen_state;
+
+
+ function string_evaluate(s:string;get_var_value:get_var_value_proc;
+ get_var_value_arg:pointer;
+ const vars:array of string):Pchar;
+
+ (*
+ 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 Pstring;
+ {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:cardinal;
+ r:Pchar;
+
+ begin
+ {Two pass approach, first, calculate the length and receive variables.}
+ i:=1;
+ len:=0;
+ varcounter:=0;
+ varptr:=@varvaluedata;
+ 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]:=Pstring(varptr);
+ if varptr>@varvaluedata+maxdata then
+ internalerrorproc(200411152);
+ Pstring(varptr)^:=get_var_value(varname,get_var_value_arg);
+ inc(len,length(Pstring(varptr)^));
+ inc(varptr,length(Pstring(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.}
+ getmem(r,len+1);
+ string_evaluate:=r;
+ 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;
+ r^:=#0;
+ 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.deftype=procdef) then
+ def.stab_state:=stab_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
+ 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;
+ { 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);
+ result:=tostr(def.stab_number-1);
+ 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:=Ttypesym(def.typesym).name;
+ 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):Pchar;
+ begin
+ result:=string_evaluate(s,@def_var_value,def,vars);
+ end;
+
+
+ procedure TDebugInfoStabs.field_add_stabstr(p:Tnamedindexitem;arg:pointer);
+ var
+ newrec : Pchar;
+ spec : string[3];
+ varsize : aint;
+ state : Precord_stabgen_state;
+ begin
+ state:=arg;
+ { static variables from objects are like global objects }
+ if (Tsym(p).typ=fieldvarsym) and
+ not(sp_static in Tsym(p).symoptions) then
+ begin
+ if ([sp_protected,sp_strictprotected]*tsym(p).symoptions)<>[] then
+ spec:='/1'
+ else if ([sp_private,sp_strictprivate]*tsym(p).symoptions)<>[] then
+ spec:='/0'
+ else
+ spec:='';
+ varsize:=tfieldvarsym(p).vartype.def.size;
+ { open arrays made overflows !! }
+ if varsize>$fffffff then
+ varsize:=$fffffff;
+ newrec:=def_stabstr_evaluate(nil,'$1:$2,$3,$4;',[p.name,
+ spec+def_stab_number(tfieldvarsym(p).vartype.def),
+ tostr(tfieldvarsym(p).fieldoffset*8),tostr(varsize*8)]);
+ if state^.stabsize+strlen(newrec)>=state^.staballoc-256 then
+ begin
+ inc(state^.staballoc,strlen(newrec)+64);
+ reallocmem(state^.stabstring,state^.staballoc);
+ end;
+ strcopy(state^.stabstring+state^.stabsize,newrec);
+ inc(state^.stabsize,strlen(newrec));
+ strdispose(newrec);
+ {This should be used for case !!}
+ inc(state^.recoffset,Tfieldvarsym(p).vartype.def.size);
+ end;
+ end;
+
+
+ procedure TDebugInfoStabs.method_add_stabstr(p:Tnamedindexitem;arg:pointer);
+ var virtualind,argnames : string;
+ newrec : pchar;
+ pd : tprocdef;
+ lindex : longint;
+ arglength : byte;
+ sp : char;
+ state:^Trecord_stabgen_state;
+ olds:integer;
+ i : integer;
+ parasym : tparavarsym;
+ begin
+ state:=arg;
+ if tsym(p).typ = procsym then
+ begin
+ pd := tprocsym(p).first_procdef;
+ 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.vartype.def.deftype = 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.vartype.def.typesym) then
+ begin
+ arglength := length(Parasym.vartype.def.typesym.name);
+ argnames := argnames + tostr(arglength)+Parasym.vartype.def.typesym.name;
+ end
+ else
+ argnames:=argnames+'11unnamedtype';
+ end;
+ end;
+ { here 2A must be changed for private and protected }
+ { 0 is private 1 protected and 2 public }
+ if ([sp_private,sp_strictprivate]*tsym(p).symoptions)<>[] then
+ sp:='0'
+ else if ([sp_protected,sp_strictprotected]*tsym(p).symoptions)<>[] then
+ sp:='1'
+ else
+ sp:='2';
+ newrec:=def_stabstr_evaluate(nil,'$1::$2=##$3;:$4;$5A$6;',[p.name,def_stab_number(pd),
+ def_stab_number(pd.rettype.def),argnames,sp,
+ virtualind]);
+ { get spare place for a string at the end }
+ olds:=state^.stabsize;
+ inc(state^.stabsize,strlen(newrec));
+ if state^.stabsize>=state^.staballoc-256 then
+ begin
+ inc(state^.staballoc,strlen(newrec)+64);
+ reallocmem(state^.stabstring,state^.staballoc);
+ end;
+ strcopy(state^.stabstring+olds,newrec);
+ strdispose(newrec);
+ {This should be used for case !!
+ RecOffset := RecOffset + pd.size;}
+ end;
+ end;
+
+
+ function TDebugInfoStabs.def_stabstr(def:tdef):pchar;
+
+ function stringdef_stabstr(def:tstringdef):pchar;
+ var
+ slen : aint;
+ bytest,charst,longst : string;
+ begin
+ case def.string_typ of
+ st_shortstring:
+ begin
+ { fix length of openshortstring }
+ slen:=def.len;
+ if slen=0 then
+ slen:=255;
+ charst:=def_stab_number(cchartype.def);
+ bytest:=def_stab_number(u8inttype.def);
+ result:=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.def);
+ bytest:=def_stab_number(u8inttype.def);
+ longst:=def_stab_number(u32inttype.def);
+ result:=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 }
+ charst:=def_stab_number(cchartype.def);
+ result:=strpnew('*'+charst);
+ end;
+ st_widestring:
+ begin
+ { looks like a pwidechar }
+ charst:=def_stab_number(cwidechartype.def);
+ result:=strpnew('*'+charst);
+ end;
+ end;
+ end;
+
+ function enumdef_stabstr(def:tenumdef):pchar;
+ var
+ st : Pchar;
+ p : Tenumsym;
+ s : string;
+ memsize,
+ stl : aint;
+ begin
+ memsize:=memsizeinc;
+ getmem(st,memsize);
+ { we can specify the size with @s<size>; prefix PM }
+ if def.size <> std_param_align then
+ strpcopy(st,'@s'+tostr(def.size*8)+';e')
+ else
+ strpcopy(st,'e');
+ p := tenumsym(def.firstenum);
+ stl:=strlen(st);
+ while assigned(p) do
+ begin
+ s :=p.name+':'+tostr(p.value)+',';
+ { place for the ending ';' also }
+ if (stl+length(s)+1>=memsize) then
+ begin
+ inc(memsize,memsizeinc);
+ reallocmem(st,memsize);
+ end;
+ strpcopy(st+stl,s);
+ inc(stl,length(s));
+ p:=p.nextenum;
+ end;
+ st[stl]:=';';
+ st[stl+1]:=#0;
+ reallocmem(st,stl+2);
+ result:=st;
+ end;
+
+ function orddef_stabstr(def:torddef):pchar;
+ begin
+ if cs_gdb_valgrind in aktglobalswitches then
+ begin
+ case def.typ of
+ uvoid :
+ result:=strpnew(def_stab_number(def));
+ bool8bit,
+ bool16bit,
+ bool32bit :
+ result:=def_stabstr_evaluate(def,'r${numberstring};0;255;',[]);
+ u32bit,
+ s64bit,
+ u64bit :
+ result:=def_stabstr_evaluate(def,'r${numberstring};0;-1;',[]);
+ else
+ result:=def_stabstr_evaluate(def,'r${numberstring};$1;$2;',[tostr(longint(def.low)),tostr(longint(def.high))]);
+ end;
+ end
+ else
+ begin
+ case def.typ of
+ uvoid :
+ result:=strpnew(def_stab_number(def));
+ uchar :
+ result:=strpnew('-20;');
+ uwidechar :
+ result:=strpnew('-30;');
+ bool8bit :
+ result:=strpnew('-21;');
+ bool16bit :
+ result:=strpnew('-22;');
+ bool32bit :
+ result:=strpnew('-23;');
+ u64bit :
+ result:=strpnew('-32;');
+ s64bit :
+ result:=strpnew('-31;');
+ {u32bit : result:=def_stab_number(s32inttype.def)+';0;-1;'); }
+ else
+ result:=def_stabstr_evaluate(def,'r${numberstring};$1;$2;',[tostr(longint(def.low)),tostr(longint(def.high))]);
+ end;
+ end;
+ end;
+
+ function floatdef_stabstr(def:tfloatdef):Pchar;
+ begin
+ case def.typ of
+ s32real,
+ s64real,
+ s80real:
+ result:=def_stabstr_evaluate(def,'r$1;${savesize};0;',[def_stab_number(s32inttype.def)]);
+ s64currency,
+ s64comp:
+ result:=def_stabstr_evaluate(def,'r$1;-${savesize};0;',[def_stab_number(s32inttype.def)]);
+ else
+ internalerror(200509261);
+ end;
+ end;
+
+ function filedef_stabstr(def:tfiledef):pchar;
+ begin
+{$ifdef cpu64bit}
+ result:=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),
+ def_stab_number(s64inttype.def),
+ def_stab_number(u8inttype.def),
+ def_stab_number(cchartype.def)]);
+{$else cpu64bit}
+ result:=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),
+ def_stab_number(u8inttype.def),
+ def_stab_number(cchartype.def)]);
+{$endif cpu64bit}
+ end;
+
+ function procdef_stabstr(def:tprocdef):pchar;
+ Var
+ RType : Char;
+ Obj,Info : String;
+ stabsstr : string;
+ p : pchar;
+ begin
+ obj := def.procsym.name;
+ 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 := def.owner.name^+'__'+def.procsym.name;
+ if not(cs_gdb_valgrind in aktglobalswitches) and
+ (def.owner.symtabletype=localsymtable) and
+ assigned(def.owner.defowner) and
+ assigned(tprocdef(def.owner.defowner).procsym) then
+ info := ','+def.procsym.name+','+tprocdef(def.owner.defowner).procsym.name;
+ end;
+ stabsstr:=def.mangledname;
+ getmem(p,length(stabsstr)+255);
+ strpcopy(p,'"'+obj+':'+RType
+ +def_stab_number(def.rettype.def)+info+'",'+tostr(n_function)
+ +',0,'+
+ tostr(def.fileinfo.line)
+ +',');
+ strpcopy(strend(p),stabsstr);
+ result:=strnew(p);
+ freemem(p,length(stabsstr)+255);
+ end;
+
+ function recorddef_stabstr(def:trecorddef):pchar;
+ var
+ state : Trecord_stabgen_state;
+ begin
+ getmem(state.stabstring,memsizeinc);
+ state.staballoc:=memsizeinc;
+ strpcopy(state.stabstring,'s'+tostr(def.size));
+ state.recoffset:=0;
+ state.stabsize:=strlen(state.stabstring);
+ def.symtable.foreach(@field_add_stabstr,@state);
+ state.stabstring[state.stabsize]:=';';
+ state.stabstring[state.stabsize+1]:=#0;
+ reallocmem(state.stabstring,state.stabsize+2);
+ result:=state.stabstring;
+ end;
+
+ function objectdef_stabstr(def:tobjectdef):pchar;
+ var
+ anc : tobjectdef;
+ state :Trecord_stabgen_state;
+ ts : string;
+ begin
+ { Write the invisible pointer for the class? }
+ if (def.objecttype=odt_class) and
+ (not def.writing_class_record_stab) then
+ begin
+ result:=strpnew('*'+def_stab_classnumber(def));
+ exit;
+ end;
+
+ state.staballoc:=memsizeinc;
+ getmem(state.stabstring,state.staballoc);
+ strpcopy(state.stabstring,'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 , }
+ strpcopy(strend(state.stabstring),'!1,020,'+def_stab_classnumber(def.childof)+';');
+ end;
+ {virtual table to implement yet}
+ state.recoffset:=0;
+ state.stabsize:=strlen(state.stabstring);
+ def.symtable.foreach(@field_add_stabstr,@state);
+ if (oo_has_vmt in def.objectoptions) then
+ if not assigned(def.childof) or not(oo_has_vmt in def.childof.objectoptions) then
+ begin
+ ts:='$vf'+def_stab_classnumber(def)+':'+def_stab_number(vmtarraytype.def)+','+tostr(def.vmt_offset*8)+';';
+ strpcopy(state.stabstring+state.stabsize,ts);
+ inc(state.stabsize,length(ts));
+ end;
+ def.symtable.foreach(@method_add_stabstr,@state);
+ 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 }
+ ts:=';~%'+def_stab_classnumber(anc)+';';
+ end
+ else
+ ts:=';';
+ strpcopy(state.stabstring+state.stabsize,ts);
+ inc(state.stabsize,length(ts));
+ reallocmem(state.stabstring,state.stabsize+1);
+ result:=state.stabstring;
+ end;
+
+ begin
+ result:=nil;
+ case def.deftype of
+ stringdef :
+ result:=stringdef_stabstr(tstringdef(def));
+ enumdef :
+ result:=enumdef_stabstr(tenumdef(def));
+ orddef :
+ result:=orddef_stabstr(torddef(def));
+ floatdef :
+ result:=floatdef_stabstr(tfloatdef(def));
+ filedef :
+ result:=filedef_stabstr(tfiledef(def));
+ recorddef :
+ result:=recorddef_stabstr(trecorddef(def));
+ variantdef :
+ result:=def_stabstr_evaluate(def,'formal${numberstring};',[]);
+ pointerdef :
+ result:=strpnew('*'+def_stab_number(tpointerdef(def).pointertype.def));
+ classrefdef :
+ result:=strpnew(def_stab_number(pvmttype.def));
+ setdef :
+ result:=def_stabstr_evaluate(def,'@s$1;S$2',[tostr(def.size*8),def_stab_number(tsetdef(def).elementtype.def)]);
+ formaldef :
+ result:=def_stabstr_evaluate(def,'formal${numberstring};',[]);
+ arraydef :
+ result:=def_stabstr_evaluate(def,'ar$1;$2;$3;$4',[def_stab_number(tarraydef(def).rangetype.def),
+ tostr(tarraydef(def).lowrange),tostr(tarraydef(def).highrange),def_stab_number(tarraydef(def).elementtype.def)]);
+ procdef :
+ result:=procdef_stabstr(tprocdef(def));
+ procvardef :
+ result:=strpnew('*f'+def_stab_number(tprocvardef(def).rettype.def));
+ objectdef :
+ begin
+ if tobjectdef(def).writing_class_record_stab then
+ result:=objectdef_stabstr(tobjectdef(def))
+ else
+ result:=strpnew('*'+def_stab_classnumber(tobjectdef(def)));
+ end;
+ end;
+ end;
+
+
+ procedure TDebugInfoStabs.write_def_stabstr(list:taasmoutput;def:tdef);
+ var
+ stabchar : string[2];
+ ss,st,su : pchar;
+ begin
+ { procdefs require a different stabs style without type prefix }
+ if def.deftype=procdef then
+ begin
+ st:=def_stabstr(def);
+ { add to list }
+ list.concat(Tai_stab.create(stab_stabs,st));
+ end
+ else
+ begin
+ { type prefix }
+ if def.deftype in tagtypes then
+ stabchar := 'Tt'
+ else
+ 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
+ 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)]);
+ ss:=def_stabstr(def);
+ reallocmem(st,strlen(ss)+512);
+ { 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 }
+ su:=def_stabstr_evaluate(def,'",${N_LSYM},0,0,0',[]);
+ strcopy(strecopy(strend(st),ss),su);
+ reallocmem(st,strlen(st)+1);
+ strdispose(ss);
+ strdispose(su);
+ { add to list }
+ list.concat(Tai_stab.create(stab_stabs,st));
+ end;
+ 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;
+// nb : string[12];
+ begin
+ if (def.stab_state in [stab_state_writing,stab_state_written]) then
+ exit;
+ { to avoid infinite loops }
+ def.stab_state := stab_state_writing;
+ { write dependencies first }
+ case def.deftype of
+ stringdef :
+ begin
+ if tstringdef(def).string_typ=st_widestring then
+ insertdef(list,cwidechartype.def)
+ else
+ begin
+ insertdef(list,cchartype.def);
+ insertdef(list,u8inttype.def);
+ end;
+ end;
+ floatdef :
+ insertdef(list,s32inttype.def);
+ filedef :
+ begin
+ insertdef(list,s32inttype.def);
+{$ifdef cpu64bit}
+ insertdef(list,s64inttype.def);
+{$endif cpu64bit}
+ insertdef(list,u8inttype.def);
+ insertdef(list,cchartype.def);
+ end;
+ classrefdef :
+ insertdef(list,pvmttype.def);
+ pointerdef :
+ insertdef(list,tpointerdef(def).pointertype.def);
+ setdef :
+ insertdef(list,tsetdef(def).elementtype.def);
+ procvardef,
+ procdef :
+ insertdef(list,tprocdef(def).rettype.def);
+ arraydef :
+ begin
+ insertdef(list,tarraydef(def).rangetype.def);
+ insertdef(list,tarraydef(def).elementtype.def);
+ end;
+ recorddef :
+ trecorddef(def).symtable.foreach(@field_write_defs,list);
+ objectdef :
+ begin
+ insertdef(list,vmtarraytype.def);
+ { first the parents }
+ anc:=tobjectdef(def);
+ while assigned(anc.childof) do
+ begin
+ anc:=anc.childof;
+ insertdef(list,anc);
+ end;
+ tobjectdef(def).symtable.foreach(@field_write_defs,list);
+ tobjectdef(def).symtable.foreach(@method_write_defs,list);
+ end;
+ end;
+(*
+ { Handle pointerdefs to records and objects to avoid recursion }
+ if (def.deftype=pointerdef) and
+ (tpointerdef(def).pointertype.def.deftype in [recorddef,objectdef]) then
+ begin
+ def.stab_state:=stab_state_used;
+ write_def_stabstr(list,def);
+ {to avoid infinite recursion in record with next-like fields }
+ if tdef(tpointerdef(def).pointertype.def).stab_state=stab_state_writing then
+ begin
+ if assigned(tpointerdef(def).pointertype.def.typesym) then
+ begin
+ if is_class(tpointerdef(def).pointertype.def) then
+ nb:=def_stab_classnumber(tobjectdef(tpointerdef(def).pointertype.def))
+ else
+ nb:=def_stab_number(tpointerdef(def).pointertype.def);
+ list.concat(Tai_stab.create(stab_stabs,def_stabstr_evaluate(
+ def,'"${sym_name}:t${numberstring}=*$1=xs$2:",${N_LSYM},0,0,0',
+ [nb,tpointerdef(def).pointertype.def.typesym.name])));
+ end;
+ def.stab_state:=stab_state_written;
+ end
+ end
+ else
+*)
+ case def.deftype of
+ objectdef :
+ 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_stab:=true;
+ write_def_stabstr(list,def);
+ tobjectdef(def).writing_class_record_stab:=false;
+ { Write the invisible pointer class }
+ oldtypesym:=def.typesym;
+ def.typesym:=nil;
+ write_def_stabstr(list,def);
+ def.typesym:=oldtypesym;
+ end
+ else
+ write_def_stabstr(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_'+def.owner.name^+tobjectdef(def).name+':S'+
+ def_stab_number(vmttype.def)+'",'+tostr(N_STSYM)+',0,0,'+tobjectdef(def).vmt_mangledname)));
+ end;
+ procdef :
+ begin
+ { procdefs are handled separatly }
+ end;
+ else
+ write_def_stabstr(list,def);
+ end;
+
+ def.stab_state := stab_state_written;
+ end;
+
+
+ procedure TDebugInfoStabs.write_symtable_defs(list:taasmoutput;st:tsymtable);
+
+ procedure dowritestabs(list:taasmoutput;st:tsymtable);
+ var
+ p : tdef;
+ begin
+ p:=tdef(st.defindex.first);
+ while assigned(p) do
+ begin
+ if (p.stab_state=stab_state_used) then
+ insertdef(list,p);
+ p:=tdef(p.indexnext);
+ end;
+ end;
+
+ var
+ old_writing_def_stabs : boolean;
+ begin
+ case st.symtabletype of
+ staticsymtable :
+ list.concat(tai_comment.Create(strpnew('Defs - Begin Staticsymtable')));
+ globalsymtable :
+ list.concat(tai_comment.Create(strpnew('Defs - Begin unit '+st.name^+' has index '+tostr(st.moduleid))));
+ end;
+ old_writing_def_stabs:=writing_def_stabs;
+ writing_def_stabs:=true;
+ dowritestabs(list,st);
+ writing_def_stabs:=old_writing_def_stabs;
+ case st.symtabletype of
+ staticsymtable :
+ list.concat(tai_comment.Create(strpnew('Defs - End Staticsymtable')));
+ globalsymtable :
+ list.concat(tai_comment.Create(strpnew('Defs - End unit '+st.name^+' has index '+tostr(st.moduleid))));
+ end;
+ end;
+
+
+ procedure TDebugInfoStabs.write_procdef(list:taasmoutput;pd:tprocdef);
+ var
+ templist : taasmoutput;
+ stabsendlabel : tasmlabel;
+ mangled_length : longint;
+ p : pchar;
+ hs : string;
+ begin
+ if assigned(pd.procstarttai) then
+ begin
+ templist:=taasmoutput.create;
+ { para types }
+ write_def_stabstr(templist,pd);
+ if assigned(pd.parast) then
+ write_symtable_syms(templist,pd.parast);
+ { local type defs and vars should not be written
+ inside the main proc stab }
+ if assigned(pd.localst) and
+ (pd.localst.symtabletype=localsymtable) then
+ write_symtable_syms(templist,pd.localst);
+ asmlist[al_procedures].insertlistbefore(pd.procstarttai,templist);
+ { end of procedure }
+ objectlibrary.getlabel(stabsendlabel,alt_dbgtype);
+ templist.concat(tai_label.create(stabsendlabel));
+ if assigned(pd.funcretsym) and
+ (tabstractnormalvarsym(pd.funcretsym).refs>0) then
+ begin
+ if tabstractnormalvarsym(pd.funcretsym).localloc.loc=LOC_REFERENCE then
+ begin
+ {$warning Need to add gdb support for ret in param register calling}
+ if paramanager.ret_in_param(pd.rettype.def,pd.proccalloption) then
+ hs:='X*'
+ else
+ hs:='X';
+ templist.concat(Tai_stab.create(stab_stabs,strpnew(
+ '"'+pd.procsym.name+':'+hs+def_stab_number(pd.rettype.def)+'",'+
+ tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(pd.funcretsym).localloc.reference.offset))));
+ if (m_result in aktmodeswitches) then
+ templist.concat(Tai_stab.create(stab_stabs,strpnew(
+ '"RESULT:'+hs+def_stab_number(pd.rettype.def)+'",'+
+ tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(pd.funcretsym).localloc.reference.offset))));
+ end;
+ end;
+ mangled_length:=length(pd.mangledname);
+ getmem(p,2*mangled_length+50);
+ strpcopy(p,'192,0,0,');
+ {$IFDEF POWERPC64}strpcopy(strend(p), '.');{$ENDIF POWERPC64}
+ strpcopy(strend(p),pd.mangledname);
+ if (target_info.use_function_relative_addresses) then
+ begin
+ strpcopy(strend(p),'-');
+ {$IFDEF POWERPC64}strpcopy(strend(p), '.');{$ENDIF POWERPC64}
+ strpcopy(strend(p),pd.mangledname);
+ end;
+ templist.concat(Tai_stab.Create(stab_stabn,strnew(p)));
+ strpcopy(p,'224,0,0,'+stabsendlabel.name);
+ if (target_info.use_function_relative_addresses) then
+ begin
+ strpcopy(strend(p),'-');
+ {$IFDEF POWERPC64}strpcopy(strend(p), '.');{$ENDIF POWERPC64}
+ strpcopy(strend(p),pd.mangledname);
+ end;
+ templist.concat(Tai_stab.Create(stab_stabn,strnew(p)));
+ freemem(p,2*mangled_length+50);
+ asmlist[al_procedures].insertlistbefore(pd.procendtai,templist);
+ templist.free;
+ end;
+ end;
+
+
+{****************************************************************************
+ TSym support
+****************************************************************************}
+
+ function TDebugInfoStabs.sym_var_value(const s:string;arg:pointer):string;
+ var
+ sym : tsym;
+ begin
+ sym:=tsym(arg);
+ result:='';
+ if s='name' then
+ result:=sym.name
+ else if s='mangledname' then
+ result:=sym.mangledname
+ else if s='ownername' then
+ result:=sym.owner.name^
+ 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):Pchar;
+ begin
+ result:=string_evaluate(s,@sym_var_value,sym,vars);
+ end;
+
+
+ procedure TDebugInfoStabs.insertsym(list:taasmoutput;sym:tsym);
+
+ function fieldvarsym_stabstr(sym:tfieldvarsym):Pchar;
+ begin
+ result:=nil;
+ if (sym.owner.symtabletype=objectsymtable) and
+ (sp_static in sym.symoptions) then
+ result:=sym_stabstr_evaluate(sym,'"${ownername}__${name}:S$1",${N_LCSYM},0,${line},${mangledname}',
+ [def_stab_number(sym.vartype.def)]);
+ end;
+
+ function globalvarsym_stabstr(sym:tglobalvarsym):Pchar;
+ var
+ st : string;
+ threadvaroffset : string;
+ regidx : Tregisterindex;
+ begin
+ result:=nil;
+ { 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;
+ st:=def_stab_number(sym.vartype.def);
+ 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
+ result:=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(aint))
+ else
+ threadvaroffset:='';
+ { 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;
+ result:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]);
+ end;
+ end;
+ end;
+
+ function localvarsym_stabstr(sym:tlocalvarsym):Pchar;
+ var
+ st : string;
+ regidx : Tregisterindex;
+ begin
+ result:=nil;
+ { There is no space allocated for not referenced locals }
+ if (sym.owner.symtabletype=localsymtable) and (sym.refs=0) then
+ exit;
+
+ st:=def_stab_number(sym.vartype.def);
+ 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
+ result:=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 }
+ result:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(sym.localloc.reference.offset)])
+ else
+ internalerror(2003091814);
+ end;
+ end;
+
+ function paravarsym_stabstr(sym:tparavarsym):Pchar;
+ var
+ st : string;
+ regidx : Tregisterindex;
+ c : char;
+ begin
+ result:=nil;
+ { 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
+ result:=sym_stabstr_evaluate(sym,'"pvmt:p$1",${N_TSYM},0,0,$2',
+ [def_stab_number(pvmttype.def),tostr(sym.localloc.reference.offset)]);
+ (* else
+ result:=sym_stabstr_evaluate(sym,'"pvmt:r$1",${N_RSYM},0,0,$2',
+ [def_stab_number(pvmttype.def),tostr(regstabs_table[regidx])]) *)
+ 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
+ result:=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
+ result:=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
+ else
+ begin
+ st:=def_stab_number(sym.vartype.def);
+
+ if paramanager.push_addr_param(sym.varspez,sym.vartype.def,tprocdef(sym.owner.defowner).proccalloption) and
+ not(vo_has_local_copy in sym.varoptions) and
+ not is_open_string(sym.vartype.def) then
+ st := 'v'+st { should be 'i' but 'i' doesn't work }
+ else
+ st := 'p'+st;
+ 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
+ result:=sym_stabstr_evaluate(sym,'"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(longint(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 }
+ result:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(sym.localloc.reference.offset)])
+ else
+ internalerror(2003091814);
+ end;
+ end;
+ end;
+
+ function constsym_stabstr(sym:tconstsym):Pchar;
+ var
+ st : string;
+ begin
+ 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;
+ { valgrind does not support constants }
+ if cs_gdb_valgrind in aktglobalswitches then
+ result:=nil
+ else
+ result:=sym_stabstr_evaluate(sym,'"${name}:c=$1;",${N_FUNCTION},0,${line},0',[st]);
+ end;
+
+ function typesym_stabstr(sym:ttypesym) : pchar;
+ var
+ stabchar : string[2];
+ begin
+ result:=nil;
+ if not assigned(sym.restype.def) then
+ internalerror(200509262);
+ if sym.restype.def.deftype in tagtypes then
+ stabchar:='Tt'
+ else
+ stabchar:='t';
+ result:=sym_stabstr_evaluate(sym,'"${name}:$1$2",${N_LSYM},0,${line},0',[stabchar,def_stab_number(sym.restype.def)]);
+ end;
+
+ function procsym_stabstr(sym:tprocsym) : pchar;
+ var
+ i : longint;
+ begin
+ result:=nil;
+ for i:=1 to sym.procdef_count do
+ write_procdef(list,sym.procdef[i]);
+ end;
+
+ var
+ stabstr : Pchar;
+ begin
+ stabstr:=nil;
+ case sym.typ of
+ labelsym :
+ stabstr:=sym_stabstr_evaluate(sym,'"${name}",${N_LSYM},0,${line},0',[]);
+ fieldvarsym :
+ stabstr:=fieldvarsym_stabstr(tfieldvarsym(sym));
+ globalvarsym :
+ stabstr:=globalvarsym_stabstr(tglobalvarsym(sym));
+ localvarsym :
+ stabstr:=localvarsym_stabstr(tlocalvarsym(sym));
+ paravarsym :
+ stabstr:=paravarsym_stabstr(tparavarsym(sym));
+ typedconstsym :
+ stabstr:=sym_stabstr_evaluate(sym,'"${name}:S$1",${N_STSYM},0,${line},${mangledname}',
+ [def_stab_number(ttypedconstsym(sym).typedconsttype.def)]);
+ constsym :
+ stabstr:=constsym_stabstr(tconstsym(sym));
+ typesym :
+ stabstr:=typesym_stabstr(ttypesym(sym));
+ procsym :
+ stabstr:=procsym_stabstr(tprocsym(sym));
+ end;
+ if stabstr<>nil then
+ list.concat(Tai_stab.create(stab_stabs,stabstr));
+ { For object types write also the symtable entries }
+ if (sym.typ=typesym) and (ttypesym(sym).restype.def.deftype=objectdef) then
+ write_symtable_syms(list,tobjectdef(ttypesym(sym).restype.def).symtable);
+ sym.isstabwritten:=true;
+ end;
+
+
+ procedure TDebugInfoStabs.write_symtable_syms(list:taasmoutput;st:tsymtable);
+ var
+ p : tsym;
+ begin
+ case st.symtabletype of
+ staticsymtable :
+ list.concat(tai_comment.Create(strpnew('Syms - Begin Staticsymtable')));
+ globalsymtable :
+ list.concat(tai_comment.Create(strpnew('Syms - Begin unit '+st.name^+' has index '+tostr(st.moduleid))));
+ end;
+ p:=tsym(st.symindex.first);
+ while assigned(p) do
+ begin
+ if (not p.isstabwritten) then
+ insertsym(list,p);
+ p:=tsym(p.indexnext);
+ end;
+ case st.symtabletype of
+ staticsymtable :
+ list.concat(tai_comment.Create(strpnew('Syms - End Staticsymtable')));
+ globalsymtable :
+ list.concat(tai_comment.Create(strpnew('Syms - End unit '+st.name^+' has index '+tostr(st.moduleid))));
+ end;
+ end;
+
+{****************************************************************************
+ Proc/Module support
+****************************************************************************}
+
+ 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;
+ storefilepos : tfileposinfo;
+ st : tsymtable;
+ i : longint;
+ begin
+ storefilepos:=aktfilepos;
+ aktfilepos:=current_module.mainfilepos;
+
+ global_stab_number:=0;
+ defnumberlist:=tlist.create;
+ stabsvarlist:=taasmoutput.create;
+ stabstypelist:=taasmoutput.create;
+
+ { include symbol that will be referenced from the main to be sure to
+ include this debuginfo .o file }
+ if current_module.is_unit then
+ begin
+ current_module.flags:=current_module.flags or uf_has_debuginfo;
+ st:=current_module.globalsymtable;
+ end
+ else
+ st:=current_module.localsymtable;
+ new_section(asmlist[al_stabs],sec_data,st.name^,0);
+ asmlist[al_stabs].concat(tai_symbol.Createname_global(make_mangledname('DEBUGINFO',st,''),AT_DATA,0));
+
+ { first write all global/local symbols. 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);
+
+ { 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);
+
+ asmlist[al_stabs].concatlist(stabstypelist);
+ asmlist[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]).stab_state:=stab_state_unused;
+ end;
+ end;
+
+ defnumberlist.free;
+ defnumberlist:=nil;
+
+ stabsvarlist.free;
+ stabstypelist.free;
+ aktfilepos:=storefilepos;
+ end;
+
+
+ procedure tdebuginfostabs.insertlineinfo(list:taasmoutput);
+ var
+ currfileinfo,
+ lastfileinfo : tfileposinfo;
+ currfuncname : pstring;
+ 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) then
+ begin
+ infile:=current_module.sourcefiles.get_file(currfileinfo.fileindex);
+ if assigned(infile) then
+ begin
+ objectlibrary.getlabel(hlabel,alt_dbgfile);
+ { emit stabs }
+ if (infile.path^<>'') then
+ list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+'",'+tostr(n_includefile)+
+ ',0,0,'+hlabel.name),hp);
+ list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+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 (lastfileinfo.line<>currfileinfo.line) and (currfileinfo.line<>0) then
+ begin
+ if assigned(currfuncname) and
+ (target_info.use_function_relative_addresses) 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;
+ end;
+
+ hp:=tai(hp.next);
+ end;
+ end;
+
+
+ procedure tdebuginfostabs.insertmoduleinfo;
+ var
+ hlabel : tasmlabel;
+ infile : tinputfile;
+ templist : taasmoutput;
+ begin
+ { emit main source n_sourcefile for start of module }
+ objectlibrary.getlabel(hlabel,alt_dbgfile);
+ infile:=current_module.sourcefiles.get_file(1);
+ templist:=taasmoutput.create;
+ new_section(templist,sec_code,'',0);
+ if (infile.path^<>'') then
+ templist.concat(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+'",'+tostr(n_sourcefile)+
+ ',0,0,'+hlabel.name));
+ 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);
+ templist.free;
+ { emit empty n_sourcefile for end of module }
+ objectlibrary.getlabel(hlabel,alt_dbgfile);
+ templist:=taasmoutput.create;
+ 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);
+ templist.free;
+ end;
+
+
+ procedure tdebuginfostabs.referencesections(list:taasmoutput);
+ var
+ hp : tused_unit;
+ begin
+ { Reference all DEBUGINFO sections from the main .text section }
+ if (target_info.system <> system_powerpc_macos) then
+ begin
+ { include reference to all debuginfo sections of used units }
+ hp:=tused_unit(usedunits.first);
+ while assigned(hp) do
+ begin
+ If (hp.u.flags and uf_has_debuginfo)=uf_has_debuginfo then
+ list.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.u.globalsymtable,''),AT_DATA,0));
+ hp:=tused_unit(hp.next);
+ end;
+ { include reference to debuginfo for this program }
+ list.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0));
+ end;
+ end;
+
+
+ const
+ dbg_stabs_info : tdbginfo =
+ (
+ id : dbg_stabs;
+ idtxt : 'STABS';
+ );
+
+initialization
+ RegisterDebugInfo(dbg_stabs_info,TDebugInfoStabs);
+end.
View Lorry Controller Status