* refactor tclassheader in tvmtbuilder and tvmtwriter

  * fix rtti generation
  * rtti is now written at the end of a module when all info is available,
    this prevents some duplicate rtti entries cause by inheritance

git-svn-id: trunk@5363 -

compiler/dbgdwarf.pas

@@ -612,7 +612,7 @@ implementation
         { Need a new label? }
         if not assigned(def.dwarf_lab) then
           begin
-            if (df_has_dwarf_dbg_info in def.defoptions) then
+            if (ds_dwarf_dbg_info_written in def.defstates) then
               begin
                 if not assigned(def.typesym) then
                   internalerror(200610011);
@@ -628,7 +628,7 @@ implementation
                    (def.owner.iscurrentunit) then
                   begin
                     def.dwarf_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym)),AB_GLOBAL,AT_DATA);
-                    include(def.defoptions,df_has_dwarf_dbg_info);
+                    include(def.defstates,ds_dwarf_dbg_info_written);
                   end
                 else
                   { The pointer typecast is needed to prevent a problem with range checking
@@ -1388,7 +1388,7 @@ implementation
 
         current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Definition '+def.typename)));
         labsym:=def_dwarf_lab(def);
-        if df_has_dwarf_dbg_info in def.defoptions then
+        if ds_dwarf_dbg_info_written in def.defstates then
           current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0))
         else
           current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));

compiler/ncgrtti.pas

@@ -68,7 +68,7 @@ implementation
 
 
     const
-       rttidefopt : array[trttitype] of tdefoption = (df_has_rttitable,df_has_inittable);
+       rttidefstate : array[trttitype] of tdefstate = (ds_rtti_table_written,ds_init_table_written);
 
     type
        TPropNameListItem = class(TFPHashObject)
@@ -831,18 +831,20 @@ implementation
           recorddef :
             fields_write_rtti(trecorddef(def).symtable,rt);
           objectdef :
-            if rt=initrtti then
-              fields_write_rtti(tobjectdef(def).symtable,rt)
-            else
-              published_write_rtti(tobjectdef(def).symtable,rt);
+            begin
+              if assigned(tobjectdef(def).childof) then
+                write_rtti(tobjectdef(def).childof,rt);
+              if rt=initrtti then
+                fields_write_rtti(tobjectdef(def).symtable,rt)
+              else
+                published_write_rtti(tobjectdef(def).symtable,rt);
+            end;
         end;
       end;
 
 
     function TRTTIWriter.ref_rtti(def:tdef;rt:trttitype):tasmsymbol;
       begin
-        if not(rttidefopt[rt] in def.defoptions) then
-          internalerror(200611037);
         result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt));
       end;
 
@@ -851,14 +853,13 @@ implementation
       var
         rttilab : tasmsymbol;
       begin
-        if rttidefopt[rt] in def.defoptions then
-          exit;
-        { only write the rttis of defs defined in the current unit,
-          otherwise we will generate duplicate asmsymbols }
+        { only write rtti of definitions from the current module }
         if not findunitsymtable(def.owner).iscurrentunit then
-          internalerror(200611035);
+          exit;
         { prevent recursion }
-        include(def.defoptions,rttidefopt[rt]);
+        if rttidefstate[rt] in def.defstates then
+          exit;
+        include(def.defstates,rttidefstate[rt]);
         { write first all dependencies }
         write_child_rtti_data(def,rt);
         { write rtti data }
@@ -873,9 +874,7 @@ implementation
 
     function TRTTIWriter.get_rtti_label(def:tdef;rt:trttitype):tasmsymbol;
       begin
-        if not(rttidefopt[rt] in def.defoptions) then
-          write_rtti(def,rt);
-        result:=ref_rtti(def,rt);
+        result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt));
       end;
 
 end.

compiler/pdecl.pas

@@ -57,7 +57,7 @@ implementation
        { symtable }
        symconst,symbase,symtype,symdef,symtable,paramgr,defutil,
        { pass 1 }
-       nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
+       nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nobj,
        { codegen }
        ncgutil,
        { parser }
@@ -235,8 +235,6 @@ implementation
                       { add default calling convention }
                       handle_calling_convention(tabstractprocdef(hdef));
                     end;
-                   { write rtti/init tables }
-                   write_persistent_type_info(hdef);
                    if not skipequal then
                     begin
                       { get init value }
@@ -406,6 +404,7 @@ implementation
          istyperenaming : boolean;
          generictypelist : TFPObjectList;
          generictokenbuf : tdynamicarray;
+         vmtbuilder : TVMTBuilder;
       begin
          old_block_type:=block_type;
          block_type:=bt_type;
@@ -533,7 +532,19 @@ implementation
                        handle_calling_convention(tprocvardef(hdef));
                      end;
                   end;
-                objectdef,
+                objectdef :
+                  begin
+                    { Build VMT indexes, skip for type renaming and forward classes }
+                    if (hdef.typesym=newtype) and
+                       not(oo_is_forward in tobjectdef(hdef).objectoptions) then
+                      begin
+                        vmtbuilder:=TVMTBuilder.Create(tobjectdef(hdef));
+                        vmtbuilder.generate_vmt;
+                        vmtbuilder.free;
+                      end;
+                    try_consume_hintdirective(newtype.symoptions);
+                    consume(_SEMICOLON);
+                  end;
                 recorddef :
                   begin
                     try_consume_hintdirective(newtype.symoptions);
@@ -555,18 +566,6 @@ implementation
                { Generic is never a type renaming }
                hdef.typesym:=newtype;
              end;
-
-           { Write tables if there are no errors and we are the typesym that
-             defines this type, so this will not be done for simple type renamings }
-           if (hdef.typ<>errordef) and
-              (hdef.typesym=newtype) then
-            begin
-              { file position }
-              oldfilepos:=current_filepos;
-              current_filepos:=newtype.fileinfo;
-              write_persistent_type_info(hdef);
-              current_filepos:=oldfilepos;
-            end;
          until token<>_ID;
          typecanbeforward:=false;
          symtablestack.top.SymList.ForEachCall(@resolve_type_forward,nil);

compiler/pdecobj.pas

@@ -179,8 +179,8 @@ implementation
               if assigned(def) and
                  (def.typ=procdef) then
                 begin
-                  tprocdef(def).extnumber:=aktobjectdef.lastvtableindex;
-                  inc(aktobjectdef.lastvtableindex);
+//                  tprocdef(def).extnumber:=aktobjectdef.lastvtableindex;
+//                  inc(aktobjectdef.lastvtableindex);
                   include(tprocdef(def).procoptions,po_virtualmethod);
                   tprocdef(def).forwarddef:=false;
                 end;

compiler/pmodules.pas

@@ -43,7 +43,7 @@ implementation
        link,assemble,import,export,gendef,ppu,comprsrc,dbgbase,
        cresstr,procinfo,
        pexports,
-       scanner,pbase,pexpr,psystem,psub,pdecsub;
+       scanner,pbase,pexpr,psystem,psub,pdecsub,ptype;
 
 
     procedure create_objectfile;
@@ -1110,10 +1110,6 @@ implementation
          { do we need to add the variants unit? }
          maybeloadvariantsunit;
 
-         { generate debuginfo }
-         if (cs_debuginfo in current_settings.moduleswitches) then
-           debuginfo.inserttypeinfo;
-
          { generate wrappers for interfaces }
          gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.globalsymtable);
          gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable);
@@ -1121,12 +1117,20 @@ implementation
          { generate pic helpers to load eip if necessary }
          gen_pic_helpers(current_asmdata.asmlists[al_procedures]);
 
+         { generate rtti/init tables }
+         write_persistent_type_info(current_module.globalsymtable);
+         write_persistent_type_info(current_module.localsymtable);
+
          { Tables }
          insertThreadVars;
 
          { Resource strings }
          GenerateResourceStrings;
 
+         { generate debuginfo }
+         if (cs_debuginfo in current_settings.moduleswitches) then
+           debuginfo.inserttypeinfo;
+
          { generate imports }
          if current_module.ImportLibraryList.Count>0 then
            importlib.generatelib;
@@ -1437,22 +1441,25 @@ implementation
            InsertPData;
 {$endif arm}
 
-         { generate debuginfo }
-         if (cs_debuginfo in current_settings.moduleswitches) then
-           debuginfo.inserttypeinfo;
-
          InsertThreadvars;
 
-         { generate wrappers for interfaces }
-         gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable);
-
          { generate pic helpers to load eip if necessary }
          gen_pic_helpers(current_asmdata.asmlists[al_procedures]);
 
+         { generate rtti/init tables }
+         write_persistent_type_info(current_module.localsymtable);
+
+         { generate wrappers for interfaces }
+         gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable);
+
          { generate imports }
          if current_module.ImportLibraryList.Count>0 then
            importlib.generatelib;
 
+         { generate debuginfo }
+         if (cs_debuginfo in current_settings.moduleswitches) then
+           debuginfo.inserttypeinfo;
+
          if islibrary or (target_info.system in system_unit_program_exports) then
            exportlib.generatelib;
 

compiler/psystem.pas

@@ -112,9 +112,6 @@ implementation
         begin
           result:=ttypesym.create(s,def);
           systemunit.insert(result);
-          { write always RTTI to get persistent typeinfo }
-          RTTIWriter.write_rtti(def,initrtti);
-          RTTIWriter.write_rtti(def,fullrtti);
         end;
 
       var

compiler/ptype.pas

@@ -26,7 +26,8 @@ unit ptype;
 interface
 
     uses
-       globtype,cclasses,symtype,symdef;
+       globtype,cclasses,
+       symtype,symdef,symbase;
 
     const
        { forward types should only be possible inside a TYPE statement }
@@ -50,7 +51,7 @@ interface
     procedure read_anon_type(var def : tdef;parseprocvardir:boolean);
 
     { generate persistent type information like VMT, RTTI and inittables }
-    procedure write_persistent_type_info(def : tdef);
+    procedure write_persistent_type_info(st:tsymtable);
 
 
 implementation
@@ -64,7 +65,7 @@ implementation
        { target }
        paramgr,
        { symtable }
-       symconst,symbase,symsym,symtable,
+       symconst,symsym,symtable,
        defutil,defcmp,
        { pass 1 }
        node,ncgrtti,nobj,
@@ -771,43 +772,61 @@ implementation
       end;
 
 
-    procedure write_persistent_type_info(def : tdef);
+    procedure write_persistent_type_info(st:tsymtable);
       var
-        ch  : tclassheader;
+        i : longint;
+        def : tdef;
+        vmtwriter  : TVMTWriter;
       begin
-        { generate persistent init/final tables when it's declared in the interface so it can
-          be reused in other used }
-        if def.owner.symtabletype=globalsymtable then
-          RTTIWriter.write_rtti(def,initrtti);
-
-        { for objects we should write the vmt and interfaces.
-          This need to be done after the rtti has been written, because
-          it can contain a reference to that data (PFV)
-          This is not for forward classes }
-        if (def.typ=objectdef) then
+        for i:=0 to st.DefList.Count-1 do
           begin
-            if not(oo_vmt_written in tobjectdef(def).objectoptions) and
-               not(oo_is_forward in tobjectdef(def).objectoptions) then
-              begin
-                ch:=tclassheader.create(tobjectdef(def));
-                { generate and check virtual methods, must be done
-                  before RTTI is written }
-                ch.genvmt;
-                { Generate RTTI for class }
-                RTTIWriter.write_rtti(def,fullrtti);
-                if is_interface(tobjectdef(def)) then
-                  ch.writeinterfaceids;
-                if (oo_has_vmt in tobjectdef(def).objectoptions) then
-                  ch.writevmt;
-                ch.free;
-                include(tobjectdef(def).objectoptions,oo_vmt_written);
-              end;
-          end
-        else
-          begin
-            { Always generate RTTI info for all types. This is to have typeinfo() return
-              the same pointer }
-            if def.owner.symtabletype=globalsymtable then
+            def:=tdef(st.DefList[i]);
+            if df_deleted in def.defoptions then
+              continue;
+            case def.typ of
+              recorddef :
+                write_persistent_type_info(trecorddef(def).symtable);
+              objectdef :
+                begin
+                  write_persistent_type_info(tobjectdef(def).symtable);
+                  { Write also VMT }
+                  if not(ds_vmt_written in def.defstates) and
+                     not(oo_is_forward in tobjectdef(def).objectoptions) then
+                    begin
+                      vmtwriter:=TVMTWriter.create(tobjectdef(def));
+                      if is_interface(tobjectdef(def)) then
+                        vmtwriter.writeinterfaceids;
+                      if (oo_has_vmt in tobjectdef(def).objectoptions) then
+                        vmtwriter.writevmt;
+                      vmtwriter.free;
+                      include(def.defstates,ds_vmt_written);
+                    end;
+                end;
+              procdef :
+                begin
+                  if assigned(tprocdef(def).localst) and
+                     (tprocdef(def).localst.symtabletype=localsymtable) then
+                    write_persistent_type_info(tprocdef(def).localst);
+                  if assigned(tprocdef(def).parast) then
+                    write_persistent_type_info(tprocdef(def).parast);
+                end;
+            end;
+            { generate always persistent tables for types in the interface so it can
+              be reused in other units and give always the same pointer location. }
+            { Init }
+            if (
+                assigned(def.typesym) and
+                (st.symtabletype=globalsymtable)
+               ) or
+               def.needs_inittable or
+               (ds_init_table_used in def.defstates) then
+              RTTIWriter.write_rtti(def,initrtti);
+            { RTTI }
+            if (
+                  assigned(def.typesym) and
+                  (st.symtabletype=globalsymtable)
+               ) or
+               (ds_rtti_table_used in def.defstates) then
               RTTIWriter.write_rtti(def,fullrtti);
           end;
       end;

compiler/symconst.pas

@@ -142,12 +142,6 @@ type
 
   { flags for a definition }
   tdefoption=(df_none,
-    { init data has been generated }
-    df_has_inittable,
-    { rtti data has been generated }
-    df_has_rttitable,
-    { dwarf debug info has been generated }
-    df_has_dwarf_dbg_info,
     { type is unique, i.e. declared with type = type <tdef>; }
     df_unique,
     { type is a generic }
@@ -159,6 +153,17 @@ type
   );
   tdefoptions=set of tdefoption;
 
+  tdefstate=(ds_none,
+    ds_vmt_written,
+    ds_rtti_table_used,
+    ds_init_table_used,
+    ds_rtti_table_written,
+    ds_init_table_written,
+    ds_dwarf_dbg_info_used,
+    ds_dwarf_dbg_info_written
+  );
+  tdefstates=set of tdefstate;
+
   { tsymlist entry types }
   tsltype = (sl_none,
     sl_load,
@@ -305,8 +310,7 @@ type
     oo_has_msgstr,
     oo_has_msgint,
     oo_can_have_published,{ the class has rtti, i.e. you can publish properties }
-    oo_has_default_property,
-    oo_vmt_written
+    oo_has_default_property
   );
   tobjectoptions=set of tobjectoption;
 

compiler/symdef.pas

@@ -227,6 +227,7 @@ interface
           objectoptions  : tobjectoptions;
           { to be able to have a variable vmt position }
           { and no vmt field for objects without virtuals }
+          vmtentries     : TFPObjectList;
           vmt_offset     : longint;
           writing_class_record_dbginfo : boolean;
           objecttype     : tobjecttyp;
@@ -919,9 +920,15 @@ implementation
         prefix : string[4];
       begin
         if rt=fullrtti then
-          prefix:='RTTI'
+          begin
+            prefix:='RTTI';
+            include(defstates,ds_rtti_table_used);
+          end
         else
-          prefix:='INIT';
+          begin
+            prefix:='INIT';
+            include(defstates,ds_init_table_used);
+          end;
         if assigned(typesym) and
            (owner.symtabletype in [staticsymtable,globalsymtable]) then
           result:=make_mangledname(prefix,owner,typesym.name)
@@ -2151,7 +2158,8 @@ implementation
 
     constructor tarraydef.create_from_pointer(def:tdef);
       begin
-         self.create(0,$7fffffff,s32inttype);
+         { use -1 so that the elecount will not overflow }
+         self.create(0,$7fffffff-1,s32inttype);
          arrayoptions:=[ado_IsConvertedPointer];
          setelementdef(def);
       end;
@@ -3560,6 +3568,7 @@ implementation
         childof:=nil;
         symtable:=tObjectSymtable.create(self,n,current_settings.packrecords);
         { create space for vmt !! }
+        vmtentries:=nil;
         vmt_offset:=0;
         lastvtableindex:=0;
         set_parent(c);
@@ -3593,6 +3602,7 @@ implementation
          tObjectSymtable(symtable).fieldalignment:=ppufile.getbyte;
          tObjectSymtable(symtable).recordalignment:=ppufile.getbyte;
          vmt_offset:=ppufile.getlongint;
+         vmtentries:=nil;
          ppufile.getderef(childofderef);
          ppufile.getsmallset(objectoptions);
 
@@ -3658,6 +3668,11 @@ implementation
              dispose(iidguid);
              iidguid:=nil;
            end;
+         if assigned(vmtentries) then
+           begin
+             vmtentries.free;
+             vmtentries:=nil;
+           end;
          inherited destroy;
       end;
 
@@ -3687,6 +3702,11 @@ implementation
             for i:=0 to ImplementedInterfaces.count-1 do
               tobjectdef(result).ImplementedInterfaces.Add(TImplementedInterface(ImplementedInterfaces[i]).Getcopy);
           end;
+        if assigned(vmtentries) then
+          begin
+            tobjectdef(result).vmtentries:=TFPobjectList.Create(false);
+            tobjectdef(result).vmtentries.Assign(vmtentries);
+          end;
       end;
 
 

compiler/symtype.pas

@@ -60,8 +60,9 @@ interface
          dwarf_lab : tasmsymbol;
          { stabs debugging }
          stab_number : word;
-         dbg_state  : tdefdbgstatus;
-         defoptions : tdefoptions;
+         dbg_state   : tdefdbgstatus;
+         defoptions  : tdefoptions;
+         defstates   : tdefstates;
          constructor create(dt:tdeftyp);
          procedure buildderef;virtual;abstract;
          procedure buildderefimpl;virtual;abstract;
@@ -193,7 +194,7 @@ interface
        current_object_option : tsymoptions = [sp_public];
 
     function  FindUnitSymtable(st:TSymtable):TSymtable;
-    
+
 
 implementation
 

compiler/utils/ppudump.pp

@@ -741,35 +741,54 @@ end;
 
 procedure readcommondef(const s:string);
 type
+  { flags for a definition }
   tdefoption=(df_none,
-    { init data has been generated }
-    df_has_inittable,
-    { rtti data has been generated }
-    df_has_rttitable,
-    { dwarf debug info has been generated }
-    df_has_dwarf_dbg_info,
     { type is unique, i.e. declared with type = type <tdef>; }
     df_unique,
     { type is a generic }
     df_generic,
     { type is a specialization of a generic type }
-    df_specialization
+    df_specialization,
+    { type is deleted does not to be stored in ppu }
+    df_deleted
   );
   tdefoptions=set of tdefoption;
+
+  tdefstate=(ds_none,
+    ds_vmt_written,
+    ds_rtti_table_used,
+    ds_init_table_used,
+    ds_rtti_table_written,
+    ds_init_table_written,
+    ds_dwarf_dbg_info_used,
+    ds_dwarf_dbg_info_written
+  );
+  tdefstates=set of tdefstate;
   tdefopt=record
     mask : tdefoption;
     str  : string[30];
   end;
+  tdefstateinfo=record
+    mask : tdefstate;
+    str  : string[30];
+  end;
 const
-  defopts=6;
+  defopts=3;
   defopt : array[1..defopts] of tdefopt=(
-     (mask:df_has_inittable;  str:'InitTable'),
-     (mask:df_has_rttitable;  str:'RTTITable'),
-     (mask:df_has_dwarf_dbg_info;  str:'Dwarf DbgInfo'),
      (mask:df_unique;         str:'Unique Type'),
      (mask:df_generic;        str:'Generic'),
      (mask:df_specialization; str:'Specialization')
   );
+  defstateinfos=7;
+  defstate : array[1..defstateinfos] of tdefstateinfo=(
+     (mask:ds_init_table_used;       str:'InitTable Used'),
+     (mask:ds_rtti_table_used;       str:'RTTITable Used'),
+     (mask:ds_init_table_written;    str:'InitTable Written'),
+     (mask:ds_rtti_table_written;    str:'RTTITable Written'),
+     (mask:ds_dwarf_dbg_info_used;   str:'Dwarf DbgInfo Used'),
+     (mask:ds_dwarf_dbg_info_written;str:'Dwarf DbgInfo Written'),
+     (mask:ds_vmt_written;           str:'VMT Written')
+  );
 var
   defoptions : tdefoptions;
   i      : longint;