Explorar o código

* only write the parts of the unit localsymtables that are actually needed:
the defs and syms (recursively) referred by inline routines and by the WPO
info
o defs and syms are no longer added immediately to the module's deflist/
symlist, even if they are created as "registered". Instead,
"doregister=true" simply means "add it to the symbol table at the
top of the symtable stack"
o normally only when a sym/def is deref'ed, it gets added to the module
symlist/deflist and defid/symid gets a (unique) value
o in cases where we use(d) the defid to construct unique names within the
current module, you now have to call call the tdef.new unique_id_str()
method. If the def was not yet registered, we will reserve room for it
in the deflist (to get a unique id), but the defid gets set to a
negative value computed from its position in the deflist. Should it
have to be written to the ppu file later on, the defid will be
modified to the actual position in the deflist. For both values,
new unique_id_str() will return the same result so that references
to this def before and after actual registrations are the same (needed
for the JVM backend, but also a good principle in general)

Overall: don't directly use symid/defid anymore to get unique identifiers,
but use tdef.new unique_id_str() instead (if necessary, a similar routine
for tsym can be added)

The result is the ppu file size gets reduced significantly after its big
increase as a result of the high level typed constant builder (which creates
a lot of defs). The result is even more efficient than before, as other
unneeded defs/syms from the localsymtables don't get saved/restored anymore
either.

git-svn-id: trunk@32153 -

Jonas Maebe %!s(int64=9) %!d(string=hai) anos
pai
achega
2cea723a0d

+ 4 - 4
compiler/blockutl.pas

@@ -160,9 +160,9 @@ implementation
       { must be a valid Pascal identifier, because we will reference it when
         constructing the block initialiser }
       { we don't have to include the moduleid in this mangledname, because
-        the invokepd is a local procedure in the current unit -> defid by
-        itself is unique }
-      name:='__FPC_BLOCK_DESCRIPTOR_SIMPLE_'+tostr(invokepd.defid);
+        the invokepd is a local procedure in the current unit -> unique_id_str
+        by itself is unique }
+      name:='__FPC_BLOCK_DESCRIPTOR_SIMPLE_'+invokepd.unique_id_str;
       { already exists -> return }
       if searchsym(name,srsym,srsymtable) then
         begin
@@ -196,7 +196,7 @@ implementation
     begin
       { the copy() is to ensure we don't overflow the maximum identifier length;
         the combination of owner.moduleid and defid will make the name unique }
-      wrappername:='__FPC_BLOCK_INVOKE_'+upper(copy(orgpd.procsym.realname,1,60))+'_'+tostr(orgpd.owner.moduleid)+'_'+tostr(orgpd.defid);
+      wrappername:='__FPC_BLOCK_INVOKE_'+upper(copy(orgpd.procsym.realname,1,60))+'_'+tostr(orgpd.owner.moduleid)+'_'+orgpd.unique_id_str;
       { already an invoke wrapper for this procsym -> reuse }
       if searchsym(wrappername,srsym,srsymtable) then
         begin

+ 13 - 11
compiler/fppu.pas

@@ -1197,13 +1197,10 @@ var
              position in derefdata is not necessarily at the end }
             derefdata.seek(derefdata.size);
          tstoredsymtable(globalsymtable).buildderefimpl;
-         if (flags and uf_local_symtable)<>0 then
-           begin
-             tstoredsymtable(localsymtable).buildderef;
-             tstoredsymtable(localsymtable).buildderefimpl;
-           end;
          tunitwpoinfo(wpoinfo).buildderef;
          tunitwpoinfo(wpoinfo).buildderefimpl;
+         if (flags and uf_local_symtable)<>0 then
+           tstoredsymtable(localsymtable).buildderef_registered;
          writederefmap;
          writederefdata;
 
@@ -1477,9 +1474,12 @@ var
           end;
 
         { we can now derefence all pointers to the implementation parts }
-        tstoredsymtable(globalsymtable).derefimpl;
+        tstoredsymtable(globalsymtable).derefimpl(false);
+        { we've just loaded the localsymtable from the ppu file, so everything
+          in it was registered by definition (otherwise it wouldn't have been in
+          there) }
         if assigned(localsymtable) then
-            tstoredsymtable(localsymtable).derefimpl;
+          tstoredsymtable(localsymtable).derefimpl(false);
 
          { read whole program optimisation-related information }
          wpoinfo:=tunitwpoinfo.ppuload(ppufile);
@@ -1608,12 +1608,14 @@ var
                if interface_compiled then
                  begin
                    Message1(unit_u_reresolving_unit,modulename^);
-                   tstoredsymtable(globalsymtable).deref;
-                   tstoredsymtable(globalsymtable).derefimpl;
+                   tstoredsymtable(globalsymtable).deref(false);
+                   tstoredsymtable(globalsymtable).derefimpl(false);
                    if assigned(localsymtable) then
                     begin
-                      tstoredsymtable(localsymtable).deref;
-                      tstoredsymtable(localsymtable).derefimpl;
+                      { we have only builderef(impl)'d the registered symbols of
+                        the localsymtable -> also only deref those again }
+                      tstoredsymtable(localsymtable).deref(true);
+                      tstoredsymtable(localsymtable).derefimpl(true);
                     end;
                    if assigned(wpoinfo) then
                      begin

+ 2 - 2
compiler/jvm/jvmdef.pas

@@ -930,8 +930,8 @@ implementation
                         begin
                           if tdef(container.defowner).typ<>procdef then
                             internalerror(2011040303);
-                          { defid is added to prevent problem with overloads }
-                          result:=tprocdef(container.defowner).procsym.realname+'$$'+tostr(tprocdef(container.defowner).defid)+'$'+result;
+                          { unique_id_str is added to prevent problem with overloads }
+                          result:=tprocdef(container.defowner).procsym.realname+'$$'+tprocdef(container.defowner).unique_id_str+'$'+result;
                           container:=container.defowner.owner;
                         end;
                     end;

+ 6 - 6
compiler/jvm/pjvm.pas

@@ -297,7 +297,7 @@ implementation
         { create new class (different internal name than enum to prevent name
           clash; at unit level because we don't want its methods to be nested
           inside a function in case its a local type) }
-        enumclass:=cobjectdef.create(odt_javaclass,'$'+current_module.realmodulename^+'$'+name+'$InternEnum$'+tostr(def.defid),java_jlenum,true);
+        enumclass:=cobjectdef.create(odt_javaclass,'$'+current_module.realmodulename^+'$'+name+'$InternEnum$'+def.unique_id_str,java_jlenum,true);
         tcpuenumdef(def).classdef:=enumclass;
         include(enumclass.objectoptions,oo_is_enum_class);
         include(enumclass.objectoptions,oo_is_sealed);
@@ -482,7 +482,7 @@ implementation
         { create new class (different internal name than pvar to prevent name
           clash; at unit level because we don't want its methods to be nested
           inside a function in case its a local type) }
-        pvclass:=cobjectdef.create(odt_javaclass,'$'+current_module.realmodulename^+'$'+name+'$InternProcvar$'+tostr(def.defid),java_procvarbase,true);
+        pvclass:=cobjectdef.create(odt_javaclass,'$'+current_module.realmodulename^+'$'+name+'$InternProcvar$'+def.unique_id_str,java_procvarbase,true);
         tcpuprocvardef(def).classdef:=pvclass;
         include(pvclass.objectoptions,oo_is_sealed);
         if df_generic in def.defoptions then
@@ -640,10 +640,10 @@ implementation
         wrapperpv.calcparas;
         { no use in creating a callback wrapper here, this procvar type isn't
           for public consumption }
-        jvm_create_procvar_class_intern('__fpc_virtualclassmethod_pv_t'+tostr(wrapperpd.defid),wrapperpv,true);
+        jvm_create_procvar_class_intern('__fpc_virtualclassmethod_pv_t'+wrapperpd.unique_id_str,wrapperpv,true);
         { create alias for the procvar type so we can use it in generated
           Pascal code }
-        typ:=ctypesym.create('__fpc_virtualclassmethod_pv_t'+tostr(wrapperpd.defid),wrapperpv,true);
+        typ:=ctypesym.create('__fpc_virtualclassmethod_pv_t'+wrapperpd.unique_id_str,wrapperpv,true);
         wrapperpv.classdef.typesym.visibility:=vis_strictprivate;
         symtablestack.top.insert(typ);
         symtablestack.pop(pd.owner);
@@ -836,8 +836,8 @@ implementation
         visname:=visibilityName[vis];
         replace(visname,' ','_');
         { create a name that is unique amongst all units (start with '$unitname$$') and
-          unique in this unit (result.defid) }
-        finish_copied_procdef(result,'$'+current_module.realmodulename^+'$$'+tostr(result.defid)+pd.procsym.realname+'$'+visname,obj.symtable,obj);
+          unique in this unit (result.unique_id_str) }
+        finish_copied_procdef(result,'$'+current_module.realmodulename^+'$$'+result.unique_id_str+pd.procsym.realname+'$'+visname,obj.symtable,obj);
         { in case the referred method is from an external class }
         exclude(result.procoptions,po_external);
         { not virtual/override/abstract/... }

+ 4 - 4
compiler/jvm/symcpu.pas

@@ -385,9 +385,9 @@ implementation
             { method of this objectdef }
             pd.struct:=obj;
             { can only construct the artificial accessorname now, because it requires
-              pd.defid }
+              pd.unique_id_str }
             if not explicitwrapper then
-              accessorname:='$'+obj.symtable.realname^+'$'+realname+'$'+accessorname+'$'+tostr(pd.defid);
+              accessorname:='$'+obj.symtable.realname^+'$'+realname+'$'+accessorname+'$'+pd.unique_id_str;
           end
         else
           begin
@@ -397,9 +397,9 @@ implementation
             exclude(pd.procoptions,po_abstractmethod);
             exclude(pd.procoptions,po_overridingmethod);
             { can only construct the artificial accessorname now, because it requires
-              pd.defid }
+              pd.unique_id_str }
             if not explicitwrapper then
-              accessorname:='$'+obj.symtable.realname^+'$'+realname+'$'+accessorname+'$'+tostr(pd.defid);
+              accessorname:='$'+obj.symtable.realname^+'$'+realname+'$'+accessorname+'$'+pd.unique_id_str;
             finish_copied_procdef(pd,accessorname,obj.symtable,obj);
             sym:=pd.procsym;
           end;

+ 1 - 1
compiler/pexpr.pas

@@ -2818,7 +2818,7 @@ implementation
                       findwithsymtable then
                      begin
                        { create dummy symbol, it will be freed later on }
-                       srsym:=tsym.create(undefinedsym,'$undefinedsym');
+                       srsym:=tstoredsym.create(undefinedsym,'$undefinedsym',false);
                        srsymtable:=nil;
                      end
                    else

+ 1 - 1
compiler/pgenutil.pas

@@ -354,7 +354,7 @@ uses
                         { special handling for specializations inside generic function declarations }
                         if symtablestack.top.defowner.typ<>procdef then
                           internalerror(2015080101);
-                        str(symtablestack.top.defowner.defid,namepart);
+                        namepart:=tdef(symtablestack.top.defowner).unique_id_str;
                         namepart:='genproc'+namepart+'_'+tdef(symtablestack.top.defowner).fullownerhierarchyname+'_'+tprocdef(symtablestack.top.defowner).procsym.realname+'_'+typeparam.resultdef.typename;
                         prettynamepart:=tdef(symtablestack.top.defowner).fullownerhierarchyname+tprocdef(symtablestack.top.defowner).procsym.prettyname;
                       end

+ 4 - 4
compiler/symconst.pas

@@ -146,15 +146,15 @@ const
   class_helper_prefix = 'CH$';
 
   { tsym.symid value in case the sym has not yet been registered }
-  symid_not_registered = -1;
+  symid_not_registered = -2;
   { tsym.symid value in case the sym has been registered, but not put in a
     symtable }
-  symid_registered_nost = -2;
+  symid_registered_nost = -1;
   { tdef.defid value in case the def has not yet been registered }
-  defid_not_registered = -1;
+  defid_not_registered = -2;
   { tdef.defid value in case the sym has been registered, but not put in a
     symtable }
-  defid_registered_nost = -2;
+  defid_registered_nost = -1;
 
 type
   { keep this in sync with TIntfFlag in rtl/objpas/typinfo.pp }

+ 2 - 2
compiler/symcreat.pas

@@ -822,7 +822,7 @@ implementation
       callpd: tprocdef;
     begin
       callpd:=tprocdef(pd.skpara);
-      str:='var pv: __fpc_virtualclassmethod_pv_t'+tostr(pd.defid)+'; begin '
+      str:='var pv: __fpc_virtualclassmethod_pv_t'+pd.unique_id_str+'; begin '
         + 'pv:=@'+callpd.procsym.RealName+';';
       if (pd.proctypeoption<>potype_constructor) and
          not is_void(pd.returndef) then
@@ -1151,7 +1151,7 @@ implementation
       { create struct to hold local variables and parameters that are
         accessed from within nested routines (start with extra dollar to prevent
         the JVM from thinking this is a nested class in the unit) }
-      nestedvarsst:=trecordsymtable.create('$'+current_module.realmodulename^+'$$_fpc_nestedvars$'+tostr(pd.defid),
+      nestedvarsst:=trecordsymtable.create('$'+current_module.realmodulename^+'$$_fpc_nestedvars$'+pd.unique_id_str,
         current_settings.alignment.localalignmax,current_settings.alignment.localalignmin,current_settings.alignment.maxCrecordalign);
       nestedvarsdef:=crecorddef.create(nestedvarsst.name^,nestedvarsst);
 {$ifdef jvm}

+ 35 - 28
compiler/symdef.pas

@@ -68,8 +68,6 @@ interface
           procedure writeentry(ppufile: tcompilerppufile; ibnr: byte);
        protected
           typesymderef  : tderef;
-          { whether this def is already registered in the unit's def list }
-          function registered : boolean;
           procedure ppuwrite_platform(ppufile:tcompilerppufile);virtual;
           procedure ppuload_platform(ppufile:tcompilerppufile);virtual;
        public
@@ -121,8 +119,10 @@ interface
           { same as above for specializations }
           function is_specialization:boolean;inline;
           { registers this def in the unit's deflist; no-op if already registered }
-          procedure register_def;
-          property is_registered: boolean read registered;
+          procedure register_def; override;
+          { add the def to the top of the symtable stack if it's not yet owned
+            by another symtable }
+          procedure maybe_put_in_symtable_stack;
        private
           savesize  : asizeuint;
        end;
@@ -1222,7 +1222,7 @@ implementation
         typ: ttypesym;
         name: string;
       begin
-        name:=internaltypeprefixName[itp_threadvar_record]+tostr(def.defid);
+        name:=internaltypeprefixName[itp_threadvar_record]+def.unique_id_str;
         typ:=try_search_current_module_type(name);
         if assigned(typ) then
           begin
@@ -1647,12 +1647,6 @@ implementation
       end;
 
 
-    function tstoreddef.registered: boolean;
-      begin
-        result:=defid<>defid_not_registered;
-      end;
-
-
     procedure tstoreddef.ppuwrite_platform(ppufile: tcompilerppufile);
       begin
         { by default: do nothing }
@@ -1679,9 +1673,9 @@ implementation
            end of an type block }
          if (dt=forwarddef) then
            exit;
-         { register the definition if wanted }
+         { Register in symtable stack }
          if doregister then
-           register_def;
+           maybe_put_in_symtable_stack;
       end;
 
 
@@ -1789,7 +1783,7 @@ implementation
            (owner.symtabletype in [staticsymtable,globalsymtable]) then
           result:=make_mangledname(prefix,typesym.owner,typesym.name)
         else
-          result:=make_mangledname(prefix,findunitsymtable(owner),'DEF'+tostr(DefId))
+          result:=make_mangledname(prefix,findunitsymtable(owner),'def'+unique_id_str)
       end;
 
 
@@ -1924,6 +1918,8 @@ implementation
         sym : tsym;
         symderef : pderef;
       begin
+        if not registered then
+          register_def;
         typesymderef.build(typesym);
         genericdefderef.build(genericdef);
         if assigned(genconstraintdata) then
@@ -2137,21 +2133,32 @@ implementation
 
 
    procedure tstoreddef.register_def;
-     var
-       insertstack : psymtablestackitem;
      begin
        if registered then
          exit;
        { Register in current_module }
        if assigned(current_module) then
          begin
-           current_module.deflist.Add(self);
-           DefId:=current_module.deflist.Count-1;
+           if defid<defid_not_registered then
+             defid:=deflist_index
+           else
+             begin
+               current_module.deflist.Add(self);
+               defid:=current_module.deflist.Count-1;
+             end;
+           maybe_put_in_symtable_stack;
          end
        else
          DefId:=defid_registered_nost;
-       { Register in symtable stack }
-       if assigned(symtablestack) then
+     end;
+
+
+   procedure tstoreddef.maybe_put_in_symtable_stack;
+     var
+       insertstack: psymtablestackitem;
+     begin
+       if assigned(symtablestack) and
+          not assigned(self.owner) then
          begin
            insertstack:=symtablestack.stack;
            while assigned(insertstack) and
@@ -2604,7 +2611,7 @@ implementation
             symtable:=basedef.symtable.getcopy;
           end
         else
-          tenumsymtable(symtable).deref;
+          tenumsymtable(symtable).deref(false);
       end;
 
 
@@ -3566,7 +3573,7 @@ implementation
     procedure tarraydef.deref;
       begin
         inherited deref;
-        tarraysymtable(symtable).deref;
+        tarraysymtable(symtable).deref(false);
         _elementdef:=tdef(_elementdefderef.resolve);
         rangedef:=tdef(rangedefderef.resolve);
       end;
@@ -3832,7 +3839,7 @@ implementation
       begin
         inherited derefimpl;
         if not (df_copied_def in defoptions) then
-          tstoredsymtable(symtable).derefimpl;
+          tstoredsymtable(symtable).derefimpl(false);
       end;
 
 
@@ -4337,7 +4344,7 @@ implementation
              symtable:=cloneddef.symtable.getcopy;
            end
          else
-           tstoredsymtable(symtable).deref;
+           tstoredsymtable(symtable).deref(false);
 
          { internal types, only load from the system unit }
          if assigned(owner) and
@@ -4611,7 +4618,7 @@ implementation
              has_paraloc_info:=callnoside;
            end;
          { parast }
-         tparasymtable(parast).deref;
+         tparasymtable(parast).deref(false);
          { recalculated parameters }
          calcparas;
       end;
@@ -5743,8 +5750,8 @@ implementation
             { Locals }
             if assigned(localst) then
               begin
-                tlocalsymtable(localst).deref;
-                tlocalsymtable(localst).derefimpl;
+                tlocalsymtable(localst).deref(false);
+                tlocalsymtable(localst).derefimpl(false);
               end;
 
             inlininginfo^.code.derefimpl;
@@ -6570,7 +6577,7 @@ implementation
              symtable:=cloneddef.symtable.getcopy;
            end
          else
-           tstoredsymtable(symtable).deref;
+           tstoredsymtable(symtable).deref(false);
          if objecttype=odt_helper then
            extendeddef:=tdef(extendeddefderef.resolve);
          for i:=0 to vmtentries.count-1 do

+ 16 - 8
compiler/symsym.pas

@@ -43,7 +43,6 @@ interface
        { this class is the base for all symbol objects }
        tstoredsym = class(tsym)
        private
-          function registered : boolean;
           procedure writeentry(ppufile: tcompilerppufile; ibnr: byte);
        protected
           procedure ppuwrite_platform(ppufile: tcompilerppufile);virtual;
@@ -53,8 +52,8 @@ interface
           constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
           destructor destroy;override;
           procedure ppuwrite(ppufile:tcompilerppufile);virtual;
-          procedure register_sym;
-          property is_registered:boolean read registered;
+          procedure buildderef; override;
+          procedure register_sym; override;
        end;
 
        tlabelsym = class(tstoredsym)
@@ -118,6 +117,7 @@ interface
 
        terrorsym = class(Tsym)
           constructor create;
+          procedure register_sym; override;
        end;
 
        { tprocsym }
@@ -548,8 +548,6 @@ implementation
     constructor tstoredsym.create(st:tsymtyp;const n : string;doregister:boolean);
       begin
          inherited create(st,n);
-         if doregister then
-           register_sym;
       end;
 
 
@@ -592,9 +590,11 @@ implementation
       end;
 
 
-    function tstoredsym.registered: boolean;
+    procedure tstoredsym.buildderef;
       begin
-        result:=symid<>symid_not_registered;
+        inherited;
+        if not registered then
+          register_sym;
       end;
 
 
@@ -1303,6 +1303,14 @@ implementation
         inherited create(errorsym,'');
       end;
 
+
+    procedure terrorsym.register_sym;
+      begin
+        { these should never be written to a ppu file, since they don't
+          derive from tstoredsym }
+        Internalerror(2015101801);
+      end;
+
 {****************************************************************************
                                 TPROPERTYSYM
 ****************************************************************************}
@@ -1399,7 +1407,7 @@ implementation
           end
         else
         if ppo_hasparameters in propoptions then
-          tparasymtable(parast).deref
+          tparasymtable(parast).deref(false)
       end;
 
 

+ 108 - 16
compiler/symtable.pas

@@ -58,10 +58,12 @@ interface
           { load/write }
           procedure ppuload(ppufile:tcompilerppufile);virtual;
           procedure ppuwrite(ppufile:tcompilerppufile);virtual;
-          procedure buildderef;virtual;
-          procedure buildderefimpl;virtual;
-          procedure deref;virtual;
-          procedure derefimpl;virtual;
+          procedure buildderef;
+          procedure buildderefimpl;
+          { buildderef but only for (recursively) used symbols/defs }
+          procedure buildderef_registered;
+          procedure deref(only_registered: boolean);virtual;
+          procedure derefimpl(only_registered: boolean);virtual;
           function  checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
           procedure allsymbolsused;
           procedure allprivatesused;
@@ -570,18 +572,24 @@ implementation
 
     procedure tstoredsymtable.writedefs(ppufile:tcompilerppufile);
       var
+        defcount,
         i   : longint;
         def : tstoreddef;
       begin
+        defcount:=0;
+        for i:=0 to DefList.Count-1 do
+          if tstoreddef(DefList[i]).is_registered then
+            inc(defcount);
         { each definition get a number, write then the amount of defs to the
           ibstartdef entry }
-        ppufile.putlongint(DefList.count);
+        ppufile.putlongint(defcount);
         ppufile.writeentry(ibstartdefs);
         { now write the definition }
         for i:=0 to DefList.Count-1 do
           begin
             def:=tstoreddef(DefList[i]);
-            def.ppuwrite(ppufile);
+            if def.is_registered then
+              def.ppuwrite(ppufile);
           end;
         { write end of definitions }
         ppufile.writeentry(ibenddefs);
@@ -590,18 +598,24 @@ implementation
 
     procedure tstoredsymtable.writesyms(ppufile:tcompilerppufile);
       var
+        symcount,
         i   : longint;
         sym : Tstoredsym;
       begin
+        symcount:=0;
+        for i:=0 to SymList.Count-1 do
+          if tstoredsym(SymList[i]).is_registered then
+            inc(symcount);
         { each definition get a number, write then the amount of syms and the
           datasize to the ibsymdef entry }
-        ppufile.putlongint(SymList.count);
+        ppufile.putlongint(symcount);
         ppufile.writeentry(ibstartsyms);
         { foreach is used to write all symbols }
         for i:=0 to SymList.Count-1 do
           begin
             sym:=tstoredsym(SymList[i]);
-            sym.ppuwrite(ppufile);
+            if sym.is_registered then
+              sym.ppuwrite(ppufile);
           end;
         { end of symbols }
         ppufile.writeentry(ibendsyms);
@@ -643,7 +657,77 @@ implementation
       end;
 
 
-    procedure tstoredsymtable.deref;
+    procedure tstoredsymtable.buildderef_registered;
+      var
+        def : tstoreddef;
+        sym : tstoredsym;
+        i   : longint;
+        defidmax,
+        symidmax: longint;
+        newbuiltdefderefs,
+        builtdefderefs,
+        builtsymderefs: array of boolean;
+      begin
+        { tdefs for which we already built the deref }
+        setlength(builtdefderefs,deflist.count);
+        { tdefs for which we built the deref in this iteration }
+        setlength(newbuiltdefderefs,deflist.count);
+        { syms for which we already built the deref }
+        setlength(builtsymderefs,symlist.count);
+        repeat
+          { we only have to store the defs (recursively) referred by wpo info
+            or inlined routines in the static symbtable }
+
+          { current number of registered defs/syms }
+          defidmax:=current_module.deflist.count;
+          symidmax:=current_module.symlist.count;
+
+          { build the derefs for the registered defs we haven't processed yet }
+          for i:=0 to DefList.Count-1 do
+            begin
+              if not builtdefderefs[i] then
+                begin
+                  def:=tstoreddef(DefList[i]);
+                  if def.is_registered then
+                    begin
+                      def.buildderef;
+                      newbuiltdefderefs[i]:=true;
+                      builtdefderefs[i]:=true;
+                    end;
+                end;
+            end;
+          { same for the syms }
+          for i:=0 to SymList.Count-1 do
+            begin
+              if not builtsymderefs[i] then
+                begin
+                  sym:=tstoredsym(SymList[i]);
+                  if sym.is_registered then
+                    begin
+                      sym.buildderef;
+                      builtsymderefs[i]:=true;
+                    end;
+                end;
+            end;
+          { now buildderefimpl for the defs we processed in this iteration }
+          for i:=0 to DefList.Count-1 do
+            begin
+              if newbuiltdefderefs[i] then
+                begin
+                  newbuiltdefderefs[i]:=false;
+                  tstoreddef(DefList[i]).buildderefimpl;
+                end;
+            end;
+        { stop when no new defs or syms have been registered while processing
+          the currently registered ones (defs/syms get added to the module's
+          deflist/symlist when they are registered) }
+        until
+          (defidmax=current_module.deflist.count) and
+          (symidmax=current_module.symlist.count);
+      end;
+
+
+    procedure tstoredsymtable.deref(only_registered: boolean);
       var
         i   : longint;
         def : tstoreddef;
@@ -656,26 +740,32 @@ implementation
         for i:=0 to SymList.Count-1 do
           begin
             sym:=tstoredsym(SymList[i]);
-            if sym.typ=typesym then
+            if (sym.typ=typesym) and
+               (not only_registered or
+                sym.is_registered) then
               sym.deref;
           end;
         { interface definitions }
         for i:=0 to DefList.Count-1 do
           begin
             def:=tstoreddef(DefList[i]);
-            def.deref;
+            if not only_registered or
+               def.is_registered then
+              def.deref;
           end;
         { interface symbols }
         for i:=0 to SymList.Count-1 do
           begin
             sym:=tstoredsym(SymList[i]);
-            if sym.typ<>typesym then
+            if (not only_registered or
+                sym.is_registered) and
+               (sym.typ<>typesym) then
               sym.deref;
           end;
       end;
 
 
-    procedure tstoredsymtable.derefimpl;
+    procedure tstoredsymtable.derefimpl(only_registered: boolean);
       var
         i   : longint;
         def : tstoreddef;
@@ -684,7 +774,9 @@ implementation
         for i:=0 to DefList.Count-1 do
           begin
             def:=tstoreddef(DefList[i]);
-            def.derefimpl;
+            if not only_registered or
+               def.is_registered then
+              def.derefimpl;
           end;
       end;
 
@@ -2277,7 +2369,7 @@ implementation
         inherited ppuload(ppufile);
 
         { now we can deref the syms and defs }
-        deref;
+        deref(false);
       end;
 
 
@@ -2324,7 +2416,7 @@ implementation
          inherited ppuload(ppufile);
 
          { now we can deref the syms and defs }
-         deref;
+         deref(false);
       end;
 
 

+ 73 - 2
compiler/symtype.pas

@@ -52,6 +52,10 @@ interface
       tgeTSymtable = (gs_none,gs_record,gs_local,gs_para);
 
       tdef = class(TDefEntry)
+        protected
+         { whether this def is already registered in the unit's def list }
+         function registered : boolean;
+        public
          typesym    : tsym;  { which type the definition was generated this def }
          { stabs debugging }
          stab_number : word;
@@ -72,6 +76,7 @@ interface
          function  rtti_mangledname(rt:trttitype):TSymStr;virtual;abstract;
          function  OwnerHierarchyName: string; virtual; abstract;
          function  fullownerhierarchyname:string;virtual;abstract;
+         function  unique_id_str: string;
          function  size:asizeint;virtual;abstract;
          function  packedbitsize:asizeint;virtual;
          function  alignment:shortint;virtual;abstract;
@@ -87,6 +92,11 @@ interface
          function getreusablesymtab: tsymtable;
          procedure register_created_object_type;virtual;
          function  get_top_level_symtable: tsymtable;
+         { only valid for registered defs and defs for which a unique id string
+           has been requested; otherwise, first call register_def }
+         function  deflist_index: longint;
+         procedure register_def; virtual; abstract;
+         property is_registered: boolean read registered;
       end;
 
 {************************************************
@@ -99,6 +109,7 @@ interface
 
       tsym = class(TSymEntry)
       protected
+       function registered : boolean;
       public
          fileinfo   : tfileposinfo;
          { size of fileinfo is 10 bytes, so if a >word aligned type would follow,
@@ -121,6 +132,8 @@ interface
          procedure IncRefCountBy(AValue : longint);
          procedure MaybeCreateRefList;
          procedure AddRef;
+         procedure register_sym; virtual; abstract;
+         property is_registered:boolean read registered;
       end;
 
       tsymarr = array[0..maxlongint div sizeof(pointer)-1] of tsym;
@@ -251,6 +264,12 @@ implementation
                                 Tdef
 ****************************************************************************}
 
+    function tdef.registered: boolean;
+      begin
+        result:=defid>defid_not_registered;
+      end;
+
+
     constructor tdef.create(dt:tdeftyp);
       begin
          inherited create;
@@ -318,6 +337,26 @@ implementation
       end;
 
 
+    function tdef.unique_id_str: string;
+      begin
+        if (defid=defid_not_registered) or
+           (defid=defid_registered_nost) then
+          begin
+            if not assigned(current_module) then
+              internalerror(2015102505);
+            current_module.deflist.Add(self);
+            { invert the defid to indicate that it was only set because we
+              needed a unique number -- then add defid_not_registered so we
+              don't get the values between defid_registered and 0 }
+            defid:=-(current_module.deflist.Count-1)+defid_not_registered-1;
+          end;
+        { use deflist_index so that it will remain the same if def first gets a
+          defid just for the unique id (as above) and later it gets registered
+          because it must be saved to the ppu }
+        result:=hexstr(deflist_index,sizeof(defid)*2);
+      end;
+
+
     function tdef.getparentdef:tdef;
       begin
         result:=nil;
@@ -384,10 +423,27 @@ implementation
           result:=tdef(result.defowner).owner;
       end;
 
+
+    function tdef.deflist_index: longint;
+      begin
+        if defid<defid_not_registered then
+          result:=-(defid-defid_not_registered+1)
+        else if defid>=0 then
+          result:=defid
+        else
+          internalerror(2015102502)
+      end;
+
 {****************************************************************************
                           TSYM (base for all symtypes)
 ****************************************************************************}
 
+    function tsym.registered: boolean;
+      begin
+        result:=symid>symid_not_registered;
+      end;
+
+
     constructor tsym.create(st:tsymtyp;const aname:string);
       begin
          inherited CreateNotOwned;
@@ -680,9 +736,24 @@ implementation
          begin
 { TODO: ugly hack}
            if s is tsym then
-             st:=FindUnitSymtable(tsym(s).owner)
+             begin
+               { if it has been registered but it wasn't put in a symbol table,
+                 this symbol shouldn't be written to a ppu }
+               if tsym(s).SymId=symid_registered_nost then
+                 Internalerror(2015102504);
+               if not tsym(s).registered then
+                 tsym(s).register_sym;
+               st:=FindUnitSymtable(tsym(s).owner)
+             end
            else
-             st:=FindUnitSymtable(tdef(s).owner);
+             begin
+               { same as above }
+               if tdef(s).defid=defid_registered_nost then
+                 Internalerror(2015102505);
+               if not tdef(s).registered then
+                 tdef(s).register_def;
+               st:=FindUnitSymtable(tdef(s).owner);
+             end;
            if not st.iscurrentunit then
              begin
                { register that the unit is needed for resolving }