From daef2efa69cf8d1f3e2d099d5b4cc684b8c16dbb Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Wed, 30 Jun 2010 19:00:40 +0000 Subject: [PATCH] - removed tstoreddef.reset() and overrides, and the associated 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 - --- compiler/dbgdwarf.pas | 17 ++++++--------- compiler/dbgstabs.pas | 4 +++- compiler/fmodule.pas | 3 --- compiler/optvirt.pas | 46 --------------------------------------- compiler/pmodules.pas | 50 +++++++------------------------------------ compiler/symdef.pas | 48 ++++++++++------------------------------- compiler/symtable.pas | 14 ------------ compiler/wpobase.pas | 22 +++++++++++++++++++ 8 files changed, 51 insertions(+), 153 deletions(-) diff --git a/compiler/dbgdwarf.pas b/compiler/dbgdwarf.pas index 8119d52e3a..350212159b 100644 --- a/compiler/dbgdwarf.pas +++ b/compiler/dbgdwarf.pas @@ -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 diff --git a/compiler/dbgstabs.pas b/compiler/dbgstabs.pas index e0e5c19dff..b3702146c8 100644 --- a/compiler/dbgstabs.pas +++ b/compiler/dbgstabs.pas @@ -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 } diff --git a/compiler/fmodule.pas b/compiler/fmodule.pas index fee53e5337..c0b269c6b5 100644 --- a/compiler/fmodule.pas +++ b/compiler/fmodule.pas @@ -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; diff --git a/compiler/optvirt.pas b/compiler/optvirt.pas index 196b98eec3..9646c1b172 100644 --- a/compiler/optvirt.pas +++ b/compiler/optvirt.pas @@ -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 diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 9ac8999546..d6baf1e772 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -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 } diff --git a/compiler/symdef.pas b/compiler/symdef.pas index a3ab0b0c11..477e8d516f 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -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); diff --git a/compiler/symtable.pas b/compiler/symtable.pas index 8c3d67a10d..f5cf48ed76 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -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 diff --git a/compiler/wpobase.pas b/compiler/wpobase.pas index 787bb15aba..de62ccd530 100644 --- a/compiler/wpobase.pas +++ b/compiler/wpobase.pas @@ -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);