* symtable splitted, no real code changes

compiler/browcol.pas

@@ -775,7 +775,6 @@ begin
     absolutesym  : S:='abs';
     propertysym  : S:='prop';
     funcretsym   : S:='res';
-    macrosym     : S:='macro';
   else S:='';
   end;
   GetTypeName:=S;
@@ -2093,7 +2092,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  2000-10-15 07:47:51  peter
+  Revision 1.11  2000-10-31 22:02:46  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.10  2000/10/15 07:47:51  peter
     * unit names and procedure names are stored mixed case
 
   Revision 1.9  2000/09/24 15:06:11  peter

compiler/browlog.pas

@@ -26,7 +26,9 @@ unit browlog;
 
 interface
 uses
-  cobjects,globtype,fmodule,finput,symconst,symtable;
+  cobjects,globtype,
+  fmodule,finput,
+  symbase,symconst,symtype,symsym,symdef,symtable;
 
 const
   logbufsize   = 16384;
@@ -69,7 +71,9 @@ var
 implementation
 
   uses
-    cutils,comphook,globals,systems,verbose;
+    cutils,comphook,
+    globals,systems,verbose,
+    ppu;
 
     function get_file_line(ref:pref): string;
       var
@@ -255,7 +259,7 @@ implementation
 
     procedure tbrowserlog.browse_symbol(const sr : string);
       var
-         sym,symb : psym;
+         sym,symb : pstoredsym;
          symt : psymtable;
          hp : pmodule;
          s,ss : string;
@@ -285,9 +289,9 @@ implementation
          next_substring;
          if assigned(symt) then
            begin
-              sym:=symt^.search(ss);
+              sym:=pstoredsym(symt^.search(ss));
               if sym=nil then
-                sym:=symt^.search(upper(ss));
+                sym:=pstoredsym(symt^.search(upper(ss)));
            end
          else
            sym:=nil;
@@ -298,7 +302,7 @@ implementation
               if assigned(symt) then
                 begin
                    next_substring;
-                   sym:=symt^.search(ss);
+                   sym:=pstoredsym(symt^.search(ss));
                 end
               else
                 sym:=nil;
@@ -326,9 +330,9 @@ implementation
               else
                 begin
                    next_substring;
-                   sym:=symt^.search(ss);
+                   sym:=pstoredsym(symt^.search(ss));
                    if sym=nil then
-                     sym:=symt^.search(upper(ss));
+                     sym:=pstoredsym(symt^.search(upper(ss)));
                 end;
            end;
 
@@ -344,9 +348,9 @@ implementation
                             symt:=precorddef(ptypesym(sym)^.restype.def)^.symtable
                           else
                             symt:=pobjectdef(ptypesym(sym)^.restype.def)^.symtable;
-                          sym:=symt^.search(ss);
+                          sym:=pstoredsym(symt^.search(ss));
                           if sym=nil then
-                            sym:=symt^.search(upper(ss));
+                            sym:=pstoredsym(symt^.search(upper(ss)));
                        end;
                   end;
                 varsym :
@@ -357,33 +361,37 @@ implementation
                             symt:=precorddef(pvarsym(sym)^.vartype.def)^.symtable
                           else
                             symt:=pobjectdef(pvarsym(sym)^.vartype.def)^.symtable;
-                          sym:=symt^.search(ss);
+                          sym:=pstoredsym(symt^.search(ss));
                           if sym=nil then
-                            sym:=symt^.search(upper(ss));
+                            sym:=pstoredsym(symt^.search(upper(ss)));
                        end;
                   end;
                 procsym :
                   begin
                      symt:=pprocsym(sym)^.definition^.parast;
-                     symb:=symt^.search(ss);
+                     symb:=pstoredsym(symt^.search(ss));
                      if symb=nil then
-                       symb:=symt^.search(upper(ss));
+                       symb:=pstoredsym(symt^.search(upper(ss)));
                      if not assigned(symb) then
                        begin
                           symt:=pprocsym(sym)^.definition^.parast;
-                          sym:=symt^.search(ss);
+                          sym:=pstoredsym(symt^.search(ss));
                           if symb=nil then
-                            symb:=symt^.search(upper(ss));
+                            symb:=pstoredsym(symt^.search(upper(ss)));
                        end
                      else
                        sym:=symb;
                   end;
-                {else
-                  sym^.add_to_browserlog;}
                 end;
            end;
            if assigned(sym) then
-             sym^.add_to_browserlog
+            begin
+              if assigned(sym^.defref) then
+               begin
+                 browserlog.AddLog('***'+sym^.name+'***');
+                 browserlog.AddLogRefs(sym^.defref);
+               end;
+            end
            else
              addlog('!!!Symbol '+ss+' not found !!!');
            make_ref:=true;
@@ -401,13 +409,80 @@ implementation
       end;
 
 
+    procedure writesymtable(p:psymtable);
+      var
+        hp : pstoredsym;
+        prdef : pprocdef;
+      begin
+        if cs_browser in aktmoduleswitches then
+         begin
+           if assigned(p^.name) then
+             Browserlog.AddLog('---Symtable '+p^.name^)
+           else
+             begin
+                if (p^.symtabletype=recordsymtable) and
+                   assigned(pdef(p^.defowner)^.typesym) then
+                  Browserlog.AddLog('---Symtable '+pdef(p^.defowner)^.typesym^.name)
+                else
+                  Browserlog.AddLog('---Symtable with no name');
+             end;
+           Browserlog.Ident;
+           hp:=pstoredsym(p^.symindex^.first);
+           while assigned(hp) do
+            begin
+              if assigned(hp^.defref) then
+               begin
+                 browserlog.AddLog('***'+hp^.name+'***');
+                 browserlog.AddLogRefs(hp^.defref);
+               end;
+              case hp^.typ of
+                typesym :
+                  begin
+                    if (ptypesym(hp)^.restype.def^.deftype=recorddef) then
+                      writesymtable(precorddef(ptypesym(hp)^.restype.def)^.symtable);
+                    if (ptypesym(hp)^.restype.def^.deftype=objectdef) then
+                      writesymtable(pobjectdef(ptypesym(hp)^.restype.def)^.symtable);
+                  end;
+                procsym :
+                  begin
+                    prdef:=pprocsym(hp)^.definition;
+                    while assigned(prdef) do
+                     begin
+                       if assigned(prdef^.defref) then
+                        begin
+                          browserlog.AddLog('***'+prdef^.mangledname);
+                          browserlog.AddLogRefs(prdef^.defref);
+                          if (current_module^.flags and uf_local_browser)<>0 then
+                            begin
+                               if assigned(prdef^.parast) then
+                                 writesymtable(prdef^.parast);
+                               if assigned(prdef^.localst) then
+                                 writesymtable(prdef^.localst);
+                            end;
+                        end;
+                       if assigned(pprocdef(prdef)^.defref) then
+                        begin
+                          browserlog.AddLog('***'+pprocdef(prdef)^.name+'***');
+                          browserlog.AddLogRefs(pprocdef(prdef)^.defref);
+                        end;
+                       prdef:=pprocdef(prdef)^.nextoverloaded;
+                     end;
+                  end;
+              end;
+              hp:=pstoredsym(hp^.indexnext);
+            end;
+           browserlog.Unident;
+         end;
+      end;
+
+
 {****************************************************************************
                              Helpers
 ****************************************************************************}
 
    procedure WriteBrowserLog;
      var
-       p : psymtable;
+       p : pstoredsymtable;
        hp : pmodule;
      begin
        browserlog.CreateLog;
@@ -415,14 +490,14 @@ implementation
        hp:=pmodule(loaded_units.first);
        while assigned(hp) do
          begin
-            p:=psymtable(hp^.globalsymtable);
+            p:=pstoredsymtable(hp^.globalsymtable);
             if assigned(p) then
-              p^.writebrowserlog;
+              writesymtable(p);
             if cs_local_browser in aktmoduleswitches then
               begin
-                 p:=psymtable(hp^.localsymtable);
+                 p:=pstoredsymtable(hp^.localsymtable);
                  if assigned(p) then
-                   p^.writebrowserlog;
+                   writesymtable(p);
               end;
             hp:=pmodule(hp^.next);
          end;
@@ -443,7 +518,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  2000-09-24 15:06:11  peter
+  Revision 1.5  2000-10-31 22:02:46  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.4  2000/09/24 15:06:11  peter
     * use defines.inc
 
   Revision 1.3  2000/08/27 16:11:49  peter
@@ -453,4 +531,4 @@ end.
   Revision 1.2  2000/07/13 11:32:32  michael
   + removed logs
 
-}
+}

compiler/cobjects.pas

@@ -178,7 +178,7 @@ interface
        end;
 
 
-       { namedindexobject for use with dictionary and indexarray }
+       { namedindexobect for use with dictionary and indexarray }
        Pnamedindexobject=^Tnamedindexobject;
        Tnamedindexobject=object
        { indexarray }
@@ -1843,7 +1843,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.15  2000-10-14 10:14:46  peter
+  Revision 1.16  2000-10-31 22:02:46  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.15  2000/10/14 10:14:46  peter
     * moehrendorf oct 2000 rewrite
 
   Revision 1.14  2000/09/24 21:19:50  peter
@@ -1891,4 +1894,4 @@ end.
   Revision 1.2  2000/07/13 11:32:38  michael
   + removed logs
 
-}
+}

compiler/compiler.pas

@@ -203,7 +203,7 @@ end;
 procedure minimal_stop;{$ifndef fpc}far;{$endif}
 begin
   DoneCompiler;
-  olddo_stop;
+  olddo_stop{$ifdef FPCPROCVAR}(){$endif};
 end;
 
 
@@ -310,7 +310,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.9  2000-10-15 09:39:36  peter
+  Revision 1.10  2000-10-31 22:02:46  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.9  2000/10/15 09:39:36  peter
     * moved cpu*.pas to i386/
     * renamed n386 to common cpunode
 
@@ -337,4 +340,4 @@ end.
 
   Revision 1.2  2000/07/13 11:32:38  michael
   + removed logs
-}
+}

compiler/export.pas

@@ -28,7 +28,7 @@ interface
 
 uses
   cutils,cobjects,
-  symtable;
+  symtype;
 
 const
    { export options }
@@ -226,7 +226,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.6  2000-09-24 15:06:16  peter
+  Revision 1.7  2000-10-31 22:02:46  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.6  2000/09/24 15:06:16  peter
     * use defines.inc
 
   Revision 1.5  2000/09/16 12:22:52  peter
@@ -243,4 +246,4 @@ end.
   Revision 1.2  2000/07/13 11:32:41  michael
   + removed logs
 
-}
+}

compiler/finput.pas

@@ -27,7 +27,7 @@ unit finput;
 interface
 
     uses
-      cutils;
+      cutils,cobjects;
 
     const
        InputFileBufSize=32*1024;
@@ -109,6 +109,35 @@ interface
           function  get_file_path(l :longint):string;
        end;
 
+{****************************************************************************
+                                TModuleBase
+ ****************************************************************************}
+
+       pmodulebase = ^tmodulebase;
+       tmodulebase = object(tlinkedlist_item)
+          { index }
+          unit_index    : word;     { global counter for browser }
+          { sources }
+          sourcefiles   : pinputfilemanager;
+          { paths and filenames }
+          path,                     { path where the module is find/created }
+          outputpath,               { path where the .s / .o / exe are created }
+          modulename,               { name of the module in uppercase }
+          realmodulename,           { name of the module in the orignal case }
+          objfilename,              { fullname of the objectfile }
+          asmfilename,              { fullname of the assemblerfile }
+          ppufilename,              { fullname of the ppufile }
+          staticlibfilename,        { fullname of the static libraryfile }
+          sharedlibfilename,        { fullname of the shared libraryfile }
+          exefilename,              { fullname of the exefile }
+          mainsource   : pstring;   { name of the main sourcefile }
+          constructor init(const s:string);
+          destructor done;virtual;
+          procedure setfilename(const fn:string;allowoutput:boolean);
+       end;
+
+
+
 
 implementation
 
@@ -118,10 +147,7 @@ uses
 {$else Delphi}
   dos,
 {$endif Delphi}
-  cobjects,globals
-{$ifdef heaptrc}
-  ,fmodule
-{$endif heaptrc}
+  globals,systems
   ;
 
 {****************************************************************************
@@ -499,9 +525,9 @@ uses
          { update cache }
          cacheindex:=last_ref_index;
          cacheinputfile:=f;
-{$ifdef heaptrc}
+{$ifdef HEAPTRC}
          writeln(stderr,f^.name^,' index ',current_module^.unit_index*100000+f^.ref_index);
-{$endif heaptrc}
+{$endif HEAPTRC}
       end;
 
 
@@ -565,10 +591,107 @@ uses
      end;
 
 
+{****************************************************************************
+                                TModuleBase
+ ****************************************************************************}
+
+    procedure tmodulebase.setfilename(const fn:string;allowoutput:boolean);
+      var
+        p : dirstr;
+        n : NameStr;
+        e : ExtStr;
+      begin
+         stringdispose(objfilename);
+         stringdispose(asmfilename);
+         stringdispose(ppufilename);
+         stringdispose(staticlibfilename);
+         stringdispose(sharedlibfilename);
+         stringdispose(exefilename);
+         stringdispose(outputpath);
+         stringdispose(path);
+         { Create names }
+         fsplit(fn,p,n,e);
+         n:=FixFileName(n);
+         { set path }
+         path:=stringdup(FixPath(p,false));
+         { obj,asm,ppu names }
+         p:=path^;
+         if AllowOutput then
+          begin
+            if (OutputUnitDir<>'') then
+             p:=OutputUnitDir
+            else
+             if (OutputExeDir<>'') then
+              p:=OutputExeDir;
+          end;
+         outputpath:=stringdup(p);
+         objfilename:=stringdup(p+n+target_info.objext);
+         asmfilename:=stringdup(p+n+target_info.asmext);
+         ppufilename:=stringdup(p+n+target_info.unitext);
+         { lib and exe could be loaded with a file specified with -o }
+         if AllowOutput and (OutputFile<>'') and (compile_level=1) then
+          n:=OutputFile;
+         staticlibfilename:=stringdup(p+target_os.libprefix+n+target_os.staticlibext);
+         if target_info.target=target_i386_WIN32 then
+           sharedlibfilename:=stringdup(p+n+target_os.sharedlibext)
+         else
+           sharedlibfilename:=stringdup(p+target_os.libprefix+n+target_os.sharedlibext);
+         { output dir of exe can be specified separatly }
+         if AllowOutput and (OutputExeDir<>'') then
+          p:=OutputExeDir
+         else
+          p:=path^;
+         exefilename:=stringdup(p+n+target_info.exeext);
+      end;
+
+
+    constructor tmodulebase.init(const s:string);
+      begin
+        modulename:=stringdup(Upper(s));
+        realmodulename:=stringdup(s);
+        mainsource:=nil;
+        ppufilename:=nil;
+        objfilename:=nil;
+        asmfilename:=nil;
+        staticlibfilename:=nil;
+        sharedlibfilename:=nil;
+        exefilename:=nil;
+        outputpath:=nil;
+        path:=nil;
+        { unit index }
+        inc(global_unit_count);
+        unit_index:=global_unit_count;
+        { sources }
+        new(sourcefiles,init);
+      end;
+
+
+    destructor tmodulebase.done;
+      begin
+        if assigned(sourcefiles) then
+         dispose(sourcefiles,done);
+        sourcefiles:=nil;
+        stringdispose(objfilename);
+        stringdispose(asmfilename);
+        stringdispose(ppufilename);
+        stringdispose(staticlibfilename);
+        stringdispose(sharedlibfilename);
+        stringdispose(exefilename);
+        stringdispose(outputpath);
+        stringdispose(path);
+        stringdispose(modulename);
+        stringdispose(realmodulename);
+        stringdispose(mainsource);
+        inherited done;
+      end;
+
 end.
 {
   $Log$
-  Revision 1.3  2000-10-14 21:52:54  peter
+  Revision 1.4  2000-10-31 22:02:46  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.3  2000/10/14 21:52:54  peter
     * fixed memory leaks
 
   Revision 1.2  2000/09/24 15:06:16  peter
@@ -578,4 +701,4 @@ end.
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 
-}
+}

compiler/fmodule.pas

@@ -79,7 +79,7 @@ interface
        punitmap = ^tunitmap;
 {$endif NEWMAP}
 
-       tmodule = object(tlinkedlist_item)
+       tmodule = object(tmodulebase)
           ppufile       : pppufile; { the PPU file }
           crc,
           interface_crc,
@@ -102,7 +102,6 @@ interface
           islibrary     : boolean;  { if it is a library (win32 dll) }
           map           : punitmap; { mapping of all used units }
           unitcount     : word;     { local unit counter }
-          unit_index    : word;     { global counter for browser }
           globalsymtable,           { pointer to the local/static symtable of this unit }
           localsymtable : pointer;  { pointer to the psymtable of this unit }
           scanner       : pointer;  { scanner object used }
@@ -111,7 +110,6 @@ interface
           imports       : plinkedlist;
           _exports      : plinkedlist;
 
-          sourcefiles   : pinputfilemanager;
           resourcefiles : tstringcontainer;
 
           linkunitofiles,
@@ -129,18 +127,7 @@ interface
           localincludesearchpath,
           locallibrarysearchpath : TSearchPathList;
 
-          path,                     { path where the module is find/created }
-          outputpath,               { path where the .s / .o / exe are created }
-          modulename,               { name of the module in uppercase }
-          realmodulename,           { name of the module in the orignal case }
-          objfilename,              { fullname of the objectfile }
-          asmfilename,              { fullname of the assemblerfile }
-          ppufilename,              { fullname of the ppufile }
-          staticlibfilename,        { fullname of the static libraryfile }
-          sharedlibfilename,        { fullname of the shared libraryfile }
-          exefilename,              { fullname of the exefile }
-          asmprefix,                { prefix for the smartlink asmfiles }
-          mainsource    : pstring;  { name of the main sourcefile }
+          asmprefix     : pstring;  { prefix for the smartlink asmfiles }
 {$ifdef Test_Double_checksum}
           crc_array : pointer;
           crc_size : longint;
@@ -181,8 +168,6 @@ interface
        main_module       : pmodule;     { Main module of the program }
        current_module    : pmodule;     { Current module which is compiled or loaded }
        compiled_module   : pmodule;     { Current module which is compiled }
-       current_ppu       : pppufile;    { Current ppufile which is read }
-       global_unit_count : word;
        usedunits         : tlinkedlist; { Used units for this program }
        loaded_units      : tlinkedlist; { All loaded units }
        SmartLinkOFiles   : TStringContainer; { List of .o files which are generated,
@@ -200,7 +185,8 @@ uses
   dos,
 {$endif}
   globtype,verbose,systems,
-  symtable,scanner;
+  symbase,
+  scanner;
 
 
 {*****************************************************************************
@@ -629,12 +615,12 @@ end;
           pscannerfile(scanner)^.invalid:=true;
         if assigned(globalsymtable) then
           begin
-            dispose(punitsymtable(globalsymtable),done);
+            dispose(psymtable(globalsymtable),done);
             globalsymtable:=nil;
           end;
         if assigned(localsymtable) then
           begin
-            dispose(punitsymtable(localsymtable),done);
+            dispose(psymtable(localsymtable),done);
             localsymtable:=nil;
           end;
         if assigned(map) then
@@ -849,10 +835,10 @@ end;
         d.init('symtable');
 {$endif}
         if assigned(globalsymtable) then
-          dispose(punitsymtable(globalsymtable),done);
+          dispose(psymtable(globalsymtable),done);
         globalsymtable:=nil;
         if assigned(localsymtable) then
-          dispose(punitsymtable(localsymtable),done);
+          dispose(psymtable(localsymtable),done);
         localsymtable:=nil;
 {$ifdef MEMDEBUG}
         d.done;
@@ -912,7 +898,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-10-15 07:47:51  peter
+  Revision 1.4  2000-10-31 22:02:46  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.3  2000/10/15 07:47:51  peter
     * unit names and procedure names are stored mixed case
 
   Revision 1.2  2000/09/24 15:06:16  peter

compiler/fpc.pas

@@ -68,7 +68,7 @@ program fpc;
                else error('Illegal processor type');
             end
           else
-            ppccommandline:=ppccommandline+paramstr(i)+' ';          
+            ppccommandline:=ppccommandline+paramstr(i)+' ';
        end;
 
      { ppcXXX is expected to be in the same directory }
@@ -81,7 +81,10 @@ program fpc;
   end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:41  michael
+  Revision 1.3  2000-10-31 22:02:46  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.2  2000/07/13 11:32:41  michael
   + removed logs
 
 }

compiler/globals.pas

@@ -40,7 +40,7 @@ interface
       strings,
       dos,
 {$endif}
-      globtype,version,tokens,systems,cutils,cobjects;
+      globtype,version,systems,cutils,cobjects;
 
     const
 {$ifdef linux}
@@ -115,10 +115,7 @@ interface
        dllversion    : string;
        dllmajor,dllminor,dllrevision : word;  { revision only for netware }
 
-       { current position }
-       token,                        { current token being parsed }
-       idtoken    : ttoken;          { holds the token if the pattern is a known word }
-       tokenpos,                     { last postion of the read token }
+       akttokenpos,                  { position of the last token }
        aktfilepos : tfileposinfo;    { current position }
 
        { type of currently parsed block }
@@ -207,10 +204,12 @@ interface
 
        Inside_asm_statement : boolean = false;
 
-    { for error info in pp.pas }
-    const
+       global_unit_count : word = 0;
+
+       { for error info in pp.pas }
        parser_current_file : string = '';
 
+
     procedure abstract;
 
     function bstoslash(const s : string) : string;
@@ -1187,7 +1186,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.16  2000-10-04 14:51:08  pierre
+  Revision 1.17  2000-10-31 22:02:46  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.16  2000/10/04 14:51:08  pierre
    * IsExe restored
 
   Revision 1.15  2000/09/27 21:20:56  peter

compiler/hcgdata.pas

@@ -28,7 +28,7 @@ unit hcgdata;
 interface
 
     uses
-       symtable,aasm;
+       symdef,aasm;
 
     { generates the message tables for a class }
     function genstrmsgtab(_class : pobjectdef) : pasmlabel;
@@ -60,7 +60,7 @@ implementation
 {$endif}
        cutils,cobjects,
        globtype,globals,verbose,
-       symconst,types,
+       symconst,symtype,symsym,types,
        hcodegen, systems,fmodule
 {$ifdef INTERFACE_SUPPORT}
 {$ifdef i386}
@@ -1039,7 +1039,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.7  2000-10-14 10:14:47  peter
+  Revision 1.8  2000-10-31 22:02:47  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.7  2000/10/14 10:14:47  peter
     * moehrendorf oct 2000 rewrite
 
   Revision 1.6  2000/09/24 21:19:50  peter

compiler/hcodegen.pas

@@ -34,8 +34,13 @@ implementation
 
     uses
       cobjects,
-      tokens,verbose,
-      aasm,symconst,symtable,cpubase;
+      { global }
+      verbose,
+      { symtable }
+      symconst,symtype,symdef,symsym,
+      { aasm }
+      aasm,cpubase
+      ;
 
     const
        pi_uses_asm  = $1;       { set, if the procedure uses asm }
@@ -459,7 +464,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.6  2000-09-24 15:06:17  peter
+  Revision 1.7  2000-10-31 22:02:47  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.6  2000/09/24 15:06:17  peter
     * use defines.inc
 
   Revision 1.5  2000/08/27 16:11:51  peter
@@ -482,4 +490,4 @@ end.
   Revision 1.2  2000/07/13 11:32:41  michael
   + removed logs
 
-}
+}

compiler/htypechk.pas

@@ -29,7 +29,7 @@ interface
     uses
       tokens,
       node,
-      symtable;
+      symtype,symdef;
 
     type
       Ttok2nodeRec=record
@@ -124,7 +124,7 @@ implementation
     uses
        globtype,systems,
        cutils,cobjects,verbose,globals,
-       symconst,
+       symconst,symsym,symtable,
        types,pass_1,cpubase,
        ncnv,nld,
        nmem,ncal,nmat,
@@ -889,7 +889,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.12  2000-10-14 10:14:47  peter
+  Revision 1.13  2000-10-31 22:02:47  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.12  2000/10/14 10:14:47  peter
     * moehrendorf oct 2000 rewrite
 
   Revision 1.11  2000/10/01 19:48:23  peter

compiler/i386/cgai386.pas

@@ -30,7 +30,7 @@ interface
     uses
        cobjects,
        cpubase,cpuasm,
-       symconst,symtable,aasm;
+       symconst,symtype,symdef,aasm;
 
 {$define TESTGETTEMP to store const that
  are written into temps for later release PM }
@@ -148,7 +148,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 {$endif test_dest_loc}
 
 
-  implementation
+implementation
 
     uses
 {$ifdef delphi}
@@ -156,7 +156,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 {$else}
        strings,
 {$endif}
-       cutils,globtype,systems,globals,verbose,fmodule,types,
+       cutils,
+       globtype,systems,globals,verbose,
+       fmodule,
+       symbase,symsym,symtable,types,
        tgeni386,temp_gen,hcodegen,regvars
 {$ifdef GDB}
        ,gdb
@@ -1590,7 +1593,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
          else
            begin
               reset_reference(hr);
-              hr.symbol:=t^.get_inittable_label;
+              hr.symbol:=pstoreddef(t)^.get_inittable_label;
               emitpushreferenceaddr(hr);
               if is_already_ref then
                 exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,S_L,
@@ -1618,7 +1621,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
          else
            begin
               reset_reference(r);
-              r.symbol:=t^.get_inittable_label;
+              r.symbol:=pstoreddef(t)^.get_inittable_label;
               emitpushreferenceaddr(r);
               if is_already_ref then
                 exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,S_L,
@@ -1677,7 +1680,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
          begin
             procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
             reset_reference(hr);
-            hr.symbol:=pvarsym(p)^.vartype.def^.get_inittable_label;
+            hr.symbol:=pstoreddef(pvarsym(p)^.vartype.def)^.get_inittable_label;
             emitpushreferenceaddr(hr);
             reset_reference(hr);
             hr.base:=procinfo^.framepointer;
@@ -2702,20 +2705,20 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
                 begin
                   if ret_in_param(aktprocsym^.definition^.rettype.def) then
                     exprasmlist^.concat(new(pai_stabs,init(strpnew(
-                     '"'+aktprocsym^.name+':X*'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
+                     '"'+aktprocsym^.name+':X*'+pstoreddef(aktprocsym^.definition^.rettype.def)^.numberstring+'",'+
                      tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))))
                   else
                     exprasmlist^.concat(new(pai_stabs,init(strpnew(
-                     '"'+aktprocsym^.name+':X'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
+                     '"'+aktprocsym^.name+':X'+pstoreddef(aktprocsym^.definition^.rettype.def)^.numberstring+'",'+
                      tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))));
                   if (m_result in aktmodeswitches) then
                     if ret_in_param(aktprocsym^.definition^.rettype.def) then
                       exprasmlist^.concat(new(pai_stabs,init(strpnew(
-                       '"RESULT:X*'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
+                       '"RESULT:X*'+pstoreddef(aktprocsym^.definition^.rettype.def)^.numberstring+'",'+
                        tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))))
                     else
                       exprasmlist^.concat(new(pai_stabs,init(strpnew(
-                       '"RESULT:X'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
+                       '"RESULT:X'+pstoreddef(aktprocsym^.definition^.rettype.def)^.numberstring+'",'+
                        tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))));
                 end;
               mangled_length:=length(aktprocsym^.definition^.mangledname);
@@ -2813,7 +2816,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 end.
 {
   $Log$
-  Revision 1.5  2000-10-24 22:23:04  peter
+  Revision 1.6  2000-10-31 22:02:55  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.5  2000/10/24 22:23:04  peter
     * emitcall -> emitinsertcall for profiling (merged)
 
   Revision 1.4  2000/10/24 12:47:45  jonas
@@ -2903,4 +2909,4 @@ end.
   Revision 1.2  2000/07/13 11:32:37  michael
   + removed logs
 
-}
+}

compiler/i386/n386add.pas

@@ -43,7 +43,7 @@ interface
     uses
       globtype,systems,
       cutils,cobjects,verbose,globals,
-      symconst,symtable,aasm,types,
+      symconst,symdef,symtable,aasm,types,
       hcodegen,temp_gen,pass_2,
       cpuasm,
       node,ncon,nset,
@@ -2292,7 +2292,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2000-10-15 09:33:31  peter
+  Revision 1.2  2000-10-31 22:02:56  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.1  2000/10/15 09:33:31  peter
     * moved n386*.pas to i386/ cpu_target dir
 
   Revision 1.6  2000/10/14 10:14:47  peter
@@ -2315,4 +2318,4 @@ end.
 
   Revision 1.1  2000/09/20 21:23:32  florian
     * initial revision
-}
+}

compiler/i386/n386bas.pas

@@ -47,7 +47,7 @@ unit n386bas;
     uses
        globals,
        aasm,cpubase,cpuasm,
-       symtable,symconst,
+       symconst,symsym,
        pass_2,tgeni386,
        cgai386;
 
@@ -204,7 +204,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2000-10-15 09:33:31  peter
+  Revision 1.2  2000-10-31 22:02:56  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.1  2000/10/15 09:33:31  peter
     * moved n386*.pas to i386/ cpu_target dir
 
   Revision 1.1  2000/10/14 10:14:48  peter

compiler/i386/n386cal.pas

@@ -29,7 +29,7 @@ interface
 { $define AnsiStrRef}
 
     uses
-      symtable,node,ncal;
+      symdef,node,ncal;
 
     type
        ti386callparanode = class(tcallparanode)
@@ -56,7 +56,7 @@ implementation
 {$endif}
       globtype,systems,
       cutils,cobjects,verbose,globals,
-      symconst,aasm,types,
+      symconst,symbase,symtype,symsym,symtable,aasm,types,
 {$ifdef GDB}
       gdb,
 {$endif GDB}
@@ -101,7 +101,7 @@ implementation
            if (defcoll^.paratype.def^.needs_inittable) then
              begin
                 reset_reference(hr);
-                hr.symbol:=defcoll^.paratype.def^.get_inittable_label;
+                hr.symbol:=pstoreddef(defcoll^.paratype.def)^.get_inittable_label;
                 emitpushreferenceaddr(hr);
                 emitpushreferenceaddr(r);
                 emitcall('FPC_FINALIZE');
@@ -1593,7 +1593,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2000-10-15 09:33:31  peter
+  Revision 1.2  2000-10-31 22:02:56  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.1  2000/10/15 09:33:31  peter
     * moved n386*.pas to i386/ cpu_target dir
 
   Revision 1.2  2000/10/14 10:14:48  peter

compiler/i386/n386cnv.pas

@@ -68,7 +68,7 @@ implementation
 
    uses
       cobjects,verbose,globtype,globals,systems,
-      symconst,symtable,aasm,
+      symconst,symdef,aasm,
       hcodegen,temp_gen,pass_2,pass_1,
       ncon,ncal,
       cpubase,cpuasm,
@@ -1434,10 +1434,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2000-10-15 09:33:31  peter
+  Revision 1.2  2000-10-31 22:02:56  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.1  2000/10/15 09:33:31  peter
     * moved n386*.pas to i386/ cpu_target dir
 
   Revision 1.1  2000/10/14 10:14:48  peter
     * moehrendorf oct 2000 rewrite
 
-}
+}

compiler/i386/n386con.pas

@@ -64,7 +64,7 @@ implementation
     uses
       globtype,systems,
       cobjects,verbose,globals,
-      symconst,symtable,aasm,types,
+      symconst,symdef,aasm,types,
       hcodegen,temp_gen,pass_2,
       cpubase,cpuasm,
       cgai386,tgeni386;
@@ -488,7 +488,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2000-10-15 09:33:31  peter
+  Revision 1.2  2000-10-31 22:02:56  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.1  2000/10/15 09:33:31  peter
     * moved n386*.pas to i386/ cpu_target dir
 
   Revision 1.2  2000/10/14 10:14:48  peter

compiler/i386/n386flw.pas

@@ -86,7 +86,7 @@ implementation
 
     uses
       cobjects,verbose,globtype,globals,systems,
-      symconst,symtable,aasm,types,
+      symconst,symdef,symsym,aasm,types,
       hcodegen,temp_gen,pass_2,
       cpubase,cpuasm,
       pass_1,nld,ncon,
@@ -1284,7 +1284,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2000-10-15 09:33:31  peter
+  Revision 1.2  2000-10-31 22:02:56  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.1  2000/10/15 09:33:31  peter
     * moved n386*.pas to i386/ cpu_target dir
 
   Revision 1.1  2000/10/14 10:14:48  peter

compiler/i386/n386inl.pas

@@ -39,7 +39,7 @@ implementation
     uses
       globtype,systems,
       cutils,cobjects,verbose,globals,fmodule,
-      symconst,symtable,aasm,types,
+      symconst,symbase,symtype,symdef,symsym,aasm,types,
       hcodegen,temp_gen,pass_1,pass_2,
       cpubase,cpuasm,
       nbas,ncon,ncal,ncnv,nld,
@@ -682,7 +682,6 @@ implementation
            dummycoll : tparaitem;
            has_code, has_32bit_code, oldregisterdef: boolean;
            r : preference;
-           l : longint;
 
           begin
            dummycoll.init;
@@ -1308,11 +1307,11 @@ implementation
               end;
             in_typeinfo_x:
                begin
-                  ttypenode(tcallparanode(left).left).typenodetype^.generate_rtti;
+                  pstoreddef(ttypenode(tcallparanode(left).left).typenodetype)^.generate_rtti;
                   location.register:=getregister32;
                   new(r);
                   reset_reference(r^);
-                  r^.symbol:=ttypenode(tcallparanode(left).left).typenodetype^.rtti_label;
+                  r^.symbol:=pstoreddef(ttypenode(tcallparanode(left).left).typenodetype)^.rtti_label;
                   emit_ref_reg(A_MOV,S_L,r,location.register);
                end;
             in_assigned_x :
@@ -1398,7 +1397,7 @@ implementation
                        emitpushreferenceaddr(hr);
                        push_int(l);
                        reset_reference(hr2);
-                       hr2.symbol:=def^.get_inittable_label;
+                       hr2.symbol:=pstoreddef(def)^.get_inittable_label;
                        emitpushreferenceaddr(hr2);
                        emitpushreferenceaddr(tcallparanode(hp).left.location.reference);
                        emitcall('FPC_DYNARR_SETLENGTH');
@@ -1630,7 +1629,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2000-10-26 14:15:07  jonas
+  Revision 1.4  2000-10-31 22:02:56  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.3  2000/10/26 14:15:07  jonas
     * fixed setlength for shortstrings
 
   Revision 1.2  2000/10/21 18:16:13  florian

compiler/i386/n386ld.pas

@@ -51,7 +51,7 @@ implementation
     uses
       globtype,systems,
       cobjects,verbose,globals,fmodule,
-      symconst,symtable,aasm,types,
+      symconst,symtype,symdef,symsym,symtable,aasm,types,
       hcodegen,temp_gen,pass_2,
       nmem,ncon,ncnv,
       cpubase,cpuasm,
@@ -634,7 +634,7 @@ implementation
                                    { increment source reference counter }
                                    new(r);
                                    reset_reference(r^);
-                                   r^.symbol:=right.resulttype^.get_inittable_label;
+                                   r^.symbol:=pstoreddef(right.resulttype)^.get_inittable_label;
                                    emitpushreferenceaddr(r^);
 
                                    emitpushreferenceaddr(right.location.reference);
@@ -642,7 +642,7 @@ implementation
                                    { decrement destination reference counter }
                                    new(r);
                                    reset_reference(r^);
-                                   r^.symbol:=left.resulttype^.get_inittable_label;
+                                   r^.symbol:=pstoreddef(left.resulttype)^.get_inittable_label;
                                    emitpushreferenceaddr(r^);
                                    emitpushreferenceaddr(left.location.reference);
                                    emitcall('FPC_DECREF');
@@ -1064,7 +1064,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2000-10-15 09:33:31  peter
+  Revision 1.2  2000-10-31 22:02:56  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.1  2000/10/15 09:33:31  peter
     * moved n386*.pas to i386/ cpu_target dir
 
   Revision 1.1  2000/10/14 10:14:49  peter

compiler/i386/n386mat.pas

@@ -51,7 +51,7 @@ implementation
     uses
       globtype,systems,
       cutils,cobjects,verbose,globals,
-      symconst,symtable,aasm,types,
+      symconst,symdef,aasm,types,
       hcodegen,temp_gen,pass_2,
       ncon,
       cpubase,cpuasm,
@@ -994,7 +994,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  2000-10-19 16:26:52  jonas
+  Revision 1.5  2000-10-31 22:02:56  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.4  2000/10/19 16:26:52  jonas
     * fixed wrong regalloc info for secondmoddiv ("merged", also small
       correction made afterwards in fixes branch)
 

compiler/i386/n386mem.pas

@@ -91,7 +91,7 @@ implementation
 {$endif GDB}
       globtype,systems,
       cutils,cobjects,verbose,globals,
-      symconst,symtable,aasm,types,
+      symconst,symbase,symdef,symsym,symtable,aasm,types,
       hcodegen,temp_gen,pass_2,
       pass_1,nld,ncon,nadd,
       cpubase,cpuasm,
@@ -148,7 +148,7 @@ implementation
                 begin
                    new(r);
                    reset_reference(r^);
-                   r^.symbol:=ppointerdef(left.resulttype)^.pointertype.def^.get_inittable_label;
+                   r^.symbol:=pstoreddef(ppointerdef(left.resulttype)^.pointertype.def)^.get_inittable_label;
                    emitpushreferenceaddr(r^);
                    dispose(r);
                    { push pointer we just allocated, we need to initialize the
@@ -221,7 +221,7 @@ implementation
                   begin
                      new(r);
                      reset_reference(r^);
-                     r^.symbol:=ppointerdef(left.resulttype)^.pointertype.def^.get_inittable_label;
+                     r^.symbol:=pstoreddef(ppointerdef(left.resulttype)^.pointertype.def)^.get_inittable_label;
                      emitpushreferenceaddr(r^);
                      dispose(r);
                      { push pointer adress }
@@ -241,7 +241,7 @@ implementation
                   begin
                      new(r);
                      reset_reference(r^);
-                     r^.symbol:=ppointerdef(left.resulttype)^.pointertype.def^.get_inittable_label;
+                     r^.symbol:=pstoreddef(ppointerdef(left.resulttype)^.pointertype.def)^.get_inittable_label;
                      emitpushreferenceaddr(r^);
                      dispose(r);
                      emit_push_loc(left.location);
@@ -989,7 +989,7 @@ implementation
                       emitlab(withstartlabel);
                       withdebuglist^.concat(new(pai_stabs,init(strpnew(
                          '"with'+tostr(withlevel)+':'+tostr(symtablestack^.getnewtypecount)+
-                         '=*'+left.resulttype^.numberstring+'",'+
+                         '=*'+pstoreddef(left.resulttype)^.numberstring+'",'+
                          tostr(N_LSYM)+',0,0,'+tostr(withreference^.offset)))));
                       mangled_length:=length(aktprocsym^.definition^.mangledname);
                       getmem(pp,mangled_length+50);
@@ -1052,7 +1052,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2000-10-31 14:18:53  jonas
+  Revision 1.4  2000-10-31 22:02:57  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.3  2000/10/31 14:18:53  jonas
     * merged double deleting of left location when using a temp in
       secondwith (merged from fixes branch). This also fixes web bug1194
 

compiler/i386/n386set.pas

@@ -46,7 +46,7 @@ implementation
     uses
       globtype,systems,cpuinfo,
       cobjects,verbose,globals,
-      symconst,symtable,aasm,types,
+      symconst,symdef,aasm,types,
       hcodegen,temp_gen,pass_2,
       ncon,
       cpubase,cpuasm,
@@ -1061,7 +1061,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.2  2000-10-26 15:53:27  jonas
+  Revision 1.3  2000-10-31 22:02:57  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.2  2000/10/26 15:53:27  jonas
     * fixed web bug1192 (changed an ungetregister32 to ungetregister)
       ("merged" from fixes)
 

compiler/i386/n386util.pas

@@ -27,7 +27,7 @@ unit n386util;
 interface
 
     uses
-      symtable,node;
+      symtype,node;
 
     function  maybe_push(needed : byte;p : tnode;isint64 : boolean) : boolean;
 {$ifdef TEMPS_NOT_PUSH}
@@ -55,7 +55,7 @@ implementation
        globtype,globals,systems,verbose,
        cutils,cobjects,
        aasm,cpubase,cpuasm,
-       symconst,
+       symconst,symdef,symsym,symtable,
 {$ifdef GDB}
        gdb,
 {$endif GDB}
@@ -1315,7 +1315,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.1  2000-10-15 09:33:32  peter
+  Revision 1.2  2000-10-31 22:02:57  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.1  2000/10/15 09:33:32  peter
     * moved n386*.pas to i386/ cpu_target dir
 
   Revision 1.3  2000/10/14 21:52:54  peter

compiler/i386/ra386att.pas

@@ -43,7 +43,7 @@ Implementation
        { aasm }
        cpubase,aasm,
        { symtable }
-       symconst,symtable,types,
+       symconst,symtype,symsym,symtable,types,
        { pass 1 }
        nbas,
        { parser }
@@ -2114,7 +2114,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2000-10-15 09:47:43  peter
+  Revision 1.2  2000-10-31 22:02:57  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.1  2000/10/15 09:47:43  peter
     * moved to i386/
 
   Revision 1.6  2000/10/14 10:14:52  peter

compiler/i386/ra386dir.pas

@@ -42,7 +42,7 @@ interface
        { aasm }
        cpubase,aasm,
        { symtable }
-       symconst,symtable,types,
+       symconst,symtype,symdef,symsym,symtable,types,
        { pass 1 }
        nbas,
        { parser }
@@ -150,7 +150,7 @@ interface
                                    begin
                                       if assigned(aktprocsym^.definition^.localst) and
                                          (lexlevel >= normal_function_level) then
-                                        sym:=aktprocsym^.definition^.localst^.search(upper(hs))
+                                        sym:=psym(aktprocsym^.definition^.localst^.search(upper(hs)))
                                       else
                                         sym:=nil;
                                       if assigned(sym) then
@@ -185,7 +185,7 @@ interface
                                       else
                                         begin
                                            if assigned(aktprocsym^.definition^.parast) then
-                                             sym:=aktprocsym^.definition^.parast^.search(upper(hs))
+                                             sym:=psym(aktprocsym^.definition^.parast^.search(upper(hs)))
                                            else
                                              sym:=nil;
                                            if assigned(sym) then
@@ -288,7 +288,10 @@ interface
 end.
 {
   $Log$
-  Revision 1.1  2000-10-15 09:47:43  peter
+  Revision 1.2  2000-10-31 22:02:57  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.1  2000/10/15 09:47:43  peter
     * moved to i386/
 
   Revision 1.5  2000/10/14 10:14:52  peter

compiler/i386/ra386int.pas

@@ -43,7 +43,7 @@ Implementation
        { aasm }
        cpubase,aasm,
        { symtable }
-       symconst,symtable,types,
+       symconst,symtype,symsym,symtable,types,
        { pass 1 }
        nbas,
        { parser }
@@ -1916,7 +1916,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2000-10-15 09:47:43  peter
+  Revision 1.2  2000-10-31 22:02:57  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.1  2000/10/15 09:47:43  peter
     * moved to i386/
 
   Revision 1.8  2000/10/14 10:14:52  peter

compiler/nadd.pas

@@ -47,7 +47,7 @@ implementation
     uses
       globtype,systems,tokens,
       cobjects,cutils,verbose,globals,
-      symconst,symtable,aasm,types,
+      symconst,symtype,symdef,symtable,aasm,types,
       cpuinfo,
 {$ifdef newcg}
       cgbase,
@@ -1232,7 +1232,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.13  2000-10-14 10:14:50  peter
+  Revision 1.14  2000-10-31 22:02:47  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.13  2000/10/14 10:14:50  peter
     * moehrendorf oct 2000 rewrite
 
   Revision 1.12  2000/10/01 19:48:23  peter

compiler/nbas.pas

@@ -74,7 +74,7 @@ implementation
     uses
       globtype,systems,
       cutils,cobjects,verbose,globals,
-      symtable,types,
+      symtype,symdef,types,
       htypechk,
       cpubase,cpuasm,
       pass_1,
@@ -349,7 +349,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2000-10-27 14:57:16  jonas
+  Revision 1.4  2000-10-31 22:02:47  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.3  2000/10/27 14:57:16  jonas
     + implementation for tasmnode.getcopy
 
   Revision 1.2  2000/10/14 21:52:54  peter

compiler/ncal.pas

@@ -28,7 +28,8 @@ unit ncal;
 interface
 
     uses
-       node,symtable;
+       node,
+       symbase,symsym,symdef,symtable;
 
     type
        tcallnode = class(tbinarynode)
@@ -101,7 +102,7 @@ interface
     uses
       cutils,globtype,systems,
       cobjects,verbose,globals,
-      symconst,aasm,types,
+      symconst,symtype,aasm,types,
       htypechk,pass_1,cpubase,
       ncnv,nld,ninl,nadd,ncon
 {$ifdef newcg}
@@ -671,7 +672,8 @@ interface
          if assigned(right) then
            begin
               { procedure does a call }
-              procinfo^.flags:=procinfo^.flags or pi_do_call;
+              if not (block_type in [bt_const,bt_type]) then
+                procinfo^.flags:=procinfo^.flags or pi_do_call;
 {$ifndef newcg}
               { calc the correture value for the register }
 {$ifdef i386}
@@ -1239,7 +1241,7 @@ interface
                end; { end of procedure to call determination }
 
               is_const:=(pocall_internconst in procdefinition^.proccalloptions) and
-                        ((block_type=bt_const) or
+                        ((block_type in [bt_const,bt_type]) or
                          (assigned(left) and (tcallparanode(left).left.nodetype in [realconstn,ordconstn])));
               { handle predefined procedures }
               if (pocall_internproc in procdefinition^.proccalloptions) or is_const then
@@ -1294,7 +1296,10 @@ interface
                      end;
                 end
               else
-                procinfo^.flags:=procinfo^.flags or pi_do_call;
+                begin
+                  if not (block_type in [bt_const,bt_type]) then
+                    procinfo^.flags:=procinfo^.flags or pi_do_call;
+                end;
 
               { add needed default parameters }
               if assigned(procs) and
@@ -1482,14 +1487,9 @@ interface
          inlineprocsym:=tcallnode(callp).symtableprocentry;
          retoffset:=-4; { less dangerous as zero (PM) }
          para_offset:=0;
-      {$IFDEF NEWST}
-         {Fixme!!}
-         internalerror($00022801);
-      {$ELSE}
          para_size:=inlineprocsym^.definition^.para_size(target_os.stackalignment);
          if ret_in_param(inlineprocsym^.definition^.rettype.def) then
            para_size:=para_size+target_os.size_of_pointer;
-      {$ENDIF NEWST}
          { copy args }
          inlinetree:=code;
          registers32:=code.registers32;
@@ -1497,11 +1497,7 @@ interface
 {$ifdef SUPPORT_MMX}
          registersmmx:=code.registersmmx;
 {$endif SUPPORT_MMX}
-      {$IFDEF NEWST}
-         {Fixme!!}
-      {$ELSE}
          resulttype:=inlineprocsym^.definition^.rettype.def;
-      {$ENDIF NEWST}
       end;
 
     destructor tprocinlinenode.destroy;
@@ -1549,7 +1545,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.12  2000-10-21 18:16:11  florian
+  Revision 1.13  2000-10-31 22:02:47  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.12  2000/10/21 18:16:11  florian
     * a lot of changes:
        - basic dyn. array support
        - basic C++ support
@@ -1589,4 +1588,4 @@ end.
   Revision 1.1  2000/09/20 20:52:16  florian
     * initial revision
 
-}
+}

compiler/ncnv.pas

@@ -28,7 +28,7 @@ interface
 
     uses
        node,
-       symtable,types,
+       symtype,types,
        nld;
 
     type
@@ -87,7 +87,7 @@ implementation
    uses
       globtype,systems,tokens,
       cutils,cobjects,verbose,globals,
-      symconst,aasm,
+      symconst,symdef,symsym,symtable,aasm,
       ncon,ncal,nset,nadd,
 {$ifdef newcg}
       cgbase,
@@ -898,8 +898,8 @@ implementation
            if nf_explizit in flags then
             begin
               { check if the result could be in a register }
-              if not(resulttype^.is_intregable) and
-                not(resulttype^.is_fpuregable) then
+              if not(pstoreddef(resulttype)^.is_intregable) and
+                not(pstoreddef(resulttype)^.is_fpuregable) then
                 make_not_regable(left);
               { boolean to byte are special because the
                 location can be different }
@@ -1163,7 +1163,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.8  2000-10-14 21:52:55  peter
+  Revision 1.9  2000-10-31 22:02:48  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.8  2000/10/14 21:52:55  peter
     * fixed memory leaks
 
   Revision 1.7  2000/10/14 10:14:50  peter

compiler/ncon.pas

@@ -27,7 +27,10 @@ unit ncon;
 interface
 
     uses
-      globtype,node,aasm,cpuinfo,symconst,symtable;
+      globtype,
+      node,
+      aasm,cpuinfo,
+      symconst,symtype,symdef,symsym;
 
     type
        trealconstnode = class(tnode)
@@ -388,13 +391,8 @@ implementation
          inherited create(ordconstn);
          value:=v;
          resulttype:=def;
-{$ifdef NEWST}
-         if typeof(resulttype^)=typeof(Torddef) then
-          testrange(resulttype,value);
-{$else NEWST}
          if resulttype^.deftype=orddef then
           testrange(resulttype,value);
-{$endif ELSE}
       end;
 
     function tordconstnode.getcopy : tnode;
@@ -628,7 +626,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.9  2000-10-14 21:52:55  peter
+  Revision 1.10  2000-10-31 22:02:48  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.9  2000/10/14 21:52:55  peter
     * fixed memory leaks
 
   Revision 1.8  2000/10/14 10:14:50  peter

compiler/nflw.pas

@@ -28,7 +28,8 @@ unit nflw;
 interface
 
     uses
-       node,aasm,cpubase,symtable;
+       node,aasm,cpubase,
+       symbase,symdef,symsym;
 
     type
        tloopnode = class(tbinarynode)
@@ -143,7 +144,7 @@ implementation
     uses
       globtype,systems,
       cutils,cobjects,verbose,globals,
-      symconst,types,htypechk,pass_1,
+      symconst,symtable,types,htypechk,pass_1,
       ncon,nmem,nld,ncnv,nbas
 {$ifdef newcg}
       ,tgobj
@@ -993,7 +994,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.8  2000-10-21 18:16:11  florian
+  Revision 1.9  2000-10-31 22:02:48  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.8  2000/10/21 18:16:11  florian
     * a lot of changes:
        - basic dyn. array support
        - basic C++ support

compiler/ninl.pas

@@ -49,7 +49,7 @@ implementation
     uses
       cobjects,verbose,globals,systems,
       globtype,
-      symconst,symtable,aasm,types,
+      symconst,symtype,symdef,symsym,symtable,aasm,types,
       pass_1,
       ncal,ncon,ncnv,nadd,nld,nbas,
       cpubase
@@ -133,7 +133,7 @@ implementation
                end;
              enumdef:
                begin
-                  enum:=Penumdef(Adef)^.firstenum;
+                  enum:=penumsym(Penumdef(Adef)^.firstenum);
                   if inlinenumber=in_high_x then
                     while enum^.nextenum<>nil do
                       enum:=enum^.nextenum;
@@ -692,7 +692,7 @@ implementation
                        if (counter>1) and
                          (not(is_dynamic_array(left.resulttype))) then
                          CGMessage(type_e_mismatch);
-                         
+
                        { convert shortstrings to openstring parameters }
                        { (generate the hightree) (JM)                  }
                        if (ppn.left.resulttype^.deftype = stringdef) and
@@ -1464,7 +1464,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.11  2000-10-26 14:15:06  jonas
+  Revision 1.12  2000-10-31 22:02:48  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.11  2000/10/26 14:15:06  jonas
     * fixed setlength for shortstrings
 
   Revision 1.10  2000/10/21 18:16:11  florian

compiler/nld.pas

@@ -27,7 +27,8 @@ unit nld;
 interface
 
     uses
-       node,symtable;
+       node,
+       symbase,symtype,symsym;
 
     type
        tloadnode = class(tunarynode)
@@ -94,7 +95,7 @@ implementation
 
     uses
       cutils,cobjects,verbose,globtype,globals,systems,
-      symconst,aasm,types,
+      symconst,symdef,symtable,aasm,types,
       htypechk,pass_1,
       ncnv,nmem,cpubase
 {$ifdef newcg}
@@ -751,7 +752,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.6  2000-10-14 10:14:50  peter
+  Revision 1.7  2000-10-31 22:02:49  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.6  2000/10/14 10:14:50  peter
     * moehrendorf oct 2000 rewrite
 
   Revision 1.5  2000/10/01 19:48:24  peter

compiler/nmat.pas

@@ -27,7 +27,7 @@ unit nmat;
 interface
 
     uses
-       node,symtable;
+       node;
 
     type
        tmoddivnode = class(tbinopnode)
@@ -54,12 +54,13 @@ interface
        cunaryminusnode : class of tunaryminusnode;
        cnotnode : class of tnotnode;
 
-  implementation
+
+implementation
 
     uses
       globtype,systems,tokens,
       cobjects,verbose,globals,
-      symconst,aasm,types,
+      symconst,symtype,symtable,symdef,aasm,types,
       htypechk,pass_1,cpubase,cpuinfo,
 {$ifdef newcg}
       cgbase,
@@ -528,7 +529,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.7  2000-10-01 19:48:24  peter
+  Revision 1.8  2000-10-31 22:02:49  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.7  2000/10/01 19:48:24  peter
     * lot of compile updates for cg11
 
   Revision 1.6  2000/09/27 21:33:22  florian

compiler/nmem.pas

@@ -27,7 +27,9 @@ unit nmem;
 interface
 
     uses
-       node,symtable,cpubase;
+       node,
+       symtype,symdef,symsym,symtable,
+       cpubase;
 
     type
        tloadvmtnode = class(tunarynode)
@@ -88,14 +90,9 @@ interface
        end;
 
        twithnode = class(tbinarynode)
-{$IFDEF NEWST}
-          withsymtables : Pcollection;
-          withreference : preference;
-{$ELSE}
           withsymtable : pwithsymtable;
           tablecount : longint;
           withreference:preference;
-{$ENDIF NEWST}
           constructor create(symtable : pwithsymtable;l,r : tnode;count : longint);virtual;
           destructor destroy;override;
           function getcopy : tnode;override;
@@ -104,11 +101,7 @@ interface
 
     function gensubscriptnode(varsym : pvarsym;l : tnode) : tsubscriptnode;
     function genselfnode(_class : pdef) : tselfnode;
-{$IFDEF NEWST}
-    function genwithnode(symtables:Pcollection;l,r : tnode) : twithnode;
-{$ELSE}
     function genwithnode(symtable:pwithsymtable;l,r : tnode;count : longint) : twithnode;
-{$ENDIF NEWST}
 
     var
        cloadvmtnode : class of tloadvmtnode;
@@ -129,7 +122,7 @@ implementation
     uses
       globtype,systems,
       cutils,cobjects,verbose,globals,
-      symconst,aasm,types,
+      symconst,symbase,aasm,types,
       htypechk,pass_1,ncal,nld,ncon,ncnv
 {$ifdef newcg}
       ,cgbase
@@ -144,36 +137,11 @@ implementation
          genselfnode:=cselfnode.create(_class);
       end;
 
-{$IFDEF NEWST}
-   function genwithnode(symtables:Pcollection;l,r : tnode) : tnode;
-
-      var
-         p : tnode;
-
-      begin
-         !!!!!!!!! fixme
-         p:=getnode;
-         disposetyp:=dt_with;
-         nodetype:=withn;
-         left:=l;
-         right:=r;
-         registers32:=0;
-{$ifdef SUPPORT_MMX}
-         registersmmx:=0;
-{$endif SUPPORT_MMX}
-         resulttype:=nil;
-         withsymtables:=symtables;
-         withreference:=nil;
-         set_file_line(l,p);
-         genwithnode:=p;
-      end;
-{$ELSE}
    function genwithnode(symtable : pwithsymtable;l,r : tnode;count : longint) : twithnode;
 
       begin
          genwithnode:=cwithnode.create(symtable,l,r,count);
       end;
-{$ENDIF NEWST}
 
     function gensubscriptnode(varsym : pvarsym;l : tnode) : tsubscriptnode;
 
@@ -838,9 +806,6 @@ implementation
         symt : psymtable;
         i    : longint;
       begin
-{$IFDEF NEWST}
-        dispose(withsymtables,done);
-{$ELSE}
         symt:=withsymtable;
         for i:=1 to tablecount do
          begin
@@ -851,7 +816,6 @@ implementation
             end;
            symt:=withsymtable;
          end;
-{$ENDIF NEWST}
         inherited destroy;
       end;
 
@@ -908,7 +872,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.8  2000-10-21 18:16:11  florian
+  Revision 1.9  2000-10-31 22:02:49  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.8  2000/10/21 18:16:11  florian
     * a lot of changes:
        - basic dyn. array support
        - basic C++ support

compiler/node.pas

@@ -31,7 +31,7 @@ interface
        globtype,
        cpubase,
        aasm,
-       symtable;
+       symtype;
 
     {$I nodeh.inc}
 
@@ -47,7 +47,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.8  2000-10-01 19:48:24  peter
+  Revision 1.9  2000-10-31 22:02:49  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.8  2000/10/01 19:48:24  peter
     * lot of compile updates for cg11
 
   Revision 1.7  2000/09/30 16:08:45  peter

compiler/nset.pas

@@ -94,7 +94,7 @@ implementation
     uses
       globtype,systems,
       cobjects,verbose,globals,
-      symconst,symtable,types,
+      symconst,symdef,symsym,symtable,types,
       htypechk,pass_1,
       ncnv,ncon,cpubase,nld
 {$ifdef newcg}
@@ -180,7 +180,7 @@ implementation
         case psd^.elementtype.def^.deftype of
           enumdef :
             begin
-              pes:=penumdef(psd^.elementtype.def)^.firstenum;
+              pes:=penumsym(penumdef(psd^.elementtype.def)^.firstenum);
               while assigned(pes) do
                 begin
                   pcs^[pes^.value div 8]:=pcs^[pes^.value div 8] or (1 shl (pes^.value mod 8));
@@ -525,7 +525,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.6  2000-10-21 18:16:11  florian
+  Revision 1.7  2000-10-31 22:02:49  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.6  2000/10/21 18:16:11  florian
     * a lot of changes:
        - basic dyn. array support
        - basic C++ support

compiler/parser.pas

@@ -36,7 +36,7 @@ implementation
     uses
       globtype,version,tokens,systems,
       cutils,cobjects,globals,verbose,
-      symtable,fmodule,aasm,
+      symbase,symtable,symsym,fmodule,aasm,
 {$ifndef newcg}
       hcodegen,
 {$endif newcg}
@@ -131,13 +131,13 @@ implementation
         hp:=pstring_item(initdefines.first);
         while assigned(hp) do
          begin
-           def_macro(hp^.str^);
+           current_scanner^.def_macro(hp^.str^);
            hp:=pstring_item(hp^.next);
          end;
       { set macros for version checking }
-        set_macro('FPC_VERSION',version_nr);
-        set_macro('FPC_RELEASE',release_nr);
-        set_macro('FPC_PATCH',patch_nr);
+        current_scanner^.set_macro('FPC_VERSION',version_nr);
+        current_scanner^.set_macro('FPC_RELEASE',release_nr);
+        current_scanner^.set_macro('FPC_PATCH',patch_nr);
       end;
 
 
@@ -147,8 +147,7 @@ implementation
       begin
          new(preprocfile,init('pre'));
        { default macros }
-         macros:=new(psymtable,init(macrosymtable));
-         macros^.name:=stringdup('Conditionals for '+filename);
+         current_scanner^.macros:=new(pdictionary,init);
          default_macros;
        { initialize a module }
          current_module:=new(pmodule,init(filename,false));
@@ -224,7 +223,6 @@ implementation
          oldcurrent_scanner,prev_scanner,
          scanner : pscannerfile;
        { symtable }
-         oldmacros,
          oldrefsymtable,
          olddefaultsymtablestack,
          oldsymtablestack : psymtable;
@@ -283,7 +281,6 @@ implementation
          oldsymtablestack:=symtablestack;
          olddefaultsymtablestack:=defaultsymtablestack;
          oldrefsymtable:=refsymtable;
-         oldmacros:=macros;
          oldprocprefix:=procprefix;
          oldaktprocsym:=aktprocsym;
          move(overloaded_operators,oldoverloaded_operators,sizeof(toverloaded_operators));
@@ -294,7 +291,7 @@ implementation
          oldtoken:=token;
          oldidtoken:=idtoken;
          old_block_type:=block_type;
-         oldtokenpos:=tokenpos;
+         oldtokenpos:=akttokenpos;
          oldcurrent_scanner:=current_scanner;
        { save cg }
          oldnextlabelnr:=nextlabelnr;
@@ -352,11 +349,6 @@ implementation
          registerdef:=true;
          aktmaxfpuregisters:=-1;
          fillchar(overloaded_operators,sizeof(toverloaded_operators),0);
-         { macros }
-         macros:=new(psymtable,init(macrosymtable));
-         macros^.name:=stringdup('Conditionals for '+filename);
-         default_macros;
-
        { reset the unit or create a new program }
          if assigned(current_module) then
            begin
@@ -371,6 +363,9 @@ implementation
             main_module:=current_module;
           end;
 
+         { Set the module to use for verbose }
+         SetCompileModule(current_module);
+
          compiled_module:=current_module;
          current_module^.in_compile:=true;
        { Load current state from the init values }
@@ -392,6 +387,9 @@ implementation
 
        { startup scanner, and save in current_module }
          current_scanner:=new(pscannerfile,Init(filename));
+       { macros }
+         default_macros;
+       { read the first token }
          current_scanner^.readtoken;
          prev_scanner:=current_module^.scanner;
          current_module^.scanner:=current_scanner;
@@ -467,10 +465,6 @@ implementation
          if assigned(prev_scanner) then
            prev_scanner^.invalid:=true;
 
-       { free macros }
-         {!!! No check for unused macros yet !!! }
-         dispose(macros,done);
-
          if (compile_level>1) then
            begin
 {$ifdef newcg}
@@ -485,7 +479,7 @@ implementation
               orgpattern:=oldorgpattern;
               token:=oldtoken;
               idtoken:=oldidtoken;
-              tokenpos:=oldtokenpos;
+              akttokenpos:=oldtokenpos;
               block_type:=old_block_type;
               current_scanner:=oldcurrent_scanner;
               { restore cg }
@@ -510,7 +504,6 @@ implementation
               refsymtable:=oldrefsymtable;
               symtablestack:=oldsymtablestack;
               defaultsymtablestack:=olddefaultsymtablestack;
-              macros:=oldmacros;
               aktprocsym:=oldaktprocsym;
               procprefix:=oldprocprefix;
               move(oldoverloaded_operators,overloaded_operators,sizeof(toverloaded_operators));
@@ -594,7 +587,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.7  2000-10-14 10:14:51  peter
+  Revision 1.8  2000-10-31 22:02:49  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.7  2000/10/14 10:14:51  peter
     * moehrendorf oct 2000 rewrite
 
   Revision 1.6  2000/10/01 19:48:25  peter

compiler/pass_2.pas

@@ -49,7 +49,7 @@ implementation
    uses
      globtype,systems,
      cobjects,comphook,verbose,globals,fmodule,
-     symconst,symtable,types,aasm,scanner,
+     symconst,symbase,symtype,symsym,symtable,types,aasm,scanner,
      pass_1,hcodegen,temp_gen,cpubase,cpuasm,regvars,nflw
 {$ifdef GDB}
      ,gdb
@@ -311,7 +311,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.9  2000-10-14 10:14:51  peter
+  Revision 1.10  2000-10-31 22:02:49  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.9  2000/10/14 10:14:51  peter
     * moehrendorf oct 2000 rewrite
 
   Revision 1.8  2000/09/24 15:06:21  peter

compiler/pbase.pas

@@ -27,13 +27,11 @@ unit pbase;
 interface
 
     uses
-       cobjects,tokens,globals,symtable
+       cobjects,tokens,globals,
+       symbase,symdef,symsym
 {$ifdef fixLeaksOnError}
        ,comphook
 {$endif fixLeaksOnError}
-{$IFDEF NEWST}
-       ,symbols,defs
-{$ENDIF NEWST}
        ;
 
     const
@@ -114,7 +112,7 @@ interface
         else
           begin
             if token=_END then
-              last_endtoken_filepos:=tokenpos;
+              last_endtoken_filepos:=akttokenpos;
             current_scanner^.readtoken;
           end;
       end;
@@ -128,7 +126,7 @@ interface
             begin
                 try_to_consume:=true;
                 if token=_END then
-                    last_endtoken_filepos:=tokenpos;
+                    last_endtoken_filepos:=akttokenpos;
                 current_scanner^.readtoken;
             end;
     end;
@@ -162,7 +160,7 @@ interface
       begin
          sc:=new(pstringcontainer,init);
          repeat
-           sc^.insert_with_tokeninfo(orgpattern,tokenpos);
+           sc^.insert_with_tokeninfo(orgpattern,akttokenpos);
            consume(_ID);
          until not try_to_consume(_COMMA);
          idlist:=sc;
@@ -192,7 +190,10 @@ end.
 
 {
   $Log$
-  Revision 1.5  2000-09-24 15:06:21  peter
+  Revision 1.6  2000-10-31 22:02:49  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.5  2000/09/24 15:06:21  peter
     * use defines.inc
 
   Revision 1.4  2000/08/27 20:19:39  peter
@@ -206,4 +207,4 @@ end.
   Revision 1.2  2000/07/13 11:32:44  michael
   + removed logs
 
-}
+}

compiler/pdecl.pas

@@ -25,9 +25,8 @@ unit pdecl;
 {$i defines.inc}
 
 interface
-
     uses
-      cobjects,symtable,node;
+      cobjects,symsym,node;
 
     function  readconstant(const name:string;const filepos:tfileposinfo):pconstsym;
 
@@ -49,7 +48,7 @@ implementation
        { aasm }
        aasm,
        { symtable }
-       symconst,types,
+       symconst,symbase,symtype,symdef,symtable,types,
 {$ifdef GDB}
        gdb,
 {$endif}
@@ -83,8 +82,8 @@ implementation
         hp:=nil;
         p:=comp_expr(true);
         do_firstpass(p);
-        storetokenpos:=tokenpos;
-        tokenpos:=filepos;
+        storetokenpos:=akttokenpos;
+        akttokenpos:=filepos;
         case p.nodetype of
            ordconstn:
              begin
@@ -129,7 +128,7 @@ implementation
            else
              Message(cg_e_illegal_expression);
         end;
-        tokenpos:=storetokenpos;
+        akttokenpos:=storetokenpos;
         p.free;
         readconstant:=hp;
       end;
@@ -149,7 +148,7 @@ implementation
          block_type:=bt_const;
          repeat
            name:=pattern;
-           filepos:=tokenpos;
+           filepos:=akttokenpos;
            consume(_ID);
            case token of
 
@@ -174,8 +173,8 @@ implementation
                    block_type:=bt_const;
                    skipequal:=false;
                    { create symbol }
-                   storetokenpos:=tokenpos;
-                   tokenpos:=filepos;
+                   storetokenpos:=akttokenpos;
+                   akttokenpos:=filepos;
 {$ifdef DELPHI_CONST_IN_RODATA}
                    if m_delphi in aktmodeswitches then
                      begin
@@ -189,7 +188,7 @@ implementation
                      begin
                        sym:=new(ptypedconstsym,inittype(name,tt,false))
                      end;
-                   tokenpos:=storetokenpos;
+                   akttokenpos:=storetokenpos;
                    symtablestack^.insert(sym);
                    { procvar can have proc directives }
                    if (tt.def^.deftype=procvardef) then
@@ -303,14 +302,14 @@ implementation
                   begin
                     { try to resolve the forward }
                     { get the correct position for it }
-                    stpos:=tokenpos;
-                    tokenpos:=pforwarddef(hpd)^.forwardpos;
+                    stpos:=akttokenpos;
+                    akttokenpos:=pforwarddef(hpd)^.forwardpos;
                     resolving_forward:=true;
                     make_ref:=false;
                     getsym(pforwarddef(hpd)^.tosymname,false);
                     make_ref:=true;
                     resolving_forward:=false;
-                    tokenpos:=stpos;
+                    akttokenpos:=stpos;
                     { we don't need the forwarddef anymore, dispose it }
                     dispose(hpd,done);
                     { was a type sym found ? }
@@ -319,13 +318,13 @@ implementation
                      begin
                        ppointerdef(pd)^.pointertype.setsym(srsym);
                        { avoid wrong unused warnings web bug 801 PM }
-                       inc(srsym^.refs);
+                       inc(pstoredsym(srsym)^.refs);
 {$ifdef GDB}
                        if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) and
                           (psym(p)^.owner^.symtabletype in [globalsymtable,staticsymtable]) then
                         begin
                           ptypesym(p)^.isusedinstab := true;
-                          psym(p)^.concatstabto(debuglist);
+                          ptypesym(p)^.concatstabto(debuglist);
                         end;
 {$endif GDB}
                        { we need a class type for classrefdef }
@@ -384,7 +383,7 @@ implementation
          repeat
            typename:=pattern;
            orgtypename:=orgpattern;
-           defpos:=tokenpos;
+           defpos:=akttokenpos;
            consume(_ID);
            consume(_EQUAL);
            { support 'ttype=type word' syntax }
@@ -419,11 +418,11 @@ implementation
                 referencing the type before it's really set it
                 will give an error (PFV) }
               tt.setdef(generrordef);
-              storetokenpos:=tokenpos;
+              storetokenpos:=akttokenpos;
               newtype:=new(ptypesym,init(orgtypename,tt));
               symtablestack^.insert(newtype);
-              tokenpos:=defpos;
-              tokenpos:=storetokenpos;
+              akttokenpos:=defpos;
+              akttokenpos:=storetokenpos;
               { read the type definition }
               read_type(tt,orgtypename);
               { update the definition of the type }
@@ -484,7 +483,7 @@ implementation
          block_type:=bt_const;
          repeat
            name:=pattern;
-           filepos:=tokenpos;
+           filepos:=akttokenpos;
            consume(_ID);
            case token of
              _EQUAL:
@@ -492,8 +491,8 @@ implementation
                    consume(_EQUAL);
                    p:=comp_expr(true);
                    do_firstpass(p);
-                   storetokenpos:=tokenpos;
-                   tokenpos:=filepos;
+                   storetokenpos:=akttokenpos;
+                   akttokenpos:=filepos;
                    case p.nodetype of
                       ordconstn:
                         begin
@@ -516,7 +515,7 @@ implementation
                       else
                         Message(cg_e_illegal_expression);
                    end;
-                   tokenpos:=storetokenpos;
+                   akttokenpos:=storetokenpos;
                    consume(_SEMICOLON);
                    p.free;
                 end;
@@ -529,7 +528,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.17  2000-10-14 10:14:51  peter
+  Revision 1.18  2000-10-31 22:02:49  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.17  2000/10/14 10:14:51  peter
     * moehrendorf oct 2000 rewrite
 
   Revision 1.16  2000/09/24 21:19:50  peter

compiler/pdecobj.pas

@@ -24,25 +24,20 @@ unit pdecobj;
 
 {$i defines.inc}
 
-  interface
+interface
 
     uses
-      globtype,symtable
-      {$IFDEF NEWST}
-      ,symbols,defs
-      {$ENDIF NEWST};
+      globtype,symtype,symdef;
 
     { parses a object declaration }
     function object_dec(const n : stringid;fd : pobjectdef) : pdef;
 
-  implementation
+implementation
 
     uses
-{$ifdef Delphi}
-      SysUtils,
-{$endif}
-      cutils,cobjects,globals,verbose,systems,tokens,
-      aasm,symconst,types,
+      cutils,cobjects,
+      globals,verbose,systems,tokens,
+      aasm,symconst,symbase,symsym,symtable,types,
 {$ifdef GDB}
       gdb,
 {$endif}
@@ -1079,7 +1074,10 @@ unit pdecobj;
 end.
 {
   $Log$
-  Revision 1.3  2000-10-26 21:54:03  peter
+  Revision 1.4  2000-10-31 22:02:49  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.3  2000/10/26 21:54:03  peter
     * fixed crash with error in child definition (merged)
 
   Revision 1.2  2000/10/21 18:16:11  florian

compiler/pdecsub.pas

@@ -27,7 +27,7 @@ unit pdecsub;
 interface
 
     uses
-      cobjects,tokens,symconst,symtable;
+      cobjects,tokens,symconst,symtype,symdef,symsym;
 
     const
       pd_global    = $1;    { directive must be global }
@@ -67,7 +67,7 @@ implementation
        { aasm }
        aasm,
        { symtable }
-       types,
+       symbase,symtable,types,
 {$ifdef GDB}
        gdb,
 {$endif}
@@ -248,10 +248,10 @@ implementation
                 end;
                if not is_procvar then
                 hs2:=pprocdef(aktprocdef)^.mangledname;
-               storetokenpos:=tokenpos;
+               storetokenpos:=akttokenpos;
                while not sc^.empty do
                 begin
-                  s:=sc^.get_with_tokeninfo(tokenpos);
+                  s:=sc^.get_with_tokeninfo(akttokenpos);
                   aktprocdef^.concatpara(tt,varspez,pdefaultvalue);
                   { For proc vars we only need the definitions }
                   if not is_procvar then
@@ -296,7 +296,7 @@ implementation
                   writeln('problem with strContStack in pdecl (1)');
 {$endif fixLeaksOnError}
                dispose(sc,done);
-               tokenpos:=storetokenpos;
+               akttokenpos:=storetokenpos;
             end;
           { set the new mangled name }
           if not is_procvar then
@@ -321,7 +321,7 @@ var orgsp,sp:stringid;
 begin
 { Save the position where this procedure really starts and set col to 1 which
   looks nicer }
-  procstartfilepos:=tokenpos;
+  procstartfilepos:=akttokenpos;
 {  procstartfilepos.column:=1; I do not agree here !!
    lets keep excat position PM }
 
@@ -342,15 +342,15 @@ begin
      (lexlevel=normal_function_level) and
      try_to_consume(_POINT) then
    begin
-     storepos:=tokenpos;
-     tokenpos:=procstartfilepos;
+     storepos:=akttokenpos;
+     akttokenpos:=procstartfilepos;
      getsym(sp,true);
      sym:=srsym;
-     tokenpos:=storepos;
+     akttokenpos:=storepos;
      { load proc name }
      sp:=pattern;
      orgsp:=orgpattern;
-     procstartfilepos:=tokenpos;
+     procstartfilepos:=akttokenpos;
      { qualifier is class name ? }
      if (sym^.typ<>typesym) or
         (ptypesym(sym)^.restype.def^.deftype<>objectdef) then
@@ -382,7 +382,7 @@ begin
         (options in [potype_constructor,potype_destructor]) then
         Message(parser_e_constructors_always_objects);
 
-     tokenpos:=procstartfilepos;
+     akttokenpos:=procstartfilepos;
      aktprocsym:=pprocsym(symtablestack^.search(sp));
 
      if not(parse_only) then
@@ -456,14 +456,14 @@ begin
         else
          DuplicateSym(aktprocsym);
         { try to recover by creating a new aktprocsym }
-        tokenpos:=procstartfilepos;
+        akttokenpos:=procstartfilepos;
         aktprocsym:=new(pprocsym,init(orgsp));
       end;
    end
   else
    begin
      { create a new procsym and set the real filepos }
-     tokenpos:=procstartfilepos;
+     akttokenpos:=procstartfilepos;
      { for operator we have only one definition for each overloaded
        operation }
      if (options=potype_operator) then
@@ -921,7 +921,7 @@ begin
        { recalculate the corrected offset }
        { the really_insert_in_data procedure
          for parasymtable should only calculateoffset PM }
-       ps^.insert_in_data;
+       pstoredsym(ps)^.insert_in_data;
        { reset the owner correctly }
        ps^.owner:=parast;
        lastps:=ps;
@@ -1439,7 +1439,7 @@ begin
  { Adjust positions of args for cdecl or stdcall }
    if (aktprocsym^.definition^.deftype=procdef) and
       (([pocall_cdecl,pocall_cppdecl,pocall_stdcall]*aktprocsym^.definition^.proccalloptions)<>[]) then
-     aktprocsym^.definition^.parast^.set_alignment(target_os.size_of_longint);
+     pstoredsymtable(aktprocsym^.definition^.parast)^.set_alignment(target_os.size_of_longint);
 
 { Call the handler }
   if pointer({$ifndef FPC}@{$endif}proc_direcdata[p].handler)<>nil then
@@ -1815,7 +1815,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-10-21 18:16:11  florian
+  Revision 1.4  2000-10-31 22:02:49  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.3  2000/10/21 18:16:11  florian
     * a lot of changes:
        - basic dyn. array support
        - basic C++ support

compiler/pdecvar.pas

@@ -43,7 +43,7 @@ implementation
        { aasm }
        aasm,
        { symtable }
-       symconst,symtable,types,fmodule,
+       symconst,symbase,symtype,symdef,symsym,symtable,types,fmodule,
 {$ifdef GDB}
        gdb,
 {$endif}
@@ -83,10 +83,10 @@ implementation
            filepos : tfileposinfo;
            ss : pvarsym;
         begin
-           filepos:=tokenpos;
+           filepos:=akttokenpos;
            while not sc^.empty do
              begin
-                s:=sc^.get_with_tokeninfo(tokenpos);
+                s:=sc^.get_with_tokeninfo(akttokenpos);
                 ss:=new(pvarsym,init(s,tt));
                 if is_threadvar then
                   include(ss^.varoptions,vo_is_thread_var);
@@ -104,7 +104,7 @@ implementation
                writeln('problem with strContStack in pdecl (2)');
 {$endif fixLeaksOnError}
            dispose(sc,done);
-           tokenpos:=filepos;
+           akttokenpos:=filepos;
         end;
 
       var
@@ -181,8 +181,8 @@ implementation
              symdone:=false;
              if is_gpc_name then
                begin
-                  storetokenpos:=tokenpos;
-                  s:=sc^.get_with_tokeninfo(tokenpos);
+                  storetokenpos:=akttokenpos;
+                  s:=sc^.get_with_tokeninfo(akttokenpos);
                   if not sc^.empty then
                    Message(parser_e_absolute_only_one_var);
 {$ifdef fixLeaksOnError}
@@ -193,7 +193,7 @@ implementation
                   aktvarsym:=new(pvarsym,init_C(s,target_os.Cprefix+C_name,tt));
                   include(aktvarsym^.varoptions,vo_is_external);
                   symtablestack^.insert(aktvarsym);
-                  tokenpos:=storetokenpos;
+                  akttokenpos:=storetokenpos;
                   symdone:=true;
                end;
              { check for absolute }
@@ -225,26 +225,26 @@ implementation
                    { we should check the result type of srsym }
                    if not (srsym^.typ in [varsym,typedconstsym,funcretsym]) then
                      Message(parser_e_absolute_only_to_var_or_const);
-                   storetokenpos:=tokenpos;
-                   tokenpos:=declarepos;
+                   storetokenpos:=akttokenpos;
+                   akttokenpos:=declarepos;
                    abssym:=new(pabsolutesym,init(s,tt));
                    abssym^.abstyp:=tovar;
-                   abssym^.ref:=srsym;
+                   abssym^.ref:=pstoredsym(srsym);
                    symtablestack^.insert(abssym);
-                   tokenpos:=storetokenpos;
+                   akttokenpos:=storetokenpos;
                  end
                 else
                  if (token=_CSTRING) or (token=_CCHAR) then
                   begin
-                    storetokenpos:=tokenpos;
-                    tokenpos:=declarepos;
+                    storetokenpos:=akttokenpos;
+                    akttokenpos:=declarepos;
                     abssym:=new(pabsolutesym,init(s,tt));
                     s:=pattern;
                     consume(token);
                     abssym^.abstyp:=toasm;
                     abssym^.asmname:=stringdup(s);
                     symtablestack^.insert(abssym);
-                    tokenpos:=storetokenpos;
+                    akttokenpos:=storetokenpos;
                   end
                 else
                 { absolute address ?!? }
@@ -252,8 +252,8 @@ implementation
                   begin
                     if (target_info.target=target_i386_go32v2) then
                      begin
-                       storetokenpos:=tokenpos;
-                       tokenpos:=declarepos;
+                       storetokenpos:=akttokenpos;
+                       akttokenpos:=declarepos;
                        abssym:=new(pabsolutesym,init(s,tt));
                        abssym^.abstyp:=toaddr;
                        abssym^.absseg:=false;
@@ -270,7 +270,7 @@ implementation
                           abssym^.absseg:=true;
                         end;
                        symtablestack^.insert(abssym);
-                       tokenpos:=storetokenpos;
+                       akttokenpos:=storetokenpos;
                      end
                     else
                      Message(parser_e_absolute_only_to_var_or_const);
@@ -288,13 +288,13 @@ implementation
                 not (symtablestack^.symtabletype in [parasymtable]) and
                 not is_record and not is_object then
                begin
-                  storetokenpos:=tokenpos;
-                  s:=sc^.get_with_tokeninfo(tokenpos);
+                  storetokenpos:=akttokenpos;
+                  s:=sc^.get_with_tokeninfo(akttokenpos);
                   if not sc^.empty then
                     Message(parser_e_initialized_only_one_var);
                   pconstsym:=new(ptypedconstsym,inittype(s,tt,false));
                   symtablestack^.insert(pconstsym);
-                  tokenpos:=storetokenpos;
+                  akttokenpos:=storetokenpos;
                   consume(_EQUAL);
                   readtypedconst(tt.def,pconstsym,false);
                   symdone:=true;
@@ -373,8 +373,8 @@ implementation
                    if extern_aktvarsym or export_aktvarsym then
                     consume(_SEMICOLON);
                    { insert in the symtable }
-                   storetokenpos:=tokenpos;
-                   tokenpos:=declarepos;
+                   storetokenpos:=akttokenpos;
+                   akttokenpos:=declarepos;
                    if is_dll then
                     aktvarsym:=new(pvarsym,init_dll(s,tt))
                    else
@@ -389,7 +389,7 @@ implementation
                     include(aktvarsym^.varoptions,vo_is_external);
                    { insert in the stack/datasegment }
                    symtablestack^.insert(aktvarsym);
-                   tokenpos:=storetokenpos;
+                   akttokenpos:=storetokenpos;
                    { now we can insert it in the import lib if its a dll, or
                      add it to the externals }
                    if extern_aktvarsym then
@@ -460,7 +460,7 @@ implementation
                Message(type_e_ordinal_expr_expected);
               consume(_OF);
 {$ifdef UseUnionSymtable}
-              UnionSymtable:=new(psymtable,init(recordsymtable));
+              UnionSymtable:=new(pstoredsymtable,init(recordsymtable));
               UnionSymtable^.next:=symtablestack;
               registerdef:=false;
               UnionDef:=new(precorddef,init(unionsymtable));
@@ -514,7 +514,7 @@ implementation
               symtablestack^.datasize:=offset+unionsymtable^.datasize;
               if maxalignment>symtablestack^.dataalignment then
                 symtablestack^.dataalignment:=maxalignment;
-              UnionSymtable^.Insert_in(symtablestack,offset);
+              pstoredsymtable(UnionSymtable)^.Insert_in(symtablestack,offset);
               UnionSym^.owner:=nil;
               dispose(unionsym,done);
               dispose(uniondef,done);
@@ -527,7 +527,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.1  2000-10-14 10:14:51  peter
+  Revision 1.2  2000-10-31 22:02:49  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.1  2000/10/14 10:14:51  peter
     * moehrendorf oct 2000 rewrite
 
 }

compiler/pexports.pas

@@ -41,7 +41,7 @@ implementation
        { aasm }
        aasm,
        { symtable }
-       symconst,symtable,types,
+       symconst,symdef,symsym,symtable,types,
        { pass 1 }
        node,pass_1,
        ncon,
@@ -169,7 +169,10 @@ end.
 
 {
   $Log$
-  Revision 1.6  2000-10-14 10:14:51  peter
+  Revision 1.7  2000-10-31 22:02:49  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.6  2000/10/14 10:14:51  peter
     * moehrendorf oct 2000 rewrite
 
   Revision 1.5  2000/09/24 21:19:50  peter

compiler/pexpr.pas

@@ -27,7 +27,7 @@ unit pexpr;
 interface
 
     uses
-      symtable,
+      symtype,
       node;
 
     { reads a whole expression }
@@ -60,7 +60,7 @@ implementation
        { aasm }
        aasm,
        { symtable }
-       symconst,types,
+       symconst,symbase,symdef,symsym,symtable,types,
 {$ifdef GDB}
        gdb,
 {$endif}
@@ -1342,37 +1342,28 @@ implementation
                               pd:=p1.resulttype;
                             end;
                   procsym : begin
-                              if block_type<>bt_type then
-                               begin
-                                 { are we in a class method ? }
-                                 possible_error:=(srsymtable^.symtabletype=objectsymtable) and
-                                                 assigned(aktprocsym) and
-                                                 (po_classmethod in aktprocsym^.definition^.procoptions);
-                                 p1:=gencallnode(pprocsym(srsym),srsymtable);
+                              { are we in a class method ? }
+                              possible_error:=(srsymtable^.symtabletype=objectsymtable) and
+                                              assigned(aktprocsym) and
+                                              (po_classmethod in aktprocsym^.definition^.procoptions);
+                              p1:=gencallnode(pprocsym(srsym),srsymtable);
 {$ifdef TEST_PROCSYMS}
-                                 p1.unit_specific:=unit_specific;
+                              p1.unit_specific:=unit_specific;
 {$endif TEST_PROCSYMS}
-                                 do_proc_call(getaddr or
-                                   (getprocvar and
-                                    ((block_type=bt_const) or
-                                     ((m_tp_procvar in aktmodeswitches) and
-                                      proc_to_procvar_equal(pprocsym(srsym)^.definition,getprocvardef)
-                                     )
-                                    )
-                                   ),again,tcallnode(p1),pd);
-                                 if (block_type=bt_const) and
-                                    getprocvar then
-                                   handle_procvar(getprocvardef,p1);
-                                 if possible_error and
-                                    not(po_classmethod in tcallnode(p1).procdefinition^.procoptions) then
-                                   Message(parser_e_only_class_methods);
-                               end
-                              else
-                               begin
-                                 p1:=cerrornode.create;
-                                 pd:=generrordef;
-                                 Message(cg_e_illegal_expression);
-                               end;
+                              do_proc_call(getaddr or
+                                (getprocvar and
+                                 ((block_type=bt_const) or
+                                  ((m_tp_procvar in aktmodeswitches) and
+                                   proc_to_procvar_equal(pprocsym(srsym)^.definition,getprocvardef)
+                                  )
+                                 )
+                                ),again,tcallnode(p1),pd);
+                              if (block_type=bt_const) and
+                                 getprocvar then
+                                handle_procvar(getprocvardef,p1);
+                              if possible_error and
+                                 not(po_classmethod in tcallnode(p1).procdefinition^.procoptions) then
+                                Message(parser_e_only_class_methods);
                             end;
               propertysym : begin
                               { access to property in a method }
@@ -1467,7 +1458,7 @@ implementation
              if assigned(p1) then
               p1.set_tree_filepos(filepos);
              oldp1:=p1;
-             filepos:=tokenpos;
+             filepos:=akttokenpos;
            end;
         end;
 
@@ -1646,7 +1637,7 @@ implementation
                     case pd^.deftype of
                        recorddef:
                          begin
-                            sym:=precorddef(pd)^.symtable^.search(pattern);
+                            sym:=psym(precorddef(pd)^.symtable^.search(pattern));
                             if assigned(sym) and
                                (sym^.typ=varsym) then
                               begin
@@ -1668,7 +1659,7 @@ implementation
                              sym:=nil;
                              while assigned(classh) do
                               begin
-                                sym:=classh^.symtable^.search(pattern);
+                                sym:=psym(classh^.symtable^.search(pattern));
                                 srsymtable:=classh^.symtable;
                                 if assigned(sym) then
                                  break;
@@ -1698,7 +1689,7 @@ implementation
                               allow_only_static:=false;
                               while assigned(classh) do
                                 begin
-                                   sym:=classh^.symtable^.search(pattern);
+                                   sym:=psym(classh^.symtable^.search(pattern));
                                    srsymtable:=classh^.symtable;
                                    if assigned(sym) then
                                      break;
@@ -1800,7 +1791,7 @@ implementation
       begin
         oldp1:=nil;
         p1:=nil;
-        filepos:=tokenpos;
+        filepos:=akttokenpos;
         if token=_ID then
          begin
            factor_read_id;
@@ -1858,7 +1849,7 @@ implementation
                         sym:=nil;
                         while assigned(classh) do
                          begin
-                           sym:=classh^.symtable^.search(pattern);
+                           sym:=psym(classh^.symtable^.search(pattern));
                            srsymtable:=classh^.symtable;
                            if assigned(sym) then
                             break;
@@ -1928,7 +1919,7 @@ implementation
                     while assigned(classh) do
                      begin
                        srsymtable:=pobjectdef(classh)^.symtable;
-                       sym:=srsymtable^.search(hs);
+                       sym:=psym(srsymtable^.search(hs));
                        if assigned(sym) then
                         begin
                           { only for procsyms we need to set the type (PFV) }
@@ -2188,7 +2179,7 @@ _LECKKLAMMER : begin
              ((token<>_EQUAL) or accept_equal) then
            begin
              oldt:=token;
-             filepos:=tokenpos;
+             filepos:=akttokenpos;
              consume(token);
              if pred_level=highest_precedence then
                p2:=factor(false)
@@ -2278,7 +2269,7 @@ _LECKKLAMMER : begin
       begin
          oldafterassignment:=afterassignment;
          p1:=sub_expr(opcompare,true);
-         filepos:=tokenpos;
+         filepos:=akttokenpos;
          if (m_tp_procvar in aktmodeswitches) and
             (token<>_ASSIGNMENT) then
            check_tp_procvar(p1);
@@ -2383,7 +2374,10 @@ _LECKKLAMMER : begin
 end.
 {
   $Log$
-  Revision 1.13  2000-10-26 23:40:54  peter
+  Revision 1.14  2000-10-31 22:02:49  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.13  2000/10/26 23:40:54  peter
     * fixed crash with call from type decl which is not allowed (merged)
 
   Revision 1.12  2000/10/21 18:16:12  florian

compiler/pmodules.pas

@@ -47,7 +47,7 @@ implementation
        globtype,version,systems,tokens,
        cutils,cobjects,comphook,compiler,
        globals,verbose,fmodule,finput,
-       symconst,symtable,aasm,types,
+       symconst,symbase,symppu,symdef,symsym,symtable,aasm,types,
 {$ifdef newcg}
        cgbase,
 {$else newcg}
@@ -890,17 +890,6 @@ implementation
 
 
     procedure setupglobalswitches;
-
-        procedure def_symbol(const s:string);
-        var
-          mac : pmacrosym;
-        begin
-          mac:=new(pmacrosym,init(s));
-          mac^.defined:=true;
-          Message1(parser_m_macro_defined,mac^.name);
-          macros^.insert(mac);
-        end;
-
       begin
         { can't have local browser when no global browser }
         if (cs_local_browser in aktmoduleswitches) and
@@ -909,16 +898,16 @@ implementation
 
         { define a symbol in delphi,objfpc,tp,gpc mode }
         if (m_delphi in aktmodeswitches) then
-         def_symbol('FPC_DELPHI')
+         current_scanner^.def_macro('FPC_DELPHI')
         else
          if (m_tp in aktmodeswitches) then
-          def_symbol('FPC_TP')
+          current_scanner^.def_macro('FPC_TP')
         else
          if (m_objfpc in aktmodeswitches) then
-          def_symbol('FPC_OBJFPC')
+          current_scanner^.def_macro('FPC_OBJFPC')
         else
          if (m_gpc in aktmodeswitches) then
-          def_symbol('FPC_GPC');
+          current_scanner^.def_macro('FPC_GPC');
       end;
 
 
@@ -1185,7 +1174,7 @@ implementation
          symtablestack:=unitst;
 
 {$ifndef DONOTCHAINOPERATORS}
-          symtablestack^.chainoperators;
+         pstoredsymtable(symtablestack)^.chainoperators;
 {$endif DONOTCHAINOPERATORS}
 
 {$ifdef DEBUG}
@@ -1300,9 +1289,9 @@ implementation
          { test static symtable }
          if (Errorcount=0) then
            begin
-             st^.allsymbolsused;
-             st^.allunitsused;
-             st^.allprivatesused;
+             pstoredsymtable(st)^.allsymbolsused;
+             pstoredsymtable(st)^.allunitsused;
+             pstoredsymtable(st)^.allprivatesused;
            end;
 
          { size of the static data }
@@ -1335,8 +1324,8 @@ implementation
          { tests, if all (interface) forwards are resolved }
          if (Errorcount=0) then
            begin
-             symtablestack^.check_forwards;
-             symtablestack^.allprivatesused;
+             pstoredsymtable(symtablestack)^.check_forwards;
+             pstoredsymtable(symtablestack)^.allprivatesused;
            end;
 
          { now we have a correct unit, change the symtable type }
@@ -1524,7 +1513,7 @@ implementation
            loadunits;
 
 {$ifndef DONOTCHAINOPERATORS}
-          symtablestack^.chainoperators;
+         pstoredsymtable(symtablestack)^.chainoperators;
 {$endif DONOTCHAINOPERATORS}
 
          { reset ranges/stabs in exported definitions }
@@ -1640,9 +1629,9 @@ implementation
          { test static symtable }
          if (Errorcount=0) then
            begin
-             st^.allsymbolsused;
-             st^.allunitsused;
-             st^.allprivatesused;
+             pstoredsymtable(st)^.allsymbolsused;
+             pstoredsymtable(st)^.allunitsused;
+             pstoredsymtable(st)^.allprivatesused;
            end;
 
          { generate imports }
@@ -1706,7 +1695,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.16  2000-10-21 14:36:26  peter
+  Revision 1.17  2000-10-31 22:02:50  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.16  2000/10/21 14:36:26  peter
     * merged pierres fixes
 
   Revision 1.15  2000/10/15 09:08:58  peter

compiler/ppu.pas

@@ -29,7 +29,6 @@ interface
 { Also write the ppu if only crc if done, this can be used with ppudump to
   see the differences between the intf and implementation }
 { define INTFPPU}
-{$define ORDERSOURCES}
 
 {$ifdef Test_Double_checksum}
 var
@@ -43,17 +42,9 @@ type
 
 const
 {$ifdef newcg}
-{$ifdef ORDERSOURCES}
-  CurrentPPUVersion=103;
-{$else ORDERSOURCES}
   CurrentPPUVersion=102;
-{$endif ORDERSOURCES}
 {$else newcg}
-{$ifdef ORDERSOURCES}
   CurrentPPUVersion=22;
-{$else ORDERSOURCES}
-  CurrentPPUVersion=20;
-{$endif ORDERSOURCES}
 {$endif newcg}
 
 { buffer sizes }
@@ -898,7 +889,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-09-24 15:06:24  peter
+  Revision 1.5  2000-10-31 22:02:50  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.4  2000/09/24 15:06:24  peter
     * use defines.inc
 
   Revision 1.3  2000/08/13 13:04:38  peter
@@ -907,4 +901,4 @@ end.
   Revision 1.2  2000/07/13 11:32:45  michael
   + removed logs
 
-}
+}

compiler/pstatmnt.pas

@@ -46,7 +46,7 @@ implementation
        { aasm }
        cpubase,aasm,
        { symtable }
-       symconst,symtable,types,
+       symconst,symbase,symtype,symdef,symsym,symtable,types,
        ppu,fmodule,
        { pass 1 }
        pass_1,htypechk,
@@ -610,7 +610,7 @@ implementation
                                     else
                                       Message1(type_e_class_type_expected,ot^.typename);
                                  end;
-                               exceptsymtable:=new(psymtable,init(stt_exceptsymtable));
+                               exceptsymtable:=new(pstoredsymtable,init(stt_exceptsymtable));
                                exceptsymtable^.insert(sym);
                                { insert the exception symtable stack }
                                exceptsymtable^.next:=symtablestack;
@@ -864,7 +864,7 @@ implementation
             { function styled new is handled in factor }
             { destructors have no parameters }
             destructorname:=pattern;
-            destructorpos:=tokenpos;
+            destructorpos:=akttokenpos;
             consume(_ID);
 
             pd:=p.resulttype;
@@ -902,10 +902,10 @@ implementation
                  exit;
               end;
             { search cons-/destructor, also in parent classes }
-            storepos:=tokenpos;
-            tokenpos:=destructorpos;
+            storepos:=akttokenpos;
+            akttokenpos:=destructorpos;
             sym:=search_class_member(classh,destructorname);
-            tokenpos:=storepos;
+            akttokenpos:=storepos;
 
             { the second parameter of new/dispose must be a call }
             { to a cons-/destructor                              }
@@ -1019,7 +1019,7 @@ implementation
       label
          ready;
       begin
-         filepos:=tokenpos;
+         filepos:=akttokenpos;
          case token of
            _GOTO :
              begin
@@ -1148,7 +1148,7 @@ implementation
 
       begin
          first:=nil;
-         filepos:=tokenpos;
+         filepos:=akttokenpos;
          consume(starttoken);
          inc(statement_level);
 
@@ -1252,13 +1252,16 @@ implementation
             assembler_block:=_asm_statement;
           { becuase the END is already read we need to get the
             last_endtoken_filepos here (PFV) }
-            last_endtoken_filepos:=tokenpos;
+            last_endtoken_filepos:=akttokenpos;
           end;
 
 end.
 {
   $Log$
-  Revision 1.11  2000-10-14 21:52:56  peter
+  Revision 1.12  2000-10-31 22:02:50  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.11  2000/10/14 21:52:56  peter
     * fixed memory leaks
 
   Revision 1.10  2000/10/14 10:14:52  peter

compiler/psub.pas

@@ -50,7 +50,7 @@ implementation
        { aasm }
        cpubase,aasm,
        { symtable }
-       symconst,symtable,types,
+       symconst,symbase,symtype,symdef,symsym,symtable,types,
        ppu,fmodule,
        { pass 1 }
        node,pass_1,
@@ -109,12 +109,12 @@ implementation
            begin
               { if the current is a function aktprocsym is non nil }
               { and there is a local symtable set }
-              storepos:=tokenpos;
-              tokenpos:=aktprocsym^.fileinfo;
+              storepos:=akttokenpos;
+              akttokenpos:=aktprocsym^.fileinfo;
               funcretsym:=new(pfuncretsym,init(aktprocsym^.name,procinfo));
               { insert in local symtable }
               symtablestack^.insert(funcretsym);
-              tokenpos:=storepos;
+              akttokenpos:=storepos;
               if ret_in_acc(procinfo^.returntype.def) or (procinfo^.returntype.def^.deftype=floatdef) then
                 procinfo^.return_offset:=-funcretsym^.address;
               procinfo^.funcretsym:=funcretsym;
@@ -444,8 +444,8 @@ implementation
            begin
              if (Errorcount=0) then
                begin
-                 aktprocsym^.definition^.localst^.check_forwards;
-                 aktprocsym^.definition^.localst^.checklabels;
+                 pstoredsymtable(aktprocsym^.definition^.localst)^.check_forwards;
+                 pstoredsymtable(aktprocsym^.definition^.localst)^.checklabels;
                end;
              if (procinfo^.flags and pi_uses_asm)=0 then
                begin
@@ -453,8 +453,8 @@ implementation
                     it will be done in proc_unit }
                   if not(aktprocsym^.definition^.proctypeoption
                      in [potype_proginit,potype_unitinit,potype_unitfinalize]) then
-                     aktprocsym^.definition^.localst^.allsymbolsused;
-                  aktprocsym^.definition^.parast^.allsymbolsused;
+                     pstoredsymtable(aktprocsym^.definition^.localst)^.allsymbolsused;
+                  pstoredsymtable(aktprocsym^.definition^.parast)^.allsymbolsused;
                end;
            end;
 
@@ -832,7 +832,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.19  2000-10-24 22:21:25  peter
+  Revision 1.20  2000-10-31 22:02:50  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.19  2000/10/24 22:21:25  peter
     * set usedregisters after writing entry and exit code (merged)
 
   Revision 1.18  2000/10/21 18:16:12  florian

compiler/psystem.pas

@@ -26,7 +26,7 @@ unit psystem;
 
 interface
 uses
-  symtable;
+  symbase;
 
 procedure insertinternsyms(p : psymtable);
 procedure insert_intern_types(p : psymtable);
@@ -38,7 +38,9 @@ procedure createconstdefs;
 implementation
 
 uses
-  globtype,globals,symconst,ninl;
+  globtype,globals,
+  symconst,symsym,symdef,symtable,
+  ninl;
 
 procedure insertinternsyms(p : psymtable);
 {
@@ -115,7 +117,7 @@ begin
 {$endif SUPPORT_FIXED}
   { Add a type for virtual method tables in lowercase }
   { so it isn't reachable!                            }
-  vmtsymtable:=new(psymtable,init(recordsymtable));
+  vmtsymtable:=new(pstoredsymtable,init(recordsymtable));
   vmtdef:=new(precorddef,init(vmtsymtable));
   pvmtdef:=new(ppointerdef,initdef(vmtdef));
   vmtsymtable^.insert(new(pvarsym,initdef('$parent',pvmtdef)));
@@ -256,7 +258,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.7  2000-10-21 18:16:12  florian
+  Revision 1.8  2000-10-31 22:02:51  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.7  2000/10/21 18:16:12  florian
     * a lot of changes:
        - basic dyn. array support
        - basic C++ support

compiler/ptconst.pas

@@ -26,7 +26,7 @@ unit ptconst;
 
 interface
 
-   uses symtable;
+   uses symtype,symsym;
 
     { this procedure reads typed constants }
     { sym is only needed for ansi strings  }
@@ -43,7 +43,7 @@ implementation
 {$endif Delphi}
        globtype,systems,tokens,cpuinfo,
        cutils,cobjects,globals,scanner,
-       symconst,aasm,types,verbose,
+       symconst,symbase,symdef,symtable,aasm,types,verbose,
        { pass 1 }
        node,pass_1,
        nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,
@@ -679,7 +679,7 @@ implementation
                    s:=pattern;
                    consume(_ID);
                    consume(_COLON);
-                   srsym:=precorddef(def)^.symtable^.search(s);
+                   srsym:=psym(precorddef(def)^.symtable^.search(s));
                    if srsym=nil then
                      begin
                         Message1(sym_e_id_not_found,s);
@@ -742,7 +742,7 @@ implementation
                         symt:=obj^.symtable;
                         while (srsym=nil) and assigned(symt) do
                           begin
-                             srsym:=symt^.search(s);
+                             srsym:=psym(symt^.search(s));
                              if assigned(obj) then
                                obj:=obj^.childof;
                              if assigned(obj) then
@@ -801,7 +801,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.9  2000-10-14 10:14:52  peter
+  Revision 1.10  2000-10-31 22:02:51  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.9  2000/10/14 10:14:52  peter
     * moehrendorf oct 2000 rewrite
 
   Revision 1.8  2000/09/30 13:23:04  peter

compiler/ptype.pas

@@ -27,7 +27,7 @@ unit ptype;
 interface
 
     uses
-       globtype,symtable;
+       globtype,symtype;
 
     const
        { forward types should only be possible inside a TYPE statement }
@@ -62,7 +62,7 @@ implementation
        { aasm }
        aasm,
        { symtable }
-       symconst,types,
+       symconst,symbase,symdef,symsym,symtable,types,
 {$ifdef GDB}
        gdb,
 {$endif}
@@ -91,7 +91,7 @@ implementation
         pos : tfileposinfo;
       begin
          s:=pattern;
-         pos:=tokenpos;
+         pos:=akttokenpos;
          { classes can be used also in classes }
          if (curobjectname=pattern) and aktobjectdef^.is_class then
            begin
@@ -115,7 +115,7 @@ implementation
            begin
               consume(_POINT);
               getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
-              pos:=tokenpos;
+              pos:=akttokenpos;
               s:=pattern;
               consume(_ID);
               is_unit_specific:=true;
@@ -208,7 +208,7 @@ implementation
 
       begin
          { create recdef }
-         symtable:=new(psymtable,init(recordsymtable));
+         symtable:=new(pstoredsymtable,init(recordsymtable));
          record_dec:=new(precorddef,init(symtable));
          { update symtable stack }
          symtable^.next:=symtablestack;
@@ -444,7 +444,7 @@ implementation
                 aktenumdef:=new(penumdef,init);
                 repeat
                   s:=orgpattern;
-                  defpos:=tokenpos;
+                  defpos:=akttokenpos;
                   consume(_ID);
                   { only allow assigning of specific numbers under fpc mode }
                   if (m_fpc in aktmodeswitches) and
@@ -460,10 +460,10 @@ implementation
                     end
                   else
                     inc(l);
-                  storepos:=tokenpos;
-                  tokenpos:=defpos;
+                  storepos:=akttokenpos;
+                  akttokenpos:=defpos;
                   constsymtable^.insert(new(penumsym,init(s,aktenumdef,l)));
-                  tokenpos:=storepos;
+                  akttokenpos:=storepos;
                 until not try_to_consume(_COMMA);
                 tt.setdef(aktenumdef);
                 consume(_RKLAMMER);
@@ -583,7 +583,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.12  2000-10-26 21:54:03  peter
+  Revision 1.13  2000-10-31 22:02:51  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.12  2000/10/26 21:54:03  peter
     * fixed crash with error in child definition (merged)
 
   Revision 1.11  2000/10/21 18:16:12  florian

compiler/rautils.pas

@@ -212,7 +212,7 @@ uses
   strings,
 {$endif}
   types,systems,verbose,globals,fmodule,
-  symtable,cpuasm
+  symbase,symtype,symdef,symsym,symtable,cpuasm
 {$ifdef NEWCG}
   ,cgbase;
 {$else}
@@ -1319,7 +1319,7 @@ Begin
      if st^.symtabletype=objectsymtable then
        sym:=search_class_member(pobjectdef(st^.defowner),base)
      else
-       sym:=st^.search(base);
+       sym:=psym(st^.search(base));
      if not assigned(sym) then
       begin
         GetRecordOffsetSize:=false;
@@ -1548,7 +1548,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.7  2000-10-08 10:26:33  peter
+  Revision 1.8  2000-10-31 22:02:51  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.7  2000/10/08 10:26:33  peter
     * merged @result fix from Pierre
 
   Revision 1.6  2000/09/24 21:19:51  peter

compiler/regvars.pas

@@ -40,7 +40,7 @@ implementation
     uses
       globtype,systems,comphook,
       cutils,cobjects,verbose,globals,
-      symconst,symtable,types,
+      symconst,symbase,symtype,symdef,symsym,symtable,types,
       hcodegen,temp_gen,cpubase,cpuasm
 {$ifdef i386}
      ,tgeni386,cgai386
@@ -50,18 +50,6 @@ implementation
 {$endif}
      ;
 
-     type
-       pregvarinfo = ^tregvarinfo;
-       tregvarinfo = record
-          regvars : array[1..maxvarregs] of pvarsym;
-          regvars_para : array[1..maxvarregs] of boolean;
-          regvars_refs : array[1..maxvarregs] of longint;
-
-          fpuregvars : array[1..maxfpuvarregs] of pvarsym;
-          fpuregvars_para : array[1..maxfpuvarregs] of boolean;
-          fpuregvars_refs : array[1..maxfpuvarregs] of longint;
-       end;
-
 
     var
       parasym : boolean;
@@ -476,7 +464,10 @@ end.
 
 {
   $Log$
-  Revision 1.10  2000-10-14 10:14:52  peter
+  Revision 1.11  2000-10-31 22:02:51  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.10  2000/10/14 10:14:52  peter
     * moehrendorf oct 2000 rewrite
 
   Revision 1.9  2000/10/01 19:48:25  peter

compiler/scandir.inc

@@ -175,7 +175,7 @@ const
     function read_factor : string;
       var
          hs : string;
-         mac : pmacrosym;
+         mac : pmacro;
          len : byte;
       begin
          if preproc_token=_ID then
@@ -191,7 +191,7 @@ const
                 end
               else
                 begin
-                   mac:=pmacrosym(macros^.search(hs));
+                   mac:=pmacro(current_scanner^.macros^.search(hs));
                    hs:=preprocpat;
                    preproc_consume(_ID);
                    if assigned(mac) then
@@ -338,7 +338,7 @@ const
     procedure dir_conditional(t:tdirectivetoken);
       var
         hs    : string;
-        mac   : pmacrosym;
+        mac   : pmacro;
         found : boolean;
         state : char;
         oldaktfilepos : tfileposinfo;
@@ -357,7 +357,7 @@ const
    _DIR_IFDEF : begin
                   current_scanner^.skipspace;
                   hs:=current_scanner^.readid;
-                  mac:=pmacrosym(macros^.search(hs));
+                  mac:=pmacro(current_scanner^.macros^.search(hs));
                   if assigned(mac) then
                     mac^.is_used:=true;
                   current_scanner^.addpreprocstack(pp_ifdef,assigned(mac) and mac^.defined,hs,scan_c_ifdef_found);
@@ -385,7 +385,7 @@ const
   _DIR_IFNDEF : begin
                   current_scanner^.skipspace;
                   hs:=current_scanner^.readid;
-                  mac:=pmacrosym(macros^.search(hs));
+                  mac:=pmacro(current_scanner^.macros^.search(hs));
                   if assigned(mac) then
                     mac^.is_used:=true;
                   current_scanner^.addpreprocstack(pp_ifndef,not(assigned(mac) and mac^.defined),hs,scan_c_ifndef_found);
@@ -414,19 +414,19 @@ const
       var
         hs  : string;
         bracketcount : longint;
-        mac : pmacrosym;
+        mac : pmacro;
         macropos : longint;
         macrobuffer : pmacrobuffer;
       begin
         current_scanner^.skipspace;
         hs:=current_scanner^.readid;
-        mac:=pmacrosym(macros^.search(hs));
+        mac:=pmacro(current_scanner^.macros^.search(hs));
         if not assigned(mac) then
           begin
-            mac:=new(pmacrosym,init(hs));
+            mac:=new(pmacro,init(hs));
             mac^.defined:=true;
             Message1(parser_m_macro_defined,mac^.name);
-            macros^.insert(mac);
+            current_scanner^.macros^.insert(mac);
           end
         else
           begin
@@ -506,17 +506,17 @@ const
     procedure dir_undef(t:tdirectivetoken);
       var
         hs  : string;
-        mac : pmacrosym;
+        mac : pmacro;
       begin
         current_scanner^.skipspace;
         hs:=current_scanner^.readid;
-        mac:=pmacrosym(macros^.search(hs));
+        mac:=pmacro(current_scanner^.macros^.search(hs));
         if not assigned(mac) then
           begin
-             mac:=new(pmacrosym,init(hs));
+             mac:=new(pmacro,init(hs));
              Message1(parser_m_macro_undefined,mac^.name);
              mac^.defined:=false;
-             macros^.insert(mac);
+             current_scanner^.macros^.insert(mac);
           end
         else
           begin
@@ -1436,7 +1436,10 @@ const
 
 {
   $Log$
-  Revision 1.9  2000-09-26 10:50:41  jonas
+  Revision 1.10  2000-10-31 22:02:51  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.9  2000/09/26 10:50:41  jonas
     * initmodeswitches is changed is you change the compiler mode from the
       command line (the -S<x> switches didn't work anymore for changing the
       compiler mode) (merged from fixes branch)

compiler/scanner.pas

@@ -27,11 +27,10 @@ unit scanner;
 interface
 
     uses
-{$ifdef Delphi}
-       dmisc,
-{$endif Delphi}
-       globtype,version,tokens,
-       cobjects,globals,verbose,comphook,finput;
+       cobjects,
+       globtype,globals,version,tokens,
+       verbose,comphook,
+       finput;
 
     const
        maxmacrolen=16*1024;
@@ -45,6 +44,17 @@ interface
        pmacrobuffer = ^tmacrobuffer;
        tmacrobuffer = array[0..maxmacrolen-1] of char;
 
+       pmacro = ^tmacro;
+       tmacro = object(tnamedindexobject)
+          defined,
+          defined_at_startup,
+          is_used : boolean;
+          buftext : pchar;
+          buflen  : longint;
+          constructor init(const n : string);
+          destructor  done;virtual;
+       end;
+
        preproctyp = (pp_ifdef,pp_ifndef,pp_if,pp_ifopt,pp_else);
        ppreprocstack = ^tpreprocstack;
        tpreprocstack = object
@@ -78,6 +88,7 @@ interface
           ignoredirectives : tstringcontainer; { ignore directives, used to give warnings only once }
           preprocstack   : ppreprocstack;
           invalid        : boolean; { flag if sourcefiles have been destroyed ! }
+          macros         : pdictionary;
 
           constructor init(const fn:string);
           destructor done;
@@ -93,6 +104,8 @@ interface
           procedure reload;
           procedure insertmacro(const macname:string;p:pchar;len:longint);
         { Scanner things }
+          procedure def_macro(const s : string);
+          procedure set_macro(const s : string;value : string);
           procedure gettokenpos;
           procedure inc_comment_level;
           procedure dec_comment_level;
@@ -134,22 +147,30 @@ interface
 
 
     var
+        { read strings }
         c              : char;
         orgpattern,
         pattern        : string;
+        { token }
+        token,                        { current token being parsed }
+        idtoken    : ttoken;          { holds the token if the pattern is a known word }
+
         current_scanner : pscannerfile;
         aktcommentstyle : tcommentstyle; { needed to use read_comment from directives }
-
-        preprocfile : ppreprocfile; { used with only preprocessing }
+        preprocfile     : ppreprocfile; { used with only preprocessing }
 
 
 implementation
 
     uses
-{$ifndef delphi}
+{$ifdef delphi}
+      dmisc,
+{$else}
       dos,
 {$endif delphi}
-      cutils,systems,symtable,switches,
+      cutils,
+      systems,
+      switches,
       fmodule;
 
 {*****************************************************************************
@@ -186,6 +207,29 @@ implementation
       end;
 
 
+{*****************************************************************************
+                                 TMacro
+*****************************************************************************}
+
+    constructor tmacro.init(const n : string);
+      begin
+         inherited initname(n);
+         defined:=true;
+         defined_at_startup:=false;
+         is_used:=false;
+         buftext:=nil;
+         buflen:=0;
+      end;
+
+
+    destructor tmacro.done;
+      begin
+         if assigned(buftext) then
+           freemem(buftext,buflen);
+         inherited done;
+      end;
+
+
 {*****************************************************************************
                             Preprocessor writting
 *****************************************************************************}
@@ -279,6 +323,7 @@ implementation
         lastasmgetchar:=#0;
         ignoredirectives.init;
         invalid:=false;
+        new(macros,init);
       { load block }
         if not openinputfile then
          Message1(scan_f_cannot_open_input,fn);
@@ -307,9 +352,50 @@ implementation
               end;
           end;
          ignoredirectives.done;
+         dispose(macros,done);
        end;
 
 
+    procedure tscannerfile.def_macro(const s : string);
+      var
+        mac : pmacro;
+      begin
+         mac:=pmacro(macros^.search(s));
+         if mac=nil then
+           begin
+             mac:=new(pmacro,init(s));
+             Message1(parser_m_macro_defined,mac^.name);
+             macros^.insert(mac);
+           end;
+         mac^.defined:=true;
+         mac^.defined_at_startup:=true;
+      end;
+
+
+    procedure tscannerfile.set_macro(const s : string;value : string);
+      var
+        mac : pmacro;
+      begin
+         mac:=pmacro(macros^.search(s));
+         if mac=nil then
+           begin
+             mac:=new(pmacro,init(s));
+             macros^.insert(mac);
+           end
+         else
+           begin
+              if assigned(mac^.buftext) then
+                freemem(mac^.buftext,mac^.buflen);
+           end;
+         Message2(parser_m_macro_set_to,mac^.name,value);
+         mac^.buflen:=length(value);
+         getmem(mac^.buftext,mac^.buflen);
+         move(value[1],mac^.buftext^,mac^.buflen);
+         mac^.defined:=true;
+         mac^.defined_at_startup:=true;
+      end;
+
+
     function tscannerfile.openinputfile:boolean;
       begin
         openinputfile:=inputfile^.open;
@@ -505,10 +591,10 @@ implementation
     { load the values of tokenpos and lasttokenpos }
       begin
         lasttokenpos:=inputstart+(inputpointer-inputbuffer);
-        tokenpos.line:=line_no;
-        tokenpos.column:=lasttokenpos-lastlinepos;
-        tokenpos.fileindex:=inputfile^.ref_index;
-        aktfilepos:=tokenpos;
+        akttokenpos.line:=line_no;
+        akttokenpos.column:=lasttokenpos-lastlinepos;
+        akttokenpos.fileindex:=inputfile^.ref_index;
+        aktfilepos:=akttokenpos;
       end;
 
 
@@ -570,12 +656,12 @@ implementation
          { update for status and call the show status routine,
            but don't touch aktfilepos ! }
            oldaktfilepos:=aktfilepos;
-           oldtokenpos:=tokenpos;
+           oldtokenpos:=akttokenpos;
            gettokenpos; { update for v_status }
            inc(status.compiledlines);
            ShowStatus;
            aktfilepos:=oldaktfilepos;
-           tokenpos:=oldtokenpos;
+           akttokenpos:=oldtokenpos;
          end;
       end;
 
@@ -1137,7 +1223,7 @@ implementation
         code    : integer;
         low,high,mid : longint;
         m       : longint;
-        mac     : pmacrosym;
+        mac     : pmacro;
         asciinr : string[6];
       label
          exit_label;
@@ -1216,7 +1302,7 @@ implementation
             { this takes some time ... }
               if (cs_support_macro in aktmoduleswitches) then
                begin
-                 mac:=pmacrosym(macros^.search(pattern));
+                 mac:=pmacro(macros^.search(pattern));
                  if assigned(mac) and (assigned(mac^.buftext)) then
                   begin
                     insertmacro(pattern,mac^.buftext,mac^.buflen);
@@ -1800,7 +1886,10 @@ exit_label:
 end.
 {
   $Log$
-  Revision 1.6  2000-09-24 15:06:28  peter
+  Revision 1.7  2000-10-31 22:02:51  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.6  2000/09/24 15:06:28  peter
     * use defines.inc
 
   Revision 1.5  2000/08/27 16:11:53  peter
@@ -1817,4 +1906,4 @@ end.
   Revision 1.2  2000/07/13 11:32:49  michael
   + removed logs
 
-}
+}

compiler/symbase.pas

@@ -0,0 +1,289 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl, Pierre Muller
+
+    This unit handles the symbol tables
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ****************************************************************************
+}
+unit symbase;
+
+{$i defines.inc}
+
+interface
+
+    uses
+       { common }
+       cutils,cobjects,
+       { global }
+       globtype,globals,
+       { symtable }
+       symconst
+       ;
+
+{************************************************
+           Some internal constants
+************************************************}
+
+   const
+       hasharraysize    = 256;
+       indexgrowsize    = 64;
+
+{************************************************
+            Needed forward pointers
+************************************************}
+
+    type
+       psymtable = ^tsymtable;
+
+{************************************************
+               TSymtableEntry
+************************************************}
+
+      psymtableentry = ^tsymtableentry;
+      tsymtableentry = object(tnamedindexobject)
+         owner : psymtable;
+      end;
+
+
+{************************************************
+                 TDefEntry
+************************************************}
+      pdefentry = ^tdefentry;
+      tdefentry = object(tsymtableentry)
+         deftype : tdeftype;
+      end;
+
+
+{************************************************
+                   TSymEntry
+************************************************}
+
+      { this object is the base for all symbol objects }
+      psymentry = ^tsymentry;
+      tsymentry = object(tsymtableentry)
+         typ : tsymtyp;
+      end;
+
+
+{************************************************
+                 TSymtable
+************************************************}
+
+       tsearchhasharray = array[0..hasharraysize-1] of psymentry;
+       psearchhasharray = ^tsearchhasharray;
+
+       tsymtable = object
+          symtabletype : tsymtabletype;
+          { each symtable gets a number }
+          unitid    : word{integer give range check errors PM};
+          name      : pstring;
+          datasize  : longint;
+          dataalignment : longint;
+          symindex,
+          defindex  : pindexarray;
+          symsearch : pdictionary;
+          next      : psymtable;
+          defowner  : pdefentry; { for records and objects }
+          { only used for parameter symtable to determine the offset relative }
+          { to the frame pointer and for local inline }
+          address_fixup : longint;
+          { this saves all definition to allow a proper clean up }
+          { separate lexlevel from symtable type }
+          symtablelevel : byte;
+          constructor init(t : tsymtabletype);
+          destructor  done;virtual;
+          procedure clear;virtual;
+          function  rename(const olds,news : stringid):psymentry;
+          procedure foreach(proc2call : tnamedindexcallback);
+          procedure insert(sym : psymentry);virtual;
+          function  search(const s : stringid) : psymentry;
+          function  speedsearch(const s : stringid;speedvalue : longint) : psymentry;virtual;
+          procedure registerdef(p : pdefentry);
+          function  getdefnr(l : longint) : pdefentry;
+          function  getsymnr(l : longint) : psymentry;
+{$ifdef GDB}
+          function getnewtypecount : word; virtual;
+{$endif GDB}
+       end;
+
+{************************************************
+                    TDeref
+************************************************}
+
+      pderef = ^tderef;
+      tderef = object
+        dereftype : tdereftype;
+        index     : word;
+        next      : pderef;
+        constructor init(typ:tdereftype;i:word);
+        destructor  done;
+      end;
+
+
+    var
+       registerdef : boolean;      { true, when defs should be registered }
+
+       defaultsymtablestack : psymtable;  { symtablestack after default units have been loaded }
+       symtablestack     : psymtable;     { linked list of symtables }
+       aktrecordsymtable : psymtable;     { current record read from ppu symtable }
+       aktstaticsymtable : psymtable;     { current static for local ppu symtable }
+       aktlocalsymtable  : psymtable;     { current proc local for local ppu symtable }
+
+
+implementation
+
+    uses
+       verbose;
+
+{****************************************************************************
+                                TSYMTABLE
+****************************************************************************}
+
+    constructor tsymtable.init(t : tsymtabletype);
+      begin
+         symtabletype:=t;
+         defowner:=nil;
+         new(symindex,init(indexgrowsize));
+         new(defindex,init(indexgrowsize));
+         new(symsearch,init);
+         symsearch^.noclear:=true;
+      end;
+
+
+    destructor tsymtable.done;
+      begin
+        stringdispose(name);
+        dispose(symindex,done);
+        dispose(defindex,done);
+        { symsearch can already be disposed or set to nil for withsymtable }
+        if assigned(symsearch) then
+         begin
+           dispose(symsearch,done);
+           symsearch:=nil;
+         end;
+      end;
+
+
+    procedure tsymtable.registerdef(p : pdefentry);
+      begin
+         defindex^.insert(p);
+         { set def owner and indexnb }
+         p^.owner:=@self;
+      end;
+
+
+    procedure tsymtable.foreach(proc2call : tnamedindexcallback);
+      begin
+        symindex^.foreach(proc2call);
+      end;
+
+
+{***********************************************
+                Table Access
+***********************************************}
+
+    procedure tsymtable.clear;
+      begin
+         symindex^.clear;
+         defindex^.clear;
+      end;
+
+
+    procedure tsymtable.insert(sym:psymentry);
+      begin
+         sym^.owner:=@self;
+         { insert in index and search hash }
+         symindex^.insert(sym);
+         symsearch^.insert(sym);
+      end;
+
+
+    function tsymtable.search(const s : stringid) : psymentry;
+      begin
+        search:=speedsearch(s,getspeedvalue(s));
+      end;
+
+
+    function tsymtable.speedsearch(const s : stringid;speedvalue : longint) : psymentry;
+      begin
+        speedsearch:=psymentry(symsearch^.speedsearch(s,speedvalue));
+      end;
+
+
+    function tsymtable.rename(const olds,news : stringid):psymentry;
+      begin
+        rename:=psymentry(symsearch^.rename(olds,news));
+      end;
+
+
+    function tsymtable.getsymnr(l : longint) : psymentry;
+      var
+        hp : psymentry;
+      begin
+        hp:=psymentry(symindex^.search(l));
+        if hp=nil then
+         internalerror(10999);
+        getsymnr:=hp;
+      end;
+
+
+    function tsymtable.getdefnr(l : longint) : pdefentry;
+      var
+        hp : pdefentry;
+      begin
+        hp:=pdefentry(defindex^.search(l));
+        if hp=nil then
+         internalerror(10998);
+        getdefnr:=hp;
+      end;
+
+
+{$ifdef GDB}
+    function tsymtable.getnewtypecount : word;
+      begin
+        getnewtypecount:=0;
+      end;
+{$endif GDB}
+
+
+{****************************************************************************
+                               TDeref
+****************************************************************************}
+
+    constructor tderef.init(typ:tdereftype;i:word);
+      begin
+        dereftype:=typ;
+        index:=i;
+        next:=nil;
+      end;
+
+
+    destructor tderef.done;
+      begin
+      end;
+
+
+
+
+
+end.
+{
+  $Log$
+  Revision 1.1  2000-10-31 22:02:51  peter
+    * symtable splitted, no real code changes
+
+}

compiler/symconst.pas

@@ -84,8 +84,24 @@ const
   pfReference= 16;
   pfOut      = 32;
 
+  main_program_level = 1;
+  unit_init_level = 1;
+  normal_function_level = 2;
+
 
 type
+  { Deref entry options }
+  tdereftype = (derefnil,
+    derefaktrecordindex,
+    derefaktstaticindex,
+    derefunit,
+    derefrecord,
+    derefindex,
+    dereflocal,
+    derefpara,
+    derefaktlocal
+  );
+
   { symbol options }
   tsymoption=(sp_none,
     sp_public,
@@ -225,6 +241,18 @@ type
   );
   tvaroptions=set of tvaroption;
 
+  { types of the symtables }
+  tsymtabletype = (invalidsymtable,withsymtable,staticsymtable,
+                   globalsymtable,unitsymtable,
+                   objectsymtable,recordsymtable,
+                   macrosymtable,localsymtable,
+                   parasymtable,inlineparasymtable,
+                   inlinelocalsymtable,stt_exceptsymtable,
+                   { only used for PPU reading of static part
+                     of a unit }
+                   staticppusymtable);
+
+
   { definition contains the informations about a type }
   tdeftype = (abstractdef,arraydef,recorddef,pointerdef,orddef,
               stringdef,enumdef,procdef,objectdef,errordef,
@@ -252,10 +280,22 @@ type
   );
 
 {$ifdef GDB}
+type
   tdefstabstatus = (
     not_written,
     being_written,
     written);
+
+const
+  tagtypes : Set of tdeftype =
+    [recorddef,enumdef,
+    {$IfNDef GDBKnowsStrings}
+    stringdef,
+    {$EndIf not GDBKnowsStrings}
+    {$IfNDef GDBKnowsFiles}
+    filedef,
+    {$EndIf not GDBKnowsFiles}
+    objectdef];
 {$endif GDB}
 
 const
@@ -282,12 +322,8 @@ implementation
 end.
 {
   $Log$
-  Revision 1.10  2000-10-21 18:16:12  florian
-    * a lot of changes:
-       - basic dyn. array support
-       - basic C++ support
-       - some work for interfaces done
-       ....
+  Revision 1.11  2000-10-31 22:02:51  peter
+    * symtable splitted, no real code changes
 
   Revision 1.9  2000/10/15 07:47:52  peter
     * unit names and procedure names are stored mixed case

compiler/symdefh.inc

@@ -1,610 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl, Pierre Muller
-
-    Interface for the definition types of the symtable
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
-}
-
-{************************************************
-                    TDef
-************************************************}
-
-       tdef = object(tsymtableentry)
-          deftype    : tdeftype;
-          typesym    : ptypesym;  { which type the definition was generated this def }
-
-          has_inittable : boolean;
-          { adress of init informations }
-          inittable_label : pasmlabel;
-
-          has_rtti   : boolean;
-          { address of rtti }
-          rtti_label : pasmlabel;
-
-          nextglobal,
-          previousglobal : pdef;
-{$ifdef GDB}
-          globalnb       : word;
-          is_def_stab_written : tdefstabstatus;
-{$endif GDB}
-          constructor init;
-          constructor load;
-          destructor  done;virtual;
-          procedure deref;virtual;
-          function  typename:string;
-          procedure write;virtual;
-          function  size:longint;virtual;
-          function  alignment:longint;virtual;
-          function  gettypename:string;virtual;
-          function  is_publishable : boolean;virtual;
-          function  is_in_current : boolean;
-          procedure correct_owner_symtable; { registers enumdef inside objects or
-                                              record directly in the owner symtable !! }
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-          function  NumberString:string;
-          procedure set_globalnb;virtual;
-          function  allstabstring : pchar;
-{$endif GDB}
-          { init. tables }
-          function  needs_inittable : boolean;virtual;
-          procedure generate_inittable;
-          function  get_inittable_label : pasmlabel;
-          { the default implemenation calls write_rtti_data     }
-          { if init and rtti data is different these procedures }
-          { must be overloaded                                  }
-          procedure write_init_data;virtual;
-          procedure write_child_init_data;virtual;
-          { rtti }
-          procedure write_rtti_name;
-          function  get_rtti_label : string;virtual;
-          procedure generate_rtti;virtual;
-          procedure write_rtti_data;virtual;
-          procedure write_child_rtti_data;virtual;
-          function is_intregable : boolean;
-          function is_fpuregable : boolean;
-       private
-          savesize  : longint;
-       end;
-
-       targconvtyp = (act_convertable,act_equal,act_exact);
-
-       tvarspez = (vs_value,vs_const,vs_var,vs_out);
-
-       pparaitem = ^tparaitem;
-       tparaitem = object(tlinkedlist_item)
-          paratype     : ttype;
-          paratyp      : tvarspez;
-          argconvtyp   : targconvtyp;
-          convertlevel : byte;
-          register     : tregister;
-          defaultvalue : psym; { pconstsym }
-       end;
-
-       { this is only here to override the count method,
-         which can't be used }
-       pparalinkedlist = ^tparalinkedlist;
-       tparalinkedlist = object(tlinkedlist)
-          function count:longint;
-       end;
-
-       tfiletyp = (ft_text,ft_typed,ft_untyped);
-
-       pfiledef = ^tfiledef;
-       tfiledef = object(tdef)
-          filetyp : tfiletyp;
-          typedfiletype : ttype;
-          constructor inittext;
-          constructor inituntyped;
-          constructor inittyped(const tt : ttype);
-          constructor inittypeddef(p : pdef);
-          constructor load;
-          procedure write;virtual;
-          procedure deref;virtual;
-          function  gettypename:string;virtual;
-          procedure setsize;
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-       end;
-
-       pformaldef = ^tformaldef;
-       tformaldef = object(tdef)
-          constructor init;
-          constructor load;
-          procedure write;virtual;
-          function  gettypename:string;virtual;
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-       end;
-
-       pforwarddef = ^tforwarddef;
-       tforwarddef = object(tdef)
-          tosymname : string;
-          forwardpos : tfileposinfo;
-          constructor init(const s:string;const pos : tfileposinfo);
-          function  gettypename:string;virtual;
-       end;
-
-       perrordef = ^terrordef;
-       terrordef = object(tdef)
-          constructor init;
-          function  gettypename:string;virtual;
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-{$endif GDB}
-       end;
-
-       { tpointerdef and tclassrefdef should get a common
-         base class, but I derived tclassrefdef from tpointerdef
-         to avoid problems with bugs (FK)
-       }
-
-       ppointerdef = ^tpointerdef;
-       tpointerdef = object(tdef)
-          pointertype : ttype;
-          is_far : boolean;
-          constructor init(const tt : ttype);
-          constructor initfar(const tt : ttype);
-          constructor initdef(p : pdef);
-          constructor initfardef(p : pdef);
-          constructor load;
-          destructor  done;virtual;
-          procedure write;virtual;
-          procedure deref;virtual;
-          function  gettypename:string;virtual;
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-       end;
-
-       pprocdef = ^tprocdef;
-
-       pobjectdef = ^tobjectdef;
-       tobjectdef = object(tdef)
-          childof  : pobjectdef;
-          objname  : pstring;
-          symtable : psymtable;
-          objectoptions : tobjectoptions;
-          { to be able to have a variable vmt position }
-          { and no vmt field for objects without virtuals }
-          vmt_offset : longint;
-{$ifdef GDB}
-          classglobalnb,
-          classptrglobalnb : word;
-          writing_stabs : boolean;
-{$endif GDB}
-          constructor init(const n : string;c : pobjectdef);
-          constructor load;
-          destructor  done;virtual;
-          procedure write;virtual;
-          procedure deref;virtual;
-          function  size : longint;virtual;
-          function  alignment:longint;virtual;
-          function  vmtmethodoffset(index:longint):longint;
-          function  is_publishable : boolean;virtual;
-          function  vmt_mangledname : string;
-          function  rtti_name : string;
-          procedure check_forwards;
-          function  is_related(d : pobjectdef) : boolean;
-          function  is_class : boolean;
-          function  is_interface : boolean;
-          function  is_cppclass : boolean;
-          function  is_object : boolean;
-          function  next_free_name_index : longint;
-          procedure insertvmt;
-          procedure set_parent(c : pobjectdef);
-          function searchdestructor : pprocdef;
-          { debug }
-{$ifdef GDB}
-          function stabstring : pchar;virtual;
-          procedure set_globalnb;virtual;
-          function  classnumberstring : string;
-          function  classptrnumberstring : string;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-          { init/final }
-          function  needs_inittable : boolean;virtual;
-          procedure write_init_data;virtual;
-          procedure write_child_init_data;virtual;
-          { rtti }
-          function  get_rtti_label : string;virtual;
-          procedure generate_rtti;virtual;
-          procedure write_rtti_data;virtual;
-          procedure write_child_rtti_data;virtual;
-          function generate_field_table : pasmlabel;
-       end;
-
-       pclassrefdef = ^tclassrefdef;
-       tclassrefdef = object(tpointerdef)
-          constructor init(def : pdef);
-          constructor load;
-          procedure write;virtual;
-          function gettypename:string;virtual;
-          { debug }
-{$ifdef GDB}
-          function stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-       end;
-
-       parraydef = ^tarraydef;
-       tarraydef = object(tdef)
-       private
-          rangenr    : longint;
-       public
-          lowrange,
-          highrange  : longint;
-          elementtype,
-          rangetype  : ttype;
-          IsDynamicArray,
-          IsVariant,
-          IsConstructor,
-          IsArrayOfConst : boolean;
-          function gettypename:string;virtual;
-          function elesize : longint;
-          constructor init(l,h : longint;rd : pdef);
-          constructor load;
-          procedure write;virtual;
-{$ifdef GDB}
-          function stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-          procedure deref;virtual;
-          function size : longint;virtual;
-          function alignment : longint;virtual;
-          { generates the ranges needed by the asm instruction BOUND (i386)
-            or CMP2 (Motorola) }
-          procedure genrangecheck;
-
-          { returns the label of the range check string }
-          function getrangecheckstring : string;
-          function needs_inittable : boolean;virtual;
-          procedure write_rtti_data;virtual;
-          procedure write_child_rtti_data;virtual;
-       end;
-
-       precorddef = ^trecorddef;
-       trecorddef = object(tdef)
-          symtable : psymtable;
-          constructor init(p : psymtable);
-          constructor load;
-          destructor done;virtual;
-          procedure write;virtual;
-          procedure deref;virtual;
-          function  size:longint;virtual;
-          function  alignment : longint;virtual;
-          function  gettypename:string;virtual;
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-          { init/final }
-          procedure write_init_data;virtual;
-          procedure write_child_init_data;virtual;
-          function  needs_inittable : boolean;virtual;
-          { rtti }
-          procedure write_rtti_data;virtual;
-          procedure write_child_rtti_data;virtual;
-       end;
-
-       porddef = ^torddef;
-       torddef = object(tdef)
-        private
-          rangenr  : longint;
-        public
-          low,high : longint;
-          typ      : tbasetype;
-          constructor init(t : tbasetype;v,b : longint);
-          constructor load;
-          procedure write;virtual;
-          function  is_publishable : boolean;virtual;
-          function  gettypename:string;virtual;
-          procedure setsize;
-          { generates the ranges needed by the asm instruction BOUND }
-          { or CMP2 (Motorola)                                       }
-          procedure genrangecheck;
-          function  getrangecheckstring : string;
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-{$endif GDB}
-          { rtti }
-          procedure write_rtti_data;virtual;
-       end;
-
-       pfloatdef = ^tfloatdef;
-       tfloatdef = object(tdef)
-          typ : tfloattype;
-          constructor init(t : tfloattype);
-          constructor load;
-          procedure write;virtual;
-          function  gettypename:string;virtual;
-          function  is_publishable : boolean;virtual;
-          procedure setsize;
-          { debug }
-{$ifdef GDB}
-          function stabstring : pchar;virtual;
-{$endif GDB}
-          { rtti }
-          procedure write_rtti_data;virtual;
-       end;
-
-       pabstractprocdef = ^tabstractprocdef;
-       tabstractprocdef = object(tdef)
-          { saves a definition to the return type }
-          rettype         : ttype;
-          proctypeoption  : tproctypeoption;
-          proccalloptions : tproccalloptions;
-          procoptions     : tprocoptions;
-          para            : pparalinkedlist;
-          maxparacount,
-          minparacount    : longint;
-          symtablelevel   : byte;
-          fpu_used        : byte;    { how many stack fpu must be empty }
-          constructor init;
-          constructor load;
-          destructor done;virtual;
-          procedure  write;virtual;
-          procedure deref;virtual;
-          procedure concatpara(tt:ttype;vsp : tvarspez;defval:psym);
-          function  para_size(alignsize:longint) : longint;
-          function  demangled_paras : string;
-          function  proccalloption2str : string;
-          procedure test_if_fpu_result;
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-       end;
-
-       pprocvardef = ^tprocvardef;
-       tprocvardef = object(tabstractprocdef)
-          constructor init;
-          constructor load;
-          procedure write;virtual;
-          function  size : longint;virtual;
-          function gettypename:string;virtual;
-          function is_publishable : boolean;virtual;
-          { debug }
-{$ifdef GDB}
-          function stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput); virtual;
-{$endif GDB}
-          { rtti }
-          procedure write_child_rtti_data;virtual;
-          procedure write_rtti_data;virtual;
-       end;
-
-       tmessageinf = record
-         case integer of
-           0 : (str : pchar);
-           1 : (i : longint);
-       end;
-
-       tprocdef = object(tabstractprocdef)
-       private
-          _mangledname : pstring;
-       public
-          extnumber  : longint;
-          messageinf : tmessageinf;
-          nextoverloaded : pprocdef;
-          { where is this function defined, needed here because there
-            is only one symbol for all overloaded functions }
-          fileinfo : tfileposinfo;
-          { pointer to the local symbol table }
-          localst : psymtable;
-          { pointer to the parameter symbol table }
-          parast : psymtable;
-          { symbol owning this definition }
-          procsym : pprocsym;
-          { browser info }
-          lastref,
-          defref,
-          crossref,
-          lastwritten : pref;
-          refcount : longint;
-          _class : pobjectdef;
-          { it's a tree, but this not easy to handle }
-          { used for inlined procs                   }
-          code : pointer;
-          { info about register variables (JM) }
-          regvarinfo: pointer;
-          { true, if the procedure is only declared }
-          { (forward procedure) }
-          forwarddef,
-          { true if the procedure is declared in the interface }
-          interfacedef : boolean;
-          { true if the procedure has a forward declaration }
-          hasforward : boolean;
-          { check the problems of manglednames }
-          count      : boolean;
-          is_used    : boolean;
-          { small set which contains the modified registers }
-{$ifdef newcg}
-          usedregisters : tregisterset;
-{$else newcg}
-          usedregisters : longint;
-{$endif newcg}
-          constructor init;
-          constructor load;
-          destructor  done;virtual;
-          procedure write;virtual;
-          procedure deref;virtual;
-          function  haspara:boolean;
-          function  mangledname : string;
-          procedure setmangledname(const s : string);
-          procedure load_references;
-          function  write_references : boolean;
-{$ifdef dummy}
-          function  procname: string;
-{$endif dummy}
-          function  cplusplusmangledname : string;
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-          { browser }
-{$ifdef BrowserLog}
-          procedure add_to_browserlog;
-{$endif BrowserLog}
-       end;
-
-       pstringdef = ^tstringdef;
-       tstringdef = object(tdef)
-          string_typ : tstringtype;
-          len        : longint;
-          constructor shortinit(l : byte);
-          constructor shortload;
-          constructor longinit(l : longint);
-          constructor longload;
-          constructor ansiinit(l : longint);
-          constructor ansiload;
-          constructor wideinit(l : longint);
-          constructor wideload;
-          function  stringtypname:string;
-          function  size : longint;virtual;
-          procedure write;virtual;
-          function  gettypename:string;virtual;
-          function  is_publishable : boolean;virtual;
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-          { init/final }
-          function  needs_inittable : boolean;virtual;
-          { rtti }
-          procedure write_rtti_data;virtual;
-       end;
-
-       penumdef = ^tenumdef;
-       tenumdef = object(tdef)
-          rangenr,
-          minval,
-          maxval    : longint;
-          has_jumps : boolean;
-          firstenum : penumsym;
-          basedef   : penumdef;
-          constructor init;
-          constructor init_subrange(_basedef:penumdef;_min,_max:longint);
-          constructor load;
-          destructor done;virtual;
-          procedure write;virtual;
-          procedure deref;virtual;
-          function  gettypename:string;virtual;
-          function  is_publishable : boolean;virtual;
-          procedure calcsavesize;
-          procedure setmax(_max:longint);
-          procedure setmin(_min:longint);
-          function  min:longint;
-          function  max:longint;
-          function  getrangecheckstring:string;
-          procedure genrangecheck;
-          { debug }
-{$ifdef GDB}
-          function stabstring : pchar;virtual;
-{$endif GDB}
-          { rtti }
-          procedure write_child_rtti_data;virtual;
-          procedure write_rtti_data;virtual;
-       end;
-
-       psetdef = ^tsetdef;
-       tsetdef = object(tdef)
-          elementtype : ttype;
-          settype : tsettype;
-          constructor init(s : pdef;high : longint);
-          constructor load;
-          destructor  done;virtual;
-          procedure write;virtual;
-          procedure deref;virtual;
-          function  gettypename:string;virtual;
-          function  is_publishable : boolean;virtual;
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-          { rtti }
-          procedure write_rtti_data;virtual;
-          procedure write_child_rtti_data;virtual;
-       end;
-
-{
-  $Log$
-  Revision 1.13  2000-10-21 18:16:12  florian
-    * a lot of changes:
-       - basic dyn. array support
-       - basic C++ support
-       - some work for interfaces done
-       ....
-
-  Revision 1.12  2000/10/15 07:47:52  peter
-    * unit names and procedure names are stored mixed case
-
-  Revision 1.11  2000/10/14 10:14:53  peter
-    * moehrendorf oct 2000 rewrite
-
-  Revision 1.10  2000/09/24 15:06:29  peter
-    * use defines.inc
-
-  Revision 1.9  2000/09/19 23:08:03  pierre
-   * fixes for local class debuggging problem (merged)
-
-  Revision 1.8  2000/08/21 11:27:44  pierre
-   * fix the stabs problems
-
-  Revision 1.7  2000/08/06 19:39:28  peter
-    * default parameters working !
-
-  Revision 1.6  2000/08/06 14:17:15  peter
-    * overload fixes (merged)
-
-  Revision 1.5  2000/08/03 13:17:26  jonas
-    + allow regvars to be used inside inlined procs, which required  the
-      following changes:
-        + load regvars in genentrycode/free them in genexitcode (cgai386)
-        * moved all regvar related code to new regvars unit
-        + added pregvarinfo type to hcodegen
-        + added regvarinfo field to tprocinfo (symdef/symdefh)
-        * deallocate the regvars of the caller in secondprocinline before
-          inlining the called procedure and reallocate them afterwards
-
-  Revision 1.4  2000/08/02 19:49:59  peter
-    * first things for default parameters
-
-  Revision 1.3  2000/07/13 12:08:27  michael
-  + patched to 1.1.0 with former 1.09patch from peter
-
-  Revision 1.2  2000/07/13 11:32:49  michael
-  + removed logs
-
-}

compiler/symppu.inc

@@ -1,753 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl, Pierre Muller
-
-    Implementation of the reading of PPU Files for the symtable
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
-}
-
-    const
-{$ifdef FPC}
-       ppubufsize=32768;
-{$ELSE}
-    {$IFDEF USEOVERLAY}
-       ppubufsize=512;
-    {$ELSE}
-       ppubufsize=4096;
-    {$ENDIF}
-{$ENDIF}
-
-{$define ORDERSOURCES}
-
-{*****************************************************************************
-                                 PPU Writing
-*****************************************************************************}
-
-    procedure writebyte(b:byte);
-      begin
-        current_ppu^.putbyte(b);
-      end;
-
-
-    procedure writeword(w:word);
-      begin
-        current_ppu^.putword(w);
-      end;
-
-
-    procedure writelong(l:longint);
-      begin
-        current_ppu^.putlongint(l);
-      end;
-
-
-    procedure writereal(d:bestreal);
-      begin
-        current_ppu^.putreal(d);
-      end;
-
-
-    procedure writestring(const s:string);
-      begin
-        current_ppu^.putstring(s);
-      end;
-
-
-    procedure writenormalset(var s); {You cannot pass an array[0..31] of byte!}
-      begin
-        current_ppu^.putdata(s,sizeof(tnormalset));
-      end;
-
-
-    procedure writesmallset(var s);
-      begin
-        current_ppu^.putdata(s,4);
-      end;
-
-
-    { posinfo is not relevant for changes in PPU }
-    procedure writeposinfo(const p:tfileposinfo);
-      var
-        oldcrc : boolean;
-      begin
-        oldcrc:=current_ppu^.do_crc;
-        current_ppu^.do_crc:=false;
-        current_ppu^.putword(p.fileindex);
-        current_ppu^.putlongint(p.line);
-        current_ppu^.putword(p.column);
-        current_ppu^.do_crc:=oldcrc;
-      end;
-
-
-    procedure writederef(p : psymtableentry);
-      begin
-        if p=nil then
-         current_ppu^.putbyte(ord(derefnil))
-        else
-         begin
-           { Static symtable ? }
-           if p^.owner^.symtabletype=staticsymtable then
-            begin
-              current_ppu^.putbyte(ord(derefaktstaticindex));
-              current_ppu^.putword(p^.indexnr);
-            end
-           { Local record/object symtable ? }
-           else if (p^.owner=aktrecordsymtable) then
-            begin
-              current_ppu^.putbyte(ord(derefaktrecordindex));
-              current_ppu^.putword(p^.indexnr);
-            end
-           { Local local/para symtable ? }
-           else if (p^.owner=aktlocalsymtable) then
-            begin
-              current_ppu^.putbyte(ord(derefaktlocal));
-              current_ppu^.putword(p^.indexnr);
-            end
-           else
-            begin
-              current_ppu^.putbyte(ord(derefindex));
-              current_ppu^.putword(p^.indexnr);
-           { Current unit symtable ? }
-              repeat
-                if not assigned(p) then
-                 internalerror(556655);
-                case p^.owner^.symtabletype of
-                 { when writing the pseudo PPU file
-                   to get CRC values the globalsymtable is not yet
-                   a unitsymtable PM }
-                  globalsymtable,
-                  unitsymtable :
-                    begin
-                      { check if the unit is available in the uses
-                        clause, else it's an error }
-                      if p^.owner^.unitid=$ffff then
-                       internalerror(55665566);
-                      current_ppu^.putbyte(ord(derefunit));
-                      current_ppu^.putword(p^.owner^.unitid);
-                      break;
-                    end;
-                  staticsymtable :
-                    begin
-                      current_ppu^.putbyte(ord(derefaktstaticindex));
-                      current_ppu^.putword(p^.indexnr);
-                      break;
-                    end;
-                  localsymtable :
-                    begin
-                      p:=p^.owner^.defowner;
-                      current_ppu^.putbyte(ord(dereflocal));
-                      current_ppu^.putword(p^.indexnr);
-                    end;
-                  parasymtable :
-                    begin
-                      p:=p^.owner^.defowner;
-                      current_ppu^.putbyte(ord(derefpara));
-                      current_ppu^.putword(p^.indexnr);
-                    end;
-                  objectsymtable,
-                  recordsymtable :
-                    begin
-                      p:=p^.owner^.defowner;
-                      current_ppu^.putbyte(ord(derefrecord));
-                      current_ppu^.putword(p^.indexnr);
-                    end;
-                  else
-                    internalerror(556656);
-                end;
-              until false;
-            end;
-         end;
-      end;
-
-    procedure writedefref(p : pdef);
-      begin
-        writederef(p);
-      end;
-
-    procedure writesymref(p : psym);
-      begin
-        writederef(p);
-      end;
-
-    procedure writesourcefiles;
-      var
-        hp    : pinputfile;
-{$ifdef ORDERSOURCES}
-        i,j : longint;
-{$endif ORDERSOURCES}
-      begin
-      { second write the used source files }
-        current_ppu^.do_crc:=false;
-        hp:=current_module^.sourcefiles^.files;
-{$ifdef ORDERSOURCES}
-      { write source files directly in good order }
-        j:=0;
-        while assigned(hp) do
-          begin
-            inc(j);
-            hp:=hp^.ref_next;
-          end;
-        while j>0 do
-          begin
-            hp:=current_module^.sourcefiles^.files;
-            for i:=1 to j-1 do
-              hp:=hp^.ref_next;
-            current_ppu^.putstring(hp^.name^);
-            dec(j);
-         end;
-{$else not ORDERSOURCES}
-        while assigned(hp) do
-         begin
-         { only name and extension }
-           current_ppu^.putstring(hp^.name^);
-           hp:=hp^.ref_next;
-         end;
-{$endif ORDERSOURCES}
-        current_ppu^.writeentry(ibsourcefiles);
-        current_ppu^.do_crc:=true;
-      end;
-
-    procedure writeusedmacros;
-      var
-        hp    : pmacrosym;
-        i     : longint;
-      begin
-      { second write the used source files }
-        current_ppu^.do_crc:=false;
-        for i:=1 to macros^.symindex^.count do
-         begin
-           hp:=pmacrosym(macros^.symindex^.search(i));
-         { only used or init defined macros are stored }
-           if hp^.is_used or hp^.defined_at_startup then
-             begin
-               current_ppu^.putstring(hp^.name);
-               current_ppu^.putbyte(byte(hp^.defined_at_startup));
-               current_ppu^.putbyte(byte(hp^.is_used));
-             end;
-         end;
-        current_ppu^.writeentry(ibusedmacros);
-        current_ppu^.do_crc:=true;
-      end;
-
-
-    procedure writeusedunit;
-      var
-        hp      : pused_unit;
-      begin
-        numberunits;
-        hp:=pused_unit(current_module^.used_units.first);
-        while assigned(hp) do
-         begin
-           { implementation units should not change
-             the CRC PM }
-           current_ppu^.do_crc:=hp^.in_interface;
-           current_ppu^.putstring(hp^.name^);
-           { the checksum should not affect the crc of this unit ! (PFV) }
-           current_ppu^.do_crc:=false;
-           current_ppu^.putlongint(hp^.checksum);
-           current_ppu^.putlongint(hp^.interface_checksum);
-           current_ppu^.putbyte(byte(hp^.in_interface));
-           current_ppu^.do_crc:=true;
-           hp:=pused_unit(hp^.next);
-         end;
-        current_ppu^.do_interface_crc:=true;
-        current_ppu^.writeentry(ibloadunit);
-      end;
-
-
-    procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
-      var
-        hcontainer : tlinkcontainer;
-        s : string;
-        mask : longint;
-      begin
-        hcontainer.init;
-        while not p.empty do
-         begin
-           s:=p.get(mask);
-           if strippath then
-            current_ppu^.putstring(SplitFileName(s))
-           else
-            current_ppu^.putstring(s);
-           current_ppu^.putlongint(mask);
-           hcontainer.insert(s,mask);
-         end;
-        current_ppu^.writeentry(id);
-        p:=hcontainer;
-      end;
-
-
-    procedure writeunitas(const s : string;unittable : punitsymtable;only_crc : boolean);
-      begin
-         Message1(unit_u_ppu_write,s);
-
-       { create unit flags }
-         with Current_Module^ do
-          begin
-{$ifdef GDB}
-            if cs_gdb_dbx in aktglobalswitches then
-             flags:=flags or uf_has_dbx;
-{$endif GDB}
-            if target_os.endian=endian_big then
-             flags:=flags or uf_big_endian;
-            if cs_browser in aktmoduleswitches then
-             flags:=flags or uf_has_browser;
-            if cs_local_browser in aktmoduleswitches then
-             flags:=flags or uf_local_browser;
-          end;
-
-{$ifdef Test_Double_checksum_write}
-        If only_crc then
-          Assign(CRCFile,s+'.INT')
-        else
-          Assign(CRCFile,s+'.IMP');
-        Rewrite(CRCFile);
-{$endif def Test_Double_checksum_write}
-       { open ppufile }
-         current_ppu:=new(pppufile,init(s));
-         current_ppu^.crc_only:=only_crc;
-         if not current_ppu^.create then
-           Message(unit_f_ppu_cannot_write);
-
-{$ifdef Test_Double_checksum}
-         if only_crc then
-           begin
-              new(current_ppu^.crc_test);
-              new(current_ppu^.crc_test2);
-           end
-         else
-           begin
-             current_ppu^.crc_test:=Current_Module^.crc_array;
-             current_ppu^.crc_index:=Current_Module^.crc_size;
-             current_ppu^.crc_test2:=Current_Module^.crc_array2;
-             current_ppu^.crc_index2:=Current_Module^.crc_size2;
-           end;
-{$endif def Test_Double_checksum}
-
-         current_ppu^.change_endian:=source_os.endian<>target_os.endian;
-       { write symbols and definitions }
-         unittable^.writeasunit;
-
-       { flush to be sure }
-         current_ppu^.flush;
-       { create and write header }
-         current_ppu^.header.size:=current_ppu^.size;
-         current_ppu^.header.checksum:=current_ppu^.crc;
-         current_ppu^.header.interface_checksum:=current_ppu^.interface_crc;
-         current_ppu^.header.compiler:=wordversion;
-         current_ppu^.header.cpu:=word(target_cpu);
-         current_ppu^.header.target:=word(target_info.target);
-         current_ppu^.header.flags:=current_module^.flags;
-         If not only_crc then
-           current_ppu^.writeheader;
-       { save crc in current_module also }
-         current_module^.crc:=current_ppu^.crc;
-         current_module^.interface_crc:=current_ppu^.interface_crc;
-         if only_crc then
-          begin
-{$ifdef Test_Double_checksum}
-            Current_Module^.crc_array:=current_ppu^.crc_test;
-            current_ppu^.crc_test:=nil;
-            Current_Module^.crc_size:=current_ppu^.crc_index2;
-            Current_Module^.crc_array2:=current_ppu^.crc_test2;
-            current_ppu^.crc_test2:=nil;
-            Current_Module^.crc_size2:=current_ppu^.crc_index2;
-{$endif def Test_Double_checksum}
-            closecurrentppu;
-          end;
-{$ifdef Test_Double_checksum_write}
-        close(CRCFile);
-{$endif Test_Double_checksum_write}
-      end;
-
-
-    procedure closecurrentppu;
-      begin
-{$ifdef Test_Double_checksum}
-         if assigned(current_ppu^.crc_test) then
-           dispose(current_ppu^.crc_test);
-         if assigned(current_ppu^.crc_test2) then
-           dispose(current_ppu^.crc_test2);
-{$endif Test_Double_checksum}
-       { close }
-         current_ppu^.close;
-         dispose(current_ppu,done);
-         current_ppu:=nil;
-      end;
-
-
-{*****************************************************************************
-                                 PPU Reading
-*****************************************************************************}
-
-    function readbyte:byte;
-      begin
-        readbyte:=current_ppu^.getbyte;
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    function readword:word;
-      begin
-        readword:=current_ppu^.getword;
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    function readlong:longint;
-      begin
-        readlong:=current_ppu^.getlongint;
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    function readreal : bestreal;
-      begin
-        readreal:=current_ppu^.getreal;
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    function readstring : string;
-      begin
-        readstring:=current_ppu^.getstring;
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    procedure readnormalset(var s);   {You cannot pass an array [0..31] of byte.}
-      begin
-        current_ppu^.getdata(s,sizeof(tnormalset));
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    procedure readsmallset(var s);
-      begin
-        current_ppu^.getdata(s,4);
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    procedure readposinfo(var p:tfileposinfo);
-      begin
-        p.fileindex:=current_ppu^.getword;
-        p.line:=current_ppu^.getlongint;
-        p.column:=current_ppu^.getword;
-      end;
-
-
-    function readderef : pderef;
-      var
-        hp,p : pderef;
-        b : tdereftype;
-      begin
-        p:=nil;
-        repeat
-          hp:=p;
-          b:=tdereftype(current_ppu^.getbyte);
-          case b of
-            derefnil :
-              break;
-            derefunit,
-            derefaktrecordindex,
-            derefaktlocal,
-            derefaktstaticindex :
-              begin
-                new(p,init(b,current_ppu^.getword));
-                p^.next:=hp;
-                break;
-              end;
-            derefindex,
-            dereflocal,
-            derefpara,
-            derefrecord :
-              begin
-                new(p,init(b,current_ppu^.getword));
-                p^.next:=hp;
-              end;
-          end;
-        until false;
-        readderef:=p;
-      end;
-
-    function readdefref : pdef;
-      begin
-        readdefref:=pdef(readderef);
-      end;
-
-    function readsymref : psym;
-      begin
-        readsymref:=psym(readderef);
-      end;
-
-    procedure readusedmacros;
-      var
-        hs : string;
-        mac : pmacrosym;
-        was_defined_at_startup,
-        was_used : boolean;
-      begin
-        while not current_ppu^.endofentry do
-         begin
-           hs:=current_ppu^.getstring;
-           was_defined_at_startup:=boolean(current_ppu^.getbyte);
-           was_used:=boolean(current_ppu^.getbyte);
-           mac:=pmacrosym(macros^.search(hs));
-           if assigned(mac) then
-             begin
-{$ifndef EXTDEBUG}
-           { if we don't have the sources why tell }
-              if current_module^.sources_avail then
-{$endif ndef EXTDEBUG}
-               if (not was_defined_at_startup) and
-                  was_used and
-                  mac^.defined_at_startup then
-                Message2(unit_h_cond_not_set_in_last_compile,hs,current_module^.mainsource^);
-             end
-           else { not assigned }
-             if was_defined_at_startup and
-                was_used then
-              Message2(unit_h_cond_not_set_in_last_compile,hs,current_module^.mainsource^);
-         end;
-      end;
-
-    procedure readsourcefiles;
-      var
-        temp,hs       : string;
-        temp_dir      : string;
-{$ifdef ORDERSOURCES}
-        main_dir      : string;
-{$endif ORDERSOURCES}
-        incfile_found,
-        main_found,
-        is_main       : boolean;
-        ppufiletime,
-        source_time   : longint;
-        hp            : pinputfile;
-      begin
-        ppufiletime:=getnamedfiletime(current_module^.ppufilename^);
-        current_module^.sources_avail:=true;
-{$ifdef ORDERSOURCES}
-        is_main:=true;
-        main_dir:='';
-{$endif ORDERSOURCES}
-        while not current_ppu^.endofentry do
-         begin
-           hs:=current_ppu^.getstring;
-{$ifndef ORDERSOURCES}
-           is_main:=current_ppu^.endofentry;
-{$endif ORDERSOURCES}
-           temp_dir:='';
-           if (current_module^.flags and uf_in_library)<>0 then
-            begin
-              current_module^.sources_avail:=false;
-              temp:=' library';
-            end
-           else if pos('Macro ',hs)=1 then
-            begin
-              { we don't want to find this file }
-              { but there is a problem with file indexing !! }
-              temp:='';
-            end
-           else
-            begin
-              { check the date of the source files }
-              Source_Time:=GetNamedFileTime(current_module^.path^+hs);
-              incfile_found:=false;
-              main_found:=false;
-              if Source_Time<>-1 then
-                hs:=current_module^.path^+hs
-{$ifdef ORDERSOURCES}
-              else if not(is_main) then
-                begin
-                  Source_Time:=GetNamedFileTime(main_dir+hs);
-                  if Source_Time<>-1 then
-                    hs:=main_dir+hs;
-                end
-{$endif def ORDERSOURCES}
-                   ;
-              if (Source_Time=-1) then
-                begin
-                  if is_main then
-                    temp_dir:=unitsearchpath.FindFile(hs,main_found)
-                  else
-                    temp_dir:=includesearchpath.FindFile(hs,incfile_found);
-                  if incfile_found or main_found then
-                   begin
-                     hs:=temp_dir+hs;
-                     Source_Time:=GetNamedFileTime(hs);
-                   end
-                end;
-              if Source_Time=-1 then
-               begin
-                 current_module^.sources_avail:=false;
-                 temp:=' not found';
-               end
-              else
-               begin
-                 if main_found then
-                   main_dir:=temp_dir;
-                 { time newer? But only allow if the file is not searched
-                   in the include path (PFV), else you've problems with
-                   units which use the same includefile names }
-                 if incfile_found then
-                  temp:=' found'
-                 else
-                  begin
-                    temp:=' time '+filetimestring(source_time);
-                    if (source_time>ppufiletime) then
-                     begin
-                       current_module^.do_compile:=true;
-                       current_module^.recompile_reason:=rr_sourcenewer;
-                       temp:=temp+' *'
-                     end;
-                  end;
-               end;
-              new(hp,init(hs));
-              { the indexing is wrong here PM }
-              current_module^.sourcefiles^.register_file(hp);
-            end;
-{$ifdef ORDERSOURCES}
-           if is_main then
-             begin
-               stringdispose(current_module^.mainsource);
-               current_module^.mainsource:=stringdup(hs);
-             end;
-{$endif ORDERSOURCES}
-           Message1(unit_u_ppu_source,hs+temp);
-{$ifdef ORDERSOURCES}
-           is_main:=false;
-{$endif ORDERSOURCES}
-         end;
-{$ifndef ORDERSOURCES}
-      { main source is always the last }
-        stringdispose(current_module^.mainsource);
-        current_module^.mainsource:=stringdup(hs);
-
-        { the indexing is corrected here PM }
-        current_module^.sourcefiles^.inverse_register_indexes;
-{$endif ORDERSOURCES}
-      { check if we want to rebuild every unit, only if the sources are
-        available }
-        if do_build and current_module^.sources_avail then
-          begin
-             current_module^.do_compile:=true;
-             current_module^.recompile_reason:=rr_build;
-          end;
-      end;
-
-
-    procedure readloadunit;
-      var
-        hs : string;
-        intfchecksum,
-        checksum : longint;
-        in_interface : boolean;
-      begin
-        while not current_ppu^.endofentry do
-         begin
-           hs:=current_ppu^.getstring;
-           checksum:=current_ppu^.getlongint;
-           intfchecksum:=current_ppu^.getlongint;
-           in_interface:=(current_ppu^.getbyte<>0);
-           current_module^.used_units.concat(new(pused_unit,init_to_load(hs,checksum,intfchecksum,in_interface)));
-         end;
-      end;
-
-
-    procedure readlinkcontainer(var p:tlinkcontainer);
-      var
-        s : string;
-        m : longint;
-      begin
-        while not current_ppu^.endofentry do
-         begin
-           s:=current_ppu^.getstring;
-           m:=current_ppu^.getlongint;
-           p.insert(s,m);
-         end;
-      end;
-
-
-    procedure load_interface;
-      var
-        b : byte;
-        newmodulename : string;
-      begin
-       { read interface part }
-         repeat
-           b:=current_ppu^.readentry;
-           case b of
-             ibmodulename :
-               begin
-                 newmodulename:=current_ppu^.getstring;
-                 if upper(newmodulename)<>current_module^.modulename^ then
-                   Message2(unit_f_unit_name_error,current_module^.realmodulename^,newmodulename);
-                 stringdispose(current_module^.modulename);
-                 stringdispose(current_module^.realmodulename);
-                 current_module^.modulename:=stringdup(upper(newmodulename));
-                 current_module^.realmodulename:=stringdup(newmodulename);
-               end;
-             ibsourcefiles :
-               readsourcefiles;
-             ibusedmacros :
-               readusedmacros;
-             ibloadunit :
-               readloadunit;
-             iblinkunitofiles :
-               readlinkcontainer(current_module^.LinkUnitOFiles);
-             iblinkunitstaticlibs :
-               readlinkcontainer(current_module^.LinkUnitStaticLibs);
-             iblinkunitsharedlibs :
-               readlinkcontainer(current_module^.LinkUnitSharedLibs);
-             iblinkotherofiles :
-               readlinkcontainer(current_module^.LinkotherOFiles);
-             iblinkotherstaticlibs :
-               readlinkcontainer(current_module^.LinkotherStaticLibs);
-             iblinkothersharedlibs :
-               readlinkcontainer(current_module^.LinkotherSharedLibs);
-             ibendinterface :
-               break;
-           else
-             Message1(unit_f_ppu_invalid_entry,tostr(b));
-           end;
-         until false;
-      end;
-
-{
-  $Log$
-  Revision 1.5  2000-10-15 07:47:53  peter
-    * unit names and procedure names are stored mixed case
-
-  Revision 1.4  2000/09/24 21:33:47  peter
-    * message updates merges
-
-  Revision 1.3  2000/09/21 20:56:19  pierre
-   * fix for bugs 1084/1128 (merged)
-
-  Revision 1.2  2000/07/13 11:32:49  michael
-  + removed logs
-
-}

compiler/symppu.pas

@@ -0,0 +1,328 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl, Pierre Muller
+
+    Implementation of the reading of PPU Files for the symtable
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ****************************************************************************
+}
+unit symppu;
+interface
+
+    uses
+       cobjects,
+       globtype,
+       symbase,
+       ppu;
+
+    var
+       current_ppu       : pppufile;    { Current ppufile which is read }
+
+    procedure writebyte(b:byte);
+    procedure writeword(w:word);
+    procedure writelong(l:longint);
+    procedure writereal(d:bestreal);
+    procedure writestring(const s:string);
+    procedure writenormalset(var s); {You cannot pass an array[0..31] of byte!}
+    procedure writesmallset(var s);
+    procedure writeposinfo(const p:tfileposinfo);
+    procedure writederef(p : psymtableentry);
+
+    function readbyte:byte;
+    function readword:word;
+    function readlong:longint;
+    function readreal : bestreal;
+    function readstring : string;
+    procedure readnormalset(var s);   {You cannot pass an array [0..31] of byte.}
+    procedure readsmallset(var s);
+    procedure readposinfo(var p:tfileposinfo);
+    function readderef : psymtableentry;
+
+    procedure closecurrentppu;
+
+
+implementation
+
+    uses
+       symconst,
+       verbose,
+       finput,scanner,
+       fmodule;
+
+{*****************************************************************************
+                                 PPU Writing
+*****************************************************************************}
+
+    procedure writebyte(b:byte);
+      begin
+        current_ppu^.putbyte(b);
+      end;
+
+
+    procedure writeword(w:word);
+      begin
+        current_ppu^.putword(w);
+      end;
+
+
+    procedure writelong(l:longint);
+      begin
+        current_ppu^.putlongint(l);
+      end;
+
+
+    procedure writereal(d:bestreal);
+      begin
+        current_ppu^.putreal(d);
+      end;
+
+
+    procedure writestring(const s:string);
+      begin
+        current_ppu^.putstring(s);
+      end;
+
+
+    procedure writenormalset(var s); {You cannot pass an array[0..31] of byte!}
+      begin
+        current_ppu^.putdata(s,sizeof(tnormalset));
+      end;
+
+
+    procedure writesmallset(var s);
+      begin
+        current_ppu^.putdata(s,4);
+      end;
+
+
+    { posinfo is not relevant for changes in PPU }
+    procedure writeposinfo(const p:tfileposinfo);
+      var
+        oldcrc : boolean;
+      begin
+        oldcrc:=current_ppu^.do_crc;
+        current_ppu^.do_crc:=false;
+        current_ppu^.putword(p.fileindex);
+        current_ppu^.putlongint(p.line);
+        current_ppu^.putword(p.column);
+        current_ppu^.do_crc:=oldcrc;
+      end;
+
+
+    procedure writederef(p : psymtableentry);
+      begin
+        if p=nil then
+         current_ppu^.putbyte(ord(derefnil))
+        else
+         begin
+           { Static symtable ? }
+           if p^.owner^.symtabletype=staticsymtable then
+            begin
+              current_ppu^.putbyte(ord(derefaktstaticindex));
+              current_ppu^.putword(p^.indexnr);
+            end
+           { Local record/object symtable ? }
+           else if (p^.owner=aktrecordsymtable) then
+            begin
+              current_ppu^.putbyte(ord(derefaktrecordindex));
+              current_ppu^.putword(p^.indexnr);
+            end
+           { Local local/para symtable ? }
+           else if (p^.owner=aktlocalsymtable) then
+            begin
+              current_ppu^.putbyte(ord(derefaktlocal));
+              current_ppu^.putword(p^.indexnr);
+            end
+           else
+            begin
+              current_ppu^.putbyte(ord(derefindex));
+              current_ppu^.putword(p^.indexnr);
+           { Current unit symtable ? }
+              repeat
+                if not assigned(p) then
+                 internalerror(556655);
+                case p^.owner^.symtabletype of
+                 { when writing the pseudo PPU file
+                   to get CRC values the globalsymtable is not yet
+                   a unitsymtable PM }
+                  globalsymtable,
+                  unitsymtable :
+                    begin
+                      { check if the unit is available in the uses
+                        clause, else it's an error }
+                      if p^.owner^.unitid=$ffff then
+                       internalerror(55665566);
+                      current_ppu^.putbyte(ord(derefunit));
+                      current_ppu^.putword(p^.owner^.unitid);
+                      break;
+                    end;
+                  staticsymtable :
+                    begin
+                      current_ppu^.putbyte(ord(derefaktstaticindex));
+                      current_ppu^.putword(p^.indexnr);
+                      break;
+                    end;
+                  localsymtable :
+                    begin
+                      p:=p^.owner^.defowner;
+                      current_ppu^.putbyte(ord(dereflocal));
+                      current_ppu^.putword(p^.indexnr);
+                    end;
+                  parasymtable :
+                    begin
+                      p:=p^.owner^.defowner;
+                      current_ppu^.putbyte(ord(derefpara));
+                      current_ppu^.putword(p^.indexnr);
+                    end;
+                  objectsymtable,
+                  recordsymtable :
+                    begin
+                      p:=p^.owner^.defowner;
+                      current_ppu^.putbyte(ord(derefrecord));
+                      current_ppu^.putword(p^.indexnr);
+                    end;
+                  else
+                    internalerror(556656);
+                end;
+              until false;
+            end;
+         end;
+      end;
+
+    procedure closecurrentppu;
+      begin
+{$ifdef Test_Double_checksum}
+         if assigned(current_ppu^.crc_test) then
+           dispose(current_ppu^.crc_test);
+         if assigned(current_ppu^.crc_test2) then
+           dispose(current_ppu^.crc_test2);
+{$endif Test_Double_checksum}
+       { close }
+         current_ppu^.close;
+         dispose(current_ppu,done);
+         current_ppu:=nil;
+      end;
+
+
+{*****************************************************************************
+                                 PPU Reading
+*****************************************************************************}
+
+    function readbyte:byte;
+      begin
+        readbyte:=current_ppu^.getbyte;
+        if current_ppu^.error then
+         Message(unit_f_ppu_read_error);
+      end;
+
+
+    function readword:word;
+      begin
+        readword:=current_ppu^.getword;
+        if current_ppu^.error then
+         Message(unit_f_ppu_read_error);
+      end;
+
+
+    function readlong:longint;
+      begin
+        readlong:=current_ppu^.getlongint;
+        if current_ppu^.error then
+         Message(unit_f_ppu_read_error);
+      end;
+
+
+    function readreal : bestreal;
+      begin
+        readreal:=current_ppu^.getreal;
+        if current_ppu^.error then
+         Message(unit_f_ppu_read_error);
+      end;
+
+
+    function readstring : string;
+      begin
+        readstring:=current_ppu^.getstring;
+        if current_ppu^.error then
+         Message(unit_f_ppu_read_error);
+      end;
+
+
+    procedure readnormalset(var s);   {You cannot pass an array [0..31] of byte.}
+      begin
+        current_ppu^.getdata(s,sizeof(tnormalset));
+        if current_ppu^.error then
+         Message(unit_f_ppu_read_error);
+      end;
+
+
+    procedure readsmallset(var s);
+      begin
+        current_ppu^.getdata(s,4);
+        if current_ppu^.error then
+         Message(unit_f_ppu_read_error);
+      end;
+
+
+    procedure readposinfo(var p:tfileposinfo);
+      begin
+        p.fileindex:=current_ppu^.getword;
+        p.line:=current_ppu^.getlongint;
+        p.column:=current_ppu^.getword;
+      end;
+
+
+    function readderef : psymtableentry;
+      var
+        hp,p : pderef;
+        b : tdereftype;
+      begin
+        p:=nil;
+        repeat
+          hp:=p;
+          b:=tdereftype(current_ppu^.getbyte);
+          case b of
+            derefnil :
+              break;
+            derefunit,
+            derefaktrecordindex,
+            derefaktlocal,
+            derefaktstaticindex :
+              begin
+                new(p,init(b,current_ppu^.getword));
+                p^.next:=hp;
+                break;
+              end;
+            derefindex,
+            dereflocal,
+            derefpara,
+            derefrecord :
+              begin
+                new(p,init(b,current_ppu^.getword));
+                p^.next:=hp;
+              end;
+          end;
+        until false;
+        readderef:=psymtableentry(p);
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  2000-10-31 22:02:52  peter
+    * symtable splitted, no real code changes
+
+}

compiler/symsymh.inc

@@ -1,345 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl, Pierre Muller
-
-    Interface for the symbols types of the symtable
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
-}
-
-{************************************************
-                   TSym
-************************************************}
-
-       { this object is the base for all symbol objects }
-       tsym = object(tsymtableentry)
-          typ        : tsymtyp;
-          symoptions : tsymoptions;
-          _realname  : pstring;
-          fileinfo   : tfileposinfo;
-{$ifdef GDB}
-          isstabwritten : boolean;
-{$endif GDB}
-          refs          : longint;
-          lastref,
-          defref,
-          lastwritten : pref;
-          refcount    : longint;
-          constructor init(const n : string);
-          constructor load;
-          destructor done;virtual;
-          procedure write;virtual;
-          procedure prederef;virtual; { needed for ttypesym to be deref'd first }
-          procedure deref;virtual;
-          function  realname : string;virtual;
-          function  mangledname : string;virtual;
-          procedure insert_in_data;virtual;
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-          procedure load_references;virtual;
-          function  write_references : boolean;virtual;
-{$ifdef BrowserLog}
-          procedure add_to_browserlog;virtual;
-{$endif BrowserLog}
-       end;
-
-       plabelsym = ^tlabelsym;
-       tlabelsym = object(tsym)
-          lab     : pasmlabel;
-          used,
-          defined : boolean;
-          code : pointer; { should be ptree! }
-          constructor init(const n : string; l : pasmlabel);
-          destructor done;virtual;
-          constructor load;
-          function mangledname : string;virtual;
-          procedure write;virtual;
-       end;
-
-       punitsym = ^tunitsym;
-       tunitsym = object(tsym)
-          unitsymtable : punitsymtable;
-          prevsym      : punitsym;
-          constructor init(const n : string;ref : punitsymtable);
-          constructor load;
-          destructor done;virtual;
-          procedure write;virtual;
-          procedure restoreunitsym;
-{$ifdef GDB}
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-       end;
-
-       pmacrosym = ^tmacrosym;
-       tmacrosym = object(tsym)
-          defined,
-          defined_at_startup,
-          is_used : boolean;
-          buftext : pchar;
-          buflen  : longint;
-          { macros aren't written to PPU files ! }
-          constructor init(const n : string);
-          destructor done;virtual;
-       end;
-
-       perrorsym = ^terrorsym;
-       terrorsym = object(tsym)
-          constructor init;
-       end;
-
-       tprocsym = object(tsym)
-          definition  : pprocdef;
-{$ifdef CHAINPROCSYMS}
-          nextprocsym : pprocsym;
-{$endif CHAINPROCSYMS}
-          is_global   : boolean;
-          constructor init(const n : string);
-          constructor load;
-          destructor done;virtual;
-          function mangledname : string;virtual;
-          function declarationstr(p : pprocdef):string;
-          { writes all declarations }
-          procedure write_parameter_lists(skipdef:pprocdef);
-          { tests, if all procedures definitions are defined and not }
-          { only forward                                             }
-          procedure check_forward;
-          procedure order_overloaded;
-          procedure write;virtual;
-          procedure deref;virtual;
-          procedure load_references;virtual;
-          function  write_references : boolean;virtual;
-{$ifdef BrowserLog}
-          procedure add_to_browserlog;virtual;
-{$endif BrowserLog}
-{$ifdef GDB}
-          function stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-       end;
-
-       ttypesym = object(tsym)
-          restype    : ttype;
-{$ifdef SYNONYM}
-          synonym    : ptypesym;
-{$endif}
-{$ifdef GDB}
-          isusedinstab : boolean;
-{$endif GDB}
-          constructor init(const n : string;const tt : ttype);
-          constructor initdef(const n : string;d : pdef);
-          constructor load;
-{$ifdef SYNONYM}
-          destructor done;virtual;
-{$endif}
-          procedure write;virtual;
-          procedure prederef;virtual;
-          procedure load_references;virtual;
-          function  write_references : boolean;virtual;
-{$ifdef BrowserLog}
-          procedure add_to_browserlog;virtual;
-{$endif BrowserLog}
-{$ifdef GDB}
-          function stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-       end;
-
-       pvarsym = ^tvarsym;
-       tvarsym = object(tsym)
-          address       : longint;
-          localvarsym   : pvarsym;
-          vartype       : ttype;
-          varoptions    : tvaroptions;
-          reg           : tregister; { if reg<>R_NO, then the variable is an register variable }
-          varspez       : tvarspez;  { sets the type of access }
-          varstate      : tvarstate;
-          constructor init(const n : string;const tt : ttype);
-          constructor init_dll(const n : string;const tt : ttype);
-          constructor init_C(const n,mangled : string;const tt : ttype);
-          constructor initdef(const n : string;p : pdef);
-          constructor load;
-          destructor  done;virtual;
-          procedure write;virtual;
-          procedure deref;virtual;
-          procedure setmangledname(const s : string);
-          function  mangledname : string;virtual;
-          procedure insert_in_data;virtual;
-          function  getsize : longint;
-          function  getvaluesize : longint;
-          function  getpushsize : longint;
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-       private
-          _mangledname  : pchar;
-       end;
-
-       ppropertysym = ^tpropertysym;
-       tpropertysym = object(tsym)
-          propoptions   : tpropertyoptions;
-          proptype      : ttype;
-          propoverriden : ppropertysym;
-          indextype     : ttype;
-          index,
-          default       : longint;
-          readaccess,
-          writeaccess,
-          storedaccess  : psymlist;
-          constructor init(const n : string);
-          destructor  done;virtual;
-          constructor load;
-          function  getsize : longint;virtual;
-          procedure write;virtual;
-          procedure deref;virtual;
-          procedure dooverride(overriden:ppropertysym);
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-       end;
-
-       pfuncretsym = ^tfuncretsym;
-       tfuncretsym = object(tsym)
-          funcretprocinfo : pointer{ should be pprocinfo};
-          rettype  : ttype;
-          address  : longint;
-          constructor init(const n : string;approcinfo : pointer{pprocinfo});
-          constructor load;
-          destructor  done;virtual;
-          procedure write;virtual;
-          procedure deref;virtual;
-          procedure insert_in_data;virtual;
-{$ifdef GDB}
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-       end;
-
-       pabsolutesym = ^tabsolutesym;
-       tabsolutesym = object(tvarsym)
-          abstyp  : absolutetyp;
-          absseg  : boolean;
-          ref     : psym;
-          asmname : pstring;
-          constructor init(const n : string;const tt : ttype);
-          constructor initdef(const n : string;p : pdef);
-          constructor load;
-          procedure deref;virtual;
-          function  mangledname : string;virtual;
-          procedure write;virtual;
-          procedure insert_in_data;virtual;
-{$ifdef GDB}
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-       end;
-
-       ptypedconstsym = ^ttypedconstsym;
-       ttypedconstsym = object(tsym)
-          prefix          : pstring;
-          typedconsttype  : ttype;
-          is_really_const : boolean;
-          constructor init(const n : string;p : pdef;really_const : boolean);
-          constructor inittype(const n : string;const tt : ttype;really_const : boolean);
-          constructor load;
-          destructor done;virtual;
-          function  mangledname : string;virtual;
-          procedure write;virtual;
-          procedure deref;virtual;
-          function  getsize:longint;
-          procedure insert_in_data;virtual;
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-{$endif GDB}
-       end;
-
-       pconstsym = ^tconstsym;
-       tconstsym = object(tsym)
-          consttype  : ttype;
-          consttyp : tconsttyp;
-          resstrindex,    { needed for resource strings }
-          value      : tconstexprint;
-          len        : longint; { len is needed for string length }
-          constructor init(const n : string;t : tconsttyp;v : tconstexprint);
-          constructor init_def(const n : string;t : tconsttyp;v : tconstexprint;def : pdef);
-          constructor init_string(const n : string;t : tconsttyp;str:pchar;l:longint);
-          constructor load;
-          destructor  done;virtual;
-          function  mangledname : string;virtual;
-          procedure deref;virtual;
-          procedure write;virtual;
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-       end;
-
-       tenumsym = object(tsym)
-          value      : longint;
-          definition : penumdef;
-          nextenum   : penumsym;
-          constructor init(const n : string;def : penumdef;v : longint);
-          constructor load;
-          procedure write;virtual;
-          procedure deref;virtual;
-          procedure order;
-{$ifdef GDB}
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-       end;
-
-       psyssym = ^tsyssym;
-       tsyssym = object(tsym)
-          number : longint;
-          constructor init(const n : string;l : longint);
-          constructor load;
-          destructor  done;virtual;
-          procedure write;virtual;
-{$ifdef GDB}
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-       end;
-
-{
-  $Log$
-  Revision 1.7  2000-10-21 18:16:12  florian
-    * a lot of changes:
-       - basic dyn. array support
-       - basic C++ support
-       - some work for interfaces done
-       ....
-
-  Revision 1.6  2000/10/15 07:47:53  peter
-    * unit names and procedure names are stored mixed case
-
-  Revision 1.5  2000/08/27 20:19:40  peter
-    * store strings with case in ppu, when an internal symbol is created
-      a '$' is prefixed so it's not automatic uppercased
-
-  Revision 1.4  2000/08/16 13:06:07  florian
-    + support of 64 bit integer constants
-
-  Revision 1.3  2000/08/13 12:54:56  peter
-    * class member decl wrong then no other error after it
-    * -vb has now also line numbering
-    * -vb is also used for interface/implementation different decls and
-      doesn't list the current function (merged)
-
-  Revision 1.2  2000/07/13 11:32:50  michael
-  + removed logs
-
-}

compiler/symtype.pas

@@ -0,0 +1,578 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl, Pierre Muller
+
+    This unit handles the symbol tables
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ****************************************************************************
+}
+unit symtype;
+
+{$i defines.inc}
+
+interface
+
+    uses
+      { common }
+      cutils,cobjects,
+      { global }
+      globtype,globals,
+      { symtable }
+      symconst,symbase,
+      { aasm }
+      aasm
+      ;
+
+    type
+{************************************************
+                Required Forwards
+************************************************}
+
+      psym = ^tsym;
+
+{************************************************
+                     TRef
+************************************************}
+
+      pref = ^tref;
+      tref = object
+        nextref     : pref;
+        posinfo     : tfileposinfo;
+        moduleindex : word;
+        is_written  : boolean;
+        constructor init(ref:pref;pos:pfileposinfo);
+        procedure   freechain;
+        destructor  done; virtual;
+      end;
+
+{************************************************
+                     TDef
+************************************************}
+
+      tgetsymtable = (gs_none,gs_record,gs_local,gs_para);
+
+      pdef = ^tdef;
+      tdef = object(tdefentry)
+         typesym    : psym;  { which type the definition was generated this def }
+         constructor init;
+         procedure deref;virtual;
+         function  typename:string;
+         function  gettypename:string;virtual;
+         function  size:longint;virtual;abstract;
+         function  alignment:longint;virtual;abstract;
+         function  getsymtable(t:tgetsymtable):psymtable;virtual;
+         function  is_publishable:boolean;virtual;abstract;
+         function  needs_inittable:boolean;virtual;abstract;
+         function  get_rtti_label : string;virtual;abstract;
+      end;
+
+{************************************************
+                     TSym
+************************************************}
+
+      { this object is the base for all symbol objects }
+      tsym = object(tsymentry)
+         _realname  : pstring;
+         fileinfo   : tfileposinfo;
+         symoptions : tsymoptions;
+         constructor init(const n : string);
+         destructor done;virtual;
+         function  realname:string;
+         procedure prederef;virtual; { needed for ttypesym to be deref'd first }
+         procedure deref;virtual;
+         function  gettypedef:pdef;virtual;
+         function  mangledname : string;virtual;abstract;
+      end;
+
+{************************************************
+                   TType
+************************************************}
+
+      ttype = object
+        def : pdef;
+        sym : psym;
+        procedure reset;
+        procedure setdef(p:pdef);
+        procedure setsym(p:psym);
+        procedure load;
+        procedure write;
+        procedure resolve;
+      end;
+
+{************************************************
+                   TSymList
+************************************************}
+
+      psymlistitem = ^tsymlistitem;
+      tsymlistitem = record
+        sym  : psym;
+        next : psymlistitem;
+      end;
+
+      psymlist = ^tsymlist;
+      tsymlist = object
+        def      : pdef;
+        firstsym,
+        lastsym  : psymlistitem;
+        constructor init;
+        constructor load;
+        destructor  done;
+        function  empty:boolean;
+        procedure setdef(p:pdef);
+        procedure addsym(p:psym);
+        procedure clear;
+        function  getcopy:psymlist;
+        procedure resolve;
+        procedure write;
+      end;
+
+
+    { resolving }
+    procedure resolvesym(var sym:psym);
+    procedure resolvedef(var def:pdef);
+
+
+implementation
+
+    uses
+       verbose,
+       ppu,symppu,
+       finput,fmodule;
+
+{****************************************************************************
+                                Tdef
+****************************************************************************}
+
+    constructor tdef.init;
+      begin
+         inherited init;
+         deftype:=abstractdef;
+         owner := nil;
+         typesym := nil;
+      end;
+
+
+    function tdef.typename:string;
+      begin
+        if assigned(typesym) and
+           not(deftype=procvardef) and
+           assigned(typesym^._realname) and
+           (typesym^._realname^[1]<>'$') then
+         typename:=typesym^._realname^
+        else
+         typename:=gettypename;
+      end;
+
+
+    function tdef.gettypename : string;
+      begin
+         gettypename:='<unknown type>'
+      end;
+
+
+    procedure tdef.deref;
+      begin
+        resolvesym(typesym);
+      end;
+
+
+    function tdef.getsymtable(t:tgetsymtable):psymtable;
+      begin
+        getsymtable:=nil;
+      end;
+
+
+{****************************************************************************
+                          TSYM (base for all symtypes)
+****************************************************************************}
+
+    constructor tsym.init(const n : string);
+      begin
+         if n[1]='$' then
+          inherited initname(copy(n,2,255))
+         else
+          inherited initname(upper(n));
+         _realname:=stringdup(n);
+         typ:=abstractsym;
+      end;
+
+
+    destructor tsym.done;
+      begin
+        stringdispose(_realname);
+        inherited done;
+      end;
+
+
+    procedure tsym.prederef;
+      begin
+      end;
+
+
+    procedure tsym.deref;
+      begin
+      end;
+
+    function tsym.realname : string;
+      begin
+        if assigned(_realname) then
+         realname:=_realname^
+        else
+         realname:=name;
+      end;
+
+
+    function tsym.gettypedef:pdef;
+      begin
+        gettypedef:=nil;
+      end;
+
+
+{****************************************************************************
+                               TRef
+****************************************************************************}
+
+    constructor tref.init(ref :pref;pos : pfileposinfo);
+      begin
+        nextref:=nil;
+        if pos<>nil then
+          posinfo:=pos^;
+        if assigned(current_module) then
+          moduleindex:=current_module^.unit_index;
+        if assigned(ref) then
+          ref^.nextref:=@self;
+        is_written:=false;
+      end;
+
+    procedure tref.freechain;
+      var
+        p,q : pref;
+      begin
+        p:=nextref;
+        nextref:=nil;
+        while assigned(p) do
+          begin
+            q:=p^.nextref;
+            dispose(p,done);
+            p:=q;
+          end;
+      end;
+
+    destructor tref.done;
+      var
+         inputfile : pinputfile;
+      begin
+         inputfile:=get_source_file(moduleindex,posinfo.fileindex);
+         if inputfile<>nil then
+           dec(inputfile^.ref_count);
+         nextref:=nil;
+      end;
+
+
+{****************************************************************************
+                                   TType
+****************************************************************************}
+
+    procedure ttype.reset;
+      begin
+        def:=nil;
+        sym:=nil;
+      end;
+
+
+    procedure ttype.setdef(p:pdef);
+      begin
+        def:=p;
+        sym:=nil;
+      end;
+
+
+    procedure ttype.setsym(p:psym);
+      begin
+        sym:=p;
+        def:=p^.gettypedef;
+        if not assigned(def) then
+         internalerror(1234005);
+      end;
+
+
+    procedure ttype.load;
+      begin
+        def:=pdef(readderef);
+        sym:=psym(readderef);
+      end;
+
+
+    procedure ttype.write;
+      begin
+        if assigned(sym) then
+         begin
+           writederef(nil);
+           writederef(sym);
+         end
+        else
+         begin
+           writederef(def);
+           writederef(nil);
+         end;
+      end;
+
+
+    procedure ttype.resolve;
+      begin
+        if assigned(sym) then
+         begin
+           resolvesym(sym);
+           setsym(sym);
+         end
+        else
+         resolvedef(def);
+      end;
+
+{****************************************************************************
+                                 TSymList
+****************************************************************************}
+
+    constructor tsymlist.init;
+      begin
+        def:=nil; { needed for procedures }
+        firstsym:=nil;
+        lastsym:=nil;
+      end;
+
+
+    constructor tsymlist.load;
+      var
+        sym : psym;
+      begin
+        def:=pdef(readderef);
+        firstsym:=nil;
+        lastsym:=nil;
+        repeat
+          sym:=psym(readderef);
+          if sym=nil then
+           break;
+          addsym(sym);
+        until false;
+      end;
+
+
+    destructor tsymlist.done;
+      begin
+        clear;
+      end;
+
+
+    function tsymlist.empty:boolean;
+      begin
+        empty:=(firstsym=nil);
+      end;
+
+
+    procedure tsymlist.clear;
+      var
+        hp : psymlistitem;
+      begin
+        while assigned(firstsym) do
+         begin
+           hp:=firstsym;
+           firstsym:=firstsym^.next;
+           dispose(hp);
+         end;
+        firstsym:=nil;
+        lastsym:=nil;
+        def:=nil;
+      end;
+
+
+    procedure tsymlist.setdef(p:pdef);
+      begin
+        def:=p;
+      end;
+
+
+    procedure tsymlist.addsym(p:psym);
+      var
+        hp : psymlistitem;
+      begin
+        if not assigned(p) then
+         exit;
+        new(hp);
+        hp^.sym:=p;
+        hp^.next:=nil;
+        if assigned(lastsym) then
+         lastsym^.next:=hp
+        else
+         firstsym:=hp;
+        lastsym:=hp;
+      end;
+
+
+    function tsymlist.getcopy:psymlist;
+      var
+        hp  : psymlist;
+        hp2 : psymlistitem;
+      begin
+        new(hp,init);
+        hp^.def:=def;
+        hp2:=firstsym;
+        while assigned(hp2) do
+         begin
+           hp^.addsym(hp2^.sym);
+           hp2:=hp2^.next;
+         end;
+        getcopy:=hp;
+      end;
+
+
+    procedure tsymlist.write;
+      var
+        hp : psymlistitem;
+      begin
+        writederef(def);
+        hp:=firstsym;
+        while assigned(hp) do
+         begin
+           writederef(hp^.sym);
+           hp:=hp^.next;
+         end;
+        writederef(nil);
+      end;
+
+
+    procedure tsymlist.resolve;
+      var
+        hp : psymlistitem;
+      begin
+        resolvedef(def);
+        hp:=firstsym;
+        while assigned(hp) do
+         begin
+           resolvesym(hp^.sym);
+           hp:=hp^.next;
+         end;
+      end;
+
+
+{*****************************************************************************
+                        Symbol / Definition Resolving
+*****************************************************************************}
+
+    procedure resolvederef(var p:pderef;var st:psymtable;var idx:word);
+      var
+        hp : pderef;
+        pd : pdef;
+      begin
+        st:=nil;
+        idx:=0;
+        while assigned(p) do
+         begin
+           case p^.dereftype of
+             derefaktrecordindex :
+               begin
+                 st:=aktrecordsymtable;
+                 idx:=p^.index;
+               end;
+             derefaktstaticindex :
+               begin
+                 st:=aktstaticsymtable;
+                 idx:=p^.index;
+               end;
+             derefaktlocal :
+               begin
+                 st:=aktlocalsymtable;
+                 idx:=p^.index;
+               end;
+             derefunit :
+               begin
+{$ifdef NEWMAP}
+                 st:=psymtable(current_module^.map^[p^.index]^.globalsymtable);
+{$else NEWMAP}
+                 st:=psymtable(current_module^.map^[p^.index]);
+{$endif NEWMAP}
+               end;
+             derefrecord :
+               begin
+                 pd:=pdef(st^.getdefnr(p^.index));
+                 st:=pd^.getsymtable(gs_record);
+                 if not assigned(st) then
+                  internalerror(556658);
+               end;
+             dereflocal :
+               begin
+                 pd:=pdef(st^.getdefnr(p^.index));
+                 st:=pd^.getsymtable(gs_local);
+                 if not assigned(st) then
+                  internalerror(556658);
+               end;
+             derefpara :
+               begin
+                 pd:=pdef(st^.getdefnr(p^.index));
+                 st:=pd^.getsymtable(gs_para);
+                 if not assigned(st) then
+                  internalerror(556658);
+               end;
+             derefindex :
+               begin
+                 idx:=p^.index;
+               end;
+             else
+               internalerror(556658);
+           end;
+           hp:=p;
+           p:=p^.next;
+           dispose(hp,done);
+         end;
+      end;
+
+
+    procedure resolvedef(var def:pdef);
+      var
+        st   : psymtable;
+        idx  : word;
+      begin
+        resolvederef(pderef(def),st,idx);
+        if assigned(st) then
+         def:=pdef(st^.getdefnr(idx))
+        else
+         def:=nil;
+      end;
+
+
+    procedure resolvesym(var sym:psym);
+      var
+        st   : psymtable;
+        idx  : word;
+      begin
+        resolvederef(pderef(sym),st,idx);
+        if assigned(st) then
+         sym:=psym(st^.getsymnr(idx))
+        else
+         sym:=nil;
+      end;
+
+
+
+
+
+
+
+end.
+{
+  $Log$
+  Revision 1.1  2000-10-31 22:02:53  peter
+    * symtable splitted, no real code changes
+
+}

compiler/t_fbsd.pas

@@ -67,7 +67,7 @@ implementation
   uses
     cutils,verbose,cobjects,systems,globtype,globals,
     symconst,script,
-    fmodule,aasm,cpuasm,cpubase,symtable{$IFDEF NEWST},symbols{$ENDIF NEWST};
+    fmodule,aasm,cpuasm,cpubase,symsym;
 
 {*****************************************************************************
                                TIMPORTLIBLINUX
@@ -457,7 +457,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-09-24 21:33:47  peter
+  Revision 1.4  2000-10-31 22:02:53  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.3  2000/09/24 21:33:47  peter
     * message updates merges
 
   Revision 1.2  2000/09/24 15:12:12  peter
@@ -465,4 +468,4 @@ end.
 
   Revision 1.2  2000/09/16 12:24:00  peter
     * freebsd support routines
-}
+}

compiler/t_linux.pas

@@ -66,7 +66,7 @@ implementation
   uses
     cutils,verbose,cobjects,systems,globtype,globals,
     symconst,script,
-    fmodule,aasm,cpuasm,cpubase,symtable{$IFDEF NEWST},symbols{$ENDIF NEWST};
+    fmodule,aasm,cpuasm,cpubase,symsym;
 
 {*****************************************************************************
                                TIMPORTLIBLINUX
@@ -455,7 +455,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.7  2000-09-24 21:33:47  peter
+  Revision 1.8  2000-10-31 22:02:54  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.7  2000/09/24 21:33:47  peter
     * message updates merges
 
   Revision 1.6  2000/09/24 15:06:31  peter

compiler/t_nwm.pas

@@ -119,7 +119,7 @@ implementation
   uses
     cutils,verbose,cobjects,systems,globtype,globals,
     symconst,script,
-    fmodule,aasm,cpuasm,cpubase,symtable{$IFDEF NEWST},symbols{$ENDIF NEWST};
+    fmodule,aasm,cpuasm,cpubase,symsym;
 
 {*****************************************************************************
                                TIMPORTLIBNETWARE
@@ -424,11 +424,14 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2000-09-24 15:06:31  peter
+  Revision 1.3  2000-10-31 22:02:55  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.2  2000/09/24 15:06:31  peter
     * use defines.inc
 
   Revision 1.1  2000/09/11 17:00:23  florian
     + first implementation of Netware Module support, thanks to
       Armin Diehl ([email protected]) for providing the patches
 
-}
+}

compiler/types.pas

@@ -30,7 +30,7 @@ interface
        cobjects,
        cpuinfo,
        node,
-       symtable;
+       symbase,symtype,symdef,symsym;
 
     type
        tmmxtype = (mmxno,mmxu8bit,mmxs8bit,mmxu16bit,mmxs16bit,
@@ -233,8 +233,8 @@ interface
 implementation
 
     uses
-       globtype,globals,
-       verbose,symconst,tokens;
+       globtype,globals,tokens,verbose,
+       symconst,symtable;
 
     var
        b_needs_init_final : boolean;
@@ -245,7 +245,7 @@ implementation
            assigned(pvarsym(p)^.vartype.def) and
            not((pvarsym(p)^.vartype.def^.deftype=objectdef) and
            pobjectdef(pvarsym(p)^.vartype.def)^.is_class) and
-           pvarsym(p)^.vartype.def^.needs_inittable then
+           pstoreddef(pvarsym(p)^.vartype.def)^.needs_inittable then
            b_needs_init_final:=true;
       end;
 
@@ -1684,7 +1684,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.15  2000-10-21 18:16:12  florian
+  Revision 1.16  2000-10-31 22:02:55  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.15  2000/10/21 18:16:12  florian
     * a lot of changes:
        - basic dyn. array support
        - basic C++ support

compiler/verbose.pas

@@ -31,6 +31,7 @@ interface
 
 uses
   cutils,cobjects,
+  finput,
   messages;
 
 {$ifndef EXTERN_MSG}
@@ -71,6 +72,7 @@ function  SetVerbosity(const s:string):boolean;
 
 procedure LoadMsgFile(const fn:string);
 
+procedure SetCompileModule(p:pmodulebase);
 procedure Stop;
 procedure ShowStatus;
 function  ErrorCount:longint;
@@ -94,11 +96,12 @@ procedure DoneVerbose;
 
 implementation
 uses
-  fmodule,comphook,
+  comphook,
   version,globals;
 
 var
-  redirexitsave : pointer;
+  redirexitsave  : pointer;
+  current_module : pmodulebase;
 
 {****************************************************************************
                        Extra Handlers for default compiler
@@ -290,6 +293,12 @@ begin
 end;
 
 
+procedure SetCompileModule(p:pmodulebase);
+begin
+  current_module:=p;
+end;
+
+
 var
   lastfileidx,
   lastmoduleidx : longint;
@@ -298,7 +307,8 @@ begin
 { fix status }
   status.currentline:=aktfilepos.line;
   status.currentcolumn:=aktfilepos.column;
-  if assigned(current_module) and assigned(current_module^.sourcefiles) and
+  if assigned(current_module) and
+     assigned(current_module^.sourcefiles) and
      ((current_module^.unit_index<>lastmoduleidx) or
       (aktfilepos.fileindex<>lastfileidx)) then
    begin
@@ -616,7 +626,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.6  2000-09-24 21:33:48  peter
+  Revision 1.7  2000-10-31 22:02:55  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.6  2000/09/24 21:33:48  peter
     * message updates merges
 
   Revision 1.5  2000/09/24 15:06:33  peter
@@ -635,4 +648,4 @@ end.
   Revision 1.2  2000/07/13 11:32:54  michael
   + removed logs
 
-}
+}