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

- removed tstoreddef.reset() and overrides, and the associated

Browse Source 
reset_used_unit_defs()/reset_all_defs() calls:
    o removed resetting tprocdef.procstarttai/procendtai and
      instead check in the debug writers whether the def is
      in the current unit or not to determine whether we should
      write debug info for it
    o use the collected defs in the wpoinfo structure to reset
      the wpo flags in the defs, instead of iterating over all
      defs in the program and resetting them that way
  - removed now unused "is_reset" flag from tmodule

git-svn-id: trunk@15501 -
This commit is contained in:
Jonas Maebe 2010-06-30 19:00:40 +00:00
parent 32fd85f17e
commit daef2efa69
8 changed files with 51 additions and 153 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
compiler/dbgdwarf.pas
View File

@ -1945,22 +1945,19 @@ implementation
cc : Tdwarf_calling_convention;
st : tsymtable;
vmtindexnr : pint;
incurrentunit : boolean;
in_currentunit : boolean;
begin
{ only write debug info for procedures defined in the current module,
except in case of methods (gcc-compatible)
}
st:=def.owner;
while not(st.symtabletype in [globalsymtable,staticsymtable]) do
st:=st.defowner.owner;
incurrentunit:=st.iscurrentunit;
in_currentunit:=def.in_currentunit;
if not incurrentunit and
if not in_currentunit and
(def.owner.symtabletype<>objectsymtable) then
exit;
{ happens for init procdef of units without init section }
if incurrentunit and
if in_currentunit and
not assigned(def.procstarttai) then
exit;
@ -2047,7 +2044,7 @@ implementation
{ we can only write the start/end if this procedure is implemented in
this module
}
if incurrentunit then
if in_currentunit then
begin
{ mark end of procedure }
current_asmdata.getlabel(procendlabel,alt_dbgtype);
@ -2081,7 +2078,7 @@ implementation
end;
{ local type defs and vars should not be written
inside the main proc }
if incurrentunit and
if in_currentunit and
assigned(def.localst) and
(def.localst.symtabletype=localsymtable) then
write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],def.localst);
@ -2090,7 +2087,7 @@ implementation
if assigned(def.parast) then
write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.parast);
{ only try to write the localst if the routine is implemented here }
if incurrentunit and
if in_currentunit and
assigned(def.localst) and
(def.localst.symtabletype=localsymtable) then
begin

4
compiler/dbgstabs.pas
View File

@ -1010,7 +1010,9 @@ implementation
hs : string;
ss : ansistring;
begin
if not assigned(def.procstarttai) then
if not(def.in_currentunit) or
{ happens for init procdef of units without init section }
not assigned(def.procstarttai) then
exit;
{ mark as used so the local type defs also be written }

3
compiler/fmodule.pas
View File

@ -113,7 +113,6 @@ interface
sources_avail, { if all sources are reachable }
interface_compiled, { if the interface section has been parsed/compiled/loaded }
is_dbginfo_written,
is_reset,
is_unit,
in_interface, { processing the implementation part? }
{ allow global settings }
@ -533,7 +532,6 @@ implementation
islibrary:=false;
ispackage:=false;
is_dbginfo_written:=false;
is_reset:=false;
mode_switch_allowed:= true;
moduleoptions:=[];
deprecatedmsg:=nil;
@ -752,7 +750,6 @@ implementation
stringdispose(deprecatedmsg);
moduleoptions:=[];
is_dbginfo_written:=false;
is_reset:=false;
crc:=0;
interface_crc:=0;
indirect_crc:=0;

46
compiler/optvirt.pas
View File

@ -756,58 +756,12 @@ unit optvirt;
end;
procedure reset_all_impl_defs;
procedure reset_used_unit_impl_defs(hp:tmodule);
var
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.localsymtable) then
begin
tstaticsymtable(pu.u.localsymtable).reset_all_defs;
reset_used_unit_impl_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_impl_defs(current_module);
end;
procedure tprogdevirtinfo.constructfromcompilerstate;
var
hp: tmodule;
i: longint;
inheritancetree: tinheritancetree;
begin
{ the compiler already resets all interface defs after every unit
compilation, but not the implementation defs (because this is only
done for the purpose of writing debug info, and you can never see
a type defined in the implementation of one unit in another unit).
Here, we want to record all classes constructed anywhere in the
program, also if those class(ref) types are defined in the
implementation of a unit. So reset the state of all defs in
implementation sections before starting the collection process. }
reset_all_impl_defs;
{ register all instantiated class/object types }
hp:=tmodule(loaded_units.first);
while assigned(hp) do

50
compiler/pmodules.pas
View File

@ -834,38 +834,9 @@ implementation
procedure reset_all_defs;
procedure reset_used_unit_defs(hp:tmodule);
var
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);
if assigned(current_module.wpoinfo) then
current_module.wpoinfo.resetdefs;
end;
@ -1184,8 +1155,6 @@ implementation
current_module.globalsymtable:=current_module.localsymtable;
current_module.localsymtable:=nil;
reset_all_defs;
{ number all units, so we know if a unit is used by this unit or
needs to be added implicitly }
current_module.updatemaps;
@ -1265,9 +1234,6 @@ implementation
if current_module.state=ms_compiled then
exit;
{ reset ranges/stabs in exported definitions }
reset_all_defs;
{ All units are read, now give them a number }
current_module.updatemaps;
@ -1342,6 +1308,9 @@ implementation
{ the last char should always be a point }
consume(_POINT);
{ reset wpo flags for all defs }
reset_all_defs;
if (Errorcount=0) then
begin
{ tests, if all (interface) forwards are resolved }
@ -1870,9 +1839,6 @@ implementation
consume(_SEMICOLON);
end;
{ reset ranges/stabs in exported definitions }
reset_all_defs;
{ All units are read, now give them a number }
current_module.updatemaps;
@ -2178,9 +2144,6 @@ implementation
if token=_USES then
loadunits;
{ reset ranges/stabs in exported definitions }
reset_all_defs;
{ All units are read, now give them a number }
current_module.updatemaps;
@ -2281,6 +2244,9 @@ implementation
{ consume the last point }
consume(_POINT);
{ reset wpo flags for all defs }
reset_all_defs;
if (Errorcount=0) then
begin
{ test static symtable }

48
compiler/symdef.pas
View File

@ -64,7 +64,6 @@ interface
constructor create(dt:tdeftyp);
constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
destructor destroy;override;
procedure reset;virtual;
function getcopy : tstoreddef;virtual;
procedure ppuwrite(ppufile:tcompilerppufile);virtual;
procedure buildderef;override;
@ -77,6 +76,7 @@ interface
function is_publishable : boolean;override;
function needs_inittable : boolean;override;
function rtti_mangledname(rt:trttitype):string;override;
function in_currentunit: boolean;
{ regvars }
function is_intregable : boolean;
function is_fpuregable : boolean;
@ -172,7 +172,6 @@ interface
symtable : TSymtable;
cloneddef : tabstractrecorddef;
cloneddefderef : tderef;
procedure reset;override;
function GetSymtable(t:tGetSymtable):TSymtable;override;
function is_packed:boolean;
end;
@ -303,7 +302,6 @@ interface
function find_procdef_bytype(pt:tproctypeoption): tprocdef;
function find_destructor: tprocdef;
function implements_any_interfaces: boolean;
procedure reset; override;
{ dispinterface support }
function get_next_dispid: longint;
{ enumerator support }
@ -333,7 +331,6 @@ interface
function is_publishable : boolean;override;
function rtti_mangledname(rt:trttitype):string;override;
procedure register_created_object_type;override;
procedure reset;override;
end;
tarraydef = class(tstoreddef)
@ -517,7 +514,9 @@ interface
{$ifdef oldregvars}
regvarinfo: pregvarinfo;
{$endif oldregvars}
{ position in aasmoutput list }
{ First/last assembler symbol/instruction in aasmoutput list.
Note: initialised after compiling the code for the procdef, but
not saved to/restored from ppu. Used when inserting debug info }
procstarttai,
procendtai : tai;
import_nr : word;
@ -541,7 +540,6 @@ interface
procedure buildderefimpl;override;
procedure deref;override;
procedure derefimpl;override;
procedure reset;override;
function GetSymtable(t:tGetSymtable):TSymtable;override;
function GetTypeName : string;override;
function mangledname : string;
@ -1040,8 +1038,14 @@ implementation
end;
procedure Tstoreddef.reset;
function tstoreddef.in_currentunit: boolean;
var
st: tsymtable;
begin
st:=owner;
while not(st.symtabletype in [globalsymtable,staticsymtable]) do
st:=st.defowner.owner;
result:=st.iscurrentunit;
end;
@ -2184,13 +2188,6 @@ implementation
end;
procedure tclassrefdef.reset;
begin
tobjectdef(pointeddef).classref_created_in_current_module:=false;
inherited reset;
end;
procedure tclassrefdef.register_created_object_type;
begin
tobjectdef(pointeddef).register_created_classref_type;
@ -2591,13 +2588,6 @@ implementation
end;
procedure tabstractrecorddef.reset;
begin
inherited reset;
tstoredsymtable(symtable).reset_all_defs;
end;
function tabstractrecorddef.is_packed:boolean;
begin
result:=tabstractrecordsymtable(symtable).is_packed;
@ -3280,14 +3270,6 @@ implementation
end;
procedure tprocdef.reset;
begin
inherited reset;
procstarttai:=nil;
procendtai:=nil;
end;
function tprocdef.fullprocname(showhidden:boolean):string;
var
s : string;
@ -4651,14 +4633,6 @@ implementation
end;
procedure tobjectdef.reset;
begin
inherited reset;
created_in_current_module:=false;
maybe_created_in_current_module:=false;
classref_created_in_current_module:=false;
end;
function tobjectdef.get_next_dispid: longint;
begin
inc(fcurrent_dispid);

14
compiler/symtable.pas
View File

@ -67,7 +67,6 @@ interface
procedure deref;virtual;
procedure derefimpl;virtual;
function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
procedure reset_all_defs;virtual;
procedure allsymbolsused;
procedure allprivatesused;
procedure check_forwards;
@ -694,19 +693,6 @@ implementation
Process all entries
***********************************************}
procedure Tstoredsymtable.reset_all_defs;
var
i : longint;
def : tstoreddef;
begin
for i:=0 to DefList.Count-1 do
begin
def:=tstoreddef(DefList[i]);
def.reset;
end;
end;
{ checks, if all procsyms and methods are defined }
procedure tstoredsymtable.check_forwards;
begin

22
compiler/wpobase.pas
View File

@ -171,6 +171,10 @@ type
procedure addcreatedobjtypeforclassref(def: tdef);
procedure addmaybecreatedbyclassref(def: tdef);
procedure addcalledvmtentry(def: tdef; index: longint);
{ resets the "I've been registered with wpo" flags for all defs in the
above lists }
procedure resetdefs;
end;
{ ************************************************************************* }
@ -362,6 +366,8 @@ implementation
var
i: longint;
begin
{ don't call resetdefs here, because the defs may have been freed
already }
fcreatedobjtypes.free;
fcreatedobjtypes:=nil;
fcreatedclassrefobjtypes.free;
@ -384,6 +390,22 @@ implementation
end;
procedure tunitwpoinfobase.resetdefs;
var
i: ptrint;
begin
if assigned(fcreatedobjtypes) then
for i:=0 to fcreatedobjtypes.count-1 do
tobjectdef(fcreatedobjtypes[i]).created_in_current_module:=false;
if assigned(fcreatedclassrefobjtypes) then
for i:=0 to fcreatedclassrefobjtypes.count-1 do
tobjectdef(fcreatedclassrefobjtypes[i]).classref_created_in_current_module:=false;
if assigned(fmaybecreatedbyclassrefdeftypes) then
for i:=0 to fmaybecreatedbyclassrefdeftypes.count-1 do
tobjectdef(fmaybecreatedbyclassrefdeftypes[i]).maybe_created_in_current_module:=false;
end;
procedure tunitwpoinfobase.addcreatedobjtype(def: tdef);
begin
fcreatedobjtypes.add(def);