* symtablestack cleanup and rewrite

git-svn-id: trunk@2448 -

compiler/browlog.pas

@@ -286,7 +286,7 @@ implementation
           looking for the symbol !! }
          make_ref:=false;
          s:=sr;
-         symt:=symtablestack;
+         symt:=symtablestack.top;
          next_substring;
          if assigned(symt) then
            begin
@@ -299,7 +299,7 @@ implementation
          if assigned(sym) and (sym.typ=unitsym) and (s<>'') then
            begin
               addlog('Unitsym found !');
-              symt:=tunitsym(sym).unitsymtable;
+              symt:=tmodule(tunitsym(sym).module).globalsymtable;
               if assigned(symt) then
                 begin
                    next_substring;
@@ -432,7 +432,6 @@ implementation
     procedure writesymtable(p:tsymtable);
       var
         hp : tsym;
-        prdef : pprocdeflist;
       begin
         if cs_browser in aktmoduleswitches then
          begin

compiler/cg64f32.pas

@@ -89,7 +89,7 @@ unit cg64f32;
     uses
        globtype,systems,
        verbose,
-       symbase,symconst,symdef,defutil,paramgr;
+       symbase,symconst,symdef,symtable,defutil,paramgr;
 
 {****************************************************************************
                                      Helpers
@@ -566,7 +566,6 @@ unit cg64f32;
         hreg   : tregister;
         hdef   :  torddef;
         opsize   : tcgsize;
-        oldregisterdef: boolean;
         from_signed,to_signed: boolean;
         temploc : tlocation;
 
@@ -576,9 +575,6 @@ unit cg64f32;
 
          if not is_64bit(todef) then
            begin
-             oldregisterdef := registerdef;
-             registerdef := false;
-
              { get the high dword in a register }
              if l.loc in [LOC_REGISTER,LOC_CREGISTER] then
                begin
@@ -650,7 +646,6 @@ unit cg64f32;
                  hdef.free;
                  cg.a_label(list,endlabel);
                end;
-             registerdef := oldregisterdef;
            end
          else
            { todef = 64bit int }

compiler/dbgdwarf.pas

@@ -1855,17 +1855,7 @@ implementation
 
 
     procedure TDebugInfoDwarf.inserttypeinfo;
-
-      function gettypedef(const s : string) : tdef;
-        var
-          srsym : ttypesym;
-        begin
-          if not(searchsystype('TVARDATA',srsym)) then
-            internalerror(200602022);
-          result:=ttypesym(srsym).restype.def;
-        end;
-
-      var
+     var
         storefilepos  : tfileposinfo;
         lenstartlabel : tasmlabel;
       begin
@@ -1875,7 +1865,7 @@ implementation
         currabbrevnumber:=0;
         writing_def_dwarf:=false;
 
-        vardatadef:=gettypedef('TVARDATA');
+        vardatadef:=search_system_type('TVARDATA').restype.def;
 
         { not exported (FK)
         filerecdef:=gettypedef('FILEREC');

compiler/htypechk.pas

@@ -869,7 +869,6 @@ implementation
       var
         hp : tnode;
         gotstring,
-        gotwith,
         gotsubscript,
         gotrecord,
         gotpointer,
@@ -892,7 +891,6 @@ implementation
         gotrecord:=false;
         gotclass:=false;
         gotpointer:=false;
-        gotwith:=false;
         gotdynarray:=false;
         gotstring:=false;
         hp:=p;
@@ -947,7 +945,7 @@ implementation
                          (gotstring and gotvec) or
                          (
                           (gotclass or gotrecord) and
-                          (gotsubscript or gotwith)
+                          (gotsubscript)
                          ) or
                          (
                            (gotvec and gotdynarray)
@@ -1067,7 +1065,7 @@ implementation
                        CGMessage1(parser_e_illegal_assignment_to_count_var,tsubscriptnode(hp).vs.realname)
                      else
                        exit;
-                   end;                     
+                   end;
                  { a class/interface access is an implicit }
                  { dereferencing                           }
                  hp:=tsubscriptnode(hp).left;
@@ -1152,7 +1150,7 @@ implementation
                    3. string is returned }
                  if (gotstring and gotvec) or
                     (gotpointer and gotderef) or
-                    (gotclass and (gotsubscript or gotwith)) then
+                    (gotclass and gotsubscript) then
                   result:=true
                  else
                  { Temp strings are stored in memory, for compatibility with
@@ -1206,19 +1204,8 @@ implementation
                             CGMessagePos(tloadnode(hp).fileinfo,type_e_no_assign_to_const);
                           exit;
                         end;
-                       { Are we at a with symtable, then we need to process the
-                         withrefnode also to check for maybe a const load }
-                       if (tloadnode(hp).symtable.symtabletype=withsymtable) then
-                        begin
-                          { continue with processing the withref node }
-                          hp:=tnode(twithsymtable(tloadnode(hp).symtable).withrefnode);
-                          gotwith:=true;
-                        end
-                       else
-                        begin
-                          result:=true;
-                          exit;
-                        end;
+                       result:=true;
+                       exit;
                      end;
                    typedconstsym :
                      begin
@@ -1456,7 +1443,7 @@ implementation
         srsymtable : tsymtable;
         srprocsym  : tprocsym;
         pt         : tcallparanode;
-
+        checkstack : psymtablestackitem;
       begin
         if not assigned(sym) then
           internalerror(200411015);
@@ -1543,9 +1530,18 @@ implementation
         if has_overload_directive and
            (sym.owner.symtabletype<>objectsymtable) then
           begin
-            srsymtable:=sym.owner.next;
-            while assigned(srsymtable) do
+            srsymtable:=sym.owner;
+            checkstack:=symtablestack.stack;
+            while assigned(checkstack) and
+                  (checkstack^.symtable<>srsymtable) do
+              checkstack:=checkstack^.next;
+            { we've already processed the current symtable, start with
+              the next symtable in the stack }
+            if assigned(checkstack) then
+              checkstack:=checkstack^.next;
+            while assigned(checkstack) do
              begin
+               srsymtable:=checkstack^.symtable;
                if srsymtable.symtabletype in [localsymtable,staticsymtable,globalsymtable] then
                 begin
                   srprocsym:=tprocsym(srsymtable.speedsearch(sym.name,sym.speedvalue));
@@ -1589,7 +1585,7 @@ implementation
                       end;
                    end;
                 end;
-               srsymtable:=srsymtable.next;
+               checkstack:=checkstack^.next;
              end;
           end;
       end;
@@ -1605,6 +1601,7 @@ implementation
         srprocsym  : tprocsym;
         pt         : tcallparanode;
         sv         : cardinal;
+        checkstack : psymtablestackitem;
       begin
         FProcSym:=nil;
         FProcs:=nil;
@@ -1628,9 +1625,10 @@ implementation
           entries are only added to the procs list and not the procsym, because
           the list can change in every situation }
         sv:=getspeedvalue(overloaded_names[op]);
-        srsymtable:=symtablestack;
-        while assigned(srsymtable) do
+        checkstack:=symtablestack.stack;
+        while assigned(checkstack) do
           begin
+            srsymtable:=checkstack^.symtable;
             if srsymtable.symtabletype in [localsymtable,staticsymtable,globalsymtable] then
               begin
                 srprocsym:=tprocsym(srsymtable.speedsearch(overloaded_names[op],sv));
@@ -1668,7 +1666,7 @@ implementation
                       end;
                   end;
               end;
-            srsymtable:=srsymtable.next;
+            checkstack:=checkstack^.next;
           end;
       end;
 

compiler/nadd.pas

@@ -1612,9 +1612,7 @@ implementation
         srsym: ttypesym;
       begin
         { get the sym that represents the fpc_normal_set type }
-        if not searchsystype('FPC_NORMAL_SET',srsym) then
-          internalerror(200108313);
-
+        srsym:=search_system_type('FPC_NORMAL_SET');
         case nodetype of
           equaln,unequaln,lten,gten:
             begin

compiler/ncal.pas

@@ -834,23 +834,15 @@ type
      constructor tcallnode.createintern(const name: string; params: tnode);
        var
          srsym: tsym;
-         symowner: tsymtable;
        begin
-         if not (cs_compilesystem in aktmoduleswitches) then
-           begin
-             srsym := searchsymonlyin(systemunit,name);
-             symowner := systemunit;
-           end
-         else
-           begin
-             searchsym(name,srsym,symowner);
-             if not assigned(srsym) then
-               searchsym(upper(name),srsym,symowner);
-           end;
+         srsym := tsym(systemunit.search(name));
+         if not assigned(srsym) and
+            (cs_compilesystem in aktmoduleswitches) then
+           srsym := tsym(systemunit.search(upper(name)));
          if not assigned(srsym) or
             (srsym.typ<>procsym) then
            Message1(cg_f_unknown_compilerproc,name);
-         self.create(params,tprocsym(srsym),symowner,nil,[]);
+         self.create(params,tprocsym(srsym),srsym.owner,nil,[]);
        end;
 
 

compiler/ncgutil.pas

@@ -144,7 +144,7 @@ interface
 
     procedure location_free(list: taasmoutput; const location : TLocation);
 
-    function getprocalign : longint;
+    function getprocalign : shortint;
 
     procedure gen_pic_helpers(list : taasmoutput);
     procedure gen_got_load(list : taasmoutput);
@@ -350,12 +350,12 @@ implementation
 
     procedure get_exception_temps(list:taasmoutput;var t:texceptiontemps);
       var
-        sym : ttypesym;
+        srsym : ttypesym;
       begin
         if jmp_buf_size=-1 then
           begin
-            searchsystype('JMP_BUF',sym);
-            jmp_buf_size:=sym.restype.def.size;
+            srsym:=search_system_type('JMP_BUF');
+            jmp_buf_size:=srsym.restype.def.size;
           end;
         tg.GetTemp(list,EXCEPT_BUF_SIZE,tt_persistent,t.envbuf);
         tg.GetTemp(list,jmp_buf_size,tt_persistent,t.jmpbuf);
@@ -2425,7 +2425,7 @@ implementation
       end;
 
 
-    function getprocalign : longint;
+    function getprocalign : shortint;
       begin
         { gprof uses 16 byte granularity }
         if (cs_profile in aktmoduleswitches) then

compiler/ncnv.pas

@@ -2011,8 +2011,7 @@ implementation
         p: tcallparanode;
 
       begin
-        if not searchsystype('FPC_SMALL_SET',srsym) then
-          internalerror(200108313);
+        srsym:=search_system_type('FPC_SMALL_SET');
         p := ccallparanode.create(left,nil);
         { reused }
         left := nil;

compiler/ninl.pas

@@ -399,8 +399,7 @@ implementation
             { create a new fileparameter as follows: file_type(temp^)    }
             { (so that we pass the value and not the address of the temp }
             { to the read/write routine)                                 }
-            if not searchsystype('TEXT',textsym) then
-              internalerror(200108313);
+            textsym:=search_system_type('TEXT');
             filepara := ccallparanode.create(ctypeconvnode.create_internal(
               cderefnode.create(ctemprefnode.create(filetemp)),textsym.restype),nil);
           end
@@ -1692,7 +1691,7 @@ implementation
                 begin
                   resulttype:=voidtype;
                   { now we know the type of buffer }
-                  srsym:=searchsymonlyin(systemunit,'SETTEXTBUF');
+                  srsym:=search_system_type('SETTEXTBUF');
                   hp:=ccallparanode.create(cordconstnode.create(
                      tcallparanode(left).left.resulttype.def.size,s32inttype,true),left);
                   result:=ccallnode.create(hp,tprocsym(srsym),systemunit,nil,[]);

compiler/nmem.pas

@@ -100,10 +100,7 @@ interface
        tvecnodeclass = class of tvecnode;
 
        twithnode = class(tunarynode)
-          withsymtable  : twithsymtable;
-          tablecount    : longint;
-          withrefnode   : tnode;
-          constructor create(l:tnode;symtable:twithsymtable;count:longint;r:tnode);
+          constructor create(l:tnode);
           destructor destroy;override;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -697,16 +694,18 @@ implementation
            pointerdef :
              begin
                { are we accessing a pointer[], then convert the pointer to
-                 an array first, in FPC this is allowed for all pointers in
-                 delphi/tp7 it's only allowed for pchars }
-               if (m_fpc in aktmodeswitches) or
-                  is_pchar(left.resulttype.def) or
-                  is_pwidechar(left.resulttype.def) then
+                 an array first, in FPC this is allowed for all pointers
+                 (except voidpointer) in delphi/tp7 it's only allowed for pchars. }
+               if not is_voidpointer(left.resulttype.def) and
+                  (
+                   (m_fpc in aktmodeswitches) or
+                   is_pchar(left.resulttype.def) or
+                   is_pwidechar(left.resulttype.def)
+                  ) then
                 begin
                   { convert pointer to array }
                   htype.setdef(tarraydef.create_from_pointer(tpointerdef(left.resulttype.def).pointertype));
                   inserttypeconv(left,htype);
-
                   resulttype:=tarraydef(htype.def).elementtype;
                 end
                else
@@ -843,32 +842,15 @@ implementation
                                TWITHNODE
 *****************************************************************************}
 
-    constructor twithnode.create(l:tnode;symtable:twithsymtable;count:longint;r:tnode);
+    constructor twithnode.create(l:tnode);
       begin
          inherited create(withn,l);
-         withrefnode:=r;
-         withsymtable:=symtable;
-         tablecount:=count;
          fileinfo:=l.fileinfo;
       end;
 
 
     destructor twithnode.destroy;
-      var
-        hsymt,
-        symt : tsymtable;
-        i    : longint;
       begin
-        symt:=withsymtable;
-        for i:=1 to tablecount do
-         begin
-           if assigned(symt) then
-            begin
-              hsymt:=symt.next;
-              symt.free;
-              symt:=hsymt;
-            end;
-         end;
         inherited destroy;
       end;
 
@@ -876,30 +858,20 @@ implementation
     constructor twithnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
       begin
         inherited ppuload(t,ppufile);
-        internalerror(200208192);
       end;
 
 
     procedure twithnode.ppuwrite(ppufile:tcompilerppufile);
       begin
         inherited ppuwrite(ppufile);
-        internalerror(200208193);
       end;
 
 
     function twithnode._getcopy : tnode;
-
       var
          p : twithnode;
-
       begin
          p:=twithnode(inherited _getcopy);
-         p.withsymtable:=withsymtable;
-         p.tablecount:=tablecount;
-         if assigned(p.withrefnode) then
-           p.withrefnode:=withrefnode._getcopy
-         else
-           p.withrefnode:=nil;
          result:=p;
       end;
 
@@ -908,16 +880,6 @@ implementation
       begin
         result:=nil;
         resulttype:=voidtype;
-
-        resulttypepass(withrefnode);
-        set_varstate(withrefnode,vs_read,[vsf_must_be_valid]);
-        if codegenerror then
-         exit;
-
-        if (withrefnode.nodetype=vecn) and
-           (nf_memseg in withrefnode.flags) then
-          CGMessage(parser_e_no_with_for_variable_in_other_segments);
-
         if assigned(left) then
           resulttypepass(left);
       end;
@@ -927,38 +889,18 @@ implementation
       begin
         result:=nil;
         expectloc:=LOC_VOID;
-
-        if assigned(left) then
-         begin
-           firstpass(left);
-           registersint:=left.registersint;
-           registersfpu:=left.registersfpu;
-{$ifdef SUPPORT_MMX}
-           registersmmx:=left.registersmmx;
-{$endif SUPPORT_MMX}
-         end;
-        if assigned(withrefnode) then
-          begin
-            firstpass(withrefnode);
-            if withrefnode.registersint > registersint then
-              registersint:=withrefnode.registersint;
-            if withrefnode.registersfpu > registersfpu then
-              registersint:=withrefnode.registersfpu;
+        registersint:=left.registersint;
+        registersfpu:=left.registersfpu;
 {$ifdef SUPPORT_MMX}
-            if withrefnode.registersmmx > registersmmx then
-              registersmmx:=withrefnode.registersmmx;
+        registersmmx:=left.registersmmx;
 {$endif SUPPORT_MMX}
-          end;
       end;
 
 
     function twithnode.docompare(p: tnode): boolean;
       begin
         docompare :=
-          inherited docompare(p) and
-          (withsymtable = twithnode(p).withsymtable) and
-          (tablecount = twithnode(p).tablecount) and
-          (withrefnode.isequal(twithnode(p).withrefnode));
+          inherited docompare(p);
       end;
 
 begin

compiler/nset.pas

@@ -102,17 +102,9 @@ interface
     { counts the labels }
     function case_count_labels(root : pcaselabel) : longint;
     { searches the highest label }
-{$ifdef int64funcresok}
     function case_get_max(root : pcaselabel) : tconstexprint;
-{$else int64funcresok}
-    function case_get_max(root : pcaselabel) : longint;
-{$endif int64funcresok}
     { searches the lowest label }
-{$ifdef int64funcresok}
     function case_get_min(root : pcaselabel) : tconstexprint;
-{$else int64funcresok}
-    function case_get_min(root : pcaselabel) : longint;
-{$endif int64funcresok}
 
 
 implementation
@@ -399,11 +391,7 @@ implementation
       end;
 
 
-{$ifdef int64funcresok}
     function case_get_max(root : pcaselabel) : tconstexprint;
-{$else int64funcresok}
-    function case_get_max(root : pcaselabel) : longint;
-{$endif int64funcresok}
       var
          hp : pcaselabel;
       begin
@@ -414,11 +402,7 @@ implementation
       end;
 
 
-{$ifdef int64funcresok}
     function case_get_min(root : pcaselabel) : tconstexprint;
-{$else int64funcresok}
-    function case_get_min(root : pcaselabel) : longint;
-{$endif int64funcresok}
       var
          hp : pcaselabel;
       begin

compiler/nutils.pas

@@ -276,14 +276,12 @@ implementation
     function load_high_value_node(vs:tparavarsym):tnode;
       var
         srsym : tsym;
-        srsymtable : tsymtable;
       begin
         result:=nil;
-        srsymtable:=vs.owner;
-        srsym:=searchsymonlyin(srsymtable,'high'+vs.name);
+        srsym:=tsym(vs.owner.search('high'+vs.name));
         if assigned(srsym) then
           begin
-            result:=cloadnode.create(srsym,srsymtable);
+            result:=cloadnode.create(srsym,vs.owner);
             resulttypepass(result);
           end
         else

compiler/options.pas

@@ -382,7 +382,6 @@ var
   error : integer;
   j,l  : longint;
   d    : DirStr;
-  e    : ExtStr;
   s    : string;
 begin
   if opt='' then

compiler/parser.pas

@@ -178,7 +178,6 @@ implementation
          current_module.localmacrosymtable:= tmacrosymtable.create(false);
          current_module.localmacrosymtable.next:= initialmacrosymtable;
          macrosymtablestack:= current_module.localmacrosymtable;
-         ConsolidateMode;
 
          main_module:=current_module;
        { startup scanner, and save in current_module }
@@ -306,11 +305,8 @@ implementation
           oldorgpattern  : string;
           old_block_type : tblock_type;
         { symtable }
-          oldrefsymtable,
-          olddefaultsymtablestack,
-          oldsymtablestack : tsymtable;
-          olddefaultmacrosymtablestack,
-          oldmacrosymtablestack : tsymtable;
+          oldsymtablestack,
+          oldmacrosymtablestack : tsymtablestack;
           oldaktprocsym    : tprocsym;
         { cg }
           oldparse_only  : boolean;
@@ -355,9 +351,6 @@ implementation
           { save symtable state }
             oldsymtablestack:=symtablestack;
             oldmacrosymtablestack:=macrosymtablestack;
-            olddefaultsymtablestack:=defaultsymtablestack;
-            olddefaultmacrosymtablestack:=defaultmacrosymtablestack;
-            oldrefsymtable:=refsymtable;
             oldcurrent_procinfo:=current_procinfo;
             oldaktdefproccall:=aktdefproccall;
           { save scanner state }
@@ -408,14 +401,10 @@ implementation
          Message1(parser_i_compiling,filename);
 
        { reset symtable }
-         symtablestack:=nil;
-         macrosymtablestack:=nil;
-         defaultsymtablestack:=nil;
-         defaultmacrosymtablestack:=nil;
+         symtablestack:=tsymtablestack.create;
+         macrosymtablestack:=tsymtablestack.create;
          systemunit:=nil;
-         refsymtable:=nil;
          aktdefproccall:=initdefproccall;
-         registerdef:=true;
          aktexceptblock:=0;
          exceptblockcounter:=0;
          aktmaxfpuregisters:=-1;
@@ -461,10 +450,9 @@ implementation
          current_module.scanner:=current_scanner;
 
          { init macros before anything in the file is parsed.}
-         macrosymtablestack:= initialmacrosymtable;
          current_module.localmacrosymtable:= tmacrosymtable.create(false);
-         current_module.localmacrosymtable.next:= initialmacrosymtable;
-         macrosymtablestack:= current_module.localmacrosymtable;
+         macrosymtablestack.push(initialmacrosymtable);
+         macrosymtablestack.push(current_module.localmacrosymtable);
 
          { read the first token }
          current_scanner.readtoken(false);
@@ -499,117 +487,120 @@ implementation
            done_module;
 
            if assigned(current_module) then
-            begin
-              { module is now compiled }
-              tppumodule(current_module).state:=ms_compiled;
-
-              { free ppu }
-              if assigned(tppumodule(current_module).ppufile) then
-               begin
-                 tppumodule(current_module).ppufile.free;
-                 tppumodule(current_module).ppufile:=nil;
-               end;
+             begin
+               { module is now compiled }
+               tppumodule(current_module).state:=ms_compiled;
 
-              { free scanner }
-              if assigned(current_module.scanner) then
-               begin
-                 if current_scanner=tscannerfile(current_module.scanner) then
-                   current_scanner:=nil;
-                 tscannerfile(current_module.scanner).free;
-                 current_module.scanner:=nil;
-               end;
-            end;
+               { free ppu }
+               if assigned(tppumodule(current_module).ppufile) then
+                 begin
+                   tppumodule(current_module).ppufile.free;
+                   tppumodule(current_module).ppufile:=nil;
+                 end;
 
-           if (compile_level>1) then
-             begin
-                with olddata^ do
+               { free scanner }
+               if assigned(current_module.scanner) then
                  begin
-                   { restore scanner }
-                   c:=oldc;
-                   pattern:=oldpattern;
-                   orgpattern:=oldorgpattern;
-                   token:=oldtoken;
-                   idtoken:=oldidtoken;
-                   akttokenpos:=oldtokenpos;
-                   block_type:=old_block_type;
-                   { restore cg }
-                   parse_only:=oldparse_only;
-                   { restore asmlists }
-                   exprasmlist:=oldexprasmlist;
-                   asmlist:=oldasmlist;
-                   { object data }
-                   resourcestrings:=oldresourcestrings;
-                   objectlibrary:=oldobjectlibrary;
-                   { restore previous scanner }
-                   if assigned(old_compiled_module) then
-                     current_scanner:=tscannerfile(old_compiled_module.scanner)
-                   else
+                   if current_scanner=tscannerfile(current_module.scanner) then
                      current_scanner:=nil;
-                   if assigned(current_scanner) then
-                     parser_current_file:=current_scanner.inputfile.name^;
-                   { restore symtable state }
-                   refsymtable:=oldrefsymtable;
-                   symtablestack:=oldsymtablestack;
-                   macrosymtablestack:=oldmacrosymtablestack;
-                   defaultsymtablestack:=olddefaultsymtablestack;
-                   defaultmacrosymtablestack:=olddefaultmacrosymtablestack;
-                   aktdefproccall:=oldaktdefproccall;
-                   current_procinfo:=oldcurrent_procinfo;
-                   aktsourcecodepage:=oldsourcecodepage;
-                   aktlocalswitches:=oldaktlocalswitches;
-                   aktmoduleswitches:=oldaktmoduleswitches;
-                   aktalignment:=oldaktalignment;
-                   aktpackenum:=oldaktpackenum;
-                   aktpackrecords:=oldaktpackrecords;
-                   aktmaxfpuregisters:=oldaktmaxfpuregisters;
-                   aktoptprocessor:=oldaktoptprocessor;
-                   aktspecificoptprocessor:=oldaktspecificoptprocessor;
-                   aktfputype:=oldaktfputype;
-                   aktasmmode:=oldaktasmmode;
-                   aktinterfacetype:=oldaktinterfacetype;
-                   aktfilepos:=oldaktfilepos;
-                   aktmodeswitches:=oldaktmodeswitches;
-                   aktexceptblock:=0;
-                   exceptblockcounter:=0;
+                   tscannerfile(current_module.scanner).free;
+                   current_module.scanner:=nil;
                  end;
-             end
-           else
-             begin
-               { Shut down things when the last file is compiled succesfull }
-               if (compile_level=1) and
-                  (status.errorcount=0) then
+
+               { free symtable stack }
+               if assigned(symtablestack) then
+                 begin
+                   symtablestack.free;
+                   symtablestack:=nil;
+                 end;
+               if assigned(macrosymtablestack) then
+                 begin
+                   macrosymtablestack.free;
+                   macrosymtablestack:=nil;
+                 end;
+             end;
+
+            with olddata^ do
+              begin
+                { restore scanner }
+                c:=oldc;
+                pattern:=oldpattern;
+                orgpattern:=oldorgpattern;
+                token:=oldtoken;
+                idtoken:=oldidtoken;
+                akttokenpos:=oldtokenpos;
+                block_type:=old_block_type;
+                { restore cg }
+                parse_only:=oldparse_only;
+                { restore asmlists }
+                exprasmlist:=oldexprasmlist;
+                asmlist:=oldasmlist;
+                { object data }
+                resourcestrings:=oldresourcestrings;
+                objectlibrary:=oldobjectlibrary;
+                { restore previous scanner }
+                if assigned(old_compiled_module) then
+                  current_scanner:=tscannerfile(old_compiled_module.scanner)
+                else
+                  current_scanner:=nil;
+                if assigned(current_scanner) then
+                  parser_current_file:=current_scanner.inputfile.name^;
+                { restore symtable state }
+                symtablestack:=oldsymtablestack;
+                macrosymtablestack:=oldmacrosymtablestack;
+                aktdefproccall:=oldaktdefproccall;
+                current_procinfo:=oldcurrent_procinfo;
+                aktsourcecodepage:=oldsourcecodepage;
+                aktlocalswitches:=oldaktlocalswitches;
+                aktmoduleswitches:=oldaktmoduleswitches;
+                aktalignment:=oldaktalignment;
+                aktpackenum:=oldaktpackenum;
+                aktpackrecords:=oldaktpackrecords;
+                aktmaxfpuregisters:=oldaktmaxfpuregisters;
+                aktoptprocessor:=oldaktoptprocessor;
+                aktspecificoptprocessor:=oldaktspecificoptprocessor;
+                aktfputype:=oldaktfputype;
+                aktasmmode:=oldaktasmmode;
+                aktinterfacetype:=oldaktinterfacetype;
+                aktfilepos:=oldaktfilepos;
+                aktmodeswitches:=oldaktmodeswitches;
+                aktexceptblock:=0;
+                exceptblockcounter:=0;
+              end;
+            { Shut down things when the last file is compiled succesfull }
+            if (compile_level=1) and
+                (status.errorcount=0) then
+              begin
+                parser_current_file:='';
+                { Close script }
+                if (not AsmRes.Empty) then
+                begin
+                  Message1(exec_i_closing_script,AsmRes.Fn);
+                  AsmRes.WriteToDisk;
+                end;
+
+                { do not create browsers on errors !! }
+                if status.errorcount=0 then
                 begin
-                  parser_current_file:='';
-                  { Close script }
-                  if (not AsmRes.Empty) then
-                   begin
-                     Message1(exec_i_closing_script,AsmRes.Fn);
-                     AsmRes.WriteToDisk;
-                   end;
-
-                  { do not create browsers on errors !! }
-                  if status.errorcount=0 then
-                   begin
 {$ifdef BrowserLog}
-                     { Write Browser Log }
-                     if (cs_browser_log in aktglobalswitches) and
-                        (cs_browser in aktmoduleswitches) then
+                  { Write Browser Log }
+                  if (cs_browser_log in aktglobalswitches) and
+                      (cs_browser in aktmoduleswitches) then
+                    begin
+                      if browserlog.elements_to_list.empty then
                       begin
-                        if browserlog.elements_to_list.empty then
-                         begin
-                           Message1(parser_i_writing_browser_log,browserlog.Fname);
-                           WriteBrowserLog;
-                         end
-                        else
-                         browserlog.list_elements;
-                      end;
+                        Message1(parser_i_writing_browser_log,browserlog.Fname);
+                        WriteBrowserLog;
+                      end
+                      else
+                      browserlog.list_elements;
+                    end;
 {$endif BrowserLog}
-                     { Write Browser Collections, also used by the TextMode IDE to
-                       retrieve a list of sourcefiles }
-                     do_extractsymbolinfo{$ifdef FPC}(){$endif};
-                   end;
+                  { Write Browser Collections, also used by the TextMode IDE to
+                    retrieve a list of sourcefiles }
+                  do_extractsymbolinfo{$ifdef FPC}(){$endif};
                 end;
-             end;
+              end;
 
            dec(compile_level);
            compiled_module:=olddata^.old_compiled_module;

compiler/pbase.pas

@@ -52,9 +52,6 @@ interface
        { for operators }
        optoken : ttoken;
 
-       { symtable were unit references are stored }
-       refsymtable : tsymtable;
-
        { true, if only routine headers should be parsed }
        parse_only : boolean;
 
@@ -85,6 +82,8 @@ interface
       and return an errorsym }
     function consume_sym(var srsym:tsym;var srsymtable:tsymtable):boolean;
 
+    function try_consume_unitsym(var srsym:tsym;var srsymtable:tsymtable):boolean;
+
     function try_consume_hintdirective(var symopt:tsymoptions):boolean;
 
     { just for an accurate position of the end of a procedure (PM) }
@@ -179,43 +178,53 @@ implementation
       begin
         { first check for identifier }
         if token<>_ID then
-         begin
-           consume(_ID);
-           srsym:=generrorsym;
-           srsymtable:=nil;
-           consume_sym:=false;
-           exit;
-         end;
+          begin
+            consume(_ID);
+            srsym:=generrorsym;
+            srsymtable:=nil;
+            result:=false;
+            exit;
+          end;
         searchsym(pattern,srsym,srsymtable);
-        if assigned(srsym) then
-         begin
-           check_hints(srsym,srsym.symoptions);
-           if (srsym.typ=unitsym) then
-            begin
-              if not(srsym.owner.symtabletype in [staticsymtable,globalsymtable]) then
-                internalerror(200501154);
-              { only allow unit.symbol access if the name was
-                found in the current module }
-              if srsym.owner.iscurrentunit then
-               begin
-                 consume(_ID);
-                 consume(_POINT);
-                 srsymtable:=tunitsym(srsym).unitsymtable;
-                 srsym:=searchsymonlyin(srsymtable,pattern);
-               end
-              else
-               srsym:=nil;
-            end;
-         end;
+        { handle unit specification like System.Writeln }
+        try_consume_unitsym(srsym,srsymtable);
         { if nothing found give error and return errorsym }
-        if srsym=nil then
-         begin
-           identifier_not_found(orgpattern);
-           srsym:=generrorsym;
-           srsymtable:=nil;
-         end;
+        if assigned(srsym) then
+          check_hints(srsym,srsym.symoptions)
+        else
+          begin
+            identifier_not_found(orgpattern);
+            srsym:=generrorsym;
+            srsymtable:=nil;
+          end;
         consume(_ID);
-        consume_sym:=assigned(srsym);
+        result:=assigned(srsym);
+      end;
+
+
+    function try_consume_unitsym(var srsym:tsym;var srsymtable:tsymtable):boolean;
+      begin
+        result:=false;
+        if assigned(srsym) and
+           (srsym.typ=unitsym) then
+          begin
+            if not(srsym.owner.symtabletype in [staticsymtable,globalsymtable]) then
+              internalerror(200501154);
+            { only allow unit.symbol access if the name was
+              found in the current module }
+            if srsym.owner.iscurrentunit then
+              begin
+                consume(_ID);
+                consume(_POINT);
+                searchsym_in_module(tunitsym(srsym).module,pattern,srsym,srsymtable);
+              end
+            else
+              begin
+                srsym:=nil;
+                srsymtable:=nil;
+              end;
+            result:=true;
+          end;
       end;
 
 

compiler/pdecl.pas

@@ -182,7 +182,7 @@ implementation
                    if assigned(sym) then
                      begin
                        sym.symoptions:=sym.symoptions+dummysymoptions;
-                       symtablestack.insert(sym);
+                       symtablestack.top.insert(sym);
                      end;
                    consume(_SEMICOLON);
                 end;
@@ -203,7 +203,7 @@ implementation
                    akttokenpos:=filepos;
                    sym:=ttypedconstsym.createtype(orgname,tt,(cs_typed_const_writable in aktlocalswitches));
                    akttokenpos:=storetokenpos;
-                   symtablestack.insert(sym);
+                   symtablestack.top.insert(sym);
                    { procvar can have proc directives, but not type references }
                    if (tt.def.deftype=procvardef) and
                       (tt.sym=nil) then
@@ -248,8 +248,6 @@ implementation
 
 
     procedure label_dec;
-      var
-         hl : tasmlabel;
       begin
          consume(_LABEL);
          if not(cs_support_goto in aktmoduleswitches) then
@@ -260,9 +258,9 @@ implementation
            else
              begin
                 if token=_ID then
-                 symtablestack.insert(tlabelsym.create(orgpattern))
+                 symtablestack.top.insert(tlabelsym.create(orgpattern))
                 else
-                 symtablestack.insert(tlabelsym.create(pattern));
+                 symtablestack.top.insert(tlabelsym.create(pattern));
                 consume(token);
              end;
            if token<>_SEMICOLON then consume(_COMMA);
@@ -482,7 +480,7 @@ implementation
               tt:=generrortype;
               storetokenpos:=akttokenpos;
               newtype:=ttypesym.create(orgtypename,tt);
-              symtablestack.insert(newtype);
+              symtablestack.top.insert(newtype);
               akttokenpos:=defpos;
               akttokenpos:=storetokenpos;
               { read the type definition }
@@ -602,7 +600,7 @@ implementation
             end;
          until token<>_ID;
          typecanbeforward:=false;
-         symtablestack.foreach_static(@resolve_type_forward,nil);
+         symtablestack.top.foreach_static(@resolve_type_forward,nil);
          block_type:=old_block_type;
       end;
 
@@ -612,7 +610,7 @@ implementation
     { the top symbol table of symtablestack         }
       begin
         consume(_VAR);
-        read_var_decs([]);
+        read_var_decls([]);
       end;
 
 
@@ -621,7 +619,7 @@ implementation
          old_block_type : tblock_type;
       begin
          consume(_PROPERTY);
-         if not(symtablestack.symtabletype in [staticsymtable,globalsymtable]) then
+         if not(symtablestack.top.symtabletype in [staticsymtable,globalsymtable]) then
            message(parser_e_resourcestring_only_sg);
          old_block_type:=block_type;
          block_type:=bt_const;
@@ -638,9 +636,9 @@ implementation
     { the top symbol table of symtablestack                }
       begin
         consume(_THREADVAR);
-        if not(symtablestack.symtabletype in [staticsymtable,globalsymtable]) then
+        if not(symtablestack.top.symtabletype in [staticsymtable,globalsymtable]) then
           message(parser_e_threadvars_only_sg);
-        read_var_decs([vd_threadvar]);
+        read_var_decls([vd_threadvar]);
       end;
 
 
@@ -655,7 +653,7 @@ implementation
          sym : tsym;
       begin
          consume(_RESOURCESTRING);
-         if not(symtablestack.symtabletype in [staticsymtable,globalsymtable]) then
+         if not(symtablestack.top.symtabletype in [staticsymtable,globalsymtable]) then
            message(parser_e_resourcestring_only_sg);
          old_block_type:=block_type;
          block_type:=bt_const;
@@ -701,7 +699,7 @@ implementation
                    if assigned(sym) then
                      begin
                        sym.symoptions:=sym.symoptions+dummysymoptions;
-                       symtablestack.insert(sym);
+                       symtablestack.top.insert(sym);
                      end;
                    consume(_SEMICOLON);
                    p.free;

compiler/pdecobj.pas

@@ -37,7 +37,7 @@ implementation
     uses
       cutils,
       globals,verbose,systems,tokens,
-      symconst,symbase,symsym,
+      symconst,symbase,symsym,symtable,
       node,nld,nmem,ncon,ncnv,ncal,
       scanner,
       pbase,pexpr,pdecsub,pdecvar,ptype
@@ -175,7 +175,8 @@ implementation
           for i:=1 to defs.count do
             begin
               pd:=tdef(defs.search(i));
-              if pd.deftype=procdef then
+              if assigned(pd) and
+                 (pd.deftype=procdef) then
                 begin
                   tprocdef(pd).extnumber:=aktobjectdef.lastvtableindex;
                   inc(aktobjectdef.lastvtableindex);
@@ -503,7 +504,7 @@ implementation
          old_object_option:=current_object_option;
 
          { objects and class types can't be declared local }
-         if not(symtablestack.symtabletype in [globalsymtable,staticsymtable]) then
+         if not(symtablestack.top.symtabletype in [globalsymtable,staticsymtable]) then
            Message(parser_e_no_local_objects);
 
          storetypecanbeforward:=typecanbeforward;
@@ -537,8 +538,7 @@ implementation
          { set class flags and inherits published }
          setclassattributes;
 
-         aktobjectdef.symtable.next:=symtablestack;
-         symtablestack:=aktobjectdef.symtable;
+         symtablestack.push(aktobjectdef.symtable);
          testcurobject:=1;
 
          { add generic type parameters }
@@ -552,7 +552,7 @@ implementation
                    include(aktobjectdef.defoptions,df_generic)
                  else
                    include(aktobjectdef.defoptions,df_specialization);
-                 symtablestack.insert(generictype);
+                 symtablestack.top.insert(generictype);
                  generictype:=ttypesym(generictype.listnext);
                end;
            end;
@@ -635,7 +635,7 @@ implementation
                               not(oo_can_have_published in aktobjectdef.objectoptions) then
                               Message(parser_e_cant_have_published);
 
-                            read_var_decs([vd_object]);
+                            read_record_fields([vd_object]);
                           end;
                     end;
                   end;
@@ -790,6 +790,9 @@ implementation
          if is_interface(aktobjectdef) then
            setinterfacemethodoptions;
 
+         { remove symtable from stack }
+         symtablestack.pop(aktobjectdef.symtable);
+
          { return defined objectdef }
          result:=aktobjectdef;
 
@@ -797,7 +800,6 @@ implementation
          aktobjectdef:=nil;
          testcurobject:=0;
          typecanbeforward:=storetypecanbeforward;
-         symtablestack:=symtablestack.next;
          current_object_option:=old_object_option;
       end;
 

compiler/pdecsub.pas

@@ -71,7 +71,7 @@ implementation
        { symtable }
        symbase,symtable,defutil,defcmp,paramgr,cpupara,
        { pass 1 }
-       node,htypechk,
+       fmodule,node,htypechk,
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
        { parser }
        scanner,
@@ -234,7 +234,7 @@ implementation
            sl.addsym(sl_load,pd.funcretsym);
            aliasvs:=tabsolutevarsym.create_ref(pd.resultname,pd.rettype,sl);
            include(aliasvs.varoptions,vo_is_funcret);
-           pd.localst.insert(aliasvs);
+           tlocalsymtable(pd.localst).insert(aliasvs);
 
            { insert result also if support is on }
            if (m_result in aktmodeswitches) then
@@ -244,7 +244,7 @@ implementation
               aliasvs:=tabsolutevarsym.create_ref('RESULT',pd.rettype,sl);
               include(aliasvs.varoptions,vo_is_funcret);
               include(aliasvs.varoptions,vo_is_result);
-              pd.localst.insert(aliasvs);
+              tlocalsymtable(pd.localst).insert(aliasvs);
             end;
 
            akttokenpos:=storepos;
@@ -504,9 +504,7 @@ implementation
                 if (token=_CONST) and (m_objpas in aktmodeswitches) then
                  begin
                    consume(_CONST);
-                   srsym:=searchsymonlyin(systemunit,'TVARREC');
-                   if not assigned(srsym) then
-                     InternalError(200404181);
+                   srsym:=search_system_type('TVARREC');
                    tarraydef(tt.def).setelementtype(ttypesym(srsym).restype);
                    tarraydef(tt.def).IsArrayOfConst:=true;
                  end
@@ -637,16 +635,16 @@ implementation
       var
         hs       : string;
         orgsp,sp : stringid;
-        sym : tsym;
         srsym : tsym;
-        oldsymtablestack,
         srsymtable : tsymtable;
+        checkstack : psymtablestackitem;
         storepos,
         procstartfilepos : tfileposinfo;
         searchagain : boolean;
         i : longint;
         st : tsymtable;
         aprocsym : tprocsym;
+        popclass : boolean;
       begin
         { Save the position where this procedure really starts }
         procstartfilepos:=akttokenpos;
@@ -676,17 +674,17 @@ implementation
            storepos:=akttokenpos;
            akttokenpos:=procstartfilepos;
            { get interface syms}
-           searchsym(sp,sym,srsymtable);
-           if not assigned(sym) then
+           searchsym(sp,srsym,srsymtable);
+           if not assigned(srsym) then
             begin
               identifier_not_found(orgsp);
-              sym:=generrorsym;
+              srsym:=generrorsym;
             end;
            akttokenpos:=storepos;
            { qualifier is interface? }
-           if (sym.typ=typesym) and
-              (ttypesym(sym).restype.def.deftype=objectdef) then
-             i:=aclass.implementedinterfaces.searchintf(ttypesym(sym).restype.def)
+           if (srsym.typ=typesym) and
+              (ttypesym(srsym).restype.def.deftype=objectdef) then
+             i:=aclass.implementedinterfaces.searchintf(ttypesym(srsym).restype.def)
            else
              i:=-1;
            if (i=-1) then
@@ -705,17 +703,17 @@ implementation
         { method  ? }
         if not assigned(aclass) and
            (potype<>potype_operator) and
-           (symtablestack.symtablelevel=main_program_level) and
+           (symtablestack.top.symtablelevel=main_program_level) and
            try_to_consume(_POINT) then
          begin
            { search for object name }
            storepos:=akttokenpos;
            akttokenpos:=procstartfilepos;
-           searchsym(sp,sym,srsymtable);
-           if not assigned(sym) then
+           searchsym(sp,srsym,srsymtable);
+           if not assigned(srsym) then
             begin
               identifier_not_found(orgsp);
-              sym:=generrorsym;
+              srsym:=generrorsym;
             end;
            akttokenpos:=storepos;
            { consume proc name }
@@ -724,10 +722,10 @@ implementation
            procstartfilepos:=akttokenpos;
            consume(_ID);
            { qualifier is class name ? }
-           if (sym.typ=typesym) and
-              (ttypesym(sym).restype.def.deftype=objectdef) then
+           if (srsym.typ=typesym) and
+              (ttypesym(srsym).restype.def.deftype=objectdef) then
             begin
-              aclass:=tobjectdef(ttypesym(sym).restype.def);
+              aclass:=tobjectdef(ttypesym(srsym).restype.def);
               aprocsym:=tprocsym(aclass.symtable.search(sp));
               { we solve this below }
               if assigned(aprocsym) then
@@ -765,23 +763,17 @@ implementation
            repeat
              searchagain:=false;
              akttokenpos:=procstartfilepos;
-             srsym:=tsym(symtablestack.search(sp));
 
-             if not(parse_only) and
-                not assigned(srsym) and
-                (symtablestack.symtabletype=staticsymtable) and
-                assigned(symtablestack.next) and
-                (symtablestack.next.iscurrentunit) then
-               begin
-                 { The procedure we prepare for is in the implementation
-                   part of the unit we compile. It is also possible that we
-                   are compiling a program, which is also some kind of
-                   implementaion part.
-
-                   We need to find out if the procedure is global. If it is
-                   global, it is in the global symtable.}
-                 srsym:=tsym(symtablestack.next.search(sp));
-               end;
+             srsymtable:=symtablestack.top;
+             srsym:=tsym(srsymtable.search(sp));
+
+             { Also look in the globalsymtable if we didn't found
+               the symbol in the localsymtable }
+             if not assigned(srsym) and
+                not(parse_only) and
+                (srsymtable=current_module.localsymtable) and
+                assigned(current_module.globalsymtable) then
+               srsym:=tsym(current_module.globalsymtable.search(sp));
 
              { Check if overloaded is a procsym }
              if assigned(srsym) then
@@ -822,19 +814,25 @@ implementation
              operation }
            if (potype=potype_operator) then
              begin
-               Aprocsym:=Tprocsym(symtablestack.search(sp));
+               Aprocsym:=Tprocsym(symtablestack.top.search(sp));
                if Aprocsym=nil then
                  Aprocsym:=tprocsym.create('$'+sp);
              end
             else
              aprocsym:=tprocsym.create(orgsp);
-            symtablestack.insert(aprocsym);
+            symtablestack.top.insert(aprocsym);
          end;
 
         { to get the correct symtablelevel we must ignore objectsymtables }
-        st:=symtablestack;
-        while not(st.symtabletype in [staticsymtable,globalsymtable,localsymtable]) do
-         st:=st.next;
+        st:=nil;
+        checkstack:=symtablestack.stack;
+        while assigned(checkstack) do
+          begin
+            st:=checkstack^.symtable;
+            if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then
+              break;
+            checkstack:=checkstack^.next;
+          end;
         pd:=tprocdef.create(st.symtablelevel+1);
         pd._class:=aclass;
         pd.procsym:=aprocsym;
@@ -867,8 +865,8 @@ implementation
         { methods need to be exported }
         if assigned(aclass) and
            (
-            (symtablestack.symtabletype=objectsymtable) or
-            (symtablestack.symtablelevel=main_program_level)
+            (symtablestack.top.symtabletype=objectsymtable) or
+            (symtablestack.top.symtablelevel=main_program_level)
            ) then
           include(pd.procoptions,po_global);
 
@@ -880,22 +878,22 @@ implementation
         if token=_LKLAMMER then
           begin
             { Add objectsymtable to be able to find generic type definitions }
-            oldsymtablestack:=symtablestack;
+            popclass:=false;
             if assigned(pd._class) and
                (pd.parast.symtablelevel=normal_function_level) and
-               (symtablestack.symtabletype<>objectsymtable) then
+               (symtablestack.top.symtabletype<>objectsymtable) then
               begin
-                pd._class.symtable.next:=symtablestack;
-                symtablestack:=pd._class.symtable;
+                symtablestack.push(pd._class.symtable);
+                popclass:=true;
               end;
             { Add parameter symtable }
             if pd.parast.symtabletype<>staticsymtable then
-              begin
-                 pd.parast.next:=symtablestack;
-                 symtablestack:=pd.parast;
-              end;
+              symtablestack.push(pd.parast);
             parse_parameter_dec(pd);
-            symtablestack:=oldsymtablestack;
+            if pd.parast.symtabletype<>staticsymtable then
+              symtablestack.pop(pd.parast);
+            if popclass then
+              symtablestack.pop(pd._class.symtable);
           end;
 
         result:=true;
@@ -1875,7 +1873,7 @@ const
             if ((not isprocvar) or
                (pd_procvar in proc_direcdata[i].pd_flags)) and
                { don't eat a public directive in classes }
-               not((idtoken=_PUBLIC) and (symtablestack.symtabletype=objectsymtable)) then
+               not((idtoken=_PUBLIC) and (symtablestack.top.symtabletype=objectsymtable)) then
               result:=true;
             exit;
           end;
@@ -1939,7 +1937,7 @@ const
         { check if method and directive not for object, like public.
           This needs to be checked also for procvars }
         if (pd_notobject in proc_direcdata[p].pd_flags) and
-           (symtablestack.symtabletype=objectsymtable) then
+           (symtablestack.top.symtabletype=objectsymtable) then
            exit;
 
         { Conflicts between directives ? }
@@ -2335,7 +2333,6 @@ const
       var
         hd    : tprocdef;
         ad,fd : tsym;
-        s1,s2 : stringid;
         i     : cardinal;
         forwardfound : boolean;
         po_comp : tprocoptions;
@@ -2485,17 +2482,15 @@ const
                         { stop when one of the two lists is at the end }
                         if not assigned(ad) or not assigned(fd) then
                          break;
-                        { retrieve names, remove reg for register parameters }
+                        { compare names of parameters, ignore implictly
+                          renamed parameters }
                         if not(sp_implicitrename in ad.symoptions) and
                            not(sp_implicitrename in fd.symoptions) then
                           begin
-                            s1:=ad.name;
-                            s2:=fd.name;
-                            { compare names }
-                            if (s1<>s2) then
+                            if (ad.name<>fd.name) then
                              begin
                                MessagePos3(pd.fileinfo,parser_e_header_different_var_names,
-                                           aprocsym.name,s1,s2);
+                                           aprocsym.realname,ad.realname,fd.realname);
                                break;
                              end;
                           end;

compiler/pdecvar.pas

@@ -29,12 +29,15 @@ interface
     uses
       symsym,symdef;
 
-    type   Tvar_dec_option=(vd_record,vd_object,vd_threadvar);
-           Tvar_dec_options=set of Tvar_dec_option;
+    type
+      tvar_dec_option=(vd_record,vd_object,vd_threadvar);
+      tvar_dec_options=set of tvar_dec_option;
 
-    function read_property_dec(aclass:tobjectdef):tpropertysym;
+    function  read_property_dec(aclass:tobjectdef):tpropertysym;
+
+    procedure read_var_decls(options:Tvar_dec_options);
 
-    procedure read_var_decs(options:Tvar_dec_options);
+    procedure read_record_fields(options:Tvar_dec_options);
 
 
 implementation
@@ -121,7 +124,7 @@ implementation
                           st:=def.getsymtable(gs_record);
                           if assigned(st) then
                            begin
-                             sym:=searchsymonlyin(st,pattern);
+                             sym:=tsym(st.search(pattern));
                              if assigned(sym) then
                               begin
                                 pl.addsym(sl_subscript,sym);
@@ -211,24 +214,18 @@ implementation
          arraytype : ttype;
          def : tdef;
          pt : tnode;
-         propname : stringid;
          sc : tsinglelist;
          paranr : word;
-         oldregisterdef : boolean;
          hreadparavs,
          hparavs      : tparavarsym;
          readprocdef,
          writeprocdef : tprocvardef;
-         oldsymtablestack : tsymtable;
       begin
          { Generate temp procvardefs to search for matching read/write
            procedures. the readprocdef will store all definitions }
-         oldregisterdef:=registerdef;
-         registerdef:=false;
          paranr:=0;
          readprocdef:=tprocvardef.create(normal_function_level);
          writeprocdef:=tprocvardef.create(normal_function_level);
-         registerdef:=oldregisterdef;
 
          { make it method pointers }
          if assigned(aclass) then
@@ -245,39 +242,24 @@ implementation
            end;
          { Generate propertysym and insert in symtablestack }
          p:=tpropertysym.create(orgpattern);
-         symtablestack.insert(p);
-         propname:=pattern;
+         symtablestack.top.insert(p);
          consume(_ID);
-         { Set the symtablestack to the parast of readprop so
-           temp defs will be destroyed after declaration }
-         readprocdef.parast.next:=symtablestack;
-         symtablestack:=readprocdef.parast;
          { property parameters ? }
-         if token=_LECKKLAMMER then
+         if try_to_consume(_LECKKLAMMER) then
            begin
               if (sp_published in current_object_option) then
                 Message(parser_e_cant_publish_that_property);
-
               { create a list of the parameters }
+              symtablestack.push(readprocdef.parast);
               sc:=tsinglelist.create;
-              consume(_LECKKLAMMER);
               inc(testcurobject);
               repeat
-                if token=_VAR then
-                  begin
-                     consume(_VAR);
-                     varspez:=vs_var;
-                  end
-                else if token=_CONST then
-                  begin
-                     consume(_CONST);
-                     varspez:=vs_const;
-                  end
-                else if (idtoken=_OUT) and (m_out in aktmodeswitches) then
-                  begin
-                     consume(_OUT);
-                     varspez:=vs_out;
-                  end
+                if try_to_consume(_VAR) then
+                  varspez:=vs_var
+                else if try_to_consume(_CONST) then
+                  varspez:=vs_const
+                else if (m_out in aktmodeswitches) and try_to_consume(_OUT) then
+                  varspez:=vs_out
                 else
                   varspez:=vs_value;
                 sc.reset;
@@ -290,10 +272,6 @@ implementation
                 until not try_to_consume(_COMMA);
                 if try_to_consume(_COLON) then
                   begin
-                    { for records, don't search the recordsymtable for
-                     the symbols of the types }
-                    oldsymtablestack:=symtablestack;
-                    symtablestack:=symtablestack.next;
                     if try_to_consume(_ARRAY) then
                       begin
                         consume(_OF);
@@ -305,7 +283,6 @@ implementation
                       end
                     else
                       single_type(tt,false);
-                    symtablestack:=oldsymtablestack;
                   end
                 else
                   tt:=cformaltype;
@@ -321,6 +298,7 @@ implementation
               until not try_to_consume(_SEMICOLON);
               sc.free;
               dec(testcurobject);
+              symtablestack.pop(readprocdef.parast);
               consume(_RECKKLAMMER);
 
               { the parser need to know if a property has parameters, the
@@ -335,12 +313,7 @@ implementation
          if (token=_COLON) or (paranr>0) or (aclass=nil) then
            begin
               consume(_COLON);
-              { insert types in global symtable }
-              oldsymtablestack:=symtablestack;
-              while not(symtablestack.symtabletype in [globalsymtable,staticsymtable]) do
-                symtablestack:=symtablestack.next;
               single_type(p.proptype,false);
-              symtablestack:=oldsymtablestack;
               if (idtoken=_INDEX) then
                 begin
                    consume(_INDEX);
@@ -375,7 +348,7 @@ implementation
          else
            begin
               { do an property override }
-              overriden:=search_class_member(aclass.childof,propname);
+              overriden:=search_class_member(aclass.childof,p.name);
               if assigned(overriden) and (overriden.typ=propertysym) then
                 begin
                   p.dooverride(tpropertysym(overriden));
@@ -579,66 +552,36 @@ implementation
               p.default:=0;
            end;
          { remove temporary procvardefs }
-         symtablestack:=symtablestack.next;
          readprocdef.free;
          writeprocdef.free;
          result:=p;
       end;
 
 
+     function maybe_parse_proc_directives(const tt:ttype):boolean;
+       var
+         newtype : ttypesym;
+       begin
+         result:=false;
+         { Process procvar directives before = and ; }
+         if (tt.def.deftype=procvardef) and
+            (tt.def.typesym=nil) and
+            check_proc_directive(true) then
+           begin
+              newtype:=ttypesym.create('unnamed',tt);
+              parse_var_proc_directives(tsym(newtype));
+              newtype.restype.def:=nil;
+              tt.def.typesym:=nil;
+              newtype.free;
+              result:=true;
+           end;
+       end;
+
+
     const
        variantrecordlevel : longint = 0;
 
-    procedure read_var_decs(options:Tvar_dec_options);
-    { reads the filed of a record into a        }
-    { symtablestack, if record=false        }
-    { variants are forbidden, so this procedure }
-    { can be used to read object fields  }
-    { if absolute is true, ABSOLUTE and file    }
-    { types are allowed                  }
-    { => the procedure is also used to read     }
-    { a sequence of variable declaration        }
-
-      procedure insert_syms(sc : tsinglelist;tt : ttype;is_threadvar : boolean; addsymopts : tsymoptions);
-      { inserts the symbols of sc in st with def as definition or sym as ttypesym, sc is disposed }
-        var
-          vs : tabstractvarsym;
-          hstaticvs : tglobalvarsym;
-        begin
-           vs:=tabstractvarsym(sc.first);
-           while assigned(vs) do
-             begin
-                vs.vartype:=tt;
-                { insert any additional hint directives }
-                vs.symoptions := vs.symoptions + addsymopts;
-                if (sp_static in current_object_option) then
-                  include(vs.symoptions,sp_static);
-                if is_threadvar then
-                  include(vs.varoptions,vo_is_thread_var);
-                { static data fields are inserted in the globalsymtable }
-                if (symtablestack.symtabletype=objectsymtable) and
-                   (sp_static in current_object_option) then
-                  begin
-                     hstaticvs:=tglobalvarsym.create('$'+lower(symtablestack.name^)+'_'+vs.name,vs_value,tt,[]);
-                     symtablestack.defowner.owner.insert(hstaticvs);
-                     insertbssdata(hstaticvs);
-                  end
-                else
-                  begin
-                    { external data is not possible here }
-                    case symtablestack.symtabletype of
-                      globalsymtable,
-                      staticsymtable :
-                        insertbssdata(tglobalvarsym(vs));
-                      recordsymtable,
-                      objectsymtable :
-                        tabstractrecordsymtable(symtablestack).insertfield(tfieldvarsym(vs),false);
-                    end;
-                  end;
-                vs:=tabstractvarsym(vs.listnext);
-             end;
-        end;
-
+    procedure read_var_decls(options:Tvar_dec_options);
 
       procedure read_default_value(sc : tsinglelist;tt : ttype;is_threadvar : boolean);
         var
@@ -650,13 +593,13 @@ implementation
              Message(parser_e_initialized_only_one_var);
           if is_threadvar then
              Message(parser_e_initialized_not_for_threadvar);
-          if symtablestack.symtabletype=localsymtable then
+          if symtablestack.top.symtabletype=localsymtable then
             begin
               consume(_EQUAL);
               tcsym:=ttypedconstsym.createtype('$default'+vs.realname,tt,false);
               include(tcsym.symoptions,sp_internal);
               vs.defaultconstsym:=tcsym;
-              symtablestack.insert(tcsym);
+              symtablestack.top.insert(tcsym);
               readtypedconst(tt,tcsym,false);
               { The variable has a value assigned }
               vs.varstate:=vs_initialised;
@@ -665,7 +608,7 @@ implementation
             begin
               tcsym:=ttypedconstsym.createtype(vs.realname,tt,true);
               tcsym.fileinfo:=vs.fileinfo;
-              symtablestack.replace(vs,tcsym);
+              symtablestack.top.replace(vs,tcsym);
               vs.free;
               consume(_EQUAL);
               readtypedconst(tt,tcsym,true);
@@ -679,56 +622,30 @@ implementation
          { to handle absolute }
          abssym : tabsolutevarsym;
          { c var }
-         newtype : ttypesym;
          is_dll,
          hasdefaultvalue,
          is_gpc_name,is_cdecl,
          extern_var,export_var : boolean;
          old_current_object_option : tsymoptions;
          hs,sorg,C_name,dll_name : string;
-         tt,casetype : ttype;
-         { maxsize contains the max. size of a variant }
-         { startvarrec contains the start of the variant part of a record }
-         maxsize, startvarrecsize : longint;
-         usedalign,
-         maxalignment,startvarrecalign,
-         maxpadalign, startpadalign: shortint;
+         tt : ttype;
          hp,pt : tnode;
-         fieldvs   : tfieldvarsym;
-         vs,vs2    : tabstractvarsym;
-         srsym : tsym;
-         oldsymtablestack,
-         srsymtable : tsymtable;
-         unionsymtable : trecordsymtable;
-         offset : longint;
-         uniondef : trecorddef;
-         unionsym : tfieldvarsym;
-         uniontype : ttype;
-         dummysymoptions : tsymoptions;
+         vs    : tabstractvarsym;
+         hintsymoptions : tsymoptions;
          semicolonatend,semicoloneaten: boolean;
-{$ifdef powerpc}
-         tempdef: tdef;
-         is_first_field: boolean;
-{$endif powerpc}
       begin
-{$ifdef powerpc}
-        is_first_field := true;
-{$endif powerpc}
          old_current_object_option:=current_object_option;
          { all variables are public if not in a object declaration }
-         if not(vd_object in options) then
-          current_object_option:=[sp_public];
+         current_object_option:=[sp_public];
          old_block_type:=block_type;
          block_type:=bt_type;
          is_gpc_name:=false;
          { Force an expected ID error message }
          if not (token in [_ID,_CASE,_END]) then
-          consume(_ID);
+           consume(_ID);
          { read vars }
          sc:=tsinglelist.create;
-         while (token=_ID) and
-            not((vd_object in options) and
-                (idtoken in [_PUBLIC,_PRIVATE,_PUBLISHED,_PROTECTED,_STRICT])) do
+         while (token=_ID) do
            begin
              sorg:=orgpattern;
              semicoloneaten:=false;
@@ -738,101 +655,40 @@ implementation
              repeat
                if (token = _ID) then
                  begin
-                   case symtablestack.symtabletype of
+                   case symtablestack.top.symtabletype of
                      localsymtable :
                        vs:=tlocalvarsym.create(orgpattern,vs_value,generrortype,[]);
                      staticsymtable,
                      globalsymtable :
                        vs:=tglobalvarsym.create(orgpattern,vs_value,generrortype,[]);
-                     recordsymtable,
-                     objectsymtable :
-                       vs:=tfieldvarsym.create(orgpattern,vs_value,generrortype,[]);
                      else
                        internalerror(200411064);
                    end;
-                   symtablestack.insert(vs);
-                   if assigned(vs.owner) then
-                     sc.insert(vs)
-                   else
-                     vs.free;
+                   sc.insert(vs);
+                   symtablestack.top.insert(vs);
                  end;
                consume(_ID);
              until not try_to_consume(_COMMA);
              consume(_COLON);
-             if (m_gpc in aktmodeswitches) and (options=[]) and
-                (token=_ID) and (orgpattern='__asmname__') then
+
+             if (m_gpc in aktmodeswitches) and
+                (token=_ID) and
+                (orgpattern='__asmname__') then
                begin
                  consume(_ID);
                  C_name:=get_stringconst;
                  Is_gpc_name:=true;
                end;
+
              { this is needed for Delphi mode at least
                but should be OK for all modes !! (PM) }
              ignore_equal:=true;
-             if ((vd_record in options) or
-                 (vd_object in options)) and
-                not(df_generic in tdef(symtablestack.defowner).defoptions) and
-                not(df_specialization in tdef(symtablestack.defowner).defoptions) then
-              begin
-                { for records, don't search the recordsymtable for
-                  the symbols of the types }
-                oldsymtablestack:=symtablestack;
-                symtablestack:=symtablestack.next;
-                read_anon_type(tt,false);
-                symtablestack:=oldsymtablestack;
-              end
-             else
-              read_anon_type(tt,false);
+             read_anon_type(tt,false);
              ignore_equal:=false;
-             { Process procvar directives }
-             if (tt.def.deftype=procvardef) and
-                (tt.def.typesym=nil) and
-                check_proc_directive(true) then
-               begin
-                  newtype:=ttypesym.create('unnamed',tt);
-                  parse_var_proc_directives(tsym(newtype));
-                  semicoloneaten:=true;
-                  newtype.restype.def:=nil;
-                  tt.def.typesym:=nil;
-                  newtype.free;
-               end;
 
-{$ifdef powerpc}
-               { from gcc/gcc/config/rs6000/rs6000.h:
-                /* APPLE LOCAL begin Macintosh alignment 2002-1-22 ff */
-                /* Return the alignment of a struct based on the Macintosh PowerPC
-                   alignment rules.  In general the alignment of a struct is
-                   determined by the greatest alignment of its elements.  However, the
-                   PowerPC rules cause the alignment of a struct to peg at word
-                   alignment except when the first field has greater than word
-                   (32-bit) alignment, in which case the alignment is determined by
-                   the alignment of the first field.  */
-               }
-               if (target_info.system in [system_powerpc_darwin, system_powerpc_macos]) and
-                  (vd_record in options) and
-                  is_first_field and
-                  (trecordsymtable(symtablestack).usefieldalignment = -1) then
-                 begin
-                   tempdef := tt.def;
-                   while tempdef.deftype = arraydef do
-                     tempdef := tarraydef(tempdef).elementtype.def;
-                   if tempdef.deftype <> recorddef then
-                     maxpadalign := tempdef.alignment
-                   else
-                     maxpadalign := trecorddef(tempdef).padalignment;
-
-                   if (maxpadalign > 4) and
-                      (maxpadalign > trecordsymtable(symtablestack).padalignment) then
-                     trecordsymtable(symtablestack).padalignment := maxpadalign;
-                   is_first_field := false;
-                 end;
-{$endif powerpc}
-
-             { types that use init/final are not allowed in variant parts, but
-               classes are allowed }
-             if (variantrecordlevel>0) and
-                (tt.def.needs_inittable and not is_class(tt.def)) then
-               Message(parser_e_cant_use_inittable_here);
+             { Process procvar directives }
+             if maybe_parse_proc_directives(tt) then
+               semicoloneaten:=true;
 
              if is_gpc_name then
                begin
@@ -852,9 +708,9 @@ implementation
                end;
 
              { check for absolute }
-             if not symdone and (idtoken=_ABSOLUTE) and (options=[]) then
+             if not symdone and
+                try_to_consume(_ABSOLUTE) then
               begin
-                consume(_ABSOLUTE);
                 abssym:=nil;
                 { only allowed for one var }
                 vs:=tabstractvarsym(sc.first);
@@ -876,7 +732,7 @@ implementation
                    abssym.abstyp:=toasm;
                    abssym.asmname:=stringdup(hs);
                    { replace the varsym }
-                   symtablestack.replace(vs,abssym);
+                   symtablestack.top.replace(vs,abssym);
                    vs.free;
                  end
                 { address }
@@ -906,7 +762,7 @@ implementation
                          Message(type_e_ordinal_expr_expected);
                     end;
 {$endif i386}
-                   symtablestack.replace(vs,abssym);
+                   symtablestack.top.replace(vs,abssym);
                    vs.free;
                  end
                 { variable }
@@ -926,7 +782,7 @@ implementation
                        abssym.fileinfo:=vs.fileinfo;
                        abssym.abstyp:=tovar;
                        abssym.ref:=node_to_symlist(pt);
-                       symtablestack.replace(vs,abssym);
+                       symtablestack.top.replace(vs,abssym);
                        vs.free;
                      end
                     else
@@ -935,55 +791,34 @@ implementation
                 if assigned(abssym) then
                  begin
                    { try to consume the hint directives with absolute symbols }
-                   dummysymoptions:=[];
-                   try_consume_hintdirective(dummysymoptions);
-                   abssym.symoptions := abssym.symoptions + dummysymoptions;
+                   hintsymoptions:=[];
+                   try_consume_hintdirective(hintsymoptions);
+                   abssym.symoptions := abssym.symoptions + hintsymoptions;
                  end;
                 pt.free;
                 symdone:=true;
               end;
 
-             { Process procvar directives before = and ; }
-             if (tt.def.deftype=procvardef) and
-                (tt.def.typesym=nil) and
-                check_proc_directive(true) then
-               begin
-                  newtype:=ttypesym.create('unnamed',tt);
-                  parse_var_proc_directives(tsym(newtype));
-                  newtype.restype.def:=nil;
-                  tt.def.typesym:=nil;
-                  newtype.free;
-               end;
-
              { try to parse the hint directives }
-             dummysymoptions:=[];
-             try_consume_hintdirective(dummysymoptions);
+             hintsymoptions:=[];
+             try_consume_hintdirective(hintsymoptions);
 
-             { Records and objects can't have default values }
-             if options*[vd_record,vd_object]<>[] then
+             { Handling of Delphi typed const = initialized vars }
+             if (token=_EQUAL) and
+                not(m_tp7 in aktmodeswitches) and
+                (symtablestack.top.symtabletype<>parasymtable) then
                begin
-                 { for a record there doesn't need to be a ; before the END or )    }
-                 if not(token in [_END,_RKLAMMER]) and
-                    not(semicoloneaten) then
-                   consume(_SEMICOLON);
+                 { Add calling convention for procvar }
+                 if (tt.def.deftype=procvardef) and
+                    (tt.def.typesym=nil) then
+                   handle_calling_convention(tprocvardef(tt.def));
+                 read_default_value(sc,tt,vd_threadvar in options);
+                 consume(_SEMICOLON);
+                 { for locals we've created typedconstsym with a different name }
+                 if symtablestack.top.symtabletype<>localsymtable then
+                   symdone:=true;
+                 hasdefaultvalue:=true;
                end
-             else
-             { Handling of Delphi typed const = initialized vars }
-               if (token=_EQUAL) and
-                  not(m_tp7 in aktmodeswitches) and
-                  (symtablestack.symtabletype<>parasymtable) then
-                 begin
-                   { Add calling convention for procvar }
-                   if (tt.def.deftype=procvardef) and
-                      (tt.def.typesym=nil) then
-                     handle_calling_convention(tprocvardef(tt.def));
-                   read_default_value(sc,tt,vd_threadvar in options);
-                   consume(_SEMICOLON);
-                   { for locals we've created typedconstsym with a different name }
-                   if symtablestack.symtabletype<>localsymtable then
-                     symdone:=true;
-                   hasdefaultvalue:=true;
-                 end
              else
                begin
                  if not(semicoloneaten) then
@@ -996,20 +831,13 @@ implementation
                 (tt.def.typesym=nil) then
                begin
                  { Parse procvar directives after ; }
-                 if check_proc_directive(true) then
-                   begin
-                     newtype:=ttypesym.create('unnamed',tt);
-                     parse_var_proc_directives(tsym(newtype));
-                     newtype.restype.def:=nil;
-                     tt.def.typesym:=nil;
-                     newtype.free;
-                   end;
+                 maybe_parse_proc_directives(tt);
                  { Add calling convention for procvar }
                  handle_calling_convention(tprocvardef(tt.def));
                  { Handling of Delphi typed const = initialized vars }
-                 if (token=_EQUAL) and (options*[vd_record,vd_object]=[]) and
+                 if (token=_EQUAL) and
                     not(m_tp7 in aktmodeswitches) and
-                    (symtablestack.symtabletype<>parasymtable) then
+                    (symtablestack.top.symtabletype<>parasymtable) then
                    begin
                      read_default_value(sc,tt,vd_threadvar in options);
                      consume(_SEMICOLON);
@@ -1019,7 +847,7 @@ implementation
                end;
 
              { Check for EXTERNAL etc directives or, in macpas, if cs_external_var is set}
-             if not symdone and (options=[]) then
+             if not symdone then
               begin
                 if (
                      (token=_ID) and
@@ -1037,7 +865,7 @@ implementation
                      Message(parser_e_absolute_only_one_var);
                    { set type of the var }
                    vs.vartype:=tt;
-                   vs.symoptions := vs.symoptions + dummysymoptions;
+                   vs.symoptions := vs.symoptions + hintsymoptions;
                    { defaults }
                    is_dll:=false;
                    is_cdecl:=false;
@@ -1046,17 +874,15 @@ implementation
                    C_name:=sorg;
                    semicolonatend:= false;
                    { cdecl }
-                   if idtoken=_CVAR then
+                   if try_to_consume(_CVAR) then
                     begin
-                      consume(_CVAR);
                       consume(_SEMICOLON);
                       is_cdecl:=true;
                       C_name:=target_info.Cprefix+sorg;
                     end;
                    { external }
-                   if idtoken=_EXTERNAL then
+                   if try_to_consume(_EXTERNAL) then
                     begin
-                      consume(_EXTERNAL);
                       extern_var:=true;
                       semicolonatend:= true;
                     end;
@@ -1156,78 +982,251 @@ implementation
                  end;
               end;
 
-             { Check for STATIC directive }
-             if not symdone and (vd_object in options) and
-               (cs_static_keyword in aktmoduleswitches) and (idtoken=_STATIC) then
-                  begin
-                    include(current_object_option,sp_static);
-                    consume(_STATIC);
-                    consume(_SEMICOLON);
-                  end;
-
              { insert it in the symtable, if not done yet }
              if not symdone then
                begin
-                  { save object option, because we can turn of the sp_published }
-                  if (sp_published in current_object_option) and
-                    not(is_class(tt.def)) then
-                   begin
-                     Message(parser_e_cant_publish_that);
-                     exclude(current_object_option,sp_published);
-                     { recover by changing access type to public }
-                     vs2:=tabstractvarsym(sc.first);
-                     while assigned (vs2) do
-                       begin
-                         exclude(vs2.symoptions,sp_published);
-                         include(vs2.symoptions,sp_public);
-                         vs2:=tabstractvarsym(vs2.listnext);
-                       end;
-                   end
-                  else
-                   if (sp_published in current_object_option) and
-                      not(oo_can_have_published in tobjectdef(tt.def).objectoptions) then
+                  vs:=tabstractvarsym(sc.first);
+                  while assigned(vs) do
                     begin
-                      Message(parser_e_only_publishable_classes_can__be_published);
-                      exclude(current_object_option,sp_published);
+                       vs.vartype:=tt;
+                       { insert any additional hint directives }
+                       vs.symoptions := vs.symoptions + hintsymoptions;
+                       if vd_threadvar in options then
+                         include(vs.varoptions,vo_is_thread_var);
+                       { static data fields are inserted in the globalsymtable }
+                       if vs.typ=globalvarsym then
+                         insertbssdata(tglobalvarsym(vs));
+                       vs:=tabstractvarsym(vs.listnext);
                     end;
-                  insert_syms(sc,tt,vd_threadvar in options,dummysymoptions);
-                  current_object_option:=old_current_object_option;
                end;
+           end;
+         block_type:=old_block_type;
+         current_object_option:=old_current_object_option;
+         { free the list }
+         sc.free;
+      end;
+
+
+    procedure read_record_fields(options:Tvar_dec_options);
+      var
+         sc : tsinglelist;
+         old_block_type : tblock_type;
+         old_current_object_option : tsymoptions;
+         hs,sorg : string;
+         tt,casetype : ttype;
+         { maxsize contains the max. size of a variant }
+         { startvarrec contains the start of the variant part of a record }
+         maxsize, startvarrecsize : longint;
+         usedalign,
+         maxalignment,startvarrecalign,
+         maxpadalign, startpadalign: shortint;
+         pt : tnode;
+         fieldvs   : tfieldvarsym;
+         hstaticvs : tglobalvarsym;
+         vs    : tabstractvarsym;
+         srsym : tsym;
+         srsymtable : tsymtable;
+         recst : tabstractrecordsymtable;
+         unionsymtable : trecordsymtable;
+         offset : longint;
+         uniondef : trecorddef;
+         unionsym : tfieldvarsym;
+         uniontype : ttype;
+         hintsymoptions : tsymoptions;
+         semicoloneaten: boolean;
+{$ifdef powerpc}
+         tempdef: tdef;
+         is_first_field: boolean;
+{$endif powerpc}
+      begin
+         recst:=tabstractrecordsymtable(symtablestack.top);
+{$ifdef powerpc}
+         is_first_field := true;
+{$endif powerpc}
+         old_current_object_option:=current_object_option;
+         { all variables are public if not in a object declaration }
+         if not(vd_object in options) then
+          current_object_option:=[sp_public];
+         old_block_type:=block_type;
+         block_type:=bt_type;
+         { Force an expected ID error message }
+         if not (token in [_ID,_CASE,_END]) then
+          consume(_ID);
+         { read vars }
+         sc:=tsinglelist.create;
+         while (token=_ID) and
+            not((vd_object in options) and
+                (idtoken in [_PUBLIC,_PRIVATE,_PUBLISHED,_PROTECTED,_STRICT])) do
+           begin
+             sorg:=orgpattern;
+             semicoloneaten:=false;
+             sc.reset;
+             repeat
+               if try_to_consume(_ID) then
+                 begin
+                   vs:=tfieldvarsym.create(orgpattern,vs_value,generrortype,[]);
+                   sc.insert(vs)
+                 end;
+             until not try_to_consume(_COMMA);
+             consume(_COLON);
+
+             { Don't search in the recordsymtable for types }
+             if (df_generic in tdef(recst.defowner).defoptions) or
+                (df_specialization in tdef(recst.defowner).defoptions) then
+               symtablestack.pop(recst);
+             ignore_equal:=true;
+             read_anon_type(tt,false);
+             ignore_equal:=false;
+             if (df_generic in tdef(recst.defowner).defoptions) or
+                (df_specialization in tdef(recst.defowner).defoptions) then
+               symtablestack.push(recst);
+
+             fieldvs:=tfieldvarsym(sc.first);
+             while assigned (fieldvs) do
+               begin
+                 symtablestack.top.insert(fieldvs);
+                 fieldvs:=tfieldvarsym(fieldvs.listnext);
+               end;
+
+             { Process procvar directives }
+             if maybe_parse_proc_directives(tt) then
+               semicoloneaten:=true;
+
+{$ifdef powerpc}
+             { from gcc/gcc/config/rs6000/rs6000.h:
+              /* APPLE LOCAL begin Macintosh alignment 2002-1-22 ff */
+              /* Return the alignment of a struct based on the Macintosh PowerPC
+                 alignment rules.  In general the alignment of a struct is
+                 determined by the greatest alignment of its elements.  However, the
+                 PowerPC rules cause the alignment of a struct to peg at word
+                 alignment except when the first field has greater than word
+                 (32-bit) alignment, in which case the alignment is determined by
+                 the alignment of the first field.  */
+             }
+             if (target_info.system in [system_powerpc_darwin, system_powerpc_macos]) and
+                is_first_field and
+                (trecordsymtable(symtablestack).usefieldalignment = -1) then
+               begin
+                 tempdef := tt.def;
+                 while tempdef.deftype = arraydef do
+                   tempdef := tarraydef(tempdef).elementtype.def;
+                 if tempdef.deftype <> recorddef then
+                   maxpadalign := tempdef.alignment
+                 else
+                   maxpadalign := trecorddef(tempdef).padalignment;
+
+                 if (maxpadalign > 4) and
+                    (maxpadalign > trecordsymtable(symtablestack).padalignment) then
+                   trecordsymtable(symtablestack).padalignment := maxpadalign;
+                 is_first_field := false;
+               end;
+{$endif powerpc}
+
+             { types that use init/final are not allowed in variant parts, but
+               classes are allowed }
+             if (variantrecordlevel>0) and
+                (tt.def.needs_inittable and not is_class(tt.def)) then
+               Message(parser_e_cant_use_inittable_here);
+
+             { try to parse the hint directives }
+             hintsymoptions:=[];
+             try_consume_hintdirective(hintsymoptions);
+
+             { Records and objects can't have default values }
+             { for a record there doesn't need to be a ; before the END or )    }
+             if not(token in [_END,_RKLAMMER]) and
+                not(semicoloneaten) then
+               consume(_SEMICOLON);
+
+             { Parse procvar directives after ; }
+             maybe_parse_proc_directives(tt);
 
+             { Add calling convention for procvar }
+             if (tt.def.deftype=procvardef) and
+                (tt.def.typesym=nil) then
+               handle_calling_convention(tprocvardef(tt.def));
+
+             { Check for STATIC directive }
+             if (vd_object in options) and
+                (cs_static_keyword in aktmoduleswitches) and
+                (try_to_consume(_STATIC)) then
+               begin
+                 include(current_object_option,sp_static);
+                 consume(_SEMICOLON);
+               end;
+
+             if (sp_published in current_object_option) and
+                not(is_class(tt.def)) then
+               begin
+                 Message(parser_e_cant_publish_that);
+                 exclude(current_object_option,sp_published);
+                 { recover by changing access type to public }
+                 fieldvs:=tfieldvarsym(sc.first);
+                 while assigned (fieldvs) do
+                   begin
+                     exclude(fieldvs.symoptions,sp_published);
+                     include(fieldvs.symoptions,sp_public);
+                     fieldvs:=tfieldvarsym(fieldvs.listnext);
+                   end;
+               end
+             else
+              if (sp_published in current_object_option) and
+                 not(oo_can_have_published in tobjectdef(tt.def).objectoptions) then
+               begin
+                 Message(parser_e_only_publishable_classes_can__be_published);
+                 exclude(current_object_option,sp_published);
+               end;
+
+             { update variable options }
+             fieldvs:=tfieldvarsym(sc.first);
+             while assigned(fieldvs) do
+               begin
+                  fieldvs.vartype:=tt;
+                  { insert any additional hint directives }
+                  fieldvs.symoptions := fieldvs.symoptions + hintsymoptions;
+                  if (sp_static in current_object_option) then
+                    include(fieldvs.symoptions,sp_static);
+                  { static data fields are inserted in the globalsymtable }
+                  if (sp_static in current_object_option) then
+                    begin
+                       hstaticvs:=tglobalvarsym.create('$'+lower(symtablestack.top.name^)+'_'+fieldvs.name,vs_value,tt,[]);
+                       recst.defowner.owner.insert(hstaticvs);
+                       insertbssdata(hstaticvs);
+                    end
+                  else
+                    recst.addfield(fieldvs);
+                  fieldvs:=tfieldvarsym(fieldvs.listnext);
+               end;
+
+             { restore current_object_option, it can be changed for
+               publishing or static }
+             current_object_option:=old_current_object_option;
            end;
 
          { Check for Case }
-         if (vd_record in options) and (token=_CASE) then
+         if (vd_record in options) and
+            try_to_consume(_CASE) then
            begin
               maxsize:=0;
               maxalignment:=0;
               maxpadalign:=0;
-              consume(_CASE);
+              { including a field declaration? }
+              fieldvs:=nil;
               sorg:=orgpattern;
               hs:=pattern;
               searchsym(hs,srsym,srsymtable);
-              { may be only a type: }
-              if assigned(srsym) and (srsym.typ in [typesym,unitsym]) then
-               begin
-                 { for records, don't search the recordsymtable for
-                   the symbols of the types }
-                 oldsymtablestack:=symtablestack;
-                 symtablestack:=symtablestack.next;
-                 read_anon_type(casetype,true);
-                 symtablestack:=oldsymtablestack;
-               end
-              else
+              if not(assigned(srsym) and (srsym.typ in [typesym,unitsym])) then
                 begin
                   consume(_ID);
                   consume(_COLON);
-                  { for records, don't search the recordsymtable for
-                    the symbols of the types }
-                  oldsymtablestack:=symtablestack;
-                  symtablestack:=symtablestack.next;
-                  read_anon_type(casetype,true);
-                  symtablestack:=oldsymtablestack;
-                  fieldvs:=tfieldvarsym.create(sorg,vs_value,casetype,[]);
-                  tabstractrecordsymtable(symtablestack).insertfield(fieldvs,true);
+                  fieldvs:=tfieldvarsym.create(sorg,vs_value,generrortype,[]);
+                  symtablestack.top.insert(fieldvs);
+                end;
+              read_anon_type(casetype,true);
+              if assigned(fieldvs) then
+                begin
+                  fieldvs.vartype:=casetype;
+                  recst.addfield(fieldvs);
                 end;
               if not(is_ordinal(casetype.def))
 {$ifndef cpu64bit}
@@ -1236,18 +1235,14 @@ implementation
                  then
                 Message(type_e_ordinal_expr_expected);
               consume(_OF);
+
               UnionSymtable:=trecordsymtable.create(aktpackrecords);
-              Unionsymtable.next:=symtablestack;
-              registerdef:=false;
               UnionDef:=trecorddef.create(unionsymtable);
               uniondef.isunion:=true;
-              if assigned(symtablestack.defowner) then
-                Uniondef.owner:=symtablestack.defowner.owner;
-              registerdef:=true;
               startvarrecsize:=UnionSymtable.datasize;
               startvarrecalign:=UnionSymtable.fieldalignment;
               startpadalign:=Unionsymtable.padalignment;
-              symtablestack:=UnionSymtable;
+              symtablestack.push(UnionSymtable);
               repeat
                 repeat
                   pt:=comp_expr(true);
@@ -1255,16 +1250,16 @@ implementation
                     Message(parser_e_illegal_expression);
                   pt.free;
                   if token=_COMMA then
-                   consume(_COMMA)
+                    consume(_COMMA)
                   else
-                   break;
+                    break;
                 until false;
                 consume(_COLON);
                 { read the vars }
                 consume(_LKLAMMER);
                 inc(variantrecordlevel);
                 if token<>_RKLAMMER then
-                  read_var_decs([vd_record]);
+                  read_record_fields([vd_record]);
                 dec(variantrecordlevel);
                 consume(_RKLAMMER);
                 { calculates maximal variant size }
@@ -1280,38 +1275,36 @@ implementation
                 else
                   break;
               until (token=_END) or (token=_RKLAMMER);
+              symtablestack.pop(UnionSymtable);
               { at last set the record size to that of the biggest variant }
               unionsymtable.datasize:=maxsize;
               unionsymtable.fieldalignment:=maxalignment;
               uniontype.def:=uniondef;
               uniontype.sym:=nil;
               UnionSym:=tfieldvarsym.create('$case',vs_value,uniontype,[]);
-              symtablestack:=symtablestack.next;
               unionsymtable.addalignmentpadding;
 {$ifdef powerpc}
               { parent inherits the alignment padding if the variant is the first "field" of the parent record/variant }
               if (target_info.system in [system_powerpc_darwin, system_powerpc_macos]) and
                  is_first_field and
-                 (trecordsymtable(symtablestack).usefieldalignment = -1) and
-                 (maxpadalign > trecordsymtable(symtablestack).padalignment) then
-                trecordsymtable(symtablestack).padalignment:=maxpadalign;
+                 (recst.usefieldalignment = -1) and
+                 (maxpadalign > recst.padalignment) then
+                recst.padalignment:=maxpadalign;
 {$endif powerpc}
               { Align the offset where the union symtable is added }
-              if (trecordsymtable(symtablestack).usefieldalignment=-1) then
+              if (recst.usefieldalignment=-1) then
                 usedalign:=used_align(unionsymtable.recordalignment,aktalignment.recordalignmin,aktalignment.maxCrecordalign)
               else
                 usedalign:=used_align(unionsymtable.recordalignment,aktalignment.recordalignmin,aktalignment.recordalignmax);
 
-              offset:=align(trecordsymtable(symtablestack).datasize,usedalign);
-              trecordsymtable(symtablestack).datasize:=offset+unionsymtable.datasize;
+              offset:=align(recst.datasize,usedalign);
+              recst.datasize:=offset+unionsymtable.datasize;
 
-              if unionsymtable.recordalignment>trecordsymtable(symtablestack).fieldalignment then
-                trecordsymtable(symtablestack).fieldalignment:=unionsymtable.recordalignment;
+              if unionsymtable.recordalignment>recst.fieldalignment then
+                recst.fieldalignment:=unionsymtable.recordalignment;
 
-              trecordsymtable(symtablestack).insertunionst(Unionsymtable,offset);
-              Unionsym.owner:=nil;
+              trecordsymtable(recst).insertunionst(Unionsymtable,offset);
               unionsym.free;
-              uniondef.owner:=nil;
               uniondef.free;
            end;
          block_type:=old_block_type;

compiler/pexpr.pas

@@ -50,12 +50,7 @@ interface
     { the ID token has to be consumed before calling this function }
     procedure do_member_read(classh:tobjectdef;getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean;callflags:tcallnodeflags);
 
-{$ifdef int64funcresok}
     function get_intconst:TConstExprInt;
-{$else int64funcresok}
-    function get_intconst:longint;
-{$endif int64funcresok}
-
     function get_stringconst:string;
 
 implementation
@@ -328,7 +323,7 @@ implementation
        end;
 
 
-     function statement_syssym(l : longint) : tnode;
+     function statement_syssym(l : byte) : tnode;
       var
         p1,p2,paras  : tnode;
         err,
@@ -1159,7 +1154,7 @@ implementation
                         begin
                            static_name:=lower(sym.owner.name^)+'_'+sym.name;
                            searchsym(static_name,sym,srsymtable);
-			   if assigned(sym) then
+                           if assigned(sym) then
                              check_hints(sym,sym.symoptions);
                            p1.free;
                            p1:=cloadnode.create(sym,srsymtable);
@@ -1203,7 +1198,7 @@ implementation
            srsym : tsym;
            possible_error : boolean;
            srsymtable : tsymtable;
-           storesymtablestack : tsymtable;
+           hdef  : tdef;
            htype : ttype;
            static_name : string;
          begin
@@ -1226,6 +1221,17 @@ implementation
                )
               ) then
             begin
+              hdef:=tdef(srsym.owner.defowner);
+              if assigned(hdef) and
+                 (hdef.deftype=procdef) then
+                srsym:=tprocdef(hdef).procsym
+              else
+                begin
+                  Message(parser_e_illegal_expression);
+                  srsym:=generrorsym;
+                end;
+              srsymtable:=srsym.owner;
+{
               storesymtablestack:=symtablestack;
               symtablestack:=srsym.owner.next;
               searchsym(srsym.name,srsym,srsymtable);
@@ -1234,6 +1240,7 @@ implementation
               if (srsym.typ<>procsym) then
                Message(parser_e_illegal_expression);
               symtablestack:=storesymtablestack;
+}
             end;
 
             begin
@@ -1260,7 +1267,7 @@ implementation
                      begin
                        static_name:=lower(srsym.owner.name^)+'_'+srsym.name;
                        searchsym(static_name,srsym,srsymtable);
-		       if assigned(srsym) then
+                       if assigned(srsym) then
                          check_hints(srsym,srsym.symoptions);
                      end
                     else
@@ -1334,8 +1341,8 @@ implementation
                                begin
                                  p1:=ctypenode.create(htype);
                                  { search also in inherited methods }
-                                 srsym:=searchsym_in_class(tobjectdef(htype.def),pattern);
-				 if assigned(srsym) then
+                                 searchsym_in_class(tobjectdef(htype.def),pattern,srsym,srsymtable);
+                                 if assigned(srsym) then
                                    check_hints(srsym,srsym.symoptions);
                                  consume(_ID);
                                  do_member_read(tobjectdef(htype.def),false,srsym,p1,again,[]);
@@ -1355,17 +1362,17 @@ implementation
                               { defined in an anchestor class              }
                               srsym:=search_class_member(tobjectdef(htype.def),pattern);
                               if assigned(srsym) then
-			        begin
+                                begin
                                   check_hints(srsym,srsym.symoptions);
-  				  if not(getaddr) and not(sp_static in srsym.symoptions) then
+                                  if not(getaddr) and not(sp_static in srsym.symoptions) then
                                     Message(sym_e_only_static_in_static)
                                   else
                                     begin
                                       consume(_ID);
                                       do_member_read(tobjectdef(htype.def),getaddr,srsym,p1,again,[]);
-				    end;  
+                                    end;
                                 end
-			      else	
+                              else
                                 Message1(sym_e_id_no_member,orgpattern);
                             end;
                          end
@@ -1389,11 +1396,11 @@ implementation
                                    consume(_ID);
                                    do_member_read(tobjectdef(htype.def),getaddr,srsym,p1,again,[]);
                                  end
-				else 
-				 begin
+                                else
+                                 begin
                                    Message1(sym_e_id_no_member,orgpattern);
                                    consume(_ID);
-				 end;
+                                 end;
                               end
                              else
                               begin
@@ -1678,9 +1685,10 @@ implementation
         var
           store_static : boolean;
           protsym  : tpropertysym;
-          p2,p3 : tnode;
-          hsym  : tsym;
-          classh : tobjectdef;
+          p2,p3  : tnode;
+          srsym  : tsym;
+          srsymtable : tsymtable;
+          classh     : tobjectdef;
 
         label
           skipreckklammercheck;
@@ -1835,13 +1843,13 @@ implementation
                         begin
                           if token=_ID then
                             begin
-                              hsym:=tsym(trecorddef(p1.resulttype.def).symtable.search(pattern));
-                              if assigned(hsym) and
-                                 (hsym.typ=fieldvarsym) then
-				begin 
-                                  check_hints(hsym,hsym.symoptions);
-                                  p1:=csubscriptnode.create(hsym,p1)
-				end  
+                              srsym:=tsym(trecorddef(p1.resulttype.def).symtable.search(pattern));
+                              if assigned(srsym) and
+                                 (srsym.typ=fieldvarsym) then
+                                begin
+                                  check_hints(srsym,srsym.symoptions);
+                                  p1:=csubscriptnode.create(srsym,p1)
+                                end
                               else
                                 begin
                                   Message1(sym_e_illegal_field,pattern);
@@ -1859,20 +1867,20 @@ implementation
                            if token=_ID then
                              begin
                                classh:=tobjectdef(tclassrefdef(p1.resulttype.def).pointertype.def);
-                               hsym:=searchsym_in_class(classh,pattern);
-                               if hsym=nil then
+                               searchsym_in_class(classh,pattern,srsym,srsymtable);
+                               if assigned(srsym) then
                                  begin
-                                   Message1(sym_e_id_no_member,orgpattern);
-                                   p1.destroy;
-                                   p1:=cerrornode.create;
-                                   { try to clean up }
+                                   check_hints(srsym,srsym.symoptions);
                                    consume(_ID);
+                                   do_member_read(classh,getaddr,srsym,p1,again,[]);
                                  end
                                else
                                  begin
-                                   check_hints(hsym,hsym.symoptions);
+                                   Message1(sym_e_id_no_member,orgpattern);
+                                   p1.destroy;
+                                   p1:=cerrornode.create;
+                                   { try to clean up }
                                    consume(_ID);
-                                   do_member_read(classh,getaddr,hsym,p1,again,[]);
                                  end;
                              end
                            else { Error }
@@ -1885,21 +1893,21 @@ implementation
                                store_static:=allow_only_static;
                                allow_only_static:=false;
                                classh:=tobjectdef(p1.resulttype.def);
-                               hsym:=searchsym_in_class(classh,pattern);
+                               searchsym_in_class(classh,pattern,srsym,srsymtable);
                                allow_only_static:=store_static;
-                               if hsym=nil then
+                               if assigned(srsym) then
                                  begin
-                                    Message1(sym_e_id_no_member,orgpattern);
-                                    p1.destroy;
-                                    p1:=cerrornode.create;
-                                    { try to clean up }
+                                    check_hints(srsym,srsym.symoptions);
                                     consume(_ID);
+                                    do_member_read(classh,getaddr,srsym,p1,again,[]);
                                  end
                                else
                                  begin
-                                    check_hints(hsym,hsym.symoptions);
+                                    Message1(sym_e_id_no_member,orgpattern);
+                                    p1.destroy;
+                                    p1:=cerrornode.create;
+                                    { try to clean up }
                                     consume(_ID);
-                                    do_member_read(classh,getaddr,hsym,p1,again,[]);
                                  end;
                              end
                            else { Error }
@@ -1964,39 +1972,24 @@ implementation
       ---------------------------------------------}
 
       var
-         l        : longint;
-         ic       : int64;
-         qc       : qword;
+         l          : longint;
+         ic         : int64;
+         qc         : qword;
 {$ifndef cpu64}
-         card     : cardinal;
+         card       : cardinal;
 {$endif cpu64}
          oldp1,
-         p1       : tnode;
-         code     : integer;
-         again    : boolean;
-         sym      : tsym;
-         pd       : tprocdef;
-         classh   : tobjectdef;
-         d        : bestreal;
-         hs,hsorg : string;
-         htype    : ttype;
-         filepos  : tfileposinfo;
-
-         {---------------------------------------------
-                           Helpers
-         ---------------------------------------------}
-
-        procedure check_tokenpos;
-        begin
-          if (p1<>oldp1) then
-           begin
-             if assigned(p1) then
-               p1.fileinfo:=filepos;
-             oldp1:=p1;
-             filepos:=akttokenpos;
-           end;
-        end;
-
+         p1         : tnode;
+         code       : integer;
+         again      : boolean;
+         srsym      : tsym;
+         srsymtable : tsymtable;
+         pd         : tprocdef;
+         classh     : tobjectdef;
+         d          : bestreal;
+         hs,hsorg   : string;
+         htype      : ttype;
+         filepos    : tfileposinfo;
       begin
         oldp1:=nil;
         p1:=nil;
@@ -2017,10 +2010,16 @@ implementation
              end
            else
              factor_read_id(p1,again);
+
            if again then
             begin
-              check_tokenpos;
-
+              if (p1<>oldp1) then
+               begin
+                 if assigned(p1) then
+                   p1.fileinfo:=filepos;
+                 oldp1:=p1;
+                 filepos:=akttokenpos;
+               end;
               { handle post fix operators }
               postfixoperators(p1,again);
             end;
@@ -2051,12 +2050,12 @@ implementation
                        number or string }
                      pd:=tprocsym(current_procinfo.procdef.procsym).first_procdef;
                      if (po_msgint in pd.procoptions) then
-                      sym:=searchsym_in_class_by_msgint(classh,pd.messageinf.i)
+                       searchsym_in_class_by_msgint(classh,pd.messageinf.i,srsym,srsymtable)
                      else
                       if (po_msgstr in pd.procoptions) then
-                       sym:=searchsym_in_class_by_msgstr(classh,pd.messageinf.str)
+                        searchsym_in_class_by_msgstr(classh,pd.messageinf.str,srsym,srsymtable)
                      else
-                      sym:=searchsym_in_class(classh,hs);
+                       searchsym_in_class(classh,hs,srsym,srsymtable);
                    end
                   else
                    begin
@@ -2064,16 +2063,16 @@ implementation
                      hsorg:=orgpattern;
                      consume(_ID);
                      anon_inherited:=false;
-                     sym:=searchsym_in_class(classh,hs);
+                     searchsym_in_class(classh,hs,srsym,srsymtable);
                    end;
-                  if assigned(sym) then
+                  if assigned(srsym) then
                    begin
-                     check_hints(sym,sym.symoptions);
+                     check_hints(srsym,srsym.symoptions);
                      { load the procdef from the inherited class and
                        not from self }
-                     if sym.typ in [procsym,propertysym] then
+                     if srsym.typ in [procsym,propertysym] then
                       begin
-                        if (sym.typ = procsym) then
+                        if (srsym.typ = procsym) then
                           begin
                             htype.setdef(classh);
                             if (po_classmethod in current_procinfo.procdef.procoptions) or
@@ -2087,7 +2086,7 @@ implementation
                         Message(parser_e_methode_id_expected);
                         p1:=cerrornode.create;
                       end;
-                     do_member_read(classh,false,sym,p1,again,[cnf_inherited,cnf_anon_inherited]);
+                     do_member_read(classh,false,srsym,p1,again,[cnf_inherited,cnf_anon_inherited]);
                    end
                   else
                    begin
@@ -2097,12 +2096,12 @@ implementation
                         if (po_msgint in pd.procoptions) or
                            (po_msgstr in pd.procoptions) then
                           begin
-                            sym:=searchsym_in_class(classh,'DEFAULTHANDLER');
-                            if not assigned(sym) or
-                               (sym.typ<>procsym) then
+                            searchsym_in_class(classh,'DEFAULTHANDLER',srsym,srsymtable);
+                            if not assigned(srsym) or
+                               (srsym.typ<>procsym) then
                               internalerror(200303171);
                             p1:=nil;
-                            do_proc_call(sym,sym.owner,classh,false,again,p1,[]);
+                            do_proc_call(srsym,srsym.owner,classh,false,again,p1,[]);
                           end
                         else
                           begin
@@ -2440,8 +2439,10 @@ implementation
         if (not assigned(p1.resulttype.def)) then
          do_resulttypepass(p1);
 
+        if assigned(p1) and
+           (p1<>oldp1) then
+          p1.fileinfo:=filepos;
         factor:=p1;
-        check_tokenpos;
       end;
 {$ifdef fpc}
   {$maxfpuregisters default}
@@ -2632,11 +2633,7 @@ implementation
          expr:=p1;
       end;
 
-{$ifdef int64funcresok}
     function get_intconst:TConstExprInt;
-{$else int64funcresok}
-    function get_intconst:longint;
-{$endif int64funcresok}
     {Reads an expression, tries to evalute it and check if it is an integer
      constant. Then the constant is returned.}
     var

compiler/pinline.pas

@@ -49,7 +49,7 @@ implementation
        globtype,tokens,verbose,
        systems,
        { symtable }
-       symconst,symdef,symsym,symtable,defutil,
+       symbase,symconst,symdef,symsym,symtable,defutil,
        { pass 1 }
        pass_1,htypechk,
        nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
@@ -335,7 +335,8 @@ implementation
         para         : tcallparanode;
         p1,p2  : tnode;
         classh : tobjectdef;
-        sym    : tsym;
+        srsym    : tsym;
+        srsymtable : tsymtable;
         again  : boolean; { dummy for do_proc_call }
       begin
         consume(_LKLAMMER);
@@ -420,9 +421,9 @@ implementation
             { search the constructor also in the symbol tables of
               the parents }
             afterassignment:=false;
-            sym:=searchsym_in_class(classh,pattern);
+            searchsym_in_class(classh,pattern,srsym,srsymtable);
             consume(_ID);
-            do_member_read(classh,false,sym,p1,again,[cnf_new_call]);
+            do_member_read(classh,false,srsym,p1,again,[cnf_new_call]);
             { we need to know which procedure is called }
             do_resulttypepass(p1);
             if not(

compiler/pmodules.pas

@@ -399,17 +399,14 @@ implementation
         hp.loadppu;
         hp.adddependency(current_module);
         { add to symtable stack }
-        tsymtable(hp.globalsymtable).next:=symtablestack;
-        symtablestack:=hp.globalsymtable;
-        if (m_mac in aktmodeswitches) and assigned(hp.globalmacrosymtable) then
-          begin
-            tsymtable(hp.globalmacrosymtable).next:=macrosymtablestack;
-            macrosymtablestack:=hp.globalmacrosymtable;
-          end;
+        symtablestack.push(hp.globalsymtable);
+        if (m_mac in aktmodeswitches) and
+           assigned(hp.globalmacrosymtable) then
+          macrosymtablestack.push(hp.globalmacrosymtable);
         { insert unitsym }
-        unitsym:=tunitsym.create(s,hp.globalsymtable);
+        unitsym:=tunitsym.create(s,hp);
         inc(unitsym.refs);
-        refsymtable.insert(unitsym);
+        current_module.localsymtable.insert(unitsym);
         { add to used units }
         current_module.addusedunit(hp,false,unitsym);
       end;
@@ -440,32 +437,38 @@ implementation
 
     procedure loaddefaultunits;
       begin
-      { are we compiling the system unit? }
+        { we are going to rebuild the symtablestack, clear it first }
+        symtablestack.clear;
+        macrosymtablestack.clear;
+
+        { macro symtable }
+        macrosymtablestack.push(initialmacrosymtable);
+
+        { are we compiling the system unit? }
         if (cs_compilesystem in aktmoduleswitches) then
          begin
-         { create system defines }
-           createconstdefs;
-         { we don't need to reset anything, it's already done in parser.pas }
+           systemunit:=tglobalsymtable(current_module.localsymtable);
+           { create system defines }
+           create_intern_symbols;
+           create_intern_types;
            exit;
          end;
-        { insert the system unit, it is allways the first }
-        symtablestack:=nil;
-        macrosymtablestack:=initialmacrosymtable;
+
+        { insert the system unit, it is allways the first. Load also the
+          internal types from the system unit }
         AddUnit('System');
-        SystemUnit:=TGlobalSymtable(Symtablestack);
-        { read default constant definitions }
-        make_ref:=false;
-        readconstdefs;
-        make_ref:=true;
+        systemunit:=tglobalsymtable(symtablestack.top);
+        load_intern_types;
+
         { Set the owner of errorsym and errortype to symtable to
           prevent crashes when accessing .owner }
         generrorsym.owner:=systemunit;
         generrortype.def.owner:=systemunit;
+
         { Units only required for main module }
-        { load heaptrace before any other units especially objpas }
         if not(current_module.is_unit) then
          begin
-           { Heaptrc unit }
+           { Heaptrc unit, load heaptrace before any other units especially objpas }
            if (cs_use_heaptrc in aktglobalswitches) then
              AddUnit('HeapTrc');
            { Lineinfo unit }
@@ -495,9 +498,6 @@ implementation
             AddUnit('FPCylix');
             AddUnit('DynLibs');
           end;
-        { save default symtablestack }
-        defaultsymtablestack:=symtablestack;
-        defaultmacrosymtablestack:=macrosymtablestack;
       end;
 
 
@@ -521,15 +521,9 @@ implementation
          fn      : string;
          pu      : tused_unit;
          hp2     : tmodule;
-         hp3     : tsymtable;
          unitsym : tunitsym;
-         top_of_macrosymtable : tsymtable;
-
       begin
          consume(_USES);
-{$ifdef DEBUG}
-         test_symtablestack;
-{$endif DEBUG}
          repeat
            s:=pattern;
            sorg:=orgpattern;
@@ -568,7 +562,7 @@ implementation
                 can not use the modulename because that can be different
                 when -Un is used }
               unitsym:=tunitsym.create(sorg,nil);
-              refsymtable.insert(unitsym);
+              current_module.localsymtable.insert(unitsym);
               { the current module uses the unit hp2 }
               current_module.addusedunit(hp2,true,unitsym);
             end
@@ -584,7 +578,6 @@ implementation
          until false;
 
          { Load the units }
-         top_of_macrosymtable:= macrosymtablestack;
          pu:=tused_unit(current_module.used_units.first);
          while assigned(pu) do
           begin
@@ -602,53 +595,17 @@ implementation
                { save crc values }
                pu.checksum:=pu.u.crc;
                pu.interface_checksum:=pu.u.interface_crc;
-               { connect unitsym to the globalsymtable of the unit }
-               pu.unitsym.unitsymtable:=pu.u.globalsymtable;
+               { connect unitsym to the module }
+               pu.unitsym.module:=pu.u;
+               { add to symtable stack }
+               symtablestack.push(pu.u.globalsymtable);
+               if (m_mac in aktmodeswitches) and
+                  assigned(pu.u.globalmacrosymtable) then
+                 macrosymtablestack.push(pu.u.globalmacrosymtable);
              end;
             pu:=tused_unit(pu.next);
           end;
 
-         { set the symtable to systemunit so it gets reorderd correctly,
-           then insert the units in the symtablestack }
-         pu:=tused_unit(current_module.used_units.first);
-         symtablestack:=defaultsymtablestack;
-         macrosymtablestack:=defaultmacrosymtablestack;
-         while assigned(pu) do
-           begin
-              if pu.in_uses then
-                begin
-                   { Reinsert in symtablestack }
-                   hp3:=symtablestack;
-                   while assigned(hp3) do
-                     begin
-                        { insert units only once ! }
-                        if pu.u.globalsymtable=hp3 then
-                          break;
-                        hp3:=hp3.next;
-                        { unit isn't inserted }
-                        if hp3=nil then
-                          begin
-                             tsymtable(pu.u.globalsymtable).next:=symtablestack;
-                             symtablestack:=tsymtable(pu.u.globalsymtable);
-                             if (m_mac in aktmodeswitches) and assigned(pu.u.globalmacrosymtable) then
-                               begin
-                                 tsymtable(pu.u.globalmacrosymtable).next:=macrosymtablestack;
-                                 macrosymtablestack:=tsymtable(pu.u.globalmacrosymtable);
-                               end;
-{$ifdef DEBUG}
-                             test_symtablestack;
-{$endif DEBUG}
-                          end;
-                     end;
-                end;
-              pu:=tused_unit(pu.next);
-           end;
-
-         if assigned (current_module.globalmacrosymtable) then
-           top_of_macrosymtable.next.next:= macrosymtablestack
-         else
-           top_of_macrosymtable.next:= macrosymtablestack;
-         macrosymtablestack:= top_of_macrosymtable;
          consume(_SEMICOLON);
       end;
 
@@ -718,12 +675,7 @@ implementation
     procedure parse_implementation_uses;
       begin
          if token=_USES then
-           begin
-              loadunits;
-{$ifdef DEBUG}
-              test_symtablestack;
-{$endif DEBUG}
-           end;
+           loadunits;
       end;
 
 
@@ -740,7 +692,6 @@ implementation
 
     function create_main_proc(const name:string;potype:tproctypeoption;st:tsymtable):tprocdef;
       var
-        stt : tsymtable;
         ps  : tprocsym;
         pd  : tprocdef;
       begin
@@ -748,22 +699,14 @@ implementation
         if assigned(current_procinfo) then
          internalerror(200304275);
         {Generate a procsym for main}
-        make_ref:=false;
-        { try to insert in in static symtable ! }
-        stt:=symtablestack;
-        symtablestack:=st;
-        { generate procsym }
         ps:=tprocsym.create('$'+name);
         { main are allways used }
         inc(ps.refs);
-        symtablestack.insert(ps);
+        st.insert(ps);
         pd:=tprocdef.create(main_program_level);
         include(pd.procoptions,po_global);
         pd.procsym:=ps;
         ps.addprocdef(pd);
-        { restore symtable }
-        make_ref:=true;
-        symtablestack:=stt;
         { set procdef options }
         pd.proctypeoption:=potype;
         pd.proccalloption:=pocall_default;
@@ -828,15 +771,13 @@ implementation
         release_main_proc(pd);
       end;
 
-    procedure delete_duplicate_macros(p:TNamedIndexItem; arg:pointer);
-      var
-        hp: tsymentry;
+
+    procedure copy_macro(p:TNamedIndexItem; arg:pointer);
       begin
-        hp:= current_module.localmacrosymtable.search(p.name);
-        if assigned(hp) then
-          current_module.localmacrosymtable.delete(hp);
+        current_module.globalmacrosymtable.insert(tmacro(p).getcopy);
       end;
 
+
     procedure proc_unit;
 
       function is_assembler_generated:boolean;
@@ -857,8 +798,6 @@ implementation
 
       var
          main_file: tinputfile;
-         st     : tsymtable;
-         unitst : tglobalsymtable;
 {$ifdef EXTDEBUG}
          store_crc,
 {$endif EXTDEBUG}
@@ -871,10 +810,7 @@ implementation
          globalvarsym : tglobalvarsym;
       begin
          if m_mac in aktmodeswitches then
-           begin
-             ConsolidateMode;
-             current_module.mode_switch_allowed:= false;
-           end;
+           current_module.mode_switch_allowed:= false;
 
          consume(_UNIT);
          if compile_level=1 then
@@ -928,7 +864,6 @@ implementation
          current_module.in_global:=false;
 
          { handle the global switches }
-         ConsolidateMode;
          setupglobalswitches;
 
          message1(unit_u_loading_interface_units,current_module.modulename^);
@@ -946,62 +881,31 @@ implementation
 
          parse_only:=true;
 
-         { generate now the global symboltable }
-         st:=tglobalsymtable.create(current_module.modulename^,current_module.moduleid);
-         refsymtable:=st;
-         unitst:=tglobalsymtable(st);
-         { define first as local to overcome dependency conflicts }
-         current_module.localsymtable:=st;
+         { generate now the global symboltable,
+           define first as local to overcome dependency conflicts }
+         current_module.localsymtable:=tglobalsymtable.create(current_module.modulename^,current_module.moduleid);
 
-         { the unit name must be usable as a unit specifier }
-         { inside the unit itself (PM)                }
-         { this also forbids to have another symbol      }
-         { with the same name as the unit                  }
-         refsymtable.insert(tunitsym.create(current_module.realmodulename^,unitst));
-
-         macrosymtablestack:= initialmacrosymtable;
+         { insert unitsym of this unit to prevent other units having
+           the same name }
+         current_module.localsymtable.insert(tunitsym.create(current_module.realmodulename^,current_module));
 
          { load default units, like the system unit }
          loaddefaultunits;
 
-         current_module.localmacrosymtable.next:=macrosymtablestack;
-         if assigned(current_module.globalmacrosymtable) then
-           begin
-             current_module.globalmacrosymtable.next:= current_module.localmacrosymtable;
-             macrosymtablestack:=current_module.globalmacrosymtable;
-           end
-         else
-           macrosymtablestack:=current_module.localmacrosymtable;
-
          { reset }
          make_ref:=true;
 
          { insert qualifier for the system unit (allows system.writeln) }
-         if not(cs_compilesystem in aktmoduleswitches) then
-           begin
-              if token=_USES then
-                begin
-                   loadunits;
-                   { has it been compiled at a higher level ?}
-                   if current_module.state=ms_compiled then
-                     exit;
-                end;
-              { ... but insert the symbol table later }
-              st.next:=symtablestack;
-              symtablestack:=st;
-           end
-         else
-         { while compiling a system unit, some types are directly inserted }
+         if not(cs_compilesystem in aktmoduleswitches) and
+            (token=_USES) then
            begin
-              st.next:=symtablestack;
-              symtablestack:=st;
-              insert_intern_types(st);
+             loadunits;
+             { has it been compiled at a higher level ?}
+             if current_module.state=ms_compiled then
+               exit;
            end;
 
-         { now we know the place to insert the constants }
-         constsymtable:=symtablestack;
-
-         { move the global symtab from the temporary local to global }
+         { move the global symtable from the temporary local to global }
          current_module.globalsymtable:=current_module.localsymtable;
          current_module.localsymtable:=nil;
 
@@ -1013,7 +917,18 @@ implementation
 
          { ... parse the declarations }
          Message1(parser_u_parsing_interface,current_module.realmodulename^);
+         symtablestack.push(current_module.globalsymtable);
          read_interface_declarations;
+         symtablestack.pop(current_module.globalsymtable);
+
+         { Export macros defined in the interface for macpas. The macros
+           are put in the globalmacrosymtable that will only be used by other
+           units. The current unit continues to use the localmacrosymtable }
+         if (m_mac in aktmodeswitches) then
+          begin
+            current_module.globalmacrosymtable:=tmacrosymtable.create(true);
+            current_module.localmacrosymtable.foreach_static(@copy_macro,nil);
+          end;
 
          { leave when we got an error }
          if (Errorcount>0) and not status.skip_error then
@@ -1043,8 +958,7 @@ implementation
          parse_only:=false;
 
          { generates static symbol table }
-         st:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
-         current_module.localsymtable:=st;
+         current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
 
 {$ifdef i386}
          if cs_create_pic in aktmoduleswitches then
@@ -1059,23 +973,6 @@ implementation
            end;
 {$endif i386}
 
-         { Swap the positions of the local and global macro sym table}
-         if assigned(current_module.globalmacrosymtable) then
-           begin
-             macrosymtablestack:=current_module.localmacrosymtable;
-             current_module.globalmacrosymtable.next:= current_module.localmacrosymtable.next;
-             current_module.localmacrosymtable.next:=current_module.globalmacrosymtable;
-
-             current_module.globalmacrosymtable.foreach_static(@delete_duplicate_macros, nil);
-           end;
-
-         { remove the globalsymtable from the symtable stack }
-         { to reinsert it after loading the implementation units }
-         symtablestack:=unitst.next;
-
-         { we don't want implementation units symbols in unitsymtable !! PM }
-         refsymtable:=st;
-
          if has_impl then
            begin
              consume(_IMPLEMENTATION);
@@ -1093,17 +990,8 @@ implementation
          { All units are read, now give them a number }
          current_module.updatemaps;
 
-         { now we can change refsymtable }
-         refsymtable:=st;
-
-         { but reinsert the global symtable as lasts }
-         unitst.next:=symtablestack;
-         symtablestack:=unitst;
-
-{$ifdef DEBUG}
-         test_symtablestack;
-{$endif DEBUG}
-         constsymtable:=symtablestack;
+         symtablestack.push(current_module.globalsymtable);
+         symtablestack.push(current_module.localsymtable);
 
          if has_impl then
            begin
@@ -1112,7 +1000,7 @@ implementation
                internalerror(200212285);
 
              { Compile the unit }
-             pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'init'),potype_unitinit,st);
+             pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'init'),potype_unitinit,current_module.localsymtable);
              pd.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
              tcgprocinfo(current_procinfo).parse_body;
              tcgprocinfo(current_procinfo).generate_code;
@@ -1133,7 +1021,7 @@ implementation
          { should we force unit initialization? }
          { this is a hack, but how can it be done better ? }
          if force_init_final and ((current_module.flags and uf_init)=0) then
-           gen_implicit_initfinal(uf_init,st);
+           gen_implicit_initfinal(uf_init,current_module.localsymtable);
          { finalize? }
          if has_impl and (token=_FINALIZATION) then
            begin
@@ -1141,7 +1029,7 @@ implementation
               current_module.flags:=current_module.flags or uf_finalize;
 
               { Compile the finalize }
-              pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,st);
+              pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
               pd.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
               tcgprocinfo(current_procinfo).parse_body;
               tcgprocinfo(current_procinfo).generate_code;
@@ -1149,7 +1037,10 @@ implementation
               release_main_proc(pd);
            end
          else if force_init_final then
-           gen_implicit_initfinal(uf_finalize,st);
+           gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
+
+         symtablestack.pop(current_module.localsymtable);
+         symtablestack.pop(current_module.globalsymtable);
 
          { the last char should always be a point }
          consume(_POINT);
@@ -1167,18 +1058,18 @@ implementation
          if (Errorcount=0) then
            begin
              { tests, if all (interface) forwards are resolved }
-             tstoredsymtable(symtablestack).check_forwards;
+             tstoredsymtable(current_module.globalsymtable).check_forwards;
              { check if all private fields are used }
-             tstoredsymtable(symtablestack).allprivatesused;
+             tstoredsymtable(current_module.globalsymtable).allprivatesused;
              { remove cross unit overloads }
-             tstoredsymtable(symtablestack).unchain_overloaded;
+             tstoredsymtable(current_module.globalsymtable).unchain_overloaded;
 
              { test static symtable }
-             tstoredsymtable(st).allsymbolsused;
-             tstoredsymtable(st).allprivatesused;
-             tstoredsymtable(st).check_forwards;
-             tstoredsymtable(st).checklabels;
-             tstoredsymtable(st).unchain_overloaded;
+             tstoredsymtable(current_module.localsymtable).allsymbolsused;
+             tstoredsymtable(current_module.localsymtable).allprivatesused;
+             tstoredsymtable(current_module.localsymtable).check_forwards;
+             tstoredsymtable(current_module.localsymtable).checklabels;
+             tstoredsymtable(current_module.localsymtable).unchain_overloaded;
 
              { used units }
              current_module.allunitsused;
@@ -1225,15 +1116,10 @@ implementation
              current_module.flags:=current_module.flags and not uf_has_debuginfo;
            end;
 
-         if cs_local_browser in aktmoduleswitches then
-           current_module.localsymtable:=refsymtable;
-
          if ag then
           begin
             { create dwarf debuginfo }
             create_dwarf;
-            { finish asmlist by adding segment starts }
-//            insertsegment;
             { assemble }
             create_objectfile;
           end;
@@ -1262,14 +1148,6 @@ implementation
          free_localsymtables(current_module.globalsymtable);
          free_localsymtables(current_module.localsymtable);
 
-         { remove static symtable (=refsymtable) here to save some mem, possible references
-           (like procsym overloads) should already have been freed above }
-         if not (cs_local_browser in aktmoduleswitches) then
-           begin
-              st.free;
-              current_module.localsymtable:=nil;
-           end;
-
          { leave when we got an error }
          if (Errorcount>0) and not status.skip_error then
           begin
@@ -1285,7 +1163,6 @@ implementation
     procedure proc_program(islibrary : boolean);
       var
          main_file : tinputfile;
-         st        : tsymtable;
          hp,hp2    : tmodule;
          pd        : tprocdef;
       begin
@@ -1370,7 +1247,6 @@ implementation
          current_module.in_global:=false;
 
          { setup things using the switches }
-         ConsolidateMode;
          setupglobalswitches;
 
          { set implementation flag }
@@ -1379,18 +1255,11 @@ implementation
 
          { insert after the unit symbol tables the static symbol table }
          { of the program                                             }
-         st:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
-         current_module.localsymtable:=st;
-         refsymtable:=st;
-
-         macrosymtablestack:= nil;
+         current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
 
          { load standard units (system,objpas,profile unit) }
          loaddefaultunits;
 
-         current_module.localmacrosymtable.next:=macrosymtablestack;
-         macrosymtablestack:=current_module.localmacrosymtable;
-
          { Load units provided on the command line }
          loadautounits;
 
@@ -1406,32 +1275,28 @@ implementation
 
          {Insert the name of the main program into the symbol table.}
          if current_module.realmodulename^<>'' then
-           st.insert(tunitsym.create(current_module.realmodulename^,st));
-
-         { ...is also constsymtable, this is the symtable where }
-         { the elements of enumeration types are inserted       }
-         constsymtable:=st;
+           current_module.localsymtable.insert(tunitsym.create(current_module.realmodulename^,current_module));
 
          Message1(parser_u_parsing_implementation,current_module.mainsource^);
 
+         symtablestack.push(current_module.localsymtable);
+
          { The program intialization needs an alias, so it can be called
            from the bootstrap code.}
-
          if islibrary then
           begin
-            pd:=create_main_proc(make_mangledname('',current_module.localsymtable,mainaliasname),potype_proginit,st);
+            pd:=create_main_proc(make_mangledname('',current_module.localsymtable,mainaliasname),potype_proginit,current_module.localsymtable);
             { Win32 startup code needs a single name }
-//            if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
             pd.aliasnames.insert('PASCALMAIN');
           end
          else if (target_info.system = system_i386_netware) or
                  (target_info.system = system_i386_netwlibc) then
            begin
-             pd:=create_main_proc('PASCALMAIN',potype_proginit,st); { main is need by the netware rtl }
+             pd:=create_main_proc('PASCALMAIN',potype_proginit,current_module.localsymtable);
            end
          else
            begin
-             pd:=create_main_proc(mainaliasname,potype_proginit,st);
+             pd:=create_main_proc(mainaliasname,potype_proginit,current_module.localsymtable);
              pd.aliasnames.insert('PASCALMAIN');
            end;
          tcgprocinfo(current_procinfo).parse_body;
@@ -1448,9 +1313,9 @@ implementation
          if tstaticsymtable(current_module.localsymtable).needs_init_final then
            begin
               { initialize section }
-              gen_implicit_initfinal(uf_init,st);
+              gen_implicit_initfinal(uf_init,current_module.localsymtable);
               { finalize section }
-              gen_implicit_initfinal(uf_finalize,st);
+              gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
            end;
 
          { Add symbol to the exports section for win32 so smartlinking a
@@ -1475,7 +1340,7 @@ implementation
               current_module.flags:=current_module.flags or uf_finalize;
 
               { Compile the finalize }
-              pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,st);
+              pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
               pd.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
               tcgprocinfo(current_procinfo).parse_body;
               tcgprocinfo(current_procinfo).generate_code;
@@ -1483,17 +1348,20 @@ implementation
               release_main_proc(pd);
            end;
 
+         symtablestack.pop(current_module.localsymtable);
+
          { consume the last point }
          consume(_POINT);
 
          if (Errorcount=0) then
            begin
              { test static symtable }
-             tstoredsymtable(st).allsymbolsused;
-             tstoredsymtable(st).allprivatesused;
-             tstoredsymtable(st).check_forwards;
-             tstoredsymtable(st).checklabels;
-             tstoredsymtable(st).unchain_overloaded;
+             tstoredsymtable(current_module.localsymtable).allsymbolsused;
+             tstoredsymtable(current_module.localsymtable).allprivatesused;
+             tstoredsymtable(current_module.localsymtable).check_forwards;
+             tstoredsymtable(current_module.localsymtable).checklabels;
+             tstoredsymtable(current_module.localsymtable).unchain_overloaded;
+
              current_module.allunitsused;
            end;
 
@@ -1555,9 +1423,6 @@ implementation
          { create dwarf debuginfo }
          create_dwarf;
 
-         { finish asmlist by adding segment starts }
-//         insertsegment;
-
          { insert own objectfile }
          insertobjectfile;
 

compiler/pstatmnt.pas

@@ -39,7 +39,7 @@ implementation
 
     uses
        { common }
-       cutils,
+       cutils,cclasses,
        { global }
        globtype,globals,verbose,
        systems,
@@ -433,26 +433,46 @@ implementation
     function _with_statement : tnode;
 
       var
-         right,p : tnode;
-         i,levelcount : longint;
-         withsymtable,symtab : tsymtable;
-         obj : tobjectdef;
-         hp : tnode;
+         p   : tnode;
+         i   : longint;
+         st  : tsymtable;
          newblock : tblocknode;
          newstatement : tstatementnode;
-         calltempp,
-         loadp : ttempcreatenode;
-         refp : tnode;
+         calltempnode,
+         tempnode : ttempcreatenode;
+         valuenode,
+         hp,
+         refnode  : tnode;
          htype : ttype;
          hasimplicitderef : boolean;
+         withsymtablelist : tlist;
+
+         procedure pushobjchild(obj:tobjectdef);
+         begin
+           if not assigned(obj) then
+             exit;
+           pushobjchild(obj.childof);
+           { keep the original tobjectdef as owner, because that is used for
+             visibility of the symtable }
+           st:=twithsymtable.create(tobjectdef(p.resulttype.def),obj.symtable.symsearch,refnode.getcopy);
+           symtablestack.push(st);
+           withsymtablelist.add(st);
+         end;
+
       begin
          p:=comp_expr(true);
          do_resulttypepass(p);
-         right:=nil;
-         if (not codegenerror) and
-            (p.resulttype.def.deftype in [objectdef,recorddef]) then
+
+         if (p.nodetype=vecn) and
+            (nf_memseg in p.flags) then
+           CGMessage(parser_e_no_with_for_variable_in_other_segments);
+
+         if (p.resulttype.def.deftype in [objectdef,recorddef]) then
           begin
             newblock:=nil;
+            valuenode:=nil;
+            tempnode:=nil;
+
             { ignore nodes that don't add instructions in the tree }
             hp:=p;
             while { equal type conversions }
@@ -472,113 +492,107 @@ implementation
                 (tloadnode(hp).symtable=current_procinfo.procdef.parast) or
                 (tloadnode(hp).symtable.symtabletype in [staticsymtable,globalsymtable])
                ) then
-             begin
-               { simple load, we can reference direct }
-               loadp:=nil;
-               refp:=p;
-             end
+              begin
+                { simple load, we can reference direct }
+                refnode:=p;
+              end
             else
-             begin
-               calltempp:=nil;
-               { complex load, load in temp first }
-               newblock:=internalstatements(newstatement);
-               { when right is a call then load it first in a temp }
-               if p.nodetype=calln then
-                 begin
-                   calltempp:=ctempcreatenode.create(p.resulttype,p.resulttype.def.size,tt_persistent,false);
-                   addstatement(newstatement,calltempp);
-                   addstatement(newstatement,cassignmentnode.create(
-                       ctemprefnode.create(calltempp),
-                       p));
-                   p:=ctemprefnode.create(calltempp);
-                   resulttypepass(p);
-                 end;
-               { classes and interfaces have implicit dereferencing }
-               hasimplicitderef:=is_class_or_interface(p.resulttype.def);
-               if hasimplicitderef then
-                 htype:=p.resulttype
-               else
-                 htype.setdef(tpointerdef.create(p.resulttype));
-{$ifdef WITHNODEDEBUG}
-               { we can't generate debuginfo for a withnode stored in a }
-               { register                                               }
-               if (cs_debuginfo in aktmoduleswitches) then
-                 loadp:=ctempcreatenode.create(htype,sizeof(aint),tt_persistent,false)
-               else
-{$endif WITHNODEDEBUG}
-                 loadp:=ctempcreatenode.create(htype,sizeof(aint),tt_persistent,true);
-               resulttypepass(loadp);
-               if hasimplicitderef then
-                begin
-                  hp:=p;
-                  refp:=ctemprefnode.create(loadp);
-                end
-               else
-                begin
-                  hp:=caddrnode.create_internal(p);
-                  refp:=cderefnode.create(ctemprefnode.create(loadp));
-                end;
-               addstatement(newstatement,loadp);
-               addstatement(newstatement,cassignmentnode.create(
-                   ctemprefnode.create(loadp),
-                   hp));
-               resulttypepass(refp);
-             end;
+              begin
+                calltempnode:=nil;
+                { complex load, load in temp first }
+                newblock:=internalstatements(newstatement);
+                { when right is a call then load it first in a temp }
+                if p.nodetype=calln then
+                  begin
+                    calltempnode:=ctempcreatenode.create(p.resulttype,p.resulttype.def.size,tt_persistent,false);
+                    addstatement(newstatement,calltempnode);
+                    addstatement(newstatement,cassignmentnode.create(
+                        ctemprefnode.create(calltempnode),
+                        p));
+                    p:=ctemprefnode.create(calltempnode);
+                    resulttypepass(p);
+                  end;
+                { classes and interfaces have implicit dereferencing }
+                hasimplicitderef:=is_class_or_interface(p.resulttype.def);
+                if hasimplicitderef then
+                  htype:=p.resulttype
+                else
+                  htype.setdef(tpointerdef.create(p.resulttype));
+                { load address of the value in a temp }
+                tempnode:=ctempcreatenode.create(htype,sizeof(aint),tt_persistent,true);
+                resulttypepass(tempnode);
+                valuenode:=p;
+                refnode:=ctemprefnode.create(tempnode);
+                fillchar(refnode.fileinfo,sizeof(tfileposinfo),0);
+                { add address call for valuenode and deref for refnode if this
+                  is not done implicitly }
+                if not hasimplicitderef then
+                  begin
+                    valuenode:=caddrnode.create_internal(valuenode);
+                    refnode:=cderefnode.create(refnode);
+                    fillchar(refnode.fileinfo,sizeof(tfileposinfo),0);
+                  end;
+                addstatement(newstatement,tempnode);
+                addstatement(newstatement,cassignmentnode.create(
+                    ctemprefnode.create(tempnode),
+                    valuenode));
+                resulttypepass(refnode);
+              end;
 
+            withsymtablelist:=tlist.create;
             case p.resulttype.def.deftype of
               objectdef :
                 begin
-                   obj:=tobjectdef(p.resulttype.def);
-                   withsymtable:=twithsymtable.Create(obj,obj.symtable.symsearch,refp);
-                   { include also all parent symtables }
-                   levelcount:=1;
-                   obj:=obj.childof;
-                   symtab:=withsymtable;
-                   while assigned(obj) do
-                    begin
-                      { keep the original tobjectdef as owner, because that is used for
-                        visibility of the symtable }
-                      symtab.next:=twithsymtable.create(tobjectdef(p.resulttype.def),obj.symtable.symsearch,refp.getcopy);
-                      symtab:=symtab.next;
-                      obj:=obj.childof;
-                      inc(levelcount);
-                    end;
-                   symtab.next:=symtablestack;
-                   symtablestack:=withsymtable;
+                   { push symtables of all parents in reverse order }
+                   pushobjchild(tobjectdef(p.resulttype.def).childof);
+                   { push object symtable }
+                   st:=twithsymtable.Create(tobjectdef(p.resulttype.def),tobjectdef(p.resulttype.def).symtable.symsearch,refnode);
+                   symtablestack.push(st);
+                   withsymtablelist.add(st);
                  end;
               recorddef :
                 begin
-                   symtab:=trecorddef(p.resulttype.def).symtable;
-                   levelcount:=1;
-                   withsymtable:=twithsymtable.create(trecorddef(p.resulttype.def),symtab.symsearch,refp);
-                   withsymtable.next:=symtablestack;
-                   symtablestack:=withsymtable;
+                   st:=twithsymtable.create(trecorddef(p.resulttype.def),trecorddef(p.resulttype.def).symtable.symsearch,refnode);
+                   symtablestack.push(st);
+                   withsymtablelist.add(st);
                 end;
+              else
+                internalerror(200601271);
             end;
+
             if try_to_consume(_COMMA) then
-              right:=_with_statement()
+              p:=_with_statement()
             else
               begin
                 consume(_DO);
                 if token<>_SEMICOLON then
-                  right:=statement
+                  p:=statement
                 else
-                  right:=cerrornode.create;
+                  p:=cerrornode.create;
               end;
-            { remove symtables from the stack }
-            for i:=1 to levelcount do
-              symtablestack:=symtablestack.next;
-            p:=cwithnode.create(right,twithsymtable(withsymtable),levelcount,refp);
+
+            { remove symtables in reverse order from the stack }
+            for i:=withsymtablelist.count-1 downto 0 do
+              begin
+                st:=tsymtable(withsymtablelist[i]);
+                symtablestack.pop(st);
+                st.free;
+              end;
+            withsymtablelist.free;
+
+//            p:=cwithnode.create(right,twithsymtable(withsymtable),levelcount,refnode);
+
             { Finalize complex withnode with destroy of temp }
             if assigned(newblock) then
              begin
                addstatement(newstatement,p);
-               addstatement(newstatement,ctempdeletenode.create(loadp));
-               if assigned(calltempp) then
-                 addstatement(newstatement,ctempdeletenode.create(calltempp));
+               if assigned(tempnode) then
+                 addstatement(newstatement,ctempdeletenode.create(tempnode));
+               if assigned(calltempnode) then
+                 addstatement(newstatement,ctempdeletenode.create(calltempnode));
                p:=newblock;
              end;
-            _with_statement:=p;
+            result:=p;
           end
          else
           begin
@@ -597,7 +611,7 @@ implementation
                if token<>_SEMICOLON then
                 statement;
              end;
-            _with_statement:=nil;
+            result:=nil;
           end;
       end;
 
@@ -734,9 +748,7 @@ implementation
                                  end;
                                exceptsymtable:=tstt_exceptsymtable.create;
                                exceptsymtable.insert(sym);
-                               { insert the exception symtable stack }
-                               exceptsymtable.next:=symtablestack;
-                               symtablestack:=exceptsymtable;
+                               symtablestack.push(exceptsymtable);
                             end
                           else
                             begin
@@ -751,7 +763,7 @@ implementation
                                if srsym.typ=unitsym then
                                  begin
                                     consume(_POINT);
-                                    srsym:=searchsymonlyin(tunitsym(srsym).unitsymtable,pattern);
+                                    searchsym_in_module(tunitsym(srsym).module,pattern,srsym,srsymtable);
                                     if srsym=nil then
                                      begin
                                        identifier_not_found(orgpattern);
@@ -805,7 +817,7 @@ implementation
                      { remove exception symtable }
                      if assigned(exceptsymtable) then
                        begin
-                         symtablestack:=symtablestack.next;
+                         symtablestack.pop(exceptsymtable);
                          if last.nodetype <> onn then
                            exceptsymtable.free;
                        end;
@@ -1123,7 +1135,7 @@ implementation
       begin
          { Rename the funcret so that recursive calls are possible }
          if not is_void(current_procinfo.procdef.rettype.def) then
-           symtablestack.rename(current_procinfo.procdef.resultname,'$hiddenresult');
+           current_procinfo.procdef.localst.rename(current_procinfo.procdef.resultname,'$hiddenresult');
 
          { delphi uses register calling for assembler methods }
          if (m_delphi in aktmodeswitches) and

compiler/psub.pas

@@ -229,8 +229,8 @@ implementation
          else
             begin
                block:=statement_block(_BEGIN);
-               if symtablestack.symtabletype=localsymtable then
-                 symtablestack.foreach_static(@initializevars,block);
+               if current_procinfo.procdef.localst.symtabletype=localsymtable then
+                 current_procinfo.procdef.localst.foreach_static(@initializevars,block);
             end;
       end;
 
@@ -711,8 +711,8 @@ implementation
           cg.t_times:=100;
 
         { clear register count }
-        symtablestack.foreach_static(@clearrefs,nil);
-        symtablestack.next.foreach_static(@clearrefs,nil);
+        procdef.localst.foreach_static(@clearrefs,nil);
+        procdef.parast.foreach_static(@clearrefs,nil);
 
         { there's always a call to FPC_INITIALIZEUNITS/FPC_DO_EXIT in the main program }
         if (procdef.localst.symtablelevel=main_program_level) and
@@ -720,14 +720,14 @@ implementation
           include(flags,pi_do_call);
 
         { set implicit_finally flag when there are locals/paras to be finalized }
-        current_procinfo.procdef.parast.foreach_static(@check_finalize_paras,nil);
-        current_procinfo.procdef.localst.foreach_static(@check_finalize_locals,nil);
+        procdef.parast.foreach_static(@check_finalize_paras,nil);
+        procdef.localst.foreach_static(@check_finalize_locals,nil);
 
         { firstpass everything }
         flowcontrol:=[];
         do_firstpass(code);
         if code.registersfpu>0 then
-          include(current_procinfo.flags,pi_uses_fpu);
+          include(flags,pi_uses_fpu);
 
         { add implicit entry and exit code }
         add_entry_exit_code;
@@ -888,7 +888,7 @@ implementation
               generate the call to the helper function }
             if (cs_check_stack in entryswitches) and
                not(po_assembler in procdef.procoptions) and
-               (current_procinfo.procdef.proctypeoption<>potype_proginit) then
+               (procdef.proctypeoption<>potype_proginit) then
               begin
                 aktfilepos:=entrypos;
                 gen_stack_check_call(templist);
@@ -924,7 +924,7 @@ implementation
               parameter that is passed to the stack checking code }
             if (cs_check_stack in entryswitches) and
                not(po_assembler in procdef.procoptions) and
-               (current_procinfo.procdef.proctypeoption<>potype_proginit) then
+               (procdef.proctypeoption<>potype_proginit) then
               begin
                 aktfilepos:=entrypos;
                 gen_stack_check_size_para(templist);
@@ -1015,9 +1015,6 @@ implementation
       var
         _class,hp : tobjectdef;
       begin
-        { allocate the symbol for this procedure }
-        alloc_proc_symbol(procdef);
-
         { insert symtables for the class, but only if it is no nested function }
         if assigned(procdef._class) and
            not(assigned(parent) and
@@ -1031,35 +1028,44 @@ implementation
               while _class.childof<>hp do
                 _class:=_class.childof;
               hp:=_class;
-              _class.symtable.next:=symtablestack;
-              symtablestack:=_class.symtable;
+              symtablestack.push(_class.symtable);
             until hp=procdef._class;
           end;
 
         { insert parasymtable in symtablestack when parsing
           a function }
         if procdef.parast.symtablelevel>=normal_function_level then
-          begin
-             procdef.parast.next:=symtablestack;
-             symtablestack:=procdef.parast;
-          end;
+          symtablestack.push(procdef.parast);
 
-        procdef.localst.next:=symtablestack;
-        symtablestack:=procdef.localst;
+        { insert localsymtable }
+        symtablestack.push(procdef.localst);
       end;
 
 
     procedure tcgprocinfo.remove_from_symtablestack;
+      var
+        _class : tobjectdef;
       begin
-        { remove localst/parast }
+        { remove localsymtable }
+        symtablestack.pop(procdef.localst);
+
+        { remove parasymtable }
         if procdef.parast.symtablelevel>=normal_function_level then
-          symtablestack:=symtablestack.next.next
-        else
-          symtablestack:=symtablestack.next;
+          symtablestack.pop(procdef.parast);
 
-        { remove class member symbol tables }
-        while symtablestack.symtabletype=objectsymtable do
-          symtablestack:=symtablestack.next;
+        { remove symtables for the class, but only if it is no nested function }
+        if assigned(procdef._class) and
+           not(assigned(parent) and
+               assigned(parent.procdef) and
+               assigned(parent.procdef._class)) then
+          begin
+            _class:=procdef._class;
+            while assigned(_class) do
+              begin
+                symtablestack.pop(_class.symtable);
+                _class:=_class.childof;
+              end;
+          end;
       end;
 
 
@@ -1103,12 +1109,10 @@ implementation
       var
          oldprocinfo : tprocinfo;
          oldblock_type : tblock_type;
-         oldconstsymtable : tsymtable;
          st : tsymtable;
       begin
          oldprocinfo:=current_procinfo;
          oldblock_type:=block_type;
-         oldconstsymtable:=constsymtable;
 
          { reset break and continue labels }
          block_type:=bt_body;
@@ -1129,6 +1133,9 @@ implementation
 {    aktstate:=Tstate_storage.create;}
     {$endif state_tracking}
 
+         { allocate the symbol for this procedure }
+         alloc_proc_symbol(procdef);
+
          { create a local symbol table for this routine }
          if not assigned(procdef.localst) then
            procdef.insert_localst;
@@ -1136,9 +1143,6 @@ implementation
          { add parast/localst to symtablestack }
          add_to_symtablestack;
 
-         { constant symbols are inserted in this symboltable }
-         constsymtable:=symtablestack;
-
          { save entry info }
          entrypos:=aktfilepos;
          entryswitches:=aktlocalswitches;
@@ -1236,7 +1240,6 @@ implementation
          current_procinfo:=oldprocinfo;
 
          { Restore old state }
-         constsymtable:=oldconstsymtable;
          block_type:=oldblock_type;
       end;
 
@@ -1591,8 +1594,7 @@ implementation
                 read_proc;
               _EXPORTS:
                 begin
-                   if not(assigned(current_procinfo.procdef.localst)) or
-                      (current_procinfo.procdef.localst.symtablelevel>main_program_level) then
+                   if (current_procinfo.procdef.localst.symtablelevel>main_program_level) then
                      begin
                         Message(parser_e_syntax_error);
                         consume_all_until(_SEMICOLON);
@@ -1635,7 +1637,7 @@ implementation
          { check for incomplete class definitions, this is only required
            for fpc modes }
          if (m_fpc in aktmodeswitches) then
-           symtablestack.foreach_static(@check_forward_class,nil);
+           current_procinfo.procdef.localst.foreach_static(@check_forward_class,nil);
       end;
 
 
@@ -1676,7 +1678,7 @@ implementation
          { check for incomplete class definitions, this is only required
            for fpc modes }
          if (m_fpc in aktmodeswitches) then
-          symtablestack.foreach_static(@check_forward_class,nil);
+          symtablestack.top.foreach_static(@check_forward_class,nil);
       end;
 
 
@@ -1721,18 +1723,14 @@ implementation
 
 
     procedure generate_specialization_procs;
-      var
-        oldsymtablestack : tsymtable;
       begin
         if assigned(current_module.globalsymtable) then
           current_module.globalsymtable.foreach_static(@specialize_objectdefs,nil);
         if assigned(current_module.localsymtable) then
           begin
-            oldsymtablestack:=symtablestack;
-            current_module.localsymtable.next:=symtablestack;
-            symtablestack:=current_module.localsymtable;
+            symtablestack.push(current_module.localsymtable);
             current_module.localsymtable.foreach_static(@specialize_objectdefs,nil);
-            symtablestack:=oldsymtablestack;
+            symtablestack.pop(current_module.localsymtable);
           end;
       end;
 

compiler/psystem.pas

@@ -28,11 +28,10 @@ interface
     uses
       symbase;
 
-    procedure insertinternsyms(p : tsymtable);
-    procedure insert_intern_types(p : tsymtable);
+    procedure create_intern_symbols;
+    procedure create_intern_types;
 
-    procedure readconstdefs;
-    procedure createconstdefs;
+    procedure load_intern_types;
 
     procedure registernodes;
     procedure registertais;
@@ -49,52 +48,52 @@ implementation
       ;
 
 
-    procedure insertinternsyms(p : tsymtable);
+    procedure create_intern_symbols;
       {
         all intern procedures for the system unit
       }
       begin
-        p.insert(tsyssym.create('Concat',in_concat_x));
-        p.insert(tsyssym.create('Write',in_write_x));
-        p.insert(tsyssym.create('WriteLn',in_writeln_x));
-        p.insert(tsyssym.create('Assigned',in_assigned_x));
-        p.insert(tsyssym.create('Read',in_read_x));
-        p.insert(tsyssym.create('ReadLn',in_readln_x));
-        p.insert(tsyssym.create('Ofs',in_ofs_x));
-        p.insert(tsyssym.create('SizeOf',in_sizeof_x));
-        p.insert(tsyssym.create('TypeOf',in_typeof_x));
-        p.insert(tsyssym.create('Low',in_low_x));
-        p.insert(tsyssym.create('High',in_high_x));
-        p.insert(tsyssym.create('Slice',in_slice_x));
-        p.insert(tsyssym.create('Seg',in_seg_x));
-        p.insert(tsyssym.create('Ord',in_ord_x));
-        p.insert(tsyssym.create('Pred',in_pred_x));
-        p.insert(tsyssym.create('Succ',in_succ_x));
-        p.insert(tsyssym.create('Exclude',in_exclude_x_y));
-        p.insert(tsyssym.create('Include',in_include_x_y));
-        p.insert(tsyssym.create('Break',in_break));
-        p.insert(tsyssym.create('Exit',in_exit));
-        p.insert(tsyssym.create('Continue',in_continue));
-        p.insert(tsyssym.create('Leave',in_leave)); {macpas only}
-        p.insert(tsyssym.create('Cycle',in_cycle)); {macpas only}
-        p.insert(tsyssym.create('Dec',in_dec_x));
-        p.insert(tsyssym.create('Inc',in_inc_x));
-        p.insert(tsyssym.create('Str',in_str_x_string));
-        p.insert(tsyssym.create('Assert',in_assert_x_y));
-        p.insert(tsyssym.create('Val',in_val_x));
-        p.insert(tsyssym.create('Addr',in_addr_x));
-        p.insert(tsyssym.create('TypeInfo',in_typeinfo_x));
-        p.insert(tsyssym.create('SetLength',in_setlength_x));
-        p.insert(tsyssym.create('Copy',in_copy_x));
-        p.insert(tsyssym.create('Initialize',in_initialize_x));
-        p.insert(tsyssym.create('Finalize',in_finalize_x));
-        p.insert(tsyssym.create('Length',in_length_x));
-        p.insert(tsyssym.create('New',in_new_x));
-        p.insert(tsyssym.create('Dispose',in_dispose_x));
+        systemunit.insert(tsyssym.create('Concat',in_concat_x));
+        systemunit.insert(tsyssym.create('Write',in_write_x));
+        systemunit.insert(tsyssym.create('WriteLn',in_writeln_x));
+        systemunit.insert(tsyssym.create('Assigned',in_assigned_x));
+        systemunit.insert(tsyssym.create('Read',in_read_x));
+        systemunit.insert(tsyssym.create('ReadLn',in_readln_x));
+        systemunit.insert(tsyssym.create('Ofs',in_ofs_x));
+        systemunit.insert(tsyssym.create('SizeOf',in_sizeof_x));
+        systemunit.insert(tsyssym.create('TypeOf',in_typeof_x));
+        systemunit.insert(tsyssym.create('Low',in_low_x));
+        systemunit.insert(tsyssym.create('High',in_high_x));
+        systemunit.insert(tsyssym.create('Slice',in_slice_x));
+        systemunit.insert(tsyssym.create('Seg',in_seg_x));
+        systemunit.insert(tsyssym.create('Ord',in_ord_x));
+        systemunit.insert(tsyssym.create('Pred',in_pred_x));
+        systemunit.insert(tsyssym.create('Succ',in_succ_x));
+        systemunit.insert(tsyssym.create('Exclude',in_exclude_x_y));
+        systemunit.insert(tsyssym.create('Include',in_include_x_y));
+        systemunit.insert(tsyssym.create('Break',in_break));
+        systemunit.insert(tsyssym.create('Exit',in_exit));
+        systemunit.insert(tsyssym.create('Continue',in_continue));
+        systemunit.insert(tsyssym.create('Leave',in_leave)); {macpas only}
+        systemunit.insert(tsyssym.create('Cycle',in_cycle)); {macpas only}
+        systemunit.insert(tsyssym.create('Dec',in_dec_x));
+        systemunit.insert(tsyssym.create('Inc',in_inc_x));
+        systemunit.insert(tsyssym.create('Str',in_str_x_string));
+        systemunit.insert(tsyssym.create('Assert',in_assert_x_y));
+        systemunit.insert(tsyssym.create('Val',in_val_x));
+        systemunit.insert(tsyssym.create('Addr',in_addr_x));
+        systemunit.insert(tsyssym.create('TypeInfo',in_typeinfo_x));
+        systemunit.insert(tsyssym.create('SetLength',in_setlength_x));
+        systemunit.insert(tsyssym.create('Copy',in_copy_x));
+        systemunit.insert(tsyssym.create('Initialize',in_initialize_x));
+        systemunit.insert(tsyssym.create('Finalize',in_finalize_x));
+        systemunit.insert(tsyssym.create('Length',in_length_x));
+        systemunit.insert(tsyssym.create('New',in_new_x));
+        systemunit.insert(tsyssym.create('Dispose',in_dispose_x));
       end;
 
 
-    procedure insert_intern_types(p : tsymtable);
+    procedure create_intern_types;
       {
         all the types inserted into the system unit
       }
@@ -102,7 +101,7 @@ implementation
         function addtype(const s:string;const t:ttype):ttypesym;
         begin
           result:=ttypesym.create(s,t);
-          p.insert(result);
+          systemunit.insert(result);
           { add init/final table if required }
           if t.def.needs_inittable then
            generate_inittable(result);
@@ -113,12 +112,93 @@ implementation
           t : ttype;
         begin
           t.setdef(def);
-          p.insert(ttypesym.create(s,t));
+          systemunit.insert(ttypesym.create(s,t));
         end;
 
       var
         hrecst : trecordsymtable;
       begin
+        symtablestack.push(systemunit);
+        cundefinedtype.setdef(tundefineddef.create);
+        cformaltype.setdef(tformaldef.create);
+        voidtype.setdef(torddef.create(uvoid,0,0));
+        u8inttype.setdef(torddef.create(u8bit,0,255));
+        s8inttype.setdef(torddef.create(s8bit,-128,127));
+        u16inttype.setdef(torddef.create(u16bit,0,65535));
+        s16inttype.setdef(torddef.create(s16bit,-32768,32767));
+        u32inttype.setdef(torddef.create(u32bit,0,high(longword)));
+        s32inttype.setdef(torddef.create(s32bit,low(longint),high(longint)));
+        u64inttype.setdef(torddef.create(u64bit,low(qword),TConstExprInt(high(qword))));
+        s64inttype.setdef(torddef.create(s64bit,low(int64),high(int64)));
+        booltype.setdef(torddef.create(bool8bit,0,1));
+        cchartype.setdef(torddef.create(uchar,0,255));
+        cwidechartype.setdef(torddef.create(uwidechar,0,65535));
+        cshortstringtype.setdef(tstringdef.createshort(255));
+        { should we give a length to the default long and ansi string definition ?? }
+        clongstringtype.setdef(tstringdef.createlong(-1));
+        cansistringtype.setdef(tstringdef.createansi(-1));
+        cwidestringtype.setdef(tstringdef.createwide(-1));
+        { length=0 for shortstring is open string (needed for readln(string) }
+        openshortstringtype.setdef(tstringdef.createshort(0));
+        openchararraytype.setdef(tarraydef.create(0,-1,s32inttype));
+        tarraydef(openchararraytype.def).setelementtype(cchartype);
+{$ifdef x86}
+        s32floattype.setdef(tfloatdef.create(s32real));
+        s64floattype.setdef(tfloatdef.create(s64real));
+        s80floattype.setdef(tfloatdef.create(s80real));
+        if target_info.system<>system_x86_64_win64 then
+          s64currencytype.setdef(tfloatdef.create(s64currency))
+        else
+          s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
+{$endif x86}
+{$ifdef powerpc}
+        s32floattype.setdef(tfloatdef.create(s32real));
+        s64floattype.setdef(tfloatdef.create(s64real));
+        s80floattype.setdef(tfloatdef.create(s80real));
+        s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
+{$endif powerpc}
+{$ifdef POWERPC64}
+        s32floattype.setdef(tfloatdef.create(s32real));
+        s64floattype.setdef(tfloatdef.create(s64real));
+        s80floattype.setdef(tfloatdef.create(s80real));
+        s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
+{$endif POWERPC64}
+{$ifdef sparc}
+        s32floattype.setdef(tfloatdef.create(s32real));
+        s64floattype.setdef(tfloatdef.create(s64real));
+        s80floattype.setdef(tfloatdef.create(s80real));
+        s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
+{$endif sparc}
+{$ifdef m68k}
+        s32floattype.setdef(tfloatdef.create(s32real));
+        s64floattype.setdef(tfloatdef.create(s64real));
+        s80floattype.setdef(tfloatdef.create(s80real));
+        s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
+{$endif}
+{$ifdef arm}
+        s32floattype.setdef(tfloatdef.create(s32real));
+        s64floattype.setdef(tfloatdef.create(s64real));
+        s80floattype.setdef(tfloatdef.create(s80real));
+        s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
+{$endif arm}
+{$ifdef cpu64bit}
+        uinttype:=u64inttype;
+        sinttype:=s64inttype;
+        ptrinttype:=u64inttype;
+{$else cpu64bit}
+        uinttype:=u32inttype;
+        sinttype:=s32inttype;
+        ptrinttype:=u32inttype;
+{$endif cpu64bit}
+        { some other definitions }
+        voidpointertype.setdef(tpointerdef.create(voidtype));
+        charpointertype.setdef(tpointerdef.create(cchartype));
+        widecharpointertype.setdef(tpointerdef.create(cwidechartype));
+        voidfarpointertype.setdef(tpointerdef.createfar(voidtype));
+        cfiletype.setdef(tfiledef.createuntyped);
+        cvarianttype.setdef(tvariantdef.create(vt_normalvariant));
+        colevarianttype.setdef(tvariantdef.create(vt_olevariant));
+
         if target_info.system=system_x86_64_win64 then
           pbestrealtype:=@s64floattype;
 
@@ -214,12 +294,12 @@ implementation
         hrecst:=trecordsymtable.create(aktpackrecords);
         vmttype.setdef(trecorddef.create(hrecst));
         pvmttype.setdef(tpointerdef.create(vmttype));
-        hrecst.insertfield(tfieldvarsym.create('$parent',vs_value,pvmttype,[]),true);
-        hrecst.insertfield(tfieldvarsym.create('$length',vs_value,s32inttype,[]),true);
-        hrecst.insertfield(tfieldvarsym.create('$mlength',vs_value,s32inttype,[]),true);
+        hrecst.insertfield(tfieldvarsym.create('$parent',vs_value,pvmttype,[]));
+        hrecst.insertfield(tfieldvarsym.create('$length',vs_value,s32inttype,[]));
+        hrecst.insertfield(tfieldvarsym.create('$mlength',vs_value,s32inttype,[]));
         vmtarraytype.setdef(tarraydef.create(0,1,s32inttype));
         tarraydef(vmtarraytype.def).setelementtype(voidpointertype);
-        hrecst.insertfield(tfieldvarsym.create('$__pfn',vs_value,vmtarraytype,[]),true);
+        hrecst.insertfield(tfieldvarsym.create('$__pfn',vs_value,vmtarraytype,[]));
         addtype('$__vtbl_ptr_type',vmttype);
         addtype('$pvmt',pvmttype);
         vmtarraytype.setdef(tarraydef.create(0,1,s32inttype));
@@ -227,30 +307,25 @@ implementation
         addtype('$vtblarray',vmtarraytype);
         { Add a type for methodpointers }
         hrecst:=trecordsymtable.create(1);
-        hrecst.insertfield(tfieldvarsym.create('$proc',vs_value,voidpointertype,[]),true);
-        hrecst.insertfield(tfieldvarsym.create('$self',vs_value,voidpointertype,[]),true);
+        hrecst.insertfield(tfieldvarsym.create('$proc',vs_value,voidpointertype,[]));
+        hrecst.insertfield(tfieldvarsym.create('$self',vs_value,voidpointertype,[]));
         methodpointertype.setdef(trecorddef.create(hrecst));
         addtype('$methodpointer',methodpointertype);
-      { Add functions that require compiler magic }
-        insertinternsyms(p);
+        symtablestack.pop(systemunit);
       end;
 
 
-    procedure readconstdefs;
+    procedure load_intern_types;
       {
         Load all default definitions for consts from the system unit
       }
 
-
         procedure loadtype(const s:string;var t:ttype);
         var
-          srsym : tsym;
+          srsym : ttypesym;
         begin
-          srsym:=searchsymonlyin(systemunit,s);
-          if not(assigned(srsym) and
-                 (srsym.typ=typesym)) then
-            internalerror(200403231);
-          t:=ttypesym(srsym).restype;
+          srsym:=search_system_type(s);
+          t:=srsym.restype;
         end;
 
       var
@@ -306,99 +381,6 @@ implementation
       end;
 
 
-    procedure createconstdefs;
-      {
-        Create all default definitions for consts for the system unit
-      }
-      var
-        oldregisterdef : boolean;
-      begin
-        { create definitions for constants }
-        oldregisterdef:=registerdef;
-        registerdef:=false;
-        cundefinedtype.setdef(tundefineddef.create);
-        cformaltype.setdef(tformaldef.create);
-        voidtype.setdef(torddef.create(uvoid,0,0));
-        u8inttype.setdef(torddef.create(u8bit,0,255));
-        s8inttype.setdef(torddef.create(s8bit,-128,127));
-        u16inttype.setdef(torddef.create(u16bit,0,65535));
-        s16inttype.setdef(torddef.create(s16bit,-32768,32767));
-        u32inttype.setdef(torddef.create(u32bit,0,high(longword)));
-        s32inttype.setdef(torddef.create(s32bit,low(longint),high(longint)));
-        u64inttype.setdef(torddef.create(u64bit,low(qword),TConstExprInt(high(qword))));
-        s64inttype.setdef(torddef.create(s64bit,low(int64),high(int64)));
-        booltype.setdef(torddef.create(bool8bit,0,1));
-        cchartype.setdef(torddef.create(uchar,0,255));
-        cwidechartype.setdef(torddef.create(uwidechar,0,65535));
-        cshortstringtype.setdef(tstringdef.createshort(255));
-        { should we give a length to the default long and ansi string definition ?? }
-        clongstringtype.setdef(tstringdef.createlong(-1));
-        cansistringtype.setdef(tstringdef.createansi(-1));
-        cwidestringtype.setdef(tstringdef.createwide(-1));
-        { length=0 for shortstring is open string (needed for readln(string) }
-        openshortstringtype.setdef(tstringdef.createshort(0));
-        openchararraytype.setdef(tarraydef.create(0,-1,s32inttype));
-        tarraydef(openchararraytype.def).setelementtype(cchartype);
-{$ifdef x86}
-        s32floattype.setdef(tfloatdef.create(s32real));
-        s64floattype.setdef(tfloatdef.create(s64real));
-        s80floattype.setdef(tfloatdef.create(s80real));
-        if target_info.system<>system_x86_64_win64 then
-          s64currencytype.setdef(tfloatdef.create(s64currency))
-        else
-          s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
-{$endif x86}
-{$ifdef powerpc}
-        s32floattype.setdef(tfloatdef.create(s32real));
-        s64floattype.setdef(tfloatdef.create(s64real));
-        s80floattype.setdef(tfloatdef.create(s80real));
-        s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
-{$endif powerpc}
-{$ifdef POWERPC64}
-        s32floattype.setdef(tfloatdef.create(s32real));
-        s64floattype.setdef(tfloatdef.create(s64real));
-        s80floattype.setdef(tfloatdef.create(s80real));
-        s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
-{$endif POWERPC64}
-{$ifdef sparc}
-        s32floattype.setdef(tfloatdef.create(s32real));
-        s64floattype.setdef(tfloatdef.create(s64real));
-        s80floattype.setdef(tfloatdef.create(s80real));
-        s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
-{$endif sparc}
-{$ifdef m68k}
-        s32floattype.setdef(tfloatdef.create(s32real));
-        s64floattype.setdef(tfloatdef.create(s64real));
-        s80floattype.setdef(tfloatdef.create(s80real));
-        s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
-{$endif}
-{$ifdef arm}
-        s32floattype.setdef(tfloatdef.create(s32real));
-        s64floattype.setdef(tfloatdef.create(s64real));
-        s80floattype.setdef(tfloatdef.create(s80real));
-        s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
-{$endif arm}
-{$ifdef cpu64bit}
-        uinttype:=u64inttype;
-        sinttype:=s64inttype;
-        ptrinttype:=u64inttype;
-{$else cpu64bit}
-        uinttype:=u32inttype;
-        sinttype:=s32inttype;
-        ptrinttype:=u32inttype;
-{$endif cpu64bit}
-        { some other definitions }
-        voidpointertype.setdef(tpointerdef.create(voidtype));
-        charpointertype.setdef(tpointerdef.create(cchartype));
-        widecharpointertype.setdef(tpointerdef.create(cwidechartype));
-        voidfarpointertype.setdef(tpointerdef.createfar(voidtype));
-        cfiletype.setdef(tfiledef.createuntyped);
-        cvarianttype.setdef(tvariantdef.create(vt_normalvariant));
-        colevarianttype.setdef(tvariantdef.create(vt_olevariant));
-        registerdef:=oldregisterdef;
-      end;
-
-
     procedure registernodes;
       {
         Register all possible nodes in the nodeclass array that

compiler/ptype.pas

@@ -183,8 +183,7 @@ implementation
          { use of current parsed object:
             - classes can be used also in classes
             - objects can be parameters }
-         if (token=_ID) and
-            assigned(aktobjectdef) and
+         if assigned(aktobjectdef) and
             (aktobjectdef.objname^=pattern) and
             (
              (testcurobject=2) or
@@ -195,38 +194,18 @@ implementation
              tt.setdef(aktobjectdef);
              exit;
            end;
-         { try to load the symbol to see if it's a unitsym. Use the
-           special searchsym_type that ignores records,objects and
+         { Use the special searchsym_type that ignores records,objects and
            parameters }
-         is_unit_specific:=false;
          searchsym_type(s,srsym,srsymtable);
+         { handle unit specification like System.Writeln }
+         is_unit_specific:=try_consume_unitsym(srsym,srsymtable);
          consume(_ID);
-         if assigned(srsym) and
-            (srsym.typ=unitsym) then
-           begin
-              is_unit_specific:=true;
-              consume(_POINT);
-              if not(srsym.owner.symtabletype in [staticsymtable,globalsymtable]) then
-                internalerror(200501155);
-              { only allow unit.symbol access if the name was
-                found in the current module }
-              if srsym.owner.iscurrentunit then
-               begin
-                 srsym:=searchsymonlyin(tunitsym(srsym).unitsymtable,pattern);
-                 pos:=akttokenpos;
-                 s:=pattern;
-               end
-              else
-               srsym:=nil;
-              consume(_ID);
-           end;
          { Types are first defined with an error def before assigning
            the real type so check if it's an errordef. if so then
            give an error. Only check for typesyms in the current symbol
            table as forwarddef are not resolved directly }
          if assigned(srsym) and
             (srsym.typ=typesym) and
-            (srsym.owner=symtablestack) and
             (ttypesym(srsym).restype.def.deftype=errordef) then
           begin
             Message1(type_e_type_is_not_completly_defined,ttypesym(srsym).realname);
@@ -313,16 +292,15 @@ implementation
     function record_dec : tdef;
 
       var
-         symtable : tsymtable;
+         recst : trecordsymtable;
          storetypecanbeforward : boolean;
          old_object_option : tsymoptions;
       begin
          { create recdef }
-         symtable:=trecordsymtable.create(aktpackrecords);
-         record_dec:=trecorddef.create(symtable);
-         { update symtable stack }
-         symtable.next:=symtablestack;
-         symtablestack:=symtable;
+         recst:=trecordsymtable.create(aktpackrecords);
+         record_dec:=trecorddef.create(recst);
+         { insert in symtablestack }
+         symtablestack.push(recst);
          { parse record }
          consume(_RECORD);
          old_object_option:=current_object_option;
@@ -331,14 +309,14 @@ implementation
          { for tp7 don't allow forward types }
          if m_tp7 in aktmodeswitches then
            typecanbeforward:=false;
-         read_var_decs([vd_record]);
+         read_record_fields([vd_record]);
          consume(_END);
          typecanbeforward:=storetypecanbeforward;
          current_object_option:=old_object_option;
          { make the record size aligned }
-         trecordsymtable(symtablestack).addalignmentpadding;
+         recst.addalignmentpadding;
          { restore symtable stack }
-         symtablestack:=symtable.next;
+         symtablestack.pop(recst);
       end;
 
 
@@ -579,7 +557,7 @@ implementation
         pd : tabstractprocdef;
         is_func,
         enumdupmsg : boolean;
-        newtype : ttypesym;
+        newtype    : ttypesym;
         oldlocalswitches : tlocalswitches;
       begin
          tt.reset;
@@ -640,7 +618,7 @@ implementation
                     inc(l);
                   storepos:=akttokenpos;
                   akttokenpos:=defpos;
-                  constsymtable.insert(tenumsym.create(s,aktenumdef,l));
+                  tstoredsymtable(aktenumdef.owner).insert(tenumsym.create(s,aktenumdef,l));
                   akttokenpos:=storepos;
                 until not try_to_consume(_COMMA);
                 tt.setdef(aktenumdef);

compiler/rautils.pas

@@ -1160,20 +1160,23 @@ begin
   i:=pos('.',s);
   { allow unit.identifier }
   if i>0 then
-   begin
-     searchsym(Copy(s,1,i-1),srsym,srsymtable);
-     if assigned(srsym) then
-      begin
-        if (srsym.typ=unitsym) and
-           (srsym.owner.symtabletype in [staticsymtable,globalsymtable]) and
-           srsym.owner.iscurrentunit then
-         srsym:=searchsymonlyin(tunitsym(srsym).unitsymtable,Copy(s,i+1,255))
-        else
-         srsym:=nil;
-      end;
-   end
+    begin
+      searchsym(Copy(s,1,i-1),srsym,srsymtable);
+      if assigned(srsym) then
+       begin
+         if (srsym.typ=unitsym) and
+            (srsym.owner.symtabletype in [staticsymtable,globalsymtable]) and
+            srsym.owner.iscurrentunit then
+           searchsym_in_module(tunitsym(srsym).module,Copy(s,i+1,255),srsym,srsymtable)
+         else
+           begin
+             srsym:=nil;
+             srsymtable:=nil;
+           end;
+       end;
+    end
   else
-   searchsym(s,srsym,srsymtable);
+    searchsym(s,srsym,srsymtable);
 end;
 
 

compiler/scandir.pas

@@ -660,9 +660,7 @@ implementation
           if not current_module.mode_switch_allowed and
               not ((m_mac in aktmodeswitches) and (pattern='MACPAS')) then
             Message1(scan_e_mode_switch_not_allowed,pattern)
-          else if SetCompileMode(pattern,false) then
-            ConsolidateMode
-          else
+          else if not SetCompileMode(pattern,false) then
             Message1(scan_w_illegal_switch,pattern)
         end;
       current_module.mode_switch_allowed:= false;

compiler/scanner.pas

@@ -192,7 +192,6 @@ interface
     procedure DoneScanner;
 
     {To be called when the language mode is finally determined}
-    procedure ConsolidateMode;
     Function SetCompileMode(const s:string; changeInit: boolean):boolean;
 
 
@@ -247,21 +246,7 @@ implementation
       end;
 
 
-    {To be called when the language mode is finally determined}
-    procedure ConsolidateMode;
-
-    begin
-      if m_mac in aktmodeswitches then
-        if current_module.is_unit and not assigned(current_module.globalmacrosymtable) then
-          begin
-            current_module.globalmacrosymtable:= tmacrosymtable.create(true);
-            current_module.globalmacrosymtable.next:= current_module.localmacrosymtable;
-            macrosymtablestack:=current_module.globalmacrosymtable;
-          end;
-    end;
-
-
-      Function SetCompileMode(const s:string; changeInit: boolean):boolean;
+    Function SetCompileMode(const s:string; changeInit: boolean):boolean;
       var
         b : boolean;
         oldaktmodeswitches : tmodeswitches;
@@ -1109,7 +1094,7 @@ In case not, the value returned can be arbitrary.
                      CTEError(exprType2, [ctetSet], 'IN');
                    if exprType = [ctetSet] then
                      CTEError(exprType, setElementTypes, 'IN');
-    
+
                   if is_number(hs1) and is_number(hs2) then
                     Message(scan_e_preproc_syntax_error)
                   else if hs2[1] = ',' then
@@ -1121,7 +1106,7 @@ In case not, the value returned can be arbitrary.
                  begin
                    if (exprType * exprType2) = [] then
                      CTEError(exprType2, exprType, tokeninfo^[op].str);
-    
+
                    if is_number(hs1) and is_number(hs2) then
                      begin
                        val(hs1,l1,w);
@@ -1210,12 +1195,12 @@ In case not, the value returned can be arbitrary.
         current_scanner.skipspace;
         hs:=current_scanner.readid;
         mac:=tmacro(search_macro(hs));
-        if not assigned(mac) or (mac.owner <> macrosymtablestack) then
+        if not assigned(mac) or (mac.owner <> current_module.localmacrosymtable) then
           begin
             mac:=tmacro.create(hs);
             mac.defined:=true;
             Message1(parser_c_macro_defined,mac.name);
-            macrosymtablestack.insert(mac);
+            current_module.localmacrosymtable.insert(mac);
           end
         else
           begin
@@ -1232,7 +1217,6 @@ In case not, the value returned can be arbitrary.
         mac.is_used:=true;
         if (cs_support_macro in aktmoduleswitches) then
           begin
-             { !!!!!! handle macro params, need we this? }
              current_scanner.skipspace;
 
              if not macstyle then
@@ -1322,13 +1306,14 @@ In case not, the value returned can be arbitrary.
         current_scanner.skipspace;
         hs:=current_scanner.readid;
         mac:=tmacro(search_macro(hs));
-        if not assigned(mac) or (mac.owner <> macrosymtablestack) then
+        if not assigned(mac) or
+           (mac.owner <> current_module.localmacrosymtable) then
           begin
             mac:=tmacro.create(hs);
             mac.defined:=true;
             mac.is_compiler_var:=true;
             Message1(parser_c_macro_defined,mac.name);
-            macrosymtablestack.insert(mac);
+            current_module.localmacrosymtable.insert(mac);
           end
         else
           begin
@@ -1343,18 +1328,14 @@ In case not, the value returned can be arbitrary.
           end;
         mac.is_used:=true;
 
-
         { key words are never substituted }
-           if is_keyword(hs) then
-            Message(scan_e_keyword_cant_be_a_macro);
-         { !!!!!! handle macro params, need we this? }
-           current_scanner.skipspace;
-         { may be a macro? }
+        if is_keyword(hs) then
+          Message(scan_e_keyword_cant_be_a_macro);
 
-        { assignment can be both := and = }
+        { macro assignment can be both := and = }
+        current_scanner.skipspace;
         if c=':' then
           current_scanner.readchar;
-
         if c='=' then
           begin
              current_scanner.readchar;
@@ -1400,12 +1381,13 @@ In case not, the value returned can be arbitrary.
         current_scanner.skipspace;
         hs:=current_scanner.readid;
         mac:=tmacro(search_macro(hs));
-        if not assigned(mac) or (mac.owner <> macrosymtablestack) then
+        if not assigned(mac) or
+           (mac.owner <> current_module.localmacrosymtable) then
           begin
              mac:=tmacro.create(hs);
              Message1(parser_c_macro_undefined,mac.name);
              mac.defined:=false;
-             macrosymtablestack.insert(mac);
+             current_module.localmacrosymtable.insert(mac);
           end
         else
           begin

compiler/symbase.pas

@@ -94,7 +94,6 @@ interface
           symindex,
           defindex  : TIndexArray;
           symsearch : Tdictionary;
-          next      : tsymtable;
           defowner  : tdefentry; { for records and objects }
           symtabletype  : tsymtabletype;
           { level of symtable, used for nested procedures }
@@ -109,13 +108,13 @@ interface
           function  rename(const olds,news : stringid):tsymentry;
           procedure foreach(proc2call : tnamedindexcallback;arg:pointer);
           procedure foreach_static(proc2call : tnamedindexstaticcallback;arg:pointer);
+          function  checkduplicate(sym : tsymentry):boolean;virtual;
           procedure insert(sym : tsymentry);virtual;
-          { deletes a tsymentry and removes it from the tsymtable}
           procedure delete(sym:tsymentry);
           procedure replace(oldsym,newsym:tsymentry);
           function  search(const s : stringid) : tsymentry;
           function  speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;virtual;
-          procedure registerdef(p : tdefentry);
+          procedure insertdef(def:tdefentry);virtual;
           function  iscurrentunit:boolean;virtual;
 {$ifdef EXTDEBUG}
           procedure dump;
@@ -125,13 +124,6 @@ interface
        end;
 
     var
-       registerdef : boolean;      { true, when defs should be registered }
-
-       defaultsymtablestack : tsymtable;  { symtablestack after default units have been loaded }
-       symtablestack     : tsymtable;     { linked list of symtables }
-       defaultmacrosymtablestack : tsymtable;{ macrosymtablestack after default units have been loaded }
-       macrosymtablestack: tsymtable;     { linked list of macro symtables }
-
        aktrecordsymtable : tsymtable;     { current record symtable }
        aktparasymtable   : tsymtable;     { current proc para symtable }
        aktlocalsymtable  : tsymtable;     { current proc local symtable }
@@ -164,7 +156,6 @@ implementation
          symtabletype:=abstractsymtable;
          symtablelevel:=0;
          defowner:=nil;
-         next:=nil;
          symindex:=tindexarray.create(indexgrowsize);
          defindex:=TIndexArray.create(indexgrowsize);
          symsearch:=tdictionary.create;
@@ -224,14 +215,6 @@ implementation
 {$endif EXTDEBUG}
 
 
-    procedure tsymtable.registerdef(p : tdefentry);
-      begin
-         defindex.insert(p);
-         { set def owner and indexnb }
-         p.owner:=self;
-      end;
-
-
     function tsymtable.iscurrentunit:boolean;
       begin
         result:=false;
@@ -261,14 +244,29 @@ implementation
       end;
 
 
+    function tsymtable.checkduplicate(sym : tsymentry):boolean;
+      begin
+        result:=(speedsearch(sym.name,sym.speedvalue)<>nil);
+      end;
+
+
     procedure tsymtable.insert(sym:tsymentry);
       begin
+         checkduplicate(sym);
          sym.owner:=self;
          { insert in index and search hash }
          symindex.insert(sym);
          symsearch.insert(sym);
       end;
 
+
+    procedure tsymtable.insertdef(def:tdefentry);
+      begin
+         def.owner:=self;
+         defindex.insert(def);
+      end;
+
+
     procedure tsymtable.delete(sym:tsymentry);
       begin
          sym.owner:=nil;
@@ -277,6 +275,7 @@ implementation
          symindex.delete(sym);
       end;
 
+
     procedure tsymtable.replace(oldsym,newsym:tsymentry);
       begin
          { Replace the entry in the dictionary, this checks

compiler/symdef.pas

@@ -66,13 +66,12 @@ interface
           genericdef      : tstoreddef;
           genericdefderef : tderef;
           generictokenbuf : tdynamicarray;
-          constructor create;
-          constructor ppuloaddef(ppufile:tcompilerppufile);
+          constructor create(dt:tdeftype);
+          constructor ppuload(dt:tdeftype;ppufile:tcompilerppufile);
           destructor  destroy;override;
           procedure reset;virtual;
           function getcopy : tstoreddef;virtual;
-          procedure ppuwritedef(ppufile:tcompilerppufile);
-          procedure ppuwrite(ppufile:tcompilerppufile);virtual;abstract;
+          procedure ppuwrite(ppufile:tcompilerppufile);virtual;
           procedure buildderef;override;
           procedure buildderefimpl;override;
           procedure deref;override;
@@ -156,21 +155,22 @@ interface
           function  getmangledparaname : string;override;
        end;
 
-       { tpointerdef and tclassrefdef should get a common
-         base class, but I derived tclassrefdef from tpointerdef
-         to avoid problems with bugs (FK)
-       }
-
-       tpointerdef = class(tstoreddef)
+       tabstractpointerdef = class(tstoreddef)
           pointertype : ttype;
+          constructor create(dt:tdeftype;const tt : ttype);
+          constructor ppuload(dt:tdeftype;ppufile:tcompilerppufile);
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure buildderef;override;
+          procedure deref;override;
+       end;
+
+       tpointerdef = class(tabstractpointerdef)
           is_far : boolean;
           constructor create(const tt : ttype);
           constructor createfar(const tt : ttype);
           function getcopy : tstoreddef;override;
           constructor ppuload(ppufile:tcompilerppufile);
           procedure ppuwrite(ppufile:tcompilerppufile);override;
-          procedure buildderef;override;
-          procedure deref;override;
           function  gettypename:string;override;
        end;
 
@@ -313,7 +313,7 @@ interface
        end;
 
 
-       tclassrefdef = class(tpointerdef)
+       tclassrefdef = class(tabstractpointerdef)
           constructor create(const t:ttype);
           constructor ppuload(ppufile:tcompilerppufile);
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -403,8 +403,8 @@ interface
 {$endif}
           funcretloc : array[tcallercallee] of TLocation;
           has_paraloc_info : boolean; { paraloc info is available }
-          constructor create(level:byte);
-          constructor ppuload(ppufile:tcompilerppufile);
+          constructor create(dt:tdeftype;level:byte);
+          constructor ppuload(dt:tdeftype;ppufile:tcompilerppufile);
           destructor destroy;override;
           procedure  ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderef;override;
@@ -608,8 +608,6 @@ interface
           { rtti }
           procedure write_rtti_data(rt:trttitype);override;
           procedure write_child_rtti_data(rt:trttitype);override;
-       private
-          procedure correct_owner_symtable;
        end;
 
        tsetdef = class(tstoreddef)
@@ -892,35 +890,52 @@ implementation
                      TDEF (base class for definitions)
 ****************************************************************************}
 
-    constructor tstoreddef.create;
+    constructor tstoreddef.create(dt:tdeftype);
+      var
+        insertstack : psymtablestackitem;
       begin
-         inherited create;
+         inherited create(dt);
          savesize := 0;
 {$ifdef EXTDEBUG}
          fileinfo := aktfilepos;
 {$endif}
-         if registerdef then
-           symtablestack.registerdef(self);
          fillchar(localrttilab,sizeof(localrttilab),0);
          generictokenbuf:=nil;
          genericdef:=nil;
+         { Register in symtable stack.
+           Don't register forwarddefs, they are disposed at the
+           end of an type block }
+         if assigned(symtablestack) and
+            (dt<>forwarddef) then
+           begin
+             insertstack:=symtablestack.stack;
+             while assigned(insertstack) and
+                   (insertstack^.symtable.symtabletype=withsymtable) do
+               insertstack:=insertstack^.next;
+             if not assigned(insertstack) then
+               internalerror(200602044);
+             insertstack^.symtable.insertdef(self);
+           end;
       end;
 
 
     destructor tstoreddef.destroy;
       begin
+        { remove also index from symtable }
+        if assigned(owner) then
+          owner.defindex.deleteindex(self);
         if assigned(generictokenbuf) then
           generictokenbuf.free;
         inherited destroy;
       end;
 
 
-    constructor tstoreddef.ppuloaddef(ppufile:tcompilerppufile);
+    constructor tstoreddef.ppuload(dt:tdeftype;ppufile:tcompilerppufile);
       var
         sizeleft,i : longint;
         buf  : array[0..255] of byte;
       begin
-         inherited create;
+         inherited create(dt);
 {$ifdef EXTDEBUG}
          fillchar(fileinfo,sizeof(fileinfo),0);
 {$endif}
@@ -971,7 +986,7 @@ implementation
       end;
 
 
-    procedure tstoreddef.ppuwritedef(ppufile:tcompilerppufile);
+    procedure tstoreddef.ppuwrite(ppufile:tcompilerppufile);
       var
         sizeleft,i : longint;
         buf  : array[0..255] of byte;
@@ -1171,9 +1186,8 @@ implementation
 
     constructor tstringdef.createshort(l : byte);
       begin
-         inherited create;
+         inherited create(stringdef);
          string_typ:=st_shortstring;
-         deftype:=stringdef;
          len:=l;
          savesize:=len+1;
       end;
@@ -1181,9 +1195,8 @@ implementation
 
     constructor tstringdef.loadshort(ppufile:tcompilerppufile);
       begin
-         inherited ppuloaddef(ppufile);
+         inherited ppuload(stringdef,ppufile);
          string_typ:=st_shortstring;
-         deftype:=stringdef;
          len:=ppufile.getbyte;
          savesize:=len+1;
       end;
@@ -1191,9 +1204,8 @@ implementation
 
     constructor tstringdef.createlong(l : aint);
       begin
-         inherited create;
+         inherited create(stringdef);
          string_typ:=st_longstring;
-         deftype:=stringdef;
          len:=l;
          savesize:=sizeof(aint);
       end;
@@ -1201,8 +1213,7 @@ implementation
 
     constructor tstringdef.loadlong(ppufile:tcompilerppufile);
       begin
-         inherited ppuloaddef(ppufile);
-         deftype:=stringdef;
+         inherited ppuload(stringdef,ppufile);
          string_typ:=st_longstring;
          len:=ppufile.getaint;
          savesize:=sizeof(aint);
@@ -1211,9 +1222,8 @@ implementation
 
     constructor tstringdef.createansi(l:aint);
       begin
-         inherited create;
+         inherited create(stringdef);
          string_typ:=st_ansistring;
-         deftype:=stringdef;
          len:=l;
          savesize:=sizeof(aint);
       end;
@@ -1221,8 +1231,7 @@ implementation
 
     constructor tstringdef.loadansi(ppufile:tcompilerppufile);
       begin
-         inherited ppuloaddef(ppufile);
-         deftype:=stringdef;
+         inherited ppuload(stringdef,ppufile);
          string_typ:=st_ansistring;
          len:=ppufile.getaint;
          savesize:=sizeof(aint);
@@ -1231,9 +1240,8 @@ implementation
 
     constructor tstringdef.createwide(l : aint);
       begin
-         inherited create;
+         inherited create(stringdef);
          string_typ:=st_widestring;
-         deftype:=stringdef;
          len:=l;
          savesize:=sizeof(aint);
       end;
@@ -1241,8 +1249,7 @@ implementation
 
     constructor tstringdef.loadwide(ppufile:tcompilerppufile);
       begin
-         inherited ppuloaddef(ppufile);
-         deftype:=stringdef;
+         inherited ppuload(stringdef,ppufile);
          string_typ:=st_widestring;
          len:=ppufile.getaint;
          savesize:=sizeof(aint);
@@ -1251,7 +1258,7 @@ implementation
 
     function tstringdef.getcopy : tstoreddef;
       begin
-        result:=tstringdef.create;
+        result:=tstringdef.create(deftype);
         result.deftype:=stringdef;
         tstringdef(result).string_typ:=string_typ;
         tstringdef(result).len:=len;
@@ -1271,7 +1278,7 @@ implementation
 
     procedure tstringdef.ppuwrite(ppufile:tcompilerppufile);
       begin
-         inherited ppuwritedef(ppufile);
+         inherited ppuwrite(ppufile);
          if string_typ=st_shortstring then
            begin
 {$ifdef extdebug}
@@ -1298,7 +1305,7 @@ implementation
 
     function tstringdef.gettypename : string;
       const
-         names : array[tstringtype] of string[10] = (
+         names : array[tstringtype] of string[11] = (
            'ShortString','LongString','AnsiString','WideString');
       begin
          gettypename:=names[string_typ];
@@ -1374,22 +1381,19 @@ implementation
 
     constructor tenumdef.create;
       begin
-         inherited create;
-         deftype:=enumdef;
+         inherited create(enumdef);
          minval:=0;
          maxval:=0;
          calcsavesize;
          has_jumps:=false;
          basedef:=nil;
          firstenum:=nil;
-         correct_owner_symtable;
       end;
 
 
     constructor tenumdef.create_subrange(_basedef:tenumdef;_min,_max:aint);
       begin
-         inherited create;
-         deftype:=enumdef;
+         inherited create(enumdef);
          minval:=_min;
          maxval:=_max;
          basedef:=_basedef;
@@ -1398,14 +1402,12 @@ implementation
          firstenum:=basedef.firstenum;
          while assigned(firstenum) and (tenumsym(firstenum).value<>minval) do
            firstenum:=tenumsym(firstenum).nextenum;
-         correct_owner_symtable;
       end;
 
 
     constructor tenumdef.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuloaddef(ppufile);
-         deftype:=enumdef;
+         inherited ppuload(enumdef,ppufile);
          ppufile.getderef(basedefderef);
          minval:=ppufile.getaint;
          maxval:=ppufile.getaint;
@@ -1508,7 +1510,7 @@ implementation
 
     procedure tenumdef.ppuwrite(ppufile:tcompilerppufile);
       begin
-         inherited ppuwritedef(ppufile);
+         inherited ppuwrite(ppufile);
          ppufile.putderef(basedefderef);
          ppufile.putaint(min);
          ppufile.putaint(max);
@@ -1517,24 +1519,6 @@ implementation
       end;
 
 
-    { used for enumdef because the symbols are
-      inserted in the owner symtable }
-    procedure tenumdef.correct_owner_symtable;
-      var
-         st : tsymtable;
-      begin
-         if assigned(owner) and
-            (owner.symtabletype in [recordsymtable,objectsymtable]) then
-           begin
-              owner.defindex.deleteindex(self);
-              st:=owner;
-              while (st.symtabletype in [recordsymtable,objectsymtable]) do
-                st:=st.next;
-              st.registerdef(self);
-           end;
-      end;
-
-
     procedure tenumdef.write_child_rtti_data(rt:trttitype);
       begin
          if assigned(basedef) then
@@ -1596,8 +1580,7 @@ implementation
 
     constructor torddef.create(t : tbasetype;v,b : TConstExprInt);
       begin
-         inherited create;
-         deftype:=orddef;
+         inherited create(orddef);
          low:=v;
          high:=b;
          typ:=t;
@@ -1607,8 +1590,7 @@ implementation
 
     constructor torddef.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuloaddef(ppufile);
-         deftype:=orddef;
+         inherited ppuload(orddef,ppufile);
          typ:=tbasetype(ppufile.getbyte);
          if sizeof(TConstExprInt)=8 then
            begin
@@ -1664,7 +1646,7 @@ implementation
 
     procedure torddef.ppuwrite(ppufile:tcompilerppufile);
       begin
-         inherited ppuwritedef(ppufile);
+         inherited ppuwrite(ppufile);
          ppufile.putbyte(byte(typ));
          if sizeof(TConstExprInt)=8 then
           begin
@@ -1779,8 +1761,7 @@ implementation
 
     constructor tfloatdef.create(t : tfloattype);
       begin
-         inherited create;
-         deftype:=floatdef;
+         inherited create(floatdef);
          typ:=t;
          setsize;
       end;
@@ -1788,8 +1769,7 @@ implementation
 
     constructor tfloatdef.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuloaddef(ppufile);
-         deftype:=floatdef;
+         inherited ppuload(floatdef,ppufile);
          typ:=tfloattype(ppufile.getbyte);
          setsize;
       end;
@@ -1835,7 +1815,7 @@ implementation
 
     procedure tfloatdef.ppuwrite(ppufile:tcompilerppufile);
       begin
-         inherited ppuwritedef(ppufile);
+         inherited ppuwrite(ppufile);
          ppufile.putbyte(byte(typ));
          ppufile.writeentry(ibfloatdef);
       end;
@@ -1877,8 +1857,7 @@ implementation
 
     constructor tfiledef.createtext;
       begin
-         inherited create;
-         deftype:=filedef;
+         inherited create(filedef);
          filetyp:=ft_text;
          typedfiletype.reset;
          setsize;
@@ -1887,8 +1866,7 @@ implementation
 
     constructor tfiledef.createuntyped;
       begin
-         inherited create;
-         deftype:=filedef;
+         inherited create(filedef);
          filetyp:=ft_untyped;
          typedfiletype.reset;
          setsize;
@@ -1897,8 +1875,7 @@ implementation
 
     constructor tfiledef.createtyped(const tt : ttype);
       begin
-         inherited create;
-         deftype:=filedef;
+         inherited create(filedef);
          filetyp:=ft_typed;
          typedfiletype:=tt;
          setsize;
@@ -1907,8 +1884,7 @@ implementation
 
     constructor tfiledef.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuloaddef(ppufile);
-         deftype:=filedef;
+         inherited ppuload(filedef,ppufile);
          filetyp:=tfiletyp(ppufile.getbyte);
          if filetyp=ft_typed then
            ppufile.gettype(typedfiletype)
@@ -1979,7 +1955,7 @@ implementation
 
     procedure tfiledef.ppuwrite(ppufile:tcompilerppufile);
       begin
-         inherited ppuwritedef(ppufile);
+         inherited ppuwrite(ppufile);
          ppufile.putbyte(byte(filetyp));
          if filetyp=ft_typed then
            ppufile.puttype(typedfiletype);
@@ -2019,18 +1995,16 @@ implementation
 
     constructor tvariantdef.create(v : tvarianttype);
       begin
-         inherited create;
+         inherited create(variantdef);
          varianttype:=v;
-         deftype:=variantdef;
          setsize;
       end;
 
 
     constructor tvariantdef.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuloaddef(ppufile);
+         inherited ppuload(variantdef,ppufile);
          varianttype:=tvarianttype(ppufile.getbyte);
-         deftype:=variantdef;
          setsize;
       end;
 
@@ -2043,7 +2017,7 @@ implementation
 
     procedure tvariantdef.ppuwrite(ppufile:tcompilerppufile);
       begin
-         inherited ppuwritedef(ppufile);
+         inherited ppuwrite(ppufile);
          ppufile.putbyte(byte(varianttype));
          ppufile.writeentry(ibvariantdef);
       end;
@@ -2084,37 +2058,69 @@ implementation
       end;
 
 
+{****************************************************************************
+                            TABSTRACTPOINTERDEF
+****************************************************************************}
+
+    constructor tabstractpointerdef.create(dt:tdeftype;const tt : ttype);
+      begin
+        inherited create(dt);
+        pointertype:=tt;
+        savesize:=sizeof(aint);
+      end;
+
+
+    constructor tabstractpointerdef.ppuload(dt:tdeftype;ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(dt,ppufile);
+         ppufile.gettype(pointertype);
+         savesize:=sizeof(aint);
+      end;
+
+
+    procedure tabstractpointerdef.buildderef;
+      begin
+        inherited buildderef;
+        pointertype.buildderef;
+      end;
+
+
+    procedure tabstractpointerdef.deref;
+      begin
+        inherited deref;
+        pointertype.resolve;
+      end;
+
+
+    procedure tabstractpointerdef.ppuwrite(ppufile:tcompilerppufile);
+      begin
+         inherited ppuwrite(ppufile);
+         ppufile.puttype(pointertype);
+      end;
+
+
 {****************************************************************************
                                TPOINTERDEF
 ****************************************************************************}
 
     constructor tpointerdef.create(const tt : ttype);
       begin
-        inherited create;
-        deftype:=pointerdef;
-        pointertype:=tt;
+        inherited create(pointerdef,tt);
         is_far:=false;
-        savesize:=sizeof(aint);
       end;
 
 
     constructor tpointerdef.createfar(const tt : ttype);
       begin
-        inherited create;
-        deftype:=pointerdef;
-        pointertype:=tt;
+        inherited create(pointerdef,tt);
         is_far:=true;
-        savesize:=sizeof(aint);
       end;
 
 
     constructor tpointerdef.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuloaddef(ppufile);
-         deftype:=pointerdef;
-         ppufile.gettype(pointertype);
+         inherited ppuload(pointerdef,ppufile);
          is_far:=(ppufile.getbyte<>0);
-         savesize:=sizeof(aint);
       end;
 
 
@@ -2126,24 +2132,9 @@ implementation
       end;
 
 
-    procedure tpointerdef.buildderef;
-      begin
-        inherited buildderef;
-        pointertype.buildderef;
-      end;
-
-
-    procedure tpointerdef.deref;
-      begin
-        inherited deref;
-        pointertype.resolve;
-      end;
-
-
     procedure tpointerdef.ppuwrite(ppufile:tcompilerppufile);
       begin
-         inherited ppuwritedef(ppufile);
-         ppufile.puttype(pointertype);
+         inherited ppuwrite(ppufile);
          ppufile.putbyte(byte(is_far));
          ppufile.writeentry(ibpointerdef);
       end;
@@ -2164,27 +2155,19 @@ implementation
 
     constructor tclassrefdef.create(const t:ttype);
       begin
-         inherited create(t);
-         deftype:=classrefdef;
+         inherited create(classrefdef,t);
       end;
 
 
     constructor tclassrefdef.ppuload(ppufile:tcompilerppufile);
       begin
-         { be careful, tclassdefref inherits from tpointerdef }
-         inherited ppuloaddef(ppufile);
-         deftype:=classrefdef;
-         ppufile.gettype(pointertype);
-         is_far:=false;
-         savesize:=sizeof(aint);
+         inherited ppuload(classrefdef,ppufile);
       end;
 
 
     procedure tclassrefdef.ppuwrite(ppufile:tcompilerppufile);
       begin
-         { be careful, tclassdefref inherits from tpointerdef }
-         inherited ppuwritedef(ppufile);
-         ppufile.puttype(pointertype);
+         inherited ppuwrite(ppufile);
          ppufile.writeentry(ibclassrefdef);
       end;
 
@@ -2197,19 +2180,17 @@ implementation
 
     function tclassrefdef.is_publishable : boolean;
       begin
-         is_publishable:=true;
+         result:=true;
       end;
 
 
-
 {***************************************************************************
                                    TSETDEF
 ***************************************************************************}
 
     constructor tsetdef.create(const t:ttype;high : aint);
       begin
-         inherited create;
-         deftype:=setdef;
+         inherited create(setdef);
          elementtype:=t;
          // setbase:=low;
          setmax:=high;
@@ -2247,8 +2228,7 @@ implementation
 
     constructor tsetdef.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuloaddef(ppufile);
-         deftype:=setdef;
+         inherited ppuload(setdef,ppufile);
          ppufile.gettype(elementtype);
          settype:=tsettype(ppufile.getbyte);
          case settype of
@@ -2280,7 +2260,7 @@ implementation
 
     procedure tsetdef.ppuwrite(ppufile:tcompilerppufile);
       begin
-         inherited ppuwritedef(ppufile);
+         inherited ppuwrite(ppufile);
          ppufile.puttype(elementtype);
          ppufile.putbyte(byte(settype));
          if settype=varset then
@@ -2346,35 +2326,22 @@ implementation
 ***************************************************************************}
 
     constructor tformaldef.create;
-      var
-         stregdef : boolean;
-      begin
-         stregdef:=registerdef;
-         registerdef:=false;
-         inherited create;
-         deftype:=formaldef;
-         registerdef:=stregdef;
-         { formaldef must be registered at unit level !! }
-         if registerdef and assigned(current_module) then
-            if assigned(current_module.localsymtable) then
-              tsymtable(current_module.localsymtable).registerdef(self)
-            else if assigned(current_module.globalsymtable) then
-              tsymtable(current_module.globalsymtable).registerdef(self);
+      begin
+         inherited create(formaldef);
          savesize:=0;
       end;
 
 
     constructor tformaldef.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuloaddef(ppufile);
-         deftype:=formaldef;
+         inherited ppuload(formaldef,ppufile);
          savesize:=0;
       end;
 
 
     procedure tformaldef.ppuwrite(ppufile:tcompilerppufile);
       begin
-         inherited ppuwritedef(ppufile);
+         inherited ppuwrite(ppufile);
          ppufile.writeentry(ibformaldef);
       end;
 
@@ -2391,8 +2358,7 @@ implementation
 
     constructor tarraydef.create(l,h : aint;const t : ttype);
       begin
-         inherited create;
-         deftype:=arraydef;
+         inherited create(arraydef);
          lowrange:=l;
          highrange:=h;
          rangetype:=t;
@@ -2415,8 +2381,7 @@ implementation
 
     constructor tarraydef.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuloaddef(ppufile);
-         deftype:=arraydef;
+         inherited ppuload(arraydef,ppufile);
          { the addresses are calculated later }
          ppufile.gettype(_elementtype);
          ppufile.gettype(rangetype);
@@ -2459,7 +2424,7 @@ implementation
 
     procedure tarraydef.ppuwrite(ppufile:tcompilerppufile);
       begin
-         inherited ppuwritedef(ppufile);
+         inherited ppuwrite(ppufile);
          ppufile.puttype(_elementtype);
          ppufile.puttype(rangetype);
          ppufile.putaint(lowrange);
@@ -2679,8 +2644,7 @@ implementation
 
     constructor trecorddef.create(p : tsymtable);
       begin
-         inherited create;
-         deftype:=recorddef;
+         inherited create(recorddef);
          symtable:=p;
          symtable.defowner:=self;
          isunion:=false;
@@ -2689,8 +2653,7 @@ implementation
 
     constructor trecorddef.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuloaddef(ppufile);
-         deftype:=recorddef;
+         inherited ppuload(recorddef,ppufile);
          symtable:=trecordsymtable.create(0);
          trecordsymtable(symtable).datasize:=ppufile.getaint;
          trecordsymtable(symtable).fieldalignment:=shortint(ppufile.getbyte);
@@ -2758,7 +2721,7 @@ implementation
 
     procedure trecorddef.ppuwrite(ppufile:tcompilerppufile);
       begin
-         inherited ppuwritedef(ppufile);
+         inherited ppuwrite(ppufile);
          ppufile.putaint(trecordsymtable(symtable).datasize);
          ppufile.putbyte(byte(trecordsymtable(symtable).fieldalignment));
          ppufile.putbyte(byte(trecordsymtable(symtable).recordalignment));
@@ -2819,12 +2782,11 @@ implementation
                        TABSTRACTPROCDEF
 ***************************************************************************}
 
-    constructor tabstractprocdef.create(level:byte);
+    constructor tabstractprocdef.create(dt:tdeftype;level:byte);
       begin
-         inherited create;
+         inherited create(dt);
          parast:=tparasymtable.create(level);
          parast.defowner:=self;
-         parast.next:=owner;
          paras:=nil;
          minparacount:=0;
          maxparacount:=0;
@@ -2962,11 +2924,11 @@ implementation
       end;
 
 
-    constructor tabstractprocdef.ppuload(ppufile:tcompilerppufile);
+    constructor tabstractprocdef.ppuload(dt:tdeftype;ppufile:tcompilerppufile);
       var
         b : byte;
       begin
-         inherited ppuloaddef(ppufile);
+         inherited ppuload(dt,ppufile);
          parast:=nil;
          Paras:=nil;
          minparacount:=0;
@@ -3003,7 +2965,7 @@ implementation
          { released procdef? }
          if not assigned(parast) then
            exit;
-         inherited ppuwritedef(ppufile);
+         inherited ppuwrite(ppufile);
          ppufile.puttype(rettype);
          oldintfcrc:=ppufile.do_interface_crc;
          ppufile.do_interface_crc:=false;
@@ -3132,8 +3094,7 @@ implementation
 
     constructor tprocdef.create(level:byte);
       begin
-         inherited create(level);
-         deftype:=procdef;
+         inherited create(procdef,level);
          _mangledname:=nil;
          fileinfo:=aktfilepos;
          extnumber:=$ffff;
@@ -3164,9 +3125,7 @@ implementation
       var
         level : byte;
       begin
-         inherited ppuload(ppufile);
-         deftype:=procdef;
-
+         inherited ppuload(procdef,ppufile);
          if po_has_mangledname in procoptions then
           _mangledname:=stringdup(ppufile.getstring)
          else
@@ -3364,9 +3323,6 @@ implementation
       begin
          localst:=tlocalsymtable.create(parast.symtablelevel);
          localst.defowner:=self;
-         { this is used by insert
-           to check same names in parast and localst }
-         localst.next:=parast;
       end;
 
 
@@ -3910,15 +3866,13 @@ implementation
 
     constructor tprocvardef.create(level:byte);
       begin
-         inherited create(level);
-         deftype:=procvardef;
+         inherited create(procvardef,level);
       end;
 
 
     constructor tprocvardef.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuload(ppufile);
-         deftype:=procvardef;
+         inherited ppuload(procvardef,ppufile);
          { load para symtable }
          parast:=tparasymtable.create(unknown_level);
          tparasymtable(parast).ppuload(ppufile);
@@ -4228,9 +4182,8 @@ implementation
 
    constructor tobjectdef.create(ot : tobjectdeftype;const n : string;c : tobjectdef);
      begin
-        inherited create;
+        inherited create(objectdef);
         objecttype:=ot;
-        deftype:=objectdef;
         objectoptions:=[];
         childof:=nil;
         symtable:=tobjectsymtable.create(n,aktpackrecords);
@@ -4257,8 +4210,7 @@ implementation
          i,implintfcount: longint;
          d : tderef;
       begin
-         inherited ppuloaddef(ppufile);
-         deftype:=objectdef;
+         inherited ppuload(objectdef,ppufile);
          objecttype:=tobjectdeftype(ppufile.getbyte);
          objrealname:=stringdup(ppufile.getstring);
          objname:=stringdup(upper(objrealname^));
@@ -4366,7 +4318,7 @@ implementation
          implintfcount : longint;
          i : longint;
       begin
-         inherited ppuwritedef(ppufile);
+         inherited ppuwrite(ppufile);
          ppufile.putbyte(byte(objecttype));
          ppufile.putstring(objrealname^);
          ppufile.putaint(tobjectsymtable(symtable).datasize);
@@ -5360,16 +5312,8 @@ implementation
 ****************************************************************************}
 
    constructor tforwarddef.create(const s:string;const pos : tfileposinfo);
-     var
-       oldregisterdef : boolean;
      begin
-        { never register the forwarddefs, they are disposed at the
-          end of the type declaration block }
-        oldregisterdef:=registerdef;
-        registerdef:=false;
-        inherited create;
-        registerdef:=oldregisterdef;
-        deftype:=forwarddef;
+        inherited create(forwarddef);
         tosymname:=stringdup(s);
         forwardpos:=pos;
      end;
@@ -5394,15 +5338,13 @@ implementation
 
    constructor tundefineddef.create;
      begin
-        inherited create;
-        deftype:=undefineddef;
+        inherited create(undefineddef);
      end;
 
 
     constructor tundefineddef.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuloaddef(ppufile);
-         deftype:=undefineddef;
+         inherited ppuload(undefineddef,ppufile);
       end;
 
     function tundefineddef.gettypename:string;
@@ -5413,7 +5355,7 @@ implementation
 
     procedure tundefineddef.ppuwrite(ppufile:tcompilerppufile);
       begin
-         inherited ppuwritedef(ppufile);
+         inherited ppuwrite(ppufile);
          ppufile.writeentry(ibundefineddef);
       end;
 
@@ -5424,8 +5366,7 @@ implementation
 
     constructor terrordef.create;
       begin
-        inherited create;
-        deftype:=errordef;
+        inherited create(errordef);
       end;
 
 

compiler/symsym.pas

@@ -32,7 +32,7 @@ interface
        { symtable }
        symconst,symbase,symtype,symdef,defcmp,
        { ppu }
-       ppu,
+       ppu,finput,
        cclasses,symnot,
        { aasm }
        aasmbase,
@@ -43,8 +43,8 @@ interface
        { this class is the base for all symbol objects }
        tstoredsym = class(tsym)
        public
-          constructor create(const n : string);
-          constructor ppuload(ppufile:tcompilerppufile);
+          constructor create(st:tsymtyp;const n : string);
+          constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
           destructor destroy;override;
           procedure ppuwrite(ppufile:tcompilerppufile);virtual;
        end;
@@ -66,8 +66,8 @@ interface
        end;
 
        tunitsym = class(Tstoredsym)
-          unitsymtable : tsymtable;
-          constructor create(const n : string;ref : tsymtable);
+          module : tobject; { tmodule }
+          constructor create(const n : string;amodule : tobject);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor destroy;override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -138,8 +138,8 @@ interface
           varregable    : tvarregable;
           varstate      : tvarstate;
           notifications : Tlinkedlist;
-          constructor create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
-          constructor ppuload(ppufile:tcompilerppufile);
+          constructor create(st:tsymtyp;const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
+          constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
           destructor  destroy;override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderef;override;
@@ -168,8 +168,8 @@ interface
           defaultconstsym : tsym;
           defaultconstsymderef : tderef;
           localloc      : TLocation; { register/reference for local var }
-          constructor create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
-          constructor ppuload(ppufile:tcompilerppufile);
+          constructor create(st:tsymtyp;const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
+          constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderef;override;
           procedure deref;override;
@@ -333,6 +333,7 @@ interface
           constructor ppuload(ppufile:tcompilerppufile);
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           destructor  destroy;override;
+          function GetCopy:tmacro;
        end;
 
        { compiler generated symbol to point to rtti and init/finalize tables }
@@ -378,13 +379,13 @@ implementation
                           TSYM (base for all symtypes)
 ****************************************************************************}
 
-    constructor tstoredsym.create(const n : string);
+    constructor tstoredsym.create(st:tsymtyp;const n : string);
       begin
-         inherited create(n);
+         inherited create(st,n);
       end;
 
 
-    constructor tstoredsym.ppuload(ppufile:tcompilerppufile);
+    constructor tstoredsym.ppuload(st:tsymtyp;ppufile:tcompilerppufile);
       var
         nr : word;
         s  : string;
@@ -396,7 +397,7 @@ implementation
          else
           inherited createname(upper(s));
          _realname:=stringdup(s);
-         typ:=abstractsym;
+         typ:=st;
          { force the correct indexnr. must be after create! }
          indexnr:=nr;
          ppufile.getposinfo(fileinfo);
@@ -442,8 +443,7 @@ implementation
 
     constructor tlabelsym.create(const n : string);
       begin
-         inherited create(n);
-         typ:=labelsym;
+         inherited create(labelsym,n);
          used:=false;
          defined:=false;
          code:=nil;
@@ -452,8 +452,7 @@ implementation
 
     constructor tlabelsym.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuload(ppufile);
-         typ:=labelsym;
+         inherited ppuload(labelsym,ppufile);
          code:=nil;
          used:=false;
          defined:=true;
@@ -476,24 +475,22 @@ implementation
                                   TUNITSYM
 ****************************************************************************}
 
-    constructor tunitsym.create(const n : string;ref : tsymtable);
+    constructor tunitsym.create(const n : string;amodule : tobject);
       var
         old_make_ref : boolean;
       begin
          old_make_ref:=make_ref;
          make_ref:=false;
-         inherited create(n);
+         inherited create(unitsym,n);
          make_ref:=old_make_ref;
-         typ:=unitsym;
-         unitsymtable:=ref;
+         module:=amodule;
       end;
 
     constructor tunitsym.ppuload(ppufile:tcompilerppufile);
 
       begin
-         inherited ppuload(ppufile);
-         typ:=unitsym;
-         unitsymtable:=nil;
+         inherited ppuload(unitsym,ppufile);
+         module:=nil;
       end;
 
     destructor tunitsym.destroy;
@@ -514,11 +511,9 @@ implementation
     constructor tprocsym.create(const n : string);
 
       begin
-         inherited create(n);
-         typ:=procsym;
+         inherited create(procsym,n);
          pdlistfirst:=nil;
          pdlistlast:=nil;
-         owner:=nil;
          { the tprocdef have their own symoptions, make the procsym
            always visible }
          symoptions:=[sp_public];
@@ -532,8 +527,7 @@ implementation
          pdderef : tderef;
          i,n : longint;
       begin
-         inherited ppuload(ppufile);
-         typ:=procsym;
+         inherited ppuload(procsym,ppufile);
          pdlistfirst:=nil;
          pdlistlast:=nil;
          procdef_count:=0;
@@ -1055,8 +1049,7 @@ implementation
 
     constructor terrorsym.create;
       begin
-        inherited create('');
-        typ:=errorsym;
+        inherited create(errorsym,'');
       end;
 
 {****************************************************************************
@@ -1065,8 +1058,7 @@ implementation
 
     constructor tpropertysym.create(const n : string);
       begin
-         inherited create(n);
-         typ:=propertysym;
+         inherited create(propertysym,n);
          propoptions:=[];
          index:=0;
          default:=0;
@@ -1080,8 +1072,7 @@ implementation
 
     constructor tpropertysym.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuload(ppufile);
-         typ:=propertysym;
+         inherited ppuload(propertysym,ppufile);
          ppufile.getsmallset(propoptions);
          if (ppo_is_override in propoptions) then
           begin
@@ -1201,9 +1192,9 @@ implementation
                             TABSTRACTVARSYM
 ****************************************************************************}
 
-    constructor tabstractvarsym.create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
+    constructor tabstractvarsym.create(st:tsymtyp;const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
       begin
-         inherited create(n);
+         inherited create(st,n);
          vartype:=tt;
          varspez:=vsp;
          varstate:=vs_declared;
@@ -1211,9 +1202,9 @@ implementation
       end;
 
 
-    constructor tabstractvarsym.ppuload(ppufile:tcompilerppufile);
+    constructor tabstractvarsym.ppuload(st:tsymtyp;ppufile:tcompilerppufile);
       begin
-         inherited ppuload(ppufile);
+         inherited ppuload(st,ppufile);
          varstate:=vs_readwritten;
          varspez:=tvarspez(ppufile.getbyte);
          varregable:=tvarregable(ppufile.getbyte);
@@ -1378,16 +1369,14 @@ implementation
 
     constructor tfieldvarsym.create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
       begin
-         inherited create(n,vsp,tt,vopts);
-         typ:=fieldvarsym;
-         fieldoffset:=0;
+         inherited create(fieldvarsym,n,vsp,tt,vopts);
+         fieldoffset:=-1;
       end;
 
 
     constructor tfieldvarsym.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuload(ppufile);
-         typ:=fieldvarsym;
+         inherited ppuload(fieldvarsym,ppufile);
          fieldoffset:=ppufile.getaint;
       end;
 
@@ -1404,17 +1393,17 @@ implementation
                         TABSTRACTNORMALVARSYM
 ****************************************************************************}
 
-    constructor tabstractnormalvarsym.create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
+    constructor tabstractnormalvarsym.create(st:tsymtyp;const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
       begin
-         inherited create(n,vsp,tt,vopts);
+         inherited create(st,n,vsp,tt,vopts);
          fillchar(localloc,sizeof(localloc),0);
          defaultconstsym:=nil;
       end;
 
 
-    constructor tabstractnormalvarsym.ppuload(ppufile:tcompilerppufile);
+    constructor tabstractnormalvarsym.ppuload(st:tsymtyp;ppufile:tcompilerppufile);
       begin
-         inherited ppuload(ppufile);
+         inherited ppuload(st,ppufile);
          fillchar(localloc,sizeof(localloc),0);
          ppufile.getderef(defaultconstsymderef);
       end;
@@ -1447,8 +1436,7 @@ implementation
 
     constructor tglobalvarsym.create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
       begin
-         inherited create(n,vsp,tt,vopts);
-         typ:=globalvarsym;
+         inherited create(globalvarsym,n,vsp,tt,vopts);
          _mangledname:=nil;
       end;
 
@@ -1468,8 +1456,7 @@ implementation
 
     constructor tglobalvarsym.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuload(ppufile);
-         typ:=globalvarsym;
+         inherited ppuload(globalvarsym,ppufile);
          if vo_has_mangledname in varoptions then
            _mangledname:=stringdup(ppufile.getstring)
          else
@@ -1534,15 +1521,13 @@ implementation
 
     constructor tlocalvarsym.create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
       begin
-         inherited create(n,vsp,tt,vopts);
-         typ:=localvarsym;
+         inherited create(localvarsym,n,vsp,tt,vopts);
       end;
 
 
     constructor tlocalvarsym.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuload(ppufile);
-         typ:=localvarsym;
+         inherited ppuload(localvarsym,ppufile);
       end;
 
 
@@ -1559,8 +1544,7 @@ implementation
 
     constructor tparavarsym.create(const n : string;nr:word;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
       begin
-         inherited create(n,vsp,tt,vopts);
-         typ:=paravarsym;
+         inherited create(paravarsym,n,vsp,tt,vopts);
          paranr:=nr;
          paraloc[calleeside].init;
          paraloc[callerside].init;
@@ -1579,7 +1563,7 @@ implementation
       var
         b : byte;
       begin
-         inherited ppuload(ppufile);
+         inherited ppuload(paravarsym,ppufile);
          paranr:=ppufile.getword;
          paraloc[calleeside].init;
          paraloc[callerside].init;
@@ -1592,7 +1576,6 @@ implementation
              paraloc[callerside].size:=paraloc[callerside].location^.size;
              paraloc[callerside].intsize:=tcgsize2size[paraloc[callerside].size];
            end;
-         typ:=paravarsym;
       end;
 
 
@@ -1616,16 +1599,14 @@ implementation
 
     constructor tabsolutevarsym.create(const n : string;const tt : ttype);
       begin
-        inherited create(n,vs_value,tt,[]);
-        typ:=absolutevarsym;
+        inherited create(absolutevarsym,n,vs_value,tt,[]);
         ref:=nil;
       end;
 
 
     constructor tabsolutevarsym.create_ref(const n : string;const tt : ttype;_ref:tsymlist);
       begin
-        inherited create(n,vs_value,tt,[]);
-        typ:=absolutevarsym;
+        inherited create(absolutevarsym,n,vs_value,tt,[]);
         ref:=_ref;
       end;
 
@@ -1640,8 +1621,7 @@ implementation
 
     constructor tabsolutevarsym.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuload(ppufile);
-         typ:=absolutevarsym;
+         inherited ppuload(absolutevarsym,ppufile);
          ref:=nil;
          asmname:=nil;
          abstyp:=absolutetyp(ppufile.getbyte);
@@ -1721,8 +1701,7 @@ implementation
 
     constructor ttypedconstsym.create(const n : string;p : tdef;writable : boolean);
       begin
-         inherited create(n);
-         typ:=typedconstsym;
+         inherited create(typedconstsym,n);
          typedconsttype.setdef(p);
          is_writable:=writable;
       end;
@@ -1730,8 +1709,7 @@ implementation
 
     constructor ttypedconstsym.createtype(const n : string;const tt : ttype;writable : boolean);
       begin
-         inherited create(n);
-         typ:=typedconstsym;
+         inherited create(typedconstsym,n);
          typedconsttype:=tt;
          is_writable:=writable;
       end;
@@ -1739,8 +1717,7 @@ implementation
 
     constructor ttypedconstsym.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuload(ppufile);
-         typ:=typedconstsym;
+         inherited ppuload(typedconstsym,ppufile);
          ppufile.gettype(typedconsttype);
          is_writable:=boolean(ppufile.getbyte);
       end;
@@ -1812,9 +1789,8 @@ implementation
 
     constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
       begin
-         inherited create(n);
+         inherited create(constsym,n);
          fillchar(value, sizeof(value), #0);
-         typ:=constsym;
          consttyp:=t;
          value.valueord:=v;
          ResStrIndex:=0;
@@ -1824,9 +1800,8 @@ implementation
 
     constructor tconstsym.create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);
       begin
-         inherited create(n);
+         inherited create(constsym,n);
          fillchar(value, sizeof(value), #0);
-         typ:=constsym;
          consttyp:=t;
          value.valueordptr:=v;
          ResStrIndex:=0;
@@ -1836,9 +1811,8 @@ implementation
 
     constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
       begin
-         inherited create(n);
+         inherited create(constsym,n);
          fillchar(value, sizeof(value), #0);
-         typ:=constsym;
          consttyp:=t;
          value.valueptr:=v;
          ResStrIndex:=0;
@@ -1848,9 +1822,8 @@ implementation
 
     constructor tconstsym.create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
       begin
-         inherited create(n);
+         inherited create(constsym,n);
          fillchar(value, sizeof(value), #0);
-         typ:=constsym;
          consttyp:=t;
          value.valueptr:=str;
          consttype.reset;
@@ -1862,9 +1835,8 @@ implementation
 
     constructor tconstsym.create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring);
       begin
-         inherited create(n);
+         inherited create(constsym,n);
          fillchar(value, sizeof(value), #0);
-         typ:=constsym;
          consttyp:=t;
          pcompilerwidestring(value.valueptr):=pw;
          consttype.reset;
@@ -1879,8 +1851,7 @@ implementation
          pc : pchar;
          pw : pcompilerwidestring;
       begin
-         inherited ppuload(ppufile);
-         typ:=constsym;
+         inherited ppuload(constsym,ppufile);
          consttype.reset;
          consttyp:=tconsttyp(ppufile.getbyte);
          fillchar(value, sizeof(value), #0);
@@ -2021,8 +1992,7 @@ implementation
 
     constructor tenumsym.create(const n : string;def : tenumdef;v : longint);
       begin
-         inherited create(n);
-         typ:=enumsym;
+         inherited create(enumsym,n);
          definition:=def;
          value:=v;
          { First entry? Then we need to set the minval }
@@ -2050,8 +2020,7 @@ implementation
 
     constructor tenumsym.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuload(ppufile);
-         typ:=enumsym;
+         inherited ppuload(enumsym,ppufile);
          ppufile.getderef(definitionderef);
          value:=ppufile.getlongint;
          nextenum := Nil;
@@ -2112,8 +2081,7 @@ implementation
     constructor ttypesym.create(const n : string;const tt : ttype);
 
       begin
-         inherited create(n);
-         typ:=typesym;
+         inherited create(typesym,n);
          restype:=tt;
         { register the typesym for the definition }
         if assigned(restype.def) and
@@ -2125,8 +2093,7 @@ implementation
 
     constructor ttypesym.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuload(ppufile);
-         typ:=typesym;
+         inherited ppuload(typesym,ppufile);
          ppufile.gettype(restype);
       end;
 
@@ -2198,15 +2165,13 @@ implementation
 
     constructor tsyssym.create(const n : string;l : longint);
       begin
-         inherited create(n);
-         typ:=syssym;
+         inherited create(syssym,n);
          number:=l;
       end;
 
     constructor tsyssym.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuload(ppufile);
-         typ:=syssym;
+         inherited ppuload(syssym,ppufile);
          number:=ppufile.getlongint;
       end;
 
@@ -2229,21 +2194,18 @@ implementation
 
     constructor tmacro.create(const n : string);
       begin
-         inherited create(n);
-         typ:= macrosym;
-         owner:= nil;
-
+         inherited create(macrosym,n);
+         owner:=nil;
          defined:=false;
          is_used:=false;
-         is_compiler_var:= false;
+         is_compiler_var:=false;
          buftext:=nil;
          buflen:=0;
       end;
 
     constructor tmacro.ppuload(ppufile:tcompilerppufile);
       begin
-         inherited ppuload(ppufile);
-         typ:=macrosym;
+         inherited ppuload(macrosym,ppufile);
          name:=ppufile.getstring;
          defined:=boolean(ppufile.getbyte);
          is_compiler_var:=boolean(ppufile.getbyte);
@@ -2261,7 +2223,7 @@ implementation
     destructor tmacro.destroy;
       begin
          if assigned(buftext) then
-           freemem(buftext,buflen);
+           freemem(buftext);
          inherited destroy;
       end;
 
@@ -2278,6 +2240,24 @@ implementation
       end;
 
 
+    function tmacro.GetCopy:tmacro;
+      var
+        p : tmacro;
+      begin
+        p:=tmacro.create(realname);
+        p.defined:=defined;
+        p.is_used:=is_used;
+        p.is_compiler_var:=is_compiler_var;
+        p.buflen:=buflen;
+        if assigned(buftext) then
+          begin
+            getmem(p.buftext,buflen);
+            move(buftext^,p.buftext^,buflen);
+          end;
+        Result:=p;
+      end;
+
+
 {****************************************************************************
                                   TRTTISYM
 ****************************************************************************}
@@ -2286,9 +2266,8 @@ implementation
       const
         prefix : array[trttitype] of string[5]=('$rtti','$init');
       begin
-        inherited create(prefix[rt]+n);
+        inherited create(rttisym,prefix[rt]+n);
         include(symoptions,sp_internal);
-        typ:=rttisym;
         lab:=nil;
         rttityp:=rt;
       end;
@@ -2312,8 +2291,7 @@ implementation
 
     constructor trttisym.ppuload(ppufile:tcompilerppufile);
       begin
-        inherited ppuload(ppufile);
-        typ:=rttisym;
+        inherited ppuload(rttisym,ppufile);
         lab:=nil;
         rttityp:=trttitype(ppufile.getbyte);
       end;

compiler/symtype.pas

@@ -76,7 +76,7 @@ interface
          stab_number : word;
          dbg_state  : tdefdbgstatus;
          defoptions : tdefoptions;
-         constructor create;
+         constructor create(dt:tdeftype);
          procedure buildderef;virtual;abstract;
          procedure buildderefimpl;virtual;abstract;
          procedure deref;virtual;abstract;
@@ -112,7 +112,7 @@ interface
          lastwritten : tref;
          refcount    : longint;
          isstabwritten : boolean;
-         constructor create(const n : string);
+         constructor create(st:tsymtyp;const n : string);
          destructor destroy;override;
          function  realname:string;
          function  mangledname:string; virtual;
@@ -240,10 +240,10 @@ implementation
                                 Tdef
 ****************************************************************************}
 
-    constructor tdef.create;
+    constructor tdef.create(dt:tdeftype);
       begin
          inherited create;
-         deftype:=abstractdef;
+         deftype:=dt;
          owner := nil;
          typesym := nil;
          defoptions:=[];
@@ -307,14 +307,14 @@ implementation
                           TSYM (base for all symtypes)
 ****************************************************************************}
 
-    constructor tsym.create(const n : string);
+    constructor tsym.create(st:tsymtyp;const n : string);
       begin
          if n[1]='$' then
           inherited createname(copy(n,2,255))
          else
           inherited createname(upper(n));
          _realname:=stringdup(n);
-         typ:=abstractsym;
+         typ:=st;
          symoptions:=[];
          defref:=nil;
          refs:=0;

compiler/systems.pas

@@ -667,6 +667,7 @@ var
   target  : tsystem;
   ar      : tar;
   res     : tres;
+  dbg     : tdbg;
 begin
   for target:=low(tsystem) to high(tsystem) do
    if assigned(targetinfos[target]) then
@@ -692,6 +693,12 @@ begin
       freemem(resinfos[res],sizeof(tresinfo));
       resinfos[res]:=nil;
     end;
+  for dbg:=low(tdbg) to high(tdbg) do
+   if assigned(dbginfos[dbg]) then
+    begin
+      freemem(dbginfos[dbg],sizeof(tdbginfo));
+      dbginfos[dbg]:=nil;
+    end;
 end;