* unit mapping rewrite

  * new derefmap added

compiler/fmodule.pas

@@ -80,11 +80,21 @@ interface
       tused_unit = class;
 
       tunitmaprec = record
-        u : tmodule;
-        unitsym : tunitsym;
+        u        : tmodule;
+        { number of references }
+        refs     : longint;
+        { index in the derefmap }
+        derefidx : longint;
       end;
       punitmap = ^tunitmaprec;
 
+      tderefmaprec = record
+        u           : tmodule;
+        { modulename, used during ppu load }
+        modulename  : pstring;
+      end;
+      pderefmap = ^tderefmaprec;
+
       tmodule = class(tmodulebase)
         do_reload,                { force reloading of the unit }
         do_compile,               { need to compile the sources }
@@ -102,8 +112,12 @@ interface
         interface_crc : cardinal;
         flags         : cardinal;  { the PPU flags }
         islibrary     : boolean;  { if it is a library (win32 dll) }
-        map           : punitmap; { mapping of all used units }
-        mapsize       : longint;  { number of units in the map }
+        moduleid      : longint;
+        unitmap       : punitmap; { mapping of all used units }
+        unitmapsize   : longint;  { number of units in the map }
+        derefmap      : pderefmap; { mapping of all units needed for deref }
+        derefmapcnt   : longint;  { number of units in the map }
+        derefmapsize  : longint;  { number of units in the map }
         derefdataintflen : longint;
         derefdata     : tdynamicarray;
         globalsymtable,           { pointer to the global symtable of this unit }
@@ -145,7 +159,9 @@ interface
         procedure adddependency(callermodule:tmodule);
         procedure flagdependent(callermodule:tmodule);
         function  addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
-        procedure numberunits;
+        procedure updatemaps;
+        function  derefidx_unit(id:longint):longint;
+        function  resolve_unit(id:longint):tmodule;
         procedure allunitsused;
         procedure setmodulename(const s:string);
       end;
@@ -174,7 +190,8 @@ interface
        SmartLinkOFiles   : TStringList; { List of .o files which are generated,
                                           used to delete them after linking }
 
-function get_source_file(moduleindex,fileindex : longint) : tinputfile;
+    function get_source_file(moduleindex,fileindex : longint) : tinputfile;
+    procedure addloadedunit(hp:tmodule);
 
 
 implementation
@@ -187,7 +204,7 @@ implementation
       dos,
     {$ENDIF USE_SYSUTILS}
       verbose,systems,
-      scanner,
+      scanner,ppu,
       procinfo;
 
 
@@ -209,6 +226,13 @@ implementation
       end;
 
 
+    procedure addloadedunit(hp:tmodule);
+      begin
+        hp.moduleid:=loaded_units.count;
+        loaded_units.concat(hp);
+      end;
+
+
 {****************************************************************************
                              TLinkContainerItem
  ****************************************************************************}
@@ -393,8 +417,11 @@ implementation
         interface_crc:=0;
         flags:=0;
         scanner:=nil;
-        map:=nil;
-        mapsize:=0;
+        unitmap:=nil;
+        unitmapsize:=0;
+        derefmap:=nil;
+        derefmapsize:=0;
+        derefmapcnt:=0;
         derefdata:=TDynamicArray.Create(1024);
         derefdataintflen:=0;
         globalsymtable:=nil;
@@ -429,9 +456,17 @@ implementation
 {$ifdef MEMDEBUG}
         d : tmemdebug;
 {$endif}
+        i : longint;
         hpi : tprocinfo;
       begin
-        dispose(map);
+        if assigned(unitmap) then
+          freemem(unitmap);
+        if assigned(derefmap) then
+          begin
+            for i:=0 to derefmapcnt-1 do
+              stringdispose(derefmap[i].modulename);
+            freemem(derefmap);
+          end;
         if assigned(imports) then
          imports.free;
         if assigned(_exports) then
@@ -512,6 +547,7 @@ implementation
     procedure tmodule.reset;
       var
         hpi : tprocinfo;
+        i   : longint;
       begin
         if assigned(scanner) then
           begin
@@ -556,13 +592,22 @@ implementation
           end;
         derefdata.free;
         derefdata:=TDynamicArray.Create(1024);
-        if assigned(map) then
+        if assigned(unitmap) then
+          begin
+            freemem(unitmap);
+            unitmap:=nil;
+          end;
+        if assigned(derefmap) then
           begin
-            freemem(map);
-            map:=nil;
+            for i:=0 to derefmapcnt-1 do
+              stringdispose(derefmap[i].modulename);
+            freemem(derefmap);
+            derefmap:=nil;
           end;
+        unitmapsize:=0;
+        derefmapsize:=0;
+        derefmapcnt:=0;
         derefdataintflen:=0;
-        mapsize:=0;
         sourcefiles.free;
         sourcefiles:=tinputfilemanager.create;
         librarydata.free;
@@ -665,55 +710,110 @@ implementation
       end;
 
 
-    procedure tmodule.numberunits;
+    procedure tmodule.updatemaps;
       var
-        pu : tused_unit;
-        hp : tmodule;
-        i  : integer;
+        oldmapsize : longint;
+        hp  : tmodule;
+        i   : longint;
       begin
-        { Reset all numbers to -1 }
+        { Extend unitmap }
+        oldmapsize:=unitmapsize;
+        unitmapsize:=loaded_units.count;
+        reallocmem(unitmap,unitmapsize*sizeof(tunitmaprec));
+        fillchar(unitmap[oldmapsize],(unitmapsize-oldmapsize)*sizeof(tunitmaprec),0);
+
+        { Extend Derefmap }
+        oldmapsize:=derefmapsize;
+        derefmapsize:=loaded_units.count;
+        reallocmem(derefmap,derefmapsize*sizeof(tderefmaprec));
+        fillchar(derefmap[oldmapsize],(derefmapsize-oldmapsize)*sizeof(tderefmaprec),0);
+
+        { Add all units to unitmap }
         hp:=tmodule(loaded_units.first);
+        i:=0;
         while assigned(hp) do
-         begin
-           if assigned(hp.globalsymtable) then
-             hp.globalsymtable.unitid:=$ffff;
-           hp:=tmodule(hp.next);
-         end;
-        { Allocate map }
-        mapsize:=used_units.count+1;
-        reallocmem(map,mapsize*sizeof(tunitmaprec));
-        { Our own symtable gets unitid 0, for a program there is
-          no globalsymtable }
-        if assigned(globalsymtable) then
-          globalsymtable.unitid:=0;
-        map[0].u:=self;
-        map[0].unitsym:=nil;
-        { number units and map }
-        i:=1;
-        pu:=tused_unit(used_units.first);
-        while assigned(pu) do
           begin
-            if assigned(pu.u.globalsymtable) then
+            if hp.moduleid>=unitmapsize then
+              internalerror(200501151);
+            { Verify old entries }
+            if (i<oldmapsize) then
               begin
-                tsymtable(pu.u.globalsymtable).unitid:=i;
-                map[i].u:=pu.u;
-                map[i].unitsym:=pu.unitsym;
-                inc(i);
+                if (hp.moduleid<>i) or
+                   (unitmap[hp.moduleid].u<>hp) then
+                  internalerror(200501156);
+              end
+            else
+              begin
+                unitmap[hp.moduleid].u:=hp;
+                unitmap[hp.moduleid].derefidx:=-1;
               end;
-            pu:=tused_unit(pu.next);
+            inc(i);
+            hp:=tmodule(hp.next);
+          end;
+      end;
+
+
+    function tmodule.derefidx_unit(id:longint):longint;
+      begin
+        if id>=unitmapsize then
+          internalerror(2005011511);
+        if unitmap[id].derefidx=-1 then
+          begin
+            unitmap[id].derefidx:=derefmapcnt;
+            inc(derefmapcnt);
+            derefmap[unitmap[id].derefidx].u:=unitmap[id].u;
+          end;
+        if unitmap[id].derefidx>=derefmapsize then
+          internalerror(2005011514);
+        result:=unitmap[id].derefidx;
+      end;
+
+
+    function tmodule.resolve_unit(id:longint):tmodule;
+      var
+        hp : tmodule;
+      begin
+        if id>=derefmapsize then
+          internalerror(200306231);
+        result:=derefmap[id].u;
+        if not assigned(result) then
+          begin
+            if not assigned(derefmap[id].modulename) or
+               (derefmap[id].modulename^='') then
+              internalerror(200501159);
+            hp:=tmodule(loaded_units.first);
+            while assigned(hp) do
+              begin
+                if hp.modulename^=derefmap[id].modulename^ then
+                  break;
+                hp:=tmodule(hp.next);
+              end;
+            if not assigned(hp) then
+              internalerror(2005011510);
+            derefmap[id].u:=hp;
+            result:=hp;
           end;
       end;
 
 
     procedure tmodule.allunitsused;
       var
-        i : longint;
+        pu : tused_unit;
       begin
-        for i:=0 to mapsize-1 do
+        pu:=tused_unit(used_units.first);
+        while assigned(pu) do
           begin
-            if assigned(map[i].unitsym) and
-               (map[i].unitsym.refs=0) then
-              MessagePos2(map[i].unitsym.fileinfo,sym_n_unit_not_used,map[i].u.realmodulename^,realmodulename^);
+            if assigned(pu.u.globalsymtable) then
+              begin
+                if unitmap[pu.u.moduleid].u<>pu.u then
+                  internalerror(200501157);
+                { Give a note when the unit is not referenced, skip
+                  this is for units with an initialization/finalization }
+                if (unitmap[pu.u.moduleid].refs=0) and
+                   ((pu.u.flags and (uf_init or uf_finalize))=0) then
+                  CGMessagePos2(pu.unitsym.fileinfo,sym_n_unit_not_used,pu.u.realmodulename^,realmodulename^);
+              end;
+            pu:=tused_unit(pu.next);
           end;
       end;
 
@@ -732,7 +832,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.51  2005-01-09 20:24:43  olle
+  Revision 1.52  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.51  2005/01/09 20:24:43  olle
     * rework of macro subsystem
     + exportable macros for mode macpas
 

compiler/fppu.pas

@@ -67,12 +67,14 @@ interface
           procedure writesourcefiles;
           procedure writeusedunit(intf:boolean);
           procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
+          procedure writederefmap;
           procedure writederefdata;
           procedure putasmsymbol_in_idx(s:tnamedindexitem;arg:pointer);
           procedure writeasmsymbols;
           procedure readsourcefiles;
           procedure readloadunit;
           procedure readlinkcontainer(var p:tlinkcontainer);
+          procedure readderefmap;
           procedure readderefdata;
           procedure readasmsymbols;
 {$IFDEF MACRO_DIFF_HINT}
@@ -462,8 +464,6 @@ uses
         hp : tused_unit;
         oldcrc : boolean;
       begin
-        { renumber the units for derefence writing }
-        numberunits;
         { write a reference for each used unit }
         hp:=tused_unit(used_units.first);
         while assigned(hp) do
@@ -508,6 +508,27 @@ uses
       end;
 
 
+    procedure tppumodule.writederefmap;
+      var
+        i : longint;
+        oldcrc : boolean;
+      begin
+        { This does not influence crc }
+        oldcrc:=ppufile.do_crc;
+        ppufile.do_crc:=false;
+        { The unit map used for resolving }
+        ppufile.putlongint(derefmapcnt);
+        for i:=0 to derefmapcnt-1 do
+          begin
+            if not assigned(derefmap[i].u) then
+              internalerror(2005011512);
+            ppufile.putstring(derefmap[i].u.modulename^)
+          end;
+        ppufile.writeentry(ibderefmap);
+        ppufile.do_crc:=oldcrc;
+      end;
+
+
     procedure tppumodule.writederefdata;
       var
         oldcrc : boolean;
@@ -604,20 +625,20 @@ uses
   Define MACRO_DIFF_HINT for the whole compiler (and ppudump)
   to turn this facility on. Also the hint messages defined
   below must be commented in in the msg/errore.msg file.
-  
+
   There is some problems with this, thats why it is shut off:
-  
+
   At the first compilation, consider a macro which is not initially
   defined, but it is used (e g the check that it is undefined is true).
-  Since it do not exist, there is no macro object where the is_used 
+  Since it do not exist, there is no macro object where the is_used
   flag can be set. Later on when the macro is defined, and the ppu
   is opened, the check cannot detect this.
-  
+
   Also, in which macro object should this flag be set ? It cant be set
   for macros in the initialmacrosymboltable since this table is shared
   between different files.
 }
-  
+
     procedure tppumodule.readusedmacros;
       var
         hs : string;
@@ -797,6 +818,19 @@ uses
       end;
 
 
+    procedure tppumodule.readderefmap;
+      var
+        i : longint;
+      begin
+        { Load unit map used for resolving }
+        derefmapsize:=ppufile.getlongint;
+        getmem(derefmap,derefmapsize*sizeof(tderefmaprec));
+        fillchar(derefmap^,derefmapsize*sizeof(tderefmaprec),0);
+        for i:=0 to derefmapsize-1 do
+          derefmap[i].modulename:=stringdup(ppufile.getstring);
+      end;
+
+
     procedure tppumodule.readderefdata;
       var
         len,hlen : longint;
@@ -898,6 +932,8 @@ uses
                readlinkcontainer(LinkotherStaticLibs);
              iblinkothersharedlibs :
                readlinkcontainer(LinkotherSharedLibs);
+             ibderefmap :
+               readderefmap;
              ibderefdata :
                readderefdata;
              ibendinterface :
@@ -941,7 +977,7 @@ uses
         if (flags and uf_has_browser)<>0 then
           begin
             tstoredsymtable(globalsymtable).load_references(ppufile,true);
-            for i:=0 to mapsize-1 do
+            for i:=0 to unitmapsize-1 do
               tstoredsymtable(globalsymtable).load_references(ppufile,false);
             b:=ppufile.readentry;
             if b<>ibendbrowser then
@@ -1023,6 +1059,7 @@ uses
              tstoredsymtable(localsymtable).buildderef;
              tstoredsymtable(localsymtable).buildderefimpl;
            end;
+         writederefmap;
          writederefdata;
 
          ppufile.writeentry(ibendinterface);
@@ -1034,7 +1071,7 @@ uses
            begin
              ppufile.putbyte(byte(true));
              ppufile.writeentry(ibexportedmacros);
-             tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile);           
+             tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile);
            end
          else
            begin
@@ -1130,6 +1167,7 @@ uses
          derefdata.reset;
          tstoredsymtable(globalsymtable).buildderef;
          derefdataintflen:=derefdata.size;
+         writederefmap;
          writederefdata;
 
          ppufile.writeentry(ibendinterface);
@@ -1141,7 +1179,7 @@ uses
            begin
              ppufile.putbyte(byte(true));
              ppufile.writeentry(ibexportedmacros);
-             tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile);           
+             tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile);
            end
          else
            begin
@@ -1227,14 +1265,13 @@ uses
             end;
            pu:=tused_unit(pu.next);
          end;
-        numberunits;
 
         { ok, now load the interface of this unit }
         if current_module<>self then
          internalerror(200208187);
-        globalsymtable:=tglobalsymtable.create(modulename^);
+        globalsymtable:=tglobalsymtable.create(modulename^,moduleid);
         tstoredsymtable(globalsymtable).ppuload(ppufile);
-    
+
         if ppufile.readentry<>ibexportedmacros then
           Message(unit_f_ppu_read_error);
         if boolean(ppufile.getbyte) then
@@ -1273,12 +1310,11 @@ uses
             end;
            pu:=tused_unit(pu.next);
          end;
-        numberunits;
 
         { load implementation symtable }
         if (flags and uf_local_symtable)<>0 then
           begin
-            localsymtable:=tstaticsymtable.create(modulename^);
+            localsymtable:=tstaticsymtable.create(modulename^,moduleid);
             tstaticsymtable(localsymtable).ppuload(ppufile);
           end;
 
@@ -1566,7 +1602,7 @@ uses
            Message1(unit_u_registering_new_unit,Upper(s));
            hp:=tppumodule.create(callermodule,s,fn,true);
            hp.loaded_from:=callermodule;
-           loaded_units.insert(hp);
+           addloadedunit(hp);
          end;
         { return }
         registerunit:=hp;
@@ -1575,7 +1611,11 @@ uses
 end.
 {
   $Log$
-  Revision 1.65  2005-01-10 21:02:35  olle
+  Revision 1.66  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.65  2005/01/10 21:02:35  olle
     - disabled macro diff message
 
   Revision 1.64  2005/01/09 20:24:43  olle

compiler/htypechk.pas

@@ -1337,7 +1337,7 @@ implementation
         if assigned(st) and
            (st.symtabletype=objectsymtable) and
            (st.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-           (st.defowner.owner.unitid=0) then
+           st.defowner.owner.iscurrentunit then
           topclassh:=tobjectdef(st.defowner)
         else
           begin
@@ -1986,7 +1986,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.109  2005-01-19 20:53:27  florian
+  Revision 1.110  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.109  2005/01/19 20:53:27  florian
     * tmypointer(12435)^ is an l-value
 
   Revision 1.108  2005/01/10 22:10:26  peter

compiler/i386/ra386int.pas

@@ -387,7 +387,8 @@ Unit Ra386int;
                     searchsym(actasmpattern,srsym,srsymtable);
                     if assigned(srsym) and
                        (srsym.typ=unitsym) and
-                       (srsym.owner.unitid=0) then
+                       (srsym.owner.symtabletype in [staticsymtable,globalsymtable]) and
+                       srsym.owner.iscurrentunit then
                      begin
                        { Add . to create System.Identifier }
                        actasmpattern:=actasmpattern+c;
@@ -2035,7 +2036,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.84  2005-01-19 20:21:51  peter
+  Revision 1.85  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.84  2005/01/19 20:21:51  peter
     * support labels in references
 
   Revision 1.83  2004/12/22 17:09:55  peter

compiler/ncal.pas

@@ -2180,7 +2180,8 @@ type
              if (st.symtabletype=objectsymtable) then
                st:=st.defowner.owner;
              if (pi_uses_static_symtable in tprocdef(procdefinition).inlininginfo^.flags) and
-                (st.unitid<>0) then
+                (st.symtabletype=globalsymtable) and
+                (not st.iscurrentunit) then
                begin
                  Comment(V_lineinfo+V_Debug,'Not inlining "'+tprocdef(procdefinition).procsym.realname+'", references static symtable');
                end
@@ -2495,7 +2496,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.275  2005-01-04 16:36:31  peter
+  Revision 1.276  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.275  2005/01/04 16:36:31  peter
     * fix aftercosntruction calls, vmt=1 is used to indicate that
       afterconstruction needs to be called
     * only accept resourcestring when objpas is loaded

compiler/parser.pas

@@ -460,18 +460,19 @@ implementation
          exceptblockcounter:=0;
          aktmaxfpuregisters:=-1;
        { reset the unit or create a new program }
-         if not assigned(current_module) then
-          begin
-            current_module:=tppumodule.create(nil,filename,'',false);
-            main_module:=current_module;
-            current_module.state:=ms_compile;
-          end;
-         if not(current_module.state in [ms_compile,ms_second_compile]) then
-           internalerror(200212281);
-
          { a unit compiled at command line must be inside the loaded_unit list }
          if (compile_level=1) then
-           loaded_units.insert(current_module);
+           begin
+             if assigned(current_module) then
+               internalerror(200501158);
+             current_module:=tppumodule.create(nil,filename,'',false);
+             addloadedunit(current_module);
+             main_module:=current_module;
+             current_module.state:=ms_compile;
+           end;
+         if not(assigned(current_module) and
+                (current_module.state in [ms_compile,ms_second_compile])) then
+           internalerror(200212281);
 
          { Set the module to use for verbose }
          compiled_module:=current_module;
@@ -699,7 +700,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.69  2005-01-09 20:24:43  olle
+  Revision 1.70  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.69  2005/01/09 20:24:43  olle
     * rework of macro subsystem
     + exportable macros for mode macpas
 

compiler/pbase.pas

@@ -209,9 +209,11 @@ implementation
          begin
            if (srsym.typ=unitsym) then
             begin
+              if not(srsym.owner.symtabletype in [staticsymtable,globalsymtable]) then
+                internalerror(200501154);
               { only allow unit.symbol access if the name was
                 found in the current module }
-              if srsym.owner.unitid=0 then
+              if srsym.owner.iscurrentunit then
                begin
                  consume(_ID);
                  consume(_POINT);
@@ -271,7 +273,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.29  2004-08-08 12:06:38  florian
+  Revision 1.30  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.29  2004/08/08 12:06:38  florian
     * finally is an "endtoken" as well
 
   Revision 1.28  2004/06/20 08:55:30  florian

compiler/pdecsub.pas

@@ -734,7 +734,7 @@ implementation
                 not assigned(srsym) and
                 (symtablestack.symtabletype=staticsymtable) and
                 assigned(symtablestack.next) and
-                (symtablestack.next.unitid=0) then
+                (symtablestack.next.iscurrentunit) then
                begin
                  { The procedure we prepare for is in the implementation
                    part of the unit we compile. It is also possible that we
@@ -1212,7 +1212,7 @@ begin
         begin
           consume(_LEGACY);
           include(pd.procoptions,po_syscall_legacy);
-        end 
+        end
       else if idtoken=_SYSV then
         begin
           consume(_SYSV);
@@ -1222,7 +1222,7 @@ begin
         begin
           consume(_BASESYSV);
           include(pd.procoptions,po_syscall_basesysv);
-        end 
+        end
       else if idtoken=_SYSVBASE then
         begin
           consume(_SYSVBASE);
@@ -1233,8 +1233,8 @@ begin
           consume(_R12BASE);
           include(pd.procoptions,po_syscall_r12base);
         end
-      else 
-        if syscall_convention='LEGACY' then 
+      else
+        if syscall_convention='LEGACY' then
           include(pd.procoptions,po_syscall_legacy)
         else if syscall_convention='SYSV' then
           include(pd.procoptions,po_syscall_sysv)
@@ -1246,7 +1246,7 @@ begin
           include(pd.procoptions,po_syscall_r12base)
         else
           internalerror(2005010404);
-      
+
       if consume_sym(sym,symtable) then
         begin
           if (sym.typ=globalvarsym) and
@@ -2408,7 +2408,11 @@ const
 end.
 {
   $Log$
-  Revision 1.225  2005-01-06 02:13:03  karoly
+  Revision 1.226  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.225  2005/01/06 02:13:03  karoly
     * more SysV call support stuff for MorphOS
 
   Revision 1.224  2005/01/05 02:31:06  karoly

compiler/pmodules.pas

@@ -487,7 +487,7 @@ implementation
          hp3     : tsymtable;
          unitsym : tunitsym;
          top_of_macrosymtable : tsymtable;
-         
+
       begin
          consume(_USES);
 {$ifdef DEBUG}
@@ -567,11 +567,6 @@ implementation
                pu.interface_checksum:=pu.u.interface_crc;
                { connect unitsym to the globalsymtable of the unit }
                pu.unitsym.unitsymtable:=pu.u.globalsymtable;
-               { increase refs of the unitsym when the unit contains
-                 initialization/finalization code so it doesn't trigger
-                 the unit not used hint }
-               if (pu.u.flags and (uf_init or uf_finalize))<>0 then
-                 inc(pu.unitsym.refs);
              end;
             pu:=tused_unit(pu.next);
           end;
@@ -700,7 +695,7 @@ implementation
           begin
             debugList.concat(tai_comment.Create(strpnew('EINCL of global '+
               tglobalsymtable(current_module.globalsymtable).name^+' has index '+
-              tostr(tglobalsymtable(current_module.globalsymtable).unitid))));
+              tostr(tglobalsymtable(current_module.globalsymtable).moduleid))));
             debugList.concat(Tai_stabs.Create(strpnew('"'+
               tglobalsymtable(current_module.globalsymtable).name^+'",'+
               tostr(N_EINCL)+',0,0,0')));
@@ -894,7 +889,7 @@ implementation
       if assigned(hp) then
         current_module.localmacrosymtable.delete(hp);
     end;
-    
+
     procedure proc_unit;
 
       function is_assembler_generated:boolean;
@@ -926,7 +921,7 @@ implementation
              ConsolidateMode;
              current_module.mode_switch_allowed:= false;
            end;
-       
+
          consume(_UNIT);
          if compile_level=1 then
           Status.IsExe:=false;
@@ -995,7 +990,7 @@ implementation
          parse_only:=true;
 
          { generate now the global symboltable }
-         st:=tglobalsymtable.create(current_module.modulename^);
+         st:=tglobalsymtable.create(current_module.modulename^,current_module.moduleid);
          refsymtable:=st;
          unitst:=tglobalsymtable(st);
          { define first as local to overcome dependency conflicts }
@@ -1057,7 +1052,7 @@ implementation
 
          { number all units, so we know if a unit is used by this unit or
            needs to be added implicitly }
-         current_module.numberunits;
+         current_module.updatemaps;
 
          { ... parse the declarations }
          Message1(parser_u_parsing_interface,current_module.realmodulename^);
@@ -1091,16 +1086,16 @@ implementation
          parse_only:=false;
 
          { generates static symbol table }
-         st:=tstaticsymtable.create(current_module.modulename^);
+         st:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
          current_module.localsymtable:=st;
 
-         { Swap the positions of the local and global macro sym table}        
+         { Swap the positions of the local and global macro sym table}
          if assigned(current_module.globalmacrosymtable) then
            begin
              macrosymtablestack:=current_module.localmacrosymtable;
              current_module.globalmacrosymtable.next:= current_module.localmacrosymtable.next;
              current_module.localmacrosymtable.next:=current_module.globalmacrosymtable;
-             
+
              current_module.globalmacrosymtable.foreach_static(@delete_duplicate_macros, nil);
            end;
 
@@ -1110,11 +1105,11 @@ implementation
 
          { we don't want implementation units symbols in unitsymtable !! PM }
          refsymtable:=st;
-         
+
          if has_impl then
            begin
-             consume(_IMPLEMENTATION);     
-             Message1(unit_u_loading_implementation_units,current_module.modulename^);     
+             consume(_IMPLEMENTATION);
+             Message1(unit_u_loading_implementation_units,current_module.modulename^);
              { Read the implementation units }
              parse_implementation_uses;
            end;
@@ -1126,7 +1121,7 @@ implementation
          reset_all_defs;
 
          { All units are read, now give them a number }
-         current_module.numberunits;
+         current_module.updatemaps;
 
          { now we can change refsymtable }
          refsymtable:=st;
@@ -1390,7 +1385,7 @@ implementation
 
          { insert after the unit symbol tables the static symbol table }
          { of the program                                             }
-         st:=tstaticsymtable.create(current_module.modulename^);;
+         st:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
          current_module.localsymtable:=st;
          refsymtable:=st;
 
@@ -1401,7 +1396,7 @@ implementation
 
          current_module.localmacrosymtable.next:=macrosymtablestack;
          macrosymtablestack:=current_module.localmacrosymtable;
-         
+
          {Load the units used by the program we compile.}
          if token=_USES then
            loadunits;
@@ -1410,7 +1405,7 @@ implementation
          reset_all_defs;
 
          { All units are read, now give them a number }
-         current_module.numberunits;
+         current_module.updatemaps;
 
          {Insert the name of the main program into the symbol table.}
          if current_module.realmodulename^<>'' then
@@ -1600,7 +1595,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.179  2005-01-09 20:24:43  olle
+  Revision 1.180  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.179  2005/01/09 20:24:43  olle
     * rework of macro subsystem
     + exportable macros for mode macpas
 

compiler/powerpc/nppcld.pas

@@ -58,9 +58,11 @@ unit nppcld;
           system_powerpc_darwin:
             begin
               if (symtableentry.typ = procsym) and
-                 not assigned(left) and
-                 ((tprocsym(symtableentry).owner.unitid<>0) or
-                  (po_external in tprocsym(symtableentry).procdef[1].procoptions)) then
+                 (tprocsym(symtableentry).owner.symtabletype in [staticsymtable,globalsymtable]) and
+                 (
+                  (not tabstractunitsymtable(tprocsym(symtableentry).owner).iscurrentmodule) or
+                  (po_external in tprocsym(symtableentry).procdef[1].procoptions)
+                 ) then
                 begin
                   l:=objectlibrary.getasmsymbol('L'+tprocsym(symtableentry).procdef[1].mangledname+'$non_lazy_ptr');
                   if not(assigned(l)) then
@@ -90,8 +92,9 @@ unit nppcld;
         case target_info.system of
           system_powerpc_darwin:
             begin
-              if (tglobalvarsym(symtableentry).owner.unitid<>0) or
-                 (vo_is_dll_var in tglobalvarsym(symtableentry).varoptions) then
+              if (vo_is_dll_var in tglobalvarsym(symtableentry).varoptions) and
+                 (tglobalvarsym(symtableentry).owner.symtabletype in [staticsymtable,globalsymtable]) and
+                 not(tabstractunitsymtable(tglobalvarsym(symtableentry).owner).iscurrentmodule) then
                 begin
                   l:=objectlibrary.getasmsymbol('L'+tglobalvarsym(symtableentry).mangledname+'$non_lazy_ptr');
                   if not(assigned(l)) then
@@ -122,7 +125,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2004-11-11 19:31:33  peter
+  Revision 1.6  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.5  2004/11/11 19:31:33  peter
     * fixed compile of powerpc,sparc,arm
 
   Revision 1.4  2004/07/19 12:45:43  jonas

compiler/ppu.pas

@@ -44,7 +44,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion=47;
+  CurrentPPUVersion=48;
 
 { buffer sizes }
   maxentrysize = 1024;
@@ -84,6 +84,7 @@ const
 {$ENDIF}
   ibderefdata            = 17;
   ibexportedmacros       = 18;
+  ibderefmap             = 19;
   {syms}
   ibtypesym        = 20;
   ibprocsym        = 21;
@@ -1059,7 +1060,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.61  2005-01-09 20:24:43  olle
+  Revision 1.62  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.61  2005/01/09 20:24:43  olle
     * rework of macro subsystem
     + exportable macros for mode macpas
 

compiler/psystem.pas

@@ -44,7 +44,7 @@ implementation
     uses
       globals,globtype,verbose,
       symconst,symtype,symsym,symdef,symtable,
-      aasmtai,aasmcpu,ncgutil,
+      aasmtai,aasmcpu,ncgutil,fmodule,
 {$ifdef GDB}
       gdb,
 {$endif GDB}
@@ -255,7 +255,11 @@ implementation
           t:=ttypesym(srsym).restype;
         end;
 
+      var
+        oldcurrentmodule : tmodule;
       begin
+        oldcurrentmodule:=current_module;
+        current_module:=nil;
         loadtype('byte',u8inttype);
         loadtype('shortint',s8inttype);
         loadtype('word',u16inttype);
@@ -305,6 +309,7 @@ implementation
         sinttype:=s32inttype;
         ptrinttype:=u32inttype;
 {$endif cpu64bit}
+        current_module:=oldcurrentmodule;
       end;
 
 
@@ -537,7 +542,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.75  2004-12-07 16:11:52  peter
+  Revision 1.76  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.75  2004/12/07 16:11:52  peter
     * set vo_explicit_paraloc flag
 
   Revision 1.74  2004/12/07 13:52:54  michael

compiler/ptype.pas

@@ -111,7 +111,11 @@ implementation
            begin
               is_unit_specific:=true;
               consume(_POINT);
-              if srsym.owner.unitid=0 then
+              if not(srsym.owner.symtabletype in [staticsymtable,globalsymtable]) then
+                internalerror(200501155);
+              { only allow unit.symbol access if the name was
+                found in the current module }
+              if srsym.owner.iscurrentunit then
                begin
                  srsym:=searchsymonlyin(tunitsym(srsym).unitsymtable,pattern);
                  pos:=akttokenpos;
@@ -166,9 +170,12 @@ implementation
            they can be refered from the parameters and symbols are not
            loaded at that time. Only write the definition when the
            symbol is the real owner of the definition (not a redefine) }
-         if (ttypesym(srsym).owner.unitid=0) and
-            ((ttypesym(srsym).restype.def.typesym=nil) or
-             (srsym=ttypesym(srsym).restype.def.typesym)) then
+         if (ttypesym(srsym).owner.symtabletype in [staticsymtable,globalsymtable]) and
+            ttypesym(srsym).owner.iscurrentunit and
+            (
+             (ttypesym(srsym).restype.def.typesym=nil) or
+             (srsym=ttypesym(srsym).restype.def.typesym)
+            ) then
           tt.setdef(ttypesym(srsym).restype.def)
          else
           tt.setsym(srsym);
@@ -659,7 +666,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.72  2005-01-04 16:39:12  peter
+  Revision 1.73  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.72  2005/01/04 16:39:12  peter
     * allow enum with jumps as array index in delphi mode
 
   Revision 1.71  2004/11/16 20:32:41  peter

compiler/raatt.pas

@@ -371,7 +371,8 @@ unit raatt;
                     searchsym(actasmpattern,srsym,srsymtable);
                     if assigned(srsym) and
                        (srsym.typ=unitsym) and
-                       (srsym.owner.unitid=0) then
+                       (srsym.owner.symtabletype in [staticsymtable,globalsymtable]) and
+                       srsym.owner.iscurrentunit then
                      begin
                        actasmpattern:=actasmpattern+c;
                        c:=current_scanner.asmgetchar;
@@ -1522,7 +1523,11 @@ end.
 
 {
   $Log$
-  Revision 1.16  2004-12-22 17:09:55  peter
+  Revision 1.17  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.16  2004/12/22 17:09:55  peter
     * support sizeof()
     * fix typecasting a constant like dword(4)
 

compiler/rautils.pas

@@ -1211,7 +1211,8 @@ begin
      if assigned(srsym) then
       begin
         if (srsym.typ=unitsym) and
-           (srsym.owner.unitid=0) then
+           (srsym.owner.symtabletype in [staticsymtable,globalsymtable]) and
+           srsym.owner.iscurrentunit then
          srsym:=searchsymonlyin(tunitsym(srsym).unitsymtable,Copy(s,i+1,255))
         else
          srsym:=nil;
@@ -1625,7 +1626,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.100  2005-01-05 15:22:39  florian
+  Revision 1.101  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.100  2005/01/05 15:22:39  florian
     * added support of shifter ops in arm inline assembler
 
   Revision 1.99  2004/12/22 17:09:55  peter

compiler/symbase.pas

@@ -103,10 +103,9 @@ interface
           next      : tsymtable;
           defowner  : tdefentry; { for records and objects }
           symtabletype  : tsymtabletype;
-          { each symtable gets a number }
-          unitid        : word;
           { level of symtable, used for nested procedures }
           symtablelevel : byte;
+          moduleid      : longint;
           refcount  : integer;
           constructor Create(const s:string);
           destructor  destroy;override;
@@ -123,6 +122,7 @@ interface
           function  search(const s : stringid) : tsymentry;
           function  speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;virtual;
           procedure registerdef(p : tdefentry);
+          function  iscurrentunit:boolean;virtual;
 {$ifdef EXTDEBUG}
           procedure dump;
 {$endif EXTDEBUG}
@@ -178,7 +178,6 @@ implementation
          defindex:=TIndexArray.create(indexgrowsize);
          symsearch:=tdictionary.create;
          symsearch.noclear:=true;
-         unitid:=0;
          refcount:=1;
       end;
 
@@ -242,6 +241,12 @@ implementation
       end;
 
 
+    function tsymtable.iscurrentunit:boolean;
+      begin
+        result:=false;
+      end;
+
+
     procedure tsymtable.foreach(proc2call : tnamedindexcallback;arg:pointer);
       begin
         symindex.foreach(proc2call,arg);
@@ -345,7 +350,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.24  2005-01-09 20:24:43  olle
+  Revision 1.25  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.24  2005/01/09 20:24:43  olle
     * rework of macro subsystem
     + exportable macros for mode macpas
 

compiler/symdef.pas

@@ -1132,8 +1132,9 @@ implementation
           end;
         if (cs_gdb_dbx in aktglobalswitches) and
            assigned(typesym) and
-           (ttypesym(typesym).owner.unitid<>0) then
-          result:='('+tostr(ttypesym(typesym).owner.unitid)+','+tostr(tstoreddef(ttypesym(typesym).restype.def).globalnb)+')'
+           (ttypesym(typesym).owner.symtabletype in [staticsymtable,globalsymtable]) and
+           (ttypesym(typesym).owner.iscurrentunit) then
+          result:='('+tostr(tabstractunitsymtable(ttypesym(typesym).owner).moduleid)+','+tostr(tstoreddef(ttypesym(typesym).restype.def).globalnb)+')'
         else
           result:=tostr(globalnb);
       end;
@@ -3315,7 +3316,7 @@ implementation
          { now dereference the definitions }
          tstoredsymtable(symtable).deref;
          aktrecordsymtable:=oldrecsyms;
-         { assign TGUID? load only from system unit (unitid=1) }
+         { assign TGUID? load only from system unit }
          if not(assigned(rec_tguid)) and
             (upper(typename)='TGUID') and
             assigned(owner) and
@@ -3837,6 +3838,8 @@ implementation
 {$ifdef GDB}
          isstabwritten := false;
 {$endif GDB}
+         { Disable po_has_inlining until the derefimpl is done }
+         exclude(procoptions,po_has_inlininginfo);
       end;
 
 
@@ -4034,7 +4037,7 @@ implementation
           module as they are defined }
         if (sp_private in symoptions) and
            (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-           (owner.defowner.owner.unitid<>0) then
+           not(owner.defowner.owner.iscurrentunit) then
           exit;
 
         { protected symbols are vissible in the module that defines them and
@@ -4044,11 +4047,12 @@ implementation
            (
             (
              (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-             (owner.defowner.owner.unitid<>0)
+             not(owner.defowner.owner.iscurrentunit)
             ) and
             not(
                 assigned(currobjdef) and
-                (currobjdef.owner.unitid=0) and
+                (currobjdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
+                (currobjdef.owner.iscurrentunit) and
                 currobjdef.is_related(tobjectdef(owner.defowner))
                )
            ) then
@@ -4155,6 +4159,7 @@ implementation
          end;
         ppufile.writeentry(ibdefref);
         write_references:=true;
+{$ifdef supportbrowser}
         if ((current_module.flags and uf_local_browser)<>0) and
            assigned(localst) and
            locals then
@@ -4165,14 +4170,14 @@ implementation
                  begin
                     if pdo.symtable<>aktrecordsymtable then
                       begin
-                         pdo.symtable.unitid:=local_symtable_index;
+                         pdo.symtable.moduleid:=local_symtable_index;
                          inc(local_symtable_index);
                       end;
                     pdo:=pdo.childof;
                  end;
-             parast.unitid:=local_symtable_index;
+             parast.moduleid:=local_symtable_index;
              inc(local_symtable_index);
-             localst.unitid:=local_symtable_index;
+             localst.moduleid:=local_symtable_index;
              inc(local_symtable_index);
              tstoredsymtable(parast).write_references(ppufile,locals);
              tstoredsymtable(localst).write_references(ppufile,locals);
@@ -4187,6 +4192,7 @@ implementation
                     pdo:=pdo.childof;
                  end;
           end;
+{$endif supportbrowser}
         aktparasymtable:=oldparasymtable;
         aktlocalsymtable:=oldlocalsymtable;
       end;
@@ -4303,6 +4309,12 @@ implementation
 
          inherited buildderefimpl;
 
+         { Enable has_inlininginfo when the inlininginfo
+           structure is available. The has_inlininginfo was disabled
+           after the load, since the data was invalid }
+         if assigned(inlininginfo) then
+             include(procoptions,po_has_inlininginfo);
+
          { Locals }
          if assigned(localst) and
             ((po_has_inlininginfo in procoptions) or
@@ -4566,7 +4578,7 @@ implementation
 
     function tprocvardef.getcopy : tstoreddef;
       begin
-      {
+      (*
           { saves a definition to the return type }
           rettype         : ttype;
           parast          : tsymtable;
@@ -4588,7 +4600,7 @@ implementation
           constructor create(level:byte);
           constructor ppuload(ppufile:tcompilerppufile);
           function getcopy : tstoreddef;override;
-       }
+       *)
       end;
 
 
@@ -4959,7 +4971,7 @@ implementation
     function tobjectdef.getcopy : tstoreddef;
       begin
         result:=inherited getcopy;
-      {
+      (*
         result:=tobjectdef.create(objecttype,objname^,childof);
           childofderef  : tderef;
           objname,
@@ -4977,7 +4989,7 @@ implementation
           lastvtableindex: longint;
           { store implemented interfaces defs and name mappings }
           implementedinterfaces: timplementedinterfaces;
-      }
+      *)
       end;
 
 
@@ -6355,7 +6367,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.289  2005-01-16 14:47:26  florian
+  Revision 1.290  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.289  2005/01/16 14:47:26  florian
     * typeinfo in typedata is now aligned
 
   Revision 1.288  2005/01/09 15:05:29  peter

compiler/symtable.pas

@@ -138,16 +138,17 @@ interface
           prev_dbx_counter : plongint;
           dbx_count_ok : boolean;
 {$endif GDB}
-          constructor create(const n : string);
+          constructor create(const n : string;id:word);
 {$ifdef GDB}
           procedure concattypestabto(asmlist : taasmoutput);
 {$endif GDB}
+          function iscurrentunit:boolean;override;
        end;
 
        tglobalsymtable = class(tabstractunitsymtable)
        public
           unittypecount : word;
-          constructor create(const n : string);
+          constructor create(const n : string;id:word);
           procedure ppuload(ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
@@ -160,7 +161,7 @@ interface
 
        tstaticsymtable = class(tabstractunitsymtable)
        public
-          constructor create(const n : string);
+          constructor create(const n : string;id:word);
           procedure ppuload(ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
@@ -591,7 +592,9 @@ implementation
         st:=findunitsymtable(sym.owner);
         with tsym(sym).fileinfo do
           begin
-            if assigned(st) and (st.unitid<>0) then
+            if assigned(st) and
+               (st.symtabletype=globalsymtable) and
+               (not st.iscurrentunit) then
               Message2(sym_h_duplicate_id_where,'unit '+st.name^,tostr(line))
             else
               Message2(sym_h_duplicate_id_where,current_module.sourcefiles.get_file_name(fileindex),tostr(line));
@@ -661,19 +664,14 @@ implementation
              Message(sym_e_only_static_in_static);
 
            { unit uses count }
-           if (unitid<>0) and
-              (symtabletype = globalsymtable) and
-              assigned(current_module) and
-              (unitid<current_module.mapsize) and
-              assigned(current_module.map[unitid].unitsym) then
-             inc(current_module.map[unitid].unitsym.refs);
-
-           { unitsym are only loaded for browsing PM    }
-           { this was buggy anyway because we could use }
-           { unitsyms from other units in _USES !!      }
-           {if (symtabletype=unitsymtable) and (hp.typ=unitsym) and
-              assigned(current_module) and (current_module.globalsymtable<>.load) then
-             hp:=nil;}
+           if assigned(current_module) and
+              (symtabletype=globalsymtable) then
+             begin
+               if tglobalsymtable(self).moduleid>current_module.unitmapsize then
+                 internalerror(200501152);
+               inc(current_module.unitmap[tglobalsymtable(self).moduleid].refs);
+             end;
+
            if make_ref and (cs_browser in aktmoduleswitches) then
              begin
                 newref:=tref.create(hp.lastref,@akttokenpos);
@@ -1344,9 +1342,10 @@ implementation
                          TAbstractUnitSymtable
 ****************************************************************************}
 
-    constructor tabstractunitsymtable.create(const n : string);
+    constructor tabstractunitsymtable.create(const n : string;id:word);
       begin
         inherited create(n);
+        moduleid:=id;
         symsearch.usehash;
 {$ifdef GDB}
          { reset GDB things }
@@ -1357,6 +1356,16 @@ implementation
       end;
 
 
+    function tabstractunitsymtable.iscurrentunit:boolean;
+      begin
+        result:=assigned(current_module) and
+                (
+                 (current_module.globalsymtable=self) or
+                 (current_module.localsymtable=self)
+                );
+      end;
+
+
 {$ifdef GDB}
       procedure tabstractunitsymtable.concattypestabto(asmlist : taasmoutput);
 
@@ -1368,7 +1377,7 @@ implementation
              while assigned(p) do
                begin
                  { also insert local types for the current unit }
-                 if (unitid=0) then
+                 if iscurrentunit then
                    begin
                      case p.deftype of
                        procdef :
@@ -1390,23 +1399,23 @@ implementation
         begin
            if not assigned(name) then
              name := stringdup('Main_program');
-           asmList.concat(tai_comment.Create(strpnew('Begin unit '+name^+' has index '+tostr(unitid))));
+           asmList.concat(tai_comment.Create(strpnew('Begin unit '+name^+' has index '+tostr(moduleid))));
            if cs_gdb_dbx in aktglobalswitches then
              begin
                 if dbx_count_ok then
                   begin
                      asmList.concat(tai_comment.Create(strpnew('"repeated" unit '+name^
-                              +' has index '+tostr(unitid)+' dbx count = '+tostr(dbx_count))));
+                              +' has index '+tostr(moduleid)+' dbx count = '+tostr(dbx_count))));
                      asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'
                        +tostr(N_EXCL)+',0,0,'+tostr(dbx_count))));
                      exit;
                   end
-                else if (current_module.globalsymtable<>self) then
+                else if not iscurrentunit then
                   begin
                     prev_dbx_count := dbx_counter;
                     dbx_counter := nil;
                     do_count_dbx:=false;
-                    if (symtabletype = globalsymtable) and (unitid<>0) then
+                    if (symtabletype = globalsymtable) then
                       asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0')));
                     dbx_counter := @dbx_count;
                     dbx_count:=0;
@@ -1421,7 +1430,7 @@ implementation
 
            if cs_gdb_dbx in aktglobalswitches then
              begin
-                if (current_module.globalsymtable<>self) then
+                if not iscurrentunit then
                   begin
                     dbx_counter := prev_dbx_count;
                     do_count_dbx:=false;
@@ -1431,7 +1440,7 @@ implementation
                     dbx_count_ok := {true}false;
                   end;
              end;
-           asmList.concat(tai_comment.Create(strpnew('End unit '+name^+' has index '+tostr(unitid))));
+           asmList.concat(tai_comment.Create(strpnew('End unit '+name^+' has index '+tostr(moduleid))));
         end;
 {$endif GDB}
 
@@ -1440,9 +1449,9 @@ implementation
                               TStaticSymtable
 ****************************************************************************}
 
-    constructor tstaticsymtable.create(const n : string);
+    constructor tstaticsymtable.create(const n : string;id:word);
       begin
-        inherited create(n);
+        inherited create(n,id);
         symtabletype:=staticsymtable;
         symtablelevel:=main_program_level;
       end;
@@ -1487,7 +1496,8 @@ implementation
       begin
          { also check the global symtable }
          if assigned(next) and
-            (next.unitid=0) then
+            (next.symtabletype=globalsymtable) and
+            (next.iscurrentunit) then
           begin
             hsym:=tsym(next.search(sym.name));
             if assigned(hsym) then
@@ -1511,20 +1521,19 @@ implementation
                               TGlobalSymtable
 ****************************************************************************}
 
-    constructor tglobalsymtable.create(const n : string);
+    constructor tglobalsymtable.create(const n : string;id:word);
       begin
-         inherited create(n);
+         inherited create(n,id);
          symtabletype:=globalsymtable;
          symtablelevel:=main_program_level;
-         unitid:=0;
 {$ifdef GDB}
          if cs_gdb_dbx in aktglobalswitches then
            begin
              dbx_count := 0;
              unittypecount:=1;
              pglobaltypecount := @unittypecount;
-             {unitid:=current_module.unitcount;}
-             {debugList.concat(tai_comment.Create(strpnew('Global '+name^+' has index '+tostr(unitid))));
+             {moduleid:=current_module.unitcount;}
+             {debugList.concat(tai_comment.Create(strpnew('Global '+name^+' has index '+tostr(moduleid))));
              debugList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0')));}
              {inc(current_module.unitcount);}
              { we can't use dbx_vcount, because we don't know
@@ -1624,24 +1633,6 @@ implementation
       var
          hsym : tsym;
       begin
-         { also check the global symtable }
-         if assigned(next) and
-            (next.unitid=0) then
-          begin
-            hsym:=tsym(next.search(sym.name));
-            if assigned(hsym) then
-             begin
-               { Delphi you can have a symbol with the same name as the
-                 unit, the unit can then not be accessed anymore using
-                 <unit>.<id>, so we can hide the symbol }
-               if (m_duplicate_names in aktmodeswitches) and
-                  (hsym.typ=symconst.unitsym) then
-                hsym.owner.rename(hsym.name,'hidden'+hsym.name)
-               else
-                DuplicateSym(sym,hsym);
-             end;
-          end;
-
          hsym:=tsym(search(sym.name));
          if assigned(hsym) then
           begin
@@ -1834,7 +1825,7 @@ implementation
                     assigned(srsymtable.defowner) and
                     (srsymtable.defowner.deftype=objectdef) and
                     (srsymtable.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-                    (srsymtable.defowner.owner.unitid=0) then
+                    (srsymtable.defowner.owner.iscurrentunit) then
                    topclass:=tobjectdef(srsymtable.defowner)
                  else
                    begin
@@ -1904,7 +1895,8 @@ implementation
                  exit;
                end;
               { also check in the local symtbale if it exists }
-              if (p=tsymtable(current_module.globalsymtable)) then
+              if (p.symtabletype=globalsymtable) and
+                 (p.iscurrentunit) then
                 begin
                    srsym:=tsym(current_module.localsymtable.search(s));
                    if assigned(srsym) then
@@ -1931,7 +1923,7 @@ implementation
            units. At least kylix supports it this way (PFV) }
          if assigned(classh) and
             (classh.owner.symtabletype in [globalsymtable,staticsymtable]) and
-            (classh.owner.unitid=0) then
+            classh.owner.iscurrentunit then
            topclassh:=classh
          else
            begin
@@ -1965,7 +1957,7 @@ implementation
            units. At least kylix supports it this way (PFV) }
          if assigned(classh) and
             (classh.owner.symtabletype in [globalsymtable,staticsymtable]) and
-            (classh.owner.unitid=0) then
+            classh.owner.iscurrentunit then
            topclassh:=classh
          else
            begin
@@ -2016,7 +2008,7 @@ implementation
            units. At least kylix supports it this way (PFV) }
          if assigned(classh) and
             (classh.owner.symtabletype in [globalsymtable,staticsymtable]) and
-            (classh.owner.unitid=0) then
+            classh.owner.iscurrentunit then
            topclassh:=classh
          else
            begin
@@ -2286,7 +2278,7 @@ implementation
                macrosymtablestack.next.insert(mac)
            end;
          if not mac.defined then
-           Message1(parser_c_macro_defined,mac.name); 
+           Message1(parser_c_macro_defined,mac.name);
          mac.defined:=true;
       end;
 
@@ -2471,7 +2463,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.168  2005-01-09 20:24:43  olle
+  Revision 1.169  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.168  2005/01/09 20:24:43  olle
     * rework of macro subsystem
     + exportable macros for mode macpas
 

compiler/symtype.pas

@@ -479,7 +479,7 @@ implementation
         if (sp_private in symoptions) and
            assigned(owner.defowner) and
            (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-           (owner.defowner.owner.unitid<>0) then
+           (not owner.defowner.owner.iscurrentunit) then
           exit;
 
         { protected symbols are vissible in the module that defines them and
@@ -489,7 +489,7 @@ implementation
             (
              assigned(owner.defowner) and
              (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-             (owner.defowner.owner.unitid<>0)
+             (not owner.defowner.owner.iscurrentunit)
             ) and
             not(
                 assigned(currobjdef) {and
@@ -595,8 +595,10 @@ implementation
         if assigned(sym) and
            (
             (sym<>def.typesym) or
-            ((sym.owner.unitid<>0) and
-             (sym.owner.unitid<>1))
+            (
+             not((sym.owner.symtabletype in [globalsymtable,staticsymtable]) and
+                 sym.owner.iscurrentunit)
+            )
            ) then
           deref.build(sym)
         else
@@ -811,33 +813,33 @@ implementation
         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.unitid=0 then
+                if s.owner.iscurrentunit then
                   begin
                     data[len]:=ord(deref_aktglobal);
                     inc(len);
                   end
                 else
                   begin
-                    { check if the unit is available in the uses
-                      clause, else it's an error }
-                    if s.owner.unitid=$ffff then
-                      internalerror(200306063);
+                    { register that the unit is needed for resolving }
+                    idx:=current_module.derefidx_unit(s.owner.moduleid);
                     data[len]:=ord(deref_unit);
-                    data[len+1]:=s.owner.unitid shr 8;
-                    data[len+2]:=s.owner.unitid and $ff;
+                    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 s.owner<>current_module.localsymtable then
+                if not s.owner.iscurrentunit then
                   internalerror(200306233);
                 data[len]:=ord(deref_aktstatic);
                 inc(len);
@@ -893,12 +895,11 @@ implementation
           while (currdef<>ownerdef) do
             begin
               nextdef:=currdef.getparentdef;
-              { objects are only allowed in globalsymtable,staticsymtable this check is
-                needed because we need the unitid }
+              { 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 nextdef.owner.unitid<>0 then
+              if not(nextdef.owner.iscurrentunit) then
                 break;
               currdef:=nextdef;
             end;
@@ -940,14 +941,14 @@ implementation
          begin
            { Static symtable of current unit ? }
            if (s.owner.symtabletype=staticsymtable) and
-              (s.owner.unitid=0) then
+              s.owner.iscurrentunit then
             begin
               data[len]:=ord(deref_aktstatic);
               inc(len);
             end
            { Global symtable of current unit ? }
            else if (s.owner.symtabletype=globalsymtable) and
-                   (s.owner.unitid=0) then
+                   s.owner.iscurrentunit then
             begin
               data[len]:=ord(deref_aktglobal);
               inc(len);
@@ -1075,11 +1076,7 @@ implementation
                 begin
                   idx:=(data[i] shl 8) or data[i+1];
                   inc(i,2);
-                  if idx>current_module.mapsize then
-                    internalerror(200306231);
-                  pm:=current_module.map[idx].u;
-                  if not assigned(pm) then
-                    internalerror(200212273);
+                  pm:=current_module.resolve_unit(idx);
                   st:=pm.globalsymtable;
                 end;
               deref_local :
@@ -1457,7 +1454,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.49  2004-12-15 21:09:06  peter
+  Revision 1.50  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.49  2004/12/15 21:09:06  peter
     * 64bit typecast
 
   Revision 1.48  2004/11/15 23:35:31  peter

compiler/utils/ppudump.pp

@@ -28,9 +28,9 @@ uses
   ppu;
 
 const
-  Version   = 'Version 1.10';
+  Version   = 'Version 1.9.8';
   Title     = 'PPU-Analyser';
-  Copyright = 'Copyright (c) 1998-2003 by the Free Pascal Development Team';
+  Copyright = 'Copyright (c) 1998-2005 by the Free Pascal Development Team';
 
 { verbosity }
   v_none           = $0;
@@ -76,7 +76,6 @@ type
 var
   ppufile     : tppufile;
   space       : string;
-  unitnumber,
   unitindex   : longint;
   verbose     : longint;
   derefdata   : pbyte;
@@ -391,8 +390,7 @@ var
 begin
   while not ppufile.EndOfEntry do
     begin
-      inc(unitnumber);
-      write('Uses unit: ',ppufile.getstring,' (Number: ',unitnumber,')');
+      write('Uses unit: ',ppufile.getstring);
       ucrc:=cardinal(ppufile.getlongint);
       uintfcrc:=cardinal(ppufile.getlongint);
       writeln(' (Crc: ',hexstr(ucrc,8),', IntfcCrc: ',hexstr(uintfcrc,8),')');
@@ -400,6 +398,17 @@ begin
 end;
 
 
+Procedure ReadDerefmap;
+var
+  i,mapsize : longint;
+begin
+  mapsize:=ppufile.getword;
+  writeln('DerefMapsize: ',mapsize);
+  for i:=0 to mapsize-1 do
+    writeln('DerefMap[',i,'] = ',ppufile.getstring);
+end;
+
+
 Procedure ReadDerefdata;
 begin
   derefdatalen:=ppufile.entrysize;
@@ -1764,6 +1773,9 @@ begin
          ibderefdata :
            ReadDerefData;
 
+         ibderefmap :
+           ReadDerefMap;
+
          iberror :
            begin
              Writeln('Error in PPU');
@@ -2132,7 +2144,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.64  2005-01-09 20:24:43  olle
+  Revision 1.65  2005-01-19 22:19:41  peter
+    * unit mapping rewrite
+    * new derefmap added
+
+  Revision 1.64  2005/01/09 20:24:43  olle
     * rework of macro subsystem
     + exportable macros for mode macpas