mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-02 12:31:01 +02:00
* more stabs updates
This commit is contained in:
parent
1cc7b06df4
commit
d8c68fdfe0
@ -621,14 +621,12 @@ implementation
|
||||
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(pu.u);
|
||||
if assigned(pu.u.globalsymtable) then
|
||||
begin
|
||||
{ first write the info for this unit, that will flag also all
|
||||
needed typesyms from used units }
|
||||
tglobalsymtable(pu.u.globalsymtable).concattypestabto(debuglist);
|
||||
{ write type info from used units }
|
||||
write_used_unit_type_info(pu.u);
|
||||
end;
|
||||
tglobalsymtable(pu.u.globalsymtable).concattypestabto(debuglist);
|
||||
end;
|
||||
pu:=tused_unit(pu.next);
|
||||
end;
|
||||
@ -637,8 +635,10 @@ implementation
|
||||
begin
|
||||
if not (cs_debuginfo in aktmoduleswitches) then
|
||||
exit;
|
||||
{ write type info for dependent units }
|
||||
{ reset unit type info flag }
|
||||
reset_unit_type_info;
|
||||
{ write used types from the used units }
|
||||
write_used_unit_type_info(current_module);
|
||||
{ first write the types from this unit }
|
||||
if assigned(current_module.globalsymtable) then
|
||||
begin
|
||||
@ -654,9 +654,6 @@ implementation
|
||||
{ and all local symbols}
|
||||
tstaticsymtable(current_module.localsymtable).concatstabto(debuglist);
|
||||
end;
|
||||
{ The debuginfo for this unit has flagged the required types, now we
|
||||
write used types from the used units }
|
||||
write_used_unit_type_info(current_module);
|
||||
if (cs_gdb_dbx in aktglobalswitches) then
|
||||
begin
|
||||
debugList.concat(tai_comment.Create(strpnew('EINCL of global '+
|
||||
@ -677,7 +674,6 @@ implementation
|
||||
|
||||
procedure reset_used_unit_defs(hp:tmodule);
|
||||
var
|
||||
hp2 : tmodule;
|
||||
pu : tused_unit;
|
||||
begin
|
||||
pu:=tused_unit(hp.used_units.first);
|
||||
@ -1448,7 +1444,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.143 2004-03-08 22:07:47 peter
|
||||
Revision 1.144 2004-03-09 20:45:04 peter
|
||||
* more stabs updates
|
||||
|
||||
Revision 1.143 2004/03/08 22:07:47 peter
|
||||
* stabs updates to write stabs for def for all implictly used
|
||||
units
|
||||
|
||||
|
@ -90,7 +90,7 @@ interface
|
||||
function stabstr_evaluate(const s:string;const vars:array of string):Pchar;
|
||||
function stabstring : pchar;virtual;
|
||||
procedure concatstabto(asmlist : taasmoutput);virtual;
|
||||
function NumberString:string;virtual;
|
||||
function numberstring:string;virtual;
|
||||
procedure set_globalnb;virtual;
|
||||
function allstabstring : pchar;virtual;
|
||||
{$endif GDB}
|
||||
@ -138,7 +138,7 @@ interface
|
||||
{ debug }
|
||||
{$ifdef GDB}
|
||||
function stabstring : pchar;override;
|
||||
function numberstring:string;override;
|
||||
procedure concatstabto(asmlist : taasmoutput);override;
|
||||
{$endif GDB}
|
||||
end;
|
||||
|
||||
@ -152,6 +152,8 @@ interface
|
||||
function needs_inittable : boolean;override;
|
||||
procedure write_rtti_data(rt:trttitype);override;
|
||||
{$ifdef GDB}
|
||||
function numberstring:string;override;
|
||||
function stabstring : pchar;override;
|
||||
procedure concatstabto(asmlist : taasmoutput);override;
|
||||
{$endif GDB}
|
||||
end;
|
||||
@ -162,6 +164,7 @@ interface
|
||||
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
||||
function gettypename:string;override;
|
||||
{$ifdef GDB}
|
||||
function numberstring:string;override;
|
||||
function stabstring : pchar;override;
|
||||
procedure concatstabto(asmlist : taasmoutput);override;
|
||||
{$endif GDB}
|
||||
@ -204,7 +207,6 @@ interface
|
||||
{ debug }
|
||||
{$ifdef GDB}
|
||||
function stabstring : pchar;override;
|
||||
function numberstring:string;override;
|
||||
procedure concatstabto(asmlist : taasmoutput);override;
|
||||
{$endif GDB}
|
||||
end;
|
||||
@ -220,6 +222,7 @@ interface
|
||||
FRTTIType : trttitype;
|
||||
{$ifdef GDB}
|
||||
procedure field_addname(p:Tnamedindexitem;arg:pointer);
|
||||
procedure field_concatstabto(p:Tnamedindexitem;arg:pointer);
|
||||
{$endif}
|
||||
procedure count_field_rtti(sym : tnamedindexitem;arg:pointer);
|
||||
procedure write_field_rtti(sym : tnamedindexitem;arg:pointer);
|
||||
@ -227,9 +230,6 @@ interface
|
||||
public
|
||||
symtable : tsymtable;
|
||||
function getsymtable(t:tgetsymtable):tsymtable;override;
|
||||
{$ifdef GDB}
|
||||
function numberstring:string;override;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
trecorddef = class(tabstractrecorddef)
|
||||
@ -247,6 +247,7 @@ interface
|
||||
{ debug }
|
||||
{$ifdef GDB}
|
||||
function stabstring : pchar;override;
|
||||
procedure concatstabto(asmlist:taasmoutput);override;
|
||||
{$endif GDB}
|
||||
function needs_inittable : boolean;override;
|
||||
{ rtti }
|
||||
@ -261,7 +262,8 @@ interface
|
||||
tobjectdef = class(tabstractrecorddef)
|
||||
private
|
||||
{$ifdef GDB}
|
||||
procedure addprocname(p :tnamedindexitem;arg:pointer);
|
||||
procedure proc_addname(p :tnamedindexitem;arg:pointer);
|
||||
procedure proc_concatstabto(p :tnamedindexitem;arg:pointer);
|
||||
{$endif GDB}
|
||||
procedure count_published_properties(sym:tnamedindexitem;arg:pointer);
|
||||
procedure write_property_info(sym : tnamedindexitem;arg:pointer);
|
||||
@ -317,7 +319,6 @@ interface
|
||||
function classnumberstring : string;
|
||||
procedure concatstabto(asmlist : taasmoutput);override;
|
||||
function allstabstring : pchar;override;
|
||||
function numberstring : string;
|
||||
{$endif GDB}
|
||||
{ rtti }
|
||||
procedure write_child_rtti_data(rt:trttitype);override;
|
||||
@ -390,7 +391,7 @@ interface
|
||||
procedure setelementtype(t: ttype);
|
||||
{$ifdef GDB}
|
||||
function stabstring : pchar;override;
|
||||
function numberstring:string;override;
|
||||
procedure concatstabto(asmlist : taasmoutput);override;
|
||||
{$endif GDB}
|
||||
procedure buildderef;override;
|
||||
procedure deref;override;
|
||||
@ -416,6 +417,7 @@ interface
|
||||
{ debug }
|
||||
{$ifdef GDB}
|
||||
function stabstring : pchar;override;
|
||||
procedure concatstabto(asmlist:taasmoutput);override;
|
||||
{$endif GDB}
|
||||
{ rtti }
|
||||
procedure write_rtti_data(rt:trttitype);override;
|
||||
@ -433,6 +435,7 @@ interface
|
||||
{ debug }
|
||||
{$ifdef GDB}
|
||||
function stabstring : pchar;override;
|
||||
procedure concatstabto(asmlist:taasmoutput);override;
|
||||
{$endif GDB}
|
||||
{ rtti }
|
||||
procedure write_rtti_data(rt:trttitype);override;
|
||||
@ -471,8 +474,6 @@ interface
|
||||
{ debug }
|
||||
{$ifdef GDB}
|
||||
function stabstring : pchar;override;
|
||||
function numberstring:string;override;
|
||||
procedure concatstabto(asmlist : taasmoutput);override;
|
||||
{$endif GDB}
|
||||
end;
|
||||
|
||||
@ -491,6 +492,7 @@ interface
|
||||
{ debug }
|
||||
{$ifdef GDB}
|
||||
function stabstring : pchar;override;
|
||||
procedure concatstabto(asmlist:taasmoutput);override;
|
||||
{$endif GDB}
|
||||
{ rtti }
|
||||
procedure write_rtti_data(rt:trttitype);override;
|
||||
@ -602,8 +604,8 @@ interface
|
||||
function is_visible_for_object(currobjdef:tobjectdef):boolean;
|
||||
{ debug }
|
||||
{$ifdef GDB}
|
||||
function stabstring : pchar;override;
|
||||
function numberstring:string;override;
|
||||
function stabstring : pchar;override;
|
||||
procedure concatstabto(asmlist : taasmoutput);override;
|
||||
{$endif GDB}
|
||||
end;
|
||||
@ -638,7 +640,7 @@ interface
|
||||
{ debug }
|
||||
{$ifdef GDB}
|
||||
function stabstring : pchar;override;
|
||||
function numberstring:string;override;
|
||||
procedure concatstabto(asmlist : taasmoutput);override;
|
||||
{$endif GDB}
|
||||
{ init/final }
|
||||
function needs_inittable : boolean;override;
|
||||
@ -692,7 +694,7 @@ interface
|
||||
{ debug }
|
||||
{$ifdef GDB}
|
||||
function stabstring : pchar;override;
|
||||
function numberstring:string;override;
|
||||
procedure concatstabto(asmlist : taasmoutput);override;
|
||||
{$endif GDB}
|
||||
{ rtti }
|
||||
procedure write_rtti_data(rt:trttitype);override;
|
||||
@ -704,9 +706,7 @@ interface
|
||||
var
|
||||
aktobjectdef : tobjectdef; { used for private functions check !! }
|
||||
{$ifdef GDB}
|
||||
{$ifdef EXTDEBUG}
|
||||
writing_def_stabs : boolean;
|
||||
{$endif EXTDEBUG}
|
||||
{ for STAB debugging }
|
||||
globaltypecount : word;
|
||||
pglobaltypecount : pword;
|
||||
@ -1080,37 +1080,31 @@ implementation
|
||||
|
||||
|
||||
function tstoreddef.numberstring : string;
|
||||
var
|
||||
table : tsymtable;
|
||||
begin
|
||||
{formal def have no type !}
|
||||
if deftype = formaldef then
|
||||
{ Stab must already be written, or we must be busy writing it }
|
||||
if writing_def_stabs and
|
||||
not(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 stab_state=stab_state_unused then
|
||||
stab_state:=stab_state_used;
|
||||
{ Need a new number? }
|
||||
if globalnb=0 then
|
||||
begin
|
||||
numberstring := tstoreddef(voidtype.def).numberstring;
|
||||
exit;
|
||||
end;
|
||||
if (stab_state=stab_state_unused) then
|
||||
begin
|
||||
stab_state:=stab_state_used;
|
||||
if globalnb=0 then
|
||||
begin
|
||||
if (cs_gdb_dbx in aktglobalswitches) and
|
||||
assigned(owner) then
|
||||
globalnb := owner.getnewtypecount
|
||||
else
|
||||
set_globalnb;
|
||||
end;
|
||||
if (cs_gdb_dbx in aktglobalswitches) and
|
||||
assigned(owner) then
|
||||
globalnb := owner.getnewtypecount
|
||||
else
|
||||
set_globalnb;
|
||||
end;
|
||||
if (cs_gdb_dbx in aktglobalswitches) and
|
||||
assigned(typesym) and
|
||||
(ttypesym(typesym).owner.unitid<>0) then
|
||||
result:='('+tostr(ttypesym(typesym).owner.unitid)+','+tostr(tstoreddef(ttypesym(typesym).restype.def).globalnb)+')'
|
||||
else
|
||||
begin
|
||||
if globalnb=0 then
|
||||
internalerror(200403081);
|
||||
result:=tostr(globalnb);
|
||||
end;
|
||||
result:=tostr(globalnb);
|
||||
end;
|
||||
|
||||
|
||||
@ -1123,6 +1117,7 @@ implementation
|
||||
stabchar := 't';
|
||||
if deftype in tagtypes then
|
||||
stabchar := 'Tt';
|
||||
{ Here we maybe generate a type, so we have to use numberstring }
|
||||
st:=stabstr_evaluate('"${sym_name}:$1$2=',[stabchar,numberstring]);
|
||||
reallocmem(st,strlen(ss)+512);
|
||||
su:=stabstr_evaluate('",${N_LSYM},0,${sym_line},0',[]);
|
||||
@ -1138,7 +1133,7 @@ implementation
|
||||
var
|
||||
stab_str : pchar;
|
||||
begin
|
||||
if (stab_state<>stab_state_used) then
|
||||
if (stab_state in [stab_state_writing,stab_state_written]) then
|
||||
exit;
|
||||
If cs_gdb_dbx in aktglobalswitches then
|
||||
begin
|
||||
@ -1446,36 +1441,32 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function tstringdef.numberstring:string;
|
||||
var
|
||||
old_state : tdefstabstatus;
|
||||
procedure tstringdef.concatstabto(asmlist:taasmoutput);
|
||||
begin
|
||||
old_state:=stab_state;
|
||||
result:=inherited numberstring;
|
||||
if (old_state=stab_state_unused) then
|
||||
begin
|
||||
case string_typ of
|
||||
st_shortstring:
|
||||
begin
|
||||
tstoreddef(cchartype.def).numberstring;
|
||||
{$IfNDef GDBknowsstrings}
|
||||
tstoreddef(u8inttype.def).numberstring;
|
||||
{$EndIf}
|
||||
end;
|
||||
st_longstring:
|
||||
begin
|
||||
tstoreddef(cchartype.def).numberstring;
|
||||
{$IfNDef GDBknowsstrings}
|
||||
tstoreddef(u8inttype.def).numberstring;
|
||||
tstoreddef(u32inttype.def).numberstring;
|
||||
{$EndIf}
|
||||
end;
|
||||
st_ansistring:
|
||||
tstoreddef(cchartype.def).numberstring;
|
||||
st_widestring:
|
||||
tstoreddef(cwidechartype.def).numberstring;
|
||||
end;
|
||||
end;
|
||||
if (stab_state in [stab_state_writing,stab_state_written]) then
|
||||
exit;
|
||||
case string_typ of
|
||||
st_shortstring:
|
||||
begin
|
||||
tstoreddef(cchartype.def).concatstabto(asmlist);
|
||||
{$IfNDef GDBknowsstrings}
|
||||
tstoreddef(u8inttype.def).concatstabto(asmlist);
|
||||
{$EndIf}
|
||||
end;
|
||||
st_longstring:
|
||||
begin
|
||||
tstoreddef(cchartype.def).concatstabto(asmlist);
|
||||
{$IfNDef GDBknowsstrings}
|
||||
tstoreddef(u8inttype.def).concatstabto(asmlist);
|
||||
tstoreddef(u32inttype.def).concatstabto(asmlist);
|
||||
{$EndIf}
|
||||
end;
|
||||
st_ansistring:
|
||||
tstoreddef(cchartype.def).concatstabto(asmlist);
|
||||
st_widestring:
|
||||
tstoreddef(cwidechartype.def).concatstabto(asmlist);
|
||||
end;
|
||||
inherited concatstabto(asmlist);
|
||||
end;
|
||||
{$endif GDB}
|
||||
|
||||
@ -1485,16 +1476,16 @@ implementation
|
||||
needs_inittable:=string_typ in [st_ansistring,st_widestring];
|
||||
end;
|
||||
|
||||
function tstringdef.gettypename : string;
|
||||
|
||||
function tstringdef.gettypename : string;
|
||||
const
|
||||
names : array[tstringtype] of string[20] = ('',
|
||||
'ShortString','LongString','AnsiString','WideString');
|
||||
|
||||
begin
|
||||
gettypename:=names[string_typ];
|
||||
end;
|
||||
|
||||
|
||||
procedure tstringdef.write_rtti_data(rt:trttitype);
|
||||
begin
|
||||
case string_typ of
|
||||
@ -1866,26 +1857,65 @@ implementation
|
||||
function torddef.stabstring : pchar;
|
||||
begin
|
||||
case typ of
|
||||
uvoid : stabstring := strpnew(numberstring+';');
|
||||
uvoid :
|
||||
stabstring := strpnew(numberstring+';');
|
||||
{GDB 4.12 for go32 doesn't like boolean as range for 0 to 1 !!!}
|
||||
{$ifdef Use_integer_types_for_boolean}
|
||||
bool8bit,
|
||||
bool16bit,
|
||||
bool32bit : stabstring := stabstr_evaluate('r${numberstring};0;255;',[]);
|
||||
bool8bit,
|
||||
bool16bit,
|
||||
bool32bit :
|
||||
stabstring := stabstr_evaluate('r${numberstring};0;255;',[]);
|
||||
{$else : not Use_integer_types_for_boolean}
|
||||
uchar : stabstring := strpnew('-20;');
|
||||
uwidechar : stabstring := strpnew('-30;');
|
||||
bool8bit : stabstring := strpnew('-21;');
|
||||
bool16bit : stabstring := strpnew('-22;');
|
||||
bool32bit : stabstring := strpnew('-23;');
|
||||
u64bit : stabstring := strpnew('-32;');
|
||||
s64bit : stabstring := strpnew('-31;');
|
||||
uchar :
|
||||
stabstring := strpnew('-20;');
|
||||
uwidechar :
|
||||
stabstring := strpnew('-30;');
|
||||
bool8bit :
|
||||
stabstring := strpnew('-21;');
|
||||
bool16bit :
|
||||
stabstring := strpnew('-22;');
|
||||
bool32bit :
|
||||
stabstring := strpnew('-23;');
|
||||
u64bit :
|
||||
stabstring := strpnew('-32;');
|
||||
s64bit :
|
||||
stabstring := strpnew('-31;');
|
||||
{$endif not Use_integer_types_for_boolean}
|
||||
{u32bit : stabstring := tstoreddef(s32inttype.def).numberstring+';0;-1;'); }
|
||||
else
|
||||
stabstring:=stabstr_evaluate('r$1;$2;$3;',[Tstoreddef(s32inttype.def).numberstring,tostr(longint(low)),tostr(longint(high))]);
|
||||
{u32bit : stabstring := tstoreddef(s32inttype.def).numberstring+';0;-1;'); }
|
||||
else
|
||||
stabstring:=stabstr_evaluate('r$1;$2;$3;',[Tstoreddef(s32inttype.def).numberstring,tostr(longint(low)),tostr(longint(high))]);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure torddef.concatstabto(asmlist:taasmoutput);
|
||||
begin
|
||||
if (stab_state in [stab_state_writing,stab_state_written]) then
|
||||
exit;
|
||||
if not(typ in [uvoid,
|
||||
{$ifdef Use_integer_types_for_boolean}
|
||||
bool8bit,
|
||||
bool16bit,
|
||||
bool32bit
|
||||
{$else : not Use_integer_types_for_boolean}
|
||||
uchar,
|
||||
uwidechar,
|
||||
bool8bit,
|
||||
bool16bit,
|
||||
bool32bit,
|
||||
u64bit,
|
||||
s64bit
|
||||
{$endif not Use_integer_types_for_boolean}
|
||||
]) then
|
||||
begin
|
||||
{ prevent circular calls when bootstrapping s32inttype }
|
||||
if (self<>s32inttype.def) and
|
||||
(Tstoreddef(s32inttype.def).stab_state<>stab_state_written) then
|
||||
Tstoreddef(s32inttype.def).concatstabto(asmlist);
|
||||
end;
|
||||
inherited concatstabto(asmlist);
|
||||
end;
|
||||
|
||||
{$endif GDB}
|
||||
|
||||
|
||||
@ -2041,22 +2071,30 @@ implementation
|
||||
|
||||
{$ifdef GDB}
|
||||
function Tfloatdef.stabstring:Pchar;
|
||||
|
||||
begin
|
||||
case typ of
|
||||
s32real,s64real:
|
||||
{ found this solution in stabsread.c from GDB v4.16 }
|
||||
stabstring:=stabstr_evaluate('r$1;${savesize};0;',[tstoreddef(s32inttype.def).numberstring]);
|
||||
s64currency,s64comp:
|
||||
stabstring:=stabstr_evaluate('r$1;-${savesize};0;',[tstoreddef(s32inttype.def).numberstring]);
|
||||
s80real:
|
||||
{ under dos at least you must give a size of twelve instead of 10 !! }
|
||||
{ this is probably do to the fact that in gcc all is pushed in 4 bytes size }
|
||||
stabstring:=stabstr_evaluate('r$1;12;0;',[tstoreddef(s32inttype.def).numberstring]);
|
||||
else
|
||||
internalerror(10005);
|
||||
begin
|
||||
case typ of
|
||||
s32real,s64real:
|
||||
{ found this solution in stabsread.c from GDB v4.16 }
|
||||
stabstring:=stabstr_evaluate('r$1;${savesize};0;',[tstoreddef(s32inttype.def).numberstring]);
|
||||
s64currency,s64comp:
|
||||
stabstring:=stabstr_evaluate('r$1;-${savesize};0;',[tstoreddef(s32inttype.def).numberstring]);
|
||||
s80real:
|
||||
{ under dos at least you must give a size of twelve instead of 10 !! }
|
||||
{ this is probably do to the fact that in gcc all is pushed in 4 bytes size }
|
||||
stabstring:=stabstr_evaluate('r$1;12;0;',[tstoreddef(s32inttype.def).numberstring]);
|
||||
else
|
||||
internalerror(10005);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure tfloatdef.concatstabto(asmlist:taasmoutput);
|
||||
begin
|
||||
if (stab_state in [stab_state_writing,stab_state_written]) then
|
||||
exit;
|
||||
tstoreddef(s32inttype.def).concatstabto(asmlist);
|
||||
inherited concatstabto(asmlist);
|
||||
end;
|
||||
end;
|
||||
{$endif GDB}
|
||||
|
||||
|
||||
@ -2215,35 +2253,31 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function tfiledef.numberstring:string;
|
||||
var
|
||||
old_state : tdefstabstatus;
|
||||
procedure tfiledef.concatstabto(asmlist:taasmoutput);
|
||||
begin
|
||||
old_state:=stab_state;
|
||||
result:=inherited numberstring;
|
||||
if (old_state=stab_state_unused) then
|
||||
begin
|
||||
{$IfDef GDBknowsfiles}
|
||||
case filetyp of
|
||||
ft_typed :
|
||||
tstoreddef(typedfiletype.def).numberstring;
|
||||
ft_untyped :
|
||||
tstoreddef(voidtype.def).numberstring;
|
||||
ft_text :
|
||||
tstoreddef(cchartype.def).numberstring;
|
||||
end;
|
||||
{$Else}
|
||||
tstoreddef(u32inttype.def).numberstring;
|
||||
tstoreddef(u16inttype.def).numberstring;
|
||||
tstoreddef(u8inttype.def).numberstring;
|
||||
tstoreddef(cchartype.def).numberstring;
|
||||
{$EndIf}
|
||||
end;
|
||||
if (stab_state in [stab_state_writing,stab_state_written]) then
|
||||
exit;
|
||||
{$IfDef GDBknowsfiles}
|
||||
case filetyp of
|
||||
ft_typed :
|
||||
tstoreddef(typedfiletype.def).concatstabto(asmlist);
|
||||
ft_untyped :
|
||||
tstoreddef(voidtype.def).concatstabto(asmlist);
|
||||
ft_text :
|
||||
tstoreddef(cchartype.def).concatstabto(asmlist);
|
||||
end;
|
||||
{$Else}
|
||||
tstoreddef(u32inttype.def).concatstabto(asmlist);
|
||||
tstoreddef(u16inttype.def).concatstabto(asmlist);
|
||||
tstoreddef(u8inttype.def).concatstabto(asmlist);
|
||||
tstoreddef(cchartype.def).concatstabto(asmlist);
|
||||
{$EndIf}
|
||||
inherited concatstabto(asmlist);
|
||||
end;
|
||||
{$endif GDB}
|
||||
|
||||
function tfiledef.gettypename : string;
|
||||
|
||||
function tfiledef.gettypename : string;
|
||||
begin
|
||||
case filetyp of
|
||||
ft_untyped:
|
||||
@ -2328,7 +2362,19 @@ implementation
|
||||
end;
|
||||
|
||||
{$ifdef GDB}
|
||||
procedure tvariantdef.concatstabto(asmlist : taasmoutput);
|
||||
function tvariantdef.stabstring : pchar;
|
||||
begin
|
||||
stabstring:=stabstr_evaluate('formal${numberstring};',[]);
|
||||
end;
|
||||
|
||||
|
||||
function tvariantdef.numberstring:string;
|
||||
begin
|
||||
result:=tstoreddef(voidtype.def).numberstring;
|
||||
end;
|
||||
|
||||
|
||||
procedure tvariantdef.concatstabto(asmlist : taasmoutput);
|
||||
begin
|
||||
{ don't know how to handle this }
|
||||
end;
|
||||
@ -2398,31 +2444,17 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function tpointerdef.numberstring:string;
|
||||
var
|
||||
old_state : tdefstabstatus;
|
||||
begin
|
||||
old_state:=stab_state;
|
||||
result:=inherited numberstring;
|
||||
if (stab_state=stab_state_unused) and
|
||||
assigned(pointertype.def) then
|
||||
tstoreddef(pointertype.def).numberstring;
|
||||
end;
|
||||
|
||||
|
||||
procedure tpointerdef.concatstabto(asmlist : taasmoutput);
|
||||
var st,nb : string;
|
||||
|
||||
begin
|
||||
if (stab_state<>stab_state_used) then
|
||||
if (stab_state in [stab_state_writing,stab_state_written]) then
|
||||
exit;
|
||||
if assigned(pointertype.def) and
|
||||
(pointertype.def.deftype=forwarddef) then
|
||||
exit;
|
||||
|
||||
stab_state:=stab_state_writing;
|
||||
if assigned(pointertype.def) and
|
||||
(pointertype.def.deftype in [recorddef,objectdef]) then
|
||||
|
||||
tstoreddef(pointertype.def).concatstabto(asmlist);
|
||||
|
||||
if (pointertype.def.deftype in [recorddef,objectdef]) then
|
||||
begin
|
||||
if pointertype.def.deftype=objectdef then
|
||||
nb:=tobjectdef(pointertype.def).classnumberstring
|
||||
@ -2591,15 +2623,12 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function tsetdef.numberstring:string;
|
||||
var
|
||||
old_state : tdefstabstatus;
|
||||
procedure tsetdef.concatstabto(asmlist:taasmoutput);
|
||||
begin
|
||||
old_state:=stab_state;
|
||||
result:=inherited numberstring;
|
||||
if (old_state=stab_state_unused) and
|
||||
assigned(elementtype.def) then
|
||||
tstoreddef(elementtype.def).numberstring;
|
||||
if (stab_state in [stab_state_writing,stab_state_written]) then
|
||||
exit;
|
||||
tstoreddef(elementtype.def).concatstabto(asmlist);
|
||||
inherited concatstabto(asmlist);
|
||||
end;
|
||||
{$endif GDB}
|
||||
|
||||
@ -2693,6 +2722,12 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function tformaldef.numberstring:string;
|
||||
begin
|
||||
result:=tstoreddef(voidtype.def).numberstring;
|
||||
end;
|
||||
|
||||
|
||||
procedure tformaldef.concatstabto(asmlist : taasmoutput);
|
||||
begin
|
||||
{ formaldef can't be stab'ed !}
|
||||
@ -2787,17 +2822,13 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function tarraydef.numberstring:string;
|
||||
var
|
||||
old_state : tdefstabstatus;
|
||||
procedure tarraydef.concatstabto(asmlist:taasmoutput);
|
||||
begin
|
||||
old_state:=stab_state;
|
||||
result:=inherited numberstring;
|
||||
if (old_state=stab_state_unused) then
|
||||
begin
|
||||
tstoreddef(rangetype.def).numberstring;
|
||||
tstoreddef(_elementtype.def).numberstring;
|
||||
end;
|
||||
if (stab_state in [stab_state_writing,stab_state_written]) then
|
||||
exit;
|
||||
tstoreddef(rangetype.def).concatstabto(asmlist);
|
||||
tstoreddef(_elementtype.def).concatstabto(asmlist);
|
||||
inherited concatstabto(asmlist);
|
||||
end;
|
||||
{$endif GDB}
|
||||
|
||||
@ -2993,15 +3024,13 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function tabstractrecorddef.numberstring:string;
|
||||
var
|
||||
old_state : tdefstabstatus;
|
||||
procedure tabstractrecorddef.field_concatstabto(p:Tnamedindexitem;arg:pointer);
|
||||
begin
|
||||
old_state:=stab_state;
|
||||
result:=inherited numberstring;
|
||||
if old_state=stab_state_unused then
|
||||
tstoredsymtable(symtable).numberstring;
|
||||
if (Tsym(p).typ=varsym) and not (sp_static in Tsym(p).symoptions) then
|
||||
tstoreddef(tvarsym(p).vartype.def).concatstabto(taasmoutput(arg));
|
||||
end;
|
||||
|
||||
|
||||
{$endif GDB}
|
||||
|
||||
|
||||
@ -3138,21 +3167,29 @@ implementation
|
||||
|
||||
{$ifdef GDB}
|
||||
function trecorddef.stabstring : pchar;
|
||||
var
|
||||
state:Trecord_stabgen_state;
|
||||
begin
|
||||
getmem(state.stabstring,memsizeinc);
|
||||
state.staballoc:=memsizeinc;
|
||||
strpcopy(state.stabstring,'s'+tostr(size));
|
||||
state.recoffset:=0;
|
||||
state.stabsize:=strlen(state.stabstring);
|
||||
symtable.foreach({$ifdef FPCPROCVAR}@{$endif}field_addname,@state);
|
||||
state.stabstring[state.stabsize]:=';';
|
||||
state.stabstring[state.stabsize+1]:=#0;
|
||||
reallocmem(state.stabstring,state.stabsize+2);
|
||||
stabstring:=state.stabstring;
|
||||
end;
|
||||
|
||||
var state:Trecord_stabgen_state;
|
||||
|
||||
begin
|
||||
getmem(state.stabstring,memsizeinc);
|
||||
state.staballoc:=memsizeinc;
|
||||
strpcopy(state.stabstring,'s'+tostr(size));
|
||||
state.recoffset:=0;
|
||||
state.stabsize:=strlen(state.stabstring);
|
||||
symtable.foreach({$ifdef FPCPROCVAR}@{$endif}field_addname,@state);
|
||||
state.stabstring[state.stabsize]:=';';
|
||||
state.stabstring[state.stabsize+1]:=#0;
|
||||
reallocmem(state.stabstring,state.stabsize+2);
|
||||
stabstring:=state.stabstring;
|
||||
end;
|
||||
procedure trecorddef.concatstabto(asmlist:taasmoutput);
|
||||
begin
|
||||
if (stab_state in [stab_state_writing,stab_state_written]) then
|
||||
exit;
|
||||
symtable.foreach({$ifdef FPCPROCVAR}@{$endif}field_concatstabto,asmlist);
|
||||
inherited concatstabto(asmlist);
|
||||
end;
|
||||
{$endif GDB}
|
||||
|
||||
|
||||
@ -3553,26 +3590,6 @@ implementation
|
||||
begin
|
||||
stabstring := strpnew('abstractproc'+numberstring+';');
|
||||
end;
|
||||
|
||||
|
||||
function tabstractprocdef.numberstring:string;
|
||||
var
|
||||
old_state : tdefstabstatus;
|
||||
begin
|
||||
old_state:=stab_state;
|
||||
result:=inherited numberstring;
|
||||
if (old_state=stab_state_unused) then
|
||||
tstoreddef(rettype.def).numberstring;
|
||||
end;
|
||||
|
||||
|
||||
procedure tabstractprocdef.concatstabto(asmlist : taasmoutput);
|
||||
begin
|
||||
{ released procdef? }
|
||||
if not assigned(parast) then
|
||||
exit;
|
||||
inherited concatstabto(asmlist);
|
||||
end;
|
||||
{$endif GDB}
|
||||
|
||||
|
||||
@ -4032,6 +4049,14 @@ implementation
|
||||
end;
|
||||
|
||||
{$ifdef GDB}
|
||||
function tprocdef.numberstring : string;
|
||||
begin
|
||||
{ procdefs are always available }
|
||||
stab_state:=stab_state_written;
|
||||
result:=inherited numberstring;
|
||||
end;
|
||||
|
||||
|
||||
function tprocdef.stabstring: pchar;
|
||||
Var
|
||||
RType : Char;
|
||||
@ -4067,30 +4092,6 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function tprocdef.numberstring:string;
|
||||
var
|
||||
old_state : tdefstabstatus;
|
||||
begin
|
||||
old_state:=stab_state;
|
||||
result:=inherited numberstring;
|
||||
if (old_state=stab_state_unused) then
|
||||
begin
|
||||
if assigned(_class) then
|
||||
_class.numberstring;
|
||||
tstoreddef(rettype.def).numberstring;
|
||||
if not(po_external in procoptions) then
|
||||
begin
|
||||
tstoredsymtable(parast).numberstring;
|
||||
{ local type defs and vars should not be written
|
||||
inside the main proc stab }
|
||||
if assigned(localst) and
|
||||
(localst.symtablelevel>main_program_level) then
|
||||
tstoredsymtable(localst).numberstring;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure tprocdef.concatstabto(asmlist : taasmoutput);
|
||||
begin
|
||||
{ released procdef? }
|
||||
@ -4098,8 +4099,9 @@ implementation
|
||||
exit;
|
||||
if (proccalloption=pocall_internproc) then
|
||||
exit;
|
||||
{ assign a number for this def }
|
||||
{ be sure to have a number assigned for this def }
|
||||
numberstring;
|
||||
{ write stabs }
|
||||
stab_state:=stab_state_writing;
|
||||
asmList.concat(Tai_stabs.Create(stabstring));
|
||||
if not(po_external in procoptions) then
|
||||
@ -4498,19 +4500,28 @@ implementation
|
||||
i := 0;
|
||||
while assigned(param) do
|
||||
begin
|
||||
inc(i);
|
||||
if param^.paratyp = vs_value then vartyp := '1' else vartyp := '0';
|
||||
{Here we have lost the parameter names !!}
|
||||
pst := strpnew('p'+tostr(i)+':'+param^.paratype.def.numberstring+','+vartyp+';');
|
||||
strcat(nss,pst);
|
||||
strdispose(pst);
|
||||
param := param^.next;
|
||||
inc(i);
|
||||
if param^.paratyp = vs_value then vartyp := '1' else vartyp := '0';
|
||||
{Here we have lost the parameter names !!}
|
||||
pst := strpnew('p'+tostr(i)+':'+param^.paratype.def.numberstring+','+vartyp+';');
|
||||
strcat(nss,pst);
|
||||
strdispose(pst);
|
||||
param := param^.next;
|
||||
end;
|
||||
{$endif}
|
||||
{strpcopy(strend(nss),';');}
|
||||
stabstring := strnew(nss);
|
||||
freemem(nss,1024);
|
||||
end;
|
||||
|
||||
|
||||
procedure tprocvardef.concatstabto(asmlist : taasmoutput);
|
||||
begin
|
||||
if (stab_state in [stab_state_writing,stab_state_written]) then
|
||||
exit;
|
||||
tstoreddef(rettype.def).concatstabto(asmlist);
|
||||
inherited concatstabto(asmlist);
|
||||
end;
|
||||
{$endif GDB}
|
||||
|
||||
|
||||
@ -5013,7 +5024,7 @@ implementation
|
||||
|
||||
|
||||
{$ifdef GDB}
|
||||
procedure tobjectdef.addprocname(p :tnamedindexitem;arg:pointer);
|
||||
procedure tobjectdef.proc_addname(p :tnamedindexitem;arg:pointer);
|
||||
var virtualind,argnames : string;
|
||||
newrec : pchar;
|
||||
pd : tprocdef;
|
||||
@ -5103,6 +5114,18 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure tobjectdef.proc_concatstabto(p :tnamedindexitem;arg:pointer);
|
||||
var
|
||||
pd : tprocdef;
|
||||
begin
|
||||
if tsym(p).typ = procsym then
|
||||
begin
|
||||
pd := tprocsym(p).first_procdef;
|
||||
tstoreddef(pd.rettype.def).concatstabto(taasmoutput(arg));
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function tobjectdef.stabstring : pchar;
|
||||
var anc : tobjectdef;
|
||||
state:Trecord_stabgen_state;
|
||||
@ -5130,7 +5153,7 @@ implementation
|
||||
strpcopy(state.stabstring+state.stabsize,ts);
|
||||
inc(state.stabsize,length(ts));
|
||||
end;
|
||||
symtable.foreach({$ifdef FPCPROCVAR}@{$endif}addprocname,@state);
|
||||
symtable.foreach({$ifdef FPCPROCVAR}@{$endif}proc_addname,@state);
|
||||
if (oo_has_vmt in objectoptions) then
|
||||
begin
|
||||
anc := self;
|
||||
@ -5179,29 +5202,6 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function tobjectdef.numberstring : string;
|
||||
var
|
||||
old_state : tdefstabstatus;
|
||||
anc : tobjectdef;
|
||||
begin
|
||||
old_state:=stab_state;
|
||||
result:=inherited numberstring;
|
||||
if (old_state=stab_state_unused) then
|
||||
begin
|
||||
tstoreddef(vmtarraytype.def).numberstring;
|
||||
tstoredsymtable(symtable).numberstring;
|
||||
{ parents }
|
||||
anc:=self;
|
||||
while assigned(anc.childof) and
|
||||
(oo_has_vmt in anc.childof.objectoptions) do
|
||||
begin
|
||||
anc:=anc.childof;
|
||||
anc.numberstring;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function tobjectdef.allstabstring : pchar;
|
||||
var
|
||||
stabchar : string[2];
|
||||
@ -5239,9 +5239,23 @@ implementation
|
||||
var
|
||||
oldtypesym : tsym;
|
||||
stab_str : pchar;
|
||||
anc : tobjectdef;
|
||||
begin
|
||||
if (stab_state<>stab_state_used) then
|
||||
if (stab_state in [stab_state_writing,stab_state_written]) then
|
||||
exit;
|
||||
stab_state:=stab_state_writing;
|
||||
tstoreddef(vmtarraytype.def).concatstabto(asmlist);
|
||||
symtable.foreach({$ifdef FPCPROCVAR}@{$endif}field_concatstabto,asmlist);
|
||||
symtable.foreach({$ifdef FPCPROCVAR}@{$endif}proc_concatstabto,asmlist);
|
||||
{ parents }
|
||||
anc:=self;
|
||||
while assigned(anc.childof) and
|
||||
(oo_has_vmt in anc.childof.objectoptions) do
|
||||
begin
|
||||
anc:=anc.childof;
|
||||
anc.concatstabto(asmlist);
|
||||
end;
|
||||
stab_state:=stab_state_used;
|
||||
if objecttype=odt_class then
|
||||
begin
|
||||
{ Write the record class itself }
|
||||
@ -6075,7 +6089,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.226 2004-03-08 22:07:47 peter
|
||||
Revision 1.227 2004-03-09 20:45:04 peter
|
||||
* more stabs updates
|
||||
|
||||
Revision 1.226 2004/03/08 22:07:47 peter
|
||||
* stabs updates to write stabs for def for all implictly used
|
||||
units
|
||||
|
||||
|
@ -347,9 +347,6 @@ implementation
|
||||
|
||||
|
||||
constructor tstoredsym.loadsym(ppufile:tcompilerppufile);
|
||||
var
|
||||
s : string;
|
||||
nr : word;
|
||||
begin
|
||||
inherited loadsym(ppufile);
|
||||
_mangledname:=nil;
|
||||
@ -1014,6 +1011,7 @@ implementation
|
||||
function tprocsym.stabstring : pchar;
|
||||
begin
|
||||
internalerror(200111171);
|
||||
result:=nil;
|
||||
end;
|
||||
{$endif GDB}
|
||||
|
||||
@ -2241,7 +2239,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.165 2004-03-08 22:07:47 peter
|
||||
Revision 1.166 2004-03-09 20:45:04 peter
|
||||
* more stabs updates
|
||||
|
||||
Revision 1.165 2004/03/08 22:07:47 peter
|
||||
* stabs updates to write stabs for def for all implictly used
|
||||
units
|
||||
|
||||
|
@ -79,7 +79,6 @@ interface
|
||||
function needs_init_final : boolean;
|
||||
procedure unchain_overloaded;
|
||||
{$ifdef GDB}
|
||||
procedure numberstring;
|
||||
procedure concatstabto(asmlist : taasmoutput);virtual;
|
||||
function getnewtypecount : word; override;
|
||||
{$endif GDB}
|
||||
@ -837,24 +836,6 @@ implementation
|
||||
|
||||
|
||||
{$ifdef GDB}
|
||||
procedure tstoredsymtable.numberstring;
|
||||
var
|
||||
p : tsym;
|
||||
begin
|
||||
p:=tsym(symindex.first);
|
||||
while assigned(p) do
|
||||
begin
|
||||
case tsym(p).typ of
|
||||
varsym :
|
||||
tstoreddef(tvarsym(p).vartype.def).numberstring;
|
||||
procsym :
|
||||
tprocsym(p).first_procdef.numberstring;
|
||||
end;
|
||||
p:=tsym(p.indexnext);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure tstoredsymtable.concatstabto(asmlist : taasmoutput);
|
||||
var
|
||||
stabstr : Pchar;
|
||||
@ -1330,6 +1311,7 @@ implementation
|
||||
{$ifdef GDB}
|
||||
procedure tabstractunitsymtable.concattypestabto(asmlist : taasmoutput);
|
||||
var
|
||||
old_writing_def_stabs : boolean;
|
||||
prev_dbx_count : plongint;
|
||||
p : tstoreddef;
|
||||
begin
|
||||
@ -1359,9 +1341,8 @@ implementation
|
||||
end;
|
||||
end;
|
||||
|
||||
{$ifdef EXTDEBUG}
|
||||
old_writing_def_stabs:=writing_def_stabs;
|
||||
writing_def_stabs:=true;
|
||||
{$endif EXTDEBUG}
|
||||
p:=tstoreddef(defindex.first);
|
||||
while assigned(p) do
|
||||
begin
|
||||
@ -1369,9 +1350,7 @@ implementation
|
||||
p.concatstabto(asmlist);
|
||||
p:=tstoreddef(p.indexnext);
|
||||
end;
|
||||
{$ifdef EXTDEBUG}
|
||||
writing_def_stabs:=false;
|
||||
{$endif EXTDEBUG}
|
||||
writing_def_stabs:=old_writing_def_stabs;
|
||||
|
||||
if cs_gdb_dbx in aktglobalswitches then
|
||||
begin
|
||||
@ -2317,7 +2296,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.142 2004-03-08 22:07:47 peter
|
||||
Revision 1.143 2004-03-09 20:45:04 peter
|
||||
* more stabs updates
|
||||
|
||||
Revision 1.142 2004/03/08 22:07:47 peter
|
||||
* stabs updates to write stabs for def for all implictly used
|
||||
units
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user