* Some more work on the new symtable.

+ Symtable stack unit 'symstack' added.

compiler/new/symtable/cobjects.pas

@@ -172,9 +172,8 @@ type   pfileposinfo = ^tfileposinfo;
          {Note: Initname was changed to init. Init without a name is
                 undesired, the object is called _named_ index object.}
          constructor init(const n:string);
-         destructor  done;virtual;
-         procedure setname(const n:string);virtual;
          function  name:string;virtual;
+         destructor  done;virtual;
        end;
 
        Pdictionaryhasharray=^Tdictionaryhasharray;
@@ -190,6 +189,7 @@ type   pfileposinfo = ^tfileposinfo;
          procedure usehash;
          procedure clear;
          function  empty:boolean;
+         function contains(obj:Pnamedindexobject):boolean;
          procedure foreach(proc2call:Tnamedindexcallback);
          function  insert(obj:Pnamedindexobject):Pnamedindexobject;
          function  rename(const olds,news : string):Pnamedindexobject;
@@ -1009,7 +1009,7 @@ begin
   { index }
   indexnr:=-1;
   { dictionary }
-  speedvalue:=-1;
+  speedvalue:=getspeedvalue(n);
   _name:=stringdup(n);
 end;
 
@@ -1018,16 +1018,6 @@ begin
   stringdispose(_name);
 end;
 
-procedure Tnamedindexobject.setname(const n:string);
-begin
-  if speedvalue=-1 then
-   begin
-     if assigned(_name) then
-       stringdispose(_name);
-     _name:=stringdup(n);
-   end;
-end;
-
 function Tnamedindexobject.name:string;
 begin
   if assigned(_name) then
@@ -1136,7 +1126,6 @@ end;
 
     function Tdictionary.insert(obj:Pnamedindexobject):Pnamedindexobject;
       begin
-        obj^.speedvalue:=getspeedvalue(obj^._name^);
         if assigned(hasharray) then
          insert:=insertnode(obj,hasharray^[obj^.speedvalue mod hasharraysize])
         else
@@ -1941,159 +1930,13 @@ end;
 end.
 {
   $Log$
-  Revision 1.1  2000-02-28 17:23:58  daniel
+  Revision 1.2  2000-03-01 11:43:55  daniel
+  * Some more work on the new symtable.
+  + Symtable stack unit 'symstack' added.
+
+  Revision 1.1  2000/02/28 17:23:58  daniel
   * Current work of symtable integration committed. The symtable can be
     activated by defining 'newst', but doesn't compile yet. Changes in type
     checking and oop are completed. What is left is to write a new
     symtablestack and adapt the parser to use it.
-
-  Revision 1.1  1999/08/05 20:49:15  daniel
-  * Use objects unit.
-
-  Revision 1.36  1999/06/23 11:13:20  peter
-    * fixed linebreak
-
-  Revision 1.35  1999/06/23 11:07:23  daniel
-  * Tdictionary.delete
-
-  Revision 1.33.2.1  1999/06/15 10:12:22  peter
-    * fixed inserttree which didn't reset left,right
-
-  Revision 1.33.2.1  1999/06/15 10:12:22  peter
-    * fixed inserttree which didn't reset left,right
-
-  Revision 1.33  1999/05/31 23:33:21  peter
-    * fixed tdictionary rename which didn't reset left,right when
-      reinserting
-
-  Revision 1.32  1999/05/27 19:44:23  peter
-    * removed oldasm
-    * plabel -> pasmlabel
-    * -a switches to source writing automaticly
-    * assembler readers OOPed
-    * asmsymbol automaticly external
-    * jumptables and other label fixes for asm readers
-
-  Revision 1.31  1999/05/21 13:54:59  peter
-    * NEWLAB for label as symbol
-
-  Revision 1.30  1999/05/21 10:38:59  peter
-    * fixed deleteindex which didn't reset indexnr and set first wrong
-
-  Revision 1.29  1999/05/08 19:47:27  peter
-    * indexarray.delete resets pointer after dispose
-
-  Revision 1.28  1999/05/05 10:05:48  florian
-    * a delphi compiled compiler recompiles ppc
-
-  Revision 1.27  1999/05/05 09:19:03  florian
-    * more fixes to get it with delphi running
-
-  Revision 1.26  1999/04/21 09:43:31  peter
-    * storenumber works
-    * fixed some typos in double_checksum
-    + incompatible types type1 and type2 message (with storenumber)
-
-  Revision 1.25  1999/04/15 10:01:44  peter
-    * small update for storenumber
-
-  Revision 1.24  1999/04/14 09:14:47  peter
-    * first things to store the symbol/def number in the ppu
-
-  Revision 1.23  1999/04/08 20:59:39  florian
-    * fixed problem with default properties which are a class
-    * case bug (from the mailing list with -O2) fixed, the
-      distance of the case labels can be greater than the positive
-      range of a longint => it is now a dword for fpc
-
-  Revision 1.22  1999/03/31 13:55:10  peter
-    * assembler inlining working for ag386bin
-
-  Revision 1.21  1999/03/19 16:35:29  pierre
-   * Tnamedindexobject done also removed left and right
-
-  Revision 1.20  1999/03/18 20:30:45  peter
-    + .a writer
-
-  Revision 1.19  1999/03/01 13:32:00  pierre
-   * external used before implemented problem fixed
-
-  Revision 1.18  1999/02/24 00:59:13  peter
-    * small updates for ag386bin
-
-  Revision 1.17  1999/01/19 11:00:33  daniel
-  + Tdictionary object:  Tsymtable will become object(TTdictionary) in the
-    future
-  + Tnamed_item object:  Tsym will become object(Tnamed_item) in the future
-
-  Revision 1.16  1998/11/04 10:11:37  peter
-    * ansistring fixes
-
-  Revision 1.15  1998/10/19 18:04:40  peter
-    + tstringcontainer.init_no_doubles
-
-  Revision 1.14  1998/09/18 16:03:37  florian
-    * some changes to compile with Delphi
-
-  Revision 1.13  1998/08/12 19:28:16  peter
-    * better libc support
-
-  Revision 1.12  1998/07/14 14:46:47  peter
-    * released NEWINPUT
-
-  Revision 1.11  1998/07/07 11:19:54  peter
-    + NEWINPUT for a better inputfile and scanner object
-
-  Revision 1.10  1998/07/01 15:26:59  peter
-    * better bufferfile.reset error handling
-
-  Revision 1.9  1998/06/03 23:40:37  peter
-    + unlimited file support, release tempclose
-
-  Revision 1.8  1998/05/20 09:42:33  pierre
-    + UseTokenInfo now default
-    * unit in interface uses and implementation uses gives error now
-    * only one error for unknown symbol (uses lastsymknown boolean)
-      the problem came from the label code !
-    + first inlined procedures and function work
-      (warning there might be allowed cases were the result is still wrong !!)
-    * UseBrower updated gives a global list of all position of all used symbols
-      with switch -gb
-
-  Revision 1.7  1998/05/06 18:36:53  peter
-    * tai_section extended with code,data,bss sections and enumerated type
-    * ident 'compiled by FPC' moved to pmodules
-    * small fix for smartlink
-
-  Revision 1.6  1998/05/06 08:38:37  pierre
-    * better position info with UseTokenInfo
-      UseTokenInfo greatly simplified
-    + added check for changed tree after first time firstpass
-      (if we could remove all the cases were it happen
-      we could skip all firstpass if firstpasscount > 1)
-      Only with ExtDebug
-
-  Revision 1.5  1998/04/30 15:59:40  pierre
-    * GDB works again better :
-      correct type info in one pass
-    + UseTokenInfo for better source position
-    * fixed one remaining bug in scanner for line counts
-    * several little fixes
-
-  Revision 1.4  1998/04/29 10:33:50  pierre
-    + added some code for ansistring (not complete nor working yet)
-    * corrected operator overloading
-    * corrected nasm output
-    + started inline procedures
-    + added starstarn : use ** for exponentiation (^ gave problems)
-    + started UseTokenInfo cond to get accurate positions
-
-  Revision 1.3  1998/04/27 23:10:28  peter
-    + new scanner
-    * $makelib -> if smartlink
-    * small filename fixes pmodule.setfilename
-    * moved import from files.pas -> import.pas
-
-  Revision 1.2  1998/04/07 11:09:04  peter
-    + filemode is set correct in tbufferedfile.reset
 }

compiler/new/symtable/defs.pas

@@ -1,10 +1,10 @@
 {
     $Id$
 
-    This unit handles definitions
+    Copyright (C) 1998-2000 by Daniel Mantione
+     and other members of the Free Pascal development team
 
-    Copyright (C) 1998-2000 by Daniel Mantione,
-     member of the Free Pascal development team
+    This unit handles definitions
 
     This program is free software; you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
@@ -577,9 +577,6 @@ var     cformaldef:Pformaldef;      {Unique formal definition.}
         cfiledef:Pfiledef;          {Get the same definition for all files
                                      used for stabs.}
 
-        generrordef:Pdef;           {Jokersymbol for eine fehlerhafte
-                                     typdefinition.}
-
 implementation
 
 uses    systems,symbols,verbose,globals,aasm,files;
@@ -974,6 +971,8 @@ var r:Psym;
 
 begin
     r:=publicsyms^.speedsearch(s,speedvalue);
+    {Privatesyms should be set to nil after compilation of the unit.
+     This way, private syms are not found by objects in other units.}
     if (r=nil) and (privatesyms<>nil) then
         r:=privatesyms^.speedsearch(s,speedvalue);
     if (r=nil) and (protectedsyms<>nil) then
@@ -2906,4 +2905,12 @@ begin
     gettypename:='unresolved forward to '+tosymname;
 end;
 
-end.
+end.
+
+{
+  $Log$
+  Revision 1.4  2000-03-01 11:43:55  daniel
+  * Some more work on the new symtable.
+  + Symtable stack unit 'symstack' added.
+
+}

compiler/new/symtable/symbols.pas

@@ -1,10 +1,10 @@
  {
     $Id$
 
-    This unit handles symbols
+    Copyright (C) 1998-2000 by Daniel Mantione
+     and other members of the Free Pascal development team
 
-    Copyright (C) 1998-2000 by Daniel Mantione,
-     member of the Free Pascal development team
+    This unit handles symbols
 
     This program is free software; you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
@@ -284,7 +284,9 @@ var current_object_option:Tobjprop;
     current_type_option:Ttypepropset;
 
     aktprocsym:Pprocsym;    {Pointer to the symbol for the
-                             currently be parsed procedure.}
+                             currently parsed procedure.}
+    aktprocdef:Pprocdef;    {Pointer to the defnition for the
+                             currently parsed procedure.}
     aktvarsym:Pvarsym;      {Pointer to the symbol for the
                              currently read var, only used
                              for variable directives.}
@@ -295,7 +297,7 @@ var current_object_option:Tobjprop;
 
 implementation
 
-uses    {callspec,}verbose,globals,systems,globtype;
+uses    callspec,verbose,globals,systems,globtype;
 
 {****************************************************************************
                                  Tlabelsym
@@ -363,8 +365,9 @@ begin
     if definitions<>nil then
         if typeof(definitions^)=typeof(Tcollection) then
             firstthat:=Pcollection(definitions)^.firstthat(action)
-        else
-            {***callpointer};
+        else if boolean(byte(longint(callpointerlocal(action,
+         previousframepointer,definitions)))) then
+            firstthat:=Pprocdef(definitions);
 end;
 
 procedure Tprocsym.foreach(action:pointer);
@@ -375,7 +378,7 @@ begin
             if typeof(definitions^)=typeof(Tcollection) then
                 Pcollection(definitions)^.foreach(action)
             else
-                {***callpointerlocal(action,previousframepointer,definitions)};
+                callpointerlocal(action,previousframepointer,definitions);
         end;
 end;
 
@@ -1441,4 +1444,12 @@ begin
     current_ppu^.writeentry(ibpropertysym);*)
 end;
 
-end.
+end.
+
+{
+  $Log$
+  Revision 1.4  2000-03-01 11:43:56  daniel
+  * Some more work on the new symtable.
+  + Symtable stack unit 'symstack' added.
+
+}

compiler/new/symtable/symstack.pas

@@ -0,0 +1,279 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Daniel Mantione
+     member of the Free Pascal development team
+
+    Commandline compiler for Free Pascal
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ***************************************************************************}
+
+unit symstack;
+
+interface
+
+uses    objects,symtable,globtype;
+
+const   cachesize=64;   {This should be a power of 2.}
+
+type    Tsymtablestack=object(Tobject)
+            srsym:Psym;                 {Result of the last search.}
+            srsymtable:Psymtable;
+            lastsrsym:Psym;             {Last sym found in statement.}
+            lastsrsymtable:Psymtable;
+            constructor init;
+            procedure clearcache;
+            procedure insert(s:Psym;addtocache:boolean);
+            function pop:Psymtable;
+            procedure push(s:Psymtable);
+            procedure search(const s:stringid;notfounderror:boolean);
+            function search_a_symtable(const symbol:stringid;symtabletype:pointer):Psym;
+            function top:Psymtable;
+            procedure topfree;
+            destructor done;virtual;
+        private
+            cache:array[1..cachesize] of Psym;
+            cachetables:array[1..cachesize] of Psymtable;
+            symtablestack:Tcollection;  {For speed reasons this is not
+                                         a pointer. A Tcollection is not
+                                         the perfect data structure for
+                                         a stack; it could be a good idea
+                                         to write an abstract stack object.}
+            procedure decache(s:Psymtable);
+        end;
+
+{$IFDEF STATISTICS}
+var hits,misses:longint;
+{$ENDIF STATISTICS}
+
+implementation
+
+uses    cobjects,symtablt,verbose,symbols,defs;
+
+var oldexit:pointer;
+
+constructor Tsymtablestack.init;
+
+begin
+    symtablestack.init(16,8);
+    clearcache;
+end;
+
+procedure Tsymtablestack.clearcache;
+
+begin
+    fillchar(cache,sizeof(cache),0);
+    fillchar(cachetables,sizeof(cache),0);
+end;
+
+procedure Tsymtablestack.decache(s:Psymtable);
+
+var p,endp:^Psymtable;
+    q:^Psym;
+
+begin
+    {Must be fast, otherwise the speed advantage is lost!
+     Therefore, the cache should not be too large...}
+    p:=@cachetables;
+    endp:=pointer(longint(@cachetables)+cachesize*sizeof(pointer));
+    q:=@cache;
+    repeat
+        if p^=s then
+            begin
+                p^:=nil;
+                q^:=nil;
+            end;
+        inc(p);
+        inc(q);
+    until p=endp;
+end;
+
+procedure Tsymtablestack.search(const s:stringid;notfounderror:boolean);
+
+var speedvalue,entry:longint;
+    i:word;
+
+begin
+    speedvalue:=getspeedvalue(s);
+    lastsrsym:=nil;
+    {Check the cache.}
+    entry:=(speedvalue and cachesize-1)+1;
+    if (cache[entry]<>nil) and (cache[entry]^.speedvalue=speedvalue) and
+     (cache[entry]^.name=s) then
+        begin
+            {Cache hit!}
+            srsym:=cache[entry];
+            srsymtable:=cachetables[entry];
+            {$IFDEF STATISTICS}
+            inc(hits);
+            {$ENDIF STATISTICS}
+        end
+    else
+        begin
+            {Cache miss. :( }
+            {$IFDEF STATISTICS}
+            inc(misses);
+            {$ENDIF STATISTICS}
+            for i:=symtablestack.count-1 downto 0 do
+                begin
+                    srsymtable:=Psymtable(symtablestack.at(i));
+                    srsym:=srsymtable^.speedsearch(s,speedvalue);
+                    if srsym<>nil then
+                        begin
+                            {Found! Place it in the cache.}
+                            cache[entry]:=srsym;
+                            cachetables[entry]:=srsymtable;
+                            exit;
+                        end
+                end;
+            {Not found...}
+            srsym:=nil;
+            if notfounderror then
+                begin
+                    message1(sym_e_id_not_found,s);
+                    srsym:=generrorsym;
+                end;
+        end;
+end;
+
+function Tsymtablestack.pop:Psymtable;
+
+var r:Psymtable;
+
+begin
+    r:=symtablestack.at(symtablestack.count);
+    decache(r);
+    pop:=r;
+    symtablestack.atdelete(symtablestack.count);
+end;
+
+procedure Tsymtablestack.push(s:Psymtable);
+
+begin
+    symtablestack.insert(s);
+end;
+
+procedure Tsymtablestack.insert(s:Psym;addtocache:boolean);
+
+var pretop,sttop:Psymtable;
+    hsym:Psym;
+    entry:longint;
+
+begin
+    sttop:=Psymtable(symtablestack.at(symtablestack.count));
+    pretop:=Psymtable(symtablestack.at(symtablestack.count-1));
+    if typeof(sttop^)=typeof(Timplsymtable) then
+        begin
+            {There must also be an interface symtable...}
+            if pretop^.speedsearch(s^.name,s^.speedvalue)<>nil then
+                duplicatesym(s);
+        end;
+    {Check for duplicate field id in inherited classes.}
+    if (typeof(sttop^)=typeof(Tobjectsymtable)) and
+     (Pobjectsymtable(sttop)^.defowner<>nil) then
+        begin
+            {Don't worry about private syms, the private symtable is disposed
+             and set to nil after the unit has been compiled.}
+            hsym:=Pobjectdef(Pobjectsymtable(sttop)^.defowner)^.
+             speedsearch(s^.name,s^.speedvalue);
+            if hsym<>nil then
+                duplicateSym(hsym);
+        end;
+    entry:=(s^.speedvalue and cachesize-1)+1;
+    if (typeof(s^)=typeof(Tenumsym)) and
+     ((typeof(sttop^)=typeof(Trecordsymtable)) or
+      (typeof(sttop^)=typeof(Tobjectsymtable))) then
+        begin
+            if pretop^.insert(s) and addtocache then
+                begin
+                    cache[entry]:=s;
+                    cachetables[entry]:=pretop;
+                end;
+        end
+    else
+        begin
+            if sttop^.insert(s) and addtocache then
+                begin
+                    cache[entry]:=s;
+                    cachetables[entry]:=top;
+                end;
+        end;
+end;
+
+function Tsymtablestack.top:Psymtable;
+
+begin
+    top:=symtablestack.at(symtablestack.count);
+end;
+
+function Tsymtablestack.search_a_symtable(const symbol:stringid;symtabletype:pointer):Psym;
+
+{Search for a symbol in a specified symbol table. Returns nil if
+ the symtable is not found, and also if the symbol cannot be found
+ in the desired symtable.}
+
+var hsymtab:Psymtable;
+    res:Psym;
+    i:word;
+
+begin
+    res:=nil;
+    for i:=symtablestack.count-1 downto 0 do
+        if typeof((Psymtable(symtablestack.at(i))^))=symtabletype then
+            begin
+                {We found the desired symtable. Now check if the symbol we
+                 search for is defined in it }
+                res:=hsymtab^.search(symbol);
+                break;
+            end;
+    search_a_symtable:=res;
+end;
+
+procedure Tsymtablestack.topfree;
+
+begin
+    decache(symtablestack.at(symtablestack.count));
+    symtablestack.atfree(symtablestack.count);
+end;
+
+destructor Tsymtablestack.done;
+
+begin
+    symtablestack.done;
+end;
+
+{$IFDEF STATISTICS}
+
+procedure exitprocedure;{$IFDEF TP}far;{$ENDIF}
+
+begin
+    writeln('Symbol cache statistics:');
+    writeln('------------------------');
+    writeln;
+    writeln('Hits:             ',hits);
+    writeln('Misses:           ',misses);
+    writeln;
+    writeln('Hit percentage:   ',(hits*100) div (hits+misses),'%');
+    exitproc:=oldexit;
+end;
+
+begin
+    hits:=0;
+    misses:=0;
+    oldexit:=exitproc;
+    exitproc:=@exitprocedure;
+{$ENDIF STATISTICS}
+end.

compiler/new/symtable/symtable.pas

@@ -1,12 +1,10 @@
 {
     $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl, Pierre Muller
+    Copyright (C) 1998-2000 by Florian Klaempfl, Daniel Mantione,
+     Pierre Muller and other members of the Free Pascal development team
 
     This unit handles the symbol tables
 
-    Copyright (C) 1998-2000 by Daniel Mantione,
-     member of the Free Pascal development team
-
     This program is free software; you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
     the Free Software Foundation; either version 2 of the License, or
@@ -52,7 +50,7 @@ type    Tdefprop=(dp_regable,           {Can be stored into a register.}
             name:Pstring;
             datasize:longint;
             procedure foreach(proc2call:Tnamedindexcallback);virtual;
-            procedure insert(sym:Psym);virtual;
+            function insert(sym:Psym):boolean;virtual;
             function search(const s:stringid):Psym;
             function speedsearch(const s:stringid;
                                  speedvalue:longint):Psym;virtual;
@@ -78,7 +76,7 @@ type    Tdefprop=(dp_regable,           {Can be stored into a register.}
             {Checks if all labels used.}
             procedure check_labels;
             procedure foreach(proc2call:Tnamedindexcallback);virtual;
-            procedure insert(sym:Psym);virtual;
+            function insert(sym:Psym):boolean;virtual;
             function speedsearch(const s:stringid;
                                  speedvalue:longint):Psym;virtual;
             procedure store(var s:Tstream);virtual;
@@ -171,6 +169,12 @@ var     read_member : boolean;      {True, wenn Members aus einer PPU-
                                      varsym seine Adresse einlesen soll }
         procprefix:stringid;
 
+        generrorsym:Psym;           {Jokersymbol, wenn das richtige
+                                     symbol nicht gefunden wird.}
+        generrordef:Pdef;           {Jokersymbol for eine fehlerhafte
+                                     typdefinition.}
+procedure duplicatesym(sym:psym);
+
 {**************************************************************************}
 
 implementation
@@ -191,7 +195,7 @@ begin
     abstract;
 end;
 
-procedure Tsymtable.insert(sym:Psym);
+function Tsymtable.insert(sym:Psym):boolean;
 
 begin
     abstract;
@@ -285,11 +289,20 @@ begin
     symsearch^.foreach(proc2call);
 end;
 
-procedure Tcontainingsymtable.insert(sym:Psym);
+function Tcontainingsymtable.insert(sym:Psym):boolean;
 
 begin
-    symsearch^.insert(sym);
-    sym^.register_defs;
+    insert:=true;
+    if symsearch^.insert(sym)<>Pnamedindexobject(sym) then
+        begin
+            duplicatesym(sym);
+            insert:=false;
+        end
+    else
+        begin
+            sym^.owner:=@self;
+            sym^.register_defs;
+        end;
 end;
 
 procedure Tcontainingsymtable.set_contents(s:Pdictionary;d:Pcollection);

compiler/new/symtable/symtablt.pas

@@ -59,7 +59,6 @@ type    Pglobalsymtable=^Tglobalsymtable;
         end;
 
         Tabstractrecordsymtable=object(Tcontainingsymtable)
-            procedure insert(sym:Psym);virtual;
             function varsymtodata(sym:Psym;len:longint):longint;virtual;
         end;
 
@@ -81,7 +80,7 @@ type    Pglobalsymtable=^Tglobalsymtable;
              possible to make another Tmethodsymtable and move this field
              to it, but I think the advantage is not worth it. (DM)}
             method:Pdef;
-            procedure insert(sym:Psym);virtual;
+            function insert(sym:Psym):boolean;virtual;
             function speedsearch(const s:stringid;
                                  speedvalue:longint):Psym;virtual;
             function varsymtodata(sym:Psym;len:longint):longint;virtual;
@@ -207,18 +206,6 @@ end;
                         Tabstractrecordsymtable
 ****************************************************************************}
 
-procedure Tabstractrecordsymtable.insert(sym:Psym);
-
-begin
-{   if typeof(sym)=typeof(Tenumsym) then
-        if owner<>nil then
-            owner^.insert(sym)
-        else
-            internalerror($990802)
-    else}
-        inherited insert(sym);
-end;
-
 function Tabstractrecordsymtable.varsymtodata(sym:Psym;
                                              len:longint):longint;
 
@@ -261,13 +248,13 @@ end;}
                              Tprocsymsymtable
 ****************************************************************************}
 
-procedure Tprocsymtable.insert(sym:Psym);
+function Tprocsymtable.insert(sym:Psym):boolean;
 
 begin
-{   if (method<>nil) and (method^.search(sym^.name)<>nil) then}
-        inherited insert(sym)
-{   else
-        duplicatesym(sym)};
+    if (method<>nil) and (Pobjectdef(method)^.search(sym^.name)<>nil) then
+        insert:=inherited insert(sym)
+    else
+        duplicatesym(sym);
 end;
 
 function Tprocsymtable.speedsearch(const s:stringid;

compiler/tree.pas

@@ -1814,6 +1814,50 @@ unit tree;
                set_varstate(p^.right,must_be_valid);
              end;
            loadn :
+         {$IFDEF NEWST}
+         if (typeof(p^.symtableentry^)=typeof(Tvarsym)) or
+           (typeof(p^.symtableentry^)=typeof(Tparamsym)) then
+          begin
+            if must_be_valid and p^.is_first then
+              begin
+                if (pvarsym(p^.symtableentry)^.state=vs_declared_and_first_found) or
+                   (pvarsym(p^.symtableentry)^.state=vs_set_but_first_not_passed) then
+                 if (assigned(pvarsym(p^.symtableentry)^.owner) and
+                    assigned(aktprocsym) and
+                    (pvarsym(p^.symtableentry)^.owner=
+                     Pcontainingsymtable(aktprocdef^.localst))) then
+                  begin
+                    if typeof(p^.symtable^)=typeof(Tprocsymtable) then
+                     CGMessage1(sym_n_uninitialized_local_variable,pvarsym(p^.symtableentry)^.name)
+                    else
+                     CGMessage1(sym_n_uninitialized_variable,pvarsym(p^.symtableentry)^.name);
+                  end;
+              end;
+          if (p^.is_first) then
+           begin
+             if pvarsym(p^.symtableentry)^.state=vs_declared_and_first_found then
+             { this can only happen at left of an assignment, no ? PM }
+              if (parsing_para_level=0) and not must_be_valid then
+               pvarsym(p^.symtableentry)^.state:=vs_assigned
+              else
+               pvarsym(p^.symtableentry)^.state:=vs_used;
+             if pvarsym(p^.symtableentry)^.state=vs_set_but_first_not_passed then
+               pvarsym(p^.symtableentry)^.state:=vs_used;
+             p^.is_first:=false;
+           end
+         else
+           begin
+             if (pvarsym(p^.symtableentry)^.state=vs_assigned) and
+                (must_be_valid or (parsing_para_level>0) or
+                 (typeof(p^.resulttype^)=typeof(Tprocvardef))) then
+               pvarsym(p^.symtableentry)^.state:=vs_used;
+             if (pvarsym(p^.symtableentry)^.state=vs_declared_and_first_found) and
+                (must_be_valid or (parsing_para_level>0) or
+                (typeof(p^.resulttype^)=typeof(Tprocvardef))) then
+               pvarsym(p^.symtableentry)^.state:=vs_set_but_first_not_passed;
+           end;
+         end;
+         {$ELSE}
          if (p^.symtableentry^.typ=varsym) then
           begin
             if must_be_valid and p^.is_first then
@@ -1854,6 +1898,7 @@ unit tree;
                pvarsym(p^.symtableentry)^.varstate:=vs_set_but_first_not_passed;
            end;
          end;
+         {$ENDIF NEWST}
          funcretn:
          begin
          { no claim if setting higher return value_str }
@@ -2021,7 +2066,11 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.114  2000-02-28 17:23:57  daniel
+  Revision 1.115  2000-03-01 11:43:55  daniel
+  * Some more work on the new symtable.
+  + Symtable stack unit 'symstack' added.
+
+  Revision 1.114  2000/02/28 17:23:57  daniel
   * Current work of symtable integration committed. The symtable can be
     activated by defining 'newst', but doesn't compile yet. Changes in type
     checking and oop are completed. What is left is to write a new