paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 22:09:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

* stabs updates to write stabs for def for all implictly used

Browse Source 
units
This commit is contained in:
peter 2004-03-08 22:07:46 +00:00
parent 7ba73ec7b0
commit abbd54f334
10 changed files with 724 additions and 774 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
compiler/fmodule.pas
View File

@ -87,6 +87,8 @@ interface
do_compile, { need to compile the sources } do_compile, { need to compile the sources }
sources_avail, { if all sources are reachable } sources_avail, { if all sources are reachable }
interface_compiled, { if the interface section has been parsed/compiled/loaded } interface_compiled, { if the interface section has been parsed/compiled/loaded }
is_stab_written,
is_reset,
is_unit, is_unit,
in_interface, { processing the implementation part? } in_interface, { processing the implementation part? }
in_global : boolean; { allow global settings } in_global : boolean; { allow global settings }
@ -142,12 +144,10 @@ interface
end; end;
tused_unit = class(tlinkedlistitem) tused_unit = class(tlinkedlistitem)
unitid : longint;
checksum, checksum,
interface_checksum : cardinal; interface_checksum : cardinal;
in_uses, in_uses,
in_interface, in_interface : boolean;
is_stab_written : boolean;
u : tmodule; u : tmodule;
unitsym : tunitsym; unitsym : tunitsym;
constructor create(_u : tmodule;intface,inuses:boolean;usym:tunitsym); constructor create(_u : tmodule;intface,inuses:boolean;usym:tunitsym);
@ -314,8 +314,6 @@ implementation
u:=_u; u:=_u;
in_interface:=intface; in_interface:=intface;
in_uses:=inuses; in_uses:=inuses;
is_stab_written:=false;
unitid:=0;
unitsym:=usym; unitsym:=usym;
if _u.state=ms_compiled then if _u.state=ms_compiled then
begin begin
@ -396,6 +394,8 @@ implementation
in_global:=true; in_global:=true;
is_unit:=_is_unit; is_unit:=_is_unit;
islibrary:=false; islibrary:=false;
is_stab_written:=false;
is_reset:=false;
uses_imports:=false; uses_imports:=false;
imports:=TLinkedList.Create; imports:=TLinkedList.Create;
_exports:=TLinkedList.Create; _exports:=TLinkedList.Create;
@ -563,6 +563,8 @@ implementation
interface_compiled:=false; interface_compiled:=false;
in_interface:=true; in_interface:=true;
in_global:=true; in_global:=true;
is_stab_written:=false;
is_reset:=false;
crc:=0; crc:=0;
interface_crc:=0; interface_crc:=0;
flags:=0; flags:=0;
@ -692,7 +694,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.43 2003-12-08 22:33:43 peter Revision 1.44 2004-03-08 22:07:46 peter
* stabs updates to write stabs for def for all implictly used
units
Revision 1.43 2003/12/08 22:33:43 peter
* don't allow duplicate uses * don't allow duplicate uses
* fix wrong circular dependency * fix wrong circular dependency

12
compiler/gdb.pas
View File

@ -84,6 +84,8 @@ Const
implementation implementation
uses fmodule;
{ to use N_EXCL we have to count the character in the stabs for { to use N_EXCL we have to count the character in the stabs for
N_BINCL to N_EINCL N_BINCL to N_EINCL
Code comes from stabs.c for ld Code comes from stabs.c for ld
@ -179,6 +181,10 @@ N_BINCL to N_EINCL
begin begin
inherited create; inherited create;
typ:=ait_stabs; typ:=ait_stabs;
if current_module.modulename^='NCNV' then
current_module:=current_module;
str:=_str; str:=_str;
if do_count_dbx then if do_count_dbx then
begin begin
@ -233,7 +239,11 @@ end.
{ {
$Log$ $Log$
Revision 1.17 2003-10-22 15:22:33 peter Revision 1.18 2004-03-08 22:07:46 peter
* stabs updates to write stabs for def for all implictly used
units
Revision 1.17 2003/10/22 15:22:33 peter
* fixed unitsym-globalsymtable relation so the uses of a unit * fixed unitsym-globalsymtable relation so the uses of a unit
is counted correctly is counted correctly

8
compiler/nobj.pas
View File

@ -1265,7 +1265,7 @@ implementation
do_count_dbx:=true; do_count_dbx:=true;
if assigned(_class.owner) and assigned(_class.owner.name) then if assigned(_class.owner) and assigned(_class.owner.name) then
dataSegment.concat(Tai_stabs.Create(strpnew('"vmt_'+_class.owner.name^+_class.name+':S'+ dataSegment.concat(Tai_stabs.Create(strpnew('"vmt_'+_class.owner.name^+_class.name+':S'+
typeglobalnumber('__vtbl_ptr_type')+'",'+tostr(N_STSYM)+',0,0,'+_class.vmt_mangledname))); tstoreddef(vmttype.def).numberstring+'",'+tostr(N_STSYM)+',0,0,'+_class.vmt_mangledname)));
end; end;
{$endif GDB} {$endif GDB}
dataSegment.concat(tai_align.create(const_align(POINTER_SIZE))); dataSegment.concat(tai_align.create(const_align(POINTER_SIZE)));
@ -1380,7 +1380,11 @@ initialization
end. end.
{ {
$Log$ $Log$
Revision 1.66 2004-03-04 17:23:50 peter Revision 1.67 2004-03-08 22:07:46 peter
* stabs updates to write stabs for def for all implictly used
units
Revision 1.66 2004/03/04 17:23:50 peter
* fix compare of parameters, they need to match exact * fix compare of parameters, they need to match exact
Revision 1.65 2004/03/02 00:36:33 olle Revision 1.65 2004/03/02 00:36:33 olle

14
compiler/pdecl.pas
View File

@ -286,9 +286,9 @@ implementation
again : boolean; again : boolean;
srsym : tsym; srsym : tsym;
srsymtable : tsymtable; srsymtable : tsymtable;
{$ifdef gdb} {$ifdef gdb_notused}
stab_str:Pchar; stab_str:Pchar;
{$endif} {$endif gdb_notused}
begin begin
{ Check only typesyms or record/object fields } { Check only typesyms or record/object fields }
@ -342,7 +342,7 @@ implementation
tpointerdef(pd).pointertype.setsym(srsym); tpointerdef(pd).pointertype.setsym(srsym);
{ avoid wrong unused warnings web bug 801 PM } { avoid wrong unused warnings web bug 801 PM }
inc(ttypesym(srsym).refs); inc(ttypesym(srsym).refs);
{$ifdef GDB} {$ifdef GDB_UNUSED}
if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) and if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) and
(tsym(p).owner.symtabletype in [globalsymtable,staticsymtable]) then (tsym(p).owner.symtabletype in [globalsymtable,staticsymtable]) then
begin begin
@ -362,7 +362,7 @@ implementation
end; end;
end; end;
end; end;
{$endif GDB} {$endif GDB_UNUSED}
{ we need a class type for classrefdef } { we need a class type for classrefdef }
if (pd.deftype=classrefdef) and if (pd.deftype=classrefdef) and
not(is_class(ttypesym(srsym).restype.def)) then not(is_class(ttypesym(srsym).restype.def)) then
@ -675,7 +675,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.82 2004-02-20 19:49:21 daniel Revision 1.83 2004-03-08 22:07:47 peter
* stabs updates to write stabs for def for all implictly used
units
Revision 1.82 2004/02/20 19:49:21 daniel
* Message system uses open arrays internally * Message system uses open arrays internally
* Bugfix for string handling in array constructor node * Bugfix for string handling in array constructor node
* Micro code reductions in pdecl.pas * Micro code reductions in pdecl.pas

181
compiler/pmodules.pas
View File

@ -24,8 +24,6 @@ unit pmodules;
{$i fpcdefs.inc} {$i fpcdefs.inc}
{$define New_GDB}
interface interface
procedure proc_unit; procedure proc_unit;
@ -571,16 +569,6 @@ implementation
symtablestack:=defaultsymtablestack; symtablestack:=defaultsymtablestack;
while assigned(pu) do while assigned(pu) do
begin begin
{$IfDef GDB}
if (cs_debuginfo in aktmoduleswitches) and
(cs_gdb_dbx in aktglobalswitches) and
not pu.is_stab_written then
begin
tglobalsymtable(pu.u.globalsymtable).concattypestabto(debuglist);
pu.is_stab_written:=true;
pu.unitid:=tsymtable(pu.u.globalsymtable).unitid;
end;
{$EndIf GDB}
if pu.in_uses then if pu.in_uses then
begin begin
{ Reinsert in symtablestack } { Reinsert in symtablestack }
@ -607,41 +595,68 @@ implementation
end; end;
procedure write_gdb_info;
{$IfDef GDB} {$IfDef GDB}
procedure write_gdb_info;
procedure reset_unit_type_info;
var var
hp : tused_unit; 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(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;
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;
end;
pu:=tused_unit(pu.next);
end;
end;
begin begin
if not (cs_debuginfo in aktmoduleswitches) then if not (cs_debuginfo in aktmoduleswitches) then
exit; exit;
{ now insert the units in the symtablestack } { write type info for dependent units }
hp:=tused_unit(current_module.used_units.first); reset_unit_type_info;
while assigned(hp) do { first write the types from this unit }
begin if assigned(current_module.globalsymtable) then
if (cs_debuginfo in aktmoduleswitches) and
not hp.is_stab_written then
begin
tglobalsymtable(hp.u.globalsymtable).concattypestabto(debuglist);
hp.is_stab_written:=true;
hp.unitid:=tsymtable(hp.u.globalsymtable).unitid;
end;
hp:=tused_unit(hp.next);
end;
if (not current_module.in_interface) and
assigned(current_module.localsymtable) then
begin
{ all types }
tstaticsymtable(current_module.localsymtable).concattypestabto(debuglist);
{ and all local symbols}
tstaticsymtable(current_module.localsymtable).concatstabto(debuglist);
end
else if assigned(current_module.globalsymtable) then
begin begin
{ all types } { all types }
tglobalsymtable(current_module.globalsymtable).concattypestabto(debuglist); tglobalsymtable(current_module.globalsymtable).concattypestabto(debuglist);
{ and all local symbols} { and all local symbols}
tglobalsymtable(current_module.globalsymtable).concatstabto(debuglist); tglobalsymtable(current_module.globalsymtable).concatstabto(debuglist);
end; end;
if assigned(current_module.localsymtable) then
begin
{ all types }
tstaticsymtable(current_module.localsymtable).concattypestabto(debuglist);
{ 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 if (cs_gdb_dbx in aktglobalswitches) then
begin begin
debugList.concat(tai_comment.Create(strpnew('EINCL of global '+ debugList.concat(tai_comment.Create(strpnew('EINCL of global '+
@ -654,14 +669,47 @@ implementation
dbx_counter:=tglobalsymtable(current_module.globalsymtable).prev_dbx_counter; dbx_counter:=tglobalsymtable(current_module.globalsymtable).prev_dbx_counter;
do_count_dbx:=false; do_count_dbx:=false;
end; end;
end;
{$Else GDB}
begin
end; end;
{$EndIf GDB} {$EndIf GDB}
procedure reset_all_defs;
procedure reset_used_unit_defs(hp:tmodule);
var
hp2 : tmodule;
pu : tused_unit;
begin
pu:=tused_unit(hp.used_units.first);
while assigned(pu) do
begin
if not pu.u.is_reset then
begin
{ prevent infinte loop for circular dependencies }
pu.u.is_reset:=true;
if assigned(pu.u.globalsymtable) then
begin
tglobalsymtable(pu.u.globalsymtable).reset_all_defs;
reset_used_unit_defs(pu.u);
end;
end;
pu:=tused_unit(pu.next);
end;
end;
var
hp2 : tmodule;
begin
hp2:=tmodule(loaded_units.first);
while assigned(hp2) do
begin
hp2.is_reset:=false;
hp2:=tmodule(hp2.next);
end;
reset_used_unit_defs(current_module);
end;
procedure parse_implementation_uses; procedure parse_implementation_uses;
begin begin
if token=_USES then if token=_USES then
@ -806,9 +854,6 @@ implementation
main_file: tinputfile; main_file: tinputfile;
st : tsymtable; st : tsymtable;
unitst : tglobalsymtable; unitst : tglobalsymtable;
{$ifdef GDB}
pu : tused_unit;
{$endif GDB}
store_crc,store_interface_crc : cardinal; store_crc,store_interface_crc : cardinal;
s1,s2 : ^string; {Saves stack space} s1,s2 : ^string; {Saves stack space}
force_init_final : boolean; force_init_final : boolean;
@ -943,10 +988,6 @@ implementation
exit; exit;
end; end;
{$ifdef New_GDB}
write_gdb_info;
{$endIf Def New_GDB}
{ Our interface is compiled, generate CRC and switch to implementation } { Our interface is compiled, generate CRC and switch to implementation }
if not(cs_compilesystem in aktmoduleswitches) and if not(cs_compilesystem in aktmoduleswitches) and
(Errorcount=0) then (Errorcount=0) then
@ -1074,29 +1115,9 @@ implementation
end; end;
{$ifdef GDB} {$ifdef GDB}
{ add all used definitions even for implementation} write_gdb_info;
if (cs_debuginfo in aktmoduleswitches) then
begin
{$IfnDef New_GDB}
if assigned(current_module.globalsymtable) then
begin
{ all types }
tglobalsymtable(current_module.globalsymtable).concattypestabto(debuglist);
{ and all local symbols}
tglobalsymtable(current_module.globalsymtable).concatstabto(debuglist);
end;
{ all local types }
tglobalsymtable(st)^.concattypestabto(debuglist);
{ and all local symbols}
st^.concatstabto(debuglist);
{$else New_GDB}
write_gdb_info;
{$endIf Def New_GDB}
end;
{$endif GDB} {$endif GDB}
reset_all_defs;
if (Errorcount=0) then if (Errorcount=0) then
begin begin
{ tests, if all (interface) forwards are resolved } { tests, if all (interface) forwards are resolved }
@ -1107,10 +1128,6 @@ implementation
tstoredsymtable(symtablestack).unchain_overloaded; tstoredsymtable(symtablestack).unchain_overloaded;
end; end;
{$ifdef GDB}
tglobalsymtable(symtablestack).is_stab_written:=false;
{$endif GDB}
{ leave when we got an error } { leave when we got an error }
if (Errorcount>0) and not status.skip_error then if (Errorcount>0) and not status.skip_error then
begin begin
@ -1132,15 +1149,6 @@ implementation
if cs_local_browser in aktmoduleswitches then if cs_local_browser in aktmoduleswitches then
current_module.localsymtable:=refsymtable; current_module.localsymtable:=refsymtable;
{$ifdef GDB}
pu:=tused_unit(usedunits.first);
while assigned(pu) do
begin
if assigned(pu.u.globalsymtable) then
tglobalsymtable(pu.u.globalsymtable).is_stab_written:=false;
pu:=tused_unit(pu.next);
end;
{$endif GDB}
if is_assembler_generated then if is_assembler_generated then
begin begin
@ -1355,9 +1363,10 @@ implementation
{ consume the last point } { consume the last point }
consume(_POINT); consume(_POINT);
{$ifdef New_GDB} {$ifdef GDB}
write_gdb_info; write_gdb_info;
{$endIf Def New_GDB} {$endif GDB}
{ leave when we got an error } { leave when we got an error }
if (Errorcount>0) and not status.skip_error then if (Errorcount>0) and not status.skip_error then
begin begin
@ -1439,7 +1448,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.142 2004-03-02 17:32:12 florian Revision 1.143 2004-03-08 22:07:47 peter
* stabs updates to write stabs for def for all implictly used
units
Revision 1.142 2004/03/02 17:32:12 florian
* make cycle fixed * make cycle fixed
+ pic support for darwin + pic support for darwin
+ support of importing vars from shared libs on darwin implemented + support of importing vars from shared libs on darwin implemented

11
compiler/psystem.pas
View File

@ -121,9 +121,6 @@ implementation
end; end;
var var
{ several defs to simulate more or less C++ objects for GDB }
vmttype,
vmtarraytype : ttype;
hrecst : trecordsymtable; hrecst : trecordsymtable;
begin begin
{$ifdef cpufpemu} {$ifdef cpufpemu}
@ -254,6 +251,8 @@ implementation
globaldef('void_farpointer',voidfarpointertype); globaldef('void_farpointer',voidfarpointertype);
globaldef('file',cfiletype); globaldef('file',cfiletype);
globaldef('pvmt',pvmttype); globaldef('pvmt',pvmttype);
globaldef('vtblarray',vmtarraytype);
globaldef('__vtbl_ptr_type',vmttype);
globaldef('variant',cvarianttype); globaldef('variant',cvarianttype);
globaldef('olevariant',colevarianttype); globaldef('olevariant',colevarianttype);
globaldef('methodpointer',methodpointertype); globaldef('methodpointer',methodpointertype);
@ -489,7 +488,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.65 2004-03-02 01:13:01 olle Revision 1.66 2004-03-08 22:07:47 peter
* stabs updates to write stabs for def for all implictly used
units
Revision 1.65 2004/03/02 01:13:01 olle
* undone last commit * undone last commit
Revision 1.63 2004/02/26 16:16:38 peter Revision 1.63 2004/02/26 16:16:38 peter

14
compiler/symconst.pas
View File

@ -345,9 +345,11 @@ type
{$ifdef GDB} {$ifdef GDB}
type type
tdefstabstatus = ( tdefstabstatus = (
not_written, stab_state_unused,
being_written, stab_state_used,
written); stab_state_writing,
stab_state_written
);
const const
tagtypes : Set of tdeftype = tagtypes : Set of tdeftype =
@ -402,7 +404,11 @@ initialization
end. end.
{ {
$Log$ $Log$
Revision 1.76 2004-02-27 10:21:05 florian Revision 1.77 2004-03-08 22:07:47 peter
* stabs updates to write stabs for def for all implictly used
units
Revision 1.76 2004/02/27 10:21:05 florian
* top_symbol killed * top_symbol killed
+ refaddr to treference added + refaddr to treference added
+ refsymbol to treference added + refsymbol to treference added

1041
compiler/symdef.pas
View File

File diff suppressed because it is too large Load Diff

15
compiler/symsym.pas
View File

@ -132,9 +132,6 @@ interface
ttypesym = class(Tsym) ttypesym = class(Tsym)
restype : ttype; restype : ttype;
{$ifdef GDB}
isusedinstab : boolean;
{$endif GDB}
constructor create(const n : string;const tt : ttype); constructor create(const n : string;const tt : ttype);
constructor ppuload(ppufile:tcompilerppufile); constructor ppuload(ppufile:tcompilerppufile);
procedure ppuwrite(ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override;
@ -2064,9 +2061,6 @@ implementation
inherited create(n); inherited create(n);
typ:=typesym; typ:=typesym;
restype:=tt; restype:=tt;
{$ifdef GDB}
isusedinstab := false;
{$endif GDB}
{ register the typesym for the definition } { register the typesym for the definition }
if assigned(restype.def) and if assigned(restype.def) and
(restype.def.deftype<>errordef) and (restype.def.deftype<>errordef) and
@ -2079,9 +2073,6 @@ implementation
begin begin
inherited loadsym(ppufile); inherited loadsym(ppufile);
typ:=typesym; typ:=typesym;
{$ifdef GDB}
isusedinstab := false;
{$endif GDB}
ppufile.gettype(restype); ppufile.gettype(restype);
end; end;
@ -2250,7 +2241,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.164 2004-03-02 18:12:31 florian Revision 1.165 2004-03-08 22:07:47 peter
* stabs updates to write stabs for def for all implictly used
units
Revision 1.164 2004/03/02 18:12:31 florian
* for vars with is_dll_var the mangledname is written to the ppu as well * for vars with is_dll_var the mangledname is written to the ppu as well
Revision 1.163 2004/03/02 17:32:12 florian Revision 1.163 2004/03/02 17:32:12 florian

184
compiler/symtable.pas
View File

@ -53,12 +53,6 @@ interface
procedure varsymbolused(p : TNamedIndexItem;arg:pointer); procedure varsymbolused(p : TNamedIndexItem;arg:pointer);
procedure TestPrivate(p : TNamedIndexItem;arg:pointer); procedure TestPrivate(p : TNamedIndexItem;arg:pointer);
procedure objectprivatesymbolused(p : TNamedIndexItem;arg:pointer); procedure objectprivatesymbolused(p : TNamedIndexItem;arg:pointer);
{$ifdef GDB}
private
procedure concatstab(p : TNamedIndexItem;arg:pointer);
procedure resetstab(p : TNamedIndexItem;arg:pointer);
procedure concattypestab(p : TNamedIndexItem;arg:pointer);
{$endif}
procedure unchain_overloads(p : TNamedIndexItem;arg:pointer); procedure unchain_overloads(p : TNamedIndexItem;arg:pointer);
procedure loaddefs(ppufile:tcompilerppufile); procedure loaddefs(ppufile:tcompilerppufile);
procedure loadsyms(ppufile:tcompilerppufile); procedure loadsyms(ppufile:tcompilerppufile);
@ -85,6 +79,7 @@ interface
function needs_init_final : boolean; function needs_init_final : boolean;
procedure unchain_overloaded; procedure unchain_overloaded;
{$ifdef GDB} {$ifdef GDB}
procedure numberstring;
procedure concatstabto(asmlist : taasmoutput);virtual; procedure concatstabto(asmlist : taasmoutput);virtual;
function getnewtypecount : word; override; function getnewtypecount : word; override;
{$endif GDB} {$endif GDB}
@ -141,7 +136,6 @@ interface
dbx_count : longint; dbx_count : longint;
prev_dbx_counter : plongint; prev_dbx_counter : plongint;
dbx_count_ok : boolean; dbx_count_ok : boolean;
is_stab_written : boolean;
{$endif GDB} {$endif GDB}
constructor create(const n : string); constructor create(const n : string);
{$ifdef GDB} {$ifdef GDB}
@ -216,8 +210,6 @@ interface
procedure search_class_overloads(aprocsym : tprocsym); procedure search_class_overloads(aprocsym : tprocsym);
function search_default_property(pd : tobjectdef) : tpropertysym; function search_default_property(pd : tobjectdef) : tpropertysym;
procedure reset_all_defs;
{*** symtable stack ***} {*** symtable stack ***}
{$ifdef DEBUG} {$ifdef DEBUG}
procedure test_symtablestack; procedure test_symtablestack;
@ -594,14 +586,6 @@ implementation
if not(assigned(ttypesym(sym).restype.def.owner)) and if not(assigned(ttypesym(sym).restype.def.owner)) and
(ttypesym(sym).restype.def.deftype<>errordef) then (ttypesym(sym).restype.def.deftype<>errordef) then
registerdef(ttypesym(sym).restype.def); registerdef(ttypesym(sym).restype.def);
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) and
(symtabletype in [globalsymtable,staticsymtable]) then
begin
ttypesym(sym).isusedinstab := true;
{sym.concatstabto(debuglist);}
end;
{$endif GDB}
end; end;
{ insert in index and search hash } { insert in index and search hash }
@ -632,21 +616,6 @@ implementation
assigned(current_module.map[unitid].unitsym) then assigned(current_module.map[unitid].unitsym) then
inc(current_module.map[unitid].unitsym.refs); inc(current_module.map[unitid].unitsym.refs);
{$ifdef GDB}
{ if it is a type, we need the stabs of this type
this might be the cause of the class debug problems
as TCHILDCLASS.Create did not generate appropriate
stabs debug info if TCHILDCLASS wasn't used anywhere else PM }
if (cs_debuginfo in aktmoduleswitches) and
(hp.typ=typesym) and make_ref then
begin
if assigned(ttypesym(hp).restype.def) then
tstoreddef(ttypesym(hp).restype.def).numberstring
else
ttypesym(hp).isusedinstab:=true;
end;
{$endif GDB}
{ unitsym are only loaded for browsing PM } { unitsym are only loaded for browsing PM }
{ this was buggy anyway because we could use } { this was buggy anyway because we could use }
{ unitsyms from other units in _USES !! } { unitsyms from other units in _USES !! }
@ -776,11 +745,6 @@ implementation
not(is_funcret_sym(tsym(p))) and not(is_funcret_sym(tsym(p))) and
( (
(tsym(p).typ<>procsym) or (tsym(p).typ<>procsym) or
{$ifdef GDB}
not (tprocsym(p).is_global) or
{$endif GDB}
{ all program functions are declared global
but unused should still be signaled PM }
((tsym(p).owner.symtabletype=staticsymtable) and ((tsym(p).owner.symtabletype=staticsymtable) and
not current_module.is_unit) not current_module.is_unit)
) then ) then
@ -823,57 +787,6 @@ implementation
{$ifdef GDB} {$ifdef GDB}
procedure TStoredSymtable.concatstab(p : TNamedIndexItem;arg:pointer);
var stabstr:Pchar;
ao:Taasmoutput;
begin
if Tsym(p).typ<>procsym then
begin
ao:=Taasmoutput(arg);
if not Tsym(p).isstabwritten then
begin
stabstr:=Tsym(p).stabstring;
if stabstr<>nil then
ao.concat(Tai_stabs.create(stabstr));
Tsym(p).isstabwritten:=true;
end;
end;
end;
procedure TStoredSymtable.resetstab(p : TNamedIndexItem;arg:pointer);
begin
if tsym(p).typ <> procsym then
Tstoredsym(p).isstabwritten:=false;
end;
procedure TStoredSymtable.concattypestab(p : TNamedIndexItem;arg:pointer);
var stabstr:Pchar;
ao:Taasmoutput;
begin
if Tsym(p).typ=typesym then
begin
ao:=Taasmoutput(arg);
if Ttypesym(p).restype.def.typesym=p then
Tstoreddef(Ttypesym(p).restype.def).concatstabto(ao)
else
begin
Tsym(p).isstabwritten:=false;
stabstr:=Tsym(p).stabstring;
if stabstr<>nil then
ao.concat(Tai_stabs.create(stabstr));
Tsym(p).isstabwritten:=true;
end;
end;
end;
function tstoredsymtable.getnewtypecount : word; function tstoredsymtable.getnewtypecount : word;
begin begin
getnewtypecount:=pglobaltypecount^; getnewtypecount:=pglobaltypecount^;
@ -924,9 +837,45 @@ implementation
{$ifdef GDB} {$ifdef GDB}
procedure tstoredsymtable.concatstabto(asmlist : taasmoutput); procedure tstoredsymtable.numberstring;
var
p : tsym;
begin begin
foreach({$ifdef FPCPROCVAR}@{$endif}concatstab,asmlist); 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;
p : tsym;
begin
p:=tsym(symindex.first);
while assigned(p) do
begin
{ Procsym and typesym are already written }
if not(Tsym(p).typ in [procsym,typesym]) then
begin
if not Tsym(p).isstabwritten then
begin
stabstr:=Tsym(p).stabstring;
if stabstr<>nil then
asmlist.concat(Tai_stabs.create(stabstr));
Tsym(p).isstabwritten:=true;
end;
end;
p:=tsym(p.indexnext);
end;
end; end;
{$endif} {$endif}
@ -1373,7 +1322,6 @@ implementation
{ reset GDB things } { reset GDB things }
prev_dbx_counter := dbx_counter; prev_dbx_counter := dbx_counter;
dbx_counter := nil; dbx_counter := nil;
is_stab_written:=false;
dbx_count := -1; dbx_count := -1;
{$endif GDB} {$endif GDB}
end; end;
@ -1381,18 +1329,12 @@ implementation
{$ifdef GDB} {$ifdef GDB}
procedure tabstractunitsymtable.concattypestabto(asmlist : taasmoutput); procedure tabstractunitsymtable.concattypestabto(asmlist : taasmoutput);
var prev_dbx_count : plongint; var
prev_dbx_count : plongint;
p : tstoreddef;
begin begin
if is_stab_written then
exit;
if not assigned(name) then if not assigned(name) then
name := stringdup('Main_program'); name := stringdup('Main_program');
{if (symtabletype = globalsymtable) and
(current_module.globalsymtable<>self) then
begin
unitid:=current_module.unitcount;
inc(current_module.unitcount);
end;}
asmList.concat(tai_comment.Create(strpnew('Begin unit '+name^+' has index '+tostr(unitid)))); asmList.concat(tai_comment.Create(strpnew('Begin unit '+name^+' has index '+tostr(unitid))));
if cs_gdb_dbx in aktglobalswitches then if cs_gdb_dbx in aktglobalswitches then
begin begin
@ -1416,22 +1358,34 @@ implementation
do_count_dbx:=assigned(dbx_counter); do_count_dbx:=assigned(dbx_counter);
end; end;
end; end;
foreach({$ifdef FPCPROCVAR}@{$endif}concattypestab,asmlist);
{$ifdef EXTDEBUG}
writing_def_stabs:=true;
{$endif EXTDEBUG}
p:=tstoreddef(defindex.first);
while assigned(p) do
begin
if (p.stab_state=stab_state_used) then
p.concatstabto(asmlist);
p:=tstoreddef(p.indexnext);
end;
{$ifdef EXTDEBUG}
writing_def_stabs:=false;
{$endif EXTDEBUG}
if cs_gdb_dbx in aktglobalswitches then if cs_gdb_dbx in aktglobalswitches then
begin begin
if (current_module.globalsymtable<>self) then if (current_module.globalsymtable<>self) then
begin begin
dbx_counter := prev_dbx_count; dbx_counter := prev_dbx_count;
do_count_dbx:=false; do_count_dbx:=false;
asmList.concat(tai_comment.Create(strpnew('End unit '+name^
+' has index '+tostr(unitid))));
asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",' asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'
+tostr(N_EINCL)+',0,0,0'))); +tostr(N_EINCL)+',0,0,0')));
do_count_dbx:=assigned(dbx_counter); do_count_dbx:=assigned(dbx_counter);
dbx_count_ok := {true}false; dbx_count_ok := {true}false;
end; end;
end; end;
is_stab_written:=true; asmList.concat(tai_comment.Create(strpnew('End unit '+name^+' has index '+tostr(unitid))));
end; end;
{$endif GDB} {$endif GDB}
@ -1535,8 +1489,8 @@ implementation
unittypecount:=1; unittypecount:=1;
pglobaltypecount := @unittypecount; pglobaltypecount := @unittypecount;
{unitid:=current_module.unitcount;} {unitid:=current_module.unitcount;}
debugList.concat(tai_comment.Create(strpnew('Global '+name^+' has index '+tostr(unitid)))); {debugList.concat(tai_comment.Create(strpnew('Global '+name^+' has index '+tostr(unitid))));
debugList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0'))); debugList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0')));}
{inc(current_module.unitcount);} {inc(current_module.unitcount);}
{ we can't use dbx_vcount, because we don't know { we can't use dbx_vcount, because we don't know
if the object file will be loaded before or afeter PM } if the object file will be loaded before or afeter PM }
@ -2129,18 +2083,6 @@ implementation
search_class_member:=nil; search_class_member:=nil;
end; end;
procedure reset_all_defs;
var st:Tsymtable;
begin
st:=symtablestack;
while st<>nil do
begin
Tstoredsymtable(st).reset_all_defs;
st:=st.next;
end;
end;
{***************************************************************************** {*****************************************************************************
Definition Helpers Definition Helpers
@ -2375,7 +2317,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.141 2004-02-26 16:16:19 peter Revision 1.142 2004-03-08 22:07:47 peter
* stabs updates to write stabs for def for all implictly used
units
Revision 1.141 2004/02/26 16:16:19 peter
* check if withsymtable.defowner is in the current unit * check if withsymtable.defowner is in the current unit
Revision 1.140 2004/02/24 16:12:39 peter Revision 1.140 2004/02/24 16:12:39 peter