* use unique symid and defid per module

git-svn-id: trunk@5061 -

compiler/fmodule.pas

@@ -123,6 +123,8 @@ interface
         derefmapsize  : longint;  { number of units in the map }
         derefdataintflen : longint;
         derefdata     : tdynamicarray;
+        deflist,
+        symlist       : TFPObjectList;
         globalsymtable,           { pointer to the global symtable of this unit }
         localsymtable : tsymtable;{ pointer to the local symtable of this unit }
         globalmacrosymtable,           { pointer to the global macro symtable of this unit }
@@ -409,6 +411,8 @@ implementation
         derefmapcnt:=0;
         derefdata:=TDynamicArray.Create(1024);
         derefdataintflen:=0;
+        deflist:=TFPObjectList.Create(false);
+        symlist:=TFPObjectList.Create(false);
         globalsymtable:=nil;
         localsymtable:=nil;
         globalmacrosymtable:=nil;
@@ -510,6 +514,8 @@ implementation
         d:=tmemdebug.create(modulename^+' - symtable');
 {$endif}
         derefdata.free;
+        deflist.free;
+        symlist.free;
         if assigned(globalsymtable) then
           globalsymtable.free;
         if assigned(localsymtable) then
@@ -579,6 +585,10 @@ implementation
             localmacrosymtable.free;
             localmacrosymtable:=nil;
           end;
+        deflist.free;  
+        deflist:=TFPObjectList.Create(false);
+        symlist.free;
+        symlist:=TFPObjectList.Create(false);
         derefdata.free;
         derefdata:=TDynamicArray.Create(1024);
         if assigned(unitmap) then

compiler/fppu.pas

@@ -249,6 +249,8 @@ uses
         Message1(unit_u_ppu_flags,tostr(flags));
         Message1(unit_u_ppu_crc,hexstr(ppufile.header.checksum,8));
         Message1(unit_u_ppu_crc,hexstr(ppufile.header.interface_checksum,8)+' (intfc)');
+        Comment(V_used,'Number of definitions: '+tostr(ppufile.header.deflistsize));
+        Comment(V_used,'Number of symbols: '+tostr(ppufile.header.symlistsize));
         do_compile:=false;
         openppu:=true;
       end;
@@ -1106,6 +1108,8 @@ uses
          ppufile.header.cpu:=word(target_cpu);
          ppufile.header.target:=word(target_info.system);
          ppufile.header.flags:=flags;
+         ppufile.header.deflistsize:=current_module.deflist.count;
+         ppufile.header.symlistsize:=current_module.symlist.count;
          ppufile.writeheader;
 
          { save crc in current module also }
@@ -1247,6 +1251,8 @@ uses
         { ok, now load the interface of this unit }
         if current_module<>self then
          internalerror(200208187);
+        deflist.count:=ppufile.header.deflistsize;
+        symlist.count:=ppufile.header.symlistsize;
         globalsymtable:=tglobalsymtable.create(modulename^,moduleid);
         tstoredsymtable(globalsymtable).ppuload(ppufile);
 

compiler/ppu.pas

@@ -164,7 +164,9 @@ type
     size     : longint; { size of the ppufile without header }
     checksum : cardinal; { checksum for this ppufile }
     interface_checksum : cardinal;
-    future   : array[0..2] of longint;
+    deflistsize,
+    symlistsize : longint;
+    future   : array[0..0] of longint;
   end;
 
   tppuentry=packed record

compiler/symbase.pas

@@ -63,6 +63,7 @@ interface
 
       tdefentry = class(tsymtableentry)
          deftype : tdeftype;
+         defid   : longint;
       end;
 
 
@@ -73,6 +74,7 @@ interface
       { this object is the base for all symbol objects }
       tsymentry = class(tsymtableentry)
          typ   : tsymtyp;
+         symid : longint;
       end;
 
 

compiler/symconst.pas

@@ -126,7 +126,9 @@ type
     deref_record,
     deref_local,
     deref_para,
-    deref_parent_object
+    deref_parent_object,
+    deref_symid,
+    deref_defid
   );
 
   { symbol options }

compiler/symdef.pas

@@ -912,11 +912,18 @@ implementation
          fillchar(localrttilab,sizeof(localrttilab),0);
          generictokenbuf:=nil;
          genericdef:=nil;
-         { Register in symtable stack.
+         { Don't register forwarddefs, they are disposed at the
-           Don't register forwarddefs, they are disposed at the
            end of an type block }
-         if assigned(symtablestack) and
+         if (dt=forwarddef) then
-            (dt<>forwarddef) then
+           exit;
+         { Register in current_module }
+         if assigned(current_module) then
+           begin
+             current_module.deflist.Add(self);
+             DefId:=current_module.deflist.Count-1;
+           end;
+         { Register in symtable stack }
+         if assigned(symtablestack) then
            begin
              insertstack:=symtablestack.stack;
              while assigned(insertstack) and
@@ -951,6 +958,8 @@ implementation
 {$endif}
          fillchar(localrttilab,sizeof(localrttilab),0);
       { load }
+         DefId:=ppufile.getlongint;
+         current_module.deflist[DefId]:=self;
          indexnr:=ppufile.getword;
          ppufile.getderef(typesymderef);
          ppufile.getsmallset(defoptions);
@@ -1002,6 +1011,7 @@ implementation
         buf  : array[0..255] of byte;
         oldintfcrc : boolean;
       begin
+        ppufile.putlongint(DefId);
         ppufile.putword(indexnr);
         ppufile.putderef(typesymderef);
         ppufile.putsmallset(defoptions);

compiler/symsym.pas

@@ -366,6 +366,7 @@ implementation
        systems,
        { symtable }
        defutil,symtable,
+       fmodule,
        { tree }
        node,
        { aasm }
@@ -386,6 +387,12 @@ implementation
     constructor tstoredsym.create(st:tsymtyp;const n : string);
       begin
          inherited create(st,n);
+         { Register in current_module }
+         if assigned(current_module) then
+           begin
+             current_module.symlist.Add(self);
+             SymId:=current_module.symlist.Count-1;
+           end;  
       end;
 
 
@@ -394,6 +401,8 @@ implementation
         nr : word;
         s  : string;
       begin
+         SymId:=ppufile.getlongint;
+         current_module.symlist[SymId]:=self;
          nr:=ppufile.getword;
          s:=ppufile.getstring;
          if s[1]='$' then
@@ -417,6 +426,7 @@ implementation
 
     procedure tstoredsym.ppuwrite(ppufile:tcompilerppufile);
       begin
+         ppufile.putlongint(SymId);
          ppufile.putword(indexnr);
          ppufile.putstring(_realname^);
          ppufile.putposinfo(fileinfo);

compiler/symtype.pas

@@ -232,7 +232,7 @@ implementation
 
     uses
        verbose,
-       fmodule
+       fmodule,symtable
        ;
 
 
@@ -373,6 +373,7 @@ implementation
     function tsym.mangledname : string;
       begin
         internalerror(200204171);
+        result:='';
       end;
 
 
@@ -774,209 +775,57 @@ implementation
         dataidx:=-1;
       end;
 
-
     procedure tderef.build(s:tsymtableentry);
       var
         len  : byte;
+        st   : tsymtable;
         data : array[0..255] of byte;
-
+        idx : word;
-        function is_child(currdef,ownerdef:tdef):boolean;
-        begin
-          while assigned(currdef) and
-                (currdef<>ownerdef) do
-            currdef:=currdef.getparentdef;
-          result:=assigned(currdef);
-        end;
-
-        procedure addowner(s:tsymtableentry);
-        var
-          idx : longint;
-        begin
-          if not assigned(s.owner) then
-            internalerror(200306063);
-          case s.owner.symtabletype of
-            globalsymtable :
-              begin
-                if s.owner.iscurrentunit then
-                  begin
-                    data[len]:=ord(deref_aktglobal);
-                    inc(len);
-                  end
-                else
-                  begin
-                    { register that the unit is needed for resolving }
-                    idx:=current_module.derefidx_unit(s.owner.moduleid);
-                    data[len]:=ord(deref_unit);
-                    data[len+1]:=idx shr 8;
-                    data[len+2]:=idx and $ff;
-                    inc(len,3);
-                  end;
-              end;
-            staticsymtable :
-              begin
-                { only references to the current static symtable are allowed }
-                if not s.owner.iscurrentunit then
-                  internalerror(200306233);
-                data[len]:=ord(deref_aktstatic);
-                inc(len);
-              end;
-            localsymtable :
-              begin
-                addowner(s.owner.defowner);
-                data[len]:=ord(deref_def);
-                data[len+1]:=s.owner.defowner.indexnr shr 8;
-                data[len+2]:=s.owner.defowner.indexnr and $ff;
-                data[len+3]:=ord(deref_local);
-                inc(len,4);
-              end;
-            parasymtable :
-              begin
-                addowner(s.owner.defowner);
-                data[len]:=ord(deref_def);
-                data[len+1]:=s.owner.defowner.indexnr shr 8;
-                data[len+2]:=s.owner.defowner.indexnr and $ff;
-                data[len+3]:=ord(deref_para);
-                inc(len,4);
-              end;
-            objectsymtable,
-            recordsymtable :
-              begin
-                addowner(s.owner.defowner);
-                data[len]:=ord(deref_def);
-                data[len+1]:=s.owner.defowner.indexnr shr 8;
-                data[len+2]:=s.owner.defowner.indexnr and $ff;
-                data[len+3]:=ord(deref_record);
-                inc(len,4);
-              end;
-            else
-              internalerror(200306065);
-          end;
-          if len>252 then
-            internalerror(200306062);
-        end;
-
-        procedure addparentobject(currdef,ownerdef:tdef);
-        var
-          nextdef : tdef;
-        begin
-          if not assigned(currdef) then
-            internalerror(200306185);
-          { Already handled by derefaktrecordindex }
-          if currdef=ownerdef then
-            internalerror(200306188);
-          { Generate a direct reference to the top parent
-            class available in the current unit, this is required because
-            the parent class is maybe not resolved yet and therefor
-            has the childof value not available yet }
-          while (currdef<>ownerdef) do
-            begin
-              nextdef:=currdef.getparentdef;
-              { objects are only allowed in globalsymtable,staticsymtable  }
-              if not(nextdef.owner.symtabletype in [globalsymtable,staticsymtable]) then
-                internalerror(200306187);
-              { Next parent is in a different unit, then stop }
-              if not(nextdef.owner.iscurrentunit) then
-                break;
-              currdef:=nextdef;
-            end;
-          { Add reference where to start the parent lookup }
-          if currdef=aktrecordsymtable.defowner then
-            begin
-              data[len]:=ord(deref_aktrecord);
-              inc(len);
-            end
-          else
-            begin
-              if currdef.owner.symtabletype=globalsymtable then
-                data[len]:=ord(deref_aktglobal)
-              else
-                data[len]:=ord(deref_aktstatic);
-              data[len+1]:=ord(deref_def);
-              data[len+2]:=currdef.indexnr shr 8;
-              data[len+3]:=currdef.indexnr and $ff;
-              data[len+4]:=ord(deref_record);
-              inc(len,5);
-            end;
-          { When the current found parent in this module is not the owner we
-            add derefs for the parent classes not available in this unit }
-          while (currdef<>ownerdef) do
-            begin
-              data[len]:=ord(deref_parent_object);
-              inc(len);
-              currdef:=currdef.getparentdef;
-              { It should be valid as it is checked by is_child }
-              if not assigned(currdef) then
-                internalerror(200306186);
-            end;
-        end;
-
       begin
         { skip length byte }
         len:=1;
+
         if assigned(s) then
          begin
-           { Static symtable of current unit ? }
+           st:=findunitsymtable(s.owner);
-           if (s.owner.symtabletype=staticsymtable) and
+           if not st.iscurrentunit then
-              s.owner.iscurrentunit then
              begin
-              data[len]:=ord(deref_aktstatic);
+               { register that the unit is needed for resolving }
-              inc(len);
+               data[len]:=ord(deref_unit);
-            end
+               idx:=current_module.derefidx_unit(st.moduleid);
-           { Global symtable of current unit ? }
+               data[len+1]:=idx shr 8 and $ff;
-           else if (s.owner.symtabletype=globalsymtable) and
+               data[len+2]:=idx and $ff;
-                   s.owner.iscurrentunit then
-            begin
-              data[len]:=ord(deref_aktglobal);
-              inc(len);
-            end
-           { Current record/object symtable ? }
-           else if (s.owner=aktrecordsymtable) then
-            begin
-              data[len]:=ord(deref_aktrecord);
-              inc(len);
-            end
-           { Current local symtable ? }
-           else if (s.owner=aktlocalsymtable) then
-            begin
-              data[len]:=ord(deref_aktlocal);
-              inc(len);
-            end
-           { Current para symtable ? }
-           else if (s.owner=aktparasymtable) then
-            begin
-              data[len]:=ord(deref_aktpara);
-              inc(len);
-            end
-           { Parent class? }
-           else if assigned(aktrecordsymtable) and
-                   (aktrecordsymtable.symtabletype=objectsymtable) and
-                   (s.owner.symtabletype=objectsymtable) and
-                   is_child(tdef(aktrecordsymtable.defowner),tdef(s.owner.defowner)) then
-            begin
-              addparentobject(tdef(aktrecordsymtable.defowner),tdef(s.owner.defowner));
-            end
-           else
-           { Default, start by building from unit symtable }
-            begin
-              addowner(s);
-            end;
-           { Add index of the symbol/def }
-           if s is tsym then
-             data[len]:=ord(deref_sym)
-           else
-             data[len]:=ord(deref_def);
-           data[len+1]:=s.indexnr shr 8;
-           data[len+2]:=s.indexnr and $ff;
                inc(len,3);
+             end;
+           if s is tsym then
+             begin
+               data[len]:=ord(deref_symid);
+               data[len+1]:=tsym(s).symid shr 24 and $ff;
+               data[len+2]:=tsym(s).symid shr 16 and $ff;
+               data[len+3]:=tsym(s).symid shr 8 and $ff;
+               data[len+4]:=tsym(s).symid and $ff;
+               inc(len,5);
+             end
+           else
+             begin
+               data[len]:=ord(deref_defid);
+               data[len+1]:=tdef(s).defid shr 24 and $ff;
+               data[len+2]:=tdef(s).defid shr 16 and $ff;
+               data[len+3]:=tdef(s).defid shr 8 and $ff;
+               data[len+4]:=tdef(s).defid and $ff;
+               inc(len,5);
+             end;
          end
         else
          begin
            { nil pointer }
-           data[len]:=0;
+           data[len]:=ord(deref_nil);
            inc(len);
          end;
+
         { store data length in first byte }
         data[0]:=len-1;
+
         { store index and write to derefdata }
         dataidx:=current_module.derefdata.size;
         current_module.derefdata.write(data,len);
@@ -985,10 +834,8 @@ implementation
 
     function tderef.resolve:tsymtableentry;
       var
-        pd     : tdef;
         pm     : tmodule;
         typ    : tdereftype;
-        st     : tsymtable;
         idx    : word;
         i      : aint;
         len    : byte;
@@ -1008,13 +855,31 @@ implementation
               internalerror(200310222);
           end;
         { process data }
-        st:=nil;
+        pm:=current_module;
         i:=0;
         while (i<len) do
           begin
             typ:=tdereftype(data[i]);
             inc(i);
             case typ of
+              deref_unit :
+                begin
+                  idx:=(data[i] shl 8) or data[i+1];
+                  inc(i,2);
+                  pm:=current_module.resolve_unit(idx);
+                end;
+              deref_defid :
+                begin
+                  idx:=(data[i] shl 24) or (data[i+1] shl 16) or (data[i+2] shl 8) or data[i+3];
+                  inc(i,4);
+                  result:=tdef(pm.deflist[idx]);
+                end;
+              deref_symid :
+                begin
+                  idx:=(data[i] shl 24) or (data[i+1] shl 16) or (data[i+2] shl 8) or data[i+3];
+                  inc(i,4);
+                  result:=tsym(pm.symlist[idx]);
+                end;
               deref_nil :
                 begin
                   result:=nil;
@@ -1022,91 +887,13 @@ implementation
                   if len<>1 then
                     internalerror(200306232);
                 end;
-              deref_sym :
-                begin
-                  if not assigned(st) then
-                    internalerror(200309141);
-                  idx:=(data[i] shl 8) or data[i+1];
-                  inc(i,2);
-                  result:=st.getsymnr(idx);
-                end;
-              deref_def :
-                begin
-                  if not assigned(st) then
-                    internalerror(200309142);
-                  idx:=(data[i] shl 8) or data[i+1];
-                  inc(i,2);
-                  result:=st.getdefnr(idx);
-                end;
-              deref_aktrecord :
-                st:=aktrecordsymtable;
-              deref_aktstatic :
-                st:=current_module.localsymtable;
-              deref_aktglobal :
-                st:=current_module.globalsymtable;
-              deref_aktlocal :
-                st:=aktlocalsymtable;
-              deref_aktpara :
-                st:=aktparasymtable;
-              deref_unit :
-                begin
-                  idx:=(data[i] shl 8) or data[i+1];
-                  inc(i,2);
-                  pm:=current_module.resolve_unit(idx);
-                  st:=pm.globalsymtable;
-                end;
-              deref_local :
-                begin
-                  if not assigned(result) then
-                    internalerror(200306069);
-                  st:=tdef(result).getsymtable(gs_local);
-                  result:=nil;
-                  if not assigned(st) then
-                    internalerror(200212275);
-                end;
-              deref_para :
-                begin
-                  if not assigned(result) then
-                    internalerror(2003060610);
-                  st:=tdef(result).getsymtable(gs_para);
-                  result:=nil;
-                  if not assigned(st) then
-                    internalerror(200212276);
-                end;
-              deref_record :
-                begin
-                  if not assigned(result) then
-                    internalerror(200306068);
-                  st:=tdef(result).getsymtable(gs_record);
-                  result:=nil;
-                  if not assigned(st) then
-                    internalerror(200212274);
-                end;
-              deref_parent_object :
-                begin
-                  { load current object symtable if no
-                    symtable is available yet }
-                  if st=nil then
-                    begin
-                      st:=aktrecordsymtable;
-                      if not assigned(st) then
-                        internalerror(200306068);
-                    end;
-                  if st.symtabletype<>objectsymtable then
-                    internalerror(200306189);
-                  pd:=tdef(st.defowner).getparentdef;
-                  if not assigned(pd) then
-                    internalerror(200306184);
-                  st:=pd.getsymtable(gs_record);
-                  if not assigned(st) then
-                    internalerror(200212274);
-                end;
               else
                 internalerror(200212277);
             end;
           end;
       end;
 
+
 {*****************************************************************************
                             TCompilerPPUFile
 *****************************************************************************}

compiler/utils/ppudump.pp

@@ -418,7 +418,7 @@ Procedure ReadDerefmap;
 var
   i,mapsize : longint;
 begin
-  mapsize:=ppufile.getword;
+  mapsize:=ppufile.getlongint;
   writeln('DerefMapsize: ',mapsize);
   for i:=0 to mapsize-1 do
     writeln('DerefMap[',i,'] = ',ppufile.getstring);
@@ -570,11 +570,14 @@ type
     deref_record,
     deref_local,
     deref_para,
-    deref_parent_object
+    deref_parent_object,
+    deref_symid,
+    deref_defid
   );
 var
   b : tdereftype;
   first : boolean;
+  unitid : word;
   idx : longint;
   i,n : byte;
   pdata : pbyte;
@@ -609,6 +612,18 @@ begin
      case b of
        deref_nil :
          write('Nil');
+       deref_symid :
+         begin
+           idx:=pdata[i] shl 24 or pdata[i+1] shl 16 or pdata[i+2] shl 8 or pdata[i+3];
+           inc(i,4);
+           write('SymId ',idx);
+         end;
+       deref_defid :
+         begin
+           idx:=pdata[i] shl 24 or pdata[i+1] shl 16 or pdata[i+2] shl 8 or pdata[i+3];
+           inc(i,4);
+           write('DefId ',idx);
+         end;
        deref_def :
          begin
            idx:=pdata[i] shl 8;
@@ -635,8 +650,7 @@ begin
          write('AktPara');
        deref_unit :
          begin
-           idx:=pdata[i] shl 8;
+           idx:=pdata[i] shl 8 or pdata[i+1];
-           idx:=idx or pdata[i+1];
            inc(i,2);
            write('Unit ',idx);
          end;
@@ -760,8 +774,11 @@ end;
 
 
 procedure readcommonsym(const s:string);
+var
+  symid : longint;
 begin
-  writeln(space,'** Symbol Nr. ',ppufile.getword,' **');
+  symid:=ppufile.getlongint;
+  writeln(space,'** Symbol Nr. ',ppufile.getword,' (',symid,') ',' **');
   writeln(space,s,ppufile.getstring);
   write(space,'     File Pos : ');
   readposinfo;
@@ -807,8 +824,10 @@ var
   first  : boolean;
   tokenbufsize : longint;
   tokenbuf : pointer;
+  defid : longint;
 begin
-  writeln(space,'** Definition Nr. ',ppufile.getword,' **');
+  defid:=ppufile.getlongint;
+  writeln(space,'** Definition Nr. ',ppufile.getword,' (',defid,') ',' **');
   writeln(space,s);
   write  (space,'      Type symbol : ');
   readderef;
@@ -2193,6 +2212,8 @@ begin
         Writeln('FileSize (w/o header)   : ',size);
         Writeln('Checksum                : ',hexstr(checksum,8));
         Writeln('Interface Checksum      : ',hexstr(interface_checksum,8));
+        Writeln('Definitions stored      : ',tostr(deflistsize));
+        Writeln('Symbols stored          : ',tostr(symlistsize));
       end;
    end;
 {read the general stuff}