* record all classrefdefs/objdefs for which a loadvmtaddrnode is generated,

    and instead of marking all classes that derive from instantiated
    classrefdefs as instantiated, only mark those classes from the above
    collection that derive from instantiated classrefdefs as
    instantiated (since to instantiate a class, you have to load its vmt
    somehow -- this may be broken by using assembler code though)

git-svn-id: branches/wpo@11938 -

compiler/nmem.pas

@@ -30,7 +30,7 @@ interface
        symdef,symsym,symtable,symtype;
 
     type
-       tloadvmtaddrnode = class(tunarynode)
+tloadvmtaddrnode = class(tunarynode)
           constructor create(l : tnode);virtual;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
@@ -168,7 +168,12 @@ implementation
          result:=nil;
          expectloc:=LOC_REGISTER;
          if left.nodetype<>typen then
-           firstpass(left);
+           firstpass(left)
+         { keep track of which classes might be instantiated via a classrefdef }
+         else if (left.resultdef.typ=classrefdef) then
+           tobjectdef(tclassrefdef(left.resultdef).pointeddef).register_maybe_created_object_type
+         else if (left.resultdef.typ=objectdef) then
+           tobjectdef(left.resultdef).register_maybe_created_object_type;
       end;
 
 

compiler/optvirt.pas

@@ -731,9 +731,14 @@ unit optvirt;
             if assigned(hp.wpoinfo.createdclassrefobjtypes) then
               for i:=0 to hp.wpoinfo.createdclassrefobjtypes.count-1 do
                 tobjectdef(hp.wpoinfo.createdclassrefobjtypes[i]).register_created_classref_type;
+            if assigned(hp.wpoinfo.maybecreatedbyclassrefdeftypes) then
+              for i:=0 to hp.wpoinfo.maybecreatedbyclassrefdeftypes.count-1 do
+                tobjectdef(hp.wpoinfo.maybecreatedbyclassrefdeftypes[i]).register_maybe_created_object_type;
             hp:=tmodule(hp.next);
           end;
          inheritancetree:=tinheritancetree.create;
+
+         { add all constructed class/object types to the tree }
 {$IFDEF DEBUG_DEVIRT}
          writeln('constructed object/class/classreftypes in ',current_module.realmodulename^);
 {$ENDIF}
@@ -764,6 +769,7 @@ unit optvirt;
              end;
            end;
 
+         { register all instantiated classrefdefs with the tree }
          for i := 0 to current_module.wpoinfo.createdclassrefobjtypes.count-1 do
            begin
              inheritancetree.registerinstantiatedclassrefdef(tdef(current_module.wpoinfo.createdclassrefobjtypes[i]));
@@ -780,31 +786,30 @@ unit optvirt;
                  internalerror(2008101101);
              end;
            end;
-         { now add all objectdefs derived from the instantiated
-           classrefdefs to the tree (as they can, in theory, all
+
+
+         { now add all objectdefs that are referred somewhere (via a
+           loadvmtaddr node) and that are derived from an instantiated
+           classrefdef to the tree (as they can, in theory, all
            be instantiated as well)
          }
-         hp:=tmodule(loaded_units.first);
-         while assigned(hp) do
-          begin
-            { we cannot just walk over the module's deflists, because a bunch of
-              the defs in there don't exist anymore (when destroyed, they're
-              removed from their symtable but not from the module's deflist)
+         for i := 0 to current_module.wpoinfo.maybecreatedbyclassrefdeftypes.count-1 do
+           begin
+             inheritancetree.checkforclassrefinheritance(tdef(current_module.wpoinfo.maybecreatedbyclassrefdeftypes[i]));
+{$IFDEF DEBUG_DEVIRT}
+             write('  Class Of ',tdef(current_module.wpoinfo.maybecreatedbyclassrefdeftypes[i]).GetTypeName);
+{$ENDIF}
+             case tdef(current_module.wpoinfo.maybecreatedbyclassrefdeftypes[i]).typ of
+               objectdef:
+{$IFDEF DEBUG_DEVIRT}
+                 writeln(' (classrefdef)')
+{$ENDIF}
+                 ;
+               else
+                 internalerror(2008101101);
+             end;
+           end;
 
-              procedure-local (or class-local) class definitions do not (yet)
-              exit, so it's enough to just walk the global and local symtables
-            }
-            { globalsymtable (interface), is nil for main program itself }
-            if assigned(hp.globalsymtable) then
-              for i:=0 to hp.globalsymtable.deflist.count-1 do
-                inheritancetree.checkforclassrefinheritance(tdef(hp.globalsymtable.deflist[i]));
-            { staticsymtable (implementation), is nil for units with nothing
-              in the implementation }
-            if assigned(hp.localsymtable) then
-              for i:=0 to hp.localsymtable.deflist.count-1 do
-                inheritancetree.checkforclassrefinheritance(tdef(hp.localsymtable.deflist[i]));
-            hp:=tmodule(hp.next);
-          end;
          inheritancetree.optimizevirtualmethods;
 {$ifdef DEBUG_DEVIRT}
          inheritancetree.printvmtinfo;

compiler/symdef.pas

@@ -249,6 +249,7 @@ interface
           iidstr         : pshortstring;
           writing_class_record_dbginfo,
           created_in_current_module,
+          maybe_created_in_current_module,
           classref_created_in_current_module : boolean;
           { store implemented interfaces defs and name mappings }
           ImplementedInterfaces : TFPObjectList;
@@ -281,6 +282,7 @@ interface
           function implements_any_interfaces: boolean;
           procedure reset; override;
           procedure register_created_object_type;override;
+          procedure register_maybe_created_object_type;
           procedure register_created_classref_type;
        end;
 
@@ -4260,6 +4262,7 @@ implementation
       begin
         inherited reset;
         created_in_current_module:=false;
+        maybe_created_in_current_module:=false;
         classref_created_in_current_module:=false;
       end;
 
@@ -4283,6 +4286,21 @@ implementation
           end;
       end;
 
+
+    procedure tobjectdef.register_maybe_created_object_type;
+      begin
+        { if we know it has been created for sure, no need
+          to also record that it maybe can be created in
+          this module
+        }
+        if not (created_in_current_module) and
+           not (maybe_created_in_current_module) then
+          begin
+            maybe_created_in_current_module:=true;
+            current_module.wpoinfo.addmaybecreatedbyclassref(self);
+          end;
+      end;
+
 {****************************************************************************
                              TImplementedInterface
 ****************************************************************************}

compiler/wpobase.pas

@@ -121,15 +121,23 @@ type
     fcreatedobjtypes: tfpobjectlist;
     { objectdefs pointed to by created classrefdefs }
     fcreatedclassrefobjtypes: tfpobjectlist;
+    { objtypes potentially instantiated by fcreatedclassrefobjtypes
+      (objdectdefs pointed to by classrefdefs that are
+       passed as a regular parameter, loaded in a variable, ...
+       so they can end up in a classrefdef var and be instantiated)
+    }
+    fmaybecreatedbyclassrefdeftypes: tfpobjectlist;
    public
     constructor create; reintroduce; virtual;
     destructor destroy; override;
 
     property createdobjtypes: tfpobjectlist read fcreatedobjtypes;
     property createdclassrefobjtypes: tfpobjectlist read fcreatedclassrefobjtypes;
+    property maybecreatedbyclassrefdeftypes: tfpobjectlist read fmaybecreatedbyclassrefdeftypes;
 
     procedure addcreatedobjtype(def: tdef);
     procedure addcreatedobjtypeforclassref(def: tdef);
+    procedure addmaybecreatedbyclassref(def: tdef);
   end;
 
   { ************************************************************************* }
@@ -312,6 +320,7 @@ implementation
     begin
       fcreatedobjtypes:=tfpobjectlist.create(false);
       fcreatedclassrefobjtypes:=tfpobjectlist.create(false);
+      fmaybecreatedbyclassrefdeftypes:=tfpobjectlist.create(false);
     end;
 
 
@@ -321,6 +330,8 @@ implementation
       fcreatedobjtypes:=nil;
       fcreatedclassrefobjtypes.free;
       fcreatedclassrefobjtypes:=nil;
+      fmaybecreatedbyclassrefdeftypes.free;
+      fmaybecreatedbyclassrefdeftypes:=nil;
       inherited destroy;
     end;
     
@@ -335,6 +346,10 @@ implementation
       fcreatedclassrefobjtypes.add(def);
     end;
 
+  procedure tunitwpoinfobase.addmaybecreatedbyclassref(def: tdef);
+    begin
+      fmaybecreatedbyclassrefdeftypes.add(def);
+    end;
 
   { twpofilereader }
 

compiler/wpoinfo.pas

@@ -40,6 +40,7 @@ type
    private
     fcreatedobjtypesderefs: pderefarray;
     fcreatedclassrefobjtypesderefs: pderefarray;
+    fmaybecreatedbyclassrefdeftypesderefs: pderefarray;
    { devirtualisation information -- end }
 
    public
@@ -86,6 +87,11 @@ implementation
           freemem(fcreatedclassrefobjtypesderefs);
           fcreatedclassrefobjtypesderefs:=nil;
         end;
+      if assigned(fmaybecreatedbyclassrefdeftypesderefs) then
+        begin
+          freemem(fmaybecreatedbyclassrefdeftypesderefs);
+          fmaybecreatedbyclassrefdeftypesderefs:=nil;
+        end;
       inherited destroy;
     end;
     
@@ -103,12 +109,18 @@ implementation
       ppufile.putlongint(fcreatedclassrefobjtypes.count);
       for i:=0 to fcreatedclassrefobjtypes.count-1 do
         ppufile.putderef(fcreatedclassrefobjtypesderefs^[i]);
+      ppufile.putlongint(fmaybecreatedbyclassrefdeftypes.count);
+      for i:=0 to fmaybecreatedbyclassrefdeftypes.count-1 do
+        ppufile.putderef(fmaybecreatedbyclassrefdeftypesderefs^[i]);
 
       ppufile.writeentry(ibcreatedobjtypes);
+
       freemem(fcreatedobjtypesderefs);
       fcreatedobjtypesderefs:=nil;
       freemem(fcreatedclassrefobjtypesderefs);
       fcreatedclassrefobjtypesderefs:=nil;
+      freemem(fmaybecreatedbyclassrefdeftypesderefs);
+      fmaybecreatedbyclassrefdeftypesderefs:=nil;
     end;
 
 
@@ -119,6 +131,7 @@ implementation
       { load start of definition section, which holds the amount of defs }
       if ppufile.readentry<>ibcreatedobjtypes then
         cgmessage(unit_f_ppu_read_error);
+
       len:=ppufile.getlongint;
       fcreatedobjtypes:=tfpobjectlist.create(false);
       fcreatedobjtypes.count:=len;
@@ -132,6 +145,13 @@ implementation
       getmem(fcreatedclassrefobjtypesderefs,len*sizeof(tderef));
       for i:=0 to len-1 do
         ppufile.getderef(fcreatedclassrefobjtypesderefs^[i]);
+
+      len:=ppufile.getlongint;
+      fmaybecreatedbyclassrefdeftypes:=tfpobjectlist.create(false);
+      fmaybecreatedbyclassrefdeftypes.count:=len;
+      getmem(fmaybecreatedbyclassrefdeftypesderefs,len*sizeof(tderef));
+      for i:=0 to len-1 do
+        ppufile.getderef(fmaybecreatedbyclassrefdeftypesderefs^[i]);
     end;
 
 
@@ -146,6 +166,10 @@ implementation
       getmem(fcreatedclassrefobjtypesderefs,fcreatedclassrefobjtypes.count*sizeof(tderef));
       for i:=0 to fcreatedclassrefobjtypes.count-1 do
         fcreatedclassrefobjtypesderefs^[i].build(fcreatedclassrefobjtypes[i]);
+
+      getmem(fmaybecreatedbyclassrefdeftypesderefs,fmaybecreatedbyclassrefdeftypes.count*sizeof(tderef));
+      for i:=0 to fmaybecreatedbyclassrefdeftypes.count-1 do
+        fmaybecreatedbyclassrefdeftypesderefs^[i].build(fmaybecreatedbyclassrefdeftypes[i]);
     end;
 
 
@@ -167,6 +191,11 @@ implementation
         fcreatedclassrefobjtypes[i]:=fcreatedclassrefobjtypesderefs^[i].resolve;
       freemem(fcreatedclassrefobjtypesderefs);
       fcreatedclassrefobjtypesderefs:=nil;
+
+      for i:=0 to fmaybecreatedbyclassrefdeftypes.count-1 do
+        fmaybecreatedbyclassrefdeftypes[i]:=fmaybecreatedbyclassrefdeftypesderefs^[i].resolve;
+      freemem(fmaybecreatedbyclassrefdeftypesderefs);
+      fmaybecreatedbyclassrefdeftypesderefs:=nil;
     end;