* extracted code to detect constructed class/object types from

    tcallnode.gen_vmt_tree into its own method to avoid clutter
  * detect x.classtype.create constructs (with classtype = the
    system.tobject.classtype method), and treat them as if a
    "class of x" has been instantiated rather than a
    "class of tobject". this required storing the instantiated
    classrefs in their own array though, because at such a
    point we don't have a "class of x" tdef available (so
    now "x", and all other defs instantiated via a classref,
    are now stored as tobjectdefs in a separate array)
  + support for devirtualising class methods (including
    constructors)

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

compiler/ncal.pas

@@ -72,6 +72,8 @@ interface
           procedure order_parameters;
           procedure check_inlining;
           function  pass1_normal:tnode;
+          procedure register_created_object_types;
+
 
           { inlining support }
           inlinelocals            : TFPObjectList;
@@ -1514,6 +1516,88 @@ implementation
       end;
 
 
+    procedure tcallnode.register_created_object_types;
+      var
+        crefdef,
+        systobjectdef : tdef;
+      begin
+        { only makes sense for methods }
+        if not assigned(methodpointer) then
+          exit;
+        if (methodpointer.resultdef.typ=classrefdef) then
+          begin
+            { constructor call via classreference => allocate memory }
+            if (procdefinition.proctypeoption=potype_constructor) then
+              begin
+                { Only a typenode can be passed when it is called with <class of xx>.create }
+                if methodpointer.nodetype=typen then
+                  { we know the exact class type being created }
+                  tclassrefdef(methodpointer.resultdef).pointeddef.register_created_object_type
+                else
+                  begin
+                    { the loadvmtaddrnode is already created in case of classtype.create }
+                    if (methodpointer.nodetype=loadvmtaddrn) and
+                       (tloadvmtaddrnode(methodpointer).left.nodetype=typen) then
+                      tclassrefdef(methodpointer.resultdef).pointeddef.register_created_object_type
+                    else
+                      begin
+                        { special case: if the classref comes from x.classtype (with classtype,
+                          being tobject.classtype) then the created instance is x or a descendant
+                          of x (rather than tobject or a descendant of tobject)
+                        }
+                        systobjectdef:=search_system_type('TOBJECT').typedef;
+                        if (methodpointer.nodetype=calln) and
+                           { not a procvar call }
+                           not assigned(right) and
+                           { procdef is owned by system.tobject }
+                           (tprocdef(tcallnode(methodpointer).procdefinition).owner.defowner=systobjectdef) and
+                           { we're calling system.tobject.classtype }
+                           (tcallnode(methodpointer).symtableprocentry.name='CLASSTYPE') and
+                           { could again be a classrefdef, but unlikely }
+                           (tcallnode(methodpointer).methodpointer.resultdef.typ=objectdef) and
+                           { don't go through this trouble if it was already a tobject }
+                           (tcallnode(methodpointer).methodpointer.resultdef<>systobjectdef) then
+                          begin
+                            { register this object type as classref, so all descendents will also
+                              be marked as instantiatable (only the pointeddef will actually be
+                              recorded, so it's no problem that the clasrefdef is only temporary)
+                            }
+                            crefdef:=tclassrefdef.create(tcallnode(methodpointer).methodpointer.resultdef);
+                            { and register it }
+                            crefdef.register_created_object_type;
+                          end
+                         else
+                          { the created class can be any child class as well -> register classrefdef }
+                          methodpointer.resultdef.register_created_object_type;
+                      end;
+                  end;
+              end
+          end
+        else
+        { Old style object }
+         if is_object(methodpointer.resultdef) then
+          begin
+            { constructor with extended syntax called from new }
+            if (cnf_new_call in callnodeflags) then
+              begin
+                methodpointer.resultdef.register_created_object_type;
+              end
+            else
+            { normal object call like obj.proc }
+              if not(cnf_dispose_call in callnodeflags) and
+                 not(cnf_inherited in callnodeflags) and
+                 not(cnf_member_call in callnodeflags) then
+             begin
+               if (procdefinition.proctypeoption=potype_constructor) then
+                 begin
+                   if (methodpointer.nodetype<>typen) then
+                     methodpointer.resultdef.register_created_object_type;
+                 end
+             end;
+          end;
+       end;
+
+
     function tcallnode.gen_vmt_tree:tnode;
       var
         vmttree : tnode;
@@ -1540,21 +1624,7 @@ implementation
                 vmttree:=methodpointer.getcopy;
                 { Only a typenode can be passed when it is called with <class of xx>.create }
                 if vmttree.nodetype=typen then
-                  begin
-                    { we know the exact class type being created }
-                    tclassrefdef(methodpointer.resultdef).pointeddef.register_created_object_type;
-                    vmttree:=cloadvmtaddrnode.create(vmttree);
-                  end
-                else
-                  begin
-                    { the loadvmtaddrnode is already created in case of classtype.create }
-                    if (vmttree.nodetype=loadvmtaddrn) and
-                       (tloadvmtaddrnode(vmttree).left.nodetype = typen) then
-                      tclassrefdef(methodpointer.resultdef).pointeddef.register_created_object_type
-                    else
-                      { the created class can be any child class as well -> register classrefdef }
-                      methodpointer.resultdef.register_created_object_type;
-                  end;
+                  vmttree:=cloadvmtaddrnode.create(vmttree);
               end
             else
               begin
@@ -1589,15 +1659,11 @@ implementation
                       vmttree:=cpointerconstnode.create(1,voidpointertype)
                     else
                       vmttree:=cpointerconstnode.create(0,voidpointertype)
-                  { else, if we are calling a constructor }
-                  else if (current_procinfo.procdef.proctypeoption=potype_constructor) then
+                  else if (current_procinfo.procdef.proctypeoption=potype_constructor) and
+                          (procdefinition.proctypeoption=potype_constructor) then
                     vmttree:=cpointerconstnode.create(0,voidpointertype)
                   else
-                    begin
-                      { created a new class instance of this type }
-                      methodpointer.resultdef.register_created_object_type;
-                      vmttree:=cpointerconstnode.create(1,voidpointertype);
-                    end;
+                    vmttree:=cpointerconstnode.create(1,voidpointertype);
                 end
             else
             { normal call to method like cl1.proc }
@@ -1620,14 +1686,11 @@ implementation
                 else
                   begin
                     if (current_procinfo.procdef.proctypeoption=potype_constructor) and
+                       (procdefinition.proctypeoption=potype_constructor) and
                        (nf_is_self in methodpointer.flags) then
                       vmttree:=cpointerconstnode.create(0,voidpointertype)
                     else
-                      begin
-                        { created a new class instance of this type }
-                        methodpointer.resultdef.register_created_object_type;
-                        vmttree:=cpointerconstnode.create(1,voidpointertype);
-                      end;
+                      vmttree:=cpointerconstnode.create(1,voidpointertype);
                   end;
               end;
           end
@@ -1636,10 +1699,7 @@ implementation
           begin
             { constructor with extended syntax called from new }
             if (cnf_new_call in callnodeflags) then
-              begin
-                methodpointer.resultdef.register_created_object_type;
                 vmttree:=cloadvmtaddrnode.create(ctypenode.create(methodpointer.resultdef))
-              end
             else
               { destructor with extended syntax called from dispose }
               if (cnf_dispose_call in callnodeflags) then
@@ -1668,10 +1728,7 @@ implementation
                    if (methodpointer.nodetype=typen) then
                      vmttree:=cpointerconstnode.create(0,voidpointertype)
                    else
-                     begin
-                       methodpointer.resultdef.register_created_object_type;
-                       vmttree:=cloadvmtaddrnode.create(ctypenode.create(methodpointer.resultdef))
-                     end;
+                     vmttree:=cloadvmtaddrnode.create(ctypenode.create(methodpointer.resultdef))
                  end
                else
                  vmttree:=cpointerconstnode.create(0,voidpointertype);
@@ -1681,6 +1738,7 @@ implementation
       end;
 
 
+
     function check_funcret_used_as_para(var n: tnode; arg: pointer): foreachnoderesult;
       var
         destsym : tsym absolute arg;
@@ -2702,6 +2760,12 @@ implementation
          { Check if the call can be inlined, sets the cnf_do_inline flag }
          check_inlining;
 
+         { must be called before maybe_load_in_temp(methodpointer), because
+           it converts the methodpointer into a temp in case it's a call
+           (and we want to know the original call)
+         }
+         register_created_object_types;
+
          { Maybe optimize the loading of the methodpointer using a temp. When the methodpointer
            is a calln this is even required to not execute the calln twice.
            This needs to be done after the resulttype pass, because in the resulttype we can still convert the

compiler/optvirt.pas

@@ -73,14 +73,14 @@ unit optvirt;
         function registerinstantiatedobjectdefrecursive(def: tobjectdef; instantiated: boolean): tinheritancetreenode;
         procedure markvmethods(node: tinheritancetreenode; p: pointer);
         procedure printobjectvmtinfo(node: tinheritancetreenode; arg: pointer);
-        procedure setinstantiated(node: tinheritancetreenode; arg: pointer);
        public
         constructor create;
         destructor destroy; override;
         { adds an objectdef (the def itself, and all of its parents that do not yet exist) to
           the tree, and returns the leaf node
         }
-        procedure registerinstantiateddef(def: tdef);
+        procedure registerinstantiatedobjdef(def: tdef);
+        procedure registerinstantiatedclassrefdef(def: tdef);
         procedure checkforclassrefinheritance(def: tdef);
         procedure foreachnode(proctocall: tinheritancetreecallback; arg: pointer);
         procedure foreachleafnode(proctocall: tinheritancetreecallback; arg: pointer);
@@ -266,12 +266,21 @@ unit optvirt;
       end;
 
 
-    procedure tinheritancetree.registerinstantiateddef(def: tdef);
+    procedure tinheritancetree.registerinstantiatedobjdef(def: tdef);
       begin
         { add the def }
         if (def.typ=objectdef) then
           registerinstantiatedobjectdefrecursive(tobjectdef(def),true)
-        else if (def.typ=classrefdef) then
+        else
+          internalerror(2008092401);
+      end;
+
+
+    procedure tinheritancetree.registerinstantiatedclassrefdef(def: tdef);
+      begin
+        { queue for later checking (these are the objectdefs
+          to which the classrefdefs point) }
+        if (def.typ=objectdef) then
           classrefdefs.add(def)
         else
           internalerror(2008092401);
@@ -284,30 +293,25 @@ unit optvirt;
      begin
        if (def.typ=objectdef) then
          begin
+{$ifdef debug_devirt}
+           write('   Checking for classrefdef inheritance of ',def.typename);
+{$endif debug_devirt}
            for i:=0 to classrefdefs.count-1 do
-             if tobjectdef(def).is_related(tclassrefdef(classrefdefs[i]).pointeddef) then
+             if tobjectdef(def).is_related(tobjectdef(classrefdefs[i])) then
                begin
-                 registerinstantiateddef(def);
+{$ifdef debug_devirt}
+                 writeln('... Found: inherits from Class Of ',tobjectdef(classrefdefs[i]).typename);
+{$endif debug_devirt}
+                 registerinstantiatedobjdef(def);
                  exit;
                end;
+{$ifdef debug_devirt}
+           writeln('... Not found!');
+{$endif debug_devirt}
          end;
      end;
 
 
-   procedure tinheritancetree.setinstantiated(node: tinheritancetreenode; arg: pointer);
-      var
-        classrefdef: tclassrefdef absolute arg;
-      begin
-        if not(node.instantiated) then
-          begin
-            node.instantiated:=true;
-            {$IFDEF DEBUG_DEVIRT}
-            writeln('Marked ',node.def.typename,' as instantiated because instantiated ',classrefdef.typename);
-            {$ENDIF}
-          end;
-      end;
-
-
     procedure tinheritancetree.foreachnodefromroot(root: tinheritancetreenode; proctocall: tinheritancetreecallback; arg: pointer);
         
       procedure process(const node: tinheritancetreenode);
@@ -370,7 +374,7 @@ unit optvirt;
             vmtbuilder:=tvmtbuilder.create(node.def);
             vmtbuilder.generate_vmt(false);
             vmtbuilder.free;
-            { may not have any vmtentries }
+            { may not have any virtual methods }
             if not assigned(node.def.vmtentries) then
               exit;
           end;
@@ -388,7 +392,7 @@ unit optvirt;
             { Now mark all virtual methods static that are the same in parent
               classes as in this instantiated child class (only instantiated
               classes can be leaf nodes, since only instantiated classes were
-              added to the tree) as statically callable.
+              added to the tree).
               If a first child does not override a parent method while a
               a second one does, the first will mark it as statically
               callable, but the second will set it to not statically callable.
@@ -406,13 +410,13 @@ unit optvirt;
                   if not assigned(currnode.def.vmtentries) then
                     break;
                 end;
-              { stop when this method is not yet implemented in a parent }
+              { stop when this method is does not exist in a parent }
               if (currnode.def.vmtentries.count<=i) then
                 break;
               
               if not assigned(currnode.def.vmcallstaticinfo) then
                 currnode.def.vmcallstaticinfo:=allocmem(currnode.def.vmtentries.count*sizeof(tvmcallstatic));
-              { same procdef as in all instantiated childs? }
+              { same procdef as in all instantiated childs? (yes or don't know) }
               if (currnode.def.vmcallstaticinfo^[i] in [vmcs_default,vmcs_yes]) then
                 begin
                   { methods in uninstantiated classes can be made static if
@@ -458,7 +462,6 @@ unit optvirt;
 
     procedure tinheritancetree.optimizevirtualmethods;
       begin
-//        finalisetree;
         foreachleafnode(@markvmethods,nil);
       end;
 
@@ -498,7 +501,10 @@ unit optvirt;
       end;
 
 
-    { helper routine: decompose a class/procdef combo into a unitname, class name and vmtentry number }
+    { helper routine: decompose an object & procdef combo into a unitname, class name and vmtentry number
+      (unit name where the objectdef is declared, class name of the objectdef, vmtentry number of the
+       procdef -- procdef does not necessarily belong to objectdef, it may also belong to a descendant
+       or parent) }
 
     procedure defsdecompose(objdef: tobjectdef; procdef: tprocdef; out unitname, classname: pshortstring; out vmtentry: longint);
       const
@@ -526,7 +532,6 @@ unit optvirt;
       end;
 
 
-
    { tclassdevirtinfo }
 
     constructor tclassdevirtinfo.create(hashobjectlist:tfphashobjectlist;const n: shortstring);
@@ -711,6 +716,9 @@ unit optvirt;
             if assigned(hp.wpoinfo.createdobjtypes) then
               for i:=0 to hp.wpoinfo.createdobjtypes.count-1 do
                 tdef(hp.wpoinfo.createdobjtypes[i]).register_created_object_type;
+            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;
             hp:=tmodule(hp.next);
           end;
          inheritancetree:=tinheritancetree.create;
@@ -719,7 +727,7 @@ unit optvirt;
 {$ENDIF}
          for i := 0 to current_module.wpoinfo.createdobjtypes.count-1 do
            begin
-             inheritancetree.registerinstantiateddef(tdef(current_module.wpoinfo.createdobjtypes[i]));
+             inheritancetree.registerinstantiatedobjdef(tdef(current_module.wpoinfo.createdobjtypes[i]));
 {$IFDEF DEBUG_DEVIRT}
              write('  ',tdef(current_module.wpoinfo.createdobjtypes[i]).GetTypeName);
 {$ENDIF}
@@ -739,13 +747,25 @@ unit optvirt;
                    else
                      internalerror(2008092101);
                  end;
-               classrefdef:
+               else
+                 internalerror(2008092102);
+             end;
+           end;
+
+         for i := 0 to current_module.wpoinfo.createdclassrefobjtypes.count-1 do
+           begin
+             inheritancetree.registerinstantiatedclassrefdef(tdef(current_module.wpoinfo.createdclassrefobjtypes[i]));
+{$IFDEF DEBUG_DEVIRT}
+             write('  Class Of ',tdef(current_module.wpoinfo.createdclassrefobjtypes[i]).GetTypeName);
+{$ENDIF}
+             case tdef(current_module.wpoinfo.createdclassrefobjtypes[i]).typ of
+               objectdef:
 {$IFDEF DEBUG_DEVIRT}
                  writeln(' (classrefdef)')
 {$ENDIF}
                  ;
                else
-                 internalerror(2008092102);
+                 internalerror(2008101101);
              end;
            end;
          { now add all objectdefs derived from the instantiated
@@ -755,17 +775,19 @@ unit optvirt;
          hp:=tmodule(loaded_units.first);
          while assigned(hp) do
           begin
-            { we cannot just walk over the module's deflist, because a bunch of
+            { 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)
 
-              procedure-local (or class-local) class definitions do not (yet) exist
+              procedure-local (or class-local) class definitions do not (yet)
+              exit, so it's enough to just walk the global and localsymtables
             }
             { 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) }
+            { 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]));
@@ -919,17 +941,25 @@ unit optvirt;
         unitdevirtinfo: tunitdevirtinfo;
         classdevirtinfo: tclassdevirtinfo;
         vmtentry: longint;
+        realobjdef: tobjectdef;
       begin
-         { we don't support classrefs yet, nor interfaces }
-         if (objdef.typ<>objectdef) or
-            not(tobjectdef(objdef).objecttype in [odt_class,odt_object]) then
+         { class methods are in the regular vmt, so we can handle classrefs
+           the same as plain objectdefs
+         }
+         if (objdef.typ=classrefdef) then
+           realobjdef:=tobjectdef(tclassrefdef(objdef).pointeddef)
+         else if (objdef.typ=objectdef) and
+            (tobjectdef(objdef).objecttype in [odt_class,odt_object]) then
+           realobjdef:=tobjectdef(objdef)
+         else
            begin
+             { we don't support interfaces yet }
              result:=false;
              exit;
            end;
 
          { get the component names for the class/procdef combo }
-         defsdecompose(tobjectdef(objdef), tprocdef(procdef),unitid,classid,vmtentry);
+         defsdecompose(realobjdef, tprocdef(procdef),unitid,classid,vmtentry);
 
          { do we have any info for this unit? }
          unitdevirtinfo:=findunit(unitid^);

compiler/pmodules.pas

@@ -1273,12 +1273,26 @@ implementation
                    odt_class:
                      writeln(' (class)');
                    else
-                     internalerror(2008092101);
+                     internalerror(2008101103);
                  end;
-               classrefdef:
-                 writeln(' (classrefdef)');
                else
-                 internalerror(2008092102);
+                 internalerror(2008101104);
+             end;
+           end;
+
+         for i := 0 to current_module.wpoinfo.createdclassrefobjtypes.count-1 do
+           begin
+             write('  Class Of ',tdef(current_module.wpoinfo.createdclassrefobjtypes[i]).GetTypeName);
+             case tdef(current_module.wpoinfo.createdclassrefobjtypes[i]).typ of
+               objectdef:
+                 case tobjectdef(current_module.wpoinfo.createdclassrefobjtypes[i]).objecttype of
+                   odt_class:
+                     writeln(' (classrefdef)');
+                   else
+                     internalerror(2008101105);
+                 end
+               else
+                 internalerror(2008101102);
              end;
            end;
 {$endif debug_devirt}

compiler/symdef.pas

@@ -244,7 +244,8 @@ interface
           iidguid        : pguid;
           iidstr         : pshortstring;
           writing_class_record_dbginfo,
-          created_in_current_module     : boolean;
+          created_in_current_module,
+          classref_created_in_current_module : boolean;
           { store implemented interfaces defs and name mappings }
           ImplementedInterfaces : TFPObjectList;
           constructor create(ot : tobjecttyp;const n : string;c : tobjectdef);
@@ -276,17 +277,17 @@ interface
           function implements_any_interfaces: boolean;
           procedure reset; override;
           procedure register_created_object_type;override;
+          procedure register_created_classref_type;
        end;
 
        tclassrefdef = class(tabstractpointerdef)
-          created_in_current_module : boolean;
           constructor create(def:tdef);
           constructor ppuload(ppufile:tcompilerppufile);
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           function  GetTypeName:string;override;
           function  is_publishable : boolean;override;
-          procedure reset; override;
           procedure register_created_object_type;override;
+          procedure reset;override;
        end;
 
        tarraydef = class(tstoreddef)
@@ -2043,21 +2044,17 @@ implementation
          result:=true;
       end;
       
-      
+
     procedure tclassrefdef.reset;
       begin
+        tobjectdef(pointeddef).classref_created_in_current_module:=false;
         inherited reset;
-        created_in_current_module:=false;
       end;
 
 
     procedure tclassrefdef.register_created_object_type;
       begin
-        if not created_in_current_module then
-          begin
-            created_in_current_module:=true;
-            current_module.wpoinfo.addcreatedobjtype(self);
-          end;
+        tobjectdef(pointeddef).register_created_classref_type;
       end;
 
 {***************************************************************************
@@ -4222,6 +4219,17 @@ implementation
       begin
         inherited reset;
         created_in_current_module:=false;
+        classref_created_in_current_module:=false;
+      end;
+
+
+    procedure tobjectdef.register_created_classref_type;
+      begin
+        if not classref_created_in_current_module then
+          begin
+            classref_created_in_current_module:=true;
+            current_module.wpoinfo.addcreatedobjtypeforclassref(self);
+          end;
       end;
 
 

compiler/wpobase.pas

@@ -108,13 +108,17 @@ type
    protected
     { created object types }
     fcreatedobjtypes: tfpobjectlist;
+    { objectdefs pointed to by created classrefdefs }
+    fcreatedclassrefobjtypes: tfpobjectlist;
    public
     constructor create; reintroduce; virtual;
     destructor destroy; override;
 
     property createdobjtypes: tfpobjectlist read fcreatedobjtypes;
+    property createdclassrefobjtypes: tfpobjectlist read fcreatedclassrefobjtypes;
 
     procedure addcreatedobjtype(def: tdef);
+    procedure addcreatedobjtypeforclassref(def: tdef);
   end;
 
   { ************************************************************************* }
@@ -251,6 +255,7 @@ implementation
   constructor tunitwpoinfobase.create;
     begin
       fcreatedobjtypes:=tfpobjectlist.create(false);
+      fcreatedclassrefobjtypes:=tfpobjectlist.create(false);
     end;
 
 
@@ -258,6 +263,8 @@ implementation
     begin
       fcreatedobjtypes.free;
       fcreatedobjtypes:=nil;
+      fcreatedclassrefobjtypes.free;
+      fcreatedclassrefobjtypes:=nil;
       inherited destroy;
     end;
     
@@ -267,6 +274,12 @@ implementation
       fcreatedobjtypes.add(def);
     end;
 
+  procedure tunitwpoinfobase.addcreatedobjtypeforclassref(def: tdef);
+    begin
+      fcreatedclassrefobjtypes.add(def);
+    end;
+
+
   { twpofilereader }
 
   function twpofilereader.getnextnoncommentline(out s: string):

compiler/wpoinfo.pas

@@ -39,6 +39,7 @@ type
    { devirtualisation information -- begin }
    private
     fcreatedobjtypesderefs: pderefarray;
+    fcreatedclassrefobjtypesderefs: pderefarray;
    { devirtualisation information -- end }
 
    public
@@ -81,10 +82,10 @@ implementation
           freemem(fcreatedobjtypesderefs);
           fcreatedobjtypesderefs:=nil;
         end;
-      if assigned(fcreatedobjtypes) then
+      if assigned(fcreatedclassrefobjtypesderefs) then
         begin
-          fcreatedobjtypes.free;
-          fcreatedobjtypes:=nil;
+          freemem(fcreatedclassrefobjtypesderefs);
+          fcreatedclassrefobjtypesderefs:=nil;
         end;
       inherited destroy;
     end;
@@ -100,9 +101,15 @@ implementation
       ppufile.putlongint(fcreatedobjtypes.count);
       for i:=0 to fcreatedobjtypes.count-1 do
         ppufile.putderef(fcreatedobjtypesderefs^[i]);
+      ppufile.putlongint(fcreatedclassrefobjtypes.count);
+      for i:=0 to fcreatedclassrefobjtypes.count-1 do
+        ppufile.putderef(fcreatedclassrefobjtypesderefs^[i]);
+
       ppufile.writeentry(ibcreatedobjtypes);
       freemem(fcreatedobjtypesderefs);
       fcreatedobjtypesderefs:=nil;
+      freemem(fcreatedclassrefobjtypesderefs);
+      fcreatedclassrefobjtypesderefs:=nil;
     end;
 
 
@@ -119,6 +126,13 @@ implementation
       getmem(fcreatedobjtypesderefs,len*sizeof(tderef));
       for i:=0 to len-1 do
         ppufile.getderef(fcreatedobjtypesderefs^[i]);
+
+      len:=ppufile.getlongint;
+      fcreatedclassrefobjtypes:=tfpobjectlist.create(false);
+      fcreatedclassrefobjtypes.count:=len;
+      getmem(fcreatedclassrefobjtypesderefs,len*sizeof(tderef));
+      for i:=0 to len-1 do
+        ppufile.getderef(fcreatedclassrefobjtypesderefs^[i]);
     end;
 
 
@@ -129,6 +143,10 @@ implementation
       getmem(fcreatedobjtypesderefs,fcreatedobjtypes.count*sizeof(tderef));
       for i:=0 to fcreatedobjtypes.count-1 do
         fcreatedobjtypesderefs^[i].build(fcreatedobjtypes[i]);
+
+      getmem(fcreatedclassrefobjtypesderefs,fcreatedclassrefobjtypes.count*sizeof(tderef));
+      for i:=0 to fcreatedclassrefobjtypes.count-1 do
+        fcreatedclassrefobjtypesderefs^[i].build(fcreatedclassrefobjtypes[i]);
     end;
 
 
@@ -145,6 +163,11 @@ implementation
         fcreatedobjtypes[i]:=fcreatedobjtypesderefs^[i].resolve;
       freemem(fcreatedobjtypesderefs);
       fcreatedobjtypesderefs:=nil;
+
+      for i:=0 to fcreatedclassrefobjtypes.count-1 do
+        fcreatedclassrefobjtypes[i]:=fcreatedclassrefobjtypesderefs^[i].resolve;
+      freemem(fcreatedclassrefobjtypesderefs);
+      fcreatedclassrefobjtypesderefs:=nil;
     end;