- 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

@@ -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

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 }

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;

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

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 }

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);

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

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);