* symtable change to classes

  * range check generation and errors fixed, make cycle DEBUG=1 works
  * memory leaks fixed

compiler/aasm.pas

@@ -27,7 +27,7 @@ unit aasm;
 interface
 
     uses
-       cutils,cobjects,cclasses,
+       cutils,cclasses,
        globtype,globals,systems;
 
     type
@@ -99,8 +99,7 @@ interface
 
        TAsmsymtype=(AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION);
 
-       pasmsymbol = ^tasmsymbol;
-       tasmsymbol = object(tnamedindexobject)
+       tasmsymbol = class(TNamedIndexItem)
          defbind,
          bind      : TAsmsymbind;
          typ       : TAsmsymtype;
@@ -114,20 +113,19 @@ interface
          refs    : longint;
          { alternate symbol which can be used for 'renaming' needed for
            inlining }
-         altsymbol : pasmsymbol;
+         altsymbol : tasmsymbol;
          { is the symbol local for a procedure/function }
          proclocal : boolean;
          { is the symbol in the used list }
          inusedlist : boolean;
-         constructor init(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
+         constructor create(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
          procedure reset;
          function  is_used:boolean;
          procedure setaddress(sec:tsection;offset,len:longint);
          procedure GenerateAltSymbol;
        end;
 
-       pasmlabel = ^tasmlabel;
-       tasmlabel = object(tasmsymbol)
+       tasmlabel = class(tasmsymbol)
 {$ifdef PACKENUMFIXED}
          { this is set by the tai_label.Init }
          is_set,
@@ -140,10 +138,10 @@ interface
          is_set,
          is_addr : boolean;
 {$endif}
-         constructor init;
-         constructor initdata;
-         constructor initaddr;
-         function name:string;virtual;
+         constructor create;
+         constructor createdata;
+         constructor createaddr;
+         function getname:string;override;
        end;
 
 
@@ -177,12 +175,12 @@ interface
 {$ifdef PACKENUMFIXED}
           is_global : boolean;
 {$endif}
-          sym : pasmsymbol;
+          sym : tasmsymbol;
           size : longint;
 {$ifndef PACKENUMFIXED}
           is_global : boolean;
 {$endif}
-          constructor Create(_sym:PAsmSymbol;siz:longint);
+          constructor Create(_sym:tasmsymbol;siz:longint);
           constructor Createname(const _name : string;siz:longint);
           constructor Createname_global(const _name : string;siz:longint);
           constructor Createdataname(const _name : string;siz:longint);
@@ -190,8 +188,8 @@ interface
        end;
 
        tai_symbol_end = class(tai)
-          sym : pasmsymbol;
-          constructor Create(_sym:PAsmSymbol);
+          sym : tasmsymbol;
+          constructor Create(_sym:tasmsymbol);
           constructor Createname(const _name : string);
        end;
 
@@ -199,11 +197,11 @@ interface
 {$ifdef PACKENUMFIXED}
           is_global : boolean;
 {$endif}
-          l : pasmlabel;
+          l : tasmlabel;
 {$ifndef PACKENUMFIXED}
           is_global : boolean;
 {$endif}
-          constructor Create(_l : pasmlabel);
+          constructor Create(_l : tasmlabel);
        end;
 
        tai_direct = class(tai)
@@ -248,7 +246,7 @@ interface
 {$ifdef PACKENUMFIXED}
           is_global : boolean;
 {$endif}
-          sym  : pasmsymbol;
+          sym  : tasmsymbol;
           size : longint;
 {$ifndef PACKENUMFIXED}
           is_global : boolean;
@@ -267,11 +265,11 @@ interface
        end;
 
        tai_const_symbol = class(tai)
-          sym    : pasmsymbol;
+          sym    : tasmsymbol;
           offset : longint;
-          constructor Create(_sym:PAsmSymbol);
-          constructor Create_offset(_sym:PAsmSymbol;ofs:longint);
-          constructor Create_rva(_sym:PAsmSymbol);
+          constructor Create(_sym:tasmsymbol);
+          constructor Create_offset(_sym:tasmsymbol;ofs:longint);
+          constructor Create_rva(_sym:tasmsymbol);
           constructor Createname(const name:string);
           constructor Createname_offset(const name:string;ofs:longint);
           constructor Createname_rva(const name:string);
@@ -368,8 +366,8 @@ type
       resourcesection,rttilist,
       resourcestringlist         : taasmoutput;
     { asm symbol list }
-      asmsymbollist : pdictionary;
-      usedasmsymbollist : psinglelist;
+      asmsymbollist : tdictionary;
+      usedasmsymbollist : tsinglelist;
 
     const
       nextaltnr   : longint = 1;
@@ -377,22 +375,22 @@ type
       countlabelref : boolean = true;
 
     { make l as a new label }
-    procedure getlabel(var l : pasmlabel);
+    procedure getlabel(var l : tasmlabel);
     { make l as a new label and flag is_addr }
-    procedure getaddrlabel(var l : pasmlabel);
+    procedure getaddrlabel(var l : tasmlabel);
     { make l as a new label and flag is_data }
-    procedure getdatalabel(var l : pasmlabel);
+    procedure getdatalabel(var l : tasmlabel);
     {just get a label number }
     procedure getlabelnr(var l : longint);
 
-    function  newasmsymbol(const s : string) : pasmsymbol;
-    function  newasmsymboltype(const s : string;_bind:TAsmSymBind;_typ:TAsmsymtype) : pasmsymbol;
-    function  getasmsymbol(const s : string) : pasmsymbol;
-    function  renameasmsymbol(const sold, snew : string):pasmsymbol;
+    function  newasmsymbol(const s : string) : tasmsymbol;
+    function  newasmsymboltype(const s : string;_bind:TAsmSymBind;_typ:TAsmsymtype) : tasmsymbol;
+    function  getasmsymbol(const s : string) : tasmsymbol;
+    function  renameasmsymbol(const sold, snew : string):tasmsymbol;
 
     procedure CreateUsedAsmSymbolList;
     procedure DestroyUsedAsmSymbolList;
-    procedure UsedAsmSymbolListInsert(p:pasmsymbol);
+    procedure UsedAsmSymbolListInsert(p:tasmsymbol);
     procedure UsedAsmSymbolListReset;
     procedure UsedAsmSymbolListResetAltSym;
     procedure UsedAsmSymbolListCheckUndefined;
@@ -465,13 +463,13 @@ uses
                                TAI_SYMBOL
  ****************************************************************************}
 
-    constructor tai_symbol.Create(_sym:PAsmSymbol;siz:longint);
+    constructor tai_symbol.Create(_sym:tasmsymbol;siz:longint);
       begin
          inherited Create;
          typ:=ait_symbol;
          sym:=_sym;
          size:=siz;
-         is_global:=(sym^.defbind=AB_GLOBAL);
+         is_global:=(sym.defbind=AB_GLOBAL);
       end;
 
     constructor tai_symbol.Createname(const _name : string;siz:longint);
@@ -515,7 +513,7 @@ uses
                                TAI_SYMBOL
  ****************************************************************************}
 
-    constructor tai_symbol_end.Create(_sym:PAsmSymbol);
+    constructor tai_symbol_end.Create(_sym:tasmsymbol);
       begin
          inherited Create;
          typ:=ait_symbol_end;
@@ -563,34 +561,34 @@ uses
                                TAI_CONST_SYMBOL_OFFSET
  ****************************************************************************}
 
-    constructor tai_const_symbol.Create(_sym:PAsmSymbol);
+    constructor tai_const_symbol.Create(_sym:tasmsymbol);
       begin
          inherited Create;
          typ:=ait_const_symbol;
          sym:=_sym;
          offset:=0;
          { update sym info }
-         inc(sym^.refs);
+         inc(sym.refs);
       end;
 
-    constructor tai_const_symbol.Create_offset(_sym:PAsmSymbol;ofs:longint);
+    constructor tai_const_symbol.Create_offset(_sym:tasmsymbol;ofs:longint);
       begin
          inherited Create;
          typ:=ait_const_symbol;
          sym:=_sym;
          offset:=ofs;
          { update sym info }
-         inc(sym^.refs);
+         inc(sym.refs);
       end;
 
-    constructor tai_const_symbol.Create_rva(_sym:PAsmSymbol);
+    constructor tai_const_symbol.Create_rva(_sym:tasmsymbol);
       begin
          inherited Create;
          typ:=ait_const_rva;
          sym:=_sym;
          offset:=0;
          { update sym info }
-         inc(sym^.refs);
+         inc(sym.refs);
       end;
 
     constructor tai_const_symbol.Createname(const name:string);
@@ -600,7 +598,7 @@ uses
          sym:=newasmsymbol(name);
          offset:=0;
          { update sym info }
-         inc(sym^.refs);
+         inc(sym.refs);
       end;
 
     constructor tai_const_symbol.Createname_offset(const name:string;ofs:longint);
@@ -610,7 +608,7 @@ uses
          sym:=newasmsymbol(name);
          offset:=ofs;
          { update sym info }
-         inc(sym^.refs);
+         inc(sym.refs);
       end;
 
     constructor tai_const_symbol.Createname_rva(const name:string);
@@ -620,7 +618,7 @@ uses
          sym:=newasmsymbol(name);
          offset:=0;
          { update sym info }
-         inc(sym^.refs);
+         inc(sym.refs);
       end;
 
 
@@ -719,13 +717,13 @@ uses
                                TAI_LABEL
  ****************************************************************************}
 
-    constructor tai_label.create(_l : pasmlabel);
+    constructor tai_label.create(_l : tasmlabel);
       begin
         inherited Create;
         typ:=ait_label;
         l:=_l;
-        l^.is_set:=true;
-        is_global:=(l^.defbind=AB_GLOBAL);
+        l.is_set:=true;
+        is_global:=(l.defbind=AB_GLOBAL);
       end;
 
 
@@ -885,9 +883,9 @@ uses
                                   AsmSymbol
 *****************************************************************************}
 
-    constructor tasmsymbol.Init(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
+    constructor tasmsymbol.create(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
       begin;
-        inherited initname(s);
+        inherited createname(s);
         reset;
         defbind:=_bind;
         typ:=_typ;
@@ -900,9 +898,9 @@ uses
       begin
         if not assigned(altsymbol) then
          begin
-           new(altsymbol,init(name+'_'+tostr(nextaltnr),bind,typ));
+           altsymbol:=tasmsymbol.create(name+'_'+tostr(nextaltnr),bind,typ);
            { also copy the amount of references }
-           altsymbol^.refs:=refs;
+           altsymbol.refs:=refs;
            inc(nextaltnr);
          end;
       end;
@@ -939,41 +937,41 @@ uses
                                   AsmLabel
 *****************************************************************************}
 
-    constructor tasmlabel.Init;
+    constructor tasmlabel.create;
       begin;
         labelnr:=nextlabelnr;
         inc(nextlabelnr);
-        inherited init(target_asm.labelprefix+tostr(labelnr),AB_LOCAL,AT_FUNCTION);
+        inherited create(target_asm.labelprefix+tostr(labelnr),AB_LOCAL,AT_FUNCTION);
         proclocal:=true;
         is_set:=false;
         is_addr := false;
       end;
 
 
-    constructor tasmlabel.Initdata;
+    constructor tasmlabel.createdata;
       begin;
         labelnr:=nextlabelnr;
         inc(nextlabelnr);
         if (cs_create_smart in aktmoduleswitches) or
            target_asm.labelprefix_only_inside_procedure then
-          inherited init('_$'+current_module.modulename^+'$_L'+tostr(labelnr),AB_GLOBAL,AT_DATA)
+          inherited create('_$'+current_module.modulename^+'$_L'+tostr(labelnr),AB_GLOBAL,AT_DATA)
         else
-          inherited init(target_asm.labelprefix+tostr(labelnr),AB_LOCAL,AT_DATA);
+          inherited create(target_asm.labelprefix+tostr(labelnr),AB_LOCAL,AT_DATA);
         is_set:=false;
         is_addr := false;
         { write it always }
         refs:=1;
       end;
 
-    constructor tasmlabel.Initaddr;
+    constructor tasmlabel.createaddr;
       begin;
-        Init;
+        create;
         is_addr := true;
       end;
 
-    function tasmlabel.name:string;
+    function tasmlabel.getname:string;
       begin
-        name:=inherited name;
+        getname:=inherited getname;
         inc(refs);
       end;
 
@@ -982,48 +980,48 @@ uses
                               AsmSymbolList helpers
 *****************************************************************************}
 
-    function newasmsymbol(const s : string) : pasmsymbol;
+    function newasmsymbol(const s : string) : tasmsymbol;
       var
-        hp : pasmsymbol;
+        hp : tasmsymbol;
       begin
-        hp:=pasmsymbol(asmsymbollist^.search(s));
+        hp:=tasmsymbol(asmsymbollist.search(s));
         if not assigned(hp) then
          begin
            { Not found, insert it as an External }
-           hp:=new(pasmsymbol,init(s,AB_EXTERNAL,AT_FUNCTION));
-           asmsymbollist^.insert(hp);
+           hp:=tasmsymbol.create(s,AB_EXTERNAL,AT_FUNCTION);
+           asmsymbollist.insert(hp);
          end;
         newasmsymbol:=hp;
       end;
 
 
-    function newasmsymboltype(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : pasmsymbol;
+    function newasmsymboltype(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : tasmsymbol;
       var
-        hp : pasmsymbol;
+        hp : tasmsymbol;
       begin
-        hp:=pasmsymbol(asmsymbollist^.search(s));
+        hp:=tasmsymbol(asmsymbollist.search(s));
         if assigned(hp) then
-         hp^.defbind:=_bind
+         hp.defbind:=_bind
         else
          begin
            { Not found, insert it as an External }
-           hp:=new(pasmsymbol,init(s,_bind,_typ));
-           asmsymbollist^.insert(hp);
+           hp:=tasmsymbol.create(s,_bind,_typ);
+           asmsymbollist.insert(hp);
          end;
         newasmsymboltype:=hp;
       end;
 
 
-    function getasmsymbol(const s : string) : pasmsymbol;
+    function getasmsymbol(const s : string) : tasmsymbol;
       begin
-        getasmsymbol:=pasmsymbol(asmsymbollist^.search(s));
+        getasmsymbol:=tasmsymbol(asmsymbollist.search(s));
       end;
 
 
     { renames an asmsymbol }
-    function renameasmsymbol(const sold, snew : string):pasmsymbol;
+    function renameasmsymbol(const sold, snew : string):tasmsymbol;
       begin
-        renameasmsymbol:=pasmsymbol(asmsymbollist^.rename(sold,snew));
+        renameasmsymbol:=tasmsymbol(asmsymbollist.rename(sold,snew));
       end;
 
 
@@ -1035,74 +1033,74 @@ uses
       begin
         if assigned(usedasmsymbollist) then
          internalerror(78455782);
-        new(usedasmsymbollist,init);
+        usedasmsymbollist:=TSingleList.create;
       end;
 
 
     procedure DestroyUsedAsmSymbolList;
       begin
-        dispose(usedasmsymbollist,done);
+        usedasmsymbollist.destroy;
         usedasmsymbollist:=nil;
       end;
 
 
-    procedure UsedAsmSymbolListInsert(p:pasmsymbol);
+    procedure UsedAsmSymbolListInsert(p:tasmsymbol);
       begin
-        if not p^.inusedlist then
-         usedasmsymbollist^.insert(p);
-        p^.inusedlist:=true;
+        if not p.inusedlist then
+         usedasmsymbollist.insert(p);
+        p.inusedlist:=true;
       end;
 
 
     procedure UsedAsmSymbolListReset;
       var
-        hp : pasmsymbol;
+        hp : tasmsymbol;
       begin
-        hp:=pasmsymbol(usedasmsymbollist^.first);
+        hp:=tasmsymbol(usedasmsymbollist.first);
         while assigned(hp) do
          begin
-           with hp^ do
+           with hp do
             begin
               reset;
               inusedlist:=false;
             end;
-           hp:=pasmsymbol(hp^.listnext);
+           hp:=tasmsymbol(hp.listnext);
          end;
       end;
 
 
     procedure UsedAsmSymbolListResetAltSym;
       var
-        hp : pasmsymbol;
+        hp : tasmsymbol;
       begin
-        hp:=pasmsymbol(usedasmsymbollist^.first);
+        hp:=tasmsymbol(usedasmsymbollist.first);
         while assigned(hp) do
          begin
-           with hp^ do
+           with hp do
             begin
               altsymbol:=nil;
               inusedlist:=false;
             end;
-           hp:=pasmsymbol(hp^.listnext);
+           hp:=tasmsymbol(hp.listnext);
          end;
       end;
 
 
     procedure UsedAsmSymbolListCheckUndefined;
       var
-        hp : pasmsymbol;
+        hp : tasmsymbol;
       begin
-        hp:=pasmsymbol(usedasmsymbollist^.first);
+        hp:=tasmsymbol(usedasmsymbollist.first);
         while assigned(hp) do
          begin
-           with hp^ do
+           with hp do
             begin
               if (refs>0) and
                  (section=Sec_none) and
                  not(bind in [AB_EXTERNAL,AB_COMMON]) then
                Message1(asmw_e_undefined_label,name);
             end;
-           hp:=pasmsymbol(hp^.listnext);
+           hp:=tasmsymbol(hp.listnext);
          end;
       end;
 
@@ -1111,34 +1109,25 @@ uses
                               Label Helpers
 *****************************************************************************}
 
-    procedure getlabel(var l : pasmlabel);
+    procedure getlabel(var l : tasmlabel);
       begin
-        l:=new(pasmlabel,init);
-        asmsymbollist^.insert(l);
+        l:=tasmlabel.create;
+        asmsymbollist.insert(l);
       end;
 
 
-    procedure getdatalabel(var l : pasmlabel);
+    procedure getdatalabel(var l : tasmlabel);
       begin
-        l:=new(pasmlabel,initdata);
-        asmsymbollist^.insert(l);
+        l:=tasmlabel.createdata;
+        asmsymbollist.insert(l);
       end;
 
-    procedure getaddrlabel(var l : pasmlabel);
+    procedure getaddrlabel(var l : tasmlabel);
       begin
-        l:=new(pasmlabel,initaddr);
-        asmsymbollist^.insert(l);
+        l:=tasmlabel.createaddr;
+        asmsymbollist.insert(l);
       end;
 
-    procedure RegenerateLabel(var l : pasmlabel);
-      begin
-        if l^.proclocal then
-         getlabel(pasmlabel(l^.altsymbol))
-        else
-         getdatalabel(pasmlabel(l^.altsymbol));
-      end;
-
-
     procedure getlabelnr(var l : longint);
       begin
          l:=nextlabelnr;
@@ -1161,7 +1150,12 @@ uses
 end.
 {
   $Log$
-  Revision 1.16  2001-02-20 21:36:39  peter
+  Revision 1.17  2001-04-13 01:22:06  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.16  2001/02/20 21:36:39  peter
     * tasm/masm fixes merged
 
   Revision 1.15  2000/12/25 00:07:25  peter

compiler/assemble.pas

@@ -34,7 +34,7 @@ uses
   strings,
   dos,
 {$endif Delphi}
-  cobjects,globtype,globals,aasm;
+  globtype,globals,aasm;
 
 const
   AsmOutSize=32768;
@@ -612,7 +612,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.16  2001-03-13 18:42:39  peter
+  Revision 1.17  2001-04-13 01:22:06  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.16  2001/03/13 18:42:39  peter
     * don't create temporary smartlink dir for internalassembler
 
   Revision 1.15  2001/03/05 21:39:11  peter

compiler/browlog.pas

@@ -26,7 +26,7 @@ unit browlog;
 
 interface
 uses
-  cobjects,cclasses,
+  cclasses,
   globtype,
   fmodule,finput,
   symbase,symconst,symtype,symsym,symdef,symtable;
@@ -51,7 +51,7 @@ type
     procedure createlog;
     procedure flushlog;
     procedure addlog(const s:string);
-    procedure addlogrefs(p:pref);
+    procedure addlogrefs(p:tref);
     procedure closelog;
     procedure ident;
     procedure unident;
@@ -73,15 +73,15 @@ implementation
 
   uses
     cutils,comphook,
-    globals,systems,verbose,
+    globals,systems,
     ppu;
 
-    function get_file_line(ref:pref): string;
+    function get_file_line(ref:tref): string;
       var
          inputfile : tinputfile;
       begin
         get_file_line:='';
-        with ref^ do
+        with ref do
          begin
            inputfile:=get_source_file(moduleindex,posinfo.fileindex);
            if assigned(inputfile) then
@@ -243,16 +243,16 @@ implementation
       end;
 
 
-    procedure tbrowserlog.addlogrefs(p:pref);
+    procedure tbrowserlog.addlogrefs(p:tref);
       var
-        ref : pref;
+        ref : tref;
       begin
         ref:=p;
         Ident;
         while assigned(ref) do
          begin
            Browserlog.AddLog(get_file_line(ref));
-           ref:=ref^.nextref;
+           ref:=ref.nextref;
          end;
         Unident;
       end;
@@ -260,8 +260,8 @@ implementation
 
     procedure tbrowserlog.browse_symbol(const sr : string);
       var
-         sym,symb : pstoredsym;
-         symt : psymtable;
+         sym,symb : tstoredsym;
+         symt : tsymtable;
          hp : tmodule;
          s,ss : string;
          p : byte;
@@ -290,20 +290,20 @@ implementation
          next_substring;
          if assigned(symt) then
            begin
-              sym:=pstoredsym(symt^.search(ss));
+              sym:=tstoredsym(symt.search(ss));
               if sym=nil then
-                sym:=pstoredsym(symt^.search(upper(ss)));
+                sym:=tstoredsym(symt.search(upper(ss)));
            end
          else
            sym:=nil;
-         if assigned(sym) and (sym^.typ=unitsym) and (s<>'') then
+         if assigned(sym) and (sym.typ=unitsym) and (s<>'') then
            begin
               addlog('Unitsym found !');
-              symt:=punitsym(sym)^.unitsymtable;
+              symt:=tunitsym(sym).unitsymtable;
               if assigned(symt) then
                 begin
                    next_substring;
-                   sym:=pstoredsym(symt^.search(ss));
+                   sym:=tstoredsym(symt.search(ss));
                 end
               else
                 sym:=nil;
@@ -331,54 +331,54 @@ implementation
               else
                 begin
                    next_substring;
-                   sym:=pstoredsym(symt^.search(ss));
+                   sym:=tstoredsym(symt.search(ss));
                    if sym=nil then
-                     sym:=pstoredsym(symt^.search(upper(ss)));
+                     sym:=tstoredsym(symt.search(upper(ss)));
                 end;
            end;
 
          while assigned(sym) and (s<>'') do
            begin
               next_substring;
-              case sym^.typ of
+              case sym.typ of
                 typesym :
                   begin
-                     if ptypesym(sym)^.restype.def^.deftype in [recorddef,objectdef] then
+                     if ttypesym(sym).restype.def.deftype in [recorddef,objectdef] then
                        begin
-                          if ptypesym(sym)^.restype.def^.deftype=recorddef then
-                            symt:=precorddef(ptypesym(sym)^.restype.def)^.symtable
+                          if ttypesym(sym).restype.def.deftype=recorddef then
+                            symt:=trecorddef(ttypesym(sym).restype.def).symtable
                           else
-                            symt:=pobjectdef(ptypesym(sym)^.restype.def)^.symtable;
-                          sym:=pstoredsym(symt^.search(ss));
+                            symt:=tobjectdef(ttypesym(sym).restype.def).symtable;
+                          sym:=tstoredsym(symt.search(ss));
                           if sym=nil then
-                            sym:=pstoredsym(symt^.search(upper(ss)));
+                            sym:=tstoredsym(symt.search(upper(ss)));
                        end;
                   end;
                 varsym :
                   begin
-                     if pvarsym(sym)^.vartype.def^.deftype in [recorddef,objectdef] then
+                     if tvarsym(sym).vartype.def.deftype in [recorddef,objectdef] then
                        begin
-                          if pvarsym(sym)^.vartype.def^.deftype=recorddef then
-                            symt:=precorddef(pvarsym(sym)^.vartype.def)^.symtable
+                          if tvarsym(sym).vartype.def.deftype=recorddef then
+                            symt:=trecorddef(tvarsym(sym).vartype.def).symtable
                           else
-                            symt:=pobjectdef(pvarsym(sym)^.vartype.def)^.symtable;
-                          sym:=pstoredsym(symt^.search(ss));
+                            symt:=tobjectdef(tvarsym(sym).vartype.def).symtable;
+                          sym:=tstoredsym(symt.search(ss));
                           if sym=nil then
-                            sym:=pstoredsym(symt^.search(upper(ss)));
+                            sym:=tstoredsym(symt.search(upper(ss)));
                        end;
                   end;
                 procsym :
                   begin
-                     symt:=pprocsym(sym)^.definition^.parast;
-                     symb:=pstoredsym(symt^.search(ss));
+                     symt:=tprocsym(sym).definition.parast;
+                     symb:=tstoredsym(symt.search(ss));
                      if symb=nil then
-                       symb:=pstoredsym(symt^.search(upper(ss)));
+                       symb:=tstoredsym(symt.search(upper(ss)));
                      if not assigned(symb) then
                        begin
-                          symt:=pprocsym(sym)^.definition^.parast;
-                          sym:=pstoredsym(symt^.search(ss));
+                          symt:=tprocsym(sym).definition.parast;
+                          sym:=tstoredsym(symt.search(ss));
                           if symb=nil then
-                            symb:=pstoredsym(symt^.search(upper(ss)));
+                            symb:=tstoredsym(symt.search(upper(ss)));
                        end
                      else
                        sym:=symb;
@@ -387,10 +387,10 @@ implementation
            end;
            if assigned(sym) then
             begin
-              if assigned(sym^.defref) then
+              if assigned(sym.defref) then
                begin
-                 browserlog.AddLog('***'+sym^.name+'***');
-                 browserlog.AddLogRefs(sym^.defref);
+                 browserlog.AddLog('***'+sym.name+'***');
+                 browserlog.AddLogRefs(sym.defref);
                end;
             end
            else
@@ -410,67 +410,67 @@ implementation
       end;
 
 
-    procedure writesymtable(p:psymtable);
+    procedure writesymtable(p:tsymtable);
       var
-        hp : pstoredsym;
-        prdef : pprocdef;
+        hp : tstoredsym;
+        prdef : tprocdef;
       begin
         if cs_browser in aktmoduleswitches then
          begin
-           if assigned(p^.name) then
-             Browserlog.AddLog('---Symtable '+p^.name^)
+           if assigned(p.name) then
+             Browserlog.AddLog('---Symtable '+p.name^)
            else
              begin
-                if (p^.symtabletype=recordsymtable) and
-                   assigned(pdef(p^.defowner)^.typesym) then
-                  Browserlog.AddLog('---Symtable '+pdef(p^.defowner)^.typesym^.name)
+                if (p.symtabletype=recordsymtable) and
+                   assigned(tdef(p.defowner).typesym) then
+                  Browserlog.AddLog('---Symtable '+tdef(p.defowner).typesym.name)
                 else
                   Browserlog.AddLog('---Symtable with no name');
              end;
            Browserlog.Ident;
-           hp:=pstoredsym(p^.symindex^.first);
+           hp:=tstoredsym(p.symindex.first);
            while assigned(hp) do
             begin
-              if assigned(hp^.defref) then
+              if assigned(hp.defref) then
                begin
-                 browserlog.AddLog('***'+hp^.name+'***');
-                 browserlog.AddLogRefs(hp^.defref);
+                 browserlog.AddLog('***'+hp.name+'***');
+                 browserlog.AddLogRefs(hp.defref);
                end;
-              case hp^.typ of
+              case hp.typ of
                 typesym :
                   begin
-                    if (ptypesym(hp)^.restype.def^.deftype=recorddef) then
-                      writesymtable(precorddef(ptypesym(hp)^.restype.def)^.symtable);
-                    if (ptypesym(hp)^.restype.def^.deftype=objectdef) then
-                      writesymtable(pobjectdef(ptypesym(hp)^.restype.def)^.symtable);
+                    if (ttypesym(hp).restype.def.deftype=recorddef) then
+                      writesymtable(trecorddef(ttypesym(hp).restype.def).symtable);
+                    if (ttypesym(hp).restype.def.deftype=objectdef) then
+                      writesymtable(tobjectdef(ttypesym(hp).restype.def).symtable);
                   end;
                 procsym :
                   begin
-                    prdef:=pprocsym(hp)^.definition;
+                    prdef:=tprocsym(hp).definition;
                     while assigned(prdef) do
                      begin
-                       if assigned(prdef^.defref) then
+                       if assigned(prdef.defref) then
                         begin
-                          browserlog.AddLog('***'+prdef^.mangledname);
-                          browserlog.AddLogRefs(prdef^.defref);
+                          browserlog.AddLog('***'+prdef.mangledname);
+                          browserlog.AddLogRefs(prdef.defref);
                           if (current_module.flags and uf_local_browser)<>0 then
                             begin
-                               if assigned(prdef^.parast) then
-                                 writesymtable(prdef^.parast);
-                               if assigned(prdef^.localst) then
-                                 writesymtable(prdef^.localst);
+                               if assigned(prdef.parast) then
+                                 writesymtable(prdef.parast);
+                               if assigned(prdef.localst) then
+                                 writesymtable(prdef.localst);
                             end;
                         end;
-                       if assigned(pprocdef(prdef)^.defref) then
+                       if assigned(tprocdef(prdef).defref) then
                         begin
-                          browserlog.AddLog('***'+pprocdef(prdef)^.name+'***');
-                          browserlog.AddLogRefs(pprocdef(prdef)^.defref);
+                          browserlog.AddLog('***'+tprocdef(prdef).name+'***');
+                          browserlog.AddLogRefs(tprocdef(prdef).defref);
                         end;
-                       prdef:=pprocdef(prdef)^.nextoverloaded;
+                       prdef:=tprocdef(prdef).nextoverloaded;
                      end;
                   end;
               end;
-              hp:=pstoredsym(hp^.indexnext);
+              hp:=tstoredsym(hp.indexnext);
             end;
            browserlog.Unident;
          end;
@@ -483,7 +483,7 @@ implementation
 
    procedure WriteBrowserLog;
      var
-       p : pstoredsymtable;
+       p : tstoredsymtable;
        hp : tmodule;
      begin
        browserlog.CreateLog;
@@ -491,12 +491,12 @@ implementation
        hp:=tmodule(loaded_units.first);
        while assigned(hp) do
          begin
-            p:=pstoredsymtable(hp.globalsymtable);
+            p:=tstoredsymtable(hp.globalsymtable);
             if assigned(p) then
               writesymtable(p);
             if cs_local_browser in aktmoduleswitches then
               begin
-                 p:=pstoredsymtable(hp.localsymtable);
+                 p:=tstoredsymtable(hp.localsymtable);
                  if assigned(p) then
                    writesymtable(p);
               end;
@@ -519,7 +519,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  2000-12-25 00:07:25  peter
+  Revision 1.7  2001-04-13 01:22:06  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.6  2000/12/25 00:07:25  peter
     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
       tlinkedlist objects)
 

compiler/compiler.pas

@@ -99,7 +99,10 @@ uses
   cutils,cclasses,globals,options,fmodule,parser,symtable,
   link,import,export,tokens,pass_1,
   { cpu overrides }
-  cpuswtch,cpunode
+  cpuswtch
+{$ifndef NOPASS2}
+  ,cpunode
+{$endif}
   ;
 
 function Compile(const cmd:string):longint;
@@ -209,7 +212,7 @@ begin
   CompilerInitedAfterArgs:=true;
 end;
 
-procedure minimal_stop;{$ifndef fpc}far;{$endif}
+procedure minimal_stop;
 begin
   DoneCompiler;
   olddo_stop{$ifdef FPCPROCVAR}(){$endif};
@@ -320,7 +323,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.16  2001-04-02 21:20:29  peter
+  Revision 1.17  2001-04-13 01:22:06  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.16  2001/04/02 21:20:29  peter
     * resulttype rewrite
 
   Revision 1.15  2000/12/26 15:57:25  peter

compiler/cresstr.pas

@@ -142,7 +142,7 @@ procedure TResourceStrings.CreateResourceStringList;
 
   Procedure AppendToAsmResList (P : TResourceStringItem);
   Var
-    l1 : pasmlabel;
+    l1 : tasmlabel;
     s : pchar;
     l : longint;
   begin
@@ -292,7 +292,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.9  2001-02-24 10:44:55  peter
+  Revision 1.10  2001-04-13 01:22:07  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.9  2001/02/24 10:44:55  peter
     * generate .rst from ppufilename instead of modulename
 
   Revision 1.8  2000/12/25 00:07:25  peter

compiler/export.pas

@@ -38,7 +38,7 @@ const
 
 type
    texported_item = class(tlinkedlistitem)
-      sym : psym;
+      sym : tsym;
       index : longint;
       name : pstring;
       options : word;
@@ -239,7 +239,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.12  2001-02-26 19:44:52  peter
+  Revision 1.13  2001-04-13 01:22:07  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.12  2001/02/26 19:44:52  peter
     * merged generic m68k updates from fixes branch
 
   Revision 1.11  2001/02/03 00:09:02  peter

compiler/finput.pas

@@ -27,7 +27,7 @@ unit finput;
 interface
 
     uses
-      cutils,cobjects,cclasses;
+      cutils,cclasses;
 
     const
        InputFileBufSize=32*1024;
@@ -683,7 +683,12 @@ uses
 end.
 {
   $Log$
-  Revision 1.7  2001-03-13 18:43:17  peter
+  Revision 1.8  2001-04-13 01:22:07  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.7  2001/03/13 18:43:17  peter
     * made memdebug and heaptrc compilable again
 
   Revision 1.6  2000/12/25 00:07:25  peter

compiler/fmodule.pas

@@ -25,23 +25,24 @@ unit fmodule;
 {$i defines.inc}
 
 {$ifdef go32v1}
-  {$define SHORTASMPREFIX}
+  {$define SHORTASMprefix}
 {$endif}
 {$ifdef go32v2}
-  {$define SHORTASMPREFIX}
+  {$define SHORTASMprefix}
 {$endif}
 {$ifdef OS2}
   { Allthough OS/2 supports long filenames I play it safe and
     use 8.3 filenames, because this allows the compiler to run
     on a FAT partition. (DM) }
-  {$define SHORTASMPREFIX}
+  {$define SHORTASMprefix}
 {$endif}
 
 interface
 
     uses
-       cutils,cobjects,cclasses,
-       globals,ppu,finput;
+       cutils,cclasses,
+       globals,ppu,finput,
+       symbase;
 
     const
        maxunits = 1024;
@@ -106,8 +107,8 @@ interface
           islibrary     : boolean;  { if it is a library (win32 dll) }
           map           : punitmap; { mapping of all used units }
           unitcount     : longint;  { local unit counter }
-          globalsymtable,           { pointer to the local/static symtable of this unit }
-          localsymtable : pointer;  { pointer to the psymtable of this unit }
+          globalsymtable,           { pointer to the global symtable of this unit }
+          localsymtable : tsymtable;{ pointer to the local symtable of this unit }
           scanner       : pointer;  { scanner object used }
           loaded_from   : tmodule;
           uses_imports  : boolean;  { Set if the module imports from DLL's.}
@@ -187,7 +188,6 @@ uses
   dos,
 {$endif}
   globtype,verbose,systems,
-  symbase,
   scanner;
 
 
@@ -614,12 +614,12 @@ uses
           pscannerfile(scanner)^.invalid:=true;
         if assigned(globalsymtable) then
           begin
-            dispose(psymtable(globalsymtable),done);
+            globalsymtable.free;
             globalsymtable:=nil;
           end;
         if assigned(localsymtable) then
           begin
-            dispose(psymtable(localsymtable),done);
+            localsymtable.free;
             localsymtable:=nil;
           end;
         if assigned(map) then
@@ -703,7 +703,7 @@ uses
          inherited create('Program');
         mainsource:=stringdup(s);
         { Dos has the famous 8.3 limit :( }
-{$ifdef SHORTASMPREFIX}
+{$ifdef SHORTASMprefix}
         asmprefix:=stringdup(FixFileName('as'));
 {$else}
         asmprefix:=stringdup(FixFileName(n));
@@ -815,13 +815,13 @@ uses
         d.init('symtable');
 {$endif}
         if assigned(globalsymtable) then
-          dispose(psymtable(globalsymtable),done);
+          globalsymtable.free;
         globalsymtable:=nil;
         if assigned(localsymtable) then
-          dispose(psymtable(localsymtable),done);
+          localsymtable.free;
         localsymtable:=nil;
 {$ifdef MEMDEBUG}
-        d.done;
+        d.free;
 {$endif}
         inherited Destroy;
       end;
@@ -878,7 +878,12 @@ uses
 end.
 {
   $Log$
-  Revision 1.10  2001-04-02 21:20:29  peter
+  Revision 1.11  2001-04-13 01:22:07  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.10  2001/04/02 21:20:29  peter
     * resulttype rewrite
 
   Revision 1.9  2001/03/13 18:45:06  peter

compiler/gdb.pas

@@ -33,7 +33,7 @@ uses
   strings,
 {$endif}
   globtype,cpubase,
-  cobjects,globals,aasm;
+  globals,aasm;
 
 {stab constants }
 Const
@@ -46,7 +46,7 @@ Const
     N_BssLine = $48;
     N_RSYM = $40; { register variable }
     N_LSYM = $80;
-    N_PSYM = 160;
+    N_tsym = 160;
     N_SourceFile = $64;
     N_IncludeFile = $84;
     N_BINCL = $82;
@@ -249,7 +249,12 @@ end.
 
 {
   $Log$
-  Revision 1.5  2000-12-25 00:07:26  peter
+  Revision 1.6  2001-04-13 01:22:07  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.5  2000/12/25 00:07:26  peter
     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
       tlinkedlist objects)
 

compiler/gendef.pas

@@ -29,11 +29,10 @@ uses
   cclasses;
 
 type
-  pdeffile=^tdeffile;
-  tdeffile=object
+  tdeffile=class
     fname : string;
-    constructor init(const fn:string);
-    destructor  done;
+    constructor create(const fn:string);
+    destructor  destroy;override;
     procedure addexport(const s:string);
     procedure addimport(const s:string);
     procedure writefile;
@@ -44,6 +43,7 @@ type
     exportlist,
     importlist   : tstringlist;
   end;
+
 var
   deffile : tdeffile;
 
@@ -57,7 +57,7 @@ uses
                                TDefFile
 ******************************************************************************}
 
-constructor tdeffile.init(const fn:string);
+constructor tdeffile.create(const fn:string);
 begin
   fname:=fn;
   WrittenOnDisk:=false;
@@ -67,7 +67,7 @@ begin
 end;
 
 
-destructor tdeffile.done;
+destructor tdeffile.destroy;
 begin
   if WrittenOnDisk and
      not(cs_link_extern in aktglobalswitches) then
@@ -160,7 +160,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  2000-12-25 00:07:26  peter
+  Revision 1.6  2001-04-13 01:22:07  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.5  2000/12/25 00:07:26  peter
     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
       tlinkedlist objects)
 

compiler/globals.pas

@@ -47,7 +47,7 @@ interface
       strings,
       dos,
 {$endif}
-      cutils,cobjects,cclasses,
+      cutils,cclasses,
       globtype,version,systems;
 
     const
@@ -282,35 +282,6 @@ implementation
       end;
 
 
-    function ngraphsearchvalue(const s1,s2 : string) : double;
-      const
-         n = 3;
-      var
-         equals,i,j : longint;
-         hs : string;
-      begin
-         equals:=0;
-         { is the string long enough ? }
-         if min(length(s1),length(s2))-n+1<1 then
-           begin
-              ngraphsearchvalue:=0.0;
-              exit;
-           end;
-         for i:=1 to length(s1)-n+1 do
-           begin
-              hs:=copy(s1,i,n);
-              for j:=1 to length(s2)-n+1 do
-                if hs=copy(s2,j,n) then
-                  inc(equals);
-           end;
-{$ifdef fpc}
-         ngraphsearchvalue:=equals/double(max(length(s1),length(s2))-n+1);
-{$else}
-         ngraphsearchvalue:=equals/(max(length(s1),length(s2))-n+1);
-{$endif}
-      end;
-
-
     function bstoslash(const s : string) : string;
     {
       return string s with all \ changed into /
@@ -1341,7 +1312,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.29  2001-04-04 21:30:42  florian
+  Revision 1.30  2001-04-13 01:22:07  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.29  2001/04/04 21:30:42  florian
     * applied several fixes to get the DD8 Delphi Unit compiled
      e.g. "forward"-interfaces are working now
 

compiler/hcodegen.pas

@@ -28,7 +28,7 @@ unit hcodegen;
 
     uses
       { common }
-      cobjects,
+      cclasses,
       { global }
       globals,verbose,
       { symtable }
@@ -55,16 +55,16 @@ unit hcodegen;
           { pointer to parent in nested procedures }
           parent : pprocinfo;
           { current class, if we are in a method }
-          _class : pobjectdef;
+          _class : tobjectdef;
           { return type }
           returntype : ttype;
           { symbol of the function, and the sym for result variable }
           resultfuncretsym,
-          funcretsym : pfuncretsym;
+          funcretsym : tfuncretsym;
           funcret_state : tvarstate;
           { the definition of the proc itself }
-          def : pprocdef;
-          sym : pprocsym;
+          def : tprocdef;
+          sym : tprocsym;
 
           { frame pointer offset }
           framepointer_offset : longint;
@@ -104,11 +104,11 @@ unit hcodegen;
 
        pregvarinfo = ^tregvarinfo;
        tregvarinfo = record
-          regvars : array[1..maxvarregs] of pvarsym;
+          regvars : array[1..maxvarregs] of tvarsym;
           regvars_para : array[1..maxvarregs] of boolean;
           regvars_refs : array[1..maxvarregs] of longint;
 
-          fpuregvars : array[1..maxfpuvarregs] of pvarsym;
+          fpuregvars : array[1..maxfpuvarregs] of tvarsym;
           fpuregvars_para : array[1..maxfpuvarregs] of boolean;
           fpuregvars_refs : array[1..maxfpuvarregs] of longint;
        end;
@@ -119,19 +119,19 @@ unit hcodegen;
        procinfo : pprocinfo;
 
        { labels for BREAK and CONTINUE }
-       aktbreaklabel,aktcontinuelabel : pasmlabel;
+       aktbreaklabel,aktcontinuelabel : tasmlabel;
 
        { label when the result is true or false }
-       truelabel,falselabel : pasmlabel;
+       truelabel,falselabel : tasmlabel;
 
        { label to leave the sub routine }
-       aktexitlabel : pasmlabel;
+       aktexitlabel : tasmlabel;
 
        { also an exit label, only used we need to clear only the stack }
-       aktexit2label : pasmlabel;
+       aktexit2label : tasmlabel;
 
        { only used in constructor for fail or if getmem fails }
-       faillabel,quickexitlabel : pasmlabel;
+       faillabel,quickexitlabel : tasmlabel;
 
        { Boolean, wenn eine loadn kein Assembler erzeugt hat }
        simple_loadn : boolean;
@@ -366,8 +366,8 @@ implementation
          exportssection:=nil;
          resourcesection:=nil;
          { assembler symbols }
-         asmsymbollist:=new(pdictionary,init);
-         asmsymbollist^.usehash;
+         asmsymbollist:=tdictionary.create;
+         asmsymbollist.usehash;
          { resourcestrings }
          ResourceStrings:=TResourceStrings.Create;
       end;
@@ -400,15 +400,15 @@ implementation
          if assigned(resourcesection) then
           resourcesection.free;
 {$ifdef MEMDEBUG}
-         d.done;
+         d.free;
 {$endif}
          { assembler symbols }
 {$ifdef MEMDEBUG}
          d.init('asmsymbol');
 {$endif}
-         dispose(asmsymbollist,done);
+         asmsymbollist.free;
 {$ifdef MEMDEBUG}
-         d.done;
+         d.free;
 {$endif}
          { resource strings }
          ResourceStrings.free;
@@ -437,7 +437,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.9  2000-12-25 00:07:26  peter
+  Revision 1.10  2001-04-13 01:22:07  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.9  2000/12/25 00:07:26  peter
     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
       tlinkedlist objects)
 

compiler/htypechk.pas

@@ -77,16 +77,16 @@ interface
 
     { is overloading of this operator allowed for this
       binary operator }
-    function isbinaryoperatoroverloadable(ld, rd,dd : pdef;
+    function isbinaryoperatoroverloadable(ld, rd,dd : tdef;
              treetyp : tnodetype) : boolean;
 
     { is overloading of this operator allowed for this
       unary operator }
-    function isunaryoperatoroverloadable(rd,dd : pdef;
+    function isunaryoperatoroverloadable(rd,dd : tdef;
              treetyp : tnodetype) : boolean;
 
     { check operator args and result type }
-    function isoperatoracceptable(pf : pprocdef; optoken : ttoken) : boolean;
+    function isoperatoracceptable(pf : tprocdef; optoken : ttoken) : boolean;
     function isbinaryoverloaded(var t : tnode) : boolean;
 
     { Register Allocation }
@@ -94,13 +94,13 @@ interface
     procedure calcregisters(p : tbinarynode;r32,fpu,mmx : word);
 
     { subroutine handling }
-    procedure test_protected_sym(sym : psym);
+    procedure test_protected_sym(sym : tsym);
     procedure test_protected(p : tnode);
     function  valid_for_formal_var(p : tnode) : boolean;
     function  valid_for_formal_const(p : tnode) : boolean;
     function  is_procsym_load(p:tnode):boolean;
     function  is_procsym_call(p:tnode):boolean;
-    procedure test_local_to_procvar(from_def:pprocvardef;to_def:pdef);
+    procedure test_local_to_procvar(from_def:tprocvardef;to_def:tdef);
     function  valid_for_assign(p:tnode;allowprop:boolean):boolean;
     { sets the callunique flag, if the node is a vecn, }
     { takes care of type casts etc.                 }
@@ -138,37 +138,37 @@ implementation
     { ld is the left type definition
       rd the right type definition
       dd the result type definition  or voiddef if unkown }
-    function isbinaryoperatoroverloadable(ld, rd, dd : pdef;
+    function isbinaryoperatoroverloadable(ld, rd, dd : tdef;
              treetyp : tnodetype) : boolean;
       begin
         isbinaryoperatoroverloadable:=
            (treetyp=starstarn) or
-           (ld^.deftype=recorddef) or
-           (rd^.deftype=recorddef) or
-           ((rd^.deftype=pointerdef) and
+           (ld.deftype=recorddef) or
+           (rd.deftype=recorddef) or
+           ((rd.deftype=pointerdef) and
             not(is_pchar(rd) and
                 (is_chararray(ld) or
-                 (ld^.deftype=stringdef) or
+                 (ld.deftype=stringdef) or
                  (treetyp=addn))) and
-            (not(ld^.deftype in [pointerdef,objectdef,classrefdef,procvardef]) or
+            (not(ld.deftype in [pointerdef,objectdef,classrefdef,procvardef]) or
              not (treetyp in [equaln,unequaln,gtn,gten,ltn,lten,subn])
             ) and
             (not is_integer(ld) or not (treetyp in [addn,subn]))
            ) or
-           ((ld^.deftype=pointerdef) and
+           ((ld.deftype=pointerdef) and
             not(is_pchar(ld) and
                 (is_chararray(rd) or
-                 (rd^.deftype=stringdef) or
+                 (rd.deftype=stringdef) or
                  (treetyp=addn))) and
-            (not(rd^.deftype in [stringdef,pointerdef,objectdef,classrefdef,procvardef]) and
-             ((not is_integer(rd) and (rd^.deftype<>objectdef)
-               and (rd^.deftype<>classrefdef)) or
+            (not(rd.deftype in [stringdef,pointerdef,objectdef,classrefdef,procvardef]) and
+             ((not is_integer(rd) and (rd.deftype<>objectdef)
+               and (rd.deftype<>classrefdef)) or
               not (treetyp in [equaln,unequaln,gtn,gten,ltn,lten,addn,subn])
              )
             )
            ) or
            { array def, but not mmx or chararray+[char,string,chararray] }
-           ((ld^.deftype=arraydef) and
+           ((ld.deftype=arraydef) and
             not((cs_mmx in aktlocalswitches) and
                 is_mmx_able_array(ld)) and
             not(is_chararray(ld) and
@@ -176,25 +176,25 @@ implementation
                  is_pchar(rd) or
                  { char array + int = pchar + int, fix for web bug 1377 (JM) }
                  is_integer(rd) or
-                 (rd^.deftype=stringdef) or
+                 (rd.deftype=stringdef) or
                  is_chararray(rd)))
            ) or
-           ((rd^.deftype=arraydef) and
+           ((rd.deftype=arraydef) and
             not((cs_mmx in aktlocalswitches) and
                 is_mmx_able_array(rd)) and
             not(is_chararray(rd) and
                 (is_char(ld) or
                  is_pchar(ld) or
-                 (ld^.deftype=stringdef) or
+                 (ld.deftype=stringdef) or
                  is_chararray(ld)))
            ) or
            { <> and = are defined for classes }
            (
-            (ld^.deftype=objectdef) and
+            (ld.deftype=objectdef) and
             not((treetyp in [equaln,unequaln]) and is_class_or_interface(ld))
            ) or
            (
-            (rd^.deftype=objectdef) and
+            (rd.deftype=objectdef) and
             not((treetyp in [equaln,unequaln]) and is_class_or_interface(rd))
            )
            or
@@ -202,23 +202,23 @@ implementation
            (
             (is_char(rd) or
              is_pchar(rd) or
-             (rd^.deftype=stringdef) or
+             (rd.deftype=stringdef) or
              is_chararray(rd) or
              is_char(ld) or
              is_pchar(ld) or
-             (ld^.deftype=stringdef) or
+             (ld.deftype=stringdef) or
              is_chararray(ld)
              ) and
              not(treetyp in [addn,equaln,unequaln,gtn,gten,ltn,lten]) and
              not(is_pchar(ld) and
-                 (is_integer(rd) or (rd^.deftype=pointerdef)) and
+                 (is_integer(rd) or (rd.deftype=pointerdef)) and
                  (treetyp=subn)
                 )
             );
       end;
 
 
-    function isunaryoperatoroverloadable(rd,dd : pdef;
+    function isunaryoperatoroverloadable(rd,dd : tdef;
              treetyp : tnodetype) : boolean;
       begin
         isunaryoperatoroverloadable:=false;
@@ -233,7 +233,7 @@ implementation
         else if (treetyp=subn { unaryminusn }) then
           begin
             isunaryoperatoroverloadable:=
-              not is_integer(rd) and not (rd^.deftype=floatdef)
+              not is_integer(rd) and not (rd.deftype=floatdef)
 {$ifdef SUPPORT_MMX}
               and not ((cs_mmx in aktlocalswitches) and
               is_mmx_able_array(rd))
@@ -251,20 +251,20 @@ implementation
           end;
       end;
 
-    function isoperatoracceptable(pf : pprocdef; optoken : ttoken) : boolean;
+    function isoperatoracceptable(pf : tprocdef; optoken : ttoken) : boolean;
       var
-        ld,rd,dd : pdef;
+        ld,rd,dd : tdef;
         i : longint;
       begin
-        case pf^.parast^.symindex^.count of
+        case pf.parast.symindex.count of
           2 : begin
                 isoperatoracceptable:=false;
                 for i:=1 to tok2nodes do
                   if tok2node[i].tok=optoken then
                     begin
-                      ld:=pvarsym(pf^.parast^.symindex^.first)^.vartype.def;
-                      rd:=pvarsym(pf^.parast^.symindex^.first^.indexnext)^.vartype.def;
-                      dd:=pf^.rettype.def;
+                      ld:=tvarsym(pf.parast.symindex.first).vartype.def;
+                      rd:=tvarsym(pf.parast.symindex.first.indexnext).vartype.def;
+                      dd:=pf.rettype.def;
                       isoperatoracceptable:=
                         tok2node[i].op_overloading_supported and
                         isbinaryoperatoroverloadable(ld,rd,dd,tok2node[i].nod);
@@ -272,8 +272,8 @@ implementation
                     end;
               end;
           1 : begin
-                rd:=pvarsym(pf^.parast^.symindex^.first)^.vartype.def;
-                dd:=pf^.rettype.def;
+                rd:=tvarsym(pf.parast.symindex.first).vartype.def;
+                dd:=pf.rettype.def;
                 for i:=1 to tok2nodes do
                   if tok2node[i].tok=optoken then
                     begin
@@ -292,7 +292,7 @@ implementation
     function isbinaryoverloaded(var t : tnode) : boolean;
 
      var
-         rd,ld   : pdef;
+         rd,ld   : tdef;
          optoken : ttoken;
          ht      : tnode;
       begin
@@ -359,7 +359,7 @@ implementation
                end
              else
                begin
-                  inc(tcallnode(ht).symtableprocentry^.refs);
+                  inc(tcallnode(ht).symtableprocentry.refs);
                   { we need copies, because the originals will be destroyed when we give a }
                   { changed node back to firstpass! (JM)                                   }
                   if assigned(tbinarynode(t).left) then
@@ -394,8 +394,8 @@ implementation
             typeconvn :
               make_not_regable(ttypeconvnode(p).left);
             loadn :
-              if tloadnode(p).symtableentry^.typ=varsym then
-                pvarsym(tloadnode(p).symtableentry)^.varoptions:=pvarsym(tloadnode(p).symtableentry)^.varoptions-[vo_regable,vo_fpuregable];
+              if tloadnode(p).symtableentry.typ=varsym then
+                tvarsym(tloadnode(p).symtableentry).varoptions:=tvarsym(tloadnode(p).symtableentry).varoptions-[vo_regable,vo_fpuregable];
          end;
       end;
 
@@ -464,12 +464,19 @@ implementation
   overloaded function
   this is the reason why it is not in the parser, PM }
 
-    procedure test_protected_sym(sym : psym);
+    procedure test_protected_sym(sym : tsym);
       begin
-         if (sp_protected in sym^.symoptions) and
-            ((sym^.owner^.symtabletype=unitsymtable) or
-             ((sym^.owner^.symtabletype=objectsymtable) and
-             (pobjectdef(sym^.owner^.defowner)^.owner^.symtabletype=unitsymtable))
+         if (sp_protected in sym.symoptions) and
+            (
+             (
+              (sym.owner.symtabletype=globalsymtable) and
+              (sym.owner.unitid<>0)
+             ) or
+             (
+              (sym.owner.symtabletype=objectsymtable) and
+              (tobjectdef(sym.owner.defowner).owner.symtabletype=globalsymtable) and
+              (tobjectdef(sym.owner.defowner).owner.unitid<>0)
+             )
             ) then
           CGMessage(parser_e_cant_access_protected_member);
       end;
@@ -496,7 +503,7 @@ implementation
      begin
         case p.nodetype of
          loadn :
-           v:=(tloadnode(p).symtableentry^.typ in [typedconstsym,varsym]);
+           v:=(tloadnode(p).symtableentry.typ in [typedconstsym,varsym]);
          typeconvn :
            v:=valid_for_formal_var(ttypeconvnode(p).left);
          derefn,
@@ -548,9 +555,9 @@ implementation
 
     function is_procsym_load(p:tnode):boolean;
       begin
-         is_procsym_load:=((p.nodetype=loadn) and (tloadnode(p).symtableentry^.typ=procsym)) or
+         is_procsym_load:=((p.nodetype=loadn) and (tloadnode(p).symtableentry.typ=procsym)) or
                           ((p.nodetype=addrn) and (taddrnode(p).left.nodetype=loadn)
-                          and (tloadnode(taddrnode(p).left).symtableentry^.typ=procsym)) ;
+                          and (tloadnode(taddrnode(p).left).symtableentry.typ=procsym)) ;
       end;
 
    { change a proc call to a procload for assignment to a procvar }
@@ -558,15 +565,15 @@ implementation
     function is_procsym_call(p:tnode):boolean;
       begin
         is_procsym_call:=(p.nodetype=calln) and (tcallnode(p).left=nil) and
-             (((tcallnode(p).symtableprocentry^.typ=procsym) and (tcallnode(p).right=nil)) or
-             (assigned(tcallnode(p).right) and (tcallnode(tcallnode(p).right).symtableprocentry^.typ=varsym)));
+             (((tcallnode(p).symtableprocentry.typ=procsym) and (tcallnode(p).right=nil)) or
+             (assigned(tcallnode(p).right) and (tcallnode(tcallnode(p).right).symtableprocentry.typ=varsym)));
       end;
 
 
     { local routines can't be assigned to procvars }
-    procedure test_local_to_procvar(from_def:pprocvardef;to_def:pdef);
+    procedure test_local_to_procvar(from_def:tprocvardef;to_def:tdef);
       begin
-         if (from_def^.symtablelevel>1) and (to_def^.deftype=procvardef) then
+         if (from_def.symtablelevel>1) and (to_def.deftype=procvardef) then
            CGMessage(type_e_cannot_local_proc_to_procvar);
       end;
 
@@ -610,7 +617,7 @@ implementation
                end;
              typeconvn :
                begin
-                 case hp.resulttype.def^.deftype of
+                 case hp.resulttype.def.deftype of
                    pointerdef :
                      gotpointer:=true;
                    objectdef :
@@ -621,7 +628,7 @@ implementation
                      begin
                        { pointer -> array conversion is done then we need to see it
                          as a deref, because a ^ is then not required anymore }
-                       if (ttypeconvnode(hp).left.resulttype.def^.deftype=pointerdef) then
+                       if (ttypeconvnode(hp).left.resulttype.def.deftype=pointerdef) then
                         gotderef:=true;
                      end;
                  end;
@@ -644,7 +651,7 @@ implementation
                begin
                  { Allow add/sub operators on a pointer, or an integer
                    and a pointer typecast and deref has been found }
-                 if (hp.resulttype.def^.deftype=pointerdef) or
+                 if (hp.resulttype.def.deftype=pointerdef) or
                     (is_integer(hp.resulttype.def) and gotpointer and gotderef) then
                   valid_for_assign:=true
                  else
@@ -667,7 +674,7 @@ implementation
              calln :
                begin
                  { check return type }
-                 case hp.resulttype.def^.deftype of
+                 case hp.resulttype.def.deftype of
                    pointerdef :
                      gotpointer:=true;
                    objectdef :
@@ -689,11 +696,11 @@ implementation
                end;
              loadn :
                begin
-                 case tloadnode(hp).symtableentry^.typ of
+                 case tloadnode(hp).symtableentry.typ of
                    absolutesym,
                    varsym :
                      begin
-                       if (pvarsym(tloadnode(hp).symtableentry)^.varspez=vs_const) then
+                       if (tvarsym(tloadnode(hp).symtableentry).varspez=vs_const) then
                         begin
                           { allow p^:= constructions with p is const parameter }
                           if gotderef then
@@ -704,17 +711,17 @@ implementation
                         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
+                       if (tloadnode(hp).symtable.symtabletype=withsymtable) then
                         begin
                           { continue with processing the withref node }
-                          hp:=tnode(pwithsymtable(tloadnode(hp).symtable)^.withrefnode);
+                          hp:=tnode(twithsymtable(tloadnode(hp).symtable).withrefnode);
                           gotwith:=true;
                         end
                        else
                         begin
                           { set the assigned flag for varsyms }
-                          if (pvarsym(tloadnode(hp).symtableentry)^.varstate=vs_declared) then
-                           pvarsym(tloadnode(hp).symtableentry)^.varstate:=vs_assigned;
+                          if (tvarsym(tloadnode(hp).symtableentry).varstate=vs_declared) then
+                           tvarsym(tloadnode(hp).symtableentry).varstate:=vs_assigned;
                           valid_for_assign:=true;
                           exit;
                         end;
@@ -739,7 +746,7 @@ implementation
 
     procedure set_varstate(p : tnode;must_be_valid : boolean);
       var
-        hsym : pvarsym;
+        hsym : tvarsym;
       begin
         while assigned(p) do
          begin
@@ -765,7 +772,7 @@ implementation
              vecn:
                begin
                  set_varstate(tbinarynode(p).right,true);
-                 if not(tunarynode(p).left.resulttype.def^.deftype in [stringdef,arraydef]) then
+                 if not(tunarynode(p).left.resulttype.def.deftype in [stringdef,arraydef]) then
                   must_be_valid:=true;
                  p:=tunarynode(p).left;
                end;
@@ -779,50 +786,50 @@ implementation
                end;
              loadn :
                begin
-                 if (tloadnode(p).symtableentry^.typ=varsym) then
+                 if (tloadnode(p).symtableentry.typ=varsym) then
                   begin
-                    hsym:=pvarsym(tloadnode(p).symtableentry);
+                    hsym:=tvarsym(tloadnode(p).symtableentry);
                     if must_be_valid and (nf_first in p.flags) then
                      begin
-                       if (hsym^.varstate=vs_declared_and_first_found) or
-                          (hsym^.varstate=vs_set_but_first_not_passed) then
+                       if (hsym.varstate=vs_declared_and_first_found) or
+                          (hsym.varstate=vs_set_but_first_not_passed) then
                         begin
-                          if (assigned(hsym^.owner) and
+                          if (assigned(hsym.owner) and
                              assigned(aktprocsym) and
-                             (hsym^.owner = aktprocsym^.definition^.localst)) then
+                             (hsym.owner = aktprocsym.definition.localst)) then
                            begin
-                             if tloadnode(p).symtable^.symtabletype=localsymtable then
-                              CGMessage1(sym_n_uninitialized_local_variable,hsym^.realname)
+                             if tloadnode(p).symtable.symtabletype=localsymtable then
+                              CGMessage1(sym_n_uninitialized_local_variable,hsym.realname)
                              else
-                              CGMessage1(sym_n_uninitialized_variable,hsym^.realname);
+                              CGMessage1(sym_n_uninitialized_variable,hsym.realname);
                            end;
                         end;
                      end;
                     if (nf_first in p.flags) then
                      begin
-                       if hsym^.varstate=vs_declared_and_first_found then
+                       if hsym.varstate=vs_declared_and_first_found then
                         begin
                           { this can only happen at left of an assignment, no ? PM }
                           if (parsing_para_level=0) and not must_be_valid then
-                           hsym^.varstate:=vs_assigned
+                           hsym.varstate:=vs_assigned
                           else
-                           hsym^.varstate:=vs_used;
+                           hsym.varstate:=vs_used;
                         end
                        else
-                        if hsym^.varstate=vs_set_but_first_not_passed then
-                         hsym^.varstate:=vs_used;
+                        if hsym.varstate=vs_set_but_first_not_passed then
+                         hsym.varstate:=vs_used;
                        exclude(p.flags,nf_first);
                      end
                     else
                       begin
-                        if (hsym^.varstate=vs_assigned) and
+                        if (hsym.varstate=vs_assigned) and
                            (must_be_valid or (parsing_para_level>0) or
-                            (p.resulttype.def^.deftype=procvardef)) then
-                          hsym^.varstate:=vs_used;
-                        if (hsym^.varstate=vs_declared_and_first_found) and
+                            (p.resulttype.def.deftype=procvardef)) then
+                          hsym.varstate:=vs_used;
+                        if (hsym.varstate=vs_declared_and_first_found) and
                            (must_be_valid or (parsing_para_level>0) or
-                           (p.resulttype.def^.deftype=procvardef)) then
-                          hsym^.varstate:=vs_set_but_first_not_passed;
+                           (p.resulttype.def.deftype=procvardef)) then
+                          hsym.varstate:=vs_set_but_first_not_passed;
                       end;
                   end;
                  break;
@@ -914,7 +921,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.23  2001-04-02 21:20:29  peter
+  Revision 1.24  2001-04-13 01:22:08  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.23  2001/04/02 21:20:29  peter
     * resulttype rewrite
 
   Revision 1.22  2001/02/20 21:46:26  peter

compiler/i386/ag386att.pas

@@ -27,7 +27,7 @@ unit ag386att;
 interface
 
     uses
-      cobjects,
+      cclasses,
       globals,
       aasm,assemble;
 
@@ -168,7 +168,7 @@ interface
             else
              s:='';
             if assigned(symbol) then
-             s:=s+symbol^.name;
+             s:=s+symbol.name;
             if offset<0 then
              s:=s+tostr(offset)
             else
@@ -218,7 +218,7 @@ interface
         top_symbol :
           begin
             if assigned(o.sym) then
-              hs:='$'+o.sym^.name
+              hs:='$'+o.sym.name
             else
               hs:='$';
             if o.symofs>0 then
@@ -249,7 +249,7 @@ interface
           getopstr_jmp:=tostr(o.val);
         top_symbol :
           begin
-            hs:=o.sym^.name;
+            hs:=o.sym.name;
             if o.symofs>0 then
              hs:=hs+'+'+tostr(o.symofs)
             else
@@ -496,7 +496,7 @@ interface
                 AsmWrite(#9'.comm'#9)
                else
                 AsmWrite(#9'.lcomm'#9);
-               AsmWrite(tai_datablock(hp).sym^.name);
+               AsmWrite(tai_datablock(hp).sym.name);
                AsmWriteLn(','+tostr(tai_datablock(hp).size));
              end;
 
@@ -522,7 +522,7 @@ interface
 
            ait_const_symbol :
              begin
-               AsmWrite(#9'.long'#9+tai_const_symbol(hp).sym^.name);
+               AsmWrite(#9'.long'#9+tai_const_symbol(hp).sym.name);
                if tai_const_symbol(hp).offset>0 then
                  AsmWrite('+'+tostr(tai_const_symbol(hp).offset))
                else if tai_const_symbol(hp).offset<0 then
@@ -531,7 +531,7 @@ interface
              end;
 
            ait_const_rva :
-             AsmWriteLn(#9'.rva'#9+tai_const_symbol(hp).sym^.name);
+             AsmWriteLn(#9'.rva'#9+tai_const_symbol(hp).sym.name);
 
            ait_real_80bit :
              begin
@@ -645,14 +645,14 @@ interface
 
            ait_label :
              begin
-               if (tai_label(hp).l^.is_used) then
+               if (tai_label(hp).l.is_used) then
                 begin
-                  if tai_label(hp).l^.defbind=AB_GLOBAL then
+                  if tai_label(hp).l.defbind=AB_GLOBAL then
                    begin
                      AsmWrite('.globl'#9);
-                     AsmWriteLn(tai_label(hp).l^.name);
+                     AsmWriteLn(tai_label(hp).l.name);
                    end;
-                  AsmWrite(tai_label(hp).l^.name);
+                  AsmWrite(tai_label(hp).l.name);
                   AsmWriteLn(':');
                 end;
              end;
@@ -662,12 +662,12 @@ interface
                if tai_symbol(hp).is_global then
                 begin
                   AsmWrite('.globl'#9);
-                  AsmWriteLn(tai_symbol(hp).sym^.name);
+                  AsmWriteLn(tai_symbol(hp).sym.name);
                 end;
                if target_info.target=target_i386_linux then
                 begin
                    AsmWrite(#9'.type'#9);
-                   AsmWrite(tai_symbol(hp).sym^.name);
+                   AsmWrite(tai_symbol(hp).sym.name);
                    if assigned(tai(hp.next)) and
                       (tai(hp.next).typ in [ait_const_symbol,ait_const_rva,
                          ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_datablock,
@@ -675,15 +675,15 @@ interface
                     AsmWriteLn(',@object')
                    else
                     AsmWriteLn(',@function');
-                   if tai_symbol(hp).sym^.size>0 then
+                   if tai_symbol(hp).sym.size>0 then
                     begin
                       AsmWrite(#9'.size'#9);
-                      AsmWrite(tai_symbol(hp).sym^.name);
+                      AsmWrite(tai_symbol(hp).sym.name);
                       AsmWrite(', ');
-                      AsmWriteLn(tostr(tai_symbol(hp).sym^.size));
+                      AsmWriteLn(tostr(tai_symbol(hp).sym.size));
                     end;
                 end;
-               AsmWrite(tai_symbol(hp).sym^.name);
+               AsmWrite(tai_symbol(hp).sym.name);
                AsmWriteLn(':');
              end;
 
@@ -695,9 +695,9 @@ interface
                   inc(symendcount);
                   AsmWriteLn(s+':');
                   AsmWrite(#9'.size'#9);
-                  AsmWrite(tai_symbol(hp).sym^.name);
+                  AsmWrite(tai_symbol(hp).sym.name);
                   AsmWrite(', '+s+' - ');
-                  AsmWriteLn(tai_symbol(hp).sym^.name);
+                  AsmWriteLn(tai_symbol(hp).sym.name);
                 end;
              end;
 
@@ -892,7 +892,12 @@ interface
 end.
 {
   $Log$
-  Revision 1.4  2001-03-05 21:39:11  peter
+  Revision 1.5  2001-04-13 01:22:17  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.4  2001/03/05 21:39:11  peter
     * changed to class with common TAssembler also for internal assembler
 
   Revision 1.3  2001/01/13 20:24:24  peter

compiler/i386/ag386bin.pas

@@ -29,7 +29,7 @@ unit ag386bin;
 interface
 
     uses
-      cobjects,
+      cclasses,
       globals,
       cpubase,aasm,
       fmodule,finput,
@@ -55,7 +55,7 @@ interface
         n_line       : byte;     { different types of source lines }
         linecount,
         includecount : longint;
-        funcname     : pasmsymbol;
+        funcname     : tasmsymbol;
         stabslastfileinfo : tfileposinfo;
         procedure convertstabs(p:pchar);
         procedure emitlineinfostabs(nidx,line : longint);
@@ -100,7 +100,7 @@ implementation
         hp : pchar;
         reloc : boolean;
         sec : tsection;
-        ps : pasmsymbol;
+        ps : tasmsymbol;
         s : string;
       begin
         ofs:=0;
@@ -187,8 +187,8 @@ implementation
                   internalerror(33006)
                 else
                   begin
-                    sec:=ps^.section;
-                    ofs:=ps^.address;
+                    sec:=ps.section;
+                    ofs:=ps.address;
                     reloc:=true;
                     UsedAsmSymbolListInsert(ps);
                   end;
@@ -209,9 +209,9 @@ implementation
                       internalerror(33007)
                     else
                       begin
-                        if ps^.section<>sec then
+                        if ps.section<>sec then
                           internalerror(33008);
-                        ofs:=ofs-ps^.address;
+                        ofs:=ofs-ps.address;
                         reloc:=false;
                         UsedAsmSymbolListInsert(ps);
                       end;
@@ -219,7 +219,7 @@ implementation
               end;
           end;
         { external bss need speical handling (PM) }
-        if assigned(ps) and (ps^.section=sec_none) then
+        if assigned(ps) and (ps.section=sec_none) then
           begin
             if currpass=2 then
               begin
@@ -247,7 +247,7 @@ implementation
 
         if (nidx=n_textline) and assigned(funcname) and
            (target_os.use_function_relative_addresses) then
-          objectdata.WriteStabs(sec_code,objectdata.sectionsize(sec_code)-funcname^.address,
+          objectdata.WriteStabs(sec_code,objectdata.sectionsize(sec_code)-funcname.address,
               nil,nidx,0,line,false)
         else
           begin
@@ -273,7 +273,7 @@ implementation
     procedure TInternalAssembler.WriteFileLineInfo(var fileinfo : tfileposinfo);
       var
         curr_n : byte;
-        hp : pasmsymbol;
+        hp : tasmsymbol;
         infile : tinputfile;
       begin
         if not ((cs_debuginfo in aktmoduleswitches) or
@@ -292,7 +292,7 @@ implementation
            hp:=newasmsymboltype('Ltext'+ToStr(IncludeCount),AB_LOCAL,AT_FUNCTION);
            if currpass=1 then
              begin
-                hp^.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
+                hp.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
                 UsedAsmSymbolListInsert(hp);
              end
            else
@@ -329,7 +329,7 @@ implementation
 
     procedure TInternalAssembler.EndFileLineInfo;
       var
-        hp : pasmsymbol;
+        hp : tasmsymbol;
         store_sec : tsection;
       begin
           if not ((cs_debuginfo in aktmoduleswitches) or
@@ -340,7 +340,7 @@ implementation
         hp:=newasmsymboltype('Letext',AB_LOCAL,AT_FUNCTION);
         if currpass=1 then
           begin
-            hp^.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
+            hp.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
             UsedAsmSymbolListInsert(hp);
           end
         else
@@ -430,9 +430,9 @@ implementation
              ait_section:
                objectalloc.setsection(Tai_section(hp).sec);
              ait_symbol :
-               Tai_symbol(hp).sym^.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
+               Tai_symbol(hp).sym.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
              ait_label :
-               Tai_label(hp).l^.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
+               Tai_label(hp).l.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
              ait_string :
                objectalloc.sectionalloc(Tai_string(hp).len);
              ait_instruction :
@@ -487,10 +487,10 @@ implementation
                   begin
                     if Tai_datablock(hp).is_global then
                      begin
-                       Tai_datablock(hp).sym^.setaddress(sec_none,Tai_datablock(hp).size,Tai_datablock(hp).size);
+                       Tai_datablock(hp).sym.setaddress(sec_none,Tai_datablock(hp).size,Tai_datablock(hp).size);
                        { force to be common/external, must be after setaddress as that would
                          set it to AS_GLOBAL }
-                       Tai_datablock(hp).sym^.bind:=AB_COMMON;
+                       Tai_datablock(hp).sym.bind:=AB_COMMON;
                      end
                     else
                      begin
@@ -499,7 +499,7 @@ implementation
                          objectalloc.sectionalign(4)
                        else if l>1 then
                          objectalloc.sectionalign(2);
-                       Tai_datablock(hp).sym^.setaddress(objectalloc.currsec,objectalloc.sectionsize,
+                       Tai_datablock(hp).sym.setaddress(objectalloc.currsec,objectalloc.sectionsize,
                          Tai_datablock(hp).size);
                        objectalloc.sectionalloc(Tai_datablock(hp).size);
                      end;
@@ -511,7 +511,7 @@ implementation
                        objectalloc.sectionalign(4)
                      else if l>1 then
                        objectalloc.sectionalign(2);
-                     Tai_datablock(hp).sym^.setaddress(objectalloc.currsec,objectalloc.sectionsize,Tai_datablock(hp).size);
+                     Tai_datablock(hp).sym.setaddress(objectalloc.currsec,objectalloc.sectionsize,Tai_datablock(hp).size);
                      objectalloc.sectionalloc(Tai_datablock(hp).size);
                    end;
                  UsedAsmSymbolListInsert(Tai_datablock(hp).sym);
@@ -570,20 +570,20 @@ implementation
 {$endif}
              ait_symbol :
                begin
-                 Tai_symbol(hp).sym^.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
+                 Tai_symbol(hp).sym.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
                  UsedAsmSymbolListInsert(Tai_symbol(hp).sym);
                end;
              ait_symbol_end :
                begin
                  if target_info.target=target_i386_linux then
                   begin
-                    Tai_symbol(hp).sym^.size:=objectalloc.sectionsize-Tai_symbol(hp).sym^.address;
+                    Tai_symbol(hp).sym.size:=objectalloc.sectionsize-Tai_symbol(hp).sym.address;
                     UsedAsmSymbolListInsert(Tai_symbol(hp).sym);
                   end;
                 end;
              ait_label :
                begin
-                 Tai_label(hp).l^.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
+                 Tai_label(hp).l.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
                  UsedAsmSymbolListInsert(Tai_label(hp).l);
                end;
              ait_string :
@@ -1026,14 +1026,19 @@ implementation
         objectoutput.free;
         objectalloc.free;
 {$ifdef MEMDEBUG}
-         d.done;
+         d.free;
 {$endif}
       end;
 
 end.
 {
   $Log$
-  Revision 1.6  2001-03-11 22:58:51  peter
+  Revision 1.7  2001-04-13 01:22:17  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.6  2001/03/11 22:58:51  peter
     * getsym redesign, removed the globals srsym,srsymtable
 
   Revision 1.5  2001/03/05 21:39:11  peter

compiler/i386/ag386int.pas

@@ -41,7 +41,7 @@ interface
 {$ifdef delphi}
       sysutils,
 {$endif}
-      cutils,globtype,globals,systems,cobjects,
+      cutils,globtype,globals,systems,cclasses,
       verbose,cpubase,cpuasm,finput,fmodule
       ;
 
@@ -137,7 +137,7 @@ interface
           begin
             if (aktoutputformat = as_i386_tasm) then
               s:=s+'dword ptr ';
-            s:=s+symbol^.name;
+            s:=s+symbol.name;
             first:=false;
           end;
          if (base<>R_NO) then
@@ -180,7 +180,7 @@ interface
         top_symbol :
           begin
             if assigned(o.sym) then
-              hs:='offset '+o.sym^.name
+              hs:='offset '+o.sym.name
             else
               hs:='offset ';
             if o.symofs>0 then
@@ -242,7 +242,7 @@ interface
           getopstr_jmp:=tostr(o.val);
         top_symbol :
           begin
-            hs:=o.sym^.name;
+            hs:=o.sym.name;
             if o.symofs>0 then
              hs:=hs+'+'+tostr(o.symofs)
             else
@@ -425,8 +425,8 @@ interface
                      end;
      ait_datablock : begin
                        if tai_datablock(hp).is_global then
-                         AsmWriteLn(#9'PUBLIC'#9+tai_datablock(hp).sym^.name);
-                       AsmWriteLn(PadTabs(tai_datablock(hp).sym^.name,#0)+'DB'#9+tostr(tai_datablock(hp).size)+' DUP(?)');
+                         AsmWriteLn(#9'PUBLIC'#9+tai_datablock(hp).sym.name);
+                       AsmWriteLn(PadTabs(tai_datablock(hp).sym.name,#0)+'DB'#9+tostr(tai_datablock(hp).size)+' DUP(?)');
                      end;
    ait_const_32bit,
     ait_const_8bit,
@@ -447,7 +447,7 @@ interface
                        AsmLn;
                      end;
   ait_const_symbol : begin
-                       AsmWriteLn(#9#9'DD'#9'offset '+tai_const_symbol(hp).sym^.name);
+                       AsmWriteLn(#9#9'DD'#9'offset '+tai_const_symbol(hp).sym.name);
                        if tai_const_symbol(hp).offset>0 then
                          AsmWrite('+'+tostr(tai_const_symbol(hp).offset))
                        else if tai_const_symbol(hp).offset<0 then
@@ -455,7 +455,7 @@ interface
                        AsmLn;
                      end;
      ait_const_rva : begin
-                       AsmWriteLn(#9#9'RVA'#9+tai_const_symbol(hp).sym^.name);
+                       AsmWriteLn(#9#9'RVA'#9+tai_const_symbol(hp).sym.name);
                      end;
         ait_real_32bit : AsmWriteLn(#9#9'DD'#9+single2str(tai_real_32bit(hp).value));
         ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(tai_real_64bit(hp).value));
@@ -536,9 +536,9 @@ interface
                        AsmLn;
                      end;
          ait_label : begin
-                       if tai_label(hp).l^.is_used then
+                       if tai_label(hp).l.is_used then
                         begin
-                          AsmWrite(tai_label(hp).l^.name);
+                          AsmWrite(tai_label(hp).l.name);
                           if assigned(hp.next) and not(tai(hp.next).typ in
                              [ait_const_32bit,ait_const_16bit,ait_const_8bit,
                               ait_const_symbol,ait_const_rva,
@@ -552,8 +552,8 @@ interface
                      end;
         ait_symbol : begin
                        if tai_symbol(hp).is_global then
-                         AsmWriteLn(#9'PUBLIC'#9+tai_symbol(hp).sym^.name);
-                       AsmWrite(tai_symbol(hp).sym^.name);
+                         AsmWriteLn(#9'PUBLIC'#9+tai_symbol(hp).sym.name);
+                       AsmWrite(tai_symbol(hp).sym.name);
                        if assigned(hp.next) and not(tai(hp.next).typ in
                           [ait_const_32bit,ait_const_16bit,ait_const_8bit,
                            ait_const_symbol,ait_const_rva,
@@ -685,22 +685,22 @@ ait_stab_function_name : ;
     var
       currentasmlist : TExternalAssembler;
 
-    procedure writeexternal(p:pnamedindexobject);
+    procedure writeexternal(p:tnamedindexitem);
       begin
-        if pasmsymbol(p)^.defbind=AB_EXTERNAL then
+        if tasmsymbol(p).defbind=AB_EXTERNAL then
           begin
             if (aktoutputformat = as_i386_masm) then
-              currentasmlist.AsmWriteln(#9'EXTRN'#9+p^.name
+              currentasmlist.AsmWriteln(#9'EXTRN'#9+p.name
                 +': NEAR')
             else
-              currentasmlist.AsmWriteln(#9'EXTRN'#9+p^.name);
+              currentasmlist.AsmWriteln(#9'EXTRN'#9+p.name);
           end;
       end;
 
     procedure T386IntelAssembler.WriteExternals;
       begin
         currentasmlist:=self;
-        AsmSymbolList^.foreach({$ifdef fpcprocvar}@{$endif}writeexternal);
+        AsmSymbolList.foreach_static({$ifdef fpcprocvar}@{$endif}writeexternal);
       end;
 
 
@@ -748,7 +748,12 @@ ait_stab_function_name : ;
 end.
 {
   $Log$
-  Revision 1.8  2001-03-25 12:30:17  peter
+  Revision 1.9  2001-04-13 01:22:17  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.8  2001/03/25 12:30:17  peter
     * masm -al fix (merged)
 
   Revision 1.7  2001/03/05 21:39:11  peter

compiler/i386/ag386nsm.pas

@@ -42,7 +42,7 @@ interface
 {$ifdef delphi}
       sysutils,
 {$endif}
-      cutils,globtype,globals,systems,cobjects,
+      cutils,globtype,globals,systems,cclasses,
       fmodule,finput,verbose,cpubase,cpuasm
       ;
 
@@ -161,7 +161,7 @@ interface
            s:='[';
          if assigned(symbol) then
           begin
-            s:=s+symbol^.name;
+            s:=s+symbol.name;
             first:=false;
           end;
          if (base<>R_NO) then
@@ -238,7 +238,7 @@ interface
           top_symbol :
             begin
               if assigned(o.sym) then
-               hs:='dword '+o.sym^.name
+               hs:='dword '+o.sym.name
               else
                hs:='dword ';
               if o.symofs>0 then
@@ -283,7 +283,7 @@ interface
             getopstr_jmp:=tostr(o.val);
           top_symbol :
             begin
-              hs:=o.sym^.name;
+              hs:=o.sym.name;
               if o.symofs>0 then
                hs:=hs+'+'+tostr(o.symofs)
               else
@@ -454,9 +454,9 @@ interface
                if tai_datablock(hp).is_global then
                 begin
                   AsmWrite(#9'GLOBAL ');
-                  AsmWriteLn(tai_datablock(hp).sym^.name);
+                  AsmWriteLn(tai_datablock(hp).sym.name);
                 end;
-               AsmWrite(PadTabs(tai_datablock(hp).sym^.name,':'));
+               AsmWrite(PadTabs(tai_datablock(hp).sym.name,':'));
                AsmWriteLn('RESB'#9+tostr(tai_datablock(hp).size));
              end;
 
@@ -483,7 +483,7 @@ interface
            ait_const_symbol :
              begin
                AsmWrite(#9#9'DD'#9);
-               AsmWrite(tai_const_symbol(hp).sym^.name);
+               AsmWrite(tai_const_symbol(hp).sym.name);
                if tai_const_symbol(hp).offset>0 then
                  AsmWrite('+'+tostr(tai_const_symbol(hp).offset))
                else if tai_const_symbol(hp).offset<0 then
@@ -494,7 +494,7 @@ interface
            ait_const_rva :
              begin
                AsmWrite(#9#9'RVA'#9);
-               AsmWriteLn(tai_const_symbol(hp).sym^.name);
+               AsmWriteLn(tai_const_symbol(hp).sym.name);
              end;
 
            ait_real_32bit :
@@ -588,8 +588,8 @@ interface
 
            ait_label :
              begin
-               if tai_label(hp).l^.is_used then
-                AsmWriteLn(tai_label(hp).l^.name+':');
+               if tai_label(hp).l.is_used then
+                AsmWriteLn(tai_label(hp).l.name+':');
              end;
 
            ait_direct :
@@ -603,9 +603,9 @@ interface
                if tai_symbol(hp).is_global then
                 begin
                   AsmWrite(#9'GLOBAL ');
-                  AsmWriteLn(tai_symbol(hp).sym^.name);
+                  AsmWriteLn(tai_symbol(hp).sym.name);
                 end;
-               AsmWrite(tai_symbol(hp).sym^.name);
+               AsmWrite(tai_symbol(hp).sym.name);
                if assigned(hp.next) and not(tai(hp.next).typ in
                   [ait_const_32bit,ait_const_16bit,ait_const_8bit,
                    ait_const_symbol,ait_const_rva,
@@ -716,16 +716,16 @@ interface
     var
       currentasmlist : TExternalAssembler;
 
-    procedure writeexternal(p:pnamedindexobject);
+    procedure writeexternal(p:tnamedindexitem);
       begin
-        if pasmsymbol(p)^.defbind=AB_EXTERNAL then
-         currentasmlist.AsmWriteln('EXTERN'#9+p^.name);
+        if tasmsymbol(p).defbind=AB_EXTERNAL then
+         currentasmlist.AsmWriteln('EXTERN'#9+p.name);
       end;
 
     procedure T386NasmAssembler.WriteExternals;
       begin
         currentasmlist:=self;
-        AsmSymbolList^.foreach({$ifdef fpcprocvar}@{$endif}writeexternal);
+        AsmSymbolList.foreach_static({$ifdef fpcprocvar}@{$endif}writeexternal);
       end;
 
 
@@ -773,7 +773,12 @@ interface
 end.
 {
   $Log$
-  Revision 1.6  2001-03-05 21:39:11  peter
+  Revision 1.7  2001-04-13 01:22:17  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.6  2001/03/05 21:39:11  peter
     * changed to class with common TAssembler also for internal assembler
 
   Revision 1.5  2001/02/20 21:36:39  peter

compiler/i386/cpuasm.pas

@@ -40,7 +40,7 @@ unit cpuasm;
 interface
 
 uses
-  cobjects,cclasses,
+  cclasses,
   aasm,globals,verbose,
   cpubase;
 
@@ -97,15 +97,15 @@ type
      constructor op_const_reg_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : preference);
 
      { this is for Jmp instructions }
-     constructor op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : pasmsymbol);
+     constructor op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol);
 
-     constructor op_sym(op : tasmop;_size : topsize;_op1 : pasmsymbol);
-     constructor op_sym_ofs(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint);
-     constructor op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint;_op2 : tregister);
-     constructor op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint;_op2 : preference);
+     constructor op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol);
+     constructor op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint);
+     constructor op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
+     constructor op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
 
      procedure loadconst(opidx:longint;l:longint);
-     procedure loadsymbol(opidx:longint;s:pasmsymbol;sofs:longint);
+     procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
      procedure loadref(opidx:longint;p:preference);
      procedure loadreg(opidx:longint;r:tregister);
      procedure loadoper(opidx:longint;o:toper);
@@ -140,7 +140,7 @@ type
      function  calcsize(p:PInsEntry):longint;
      procedure gencode;
      function  NeedAddrPrefix(opidx:byte):boolean;
-     procedure SwapOperands;
+     procedure Swatoperands;
 {$endif NOAG386BIN}
   end;
 
@@ -240,7 +240,7 @@ uses
       end;
 
 
-    procedure taicpu.loadsymbol(opidx:longint;s:pasmsymbol;sofs:longint);
+    procedure taicpu.loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
       begin
         if opidx>=ops then
          ops:=opidx+1;
@@ -254,7 +254,7 @@ uses
          end;
         { Mark the symbol as used }
         if assigned(s) then
-         inc(s^.refs);
+         inc(s.refs);
       end;
 
 
@@ -283,7 +283,7 @@ uses
                typ:=top_ref;
                { mark symbol as used }
                if assigned(ref^.symbol) then
-                 inc(ref^.symbol^.refs);
+                 inc(ref^.symbol.refs);
              end;
          end;
       end;
@@ -509,7 +509,7 @@ uses
       end;
 
 
-    constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : pasmsymbol);
+    constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol);
       begin
          inherited create;
          init(op,_size);
@@ -519,7 +519,7 @@ uses
       end;
 
 
-    constructor taicpu.op_sym(op : tasmop;_size : topsize;_op1 : pasmsymbol);
+    constructor taicpu.op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol);
       begin
          inherited create;
          init(op,_size);
@@ -528,7 +528,7 @@ uses
       end;
 
 
-    constructor taicpu.op_sym_ofs(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint);
+    constructor taicpu.op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint);
       begin
          inherited create;
          init(op,_size);
@@ -537,7 +537,7 @@ uses
       end;
 
 
-    constructor taicpu.op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint;_op2 : tregister);
+    constructor taicpu.op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
       begin
          inherited create;
          init(op,_size);
@@ -547,7 +547,7 @@ uses
       end;
 
 
-    constructor taicpu.op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint;_op2 : preference);
+    constructor taicpu.op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
       begin
          inherited create;
          init(op,_size);
@@ -566,7 +566,7 @@ uses
              top_ref:
                dispose(oper[0].ref);
              top_symbol:
-               dec(Pasmsymbol(oper[0].sym)^.refs);
+               dec(tasmsymbol(oper[0].sym).refs);
            end;
            if (ops>1) then
             begin
@@ -682,7 +682,7 @@ uses
       end;
 
 
-    procedure taicpu.SwapOperands;
+    procedure taicpu.Swatoperands;
       var
         p : TOper;
       begin
@@ -708,7 +708,7 @@ uses
       begin
         if FOperandOrder<>order then
          begin
-           SwapOperands;
+           Swatoperands;
            FOperandOrder:=order;
          end;
       end;
@@ -821,11 +821,11 @@ begin
              l:=InsOffset-LastInsOffset;
             inc(l,symofs);
             if assigned(sym) then
-             inc(l,sym^.address);
+             inc(l,sym.address);
             { instruction size will then always become 2 (PFV) }
             relsize:=(InsOffset+2)-l;
             if (not assigned(sym) or
-                ((sym^.bind<>AB_EXTERNAL) and (sym^.address<>0))) and
+                ((sym.bind<>AB_EXTERNAL) and (sym.address<>0))) and
                (relsize>=-128) and (relsize<=127) then
              ot:=OT_IMM32 or OT_SHORT
             else
@@ -930,7 +930,7 @@ begin
    { we can leave because the size for all operands is forced to be
      the same
      but not if IF_SB IF_SW or IF_SD is set PM }
-     if asize= $ffffffff then
+     if asize=-1 then
        exit;
      siz[0]:=asize;
      siz[1]:=asize;
@@ -1189,7 +1189,7 @@ const
 var
   j     : longint;
   i,b   : tregister;
-  sym   : pasmsymbol;
+  sym   : tasmsymbol;
   md,s  : byte;
   base,index,scalefactor,
   o     : longint;
@@ -1463,7 +1463,7 @@ procedure taicpu.GenCode;
 
 var
   currval : longint;
-  currsym : pasmsymbol;
+  currsym : tasmsymbol;
 
   procedure getvalsym(opidx:longint);
   begin
@@ -1652,7 +1652,7 @@ begin
           getvalsym(c-40);
           data:=currval-insend;
           if assigned(currsym) then
-           inc(data,currsym^.address);
+           inc(data,currsym.address);
           if (data>127) or (data<-128) then
            Message1(asmw_e_short_jmp_out_of_range,tostr(data));
           objectdata.writebytes(data,1);
@@ -1773,7 +1773,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.13  2001-04-05 21:33:45  peter
+  Revision 1.14  2001-04-13 01:22:18  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.13  2001/04/05 21:33:45  peter
     * movd and opsize fix merged
 
   Revision 1.12  2001/03/25 12:29:45  peter

compiler/i386/cpubase.pas

@@ -31,7 +31,7 @@ unit cpubase;
 interface
 
 uses
-  globals,cutils,cobjects,aasm;
+  globals,cutils,cclasses,aasm;
 
 const
 { Size of the instruction table converted by nasmconv.pas }
@@ -194,8 +194,7 @@ type
 
   op2strtable=array[tasmop] of string[11];
 
-  pstr2opentry = ^tstr2opentry;
-  tstr2opentry = object(Tnamedindexobject)
+  tstr2opentry = class(Tnamedindexitem)
     op: TAsmOp;
   end;
 
@@ -444,7 +443,7 @@ type
      index       : tregister;
      scalefactor : byte;
      offset      : longint;
-     symbol      : pasmsymbol;
+     symbol      : tasmsymbol;
      offsetfixup : longint;
      options     : trefoptions;
 {$ifdef newcg}
@@ -466,7 +465,7 @@ type
            top_reg    : (reg:tregister);
            top_ref    : (ref:preference);
            top_const  : (val:longint);
-           top_symbol : (sym:pasmsymbol;symofs:longint);
+           top_symbol : (sym:tasmsymbol;symofs:longint);
         end;
 
 {*****************************************************************************
@@ -924,7 +923,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2001-02-20 21:34:04  peter
+  Revision 1.4  2001-04-13 01:22:18  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.3  2001/02/20 21:34:04  peter
     * iret, lret fixes
 
   Revision 1.2  2000/12/07 17:19:45  jonas
@@ -962,4 +966,4 @@ end.
   Revision 1.2  2000/07/13 11:32:39  michael
   + removed logs
 
-}
+}

compiler/i386/daopt386.pas

@@ -197,7 +197,7 @@ Function DFAPass2(
                                       BlockStart, BlockEnd: Tai): Boolean;
 Procedure ShutDownDFA;
 
-Function FindLabel(L: PasmLabel; Var hp: Tai): Boolean;
+Function FindLabel(L: tasmlabel; Var hp: Tai): Boolean;
 
 Procedure IncState(Var S: Byte; amount: longint);
 
@@ -256,19 +256,19 @@ Var
   var temp: PSearchLinkedListItem;
   begin
     temp := first;
-    while (temp <> last^.next) and
+    while (temp <> last.next) and
           not(temp.equals(p)) do
       temp := temp.next;
-    searchByValue := temp <> last^.next;
+    searchByValue := temp <> last.next;
   end;
 
   procedure TSearchLinkedList.removeByValue(p: PSearchLinkedListItem);
   begin
     temp := first;
-    while (temp <> last^.next) and
+    while (temp <> last.next) and
           not(temp.equals(p)) do
       temp := temp.next;
-    if temp <> last^.next then
+    if temp <> last.next then
       begin
         remove(temp);
         dispose(temp,done);
@@ -320,10 +320,10 @@ Begin
           Then
             Begin
               LabelFound := True;
-              If (Tai_Label(p).l^.labelnr < LowLabel) Then
-                LowLabel := Tai_Label(p).l^.labelnr;
-              If (Tai_Label(p).l^.labelnr > HighLabel) Then
-                HighLabel := Tai_Label(p).l^.labelnr;
+              If (Tai_Label(p).l.labelnr < LowLabel) Then
+                LowLabel := Tai_Label(p).l.labelnr;
+              If (Tai_Label(p).l.labelnr > HighLabel) Then
+                HighLabel := Tai_Label(p).l.labelnr;
             End;
       lastP := p;
       GetNextInstruction(p, p);
@@ -388,18 +388,18 @@ Procedure RemoveLastDeallocForFuncRes(asmL: TAAsmOutput; p: Tai);
 
 begin
   if assigned(procinfo^.returntype.def) then
-    case procinfo^.returntype.def^.deftype of
+    case procinfo^.returntype.def.deftype of
       arraydef,recorddef,pointerdef,
          stringdef,enumdef,procdef,objectdef,errordef,
          filedef,setdef,procvardef,
          classrefdef,forwarddef:
         DoRemoveLastDeallocForFuncRes(asmL,R_EAX);
       orddef:
-        if procinfo^.returntype.def^.size <> 0 then
+        if procinfo^.returntype.def.size <> 0 then
           begin
             DoRemoveLastDeallocForFuncRes(asmL,R_EAX);
             { for int64/qword }
-            if procinfo^.returntype.def^.size = 8 then
+            if procinfo^.returntype.def.size = 8 then
               DoRemoveLastDeallocForFuncRes(asmL,R_EDX);
           end;
     end;
@@ -410,18 +410,18 @@ var regCounter: TRegister;
 begin
   regs := [];
   if assigned(procinfo^.returntype.def) then
-    case procinfo^.returntype.def^.deftype of
+    case procinfo^.returntype.def.deftype of
       arraydef,recorddef,pointerdef,
          stringdef,enumdef,procdef,objectdef,errordef,
          filedef,setdef,procvardef,
          classrefdef,forwarddef:
        regs := [R_EAX];
       orddef:
-        if procinfo^.returntype.def^.size <> 0 then
+        if procinfo^.returntype.def.size <> 0 then
           begin
             regs := [R_EAX];
             { for int64/qword }
-            if procinfo^.returntype.def^.size = 8 then
+            if procinfo^.returntype.def.size = 8 then
               regs := regs + [R_EDX];
           end;
     end;
@@ -444,7 +444,7 @@ begin
   while not(funcResReg and
             (p.typ = ait_instruction) and
             (Taicpu(p).opcode = A_JMP) and
-            (pasmlabel(Taicpu(p).oper[0].sym) = aktexit2label)) and
+            (tasmlabel(Taicpu(p).oper[0].sym) = aktexit2label)) and
         getLastInstruction(p, p) And
         not(regInInstruction(reg, p)) Do
     hp1 := p;
@@ -453,7 +453,7 @@ begin
   if not(funcResReg) or
      not((hp1.typ = ait_instruction) and
          (Taicpu(hp1).opcode = A_JMP) and
-         (pasmlabel(Taicpu(hp1).oper[0].sym) = aktexit2label)) then
+         (tasmlabel(Taicpu(hp1).oper[0].sym) = aktexit2label)) then
     begin
       p := TaiRegAlloc.deAlloc(reg);
       insertLLItem(AsmL, hp1.previous, hp1, p);
@@ -481,7 +481,7 @@ Begin
       Case p.typ Of
         ait_Label:
           If not labelCanBeSkipped(Tai_label(p)) Then
-            LabelTable^[Tai_Label(p).l^.labelnr-LowLabel].TaiObj := p;
+            LabelTable^[Tai_Label(p).l.labelnr-LowLabel].TaiObj := p;
         ait_regAlloc:
           { ESI and EDI are (de)allocated manually, don't mess with them }
           if not(TaiRegAlloc(p).Reg in [R_EDI,R_ESI]) then
@@ -528,7 +528,7 @@ End;
 
 {************************ Search the Label table ************************}
 
-Function FindLabel(L: PasmLabel; Var hp: Tai): Boolean;
+Function FindLabel(L: tasmlabel; Var hp: Tai): Boolean;
 
 {searches for the specified label starting from hp as long as the
  encountered instructions are labels, to be able to optimize constructs like
@@ -1063,7 +1063,7 @@ End;
 
 function labelCanBeSkipped(p: Tai_label): boolean;
 begin
-  labelCanBeSkipped := not(p.l^.is_used) or p.l^.is_addr;
+  labelCanBeSkipped := not(p.l.is_used) or p.l.is_addr;
 end;
 
 {******************* The Data Flow Analyzer functions ********************}
@@ -1989,7 +1989,7 @@ Begin
                             While GetNextInstruction(hp, hp) And
                                   Not((hp.typ = ait_instruction) And
                                       (Taicpu(hp).is_jmp) and
-                                      (pasmlabel(Taicpu(hp).oper[0].sym)^.labelnr = Tai_Label(p).l^.labelnr)) And
+                                      (tasmlabel(Taicpu(hp).oper[0].sym).labelnr = Tai_Label(p).l^.labelnr)) And
                                   Not((hp.typ = ait_label) And
                                       (LTable^[Tai_Label(hp).l^.labelnr-LoLab].RefsFound
                                        = Tai_Label(hp).l^.RefCount) And
@@ -2041,8 +2041,8 @@ Begin
                       con_invalid: typ := con_unknown;
                     end;
 {$Else JumpAnal}
-          With LTable^[pasmlabel(Taicpu(p).oper[0].sym)^.labelnr-LoLab] Do
-            If (RefsFound = pasmlabel(Taicpu(p).oper[0].sym)^.RefCount) Then
+          With LTable^[tasmlabel(Taicpu(p).oper[0].sym).labelnr-LoLab] Do
+            If (RefsFound = tasmlabel(Taicpu(p).oper[0].sym).RefCount) Then
               Begin
                 If (InstrCnt < InstrNr)
                   Then
@@ -2390,9 +2390,9 @@ Begin
           begin
             if Taicpu(p).is_jmp then
              begin
-               If (pasmlabel(Taicpu(p).oper[0].sym)^.labelnr >= LoLab) And
-                  (pasmlabel(Taicpu(p).oper[0].sym)^.labelnr <= HiLab) Then
-                 Inc(LTable^[pasmlabel(Taicpu(p).oper[0].sym)^.labelnr-LoLab].RefsFound);
+               If (tasmlabel(Taicpu(p).oper[0].sym).labelnr >= LoLab) And
+                  (tasmlabel(Taicpu(p).oper[0].sym).labelnr <= HiLab) Then
+                 Inc(LTable^[tasmlabel(Taicpu(p).oper[0].sym).labelnr-LoLab].RefsFound);
              end;
           end;
 {        ait_instruction:
@@ -2454,7 +2454,12 @@ End.
 
 {
   $Log$
-  Revision 1.16  2001-04-02 21:20:36  peter
+  Revision 1.17  2001-04-13 01:22:18  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.16  2001/04/02 21:20:36  peter
     * resulttype rewrite
 
   Revision 1.15  2000/12/31 11:00:31  jonas

compiler/i386/n386add.pas

@@ -42,7 +42,7 @@ interface
 
     uses
       globtype,systems,
-      cutils,cobjects,verbose,globals,
+      cutils,verbose,globals,
       symconst,symdef,aasm,types,
       hcodegen,temp_gen,pass_2,
       cpuasm,
@@ -102,12 +102,12 @@ interface
       begin
          { remove temporary location if not a set or string }
          { that's a bad hack (FK) who did this ?            }
-         if (left.resulttype.def^.deftype<>stringdef) and
-            ((left.resulttype.def^.deftype<>setdef) or (psetdef(left.resulttype.def)^.settype=smallset)) and
+         if (left.resulttype.def.deftype<>stringdef) and
+            ((left.resulttype.def.deftype<>setdef) or (tsetdef(left.resulttype.def).settype=smallset)) and
             (left.location.loc in [LOC_MEM,LOC_REFERENCE]) then
            ungetiftemp(left.location.reference);
-         if (right.resulttype.def^.deftype<>stringdef) and
-            ((right.resulttype.def^.deftype<>setdef) or (psetdef(right.resulttype.def)^.settype=smallset)) and
+         if (right.resulttype.def.deftype<>stringdef) and
+            ((right.resulttype.def.deftype<>setdef) or (tsetdef(right.resulttype.def).settype=smallset)) and
             (right.location.loc in [LOC_MEM,LOC_REFERENCE]) then
            ungetiftemp(right.location.reference);
          { in case of comparison operation the put result in the flags }
@@ -128,7 +128,7 @@ interface
 
       var
 {$ifdef newoptimizations2}
-        l: pasmlabel;
+        l: tasmlabel;
         hreg: tregister;
         href2: preference;
         oldregisterdef: boolean;
@@ -142,7 +142,7 @@ interface
         { string operations are not commutative }
         if nf_swaped in flags then
           swapleftright;
-        case pstringdef(left.resulttype.def)^.string_typ of
+        case tstringdef(left.resulttype.def).string_typ of
            st_ansistring:
              begin
                 case nodetype of
@@ -296,7 +296,7 @@ interface
                              { length of temp string = 255 (JM) }
                              { *** redefining a type is not allowed!! (thanks, Pierre) }
                              { also problem with constant string!                      }
-                             pstringdef(left.resulttype.def)^.len := 255;
+                             tstringdef(left.resulttype.def).len := 255;
 
 {$endif newoptimizations2}
                           end;
@@ -317,7 +317,7 @@ interface
                               newreference(left.location.reference),R_EDI);
                             { is it already maximal? }
                             emit_const_reg(A_CMP,S_L,
-                              pstringdef(left.resulttype.def)^.len,R_EDI);
+                              tstringdef(left.resulttype.def).len,R_EDI);
                             emitjmp(C_E,l);
                             { no, so add the new character }
                             { is it a constant char? }
@@ -392,7 +392,7 @@ interface
 {$ifdef newoptimizations2}
                            { string (could be < 255 chars now) (JM)         }
                             emit_const(A_PUSH,S_L,
-                              pstringdef(left.resulttype.def)^.len);
+                              tstringdef(left.resulttype.def).len);
 {$endif newoptimizations2}
                             emitpushreferenceaddr(left.location.reference);
                            { the optimizer can more easily put the          }
@@ -673,10 +673,10 @@ interface
          pushed,mboverflow,cmpop : boolean;
          op,op2 : tasmop;
          resflags : tresflags;
-         otl,ofl : pasmlabel;
+         otl,ofl : tasmlabel;
          power : longint;
          opsize : topsize;
-         hl4: pasmlabel;
+         hl4: tasmlabel;
          hr : preference;
 
          { true, if unsigned types are compared }
@@ -763,14 +763,14 @@ interface
       begin
       { to make it more readable, string and set (not smallset!) have their
         own procedures }
-         case left.resulttype.def^.deftype of
+         case left.resulttype.def.deftype of
          stringdef : begin
                        addstring;
                        exit;
                      end;
             setdef : begin
                      { normalsets are handled separate }
-                       if not(psetdef(left.resulttype.def)^.settype=smallset) then
+                       if not(tsetdef(left.resulttype.def).settype=smallset) then
                         begin
                           addset;
                           exit;
@@ -787,7 +787,7 @@ interface
 
          { are we a (small)set, must be set here because the side can be
            swapped ! (PFV) }
-         is_set:=(left.resulttype.def^.deftype=setdef);
+         is_set:=(left.resulttype.def.deftype=setdef);
 
          { calculate the operator which is more difficult }
          firstcomplex(self);
@@ -796,12 +796,12 @@ interface
          if is_boolean(left.resulttype.def) and
             is_boolean(right.resulttype.def) then
            begin
-             if (porddef(left.resulttype.def)^.typ=bool8bit) or
-                (porddef(right.resulttype.def)^.typ=bool8bit) then
+             if (torddef(left.resulttype.def).typ=bool8bit) or
+                (torddef(right.resulttype.def).typ=bool8bit) then
                opsize:=S_B
              else
-               if (porddef(left.resulttype.def)^.typ=bool16bit) or
-                  (porddef(right.resulttype.def)^.typ=bool16bit) then
+               if (torddef(left.resulttype.def).typ=bool16bit) or
+                  (torddef(right.resulttype.def).typ=bool16bit) then
                  opsize:=S_W
              else
                opsize:=S_L;
@@ -916,28 +916,28 @@ interface
                   set_location(left.location,location);
                 end;
 
-              if (left.resulttype.def^.deftype=pointerdef) or
+              if (left.resulttype.def.deftype=pointerdef) or
 
-                 (right.resulttype.def^.deftype=pointerdef) or
+                 (right.resulttype.def.deftype=pointerdef) or
 
                  (is_class_or_interface(right.resulttype.def) and is_class_or_interface(left.resulttype.def)) or
 
-                 (left.resulttype.def^.deftype=classrefdef) or
+                 (left.resulttype.def.deftype=classrefdef) or
 
-                 (left.resulttype.def^.deftype=procvardef) or
+                 (left.resulttype.def.deftype=procvardef) or
 
-                 ((left.resulttype.def^.deftype=enumdef) and
-                  (left.resulttype.def^.size=4)) or
+                 ((left.resulttype.def.deftype=enumdef) and
+                  (left.resulttype.def.size=4)) or
 
-                 ((left.resulttype.def^.deftype=orddef) and
-                 (porddef(left.resulttype.def)^.typ=s32bit)) or
-                 ((right.resulttype.def^.deftype=orddef) and
-                 (porddef(right.resulttype.def)^.typ=s32bit)) or
+                 ((left.resulttype.def.deftype=orddef) and
+                 (torddef(left.resulttype.def).typ=s32bit)) or
+                 ((right.resulttype.def.deftype=orddef) and
+                 (torddef(right.resulttype.def).typ=s32bit)) or
 
-                ((left.resulttype.def^.deftype=orddef) and
-                 (porddef(left.resulttype.def)^.typ=u32bit)) or
-                 ((right.resulttype.def^.deftype=orddef) and
-                 (porddef(right.resulttype.def)^.typ=u32bit)) or
+                ((left.resulttype.def.deftype=orddef) and
+                 (torddef(left.resulttype.def).typ=u32bit)) or
+                 ((right.resulttype.def.deftype=orddef) and
+                 (torddef(right.resulttype.def).typ=u32bit)) or
 
                 { as well as small sets }
                  is_set then
@@ -1134,7 +1134,7 @@ interface
                            { constant (JM)                             }
                            release_loc(right.location);
                            location.register := getregister32;
-                           emitloadord2reg(right.location,porddef(u32bittype.def),location.register,false);
+                           emitloadord2reg(right.location,torddef(u32bittype.def),location.register,false);
                            emit_const_reg(A_SHL,S_L,power,location.register)
                          End
                        Else
@@ -1160,13 +1160,13 @@ interface
                          { left.location can be R_EAX !!! }
                          getexplicitregister32(R_EDI);
                          { load the left value }
-                         emitloadord2reg(left.location,porddef(u32bittype.def),R_EDI,true);
+                         emitloadord2reg(left.location,torddef(u32bittype.def),R_EDI,true);
                          release_loc(left.location);
                          { allocate EAX }
                          if R_EAX in unused then
                            exprasmList.concat(Tairegalloc.Alloc(R_EAX));
                          { load he right value }
-                         emitloadord2reg(right.location,porddef(u32bittype.def),R_EAX,true);
+                         emitloadord2reg(right.location,torddef(u32bittype.def),R_EAX,true);
                          release_loc(right.location);
                          { allocate EAX if it isn't yet allocated (JM) }
                          if (R_EAX in unused) then
@@ -1429,11 +1429,11 @@ interface
               else
 
               { Char type }
-                if ((left.resulttype.def^.deftype=orddef) and
-                    (porddef(left.resulttype.def)^.typ=uchar)) or
+                if ((left.resulttype.def.deftype=orddef) and
+                    (torddef(left.resulttype.def).typ=uchar)) or
               { enumeration type 16 bit }
-                   ((left.resulttype.def^.deftype=enumdef) and
-                    (left.resulttype.def^.size=1)) then
+                   ((left.resulttype.def.deftype=enumdef) and
+                    (left.resulttype.def.size=1)) then
                  begin
                    case nodetype of
                       ltn,lten,gtn,gten,
@@ -1507,8 +1507,8 @@ interface
                 end
               else
               { 16 bit enumeration type }
-                if ((left.resulttype.def^.deftype=enumdef) and
-                    (left.resulttype.def^.size=2)) then
+                if ((left.resulttype.def.deftype=enumdef) and
+                    (left.resulttype.def.size=2)) then
                  begin
                    case nodetype of
                       ltn,lten,gtn,gten,
@@ -1586,10 +1586,10 @@ interface
                 begin
                    mboverflow:=false;
                    cmpop:=false;
-                   unsigned:=((left.resulttype.def^.deftype=orddef) and
-                       (porddef(left.resulttype.def)^.typ=u64bit)) or
-                      ((right.resulttype.def^.deftype=orddef) and
-                       (porddef(right.resulttype.def)^.typ=u64bit));
+                   unsigned:=((left.resulttype.def.deftype=orddef) and
+                       (torddef(left.resulttype.def).typ=u64bit)) or
+                      ((right.resulttype.def.deftype=orddef) and
+                       (torddef(right.resulttype.def).typ=u64bit));
                    case nodetype of
                       addn : begin
                                 begin
@@ -1658,7 +1658,7 @@ interface
                         clear_location(hloc);
                         emit_pushq_loc(right.location);
                         saveregvars($ff);
-                        if porddef(resulttype.def)^.typ=u64bit then
+                        if torddef(resulttype.def).typ=u64bit then
                           emitcall('FPC_MUL_QWORD')
                         else
                           emitcall('FPC_MUL_INT64');
@@ -1924,7 +1924,7 @@ interface
                 end
               else
               { Floating point }
-               if (left.resulttype.def^.deftype=floatdef) then
+               if (left.resulttype.def.deftype=floatdef) then
                  begin
                     { real constants to the right, but only if it
                       isn't on the FPU stack, i.e. 1.0 or 0.0! }
@@ -1954,7 +1954,7 @@ interface
                               inc(fpuvaroffset);
                             end
                          else
-                           floatload(pfloatdef(right.resulttype.def)^.typ,right.location.reference);
+                           floatload(tfloatdef(right.resulttype.def).typ,right.location.reference);
                          if (left.location.loc<>LOC_FPU) then
                            begin
                               if left.location.loc=LOC_CFPUREGISTER then
@@ -1964,7 +1964,7 @@ interface
                                    inc(fpuvaroffset);
                                 end
                               else
-                                floatload(pfloatdef(left.resulttype.def)^.typ,left.location.reference)
+                                floatload(tfloatdef(left.resulttype.def).typ,left.location.reference)
                            end
                          { left was on the stack => swap }
                          else
@@ -1983,7 +1983,7 @@ interface
                               inc(fpuvaroffset);
                            end
                          else
-                           floatload(pfloatdef(left.resulttype.def)^.typ,left.location.reference)
+                           floatload(tfloatdef(left.resulttype.def).typ,left.location.reference)
                       end
                     { fpu operands are always in the wrong order on the stack }
                     else
@@ -2273,7 +2273,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  2001-04-02 21:20:36  peter
+  Revision 1.11  2001-04-13 01:22:18  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.10  2001/04/02 21:20:36  peter
     * resulttype rewrite
 
   Revision 1.9  2000/12/31 11:14:11  jonas

compiler/i386/n386bas.pas

@@ -53,16 +53,16 @@ unit n386bas;
 
     procedure ti386asmnode.pass_2;
 
-      procedure ReLabel(var p:pasmsymbol);
+      procedure ReLabel(var p:tasmsymbol);
         begin
-          if p^.proclocal then
+          if p.proclocal then
            begin
-             if not assigned(p^.altsymbol) then
+             if not assigned(p.altsymbol) then
               begin
-                p^.GenerateAltSymbol;
+                p.GenerateAltSymbol;
                 UsedAsmSymbolListInsert(p);
               end;
-             p:=p^.altsymbol;
+             p:=p.altsymbol;
            end;
         end;
 
@@ -75,8 +75,8 @@ unit n386bas;
          if inlining_procedure then
            begin
              CreateUsedAsmSymbolList;
-             localfixup:=aktprocsym^.definition^.localst^.address_fixup;
-             parafixup:=aktprocsym^.definition^.parast^.address_fixup;
+             localfixup:=aktprocsym.definition.localst.address_fixup;
+             parafixup:=aktprocsym.definition.parast.address_fixup;
              hp:=tai(p_asm.first);
              while assigned(hp) do
               begin
@@ -86,7 +86,7 @@ unit n386bas;
                   ait_label :
                      begin
                        { regenerate the labels by setting altsymbol }
-                       ReLabel(pasmsymbol(tai_label(hp2).l));
+                       ReLabel(tasmsymbol(tai_label(hp2).l));
                      end;
                   ait_const_rva,
                   ait_const_symbol :
@@ -144,7 +144,7 @@ unit n386bas;
            begin
              { if the routine is an inline routine, then we must hold a copy
                because it can be necessary for inlining later }
-             if (pocall_inline in aktprocsym^.definition^.proccalloptions) then
+             if (pocall_inline in aktprocsym.definition.proccalloptions) then
                exprasmList.concatlistcopy(p_asm)
              else
                exprasmList.concatlist(p_asm);
@@ -204,7 +204,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.6  2001-04-02 21:20:36  peter
+  Revision 1.7  2001-04-13 01:22:18  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.6  2001/04/02 21:20:36  peter
     * resulttype rewrite
 
   Revision 1.5  2000/12/25 00:07:32  peter

compiler/i386/n386cal.pas

@@ -55,8 +55,8 @@ implementation
       strings,
 {$endif}
       globtype,systems,
-      cutils,cobjects,verbose,globals,
-      symconst,symbase,symtype,symsym,symtable,aasm,types,
+      cutils,verbose,globals,
+      symconst,symbase,symsym,symtable,aasm,types,
 {$ifdef GDB}
       gdb,
 {$endif GDB}
@@ -86,7 +86,7 @@ implementation
         end;
 
       var
-         otlabel,oflabel : pasmlabel;
+         otlabel,oflabel : tasmlabel;
          { temporary variables: }
          tempdeftype : tdeftype;
          r : preference;
@@ -112,7 +112,7 @@ implementation
            end
          { in codegen.handleread.. defcoll.data is set to nil }
          else if assigned(defcoll.paratype.def) and
-           (defcoll.paratype.def^.deftype=formaldef) then
+           (defcoll.paratype.def.deftype=formaldef) then
            begin
               { allow @var }
               inc(pushedparasize,4);
@@ -160,7 +160,7 @@ implementation
               if (defcoll.paratyp=vs_out) and
                  assigned(defcoll.paratype.def) and
                  not is_class(defcoll.paratype.def) and
-                 defcoll.paratype.def^.needs_inittable then
+                 defcoll.paratype.def.needs_inittable then
                 finalize(defcoll.paratype.def,left.location.reference,false);
               inc(pushedparasize,4);
               if inlined then
@@ -178,7 +178,7 @@ implementation
            end
          else
            begin
-              tempdeftype:=resulttype.def^.deftype;
+              tempdeftype:=resulttype.def.deftype;
               if tempdeftype=filedef then
                CGMessage(cg_e_file_must_call_by_reference);
               { open array must always push the address, this is needed to
@@ -244,7 +244,7 @@ implementation
          { true if a constructor is called again }
          extended_new : boolean;
          { adress returned from an I/O-error }
-         iolabel : pasmlabel;
+         iolabel : tasmlabel;
          { lexlevel count }
          i : longint;
          { help reference pointer }
@@ -267,7 +267,7 @@ implementation
          pop_esp : boolean;
          pop_allowed : boolean;
          regs_to_push : byte;
-         constructorfailed : pasmlabel;
+         constructorfailed : tasmlabel;
 
       label
          dont_call;
@@ -283,7 +283,7 @@ implementation
          unusedregisters:=unused;
          usablecount:=usablereg32;
 
-         if ([pocall_cdecl,pocall_cppdecl,pocall_stdcall]*procdefinition^.proccalloptions)<>[] then
+         if ([pocall_cdecl,pocall_cppdecl,pocall_stdcall]*procdefinition.proccalloptions)<>[] then
           para_alignment:=4
          else
           para_alignment:=target_os.stackalignment;
@@ -296,41 +296,41 @@ implementation
            params:=left.getcopy
          else params := nil;
 
-         if (pocall_inline in procdefinition^.proccalloptions) then
+         if (pocall_inline in procdefinition.proccalloptions) then
            begin
               inlined:=true;
               inlinecode:=tprocinlinenode(right);
               { set it to the same lexical level as the local symtable, becuase
                 the para's are stored there }
-              pprocdef(procdefinition)^.parast^.symtablelevel:=aktprocsym^.definition^.localst^.symtablelevel;
+              tprocdef(procdefinition).parast.symtablelevel:=aktprocsym.definition.localst.symtablelevel;
               if assigned(params) then
                 inlinecode.para_offset:=gettempofsizepersistant(inlinecode.para_size);
-              pprocdef(procdefinition)^.parast^.address_fixup:=inlinecode.para_offset;
+              tprocdef(procdefinition).parast.address_fixup:=inlinecode.para_offset;
 {$ifdef extdebug}
              Comment(V_debug,
                'inlined parasymtable is at offset '
-               +tostr(pprocdef(procdefinition)^.parast^.address_fixup));
+               +tostr(tprocdef(procdefinition).parast.address_fixup));
              exprasmList.concat(Tai_asm_comment.Create(
                strpnew('inlined parasymtable is at offset '
-               +tostr(pprocdef(procdefinition)^.parast^.address_fixup))));
+               +tostr(tprocdef(procdefinition).parast.address_fixup))));
 {$endif extdebug}
               { disable further inlining of the same proc
                 in the args }
-              exclude(procdefinition^.proccalloptions,pocall_inline);
+              exclude(procdefinition.proccalloptions,pocall_inline);
            end;
          { only if no proc var }
          if inlined or
             not(assigned(right)) then
-           is_con_or_destructor:=(procdefinition^.proctypeoption in [potype_constructor,potype_destructor]);
+           is_con_or_destructor:=(procdefinition.proctypeoption in [potype_constructor,potype_destructor]);
          { proc variables destroy all registers }
          if (inlined or
             (right=nil)) and
             { virtual methods too }
-            not(po_virtualmethod in procdefinition^.procoptions) then
+            not(po_virtualmethod in procdefinition.procoptions) then
            begin
               if (cs_check_io in aktlocalswitches) and
-                 (po_iocheck in procdefinition^.procoptions) and
-                 not(po_iocheck in aktprocsym^.definition^.procoptions) then
+                 (po_iocheck in procdefinition.procoptions) and
+                 not(po_iocheck in aktprocsym.definition.procoptions) then
                 begin
                    getaddrlabel(iolabel);
                    emitlab(iolabel);
@@ -339,11 +339,11 @@ implementation
                 iolabel:=nil;
 
               { save all used registers }
-              regs_to_push := pprocdef(procdefinition)^.usedregisters;
+              regs_to_push := tprocdef(procdefinition).usedregisters;
               pushusedregisters(pushed,regs_to_push);
 
               { give used registers through }
-              usedinproc:=usedinproc or pprocdef(procdefinition)^.usedregisters;
+              usedinproc:=usedinproc or tprocdef(procdefinition).usedregisters;
            end
          else
            begin
@@ -362,9 +362,9 @@ implementation
            and for objects constructors PM }
          if (inlined or
             (right=nil)) and
-            (procdefinition^.proctypeoption=potype_constructor) and
+            (procdefinition.proctypeoption=potype_constructor) and
             { quick'n'dirty check if it is a class or an object }
-            (resulttype.def^.deftype=orddef) then
+            (resulttype.def.deftype=orddef) then
            pop_allowed:=false
          else
            pop_allowed:=true;
@@ -375,7 +375,7 @@ implementation
             if i>0 then
              inc(pop_size,4-i);
           { This parasize aligned on 4 ? }
-            i:=procdefinition^.para_size(para_alignment) and 3;
+            i:=procdefinition.para_size(para_alignment) and 3;
             if i>0 then
              inc(pop_size,4-i);
           { insert the opcode and update pushedparasize }
@@ -396,7 +396,7 @@ implementation
          if pop_allowed and (cs_align in aktglobalswitches) then
            begin
               pop_esp:=true;
-              push_size:=procdefinition^.para_size(para_alignment);
+              push_size:=procdefinition.para_size(para_alignment);
               { !!!! here we have to take care of return type, self
                 and nested procedures
               }
@@ -433,30 +433,30 @@ implementation
                 if inlined then
                   begin
                      reset_reference(funcretref);
-                     funcretref.offset:=gettempofsizepersistant(procdefinition^.rettype.def^.size);
+                     funcretref.offset:=gettempofsizepersistant(procdefinition.rettype.def.size);
                      funcretref.base:=procinfo^.framepointer;
                   end
                 else
-                  gettempofsizereference(procdefinition^.rettype.def^.size,funcretref);
+                  gettempofsizereference(procdefinition.rettype.def.size,funcretref);
            end;
          if assigned(params) then
            begin
               { be found elsewhere }
               if inlined then
-                para_offset:=pprocdef(procdefinition)^.parast^.address_fixup+
-                  pprocdef(procdefinition)^.parast^.datasize
+                para_offset:=tprocdef(procdefinition).parast.address_fixup+
+                  tprocdef(procdefinition).parast.datasize
               else
                 para_offset:=0;
               if not(inlined) and
                  assigned(right) then
-                tcallparanode(params).secondcallparan(TParaItem(pabstractprocdef(right.resulttype.def)^.Para.first),
-                  (pocall_leftright in procdefinition^.proccalloptions),inlined,
-                  (([pocall_cdecl,pocall_cppdecl]*procdefinition^.proccalloptions)<>[]),
+                tcallparanode(params).secondcallparan(TParaItem(tabstractprocdef(right.resulttype.def).Para.first),
+                  (pocall_leftright in procdefinition.proccalloptions),inlined,
+                  (([pocall_cdecl,pocall_cppdecl]*procdefinition.proccalloptions)<>[]),
                   para_alignment,para_offset)
               else
-                tcallparanode(params).secondcallparan(TParaItem(procdefinition^.Para.first),
-                  (pocall_leftright in procdefinition^.proccalloptions),inlined,
-                  (([pocall_cdecl,pocall_cppdecl]*procdefinition^.proccalloptions)<>[]),
+                tcallparanode(params).secondcallparan(TParaItem(procdefinition.Para.first),
+                  (pocall_leftright in procdefinition.proccalloptions),inlined,
+                  (([pocall_cdecl,pocall_cppdecl]*procdefinition.proccalloptions)<>[]),
                   para_alignment,para_offset);
            end;
          if inlined then
@@ -471,16 +471,12 @@ implementation
 {$endif not OLD_C_STACK}
               if inlined then
                 begin
-{$ifndef noAllocEdi}
                    getexplicitregister32(R_EDI);
-{$endif noAllocEdi}
                    emit_ref_reg(A_LEA,S_L,
                      newreference(funcretref),R_EDI);
                    r:=new_reference(procinfo^.framepointer,inlinecode.retoffset);
                    emit_reg_ref(A_MOV,S_L,R_EDI,r);
-{$ifndef noAllocEdi}
                    ungetregister32(R_EDI);
-{$endif noAllocEdi}
                 end
               else
                 emitpushreferenceaddr(funcretref);
@@ -492,36 +488,34 @@ implementation
               { overloaded operator have no symtable }
               { push self }
               if assigned(symtableproc) and
-                (symtableproc^.symtabletype=withsymtable) then
+                (symtableproc.symtabletype=withsymtable) then
                 begin
                    { dirty trick to avoid the secondcall below }
                    methodpointer:=ccallparanode.create(nil,nil);
                    methodpointer.location.loc:=LOC_REGISTER;
-{$ifndef noAllocEDI}
                    getexplicitregister32(R_ESI);
-{$endif noAllocEDI}
                    methodpointer.location.register:=R_ESI;
                    { ARGHHH this is wrong !!!
                      if we can init from base class for a child
                      class that the wrong VMT will be
                      transfered to constructor !! }
                    methodpointer.resulttype:=
-                     twithnode(pwithsymtable(symtableproc)^.withnode).left.resulttype;
+                     twithnode(twithsymtable(symtableproc).withnode).left.resulttype;
                    { make a reference }
                    new(r);
                    reset_reference(r^);
-                   { if assigned(ptree(pwithsymtable(symtable)^.withnode)^.pref) then
+                   { if assigned(ptree(twithsymtable(symtable).withnode)^.pref) then
                      begin
-                        r^:=ptree(pwithsymtable(symtable)^.withnode)^.pref^;
+                        r^:=ptree(twithsymtable(symtable).withnode)^.pref^;
                      end
                    else
                      begin
-                        r^.offset:=symtable^.datasize;
+                        r^.offset:=symtable.datasize;
                         r^.base:=procinfo^.framepointer;
                      end; }
-                   r^:=twithnode(pwithsymtable(symtableproc)^.withnode).withreference^;
-                   if ((not(nf_islocal in twithnode(pwithsymtable(symtableproc)^.withnode).flags)) and
-                       (not pwithsymtable(symtableproc)^.direct_with)) or
+                   r^:=twithnode(twithsymtable(symtableproc).withnode).withreference^;
+                   if ((not(nf_islocal in twithnode(twithsymtable(symtableproc).withnode).flags)) and
+                       (not twithsymtable(symtableproc).direct_with)) or
                       is_class_or_interface(methodpointer.resulttype.def) then
                      emit_ref_reg(A_MOV,S_L,r,R_ESI)
                    else
@@ -530,8 +524,8 @@ implementation
 
               { push self }
               if assigned(symtableproc) and
-                ((symtableproc^.symtabletype=objectsymtable) or
-                (symtableproc^.symtabletype=withsymtable)) then
+                ((symtableproc.symtabletype=objectsymtable) or
+                (symtableproc.symtabletype=withsymtable)) then
                 begin
                    if assigned(methodpointer) then
                      begin
@@ -549,7 +543,7 @@ implementation
                                typen:
                                  begin
                                     { direct call to inherited method }
-                                    if (po_abstractmethod in procdefinition^.procoptions) then
+                                    if (po_abstractmethod in procdefinition.procoptions) then
                                       begin
                                          CGMessage(cg_e_cant_call_abstract_method);
                                          goto dont_call;
@@ -557,22 +551,20 @@ implementation
                                     { generate no virtual call }
                                     no_virtual_call:=true;
 
-                                    if (sp_static in symtableprocentry^.symoptions) then
+                                    if (sp_static in symtableprocentry.symoptions) then
                                       begin
                                          { well lets put the VMT address directly into ESI }
                                          { it is kind of dirty but that is the simplest    }
                                          { way to accept virtual static functions (PM)     }
                                          loadesi:=true;
                                          { if no VMT just use $0 bug0214 PM }
-{$ifndef noAllocEDI}
                                          getexplicitregister32(R_ESI);
-{$endif noAllocEDI}
-                                         if not(oo_has_vmt in pobjectdef(methodpointer.resulttype.def)^.objectoptions) then
+                                         if not(oo_has_vmt in tobjectdef(methodpointer.resulttype.def).objectoptions) then
                                            emit_const_reg(A_MOV,S_L,0,R_ESI)
                                          else
                                            begin
                                              emit_sym_ofs_reg(A_MOV,S_L,
-                                               newasmsymbol(pobjectdef(methodpointer.resulttype.def)^.vmt_mangledname),
+                                               newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),
                                                0,R_ESI);
                                            end;
                                          { emit_reg(A_PUSH,S_L,R_ESI);
@@ -583,10 +575,10 @@ implementation
                                       loadesi:=false;
 
                                     { a class destructor needs a flag }
-                                    if is_class(pobjectdef(methodpointer.resulttype.def)) and
+                                    if is_class(tobjectdef(methodpointer.resulttype.def)) and
                                        {assigned(aktprocsym) and
-                                       (aktprocsym^.definition^.proctypeoption=potype_destructor)}
-                                       (procdefinition^.proctypeoption=potype_destructor) then
+                                       (aktprocsym.definition.proctypeoption=potype_destructor)}
+                                       (procdefinition.proctypeoption=potype_destructor) then
                                       begin
                                         push_int(0);
                                         emit_reg(A_PUSH,S_L,R_ESI);
@@ -595,8 +587,8 @@ implementation
                                     if not(is_con_or_destructor and
                                            is_class(methodpointer.resulttype.def) and
                                            {assigned(aktprocsym) and
-                                          (aktprocsym^.definition^.proctypeoption in [potype_constructor,potype_destructor])}
-                                           (procdefinition^.proctypeoption in [potype_constructor,potype_destructor])
+                                          (aktprocsym.definition.proctypeoption in [potype_constructor,potype_destructor])}
+                                           (procdefinition.proctypeoption in [potype_constructor,potype_destructor])
                                           ) then
                                       emit_reg(A_PUSH,S_L,R_ESI);
                                     { if an inherited con- or destructor should be  }
@@ -607,7 +599,7 @@ implementation
                                       is_object(methodpointer.resulttype.def) and
                                       assigned(aktprocsym) then
                                       begin
-                                         if not(aktprocsym^.definition^.proctypeoption in
+                                         if not(aktprocsym.definition.proctypeoption in
                                                 [potype_constructor,potype_destructor]) then
                                           CGMessage(cg_w_member_cd_call_from_method);
                                       end;
@@ -617,7 +609,7 @@ implementation
                                       not(
                                         is_class(methodpointer.resulttype.def) and
                                         assigned(aktprocsym) and
-                                        (aktprocsym^.definition^.proctypeoption=potype_destructor)) then
+                                        (aktprocsym.definition.proctypeoption=potype_destructor)) then
                                       begin
                                          { a constructor needs also a flag }
                                          if is_class(methodpointer.resulttype.def) then
@@ -629,14 +621,12 @@ implementation
                                  begin
                                     { extended syntax of new }
                                     { ESI must be zero }
-{$ifndef noAllocEDI}
                                     getexplicitregister32(R_ESI);
-{$endif noAllocEDI}
                                     emit_reg_reg(A_XOR,S_L,R_ESI,R_ESI);
                                     emit_reg(A_PUSH,S_L,R_ESI);
                                     { insert the vmt }
                                     emit_sym(A_PUSH,S_L,
-                                      newasmsymbol(pobjectdef(methodpointer.resulttype.def)^.vmt_mangledname));
+                                      newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname));
                                     extended_new:=true;
                                  end;
                                hdisposen:
@@ -645,25 +635,21 @@ implementation
 
                                     { destructor with extended syntax called from dispose }
                                     { hdisposen always deliver LOC_REFERENCE          }
-{$ifndef noAllocEDI}
                                     getexplicitregister32(R_ESI);
-{$endif noAllocEDI}
                                     emit_ref_reg(A_LEA,S_L,
                                       newreference(methodpointer.location.reference),R_ESI);
                                     del_reference(methodpointer.location.reference);
                                     emit_reg(A_PUSH,S_L,R_ESI);
                                     emit_sym(A_PUSH,S_L,
-                                      newasmsymbol(pobjectdef(methodpointer.resulttype.def)^.vmt_mangledname));
+                                      newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname));
                                  end;
                                else
                                  begin
                                     { call to an instance member }
-                                    if (symtableproc^.symtabletype<>withsymtable) then
+                                    if (symtableproc.symtabletype<>withsymtable) then
                                       begin
                                          secondpass(methodpointer);
-{$ifndef noAllocEDI}
                                          getexplicitregister32(R_ESI);
-{$endif noAllocEDI}
                                          case methodpointer.location.loc of
                                             LOC_CREGISTER,
                                             LOC_REGISTER:
@@ -673,7 +659,7 @@ implementation
                                               end;
                                             else
                                               begin
-                                                 if (methodpointer.resulttype.def^.deftype=classrefdef) or
+                                                 if (methodpointer.resulttype.def.deftype=classrefdef) or
                                                     is_class_or_interface(methodpointer.resulttype.def) then
                                                    emit_ref_reg(A_MOV,S_L,
                                                      newreference(methodpointer.location.reference),R_ESI)
@@ -686,27 +672,27 @@ implementation
                                       end;
                                     { when calling a class method, we have to load ESI with the VMT !
                                       But, not for a class method via self }
-                                    if not(po_containsself in procdefinition^.procoptions) then
+                                    if not(po_containsself in procdefinition.procoptions) then
                                       begin
-                                        if (po_classmethod in procdefinition^.procoptions) and
-                                           not(methodpointer.resulttype.def^.deftype=classrefdef) then
+                                        if (po_classmethod in procdefinition.procoptions) and
+                                           not(methodpointer.resulttype.def.deftype=classrefdef) then
                                           begin
                                              { class method needs current VMT }
                                              getexplicitregister32(R_ESI);
                                              new(r);
                                              reset_reference(r^);
                                              r^.base:=R_ESI;
-                                             r^.offset:= pprocdef(procdefinition)^._class^.vmt_offset;
+                                             r^.offset:= tprocdef(procdefinition)._class.vmt_offset;
                                              emit_ref_reg(A_MOV,S_L,r,R_ESI);
                                           end;
 
                                         { direct call to destructor: remove data }
-                                        if (procdefinition^.proctypeoption=potype_destructor) and
+                                        if (procdefinition.proctypeoption=potype_destructor) and
                                            is_class(methodpointer.resulttype.def) then
                                           emit_const(A_PUSH,S_L,1);
 
                                         { direct call to class constructor, don't allocate memory }
-                                        if (procdefinition^.proctypeoption=potype_constructor) and
+                                        if (procdefinition.proctypeoption=potype_constructor) and
                                            is_class(methodpointer.resulttype.def) then
                                           begin
                                              emit_const(A_PUSH,S_L,0);
@@ -715,9 +701,9 @@ implementation
                                         else
                                           begin
                                              { constructor call via classreference => allocate memory }
-                                             if (procdefinition^.proctypeoption=potype_constructor) and
-                                                (methodpointer.resulttype.def^.deftype=classrefdef) and
-                                                is_class(pclassrefdef(methodpointer.resulttype.def)^.pointertype.def) then
+                                             if (procdefinition.proctypeoption=potype_constructor) and
+                                                (methodpointer.resulttype.def.deftype=classrefdef) and
+                                                is_class(tclassrefdef(methodpointer.resulttype.def).pointertype.def) then
                                                 emit_const(A_PUSH,S_L,1);
                                              emit_reg(A_PUSH,S_L,R_ESI);
                                           end;
@@ -728,11 +714,11 @@ implementation
                                          { classes don't get a VMT pointer pushed }
                                          if is_object(methodpointer.resulttype.def) then
                                            begin
-                                              if (procdefinition^.proctypeoption=potype_constructor) then
+                                              if (procdefinition.proctypeoption=potype_constructor) then
                                                 begin
                                                    { it's no bad idea, to insert the VMT }
                                                    emit_sym(A_PUSH,S_L,newasmsymbol(
-                                                     pobjectdef(methodpointer.resulttype.def)^.vmt_mangledname));
+                                                     tobjectdef(methodpointer.resulttype.def).vmt_mangledname));
                                                 end
                                               { destructors haven't to dispose the instance, if this is }
                                               { a direct call                                           }
@@ -746,10 +732,10 @@ implementation
                      end
                    else
                      begin
-                        if (po_classmethod in procdefinition^.procoptions) and
+                        if (po_classmethod in procdefinition.procoptions) and
                           not(
                             assigned(aktprocsym) and
-                            (po_classmethod in aktprocsym^.definition^.procoptions)
+                            (po_classmethod in aktprocsym.definition.procoptions)
                           ) then
                           begin
                              { class method needs current VMT }
@@ -757,7 +743,7 @@ implementation
                              new(r);
                              reset_reference(r^);
                              r^.base:=R_ESI;
-                             r^.offset:= pprocdef(procdefinition)^._class^.vmt_offset;
+                             r^.offset:= tprocdef(procdefinition)._class.vmt_offset;
                              emit_ref_reg(A_MOV,S_L,r,R_ESI);
                           end
                         else
@@ -768,12 +754,12 @@ implementation
                         { direct call to destructor: don't remove data! }
                         if is_class(procinfo^._class) then
                           begin
-                             if (procdefinition^.proctypeoption=potype_destructor) then
+                             if (procdefinition.proctypeoption=potype_destructor) then
                                begin
                                   emit_const(A_PUSH,S_L,0);
                                   emit_reg(A_PUSH,S_L,R_ESI);
                                end
-                             else if (procdefinition^.proctypeoption=potype_constructor) then
+                             else if (procdefinition.proctypeoption=potype_constructor) then
                                begin
                                   emit_const(A_PUSH,S_L,0);
                                   emit_const(A_PUSH,S_L,0);
@@ -786,11 +772,11 @@ implementation
                              emit_reg(A_PUSH,S_L,R_ESI);
                              if is_con_or_destructor then
                                begin
-                                  if (procdefinition^.proctypeoption=potype_constructor) then
+                                  if (procdefinition.proctypeoption=potype_constructor) then
                                     begin
                                        { it's no bad idea, to insert the VMT }
                                        emit_sym(A_PUSH,S_L,newasmsymbol(
-                                         procinfo^._class^.vmt_mangledname));
+                                         procinfo^._class.vmt_mangledname));
                                     end
                                   { destructors haven't to dispose the instance, if this is }
                                   { a direct call                                           }
@@ -804,10 +790,10 @@ implementation
                 end;
 
                 { call to BeforeDestruction? }
-                if (procdefinition^.proctypeoption=potype_destructor) and
+                if (procdefinition.proctypeoption=potype_destructor) and
                    assigned(methodpointer) and
                    (methodpointer.nodetype<>typen) and
-                   is_class(pobjectdef(methodpointer.resulttype.def)) and
+                   is_class(tobjectdef(methodpointer.resulttype.def)) and
                    (inlined or
                    (right=nil)) then
                   begin
@@ -826,8 +812,8 @@ implementation
                   end;
 
               { push base pointer ?}
-              if (lexlevel>=normal_function_level) and assigned(pprocdef(procdefinition)^.parast) and
-                ((pprocdef(procdefinition)^.parast^.symtablelevel)>normal_function_level) then
+              if (lexlevel>=normal_function_level) and assigned(tprocdef(procdefinition).parast) and
+                ((tprocdef(procdefinition).parast.symtablelevel)>normal_function_level) then
                 begin
                    { if we call a nested function in a method, we must      }
                    { push also SELF!                                    }
@@ -839,7 +825,7 @@ implementation
                         emit_reg(A_PUSH,S_L,R_ESI);
                      end;
                    }
-                   if lexlevel=(pprocdef(procdefinition)^.parast^.symtablelevel) then
+                   if lexlevel=(tprocdef(procdefinition).parast.symtablelevel) then
                      begin
                         new(r);
                         reset_reference(r^);
@@ -849,11 +835,11 @@ implementation
                      end
                      { this is only true if the difference is one !!
                        but it cannot be more !! }
-                   else if (lexlevel=pprocdef(procdefinition)^.parast^.symtablelevel-1) then
+                   else if (lexlevel=tprocdef(procdefinition).parast.symtablelevel-1) then
                      begin
                         emit_reg(A_PUSH,S_L,procinfo^.framepointer)
                      end
-                   else if (lexlevel>pprocdef(procdefinition)^.parast^.symtablelevel) then
+                   else if (lexlevel>tprocdef(procdefinition).parast.symtablelevel) then
                      begin
                         hregister:=getregister32;
                         new(r);
@@ -861,7 +847,7 @@ implementation
                         r^.offset:=procinfo^.framepointer_offset;
                         r^.base:=procinfo^.framepointer;
                         emit_ref_reg(A_MOV,S_L,r,hregister);
-                        for i:=(pprocdef(procdefinition)^.parast^.symtablelevel) to lexlevel-1 do
+                        for i:=(tprocdef(procdefinition).parast.symtablelevel) to lexlevel-1 do
                           begin
                              new(r);
                              reset_reference(r^);
@@ -880,7 +866,7 @@ implementation
 
               saveregvars(regs_to_push);
 
-              if (po_virtualmethod in procdefinition^.procoptions) and
+              if (po_virtualmethod in procdefinition.procoptions) and
                  not(no_virtual_call) then
                 begin
                    { static functions contain the vmt_address in ESI }
@@ -890,19 +876,19 @@ implementation
                    getexplicitregister32(R_ESI);
                    if assigned(aktprocsym) then
                      begin
-                       if (((sp_static in aktprocsym^.symoptions) or
-                        (po_classmethod in aktprocsym^.definition^.procoptions)) and
+                       if (((sp_static in aktprocsym.symoptions) or
+                        (po_classmethod in aktprocsym.definition.procoptions)) and
                         ((methodpointer=nil) or (methodpointer.nodetype=typen)))
                         or
-                        (po_staticmethod in procdefinition^.procoptions) or
-                        ((procdefinition^.proctypeoption=potype_constructor) and
+                        (po_staticmethod in procdefinition.procoptions) or
+                        ((procdefinition.proctypeoption=potype_constructor) and
                         { esi contains the vmt if we call a constructor via a class ref }
                          assigned(methodpointer) and
-                         (methodpointer.resulttype.def^.deftype=classrefdef)
+                         (methodpointer.resulttype.def.deftype=classrefdef)
                         ) or
-                        { is_interface(pprocdef(procdefinition)^._class) or }
+                        { is_interface(tprocdef(procdefinition)._class) or }
                         { ESI is loaded earlier }
-                        (po_classmethod in procdefinition^.procoptions) then
+                        (po_classmethod in procdefinition.procoptions) then
                          begin
                             new(r);
                             reset_reference(r^);
@@ -914,7 +900,7 @@ implementation
                             reset_reference(r^);
                             r^.base:=R_ESI;
                             { this is one point where we need vmt_offset (PM) }
-                            r^.offset:= pprocdef(procdefinition)^._class^.vmt_offset;
+                            r^.offset:= tprocdef(procdefinition)._class.vmt_offset;
                             getexplicitregister32(R_EDI);
                             emit_ref_reg(A_MOV,S_L,r,R_EDI);
                             new(r);
@@ -936,16 +922,16 @@ implementation
                        r^.base:=R_EDI;
                      end;
                    }
-                   if pprocdef(procdefinition)^.extnumber=-1 then
+                   if tprocdef(procdefinition).extnumber=-1 then
                      internalerror(44584);
-                   r^.offset:=pprocdef(procdefinition)^._class^.vmtmethodoffset(pprocdef(procdefinition)^.extnumber);
-                   if not(is_interface(pprocdef(procdefinition)^._class)) and
-                     not(is_cppclass(pprocdef(procdefinition)^._class)) then
+                   r^.offset:=tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber);
+                   if not(is_interface(tprocdef(procdefinition)._class)) and
+                     not(is_cppclass(tprocdef(procdefinition)._class)) then
                      begin
                         if (cs_check_object_ext in aktlocalswitches) then
                           begin
                              emit_sym(A_PUSH,S_L,
-                               newasmsymbol(pprocdef(procdefinition)^._class^.vmt_mangledname));
+                               newasmsymbol(tprocdef(procdefinition)._class.vmt_mangledname));
                              emit_reg(A_PUSH,S_L,r^.base);
                              emitcall('FPC_CHECK_OBJECT_EXT');
                           end
@@ -956,44 +942,42 @@ implementation
                           end;
                      end;
                    emit_ref(A_CALL,S_NO,r);
-{$ifndef noAllocEdi}
                    ungetregister32(R_EDI);
-{$endif noAllocEdi}
                 end
               else if not inlined then
                 begin
                   { We can call interrupts from within the smae code
                     by just pushing the flags and CS PM }
-                  if (po_interrupt in procdefinition^.procoptions) then
+                  if (po_interrupt in procdefinition.procoptions) then
                     begin
                         emit_none(A_PUSHF,S_L);
                         emit_reg(A_PUSH,S_L,R_CS);
                     end;
-                  emitcall(pprocdef(procdefinition)^.mangledname);
+                  emitcall(tprocdef(procdefinition).mangledname);
                 end
               else { inlined proc }
                 { inlined code is in inlinecode }
                 begin
                    { set poinline again }
-                   include(procdefinition^.proccalloptions,pocall_inline);
+                   include(procdefinition.proccalloptions,pocall_inline);
                    { process the inlinecode }
                    secondpass(inlinecode);
                    { free the args }
-                   if pprocdef(procdefinition)^.parast^.datasize>0 then
-                     ungetpersistanttemp(pprocdef(procdefinition)^.parast^.address_fixup);
+                   if tprocdef(procdefinition).parast.datasize>0 then
+                     ungetpersistanttemp(tprocdef(procdefinition).parast.address_fixup);
                 end;
            end
          else
            { now procedure variable case }
            begin
               secondpass(right);
-              if (po_interrupt in procdefinition^.procoptions) then
+              if (po_interrupt in procdefinition.procoptions) then
                 begin
                     emit_none(A_PUSHF,S_L);
                     emit_reg(A_PUSH,S_L,R_CS);
                 end;
               { procedure of object? }
-              if (po_methodpointer in procdefinition^.procoptions) then
+              if (po_methodpointer in procdefinition.procoptions) then
                 begin
                    { method pointer can't be in a register }
                    hregister:=R_NO;
@@ -1012,7 +996,7 @@ implementation
                      end;
 
                    { load self, but not if it's already explicitly pushed }
-                   if not(po_containsself in procdefinition^.procoptions) then
+                   if not(po_containsself in procdefinition.procoptions) then
                      begin
                        { load ESI }
                        inc(right.location.reference.offset,4);
@@ -1029,14 +1013,7 @@ implementation
                      emit_ref(A_CALL,S_NO,newreference(right.location.reference))
                    else
                      begin
-{$ifndef noAllocEdi}
                        ungetregister32(hregister);
-{$else noAllocEdi}
-                       { the same code, the previous line is just to       }
-                       { indicate EDI actually is deallocated if allocated }
-                       { above (JM)                                        }
-                       ungetregister32(hregister);
-{$endif noAllocEdi}
                        emit_reg(A_CALL,S_NO,hregister);
                      end;
 
@@ -1061,7 +1038,7 @@ implementation
            { this was only for normal functions
              displaced here so we also get
              it to work for procvars PM }
-           if (not inlined) and (pocall_clearstack in procdefinition^.proccalloptions) then
+           if (not inlined) and (pocall_clearstack in procdefinition.proccalloptions) then
              begin
                 { we also add the pop_size which is included in pushedparasize }
                 pop_size:=0;
@@ -1105,10 +1082,10 @@ implementation
            but only if it is a call of an inherited constructor }
          if (inlined or
              (right=nil)) and
-            (procdefinition^.proctypeoption=potype_constructor) and
+            (procdefinition.proctypeoption=potype_constructor) and
             assigned(methodpointer) and
             (methodpointer.nodetype=typen) and
-            (aktprocsym^.definition^.proctypeoption=potype_constructor) then
+            (aktprocsym.definition.proctypeoption=potype_constructor) then
            begin
              emitjmp(C_Z,faillabel);
            end;
@@ -1117,7 +1094,7 @@ implementation
          if is_class(resulttype.def) and
            (inlined or
            (right=nil)) and
-           (procdefinition^.proctypeoption=potype_constructor) and
+           (procdefinition.proctypeoption=potype_constructor) and
            assigned(methodpointer) and
            (methodpointer.nodetype<>typen) then
            begin
@@ -1157,9 +1134,9 @@ implementation
               { a contructor could be a function with boolean result }
               if (inlined or
                   (right=nil)) and
-                 (procdefinition^.proctypeoption=potype_constructor) and
+                 (procdefinition.proctypeoption=potype_constructor) and
                  { quick'n'dirty check if it is a class or an object }
-                 (resulttype.def^.deftype=orddef) then
+                 (resulttype.def.deftype=orddef) then
                 begin
                    { this fails if popsize > 0 PM }
                    location.loc:=LOC_FLAGS;
@@ -1190,10 +1167,10 @@ implementation
                 end
               else
                 begin
-                   if (resulttype.def^.deftype in [orddef,enumdef]) then
+                   if (resulttype.def.deftype in [orddef,enumdef]) then
                      begin
                         location.loc:=LOC_REGISTER;
-                        case resulttype.def^.size of
+                        case resulttype.def.size of
                           4 :
                             begin
 {$ifdef test_dest_loc}
@@ -1257,7 +1234,7 @@ implementation
                      end
 
                 end
-              else if (resulttype.def^.deftype=floatdef) then
+              else if (resulttype.def.deftype=floatdef) then
                 begin
                   location.loc:=LOC_FPU;
                   inc(fpuvaroffset);
@@ -1347,7 +1324,7 @@ implementation
               if location.loc in [LOC_MEM,LOC_REFERENCE] then
                 begin
                    { data which must be finalized ? }
-                   if (resulttype.def^.needs_inittable) then
+                   if (resulttype.def.needs_inittable) then
                       finalize(resulttype.def,location.reference,false);
                    { release unused temp }
                    ungetiftemp(location.reference)
@@ -1372,15 +1349,15 @@ implementation
 
 
     procedure ti386procinlinenode.pass_2;
-       var st : psymtable;
-           oldprocsym : pprocsym;
+       var st : tsymtable;
+           oldprocsym : tprocsym;
            ps, i : longint;
            tmpreg: tregister;
            oldprocinfo : pprocinfo;
            oldinlining_procedure,
            nostackframe,make_global : boolean;
            inlineentrycode,inlineexitcode : TAAsmoutput;
-           oldexitlabel,oldexit2label,oldquickexitlabel:Pasmlabel;
+           oldexitlabel,oldexit2label,oldquickexitlabel:tasmlabel;
            oldunused,oldusableregs : tregisterset;
            oldc_usableregs : longint;
            oldreg_pushes : regvar_longintarray;
@@ -1391,18 +1368,18 @@ implementation
            oldreg_releaser : regvar_ptreearray;
 {$endif TEMPREGDEBUG}
 {$ifdef GDB}
-           startlabel,endlabel : pasmlabel;
+           startlabel,endlabel : tasmlabel;
            pp : pchar;
            mangled_length  : longint;
 {$endif GDB}
        begin
           { deallocate the registers used for the current procedure's regvars }
-          if assigned(aktprocsym^.definition^.regvarinfo) then
+          if assigned(aktprocsym.definition.regvarinfo) then
             begin
-              with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do
+              with pregvarinfo(aktprocsym.definition.regvarinfo)^ do
                 for i := 1 to maxvarregs do
                   if assigned(regvars[i]) then
-                    store_regvar(exprasmlist,regvars[i]^.reg);
+                    store_regvar(exprasmlist,regvars[i].reg);
               oldunused := unused;
               oldusableregs := usableregs;
               oldc_usableregs := c_usableregs;
@@ -1418,15 +1395,15 @@ implementation
               resetusableregisters;
               clearregistercount;
               cleartempgen;
-              if assigned(inlineprocsym^.definition^.regvarinfo) then
-                with pregvarinfo(inlineprocsym^.definition^.regvarinfo)^ do
+              if assigned(inlineprocsym.definition.regvarinfo) then
+                with pregvarinfo(inlineprocsym.definition.regvarinfo)^ do
                  for i := 1 to maxvarregs do
                   if assigned(regvars[i]) then
                     begin
-                      case regsize(regvars[i]^.reg) of
-                        S_B: tmpreg := reg8toreg32(regvars[i]^.reg);
-                        S_W: tmpreg := reg16toreg32(regvars[i]^.reg);
-                        S_L: tmpreg := regvars[i]^.reg;
+                      case regsize(regvars[i].reg) of
+                        S_B: tmpreg := reg8toreg32(regvars[i].reg);
+                        S_W: tmpreg := reg16toreg32(regvars[i].reg);
+                        S_L: tmpreg := regvars[i].reg;
                       end;
                       usableregs:=usableregs-[tmpreg];
                       is_reg_var[tmpreg]:=true;
@@ -1447,20 +1424,20 @@ implementation
           move(procinfo^,oldprocinfo^,sizeof(tprocinfo));
           { set the return value }
           aktprocsym:=inlineprocsym;
-          procinfo^.returntype:=aktprocsym^.definition^.rettype;
+          procinfo^.returntype:=aktprocsym.definition.rettype;
           procinfo^.return_offset:=retoffset;
           procinfo^.para_offset:=para_offset;
           { arg space has been filled by the parent secondcall }
-          st:=aktprocsym^.definition^.localst;
+          st:=aktprocsym.definition.localst;
           { set it to the same lexical level }
-          st^.symtablelevel:=oldprocsym^.definition^.localst^.symtablelevel;
-          if st^.datasize>0 then
+          st.symtablelevel:=oldprocsym.definition.localst.symtablelevel;
+          if st.datasize>0 then
             begin
-              st^.address_fixup:=gettempofsizepersistant(st^.datasize)+st^.datasize;
+              st.address_fixup:=gettempofsizepersistant(st.datasize)+st.datasize;
 {$ifdef extdebug}
-              Comment(V_debug,'local symtable is at offset '+tostr(st^.address_fixup));
+              Comment(V_debug,'local symtable is at offset '+tostr(st.address_fixup));
               exprasmList.concat(Tai_asm_comment.Create(strpnew(
-                'local symtable is at offset '+tostr(st^.address_fixup))));
+                'local symtable is at offset '+tostr(st.address_fixup))));
 {$endif extdebug}
             end;
           exprasmList.concat(Tai_Marker.Create(InlineStart));
@@ -1473,23 +1450,23 @@ implementation
               getaddrlabel(startlabel);
               getaddrlabel(endlabel);
               emitlab(startlabel);
-              inlineprocsym^.definition^.localst^.symtabletype:=inlinelocalsymtable;
-              inlineprocsym^.definition^.parast^.symtabletype:=inlineparasymtable;
+              inlineprocsym.definition.localst.symtabletype:=inlinelocalsymtable;
+              inlineprocsym.definition.parast.symtabletype:=inlineparasymtable;
 
               { Here we must include the para and local symtable info }
-              inlineprocsym^.concatstabto(withdebuglist);
+              inlineprocsym.concatstabto(withdebuglist);
 
-              { set it back for savety }
-              inlineprocsym^.definition^.localst^.symtabletype:=localsymtable;
-              inlineprocsym^.definition^.parast^.symtabletype:=parasymtable;
+              { set it back for safety }
+              inlineprocsym.definition.localst.symtabletype:=localsymtable;
+              inlineprocsym.definition.parast.symtabletype:=parasymtable;
 
-              mangled_length:=length(oldprocsym^.definition^.mangledname);
+              mangled_length:=length(oldprocsym.definition.mangledname);
               getmem(pp,mangled_length+50);
-              strpcopy(pp,'192,0,0,'+startlabel^.name);
+              strpcopy(pp,'192,0,0,'+startlabel.name);
               if (target_os.use_function_relative_addresses) then
                 begin
                   strpcopy(strend(pp),'-');
-                  strpcopy(strend(pp),oldprocsym^.definition^.mangledname);
+                  strpcopy(strend(pp),oldprocsym.definition.mangledname);
                 end;
               withdebugList.concat(Tai_stabn.Create(strnew(pp)));
             end;
@@ -1500,12 +1477,12 @@ implementation
           ps:=para_size;
           make_global:=false; { to avoid warning }
           genentrycode(inlineentrycode,make_global,0,ps,nostackframe,true);
-          if po_assembler in aktprocsym^.definition^.procoptions then
+          if po_assembler in aktprocsym.definition.procoptions then
             inlineentrycode.insert(Tai_marker.Create(asmblockstart));
           exprasmList.concatlist(inlineentrycode);
           secondpass(inlinetree);
           genexitcode(inlineexitcode,0,false,true);
-          if po_assembler in aktprocsym^.definition^.procoptions then
+          if po_assembler in aktprocsym.definition.procoptions then
             inlineexitcode.concat(Tai_marker.Create(asmblockend));
           exprasmList.concatlist(inlineexitcode);
 
@@ -1517,10 +1494,10 @@ implementation
           exprasmList.concat(Tai_Marker.Create(InlineEnd));
 
           {we can free the local data now, reset also the fixup address }
-          if st^.datasize>0 then
+          if st.datasize>0 then
             begin
-              ungetpersistanttemp(st^.address_fixup-st^.datasize);
-              st^.address_fixup:=0;
+              ungetpersistanttemp(st.address_fixup-st.datasize);
+              st.address_fixup:=0;
             end;
           { restore procinfo }
           move(oldprocinfo^,procinfo^,sizeof(tprocinfo));
@@ -1529,11 +1506,11 @@ implementation
           if (cs_debuginfo in aktmoduleswitches) then
             begin
               emitlab(endlabel);
-              strpcopy(pp,'224,0,0,'+endlabel^.name);
+              strpcopy(pp,'224,0,0,'+endlabel.name);
              if (target_os.use_function_relative_addresses) then
                begin
                  strpcopy(strend(pp),'-');
-                 strpcopy(strend(pp),oldprocsym^.definition^.mangledname);
+                 strpcopy(strend(pp),oldprocsym.definition.mangledname);
                end;
               withdebugList.concat(Tai_stabn.Create(strnew(pp)));
               freemem(pp,mangled_length+50);
@@ -1549,7 +1526,7 @@ implementation
           { reallocate the registers used for the current procedure's regvars, }
           { since they may have been used and then deallocated in the inlined  }
           { procedure (JM)                                                     }
-          if assigned(aktprocsym^.definition^.regvarinfo) then
+          if assigned(aktprocsym.definition.regvarinfo) then
             begin
               unused := oldunused;
               usableregs := oldusableregs;
@@ -1572,7 +1549,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.20  2001-04-02 21:20:36  peter
+  Revision 1.21  2001-04-13 01:22:18  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.20  2001/04/02 21:20:36  peter
     * resulttype rewrite
 
   Revision 1.19  2001/03/11 22:58:51  peter

compiler/i386/n386cnv.pas

@@ -83,7 +83,7 @@ implementation
         opsize    : topsize;
         hregister,
         hregister2 : tregister;
-        l : pasmlabel;
+        l : tasmlabel;
 
       begin
         { insert range check if not explicit conversion }
@@ -91,12 +91,12 @@ implementation
           emitrangecheck(left,resulttype.def);
 
         { is the result size smaller ? }
-        if resulttype.def^.size<left.resulttype.def^.size then
+        if resulttype.def.size<left.resulttype.def.size then
           begin
             { only need to set the new size of a register }
             if (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
              begin
-               case resulttype.def^.size of
+               case resulttype.def.size of
                 1 : location.register:=makereg8(left.location.register);
                 2 : location.register:=makereg16(left.location.register);
                 4 : location.register:=makereg32(left.location.register);
@@ -108,7 +108,7 @@ implementation
           end
 
         { is the result size bigger ? }
-        else if resulttype.def^.size>left.resulttype.def^.size then
+        else if resulttype.def.size>left.resulttype.def.size then
           begin
             { remove reference }
             if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
@@ -155,7 +155,7 @@ implementation
                  hregister2:=getregister32;
                  location.registerhigh:=hregister2;
               end;
-            case resulttype.def^.size of
+            case resulttype.def.size of
              1:
                location.register:=makereg8(hregister);
              2:
@@ -185,7 +185,7 @@ implementation
                 begin
                   emit_reg_reg(A_XOR,S_L,
                     hregister2,hregister2);
-                  if (porddef(resulttype.def)^.typ=s64bit) and
+                  if (torddef(resulttype.def).typ=s64bit) and
                     is_signed(left.resulttype.def) then
                     begin
                        getlabel(l);
@@ -208,15 +208,15 @@ implementation
       begin
          { does anybody know a better solution than this big case statement ? }
          { ok, a proc table would do the job                              }
-         case pstringdef(resulttype.def)^.string_typ of
+         case tstringdef(resulttype.def).string_typ of
 
             st_shortstring:
-              case pstringdef(left.resulttype.def)^.string_typ of
+              case tstringdef(left.resulttype.def).string_typ of
                  st_shortstring:
                    begin
-                      gettempofsizereference(resulttype.def^.size,location.reference);
+                      gettempofsizereference(resulttype.def.size,location.reference);
                       copyshortstring(location.reference,left.location.reference,
-                        pstringdef(resulttype.def)^.len,false,true);
+                        tstringdef(resulttype.def).len,false,true);
 {                      done by copyshortstring now (JM)          }
 {                      del_reference(left.location.reference); }
                       ungetiftemp(left.location.reference);
@@ -228,7 +228,7 @@ implementation
                    end;
                  st_ansistring:
                    begin
-                      gettempofsizereference(resulttype.def^.size,location.reference);
+                      gettempofsizereference(resulttype.def.size,location.reference);
                       loadansi2short(left,self);
                       { this is done in secondtypeconv (FK)
                       removetemps(exprasmlist,temptoremove);
@@ -243,7 +243,7 @@ implementation
               end;
 
             st_longstring:
-              case pstringdef(left.resulttype.def)^.string_typ of
+              case tstringdef(left.resulttype.def).string_typ of
                  st_shortstring:
                    begin
                       {!!!!!!!}
@@ -262,7 +262,7 @@ implementation
               end;
 
             st_ansistring:
-              case pstringdef(left.resulttype.def)^.string_typ of
+              case tstringdef(left.resulttype.def).string_typ of
                  st_shortstring:
                    begin
                       clear_location(location);
@@ -294,7 +294,7 @@ implementation
               end;
 
             st_widestring:
-              case pstringdef(left.resulttype.def)^.string_typ of
+              case tstringdef(left.resulttype.def).string_typ of
                  st_shortstring:
                    begin
                       {!!!!!!!}
@@ -327,7 +327,7 @@ implementation
          clear_location(location);
          location.loc:=LOC_REGISTER;
          location.register:=getregister32;
-         case pstringdef(left.resulttype.def)^.string_typ of
+         case tstringdef(left.resulttype.def).string_typ of
            st_shortstring :
              begin
                inc(left.location.reference.offset);
@@ -365,12 +365,12 @@ implementation
     procedure ti386typeconvnode.second_string_to_chararray;
       var
          pushedregs: tpushed;
-         //l1 : pasmlabel;
+         //l1 : tasmlabel;
          //hr : preference;
          arrsize, strtype: longint;
          regstopush: byte;
       begin
-         with parraydef(resulttype.def)^ do
+         with tarraydef(resulttype.def) do
           begin
             if highrange<lowrange then
              internalerror(75432653);
@@ -380,7 +380,7 @@ implementation
          if (left.nodetype = stringconstn) and
             { left.length+1 since there's always a terminating #0 character (JM) }
             (tstringconstnode(left).len+1 >= arrsize) and
-            (pstringdef(left.resulttype.def)^.string_typ=st_shortstring) then
+            (tstringdef(left.resulttype.def).string_typ=st_shortstring) then
            begin
              inc(location.reference.offset);
              exit;
@@ -395,7 +395,7 @@ implementation
 
          emit_push_lea_loc(location,false);
 
-         case pstringdef(left.resulttype.def)^.string_typ of
+         case tstringdef(left.resulttype.def).string_typ of
            st_shortstring :
              begin
                { 0 means shortstring }
@@ -492,12 +492,12 @@ implementation
          l : longint;
       begin
          { calc the length of the array }
-         l:=parraydef(left.resulttype.def)^.highrange-parraydef(left.resulttype.def)^.lowrange+1;
+         l:=tarraydef(left.resulttype.def).highrange-tarraydef(left.resulttype.def).lowrange+1;
          { this is a type conversion which copies the data, so we can't }
          { return a reference                                        }
          clear_location(location);
          location.loc:=LOC_MEM;
-         case pstringdef(resulttype.def)^.string_typ of
+         case tstringdef(resulttype.def).string_typ of
            st_shortstring :
              begin
                if l>255 then
@@ -505,15 +505,15 @@ implementation
                   CGMessage(type_e_mismatch);
                   l:=255;
                 end;
-               gettempofsizereference(resulttype.def^.size,location.reference);
+               gettempofsizereference(resulttype.def.size,location.reference);
                { we've also to release the registers ... }
                { Yes, but before pushusedregisters since that one resets unused! }
                { This caused web bug 1073 (JM)                                   }
                regstopush := $ff;
                remove_non_regvars_from_loc(left.location,regstopush);
                pushusedregisters(pushed,regstopush);
-               if l>=resulttype.def^.size then
-                 push_int(resulttype.def^.size-1)
+               if l>=resulttype.def.size then
+                 push_int(resulttype.def.size-1)
                else
                  push_int(l);
                { ... here only the temp. location is released }
@@ -562,7 +562,7 @@ implementation
       begin
          clear_location(location);
          location.loc:=LOC_MEM;
-         case pstringdef(resulttype.def)^.string_typ of
+         case tstringdef(resulttype.def).string_typ of
            st_shortstring :
              begin
                gettempofsizereference(256,location.reference);
@@ -592,22 +592,20 @@ implementation
       var
          r : preference;
          hregister : tregister;
-         l1,l2 : pasmlabel;
+         l1,l2 : tasmlabel;
 
       begin
          { for u32bit a solution is to push $0 and to load a comp }
          { does this first, it destroys maybe EDI }
          hregister:=R_EDI;
-         if porddef(left.resulttype.def)^.typ=u32bit then
+         if torddef(left.resulttype.def).typ=u32bit then
             push_int(0);
          if (left.location.loc=LOC_REGISTER) or
             (left.location.loc=LOC_CREGISTER) then
            begin
-{$ifndef noAllocEdi}
-              if not (porddef(left.resulttype.def)^.typ in [u32bit,s32bit,u64bit,s64bit]) then
+              if not (torddef(left.resulttype.def).typ in [u32bit,s32bit,u64bit,s64bit]) then
                 getexplicitregister32(R_EDI);
-{$endif noAllocEdi}
-              case porddef(left.resulttype.def)^.typ of
+              case torddef(left.resulttype.def).typ of
                  s8bit : emit_reg_reg(A_MOVSX,S_BL,left.location.register,R_EDI);
                  u8bit : emit_reg_reg(A_MOVZX,S_BL,left.location.register,R_EDI);
                  s16bit : emit_reg_reg(A_MOVSX,S_WL,left.location.register,R_EDI);
@@ -625,10 +623,8 @@ implementation
          else
            begin
               r:=newreference(left.location.reference);
-{$ifndef noAllocEdi}
               getexplicitregister32(R_EDI);
-{$endif noAllocEdi}
-              case porddef(left.resulttype.def)^.typ of
+              case torddef(left.resulttype.def).typ of
                  s8bit:
                    emit_ref_reg(A_MOVSX,S_BL,r,R_EDI);
                  u8bit:
@@ -653,12 +649,10 @@ implementation
            end;
          { for 64 bit integers, the high dword is already pushed }
          emit_reg(A_PUSH,S_L,hregister);
-{$ifndef noAllocEdi}
          if hregister = R_EDI then
            ungetregister32(R_EDI);
-{$endif noAllocEdi}
          r:=new_reference(R_ESP,0);
-         case porddef(left.resulttype.def)^.typ of
+         case torddef(left.resulttype.def).typ of
            u32bit:
              begin
                 emit_ref(A_FILD,S_IQ,r);
@@ -676,16 +670,12 @@ implementation
                 { if it is 1 then we add $80000000 000000000 }
                 { as double                                  }
                 inc(r^.offset,4);
-{$ifndef noAllocEdi}
                 getexplicitregister32(R_EDI);
-{$endif noAllocEdi}
                 emit_ref_reg(A_MOV,S_L,r,R_EDI);
                 r:=new_reference(R_ESP,4);
                 emit_const_ref(A_AND,S_L,$7fffffff,r);
                 emit_const_reg(A_TEST,S_L,longint($80000000),R_EDI);
-{$ifndef noAllocEdi}
                 ungetregister32(R_EDI);
-{$endif noAllocEdi}
                 r:=new_reference(R_ESP,0);
                 emit_ref(A_FILD,S_IQ,r);
                 getdatalabel(l1);
@@ -704,13 +694,9 @@ implementation
            else
              begin
                 emit_ref(A_FILD,S_IL,r);
-{$ifndef noAllocEdi}
                 getexplicitregister32(R_EDI);
-{$endif noAllocEdi}
                 emit_reg(A_POP,S_L,R_EDI);
-{$ifndef noAllocEdi}
                 ungetregister32(R_EDI);
-{$endif noAllocEdi}
              end;
          end;
          inc(fpuvaroffset);
@@ -731,7 +717,7 @@ implementation
             LOC_MEM,
             LOC_REFERENCE:
               begin
-                 floatload(pfloatdef(left.resulttype.def)^.typ,
+                 floatload(tfloatdef(left.resulttype.def).typ,
                    left.location.reference);
                  { we have to free the reference }
                  del_reference(left.location.reference);
@@ -771,7 +757,7 @@ implementation
 
     procedure ti386typeconvnode.second_bool_to_int;
       var
-         oldtruelabel,oldfalselabel,hlabel : pasmlabel;
+         oldtruelabel,oldfalselabel,hlabel : tasmlabel;
          hregister : tregister;
          newsize,
          opsize : topsize;
@@ -785,7 +771,7 @@ implementation
          { byte(boolean) or word(wordbool) or longint(longbool) must
          be accepted for var parameters }
          if (nf_explizit in flags) and
-            (left.resulttype.def^.size=resulttype.def^.size) and
+            (left.resulttype.def.size=resulttype.def.size) and
             (left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
            begin
               set_location(location,left.location);
@@ -796,16 +782,16 @@ implementation
          clear_location(location);
          location.loc:=LOC_REGISTER;
          del_reference(left.location.reference);
-         case left.resulttype.def^.size of
+         case left.resulttype.def.size of
           1 : begin
-                case resulttype.def^.size of
+                case resulttype.def.size of
                  1 : opsize:=S_B;
                  2 : opsize:=S_BW;
                  4 : opsize:=S_BL;
                 end;
               end;
           2 : begin
-                case resulttype.def^.size of
+                case resulttype.def.size of
                  1 : begin
                        if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
                         left.location.register:=reg16toreg8(left.location.register);
@@ -816,7 +802,7 @@ implementation
                 end;
               end;
           4 : begin
-                case resulttype.def^.size of
+                case resulttype.def.size of
                  1 : begin
                        if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
                         left.location.register:=reg32toreg8(left.location.register);
@@ -839,7 +825,7 @@ implementation
           else
            op:=A_MOVZX;
          hregister:=getregister32;
-         case resulttype.def^.size of
+         case resulttype.def.size of
           1 : begin
                 location.register:=reg32toreg8(hregister);
                 newsize:=S_B;
@@ -898,7 +884,7 @@ implementation
          { byte(boolean) or word(wordbool) or longint(longbool) must
          be accepted for var parameters }
          if (nf_explizit in flags) and
-            (left.resulttype.def^.size=resulttype.def^.size) and
+            (left.resulttype.def.size=resulttype.def.size) and
             (left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
            begin
               set_location(location,left.location);
@@ -930,7 +916,7 @@ implementation
             else
               internalerror(10062);
          end;
-         case resulttype.def^.size of
+         case resulttype.def.size of
           1 : location.register:=makereg8(hregister);
           2 : location.register:=makereg16(hregister);
           4 : location.register:=makereg32(hregister);
@@ -963,7 +949,7 @@ implementation
 
     procedure ti386typeconvnode.second_ansistring_to_pchar;
       var
-         l1 : pasmlabel;
+         l1 : tasmlabel;
          hr : preference;
       begin
          clear_location(location);
@@ -995,11 +981,11 @@ implementation
         pushed : tpushed;
         regs_to_push: byte;
       begin
-         case pstringdef(resulttype.def)^.string_typ of
+         case tstringdef(resulttype.def).string_typ of
            st_shortstring:
              begin
                 location.loc:=LOC_REFERENCE;
-                gettempofsizereference(resulttype.def^.size,location.reference);
+                gettempofsizereference(resulttype.def.size,location.reference);
                 pushusedregisters(pushed,$ff);
                 case left.location.loc of
                    LOC_REGISTER,LOC_CREGISTER:
@@ -1063,7 +1049,7 @@ implementation
     procedure ti386typeconvnode.second_class_to_intf;
       var
          hreg : tregister;
-         l1 : pasmlabel;
+         l1 : tasmlabel;
       begin
          case left.location.loc of
             LOC_MEM,
@@ -1087,8 +1073,8 @@ implementation
          emit_reg_reg(A_TEST,S_L,hreg,hreg);
          getlabel(l1);
          emitjmp(C_Z,l1);
-         emit_const_reg(A_ADD,S_L,pobjectdef(left.resulttype.def)^.implementedinterfaces^.ioffsets(
-           pobjectdef(left.resulttype.def)^.implementedinterfaces^.searchintf(resulttype.def))^,hreg);
+         emit_const_reg(A_ADD,S_L,tobjectdef(left.resulttype.def).implementedinterfaces.ioffsets(
+           tobjectdef(left.resulttype.def).implementedinterfaces.searchintf(resulttype.def))^,hreg);
          emitlab(l1);
          location.loc:=LOC_REGISTER;
          location.register:=hreg;
@@ -1174,10 +1160,10 @@ implementation
 {$ifdef TESTOBJEXT2}
                   { Check explicit conversions to objects pointers !! }
                      if p^.explizit and
-                        (p^.resulttype.def^.deftype=pointerdef) and
-                        (ppointerdef(p^.resulttype.def)^.definition^.deftype=objectdef) and not
-                        (pobjectdef(ppointerdef(p^.resulttype.def)^.definition)^.isclass) and
-                        ((pobjectdef(ppointerdef(p^.resulttype.def)^.definition)^.options and oo_hasvmt)<>0) and
+                        (p^.resulttype.def.deftype=pointerdef) and
+                        (tpointerdef(p^.resulttype.def).definition.deftype=objectdef) and not
+                        (tobjectdef(tpointerdef(p^.resulttype.def).definition).isclass) and
+                        ((tobjectdef(tpointerdef(p^.resulttype.def).definition).options and oo_hasvmt)<>0) and
                         (cs_check_range in aktlocalswitches) then
                        begin
                           new(r);
@@ -1186,31 +1172,23 @@ implementation
                            r^.base:=p^.location.register
                           else
                             begin
-{$ifndef noAllocEdi}
                                getexplicitregister32(R_EDI);
-{$endif noAllocEdi}
                                emit_mov_loc_reg(p^.location,R_EDI);
                                r^.base:=R_EDI;
                             end;
                           { NIL must be accepted !! }
                           emit_reg_reg(A_OR,S_L,r^.base,r^.base);
-{$ifndef noAllocEdi}
                           ungetregister32(R_EDI);
-{$endif noAllocEdi}
                           getlabel(nillabel);
                           emitjmp(C_E,nillabel);
                           { this is one point where we need vmt_offset (PM) }
-                          r^.offset:= pobjectdef(ppointerdef(p^.resulttype.def)^.definition)^.vmt_offset;
-{$ifndef noAllocEdi}
+                          r^.offset:= tobjectdef(tpointerdef(p^.resulttype.def).definition).vmt_offset;
                           getexplicitregister32(R_EDI);
-{$endif noAllocEdi}
                           emit_ref_reg(A_MOV,S_L,r,R_EDI);
                           emit_sym(A_PUSH,S_L,
-                            newasmsymbol(pobjectdef(ppointerdef(p^.resulttype.def)^.definition)^.vmt_mangledname));
+                            newasmsymbol(tobjectdef(tpointerdef(p^.resulttype.def).definition).vmt_mangledname));
                           emit_reg(A_PUSH,S_L,R_EDI);
-{$ifndef noAllocEdi}
                           ungetregister32(R_EDI);
-{$endif noAllocEdi}
                           emitcall('FPC_CHECK_OBJECT_EXT');
                           emitlab(nillabel);
                        end;
@@ -1334,7 +1312,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.13  2001-04-02 21:20:36  peter
+  Revision 1.14  2001-04-13 01:22:18  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.13  2001/04/02 21:20:36  peter
     * resulttype rewrite
 
   Revision 1.12  2001/01/08 21:45:11  peter

compiler/i386/n386con.pas

@@ -76,7 +76,7 @@ implementation
 
       var
          hp1 : tai;
-         lastlabel : pasmlabel;
+         lastlabel : tasmlabel;
          realait : tait;
 
       begin
@@ -95,7 +95,7 @@ implementation
          else
            begin
               lastlabel:=nil;
-              realait:=floattype2ait[pfloatdef(resulttype.def)^.typ];
+              realait:=floattype2ait[tfloatdef(resulttype.def).typ];
               { const already used ? }
               if not assigned(lab_real) then
                 begin
@@ -160,7 +160,7 @@ implementation
 
     procedure ti386ordconstnode.pass_2;
       var
-         l : pasmlabel;
+         l : tasmlabel;
 
       begin
          location.loc:=LOC_MEM;
@@ -193,7 +193,7 @@ implementation
          { an integer const. behaves as a memory reference }
          location.loc:=LOC_MEM;
          location.reference.is_immediate:=true;
-         location.reference.offset:=value;
+         location.reference.offset:=longint(value);
       end;
 
 
@@ -205,7 +205,7 @@ implementation
       var
          hp1 : tai;
          l1,l2,
-         lastlabel   : pasmlabel;
+         lastlabel   : tasmlabel;
          pc       : pchar;
          same_string : boolean;
          l,j,
@@ -386,19 +386,19 @@ implementation
     procedure ti386setconstnode.pass_2;
       var
          hp1     : tai;
-         lastlabel   : pasmlabel;
+         lastlabel   : tasmlabel;
          i         : longint;
          neededtyp   : tait;
       begin
         { small sets are loaded as constants }
-        if psetdef(resulttype.def)^.settype=smallset then
+        if tsetdef(resulttype.def).settype=smallset then
          begin
            location.loc:=LOC_MEM;
            location.reference.is_immediate:=true;
            location.reference.offset:=plongint(value_set)^;
            exit;
          end;
-        if psetdef(resulttype.def)^.settype=smallset then
+        if tsetdef(resulttype.def).settype=smallset then
          neededtyp:=ait_const_32bit
         else
          neededtyp:=ait_const_8bit;
@@ -461,7 +461,7 @@ implementation
                  if (cs_create_smart in aktmoduleswitches) then
                   Consts.concat(Tai_cut.Create);
                  Consts.concat(Tai_label.Create(lastlabel));
-                 if psetdef(resulttype.def)^.settype=smallset then
+                 if tsetdef(resulttype.def).settype=smallset then
                   begin
                     move(value_set^,i,sizeof(longint));
                     Consts.concat(Tai_const.Create_32bit(i));
@@ -500,7 +500,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.7  2001-04-02 21:20:37  peter
+  Revision 1.8  2001-04-13 01:22:18  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.7  2001/04/02 21:20:37  peter
     * resulttype rewrite
 
   Revision 1.6  2000/12/25 00:07:32  peter

compiler/i386/n386flw.pas

@@ -99,8 +99,8 @@ implementation
     procedure ti386whilerepeatnode.pass_2;
       var
          lcont,lbreak,lloop,
-         oldclabel,oldblabel : pasmlabel;
-         otlabel,oflabel : pasmlabel;
+         oldclabel,oldblabel : tasmlabel;
+         otlabel,oflabel : tasmlabel;
 
          //start_regvars_loaded,
          //then_regvars_loaded: regvar_booleanarray;
@@ -178,7 +178,7 @@ implementation
     procedure ti386ifnode.pass_2;
 
       var
-         hl,otlabel,oflabel : pasmlabel;
+         hl,otlabel,oflabel : tasmlabel;
 
       begin
          otlabel:=truelabel;
@@ -232,7 +232,7 @@ implementation
 
     procedure ti386fornode.pass_2;
       var
-         l3,oldclabel,oldblabel : pasmlabel;
+         l3,oldclabel,oldblabel : tasmlabel;
          omitfirstcomp,temptovalue : boolean;
          hs : byte;
          temp1 : treference;
@@ -261,7 +261,7 @@ implementation
          { only calculate reference }
          cleartempgen;
          secondpass(t2);
-         hs:=t2.resulttype.def^.size;
+         hs:=t2.resulttype.def.size;
          if t2.location.loc <> LOC_CREGISTER then
            cmp32:=getregister32;
          case hs of
@@ -308,7 +308,7 @@ implementation
          { produce start assignment }
          cleartempgen;
          secondpass(left);
-         count_var_is_signed:=is_signed(porddef(t2.resulttype.def));
+         count_var_is_signed:=is_signed(torddef(t2.resulttype.def));
          if temptovalue then
              begin
               if t2.location.loc=LOC_CREGISTER then
@@ -464,7 +464,7 @@ implementation
       var
          {op : tasmop;
          s : topsize;}
-         otlabel,oflabel : pasmlabel;
+         otlabel,oflabel : tasmlabel;
          r : preference;
          is_mem,
          allocated_eax,
@@ -531,7 +531,7 @@ implementation
               else
                 internalerror(2001);
               end;
-              case procinfo^.returntype.def^.deftype of
+              case procinfo^.returntype.def.deftype of
            pointerdef,
            procvardef : begin
                           cleanleft;
@@ -547,7 +547,7 @@ implementation
              floatdef : begin
                           cleanleft;
                           if is_mem then
-                           floatload(pfloatdef(procinfo^.returntype.def)^.typ,left.location.reference);
+                           floatload(tfloatdef(procinfo^.returntype.def).typ,left.location.reference);
                         end;
               { orddef,
               enumdef : }
@@ -558,7 +558,7 @@ implementation
                           cleanleft;
                           exprasmlist.concat(tairegalloc.alloc(R_EAX));
                           allocated_eax := true;
-                          case procinfo^.returntype.def^.size of
+                          case procinfo^.returntype.def.size of
                            { it can be a qword/int64 too ... }
                            8 : if is_mem then
                                  begin
@@ -657,8 +657,8 @@ do_jmp:
          emitjmp(C_None,labelnr);
          { the assigned avoids only crashes if the label isn't defined }
          if assigned(labsym) and
-           assigned(labsym^.code) and
-            (aktexceptblock<>tlabelnode(labsym^.code).exceptionblock) then
+           assigned(labsym.code) and
+            (aktexceptblock<>tlabelnode(labsym.code).exceptionblock) then
            CGMessage(cg_e_goto_inout_of_exception_block);
        end;
 
@@ -683,7 +683,7 @@ do_jmp:
     procedure ti386raisenode.pass_2;
 
       var
-         a : pasmlabel;
+         a : tasmlabel;
       begin
          if assigned(left) then
            begin
@@ -733,7 +733,7 @@ do_jmp:
 *****************************************************************************}
 
     var
-       endexceptlabel : pasmlabel;
+       endexceptlabel : tasmlabel;
 
     { does the necessary things to clean up the object stack }
     { in the except block                                    }
@@ -777,7 +777,7 @@ do_jmp:
          oldaktexitlabel,
          oldaktexit2label,
          oldaktcontinuelabel,
-         oldaktbreaklabel : pasmlabel;
+         oldaktbreaklabel : tasmlabel;
          oldexceptblock : tnode;
 
 
@@ -1044,7 +1044,7 @@ do_jmp:
          oldaktcontinuelabel,
          doobjectdestroyandreraise,
          doobjectdestroy,
-         oldaktbreaklabel : pasmlabel;
+         oldaktbreaklabel : tasmlabel;
          ref : treference;
          oldexceptblock : tnode;
          oldflowcontrol : tflowcontrol;
@@ -1057,7 +1057,7 @@ do_jmp:
 
          { push the vmt }
          emit_sym(A_PUSH,S_L,
-           newasmsymbol(excepttype^.vmt_mangledname));
+           newasmsymbol(excepttype.vmt_mangledname));
          emitcall('FPC_CATCHES');
          { allocate eax }
          exprasmList.concat(Tairegalloc.Alloc(R_EAX));
@@ -1068,7 +1068,7 @@ do_jmp:
 
          { what a hack ! }
          if assigned(exceptsymtable) then
-           pvarsym(exceptsymtable^.symindex^.first)^.address:=ref.offset;
+           tvarsym(exceptsymtable.symindex.first).address:=ref.offset;
 
          emit_reg_ref(A_MOV,S_L,
            R_EAX,newreference(ref));
@@ -1204,7 +1204,7 @@ do_jmp:
          oldaktexitlabel,
          oldaktexit2label,
          oldaktcontinuelabel,
-         oldaktbreaklabel : pasmlabel;
+         oldaktbreaklabel : tasmlabel;
          oldexceptblock : tnode;
          oldflowcontrol,tryflowcontrol : tflowcontrol;
          decconst : longint;
@@ -1385,7 +1385,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.9  2001-04-02 21:20:37  peter
+  Revision 1.10  2001-04-13 01:22:19  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.9  2001/04/02 21:20:37  peter
     * resulttype rewrite
 
   Revision 1.8  2001/01/27 21:29:35  florian

compiler/i386/n386ic.pas

@@ -28,7 +28,7 @@ uses
   aasm,
   symbase,symtype,symtable,symdef,symsym;
 
-procedure cgintfwrapper(asmlist: TAAsmoutput; procdef: pprocdef; const labelname: string; ioffset: longint);
+procedure cgintfwrapper(asmlist: TAAsmoutput; procdef: tprocdef; const labelname: string; ioffset: longint);
 
 implementation
 
@@ -82,22 +82,22 @@ virtual(2):      OK     OK    OK(3)  OK     OK(3)      OK          OK(4)
 
 }
 
-function getselfoffsetfromsp(procdef: pprocdef): longint;
+function getselfoffsetfromsp(procdef: tprocdef): longint;
 begin
-  if not assigned(procdef^.parast^.symindex^.first) then
+  if not assigned(procdef.parast.symindex.first) then
     getselfoffsetfromsp:=4
   else
-    if psym(procdef^.parast^.symindex^.first)^.typ=varsym then
-      getselfoffsetfromsp:=pvarsym(procdef^.parast^.symindex^.first)^.address+4
+    if tsym(procdef.parast.symindex.first).typ=varsym then
+      getselfoffsetfromsp:=tvarsym(procdef.parast.symindex.first).address+4
     else
       Internalerror(2000061310);
 end;
 
 
-procedure cgintfwrapper(asmlist: TAAsmoutput; procdef: pprocdef; const labelname: string; ioffset: longint);
+procedure cgintfwrapper(asmlist: TAAsmoutput; procdef: tprocdef; const labelname: string; ioffset: longint);
   procedure checkvirtual;
   begin
-    if (procdef^.extnumber=-1) then
+    if (procdef.extnumber=-1) then
       Internalerror(200006139);
   end;
 
@@ -123,24 +123,24 @@ procedure cgintfwrapper(asmlist: TAAsmoutput; procdef: pprocdef; const labelname
   procedure op_oneaxmethodaddr(op: TAsmOp);
   begin
     { call/jmp  vmtoffs(%eax) ; method offs }
-    emit_ref(op,S_L,new_reference(R_EAX,procdef^._class^.vmtmethodoffset(procdef^.extnumber)));
+    emit_ref(op,S_L,new_reference(R_EAX,procdef._class.vmtmethodoffset(procdef.extnumber)));
   end;
 
   procedure loadmethodoffstoeax;
   begin
     { mov  vmtoffs(%eax),%eax ; method offs }
-    emit_ref_reg(A_MOV,S_L,new_reference(R_EAX,procdef^._class^.vmtmethodoffset(procdef^.extnumber)),R_EAX);
+    emit_ref_reg(A_MOV,S_L,new_reference(R_EAX,procdef._class.vmtmethodoffset(procdef.extnumber)),R_EAX);
   end;
 
 var
   oldexprasmlist: TAAsmoutput;
-  lab : pasmsymbol;
+  lab : tasmsymbol;
 
 begin
-  if procdef^.proctypeoption<>potype_none then
+  if procdef.proctypeoption<>potype_none then
     Internalerror(200006137);
-  if not assigned(procdef^._class) or
-     (procdef^.procoptions*[po_containsself, po_classmethod, po_staticmethod,
+  if not assigned(procdef._class) or
+     (procdef.procoptions*[po_containsself, po_classmethod, po_staticmethod,
        po_methodpointer, po_interrupt, po_iocheck]<>[]) then
     Internalerror(200006138);
 
@@ -153,9 +153,9 @@ begin
   adjustselfvalue(ioffset);
 
   { case 1  or 2 }
-  if (pocall_clearstack in procdef^.proccalloptions) then
+  if (pocall_clearstack in procdef.proccalloptions) then
     begin
-      if po_virtualmethod in procdef^.procoptions then
+      if po_virtualmethod in procdef.procoptions then
         begin { case 2 }
           getselftoeax(0);
           loadvmttoeax;
@@ -163,13 +163,13 @@ begin
         end
       else { case 1 }
         begin
-          emitcall(procdef^.mangledname);
+          emitcall(procdef.mangledname);
         end;
       { restore param1 value self to interface }
       adjustselfvalue(-ioffset);
     end
   { case 3 }
-  else if [po_virtualmethod,po_saveregisters]*procdef^.procoptions=[po_virtualmethod,po_saveregisters] then
+  else if [po_virtualmethod,po_saveregisters]*procdef.procoptions=[po_virtualmethod,po_saveregisters] then
     begin
       emit_reg(A_PUSH,S_L,R_EBX); { allocate space for address}
       emit_reg(A_PUSH,S_L,R_EAX);
@@ -184,7 +184,7 @@ begin
       emit_none(A_RET,S_L);
     end
   { case 4 }
-  else if po_virtualmethod in procdef^.procoptions then
+  else if po_virtualmethod in procdef.procoptions then
     begin
       getselftoeax(0);
       loadvmttoeax;
@@ -193,7 +193,7 @@ begin
   { case 0 }
   else
     begin
-      lab:=newasmsymbol(procdef^.mangledname);
+      lab:=newasmsymbol(procdef.mangledname);
       emit_sym(A_JMP,S_NO,lab);
     end;
   exprasmlist:=oldexprasmlist;
@@ -202,7 +202,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-12-25 00:07:33  peter
+  Revision 1.5  2001-04-13 01:22:19  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.4  2000/12/25 00:07:33  peter
     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
       tlinkedlist objects)
 

compiler/i386/n386inl.pas

@@ -91,7 +91,7 @@ implementation
 
       begin
         { Get the accumulator first so it can't be used in the dest }
-        if (dest.resulttype.def^.deftype=orddef) and
+        if (dest.resulttype.def.deftype=orddef) and
           not(is_64bitint(dest.resulttype.def)) then
           hregister:=getexplicitregister32(accumulator);
         { process dest }
@@ -99,17 +99,17 @@ implementation
         if Codegenerror then
          exit;
         { store the value }
-        Case dest.resulttype.def^.deftype of
+        Case dest.resulttype.def.deftype of
           floatdef:
             if dest.location.loc=LOC_CFPUREGISTER then
               begin
-                 floatstoreops(pfloatdef(dest.resulttype.def)^.typ,op,opsize);
+                 floatstoreops(tfloatdef(dest.resulttype.def).typ,op,opsize);
                  emit_reg(op,opsize,correct_fpuregister(dest.location.register,fpuvaroffset+1));
               end
             else
               begin
                  inc(fpuvaroffset);
-                 floatstore(PFloatDef(dest.resulttype.def)^.typ,dest.location.reference);
+                 floatstore(tfloatdef(dest.resulttype.def).typ,dest.location.reference);
                  { floatstore decrements the fpu var offset }
                  { but in fact we didn't increment it       }
               end;
@@ -121,7 +121,7 @@ implementation
                 end
               else
                begin
-                 Case dest.resulttype.def^.size of
+                 Case dest.resulttype.def.size of
                   1 : hreg:=regtoreg8(hregister);
                   2 : hreg:=regtoreg16(hregister);
                   4 : hreg:=hregister;
@@ -129,26 +129,26 @@ implementation
                  emit_mov_reg_loc(hreg,dest.location);
                  If (cs_check_range in aktlocalswitches) and
                     {no need to rangecheck longints or cardinals on 32bit processors}
-                    not((porddef(dest.resulttype.def)^.typ = s32bit) and
-                        (porddef(dest.resulttype.def)^.low = longint($80000000)) and
-                        (porddef(dest.resulttype.def)^.high = $7fffffff)) and
-                    not((porddef(dest.resulttype.def)^.typ = u32bit) and
-                        (porddef(dest.resulttype.def)^.low = 0) and
-                        (porddef(dest.resulttype.def)^.high = longint($ffffffff))) then
+                    not((torddef(dest.resulttype.def).typ = s32bit) and
+                        (torddef(dest.resulttype.def).low = longint($80000000)) and
+                        (torddef(dest.resulttype.def).high = $7fffffff)) and
+                    not((torddef(dest.resulttype.def).typ = u32bit) and
+                        (torddef(dest.resulttype.def).low = 0) and
+                        (torddef(dest.resulttype.def).high = longint($ffffffff))) then
                   Begin
                     {do not register this temporary def}
                     OldRegisterDef := RegisterDef;
                     RegisterDef := False;
                     htype.reset;
-                    Case PordDef(dest.resulttype.def)^.typ of
+                    Case torddef(dest.resulttype.def).typ of
                       u8bit,u16bit,u32bit:
                         begin
-                          htype.setdef(new(porddef,init(u32bit,0,longint($ffffffff))));
+                          htype.setdef(torddef.create(u32bit,0,longint($ffffffff)));
                           hreg:=hregister;
                         end;
                       s8bit,s16bit,s32bit:
                         begin
-                          htype.setdef(new(porddef,init(s32bit,longint($80000000),$7fffffff)));
+                          htype.setdef(torddef.create(s32bit,longint($80000000),$7fffffff));
                           hreg:=hregister;
                         end;
                     end;
@@ -163,7 +163,7 @@ implementation
                     { emit the range check }
                     emitrangecheck(hp,dest.resulttype.def);
                     if assigned(htype.def) then
-                      Dispose(htype.def, Done);
+                      htype.def.free;
                     RegisterDef := OldRegisterDef;
                     hp.free;
                   End;
@@ -220,20 +220,21 @@ implementation
            node       : tcallparanode;
            hp         : tnode;
            typedtyp,
-           pararesult : pdef;
+           pararesult : tdef;
            orgfloattype : tfloattype;
            dummycoll  : tparaitem;
-           iolabel    : pasmlabel;
+           iolabel    : tasmlabel;
            npara      : longint;
            esireloaded : boolean;
-
+        label
+          myexit;
         begin
            { here we don't use register calling conventions }
            dummycoll:=TParaItem.Create;
            dummycoll.register:=R_NO;
            { I/O check }
            if (cs_check_io in aktlocalswitches) and
-              not(po_iocheck in aktprocsym^.definition^.procoptions) then
+              not(po_iocheck in aktprocsym.definition.procoptions) then
              begin
                 getaddrlabel(iolabel);
                 emitlab(iolabel);
@@ -254,9 +255,7 @@ implementation
                 loadstream;
                 { save @aktfile in temporary variable }
                 emit_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile));
-{$ifndef noAllocEdi}
                 ungetregister32(R_EDI);
-{$endif noAllocEdi}
              end
            else
              begin
@@ -267,25 +266,22 @@ implementation
                 npara := nb_para;
                 { calculate data variable }
                 { is first parameter a file type ? }
-                if node.left.resulttype.def^.deftype=filedef then
+                if node.left.resulttype.def.deftype=filedef then
                   begin
-                     ft:=pfiledef(node.left.resulttype.def)^.filetyp;
+                     ft:=tfiledef(node.left.resulttype.def).filetyp;
                      if ft=ft_typed then
-                       typedtyp:=pfiledef(node.left.resulttype.def)^.typedfiletype.def;
+                       typedtyp:=tfiledef(node.left.resulttype.def).typedfiletype.def;
                      secondpass(node.left);
                      if codegenerror then
-                       exit;
+                       goto myexit;
 
                      { save reference in temporary variables }
                      if node.left.location.loc<>LOC_REFERENCE then
                        begin
                           CGMessage(cg_e_illegal_expression);
-                          exit;
+                          goto myexit;
                        end;
-{$ifndef noAllocEdi}
                      getexplicitregister32(R_EDI);
-{$endif noAllocEdi}
-
                      emit_ref_reg(A_LEA,S_L,newreference(node.left.location.reference),R_EDI);
                      del_reference(node.left.location.reference);
                      { skip to the next parameter }
@@ -299,9 +295,7 @@ implementation
 
                 { save @aktfile in temporary variable }
                 emit_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile));
-{$ifndef noAllocEdi}
                 ungetregister32(R_EDI);
-{$endif noAllocEdi}
                 if doread then
                 { parameter by READ gives call by reference }
                   dummycoll.paratyp:=vs_var
@@ -312,7 +306,7 @@ implementation
                 { because of secondcallparan, which otherwise attaches }
                 if ft=ft_typed then
                   { this is to avoid copy of simple const parameters }
-                  {dummycoll.data:=new(pformaldef,init)}
+                  {dummycoll.data:=new(pformaldef.create)}
                   dummycoll.paratype:=cformaltype
                 else
                   { I think, this isn't a good solution (FK) }
@@ -331,9 +325,9 @@ implementation
                        convert here else we loose the old float type }
                      if (not doread) and
                         (ft<>ft_typed) and
-                        (tcallparanode(hp).left.resulttype.def^.deftype=floatdef) then
+                        (tcallparanode(hp).left.resulttype.def.deftype=floatdef) then
                       begin
-                        orgfloattype:=pfloatdef(tcallparanode(hp).left.resulttype.def)^.typ;
+                        orgfloattype:=tfloatdef(tcallparanode(hp).left.resulttype.def).typ;
                         tcallparanode(hp).left:=ctypeconvnode.create(tcallparanode(hp).left,pbestrealtype^);
                         firstpass(tcallparanode(hp).left);
                       end;
@@ -341,7 +335,7 @@ implementation
                        parameter as their destination instead of being pushed }
                      if doread and
                         (ft<>ft_typed) and
-                        (tcallparanode(hp).resulttype.def^.deftype in [orddef,floatdef]) then
+                        (tcallparanode(hp).resulttype.def.deftype in [orddef,floatdef]) then
                       begin
                       end
                      else
@@ -362,7 +356,7 @@ implementation
                       end;
                      tcallparanode(hp).right:=node;
                      if codegenerror then
-                       exit;
+                       goto myexit;
 
                      emit_push_mem(aktfile);
                      if (ft=ft_typed) then
@@ -378,7 +372,7 @@ implementation
                           { I think that is only possible by adding }
                           { reset and rewrite to the inline list a call }
                           { allways read only one record by element }
-                            push_int(typedtyp^.size);
+                            push_int(typedtyp.size);
                             saveregvars($ff);
                             if doread then
                               emitcall('FPC_TYPED_READ')
@@ -404,10 +398,10 @@ implementation
                                    tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
                                    tcallparanode(hp).right:=node;
                                    if codegenerror then
-                                     exit;
+                                     goto myexit;
                                 end
                               else
-                                if pararesult^.deftype<>floatdef then
+                                if pararesult.deftype<>floatdef then
                                   push_int(0)
                                 else
                                   push_int(-32767);
@@ -421,25 +415,25 @@ implementation
                                    dummycoll.paratyp:=vs_value;
                                    tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
                                    tcallparanode(hp).right:=node;
-                                   if pararesult^.deftype<>floatdef then
+                                   if pararesult.deftype<>floatdef then
                                      CGMessage(parser_e_illegal_colon_qualifier);
                                    if codegenerror then
-                                     exit;
+                                     goto myexit;
                                 end
                               else
                                 begin
-                                  if pararesult^.deftype=floatdef then
+                                  if pararesult.deftype=floatdef then
                                     push_int(-1);
                                 end;
                              { push also the real type for floats }
-                              if pararesult^.deftype=floatdef then
+                              if pararesult.deftype=floatdef then
                                 push_int(ord(orgfloattype));
                             end;
                           saveregvars($ff);
-                          case pararesult^.deftype of
+                          case pararesult.deftype of
                             stringdef :
                               begin
-                                emitcall(rdwrprefix[doread]+pstringdef(pararesult)^.stringtypname);
+                                emitcall(rdwrprefix[doread]+tstringdef(pararesult).stringtypname);
                               end;
                             pointerdef :
                               begin
@@ -455,7 +449,7 @@ implementation
                               begin
                                 emitcall(rdwrprefix[doread]+'FLOAT');
                                 {
-                                if pfloatdef(resulttype.def)^.typ<>f32bit then
+                                if tfloatdef(resulttype.def).typ<>f32bit then
                                   dec(fpuvaroffset);
                                 }
                                 if doread then
@@ -467,7 +461,7 @@ implementation
                               end;
                             orddef :
                               begin
-                                case porddef(pararesult)^.typ of
+                                case torddef(pararesult).typ of
                                   s8bit,s16bit,s32bit :
                                     emitcall(rdwrprefix[doread]+'SINT');
                                   u8bit,u16bit,u32bit :
@@ -544,6 +538,9 @@ implementation
                      hp:=tcallparanode(hp).right;
                   end;
              end;
+
+        myexit:
+           dummycoll.free;
         end;
 
       procedure handle_str;
@@ -556,7 +553,8 @@ implementation
            is_real : boolean;
            realtype : tfloattype;
            procedureprefix : string;
-
+        label
+           myexit;
           begin
            dummycoll:=TParaItem.Create;
            dummycoll.register:=R_NO;
@@ -565,10 +563,10 @@ implementation
            is_real:=false;
            while assigned(node.right) do node:=tcallparanode(node.right);
            { if a real parameter somewhere then call REALSTR }
-           if (node.left.resulttype.def^.deftype=floatdef) then
+           if (node.left.resulttype.def.deftype=floatdef) then
             begin
               is_real:=true;
-              realtype:=pfloatdef(node.left.resulttype.def)^.typ;
+              realtype:=tfloatdef(node.left.resulttype.def).typ;
             end;
 
            node:=tcallparanode(left);
@@ -584,13 +582,10 @@ implementation
              dummycoll.paratype:=openshortstringtype
            else
              dummycoll.paratype:=hp.resulttype;
-           procedureprefix:='FPC_'+pstringdef(hp.resulttype.def)^.stringtypname+'_';
+           procedureprefix:='FPC_'+tstringdef(hp.resulttype.def).stringtypname+'_';
            tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
            if codegenerror then
-             begin
-               dummycoll.free;
-               exit;
-             end;
+            goto myexit;
 
            dummycoll.paratyp:=vs_const;
            left.free;
@@ -612,10 +607,7 @@ implementation
                 dummycoll.paratyp:=vs_value;
                 tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
                 if codegenerror then
-                  begin
-                    dummycoll.free;
-                    exit;
-                  end;
+                  goto myexit;
                 hp.free;
                 hp:=node;
                 node:=tcallparanode(node.right);
@@ -632,10 +624,7 @@ implementation
                 dummycoll.paratyp:=vs_value;
                 tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
                 if codegenerror then
-                  begin
-                    dummycoll.free;
-                    exit;
-                  end;
+                  goto myexit;
                 hp.free;
                 hp:=node;
                 node:=tcallparanode(node.right);
@@ -659,16 +648,13 @@ implementation
            dummycoll.paratyp:=vs_value;
            tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
            if codegenerror then
-             begin
-               dummycoll.free;
-               exit;
-             end;
+            goto myexit;
 
            saveregvars($ff);
            if is_real then
              emitcall(procedureprefix+'FLOAT')
            else
-             case porddef(hp.resulttype.def)^.typ of
+             case torddef(hp.resulttype.def).typ of
                 u32bit:
                   emitcall(procedureprefix+'CARDINAL');
 
@@ -681,9 +667,11 @@ implementation
                 else
                   emitcall(procedureprefix+'LONGINT');
              end;
+           popusedregisters(pushed);
            hp.free;
+
+        myexit:
            dummycoll.free;
-           popusedregisters(pushed);
         end;
 
 
@@ -692,13 +680,14 @@ implementation
            hp,node,
            code_para, dest_para : tcallparanode;
            hreg,hreg2: TRegister;
-           hdef: POrdDef;
+           hdef: torddef;
            procedureprefix : string;
            hr, hr2: TReference;
            dummycoll : tparaitem;
            has_code, has_32bit_code, oldregisterdef: boolean;
            r : preference;
-
+          label
+            myexit;
           begin
            dummycoll:=TParaItem.Create;
            dummycoll.register:=R_NO;
@@ -719,7 +708,7 @@ implementation
                hp := node;
                node := tcallparanode(node.right);
                hp.right := nil;
-               has_32bit_code := (porddef(tcallparanode(code_para).left.resulttype.def)^.typ in [u32bit,s32bit]);
+               has_32bit_code := (torddef(tcallparanode(code_para).left.resulttype.def).typ in [u32bit,s32bit]);
              End;
 
           {hp = destination now, save for later use}
@@ -734,10 +723,7 @@ implementation
            dummycoll.paratype.setdef(dest_para.resulttype.def);
            dest_para.secondcallparan(dummycoll,false,false,false,0,0);
            if codegenerror then
-           begin
-             dummycoll.free;
-             exit;
-           end;
+            goto myexit;
 
           {save the regvars}
            pushusedregisters(pushed,$ff);
@@ -751,10 +737,7 @@ implementation
                dummycoll.paratype.setdef(code_para.resulttype.def);
                code_para.secondcallparan(dummycoll,false,false,false,0,0);
                if codegenerror then
-                 begin
-                   dummycoll.free;
-                   exit;
-                 end;
+                goto myexit;
                code_para.free;
              End
            Else
@@ -769,12 +752,9 @@ implementation
            dummycoll.paratype.setdef(node.resulttype.def);
            node.secondcallparan(dummycoll,false,false,false,0,0);
            if codegenerror then
-             begin
-               dummycoll.free;
-               exit;
-             end;
+             goto myexit;
 
-           Case dest_para.resulttype.def^.deftype of
+           Case dest_para.resulttype.def.deftype of
              floatdef:
                begin
                   procedureprefix := 'FPC_VAL_REAL_';
@@ -795,7 +775,7 @@ implementation
                         {if we are converting to a signed number, we have to include the
                          size of the destination, so the Val function can extend the sign
                          of the result to allow proper range checking}
-                        emit_const(A_PUSH,S_L,dest_para.resulttype.def^.size);
+                        emit_const(A_PUSH,S_L,dest_para.resulttype.def.size);
                         procedureprefix := 'FPC_VAL_SINT_'
                       end
                     else
@@ -804,7 +784,7 @@ implementation
            End;
 
            saveregvars($ff);
-           emitcall(procedureprefix+pstringdef(node.resulttype.def)^.stringtypname);
+           emitcall(procedureprefix+tstringdef(node.resulttype.def).stringtypname);
            { before disposing node we need to ungettemp !! PM }
            if node.left.location.loc in [LOC_REFERENCE,LOC_MEM] then
              ungetiftemp(node.left.location.reference);
@@ -814,7 +794,7 @@ implementation
           {reload esi in case the dest_para/code_para is a class variable or so}
            maybe_loadself;
 
-           If (dest_para.resulttype.def^.deftype = orddef) Then
+           If (dest_para.resulttype.def.deftype = orddef) Then
              Begin
               {store the result in a safe place, because EAX may be used by a
                register variable}
@@ -839,21 +819,15 @@ implementation
               {load the address of the code parameter}
                secondpass(code_para.left);
               {move the code to its destination}
-{$ifndef noAllocEdi}
                getexplicitregister32(R_EDI);
-{$endif noAllocEdi}
                emit_ref_reg(A_MOV,S_L,NewReference(hr),R_EDI);
                emit_mov_reg_loc(R_DI,code_para.left.location);
-{$ifndef noAllocEdi}
                ungetregister32(R_EDI);
-{$endif noAllocEdi}
                code_para.free;
              End;
 
           {restore the address of the result}
-{$ifndef noAllocEdi}
            getexplicitregister32(R_EDI);
-{$endif noAllocEdi}
            emit_reg(A_POP,S_L,R_EDI);
 
           {set up hr2 to a refernce with EDI as base register}
@@ -861,11 +835,11 @@ implementation
            hr2.base := R_EDI;
 
           {save the function result in the destination variable}
-           Case dest_para.left.resulttype.def^.deftype of
+           Case dest_para.left.resulttype.def.deftype of
              floatdef:
-               floatstore(PFloatDef(dest_para.left.resulttype.def)^.typ, hr2);
+               floatstore(tfloatdef(dest_para.left.resulttype.def).typ, hr2);
              orddef:
-               Case PordDef(dest_para.left.resulttype.def)^.typ of
+               Case torddef(dest_para.left.resulttype.def).typ of
                  u8bit,s8bit:
                    emit_reg_ref(A_MOV, S_B,
                      RegToReg8(hreg),newreference(hr2));
@@ -886,22 +860,20 @@ implementation
                    end;
                End;
            End;
-{$ifndef noAllocEdi}
            ungetregister32(R_EDI);
-{$endif noAllocEdi}
            If (cs_check_range in aktlocalswitches) and
-              (dest_para.left.resulttype.def^.deftype = orddef) and
+              (dest_para.left.resulttype.def.deftype = orddef) and
               (not(is_64bitint(dest_para.left.resulttype.def))) and
             {the following has to be changed to 64bit checking, once Val
              returns 64 bit values (unless a special Val function is created
              for that)}
             {no need to rangecheck longints or cardinals on 32bit processors}
-               not((porddef(dest_para.left.resulttype.def)^.typ = s32bit) and
-                   (porddef(dest_para.left.resulttype.def)^.low = longint($80000000)) and
-                   (porddef(dest_para.left.resulttype.def)^.high = $7fffffff)) and
-               not((porddef(dest_para.left.resulttype.def)^.typ = u32bit) and
-                   (porddef(dest_para.left.resulttype.def)^.low = 0) and
-                   (porddef(dest_para.left.resulttype.def)^.high = longint($ffffffff))) then
+               not((torddef(dest_para.left.resulttype.def).typ = s32bit) and
+                   (torddef(dest_para.left.resulttype.def).low = longint($80000000)) and
+                   (torddef(dest_para.left.resulttype.def).high = $7fffffff)) and
+               not((torddef(dest_para.left.resulttype.def).typ = u32bit) and
+                   (torddef(dest_para.left.resulttype.def).low = 0) and
+                   (torddef(dest_para.left.resulttype.def).high = longint($ffffffff))) then
              Begin
                hp:=tcallparanode(dest_para.left.getcopy);
                hp.location.loc := LOC_REGISTER;
@@ -909,21 +881,22 @@ implementation
               {do not register this temporary def}
                OldRegisterDef := RegisterDef;
                RegisterDef := False;
-               Case PordDef(dest_para.left.resulttype.def)^.typ of
-                 u8bit,u16bit,u32bit: new(hdef,init(u32bit,0,longint($ffffffff)));
-                 s8bit,s16bit,s32bit: new(hdef,init(s32bit,longint($80000000),$7fffffff));
+               Case torddef(dest_para.left.resulttype.def).typ of
+                 u8bit,u16bit,u32bit: hdef:=torddef.create(u32bit,0,longint($ffffffff));
+                 s8bit,s16bit,s32bit: hdef:=torddef.create(s32bit,longint($80000000),$7fffffff);
                end;
                hp.resulttype.def := hdef;
                emitrangecheck(hp,dest_para.left.resulttype.def);
                hp.right := nil;
-               Dispose(hp.resulttype.def, Done);
+               hp.resulttype.def.free;
                RegisterDef := OldRegisterDef;
                hp.free;
              End;
           {dest_para.right is already nil}
            dest_para.free;
-           dummycoll.free;
            UnGetIfTemp(hr);
+        myexit:
+           dummycoll.free;
         end;
 
       var
@@ -934,9 +907,9 @@ implementation
          l : longint;
          ispushed : boolean;
          hregister : tregister;
-         otlabel,oflabel{,l1}   : pasmlabel;
+         otlabel,oflabel{,l1}   : tasmlabel;
          oldpushedparasize : longint;
-         def : pdef;
+         def : tdef;
          hr,hr2 : treference;
 
       begin
@@ -1011,7 +984,7 @@ implementation
                    begin
                       location.register:=getregister32;
                       emit_sym_ofs_reg(A_MOV,
-                        S_L,newasmsymbol(pobjectdef(left.resulttype.def)^.vmt_mangledname),0,
+                        S_L,newasmsymbol(tobjectdef(left.resulttype.def).vmt_mangledname),0,
                         location.register);
                    end
                  else
@@ -1022,7 +995,7 @@ implementation
                       location.register:=getregister32;
                       { load VMT pointer }
                       inc(left.location.reference.offset,
-                        pobjectdef(left.resulttype.def)^.vmt_offset);
+                        tobjectdef(left.resulttype.def).vmt_offset);
                       emit_ref_reg(A_MOV,S_L,
                       newreference(left.location.reference),
                         location.register);
@@ -1134,7 +1107,7 @@ implementation
                      asmop:=A_SUB
                    else
                      asmop:=A_ADD;
-                 case resulttype.def^.size of
+                 case resulttype.def.size of
                    8 : opsize:=S_L;
                    4 : opsize:=S_L;
                    2 : opsize:=S_W;
@@ -1143,7 +1116,7 @@ implementation
                    internalerror(10080);
                  end;
                  location.loc:=LOC_REGISTER;
-                 if resulttype.def^.size=8 then
+                 if resulttype.def.size=8 then
                    begin
                       if left.location.loc<>LOC_REGISTER then
                         begin
@@ -1198,9 +1171,9 @@ implementation
                              del_reference(left.location.reference);
 
                            location.register:=getregister32;
-                           if (resulttype.def^.size=2) then
+                           if (resulttype.def.size=2) then
                              location.register:=reg32toreg16(location.register);
-                           if (resulttype.def^.size=1) then
+                           if (resulttype.def.size=1) then
                              location.register:=reg32toreg8(location.register);
                            if left.location.loc=LOC_CREGISTER then
                              emit_reg_reg(A_MOV,opsize,left.location.register,
@@ -1231,10 +1204,10 @@ implementation
                 addconstant:=true;
               { load first parameter, must be a reference }
                 secondpass(tcallparanode(left).left);
-                case tcallparanode(left).left.resulttype.def^.deftype of
+                case tcallparanode(left).left.resulttype.def.deftype of
                   orddef,
                  enumdef : begin
-                             case tcallparanode(left).left.resulttype.def^.size of
+                             case tcallparanode(left).left.resulttype.def.size of
                               1 : opsize:=S_B;
                               2 : opsize:=S_W;
                               4 : opsize:=S_L;
@@ -1243,10 +1216,10 @@ implementation
                            end;
               pointerdef : begin
                              opsize:=S_L;
-                             if is_void(ppointerdef(tcallparanode(left).left.resulttype.def)^.pointertype.def) then
+                             if is_void(tpointerdef(tcallparanode(left).left.resulttype.def).pointertype.def) then
                               addvalue:=1
                              else
-                              addvalue:=ppointerdef(tcallparanode(left).left.resulttype.def)^.pointertype.def^.size;
+                              addvalue:=tpointerdef(tcallparanode(left).left.resulttype.def).pointertype.def.size;
                            end;
                 else
                  internalerror(10081);
@@ -1336,11 +1309,11 @@ implementation
 
             in_typeinfo_x:
                begin
-                  pstoreddef(ttypenode(tcallparanode(left).left).resulttype.def)^.generate_rtti;
+                  tstoreddef(ttypenode(tcallparanode(left).left).resulttype.def).generate_rtti;
                   location.register:=getregister32;
                   new(r);
                   reset_reference(r^);
-                  r^.symbol:=pstoreddef(ttypenode(tcallparanode(left).left).resulttype.def)^.rtti_label;
+                  r^.symbol:=tstoreddef(ttypenode(tcallparanode(left).left).resulttype.def).rtti_label;
                   emit_ref_reg(A_LEA,S_L,r,location.register);
                end;
 
@@ -1348,12 +1321,12 @@ implementation
                begin
                   pushusedregisters(pushed,$ff);
                   { force rtti generation }
-                  pstoreddef(ttypenode(tcallparanode(left).left).resulttype.def)^.generate_rtti;
+                  tstoreddef(ttypenode(tcallparanode(left).left).resulttype.def).generate_rtti;
                   { if a count is passed, push size, typeinfo and count }
                   if assigned(tcallparanode(left).right) then
                     begin
                        secondpass(tcallparanode(tcallparanode(left).right).left);
-                       push_int(tcallparanode(left).left.resulttype.def^.size);
+                       push_int(tcallparanode(left).left.resulttype.def.size);
                        if codegenerror then
                         exit;
                        emit_push_loc(tcallparanode(tcallparanode(left).right).left.location);
@@ -1361,7 +1334,7 @@ implementation
 
                   { generate a reference }
                   reset_reference(hr);
-                  hr.symbol:=pstoreddef(ttypenode(tcallparanode(left).left).resulttype.def)^.rtti_label;
+                  hr.symbol:=tstoreddef(ttypenode(tcallparanode(left).left).resulttype.def).rtti_label;
                   emitpushreferenceaddr(hr);
 
                   { data to finalize }
@@ -1399,7 +1372,7 @@ implementation
              in_reset_typedfile,in_rewrite_typedfile :
                begin
                   pushusedregisters(pushed,$ff);
-                  emit_const(A_PUSH,S_L,pfiledef(left.resulttype.def)^.typedfiletype.def^.size);
+                  emit_const(A_PUSH,S_L,tfiledef(left.resulttype.def).typedfiletype.def.size);
                   secondpass(left);
                   emitpushreferenceaddr(left.location.reference);
                   saveregvars($ff);
@@ -1448,12 +1421,13 @@ implementation
                   { handle shortstrings separately since the hightree must be }
                   { pushed too (JM)                                           }
                   if not(is_dynamic_array(def)) and
-                     (pstringdef(def)^.string_typ = st_shortstring) then
+                     (tstringdef(def).string_typ = st_shortstring) then
                     begin
                       dummycoll:=TParaItem.Create;
                       dummycoll.paratyp:=vs_var;
                       dummycoll.paratype:=openshortstringtype;
                       tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
+                      dummycoll.free;
                       if codegenerror then
                         exit;
                     end
@@ -1463,7 +1437,7 @@ implementation
                        emitpushreferenceaddr(hr2);
                        push_int(l);
                        reset_reference(hr2);
-                       hr2.symbol:=pstoreddef(def)^.get_inittable_label;
+                       hr2.symbol:=tstoreddef(def).get_inittable_label;
                        emitpushreferenceaddr(hr2);
                        emitpushreferenceaddr(tcallparanode(hp).left.location.reference);
                        saveregvars($ff);
@@ -1473,7 +1447,7 @@ implementation
                   else
                     { must be string }
                     begin
-                       case pstringdef(def)^.string_typ of
+                       case tstringdef(def).string_typ of
                           st_widestring:
                             begin
                               emitpushreferenceaddr(tcallparanode(hp).left.location.reference);
@@ -1558,7 +1532,7 @@ implementation
                         asmop:=A_BTS
                       else
                         asmop:=A_BTR;
-                      if psetdef(left.resulttype.def)^.settype=smallset then
+                      if tsetdef(left.resulttype.def).settype=smallset then
                         begin
                            if tcallparanode(tcallparanode(left).right).left.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
                              { we don't need a mod 32 because this is done automatically  }
@@ -1627,7 +1601,7 @@ implementation
                       end;
                     LOC_REFERENCE,LOC_MEM:
                       begin
-                         floatload(pfloatdef(left.resulttype.def)^.typ,left.location.reference);
+                         floatload(tfloatdef(left.resulttype.def).typ,left.location.reference);
                          del_reference(left.location.reference);
                       end
                     else
@@ -1704,7 +1678,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.13  2001-04-02 21:20:37  peter
+  Revision 1.14  2001-04-13 01:22:19  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.13  2001/04/02 21:20:37  peter
     * resulttype rewrite
 
   Revision 1.12  2001/03/13 11:52:48  jonas

compiler/i386/n386ld.pas

@@ -67,7 +67,7 @@ implementation
          symtabletype : tsymtabletype;
          i : longint;
          hp : preference;
-         s : pasmsymbol;
+         s : tasmsymbol;
          popeax : boolean;
          //pushed : tpushed;
          //hr : treference;
@@ -75,27 +75,27 @@ implementation
       begin
          simple_loadn:=true;
          reset_reference(location.reference);
-         case symtableentry^.typ of
+         case symtableentry.typ of
               { this is only for toasm and toaddr }
               absolutesym :
                  begin
                     location.reference.symbol:=nil;
-                    if (pabsolutesym(symtableentry)^.abstyp=toaddr) then
+                    if (tabsolutesym(symtableentry).abstyp=toaddr) then
                      begin
-                       if pabsolutesym(symtableentry)^.absseg then
+                       if tabsolutesym(symtableentry).absseg then
                         location.reference.segment:=R_FS;
-                       location.reference.offset:=pabsolutesym(symtableentry)^.address;
+                       location.reference.offset:=tabsolutesym(symtableentry).address;
                      end
                     else
-                     location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
+                     location.reference.symbol:=newasmsymbol(symtableentry.mangledname);
                  end;
               constsym:
                 begin
-                   if pconstsym(symtableentry)^.consttyp=constresourcestring then
+                   if tconstsym(symtableentry).consttyp=constresourcestring then
                      begin
                         location.loc:=LOC_MEM;
-                        location.reference.symbol:=newasmsymbol(pconstsym(symtableentry)^.owner^.name^+'_RESOURCESTRINGLIST');
-                        location.reference.offset:=pconstsym(symtableentry)^.resstrindex*16+8;
+                        location.reference.symbol:=newasmsymbol(tconstsym(symtableentry).owner.name^+'_RESOURCESTRINGLIST');
+                        location.reference.offset:=tconstsym(symtableentry).resstrindex*16+8;
                      end
                    else
                      internalerror(22798);
@@ -104,31 +104,31 @@ implementation
                  begin
                     hregister:=R_NO;
                     { C variable }
-                    if (vo_is_C_var in pvarsym(symtableentry)^.varoptions) then
+                    if (vo_is_C_var in tvarsym(symtableentry).varoptions) then
                       begin
-                         location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
+                         location.reference.symbol:=newasmsymbol(symtableentry.mangledname);
                       end
                     { DLL variable }
-                    else if (vo_is_dll_var in pvarsym(symtableentry)^.varoptions) then
+                    else if (vo_is_dll_var in tvarsym(symtableentry).varoptions) then
                       begin
                          hregister:=getregister32;
-                         location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
+                         location.reference.symbol:=newasmsymbol(symtableentry.mangledname);
                          emit_ref_reg(A_MOV,S_L,newreference(location.reference),hregister);
                          location.reference.symbol:=nil;
                          location.reference.base:=hregister;
                       end
                     { external variable }
-                    else if (vo_is_external in pvarsym(symtableentry)^.varoptions) then
+                    else if (vo_is_external in tvarsym(symtableentry).varoptions) then
                       begin
-                         location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
+                         location.reference.symbol:=newasmsymbol(symtableentry.mangledname);
                       end
                     { thread variable }
-                    else if (vo_is_thread_var in pvarsym(symtableentry)^.varoptions) then
+                    else if (vo_is_thread_var in tvarsym(symtableentry).varoptions) then
                       begin
                          popeax:=not(R_EAX in unused);
                          if popeax then
                            emit_reg(A_PUSH,S_L,R_EAX);
-                         location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
+                         location.reference.symbol:=newasmsymbol(symtableentry.mangledname);
                          emit_ref(A_PUSH,S_L,newreference(location.reference));
                          { the called procedure isn't allowed to change }
                          { any register except EAX                    }
@@ -144,29 +144,29 @@ implementation
                     { normal variable }
                     else
                       begin
-                         symtabletype:=symtable^.symtabletype;
+                         symtabletype:=symtable.symtabletype;
                          { in case it is a register variable: }
-                         if pvarsym(symtableentry)^.reg<>R_NO then
+                         if tvarsym(symtableentry).reg<>R_NO then
                            begin
-                              if pvarsym(symtableentry)^.reg in [R_ST0..R_ST7] then
+                              if tvarsym(symtableentry).reg in [R_ST0..R_ST7] then
                                 begin
                                    location.loc:=LOC_CFPUREGISTER;
-                                   location.register:=pvarsym(symtableentry)^.reg;
+                                   location.register:=tvarsym(symtableentry).reg;
                                 end
                               else
-                                if not(makereg32(pvarsym(symtableentry)^.reg) in [R_EAX..R_EBX]) or
-                                   regvar_loaded[pvarsym(symtableentry)^.reg] then
+                                if not(makereg32(tvarsym(symtableentry).reg) in [R_EAX..R_EBX]) or
+                                   regvar_loaded[tvarsym(symtableentry).reg] then
                                 begin
                                    location.loc:=LOC_CREGISTER;
-                                   location.register:=pvarsym(symtableentry)^.reg;
-                                   unused:=unused-[pvarsym(symtableentry)^.reg];
+                                   location.register:=tvarsym(symtableentry).reg;
+                                   unused:=unused-[tvarsym(symtableentry).reg];
                                 end
                               else
                                 begin
-                                  load_regvar(exprasmlist,pvarsym(symtableentry));
+                                  load_regvar(exprasmlist,tvarsym(symtableentry));
                                   location.loc:=LOC_CREGISTER;
-                                  location.register:=pvarsym(symtableentry)^.reg;
-                                  unused:=unused-[pvarsym(symtableentry)^.reg];
+                                  location.register:=tvarsym(symtableentry).reg;
+                                  unused:=unused-[tvarsym(symtableentry).reg];
                                 end
                            end
                          else
@@ -179,20 +179,20 @@ implementation
                                    if (symtabletype in [inlinelocalsymtable,
                                                         localsymtable]) then
                                      location.reference.offset:=
-                                       pvarsym(symtableentry)^.address-symtable^.address_fixup
+                                       tvarsym(symtableentry).address-symtable.address_fixup
                                    else
                                      location.reference.offset:=
-                                       pvarsym(symtableentry)^.address+symtable^.address_fixup;
+                                       tvarsym(symtableentry).address+symtable.address_fixup;
 
                                    if (symtabletype in [localsymtable,inlinelocalsymtable]) then
                                      begin
                                         if use_esp_stackframe then
                                           dec(location.reference.offset,
-                                            pvarsym(symtableentry)^.getvaluesize)
+                                            tvarsym(symtableentry).getvaluesize)
                                         else
                                           location.reference.offset:=-location.reference.offset;
                                      end;
-                                   if (lexlevel>(symtable^.symtablelevel)) then
+                                   if (lexlevel>(symtable.symtablelevel)) then
                                      begin
                                         hregister:=getregister32;
 
@@ -204,7 +204,7 @@ implementation
 
                                         simple_loadn:=false;
                                         i:=lexlevel-1;
-                                        while i>(symtable^.symtablelevel) do
+                                        while i>(symtable.symtablelevel) do
                                           begin
                                              { make a reference }
                                              hp:=new_reference(hregister,8);
@@ -216,27 +216,27 @@ implementation
                                 end
                               else
                                 case symtabletype of
-                                   unitsymtable,globalsymtable,
+                                   globalsymtable,
                                    staticsymtable :
                                      begin
-                                       location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
+                                       location.reference.symbol:=newasmsymbol(symtableentry.mangledname);
                                      end;
                                    stt_exceptsymtable:
                                      begin
                                         location.reference.base:=procinfo^.framepointer;
-                                        location.reference.offset:=pvarsym(symtableentry)^.address;
+                                        location.reference.offset:=tvarsym(symtableentry).address;
                                      end;
                                    objectsymtable:
                                      begin
                                         getexplicitregister32(R_ESI);
-                                        if (sp_static in pvarsym(symtableentry)^.symoptions) then
+                                        if (sp_static in tvarsym(symtableentry).symoptions) then
                                           begin
-                                             location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
+                                             location.reference.symbol:=newasmsymbol(symtableentry.mangledname);
                                           end
                                         else
                                           begin
                                              location.reference.base:=R_ESI;
-                                             location.reference.offset:=pvarsym(symtableentry)^.address;
+                                             location.reference.offset:=tvarsym(symtableentry).address;
                                           end;
                                      end;
                                    withsymtable:
@@ -246,33 +246,33 @@ implementation
                                           contains the offset of the temp
                                           stored }
 {                                       hp:=new_reference(procinfo^.framepointer,
-                                          symtable^.datasize);
+                                          symtable.datasize);
 
                                         emit_ref_reg(A_MOV,S_L,hp,hregister);}
 
-                                        if nf_islocal in tnode(pwithsymtable(symtable)^.withnode).flags then
+                                        if nf_islocal in tnode(twithsymtable(symtable).withnode).flags then
                                          begin
-                                           location.reference:=twithnode(pwithsymtable(symtable)^.withnode).withreference^;
+                                           location.reference:=twithnode(twithsymtable(symtable).withnode).withreference^;
                                          end
                                         else
                                          begin
                                            hregister:=getregister32;
                                            location.reference.base:=hregister;
                                            emit_ref_reg(A_MOV,S_L,
-                                             newreference(twithnode(pwithsymtable(symtable)^.withnode).withreference^),
+                                             newreference(twithnode(twithsymtable(symtable).withnode).withreference^),
                                              hregister);
                                          end;
-                                        inc(location.reference.offset,pvarsym(symtableentry)^.address);
+                                        inc(location.reference.offset,tvarsym(symtableentry).address);
                                      end;
                                 end;
                            end;
                          { in case call by reference, then calculate. Open array
                            is always an reference! }
-                         if (pvarsym(symtableentry)^.varspez in [vs_var,vs_out]) or
-                            is_open_array(pvarsym(symtableentry)^.vartype.def) or
-                            is_array_of_const(pvarsym(symtableentry)^.vartype.def) or
-                            ((pvarsym(symtableentry)^.varspez=vs_const) and
-                             push_addr_param(pvarsym(symtableentry)^.vartype.def)) then
+                         if (tvarsym(symtableentry).varspez in [vs_var,vs_out]) or
+                            is_open_array(tvarsym(symtableentry).vartype.def) or
+                            is_array_of_const(tvarsym(symtableentry).vartype.def) or
+                            ((tvarsym(symtableentry).varspez=vs_const) and
+                             push_addr_param(tvarsym(symtableentry).vartype.def)) then
                            begin
                               simple_loadn:=false;
                               if hregister=R_NO then
@@ -302,13 +302,13 @@ implementation
                          gettempofsizereference(8,location.reference);
                          if left.nodetype=typen then
                           begin
-                            if left.resulttype.def^.deftype<>objectdef then
+                            if left.resulttype.def.deftype<>objectdef then
                              internalerror(200103261);
                             getexplicitregister32(R_EDI);
                             hregister:=R_EDI;
                             new(hp);
                             emit_sym_ofs_reg(A_MOV,S_L,
-                              newasmsymbol(pobjectdef(left.resulttype.def)^.vmt_mangledname),0,R_EDI);
+                              newasmsymbol(tobjectdef(left.resulttype.def).vmt_mangledname),0,R_EDI);
                           end
                          else
                           begin
@@ -352,7 +352,7 @@ implementation
                            hregister,hp);
 
                          { virtual method ? }
-                         if (po_virtualmethod in pprocsym(symtableentry)^.definition^.procoptions) then
+                         if (po_virtualmethod in tprocsym(symtableentry).definition.procoptions) then
                            begin
                               new(hp);
                               reset_reference(hp^);
@@ -367,23 +367,19 @@ implementation
                               new(hp);
                               reset_reference(hp^);
                               hp^.base:=R_EDI;
-                              hp^.offset:=pprocsym(symtableentry)^.definition^._class^.vmtmethodoffset(
-                                pprocsym(symtableentry)^.definition^.extnumber);
+                              hp^.offset:=tprocsym(symtableentry).definition._class.vmtmethodoffset(
+                                tprocsym(symtableentry).definition.extnumber);
                               emit_ref_reg(A_MOV,S_L,
                                 hp,R_EDI);
                               { ... and store it }
                               emit_reg_ref(A_MOV,S_L,
                                 R_EDI,newreference(location.reference));
-{$ifndef noAllocEdi}
                               ungetregister32(R_EDI);
-{$endif noAllocEdi}
                            end
                          else
                            begin
-{$ifndef noAllocEdi}
                               ungetregister32(R_EDI);
-{$endif noAllocEdi}
-                              s:=newasmsymbol(pprocsym(symtableentry)^.definition^.mangledname);
+                              s:=newasmsymbol(tprocsym(symtableentry).definition.mangledname);
                               emit_sym_ofs_ref(A_MOV,S_L,s,0,
                                 newreference(location.reference));
                            end;
@@ -391,12 +387,12 @@ implementation
                     else
                       begin
                          {!!!!! Be aware, work on virtual methods too }
-                         location.reference.symbol:=newasmsymbol(pprocsym(symtableentry)^.definition^.mangledname);
+                         location.reference.symbol:=newasmsymbol(tprocsym(symtableentry).definition.mangledname);
                       end;
                  end;
               typedconstsym :
                  begin
-                    location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
+                    location.reference.symbol:=newasmsymbol(symtableentry.mangledname);
                  end;
               else internalerror(4);
          end;
@@ -410,7 +406,7 @@ implementation
     procedure ti386assignmentnode.pass_2;
       var
          opsize : topsize;
-         otlabel,hlabel,oflabel : pasmlabel;
+         otlabel,hlabel,oflabel : tasmlabel;
          fputyp : tfloattype;
          loc : tloc;
          r : preference;
@@ -481,7 +477,7 @@ implementation
               exit;
            end;
 {$endif test_dest_loc}
-         if left.resulttype.def^.deftype=stringdef then
+         if left.resulttype.def.deftype=stringdef then
            begin
               if is_ansistring(left.resulttype.def) then
                 begin
@@ -572,7 +568,7 @@ implementation
                          if (right.nodetype=ordconstn) or
                             (loc=LOC_CREGISTER) then
                            begin
-                              case left.resulttype.def^.size of
+                              case left.resulttype.def.size of
                                  1 : opsize:=S_B;
                                  2 : opsize:=S_W;
                                  4 : opsize:=S_L;
@@ -625,7 +621,7 @@ implementation
                            end
                          else if loc=LOC_CFPUREGISTER then
                            begin
-                              floatloadops(pfloatdef(right.resulttype.def)^.typ,op,opsize);
+                              floatloadops(tfloatdef(right.resulttype.def).typ,op,opsize);
                               emit_ref(op,opsize,
                                 newreference(right.location.reference));
                               emit_reg(A_FSTP,S_NO,
@@ -633,16 +629,16 @@ implementation
                            end
                          else
                            begin
-                              if (right.resulttype.def^.needs_inittable) then
+                              if (right.resulttype.def.needs_inittable) then
                                 begin
                                    { this would be a problem }
-                                   if not(left.resulttype.def^.needs_inittable) then
+                                   if not(left.resulttype.def.needs_inittable) then
                                      internalerror(3457);
 
                                    { increment source reference counter }
                                    new(r);
                                    reset_reference(r^);
-                                   r^.symbol:=pstoreddef(right.resulttype.def)^.get_inittable_label;
+                                   r^.symbol:=tstoreddef(right.resulttype.def).get_inittable_label;
                                    emitpushreferenceaddr(r^);
 
                                    emitpushreferenceaddr(right.location.reference);
@@ -650,7 +646,7 @@ implementation
                                    { decrement destination reference counter }
                                    new(r);
                                    reset_reference(r^);
-                                   r^.symbol:=pstoreddef(left.resulttype.def)^.get_inittable_label;
+                                   r^.symbol:=tstoreddef(left.resulttype.def).get_inittable_label;
                                    emitpushreferenceaddr(r^);
                                    emitpushreferenceaddr(left.location.reference);
                                    emitcall('FPC_DECREF');
@@ -658,11 +654,11 @@ implementation
 
 {$ifdef regallocfix}
                               concatcopy(right.location.reference,
-                                left.location.reference,left.resulttype.def^.size,true,false);
+                                left.location.reference,left.resulttype.def.size,true,false);
                               ungetiftemp(right.location.reference);
 {$Else regallocfix}
                               concatcopy(right.location.reference,
-                                left.location.reference,left.resulttype.def^.size,false,false);
+                                left.location.reference,left.resulttype.def.size,false,false);
                               ungetiftemp(right.location.reference);
 {$endif regallocfix}
                            end;
@@ -681,7 +677,7 @@ implementation
 {$endif SUPPORT_MMX}
             LOC_REGISTER,
             LOC_CREGISTER : begin
-                              case right.resulttype.def^.size of
+                              case right.resulttype.def.size of
                                  1 : opsize:=S_B;
                                  2 : opsize:=S_W;
                                  4 : opsize:=S_L;
@@ -726,15 +722,15 @@ implementation
 
                            end;
             LOC_FPU : begin
-                              if (left.resulttype.def^.deftype=floatdef) then
-                               fputyp:=pfloatdef(left.resulttype.def)^.typ
+                              if (left.resulttype.def.deftype=floatdef) then
+                               fputyp:=tfloatdef(left.resulttype.def).typ
                               else
-                               if (right.resulttype.def^.deftype=floatdef) then
-                                fputyp:=pfloatdef(right.resulttype.def)^.typ
+                               if (right.resulttype.def.deftype=floatdef) then
+                                fputyp:=tfloatdef(right.resulttype.def).typ
                               else
                                if (right.nodetype=typeconvn) and
-                                  (ttypeconvnode(right).left.resulttype.def^.deftype=floatdef) then
-                                fputyp:=pfloatdef(ttypeconvnode(right).left.resulttype.def)^.typ
+                                  (ttypeconvnode(right).left.resulttype.def.deftype=floatdef) then
+                                fputyp:=tfloatdef(ttypeconvnode(right).left.resulttype.def).typ
                               else
                                 fputyp:=s32real;
                               case loc of
@@ -751,15 +747,15 @@ implementation
                               end;
                            end;
             LOC_CFPUREGISTER: begin
-                              if (left.resulttype.def^.deftype=floatdef) then
-                               fputyp:=pfloatdef(left.resulttype.def)^.typ
+                              if (left.resulttype.def.deftype=floatdef) then
+                               fputyp:=tfloatdef(left.resulttype.def).typ
                               else
-                               if (right.resulttype.def^.deftype=floatdef) then
-                                fputyp:=pfloatdef(right.resulttype.def)^.typ
+                               if (right.resulttype.def.deftype=floatdef) then
+                                fputyp:=tfloatdef(right.resulttype.def).typ
                               else
                                if (right.nodetype=typeconvn) and
-                                  (ttypeconvnode(right).left.resulttype.def^.deftype=floatdef) then
-                                fputyp:=pfloatdef(ttypeconvnode(right).left.resulttype.def)^.typ
+                                  (ttypeconvnode(right).left.resulttype.def.deftype=floatdef) then
+                                fputyp:=tfloatdef(ttypeconvnode(right).left.resulttype.def).typ
                               else
                                 fputyp:=s32real;
                               emit_reg(A_FLD,S_NO,
@@ -905,19 +901,19 @@ implementation
       var
         hp    : tarrayconstructornode;
         href  : treference;
-        lt    : pdef;
+        lt    : tdef;
         vaddr : boolean;
         vtype : longint;
         freetemp,
         dovariant : boolean;
         elesize : longint;
       begin
-        dovariant:=(nf_forcevaria in flags) or parraydef(resulttype.def)^.isvariant;
+        dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
         if dovariant then
          elesize:=8
         else
          begin
-           elesize:=parraydef(resulttype.def)^.elesize;
+           elesize:=tarraydef(resulttype.def).elesize;
            if elesize>4 then
             internalerror(8765678);
          end;
@@ -926,10 +922,10 @@ implementation
            reset_reference(location.reference);
            { Allocate always a temp, also if no elements are required, to
              be sure that location is valid (PFV) }
-            if parraydef(resulttype.def)^.highrange=-1 then
+            if tarraydef(resulttype.def).highrange=-1 then
               gettempofsizereference(elesize,location.reference)
             else
-              gettempofsizereference((parraydef(resulttype.def)^.highrange+1)*elesize,location.reference);
+              gettempofsizereference((tarraydef(resulttype.def).highrange+1)*elesize,location.reference);
            href:=location.reference;
          end;
         hp:=self;
@@ -947,13 +943,13 @@ implementation
                  vtype:=$ff;
                  vaddr:=false;
                  lt:=hp.left.resulttype.def;
-                 case lt^.deftype of
+                 case lt.deftype of
                    enumdef,
                    orddef :
                      begin
                        if is_64bitint(lt) then
                          begin
-                            case porddef(lt)^.typ of
+                            case torddef(lt).typ of
                                s64bit:
                                  vtype:=vtInt64;
                                u64bit:
@@ -962,14 +958,14 @@ implementation
                             freetemp:=false;
                             vaddr:=true;
                          end
-                       else if (lt^.deftype=enumdef) or
+                       else if (lt.deftype=enumdef) or
                          is_integer(lt) then
                          vtype:=vtInteger
                        else
                          if is_boolean(lt) then
                            vtype:=vtBoolean
                          else
-                           if (lt^.deftype=orddef) and (porddef(lt)^.typ=uchar) then
+                           if (lt.deftype=orddef) and (torddef(lt).typ=uchar) then
                              vtype:=vtChar;
                      end;
                    floatdef :
@@ -1072,7 +1068,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.12  2001-04-02 21:20:37  peter
+  Revision 1.13  2001-04-13 01:22:19  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.12  2001/04/02 21:20:37  peter
     * resulttype rewrite
 
   Revision 1.11  2000/12/25 00:07:33  peter

compiler/i386/n386mat.pas

@@ -68,7 +68,7 @@ implementation
          shrdiv, andmod, pushed,popeax,popedx : boolean;
 
          power : longint;
-         hl : pasmlabel;
+         hl : tasmlabel;
          hloc : tlocation;
          pushedreg : tpushed;
          typename,opname : string[6];
@@ -102,7 +102,7 @@ implementation
               clear_location(hloc);
               emit_pushq_loc(right.location);
 
-              if porddef(resulttype.def)^.typ=u64bit then
+              if torddef(resulttype.def).typ=u64bit then
                 typename:='QWORD'
               else
                 typename:='INT64';
@@ -260,13 +260,13 @@ implementation
                           end;
                      end;
                    { sign extension depends on the left type }
-                   if porddef(left.resulttype.def)^.typ=u32bit then
+                   if torddef(left.resulttype.def).typ=u32bit then
                       emit_reg_reg(A_XOR,S_L,R_EDX,R_EDX)
                    else
                       emit_none(A_CDQ,S_NO);
 
                    { division depends on the right type }
-                   if porddef(right.resulttype.def)^.typ=u32bit then
+                   if torddef(right.resulttype.def).typ=u32bit then
                      emit_reg(A_DIV,S_L,R_EDI)
                    else
                      emit_reg(A_IDIV,S_L,R_EDI);
@@ -340,7 +340,7 @@ implementation
          hregisterhigh,hregisterlow : tregister;
          pushed,popecx : boolean;
          op : tasmop;
-         l1,l2,l3 : pasmlabel;
+         l1,l2,l3 : tasmlabel;
 
       begin
          popecx:=false;
@@ -761,10 +761,10 @@ implementation
                  LOC_REFERENCE,LOC_MEM:
                                 begin
                                    del_reference(left.location.reference);
-                                   if (left.resulttype.def^.deftype=floatdef) then
+                                   if (left.resulttype.def.deftype=floatdef) then
                                      begin
                                         location.loc:=LOC_FPU;
-                                        floatload(pfloatdef(left.resulttype.def)^.typ,
+                                        floatload(tfloatdef(left.resulttype.def).typ,
                                           left.location.reference);
                                         emit_none(A_FCHS,S_NO);
                                      end
@@ -823,7 +823,7 @@ implementation
             (F_NE,F_E,F_LE,F_GE,F_L,F_G,F_NC,F_C,
              F_BE,F_B,F_AE,F_A);
       var
-         hl : pasmlabel;
+         hl : tasmlabel;
          opsize : topsize;
       begin
          if is_boolean(resulttype.def) then
@@ -998,7 +998,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.12  2001-04-04 22:37:06  peter
+  Revision 1.13  2001-04-13 01:22:19  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.12  2001/04/04 22:37:06  peter
     * fix for not with no 32bit values
 
   Revision 1.11  2001/04/02 21:20:38  peter

compiler/i386/n386mem.pas

@@ -105,7 +105,7 @@ implementation
       begin
          location.register:=getregister32;
          emit_sym_ofs_reg(A_MOV,
-            S_L,newasmsymbol(pobjectdef(pclassrefdef(resulttype.def)^.pointertype.def)^.vmt_mangledname),0,
+            S_L,newasmsymbol(tobjectdef(tclassrefdef(resulttype.def).pointertype.def).vmt_mangledname),0,
             location.register);
       end;
 
@@ -140,16 +140,16 @@ implementation
               gettempofsizereference(target_os.size_of_pointer,location.reference);
 
               { determines the size of the mem block }
-              push_int(ppointerdef(resulttype.def)^.pointertype.def^.size);
+              push_int(tpointerdef(resulttype.def).pointertype.def.size);
               emit_push_lea_loc(location,false);
               saveregvars($ff);
               emitcall('FPC_GETMEM');
 
-              if ppointerdef(resulttype.def)^.pointertype.def^.needs_inittable then
+              if tpointerdef(resulttype.def).pointertype.def.needs_inittable then
                 begin
                    new(r);
                    reset_reference(r^);
-                   r^.symbol:=pstoreddef(ppointerdef(resulttype.def)^.pointertype.def)^.get_inittable_label;
+                   r^.symbol:=tstoreddef(tpointerdef(resulttype.def).pointertype.def).get_inittable_label;
                    emitpushreferenceaddr(r^);
                    dispose(r);
                    { push pointer we just allocated, we need to initialize the
@@ -219,11 +219,11 @@ implementation
          case nodetype of
            simpledisposen:
              begin
-                if ppointerdef(left.resulttype.def)^.pointertype.def^.needs_inittable then
+                if tpointerdef(left.resulttype.def).pointertype.def.needs_inittable then
                   begin
                      new(r);
                      reset_reference(r^);
-                     r^.symbol:=pstoreddef(ppointerdef(left.resulttype.def)^.pointertype.def)^.get_inittable_label;
+                     r^.symbol:=tstoreddef(tpointerdef(left.resulttype.def).pointertype.def).get_inittable_label;
                      emitpushreferenceaddr(r^);
                      dispose(r);
                      { push pointer adress }
@@ -236,14 +236,14 @@ implementation
            simplenewn:
              begin
                 { determines the size of the mem block }
-                push_int(ppointerdef(left.resulttype.def)^.pointertype.def^.size);
+                push_int(tpointerdef(left.resulttype.def).pointertype.def.size);
                 emit_push_lea_loc(left.location,true);
                 emitcall('FPC_GETMEM');
-                if ppointerdef(left.resulttype.def)^.pointertype.def^.needs_inittable then
+                if tpointerdef(left.resulttype.def).pointertype.def.needs_inittable then
                   begin
                      new(r);
                      reset_reference(r^);
-                     r^.symbol:=pstoreddef(ppointerdef(left.resulttype.def)^.pointertype.def)^.get_inittable_label;
+                     r^.symbol:=tstoreddef(tpointerdef(left.resulttype.def).pointertype.def).get_inittable_label;
                      emitpushreferenceaddr(r^);
                      dispose(r);
                      emit_push_loc(left.location);
@@ -279,13 +279,13 @@ implementation
          {@ on a procvar means returning an address to the procedure that
            is stored in it.}
          { yes but left.symtableentry can be nil
-           for example on @self !! }
+           for example on self !! }
          { symtableentry can be also invalid, if left is no tree node }
          if (m_tp_procvar in aktmodeswitches) and
            (left.nodetype=loadn) and
            assigned(tloadnode(left).symtableentry) and
-           (tloadnode(left).symtableentry^.typ=varsym) and
-           (pvarsym(tloadnode(left).symtableentry)^.vartype.def^.deftype=procvardef) then
+           (tloadnode(left).symtableentry.typ=varsym) and
+           (tvarsym(tloadnode(left).symtableentry).vartype.def.deftype=procvardef) then
            emit_ref_reg(A_MOV,S_L,
              newreference(left.location.reference),
              location.register)
@@ -348,9 +348,9 @@ implementation
                  location.reference.base:=hr;
               end;
          end;
-         if ppointerdef(left.resulttype.def)^.is_far then
+         if tpointerdef(left.resulttype.def).is_far then
           location.reference.segment:=R_FS;
-         if not ppointerdef(left.resulttype.def)^.is_far and
+         if not tpointerdef(left.resulttype.def).is_far and
             (cs_gdb_heaptrc in aktglobalswitches) and
             (cs_checkpointer in aktglobalswitches) then
               begin
@@ -408,7 +408,7 @@ implementation
          else
            set_location(location,left.location);
 
-         inc(location.reference.offset,vs^.address);
+         inc(location.reference.offset,vs.address);
       end;
 
 
@@ -428,10 +428,10 @@ implementation
              get_mul_size:=1
             else
              begin
-               if (left.resulttype.def^.deftype=arraydef) then
-                get_mul_size:=parraydef(left.resulttype.def)^.elesize
+               if (left.resulttype.def.deftype=arraydef) then
+                get_mul_size:=tarraydef(left.resulttype.def).elesize
                else
-                get_mul_size:=resulttype.def^.size;
+                get_mul_size:=resulttype.def.size;
              end
           end;
 
@@ -462,10 +462,10 @@ implementation
          hp  : preference;
          href : treference;
          tai : Taicpu;
-         srsym : psym;
+         srsym : tsym;
          pushed : tpushed;
          hightree : tnode;
-         hl,otl,ofl : pasmlabel;
+         hl,otl,ofl : tasmlabel;
       begin
          secondpass(left);
          { we load the array reference to location }
@@ -571,21 +571,21 @@ implementation
            set_location(location,left.location);
 
          { offset can only differ from 0 if arraydef }
-         if (left.resulttype.def^.deftype=arraydef) and
+         if (left.resulttype.def.deftype=arraydef) and
            not(is_dynamic_array(left.resulttype.def)) then
            dec(location.reference.offset,
-               get_mul_size*parraydef(left.resulttype.def)^.lowrange);
+               get_mul_size*tarraydef(left.resulttype.def).lowrange);
          if right.nodetype=ordconstn then
            begin
               { offset can only differ from 0 if arraydef }
-              if (left.resulttype.def^.deftype=arraydef) then
+              if (left.resulttype.def.deftype=arraydef) then
                 begin
                    if not(is_open_array(left.resulttype.def)) and
                       not(is_array_of_const(left.resulttype.def)) and
                       not(is_dynamic_array(left.resulttype.def)) then
                      begin
-                        if (tordconstnode(right).value>parraydef(left.resulttype.def)^.highrange) or
-                           (tordconstnode(right).value<parraydef(left.resulttype.def)^.lowrange) then
+                        if (tordconstnode(right).value>tarraydef(left.resulttype.def).highrange) or
+                           (tordconstnode(right).value<tarraydef(left.resulttype.def).lowrange) then
                            begin
                               if (cs_check_range in aktlocalswitches) then
                                 CGMessage(parser_e_range_check_error)
@@ -593,7 +593,7 @@ implementation
                                 CGMessage(parser_w_range_check_error);
                            end;
                         dec(left.location.reference.offset,
-                            get_mul_size*parraydef(left.resulttype.def)^.lowrange);
+                            get_mul_size*tarraydef(left.resulttype.def).lowrange);
                      end
                    else
                      begin
@@ -602,13 +602,13 @@ implementation
                         {!!!!!!!!!!!!!!!!!}
                      end;
                 end
-              else if (left.resulttype.def^.deftype=stringdef) then
+              else if (left.resulttype.def.deftype=stringdef) then
                 begin
                    if (tordconstnode(right).value=0) and not(is_shortstring(left.resulttype.def)) then
                      CGMessage(cg_e_can_access_element_zero);
 
                    if (cs_check_range in aktlocalswitches) then
-                     case pstringdef(left.resulttype.def)^.string_typ of
+                     case tstringdef(left.resulttype.def).string_typ of
                         { it's the same for ansi- and wide strings }
                         st_widestring,
                         st_ansistring:
@@ -656,7 +656,7 @@ implementation
               { need that fancy code (it would be }
               { buggy)                            }
                 not(cs_check_range in aktlocalswitches) and
-                (left.resulttype.def^.deftype=arraydef) then
+                (left.resulttype.def.deftype=arraydef) then
                 begin
                    extraoffset:=0;
                    if (right.nodetype=addn) then
@@ -733,18 +733,18 @@ implementation
 
               if cs_check_range in aktlocalswitches then
                begin
-                 if left.resulttype.def^.deftype=arraydef then
+                 if left.resulttype.def.deftype=arraydef then
                    begin
                      if is_open_array(left.resulttype.def) or
                         is_array_of_const(left.resulttype.def) then
                       begin
                         reset_reference(href);
-                        parraydef(left.resulttype.def)^.genrangecheck;
-                        href.symbol:=newasmsymbol(parraydef(left.resulttype.def)^.getrangecheckstring);
+                        tarraydef(left.resulttype.def).genrangecheck;
+                        href.symbol:=newasmsymbol(tarraydef(left.resulttype.def).getrangecheckstring);
                         href.offset:=4;
                         srsym:=searchsymonlyin(tloadnode(left).symtable,
-                          'high'+pvarsym(tloadnode(left).symtableentry)^.name);
-                        hightree:=cloadnode.create(pvarsym(srsym),tloadnode(left).symtable);
+                          'high'+tvarsym(tloadnode(left).symtableentry).name);
+                        hightree:=cloadnode.create(tvarsym(srsym),tloadnode(left).symtable);
                         firstpass(hightree);
                         secondpass(hightree);
                         emit_mov_loc_ref(hightree.location,href,S_L,true);
@@ -759,7 +759,7 @@ implementation
                  LOC_REGISTER:
                    begin
                       ind:=right.location.register;
-                      case right.resulttype.def^.size of
+                      case right.resulttype.def.size of
                          1:
                            begin
                               hr:=reg8toreg32(ind);
@@ -777,7 +777,7 @@ implementation
                  LOC_CREGISTER:
                    begin
                       ind:=getregister32;
-                      case right.resulttype.def^.size of
+                      case right.resulttype.def.size of
                          1:
                            emit_reg_reg(A_MOVZX,S_BL,right.location.register,ind);
                          2:
@@ -811,7 +811,7 @@ implementation
                       ind:=getregister32;
                       { Booleans are stored in an 8 bit memory location, so
                         the use of MOVL is not correct }
-                      case right.resulttype.def^.size of
+                      case right.resulttype.def.size of
                        1 : tai:=Taicpu.Op_ref_reg(A_MOVZX,S_BL,newreference(right.location.reference),ind);
                        2 : tai:=Taicpu.Op_ref_reg(A_MOVZX,S_WL,newreference(right.location.reference),ind);
                        4 : tai:=Taicpu.Op_ref_reg(A_MOV,S_L,newreference(right.location.reference),ind);
@@ -825,13 +825,13 @@ implementation
             { produce possible range check code: }
               if cs_check_range in aktlocalswitches then
                begin
-                 if left.resulttype.def^.deftype=arraydef then
+                 if left.resulttype.def.deftype=arraydef then
                    begin
                      { done defore (PM) }
                    end
-                 else if (left.resulttype.def^.deftype=stringdef) then
+                 else if (left.resulttype.def.deftype=stringdef) then
                    begin
-                      case pstringdef(left.resulttype.def)^.string_typ of
+                      case tstringdef(left.resulttype.def).string_typ of
                          { it's the same for ansi- and wide strings }
                          st_widestring,
                          st_ansistring:
@@ -906,7 +906,7 @@ implementation
       begin
          reset_reference(location.reference);
          getexplicitregister32(R_ESI);
-         if (resulttype.def^.deftype=classrefdef) or
+         if (resulttype.def.deftype=classrefdef) or
            is_class(resulttype.def) then
            location.register:=R_ESI
          else
@@ -922,7 +922,7 @@ implementation
       var
         usetemp,with_expr_in_temp : boolean;
 {$ifdef GDB}
-        withstartlabel,withendlabel : pasmlabel;
+        withstartlabel,withendlabel : tasmlabel;
         pp : pchar;
         mangled_length  : longint;
 
@@ -940,7 +940,7 @@ implementation
 
                usetemp:=false;
                if (left.nodetype=loadn) and
-                  (tloadnode(left).symtable=aktprocsym^.definition^.localst) then
+                  (tloadnode(left).symtable=aktprocsym.definition.localst) then
                  begin
                     { for locals use the local storage }
                     withreference^:=left.location.reference;
@@ -950,17 +950,13 @@ implementation
                 { call can have happend with a property }
                 if is_class_or_interface(left.resulttype.def) then
                  begin
-{$ifndef noAllocEdi}
                     getexplicitregister32(R_EDI);
-{$endif noAllocEdi}
                     emit_mov_loc_reg(left.location,R_EDI);
                     usetemp:=true;
                  end
                else
                  begin
-{$ifndef noAllocEdi}
                    getexplicitregister32(R_EDI);
-{$endif noAllocEdi}
                    emit_lea_loc_reg(left.location,R_EDI,false);
                    usetemp:=true;
                  end;
@@ -986,9 +982,7 @@ implementation
                   normaltemptopersistant(withreference^.offset);
                   { move to temp reference }
                   emit_reg_ref(A_MOV,S_L,R_EDI,newreference(withreference^));
-{$ifndef noAllocEdi}
                   ungetregister32(R_EDI);
-{$endif noAllocEdi}
 {$ifdef GDB}
                   if (cs_debuginfo in aktmoduleswitches) then
                     begin
@@ -997,16 +991,16 @@ implementation
                       getaddrlabel(withendlabel);
                       emitlab(withstartlabel);
                       withdebugList.concat(Tai_stabs.Create(strpnew(
-                         '"with'+tostr(withlevel)+':'+tostr(symtablestack^.getnewtypecount)+
-                         '=*'+pstoreddef(left.resulttype.def)^.numberstring+'",'+
+                         '"with'+tostr(withlevel)+':'+tostr(symtablestack.getnewtypecount)+
+                         '=*'+tstoreddef(left.resulttype.def).numberstring+'",'+
                          tostr(N_LSYM)+',0,0,'+tostr(withreference^.offset))));
-                      mangled_length:=length(aktprocsym^.definition^.mangledname);
+                      mangled_length:=length(aktprocsym.definition.mangledname);
                       getmem(pp,mangled_length+50);
-                      strpcopy(pp,'192,0,0,'+withstartlabel^.name);
+                      strpcopy(pp,'192,0,0,'+withstartlabel.name);
                       if (target_os.use_function_relative_addresses) then
                         begin
                           strpcopy(strend(pp),'-');
-                          strpcopy(strend(pp),aktprocsym^.definition^.mangledname);
+                          strpcopy(strend(pp),aktprocsym.definition.mangledname);
                         end;
                       withdebugList.concat(Tai_stabn.Create(strnew(pp)));
                     end;
@@ -1024,11 +1018,11 @@ implementation
                    if (cs_debuginfo in aktmoduleswitches) then
                      begin
                        emitlab(withendlabel);
-                       strpcopy(pp,'224,0,0,'+withendlabel^.name);
+                       strpcopy(pp,'224,0,0,'+withendlabel.name);
                       if (target_os.use_function_relative_addresses) then
                         begin
                           strpcopy(strend(pp),'-');
-                          strpcopy(strend(pp),aktprocsym^.definition^.mangledname);
+                          strpcopy(strend(pp),aktprocsym.definition.mangledname);
                         end;
                        withdebugList.concat(Tai_stabn.Create(strnew(pp)));
                        freemem(pp,mangled_length+50);
@@ -1061,7 +1055,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.11  2001-04-02 21:20:38  peter
+  Revision 1.12  2001-04-13 01:22:19  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.11  2001/04/02 21:20:38  peter
     * resulttype rewrite
 
   Revision 1.10  2001/03/11 22:58:52  peter

compiler/i386/n386opt.pas

@@ -82,7 +82,7 @@ end;
 
 procedure ti386addsstringcharoptnode.pass_2;
 var
-  l: pasmlabel;
+  l: tasmlabel;
   href2: preference;
   href:  treference;
   hreg, lengthreg: tregister;
@@ -135,7 +135,7 @@ begin
   if istemp(left.location.reference) then
     checklength := curmaxlen = 255
   else
-    checklength := curmaxlen >= pstringdef(left.resulttype.def)^.len;
+    checklength := curmaxlen >= tstringdef(left.resulttype.def).len;
   if checklength then
     begin
       { is it already maximal? }
@@ -143,7 +143,7 @@ begin
       if istemp(left.location.reference) then
         emit_const_reg(A_CMP,S_L,255,lengthreg)
       else
-        emit_const_reg(A_CMP,S_L,pstringdef(left.resulttype.def)^.len,lengthreg);
+        emit_const_reg(A_CMP,S_L,tstringdef(left.resulttype.def).len,lengthreg);
       emitjmp(C_E,l);
     end;
 
@@ -248,7 +248,12 @@ end.
 
 {
   $Log$
-  Revision 1.3  2001-04-02 21:20:38  peter
+  Revision 1.4  2001-04-13 01:22:19  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.3  2001/04/02 21:20:38  peter
     * resulttype rewrite
 
   Revision 1.2  2001/01/06 19:12:31  jonas

compiler/i386/n386set.pas

@@ -101,7 +101,7 @@ implementation
          i,numparts : byte;
          adjustment : longint;
          {href,href2 : Treference;}
-         l,l2       : pasmlabel;
+         l,l2       : tasmlabel;
 {$ifdef CORRECT_SET_IN_FPC}
          AM         : tasmop;
 {$endif CORRECT_SET_IN_FPC}
@@ -172,9 +172,9 @@ implementation
 
          { check if we can use smallset operation using btl which is limited
            to 32 bits, the left side may also not contain higher values !! }
-         use_small:=(psetdef(right.resulttype.def)^.settype=smallset) and
-                    ((left.resulttype.def^.deftype=orddef) and (porddef(left.resulttype.def)^.high<=32) or
-                     (left.resulttype.def^.deftype=enumdef) and (penumdef(left.resulttype.def)^.max<=32));
+         use_small:=(tsetdef(right.resulttype.def).settype=smallset) and
+                    ((left.resulttype.def.deftype=orddef) and (torddef(left.resulttype.def).high<=32) or
+                     (left.resulttype.def.deftype=enumdef) and (tenumdef(left.resulttype.def).max<=32));
 
          { Can we generate jumps? Possible for all types of sets }
          genjumps:=(right.nodetype=setconstn) and
@@ -531,7 +531,7 @@ implementation
          hp : tnode;
          { register with case expression }
          hregister,hregister2 : tregister;
-         endlabel,elselabel : pasmlabel;
+         endlabel,elselabel : tasmlabel;
 
          { true, if we can omit the range check of the jump table }
          jumptable_no_range : boolean;
@@ -542,7 +542,7 @@ implementation
       procedure gentreejmp(p : pcaserecord);
 
         var
-           lesslabel,greaterlabel : pasmlabel;
+           lesslabel,greaterlabel : tasmlabel;
 
        begin
          emitlab(p^._at);
@@ -592,7 +592,7 @@ implementation
         procedure genitem(t : pcaserecord);
 
           var
-             l1 : pasmlabel;
+             l1 : tasmlabel;
 
           begin
              if assigned(t^.less) then
@@ -753,7 +753,7 @@ implementation
       procedure genjumptable(hp : pcaserecord;min_,max_ : longint);
 
         var
-           table : pasmlabel;
+           table : tasmlabel;
            last : TConstExprInt;
            hr : preference;
 
@@ -830,7 +830,7 @@ implementation
          max_label: tconstexprint;
          lv,hv,labels : longint;
          max_linear_list : longint;
-         otl, ofl: pasmlabel;
+         otl, ofl: tasmlabel;
 {$ifdef Delphi}
          dist : cardinal;
 {$else Delphi}
@@ -870,7 +870,7 @@ implementation
            end;
          secondpass(left);
          { determines the size of the operand }
-         opsize:=bytes2Sxx[left.resulttype.def^.size];
+         opsize:=bytes2Sxx[left.resulttype.def.size];
          { copy the case expression to a register }
          case left.location.loc of
             LOC_REGISTER:
@@ -1065,7 +1065,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.13  2001-04-06 14:09:34  jonas
+  Revision 1.14  2001-04-13 01:22:19  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.13  2001/04/06 14:09:34  jonas
     * fixed bug in ti386innode.pass_2 code and made it simpler/faster
 
   Revision 1.12  2001/04/02 21:20:38  peter

compiler/i386/n386util.pas

@@ -47,14 +47,14 @@ interface
 
     procedure maketojumpbool(p : tnode);
     procedure emitoverflowcheck(p:tnode);
-    procedure emitrangecheck(p:tnode;todef:pdef);
+    procedure emitrangecheck(p:tnode;todef:tdef);
     procedure firstcomplex(p : tbinarynode);
 
 implementation
 
     uses
        globtype,globals,systems,verbose,
-       cutils,cobjects,
+       cutils,
        aasm,cpubase,cpuasm,
        symconst,symbase,symdef,symsym,symtable,
 {$ifdef GDB}
@@ -347,13 +347,13 @@ implementation
         op : tasmop;
         hreg : tregister;
         size : longint;
-        hlabel : pasmlabel;
+        hlabel : tasmlabel;
       begin
         case p.location.loc of
            LOC_REGISTER,
            LOC_CREGISTER:
              begin
-                  if p.resulttype.def^.size=8 then
+                  if p.resulttype.def.size=8 then
                     begin
                        inc(pushedparasize,8);
                        if inlined then
@@ -437,7 +437,7 @@ implementation
              end;
            LOC_FPU:
              begin
-                size:=align(pfloatdef(p.resulttype.def)^.size,alignment);
+                size:=align(tfloatdef(p.resulttype.def).size,alignment);
                 inc(pushedparasize,size);
                 if not inlined then
                  emit_const_reg(A_SUB,S_L,size,R_ESP);
@@ -447,7 +447,7 @@ implementation
                   exprasmList.concat(Tai_force_line.Create);
 {$endif GDB}
                 r:=new_reference(R_ESP,0);
-                floatstoreops(pfloatdef(p.resulttype.def)^.typ,op,opsize);
+                floatstoreops(tfloatdef(p.resulttype.def).typ,op,opsize);
                 { this is the easiest case for inlined !! }
                 if inlined then
                   begin
@@ -461,7 +461,7 @@ implementation
              begin
                 exprasmList.concat(Taicpu.Op_reg(A_FLD,S_NO,
                   correct_fpuregister(p.location.register,fpuvaroffset)));
-                size:=align(pfloatdef(p.resulttype.def)^.size,alignment);
+                size:=align(tfloatdef(p.resulttype.def).size,alignment);
                 inc(pushedparasize,size);
                 if not inlined then
                  emit_const_reg(A_SUB,S_L,size,R_ESP);
@@ -471,7 +471,7 @@ implementation
                   exprasmList.concat(Tai_force_line.Create);
 {$endif GDB}
                 r:=new_reference(R_ESP,0);
-                floatstoreops(pfloatdef(p.resulttype.def)^.typ,op,opsize);
+                floatstoreops(tfloatdef(p.resulttype.def).typ,op,opsize);
                 { this is the easiest case for inlined !! }
                 if inlined then
                   begin
@@ -484,11 +484,11 @@ implementation
              begin
                 tempreference:=p.location.reference;
                 del_reference(p.location.reference);
-                case p.resulttype.def^.deftype of
+                case p.resulttype.def.deftype of
                   enumdef,
                   orddef :
                     begin
-                      case p.resulttype.def^.size of
+                      case p.resulttype.def.size of
                        8 : begin
                              inc(pushedparasize,8);
                              if inlined then
@@ -552,7 +552,7 @@ implementation
                                 ungetregister32(R_EDI);
                               end
                              else
-                              emit_push_mem_size(tempreference,p.resulttype.def^.size);
+                              emit_push_mem_size(tempreference,p.resulttype.def.size);
                            end;
                          else
                            internalerror(234231);
@@ -560,7 +560,7 @@ implementation
                     end;
                   floatdef :
                     begin
-                      case pfloatdef(p.resulttype.def)^.typ of
+                      case tfloatdef(p.resulttype.def).typ of
                         s32real :
                           begin
                              inc(pushedparasize,4);
@@ -693,20 +693,20 @@ implementation
                        if is_widestring(p.resulttype.def) or
                           is_ansistring(p.resulttype.def) or
                           is_smallset(p.resulttype.def) or
-                          ((p.resulttype.def^.deftype in [recorddef,arraydef]) and
+                          ((p.resulttype.def.deftype in [recorddef,arraydef]) and
                            (
-                            (p.resulttype.def^.deftype<>arraydef) or not
-                            (parraydef(p.resulttype.def)^.IsConstructor or
-                             parraydef(p.resulttype.def)^.isArrayOfConst or
+                            (p.resulttype.def.deftype<>arraydef) or not
+                            (tarraydef(p.resulttype.def).IsConstructor or
+                             tarraydef(p.resulttype.def).isArrayOfConst or
                              is_open_array(p.resulttype.def))
                            ) and
-                           (p.resulttype.def^.size<=4)
+                           (p.resulttype.def.size<=4)
                           ) or
                           is_class(p.resulttype.def) or
                           is_interface(p.resulttype.def) then
                          begin
-                            if (p.resulttype.def^.size>2) or
-                               ((alignment=4) and (p.resulttype.def^.size>0)) then
+                            if (p.resulttype.def.size>2) or
+                               ((alignment=4) and (p.resulttype.def.size>0)) then
                               begin
                                 inc(pushedparasize,4);
                                 if inlined then
@@ -719,7 +719,7 @@ implementation
                               end
                             else
                               begin
-                                if p.resulttype.def^.size>0 then
+                                if p.resulttype.def.size>0 then
                                   begin
                                     inc(pushedparasize,2);
                                     if inlined then
@@ -736,7 +736,7 @@ implementation
                        else if is_cdecl then
                          begin
                            { push on stack }
-                           size:=align(p.resulttype.def^.size,alignment);
+                           size:=align(p.resulttype.def.size,alignment);
                            inc(pushedparasize,size);
                            emit_const_reg(A_SUB,S_L,size,R_ESP);
                            r:=new_reference(R_ESP,0);
@@ -904,14 +904,14 @@ implementation
     { produces if necessary overflowcode }
     procedure emitoverflowcheck(p:tnode);
       var
-         hl : pasmlabel;
+         hl : tasmlabel;
       begin
          if not(cs_check_overflow in aktlocalswitches) then
           exit;
          getlabel(hl);
-         if not ((p.resulttype.def^.deftype=pointerdef) or
-                ((p.resulttype.def^.deftype=orddef) and
-                 (porddef(p.resulttype.def)^.typ in [u64bit,u16bit,u32bit,u8bit,uchar,
+         if not ((p.resulttype.def.deftype=pointerdef) or
+                ((p.resulttype.def.deftype=orddef) and
+                 (torddef(p.resulttype.def).typ in [u64bit,u16bit,u32bit,u8bit,uchar,
                                                   bool8bit,bool16bit,bool32bit]))) then
            emitjmp(C_NO,hl)
          else
@@ -922,16 +922,16 @@ implementation
 
     { produces range check code, while one of the operands is a 64 bit
       integer }
-    procedure emitrangecheck64(p : tnode;todef : pdef);
+    procedure emitrangecheck64(p : tnode;todef : tdef);
 
       var
         neglabel,
         poslabel,
-        endlabel: pasmlabel;
+        endlabel: tasmlabel;
         href   : preference;
         hreg   : tregister;
-        hdef   :  porddef;
-        fromdef : pdef;
+        hdef   :  torddef;
+        fromdef : tdef;
         opcode : tasmop;
         opsize   : topsize;
         oldregisterdef: boolean;
@@ -978,11 +978,11 @@ implementation
              { if the high dword = 0, the low dword can be considered a }
              { simple cardinal                                          }
              emitlab(poslabel);
-             new(hdef,init(u32bit,0,longint($ffffffff)));
+             hdef:=torddef.create(u32bit,0,longint($ffffffff));
              { the real p.resulttype.def is already saved in fromdef }
              p.resulttype.def := hdef;
              emitrangecheck(p,todef);
-             dispose(hdef,done);
+             hdef.free;
              { restore original resulttype.def }
              p.resulttype.def := todef;
 
@@ -1013,10 +1013,10 @@ implementation
                  { if we get here, the 64bit value lies between }
                  { longint($80000000) and -1 (JM)               }
                  emitlab(neglabel);
-                 new(hdef,init(s32bit,longint($80000000),-1));
+                 hdef:=torddef.create(s32bit,longint($80000000),-1);
                  p.resulttype.def := hdef;
                  emitrangecheck(p,todef);
-                 dispose(hdef,done);
+                 hdef.free;
                  emitlab(endlabel);
                end;
              registerdef := oldregisterdef;
@@ -1032,7 +1032,7 @@ implementation
               { also not if the fromdef is unsigned and < 64bit, since that will }
               { always fit in a 64bit int (todef is 64bit)                       }
               (from_signed or
-               (porddef(fromdef)^.typ = u64bit)) then
+               (torddef(fromdef).typ = u64bit)) then
              begin
                { in all cases, there is only a problem if the higest bit is set }
                if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
@@ -1043,7 +1043,7 @@ implementation
                else
                  begin
                    hreg := getexplicitregister32(R_EDI);
-                   case p.resulttype.def^.size of
+                   case p.resulttype.def.size of
                      1: opsize := S_BL;
                      2: opsize := S_WL;
                      4,8: opsize := S_L;
@@ -1055,7 +1055,7 @@ implementation
                    else
                      opcode := A_MOV;
                    href := newreference(p.location.reference);
-                   if p.resulttype.def^.size = 8 then
+                   if p.resulttype.def.size = 8 then
                      inc(href^.offset,4);
                    emit_ref_reg(opcode,opsize,href,hreg);
                  end;
@@ -1070,7 +1070,7 @@ implementation
       end;
 
      { produces if necessary rangecheckcode }
-     procedure emitrangecheck(p:tnode;todef:pdef);
+     procedure emitrangecheck(p:tnode;todef:tdef);
      {
        generate range checking code for the value at location t. The
        type used is the checked against todefs ranges. fromdef (p.resulttype.def)
@@ -1078,17 +1078,17 @@ implementation
        equal the check is also insert (needed for succ,pref,inc,dec)
      }
       var
-        neglabel : pasmlabel;
+        neglabel : tasmlabel;
         opsize : topsize;
         op     : tasmop;
-        fromdef : pdef;
+        fromdef : tdef;
         lto,hto,
         lfrom,hfrom : longint;
         is_reg : boolean;
       begin
         { range checking on and range checkable value? }
         if not(cs_check_range in aktlocalswitches) or
-           not(todef^.deftype in [orddef,enumdef,arraydef]) then
+           not(todef.deftype in [orddef,enumdef,arraydef]) then
           exit;
         { only check when assigning to scalar, subranges are different,
           when todef=fromdef then the check is always generated }
@@ -1097,12 +1097,12 @@ implementation
         { int64/qword, since such operations can at most cause overflows (JM)   }
         if (fromdef = todef) and
           { then fromdef and todef can only be orddefs }
-           (((porddef(fromdef)^.typ = s32bit) and
-             (porddef(fromdef)^.low = longint($80000000)) and
-             (porddef(fromdef)^.high = $7fffffff)) or
-            ((porddef(fromdef)^.typ = u32bit) and
-             (porddef(fromdef)^.low = 0) and
-             (porddef(fromdef)^.high = longint($ffffffff))) or
+           (((torddef(fromdef).typ = s32bit) and
+             (torddef(fromdef).low = longint($80000000)) and
+             (torddef(fromdef).high = $7fffffff)) or
+            ((torddef(fromdef).typ = u32bit) and
+             (torddef(fromdef).low = 0) and
+             (torddef(fromdef).high = longint($ffffffff))) or
             is_64bitint(fromdef)) then
           exit;
         if is_64bitint(fromdef) or is_64bitint(todef) then
@@ -1208,8 +1208,8 @@ implementation
       begin
          { always calculate boolean AND and OR from left to right }
          if (p.nodetype in [orn,andn]) and
-            (p.left.resulttype.def^.deftype=orddef) and
-            (porddef(p.left.resulttype.def)^.typ in [bool8bit,bool16bit,bool32bit]) then
+            (p.left.resulttype.def.deftype=orddef) and
+            (torddef(p.left.resulttype.def).typ in [bool8bit,bool16bit,bool32bit]) then
            begin
              { p.swaped:=false}
              if nf_swaped in p.flags then
@@ -1242,12 +1242,12 @@ implementation
     procedure push_shortstring_length(p:tnode);
       var
         hightree : tnode;
-        srsym    : psym;
+        srsym    : tsym;
       begin
         if is_open_string(p.resulttype.def) then
          begin
-           srsym:=searchsymonlyin(tloadnode(p).symtable,'high'+pvarsym(tloadnode(p).symtableentry)^.name);
-           hightree:=cloadnode.create(pvarsym(srsym),tloadnode(p).symtable);
+           srsym:=searchsymonlyin(tloadnode(p).symtable,'high'+tvarsym(tloadnode(p).symtableentry).name);
+           hightree:=cloadnode.create(tvarsym(srsym),tloadnode(p).symtable);
            firstpass(hightree);
            secondpass(hightree);
            push_value_para(hightree,false,false,0,4);
@@ -1256,7 +1256,7 @@ implementation
          end
         else
          begin
-           push_int(pstringdef(p.resulttype.def)^.len);
+           push_int(tstringdef(p.resulttype.def).len);
          end;
       end;
 
@@ -1271,7 +1271,7 @@ implementation
       var
         href: treference;
       begin
-         case source.resulttype.def^.deftype of
+         case source.resulttype.def.deftype of
             stringdef:
               begin
                  if (source.nodetype=stringconstn) and
@@ -1332,7 +1332,7 @@ implementation
          r : preference;
 
       begin
-         case p.right.resulttype.def^.deftype of
+         case p.right.resulttype.def.deftype of
             stringdef:
               begin
                  if (p.right.nodetype=stringconstn) and
@@ -1472,7 +1472,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.14  2001-04-02 21:20:39  peter
+  Revision 1.15  2001-04-13 01:22:19  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.14  2001/04/02 21:20:39  peter
     * resulttype rewrite
 
   Revision 1.13  2001/03/11 22:58:52  peter

compiler/i386/popt386.pas

@@ -445,9 +445,9 @@ Var
    jmp l3               jmp l3}
 
   Var p1, p2: Tai;
-      l: pasmlabel;
+      l: tasmlabel;
 
-    Function FindAnyLabel(hp: Tai; var l: pasmlabel): Boolean;
+    Function FindAnyLabel(hp: Tai; var l: tasmlabel): Boolean;
     Begin
       FindAnyLabel := false;
       While assigned(hp.next) and
@@ -462,11 +462,11 @@ Var
     End;
 
   Begin
-    If (pasmlabel(hp.oper[0].sym)^.labelnr >= LoLab) and
-       (pasmlabel(hp.oper[0].sym)^.labelnr <= HiLab) and   {range check, a jump can go past an assembler block!}
-       Assigned(LTable^[pasmlabel(hp.oper[0].sym)^.labelnr-LoLab].TaiObj) Then
+    If (tasmlabel(hp.oper[0].sym).labelnr >= LoLab) and
+       (tasmlabel(hp.oper[0].sym).labelnr <= HiLab) and   {range check, a jump can go past an assembler block!}
+       Assigned(LTable^[tasmlabel(hp.oper[0].sym).labelnr-LoLab].TaiObj) Then
       Begin
-        p1 := LTable^[pasmlabel(hp.oper[0].sym)^.labelnr-LoLab].TaiObj; {the jump's destination}
+        p1 := LTable^[tasmlabel(hp.oper[0].sym).labelnr-LoLab].TaiObj; {the jump's destination}
         SkipLabels(p1,p1);
         If (Tai(p1).typ = ait_instruction) and
            (Taicpu(p1).is_jmp) Then
@@ -486,9 +486,9 @@ Var
               SkipLabels(p1,p1)) Then
             Begin
               GetFinalDestination(asml, Taicpu(p1));
-              Dec(pasmlabel(hp.oper[0].sym)^.refs);
+              Dec(tasmlabel(hp.oper[0].sym).refs);
               hp.oper[0].sym:=Taicpu(p1).oper[0].sym;
-              inc(pasmlabel(hp.oper[0].sym)^.refs);
+              inc(tasmlabel(hp.oper[0].sym).refs);
             End
           Else
             If (Taicpu(p1).condition = inverse_cond[hp.condition]) then
@@ -500,9 +500,9 @@ Var
   {$endif finaldestdebug}
                   getlabel(l);
                   insertllitem(asml,p1,p1.next,Tai_label.Create(l));
-                  dec(pasmlabel(Taicpu(hp).oper[0].sym)^.refs);
+                  dec(tasmlabel(Taicpu(hp).oper[0].sym).refs);
                   hp.oper[0].sym := l;
-                  inc(l^.refs);
+                  inc(l.refs);
   {               this won't work, since the new label isn't in the labeltable }
   {               so it will fail the rangecheck. Labeltable should become a   }
   {               hashtable to support this:                                   }
@@ -514,7 +514,7 @@ Var
                   insertllitem(asml,p1,p1.next,Tai_asm_comment.Create(
                     strpnew('next label reused'))));
   {$endif finaldestdebug}
-                  inc(l^.refs);
+                  inc(l.refs);
                   hp.oper[0].sym := l;
                   GetFinalDestination(asml, hp);
                 end;
@@ -594,7 +594,7 @@ Begin
                { remove jumps to a label coming right after them }
                If GetNextInstruction(p, hp1) then
                  Begin
-                   if FindLabel(pasmlabel(Taicpu(p).oper[0].sym), hp1) then
+                   if FindLabel(tasmlabel(Taicpu(p).oper[0].sym), hp1) then
                      Begin
                        hp2:=Tai(hp1.next);
                        asml.remove(p);
@@ -609,7 +609,7 @@ Begin
                        If (Tai(hp1).typ=ait_instruction) and
                           (Taicpu(hp1).opcode=A_JMP) and
                           GetNextInstruction(hp1, hp2) And
-                          FindLabel(PAsmLabel(Taicpu(p).oper[0].sym), hp2)
+                          FindLabel(tasmlabel(Taicpu(p).oper[0].sym), hp2)
                          Then
                            Begin
                              if Taicpu(p).opcode=A_Jcc then
@@ -621,9 +621,9 @@ Begin
                                 p:=Tai(p.next);
                                 continue;
                               end;
-                             Dec(Tai_label(hp2).l^.refs);
+                             Dec(Tai_label(hp2).l.refs);
                              Taicpu(p).oper[0].sym:=Taicpu(hp1).oper[0].sym;
-                             Inc(Taicpu(p).oper[0].sym^.refs);
+                             Inc(Taicpu(p).oper[0].sym.refs);
                              asml.remove(hp1);
                              hp1.free;
                              If (LabDif <> 0) Then
@@ -699,7 +699,7 @@ Begin
                        (Taicpu(hp3).is_jmp) and
                        (Taicpu(hp3).opcode = A_JMP) And
                        GetNextInstruction(hp3, hp4) And
-                       FindLabel(PAsmLabel(Taicpu(hp1).oper[0].sym),hp4)
+                       FindLabel(tasmlabel(Taicpu(hp1).oper[0].sym),hp4)
                       Then
                         Begin
                           Taicpu(hp2).Opcode := A_SUB;
@@ -1688,7 +1688,7 @@ Begin
                        end;
                      if assigned(hp1) then
                        begin
-                          if FindLabel(PAsmLabel(Taicpu(p).oper[0].sym),hp1) then
+                          if FindLabel(tasmlabel(Taicpu(p).oper[0].sym),hp1) then
                             begin
                                if (l<=4) and (l>0) then
                                  begin
@@ -1728,7 +1728,7 @@ Begin
                                 (hp2.typ=ait_instruction) and
                                 (Taicpu(hp2).is_jmp) and
                                 (Taicpu(hp2).condition=C_None) and
-                                FindLabel(PAsmLabel(Taicpu(p).oper[0].sym),hp1) then
+                                FindLabel(tasmlabel(Taicpu(p).oper[0].sym),hp1) then
                                  begin
                                     l:=0;
                                     while assigned(hp1) And
@@ -1740,7 +1740,7 @@ Begin
                                  end;
                               {
                               if assigned(hp1) and
-                                FindLabel(PAsmLabel(Taicpu(hp2).oper[0].sym),hp1) then
+                                FindLabel(tasmlabel(Taicpu(hp2).oper[0].sym),hp1) then
                                 begin
                                    condition:=inverse_cond[Taicpu(p).condition];
                                    GetNextInstruction(p,hp1);
@@ -2008,7 +2008,12 @@ End.
 
 {
   $Log$
-  Revision 1.12  2001-04-06 14:06:03  jonas
+  Revision 1.13  2001-04-13 01:22:19  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.12  2001/04/06 14:06:03  jonas
     * fixed incompatibility between new regvar handling and -Op2
 
   Revision 1.11  2001/04/02 21:20:39  peter

compiler/i386/ra386.pas

@@ -37,21 +37,19 @@ Function CheckOverride(overrideop,op:tasmop): Boolean;
 Procedure FWaitWarning;
 
 type
-  P386Operand=^T386Operand;
-  T386Operand=object(TOperand)
-    Procedure SetCorrectSize(opcode:tasmop);virtual;
-    Function SetupResult : boolean;virtual;
+  T386Operand=class(TOperand)
+    Procedure SetCorrectSize(opcode:tasmop);override;
+    Function SetupResult : boolean;override;
   end;
 
-  P386Instruction=^T386Instruction;
-  T386Instruction=object(TInstruction)
+  T386Instruction=class(TInstruction)
     { Operand sizes }
     procedure AddReferenceSizes;
     procedure SetInstructionOpsize;
     procedure CheckOperandSizes;
     procedure CheckNonCommutativeOpcodes;
     { opcode adding }
-    procedure ConcatInstruction(p : taasmoutput);virtual;
+    procedure ConcatInstruction(p : taasmoutput);override;
   end;
 
 
@@ -193,7 +191,7 @@ Function T386Operand.SetupResult:boolean;
 var
   Res : boolean;
 Begin
-  Res:=TOperand.setupResult;
+  Res:=inherited setupResult;
   { replace by ref by register if not place was
     reserved on stack }
   if res and (procinfo^.return_offset=0) then
@@ -202,7 +200,7 @@ Begin
      if is_fpu(procinfo^.returntype.def) then
        begin
          opr.reg:=R_ST0;
-         case pfloatdef(procinfo^.returntype.def)^.typ of
+         case tfloatdef(procinfo^.returntype.def).typ of
            s32real : size:=S_FS;
            s64real : size:=S_FL;
            s80real : size:=S_FX;
@@ -215,7 +213,7 @@ Begin
          end;
        end
      else if ret_in_acc(procinfo^.returntype.def) then
-       case procinfo^.returntype.def^.size of
+       case procinfo^.returntype.def.size of
        1 : begin
              opr.reg:=R_AL;
              size:=S_B;
@@ -251,15 +249,15 @@ procedure T386Instruction.AddReferenceSizes;
   operand is a register }
 var
   operand2,i : longint;
-  s : pasmsymbol;
+  s : tasmsymbol;
   so : longint;
 begin
   for i:=1to ops do
    begin
-   operands[i]^.SetCorrectSize(opcode);
-   if (operands[i]^.size=S_NO) then
+   operands[i].SetCorrectSize(opcode);
+   if (operands[i].size=S_NO) then
     begin
-      case operands[i]^.Opr.Typ of
+      case operands[i].Opr.Typ of
         OPR_REFERENCE :
           begin
             if i=2 then
@@ -269,30 +267,30 @@ begin
             if operand2<ops then
              begin
                { Only allow register as operand to take the size from }
-               if operands[operand2]^.opr.typ=OPR_REGISTER then
+               if operands[operand2].opr.typ=OPR_REGISTER then
                  begin
                    if ((opcode<>A_MOVD) and
                        (opcode<>A_CVTSI2SS)) then
-                     operands[i]^.size:=operands[operand2]^.size;
+                     operands[i].size:=operands[operand2].size;
                  end
                else
                 begin
                   { if no register then take the opsize (which is available with ATT),
                     if not availble then give an error }
                   if opsize<>S_NO then
-                    operands[i]^.size:=opsize
+                    operands[i].size:=opsize
                   else
                    begin
                      Message(asmr_e_unable_to_determine_reference_size);
                      { recovery }
-                     operands[i]^.size:=S_L;
+                     operands[i].size:=S_L;
                    end;
                 end;
              end
             else
              begin
                if opsize<>S_NO then
-                 operands[i]^.size:=opsize
+                 operands[i].size:=opsize
              end;
           end;
         OPR_SYMBOL :
@@ -300,14 +298,14 @@ begin
             { Fix lea which need a reference }
             if opcode=A_LEA then
              begin
-               s:=operands[i]^.opr.symbol;
-               so:=operands[i]^.opr.symofs;
-               operands[i]^.opr.typ:=OPR_REFERENCE;
-               reset_reference(operands[i]^.opr.ref);
-               operands[i]^.opr.ref.symbol:=s;
-               operands[i]^.opr.ref.offset:=so;
+               s:=operands[i].opr.symbol;
+               so:=operands[i].opr.symofs;
+               operands[i].opr.typ:=OPR_REFERENCE;
+               reset_reference(operands[i].opr.ref);
+               operands[i].opr.ref.symbol:=s;
+               operands[i].opr.ref.offset:=so;
              end;
-            operands[i]^.size:=S_L;
+            operands[i].size:=S_L;
           end;
       end;
     end;
@@ -325,25 +323,25 @@ begin
       { "push es" must be stored as a long PM }
       if ((opcode=A_PUSH) or
           (opcode=A_POP)) and
-         (operands[1]^.opr.typ=OPR_REGISTER) and
-         ((operands[1]^.opr.reg>=firstsreg) and
-          (operands[1]^.opr.reg<=lastsreg)) then
+         (operands[1].opr.typ=OPR_REGISTER) and
+         ((operands[1].opr.reg>=firstsreg) and
+          (operands[1].opr.reg<=lastsreg)) then
         opsize:=S_L
       else
-        opsize:=operands[1]^.size;
+        opsize:=operands[1].size;
     2 :
       begin
         case opcode of
           A_MOVZX,A_MOVSX :
             begin
-              case operands[1]^.size of
+              case operands[1].size of
                 S_W :
-                  case operands[2]^.size of
+                  case operands[2].size of
                     S_L :
                       opsize:=S_WL;
                   end;
                 S_B :
-                  case operands[2]^.size of
+                  case operands[2].size of
                     S_W :
                       opsize:=S_BW;
                     S_L :
@@ -355,13 +353,13 @@ begin
                      32 bit register or memory, so no opsize is correct here PM }
             exit;
           A_OUT :
-            opsize:=operands[1]^.size;
+            opsize:=operands[1].size;
           else
-            opsize:=operands[2]^.size;
+            opsize:=operands[2].size;
         end;
       end;
     3 :
-      opsize:=operands[3]^.size;
+      opsize:=operands[3].size;
   end;
 end;
 
@@ -387,9 +385,9 @@ begin
   { special push/pop selector case }
   if ((opcode=A_PUSH) or
       (opcode=A_POP)) and
-     (operands[1]^.opr.typ=OPR_REGISTER) and
-     ((operands[1]^.opr.reg>=firstsreg) and
-      (operands[1]^.opr.reg<=lastsreg)) then
+     (operands[1].opr.typ=OPR_REGISTER) and
+     ((operands[1].opr.reg>=firstsreg) and
+      (operands[1].opr.reg<=lastsreg)) then
      exit;
   if opsize in [S_BW,S_BL,S_WL] then
    begin
@@ -399,11 +397,11 @@ begin
       begin
         case opsize of
           S_BW :
-            sizeerr:=(operands[1]^.size<>S_B) or (operands[2]^.size<>S_W);
+            sizeerr:=(operands[1].size<>S_B) or (operands[2].size<>S_W);
           S_BL :
-            sizeerr:=(operands[1]^.size<>S_B) or (operands[2]^.size<>S_L);
+            sizeerr:=(operands[1].size<>S_B) or (operands[2].size<>S_L);
           S_WL :
-            sizeerr:=(operands[1]^.size<>S_W) or (operands[2]^.size<>S_L);
+            sizeerr:=(operands[1].size<>S_W) or (operands[2].size<>S_L);
         end;
       end;
    end
@@ -411,9 +409,9 @@ begin
    begin
      for i:=1 to ops do
       begin
-        if (operands[i]^.opr.typ<>OPR_CONSTANT) and
-           (operands[i]^.size in [S_B,S_W,S_L]) and
-           (operands[i]^.size<>opsize) then
+        if (operands[i].opr.typ<>OPR_CONSTANT) and
+           (operands[i].size in [S_B,S_W,S_L]) and
+           (operands[i].size<>opsize) then
          sizeerr:=true;
       end;
    end;
@@ -435,11 +433,11 @@ end;
 procedure T386Instruction.CheckNonCommutativeOpcodes;
 begin
   if ((ops=2) and
-     (operands[1]^.opr.typ=OPR_REGISTER) and
-     (operands[2]^.opr.typ=OPR_REGISTER) and
+     (operands[1].opr.typ=OPR_REGISTER) and
+     (operands[2].opr.typ=OPR_REGISTER) and
      { if the first is ST and the second is also a register
        it is necessarily ST1 .. ST7 }
-     (operands[1]^.opr.reg=R_ST)) or
+     (operands[1].opr.reg=R_ST)) or
       (ops=0)  then
       if opcode=A_FSUBR then
         opcode:=A_FSUB
@@ -458,8 +456,8 @@ begin
       else if opcode=A_FDIVP then
         opcode:=A_FDIVRP;
   if  ((ops=1) and
-      (operands[1]^.opr.typ=OPR_REGISTER) and
-      (operands[1]^.opr.reg in [R_ST1..R_ST7])) then
+      (operands[1].opr.typ=OPR_REGISTER) and
+      (operands[1].opr.reg in [R_ST1..R_ST7])) then
       if opcode=A_FSUBRP then
         opcode:=A_FSUBP
       else if opcode=A_FSUBP then
@@ -485,20 +483,20 @@ begin
    siz:=opsize
   else
    begin
-     if (Ops=2) and (operands[1]^.opr.typ=OPR_REGISTER) then
-      siz:=operands[1]^.size
+     if (Ops=2) and (operands[1].opr.typ=OPR_REGISTER) then
+      siz:=operands[1].size
      else
-      siz:=operands[Ops]^.size;
+      siz:=operands[Ops].size;
      { MOVD should be of size S_LQ or S_QL, but these do not exist PM }
-     if (ops=2) and (operands[1]^.size<>S_NO) and
-        (operands[2]^.size<>S_NO) and (operands[1]^.size<>operands[2]^.size) then
+     if (ops=2) and (operands[1].size<>S_NO) and
+        (operands[2].size<>S_NO) and (operands[1].size<>operands[2].size) then
        siz:=S_NO;
    end;
 
    if ((opcode=A_MOVD)or
        (opcode=A_CVTSI2SS)) and
-      ((operands[1]^.size=S_NO) or
-       (operands[2]^.size=S_NO)) then
+      ((operands[1].size=S_NO) or
+       (operands[2].size=S_NO)) then
      siz:=S_NO;
    { NASM does not support FADD without args
      as alias of FADDP
@@ -558,14 +556,14 @@ begin
   {$endif INTELOP}
 {$endif ATTOP}
        ops:=2;
-       operands[1]^.opr.typ:=OPR_REGISTER;
-       operands[2]^.opr.typ:=OPR_REGISTER;
-       operands[1]^.opr.reg:=R_ST;
-       operands[2]^.opr.reg:=R_ST1;
+       operands[1].opr.typ:=OPR_REGISTER;
+       operands[2].opr.typ:=OPR_REGISTER;
+       operands[1].opr.reg:=R_ST;
+       operands[2].opr.reg:=R_ST1;
      end;
   if (ops=1) and
-      ((operands[1]^.opr.typ=OPR_REGISTER) and
-      (operands[1]^.opr.reg in [R_ST1..R_ST7])) and
+      ((operands[1].opr.typ=OPR_REGISTER) and
+      (operands[1].opr.reg in [R_ST1..R_ST7])) and
       ((opcode=A_FSUBP) or
       (opcode=A_FSUBRP) or
       (opcode=A_FDIVP) or
@@ -583,14 +581,14 @@ begin
   {$endif INTELOP}
 {$endif ATTOP}
        ops:=2;
-       operands[2]^.opr.typ:=OPR_REGISTER;
-       operands[2]^.opr.reg:=operands[1]^.opr.reg;
-       operands[1]^.opr.reg:=R_ST;
+       operands[2].opr.typ:=OPR_REGISTER;
+       operands[2].opr.reg:=operands[1].opr.reg;
+       operands[1].opr.reg:=R_ST;
      end;
 
   if (ops=1) and
-      ((operands[1]^.opr.typ=OPR_REGISTER) and
-      (operands[1]^.opr.reg in [R_ST1..R_ST7])) and
+      ((operands[1].opr.typ=OPR_REGISTER) and
+      (operands[1].opr.reg in [R_ST1..R_ST7])) and
       ((opcode=A_FSUB) or
       (opcode=A_FSUBR) or
       (opcode=A_FDIV) or
@@ -608,8 +606,8 @@ begin
   {$endif INTELOP}
 {$endif ATTOP}
        ops:=2;
-       operands[2]^.opr.typ:=OPR_REGISTER;
-       operands[2]^.opr.reg:=R_ST;
+       operands[2].opr.typ:=OPR_REGISTER;
+       operands[2].opr.reg:=R_ST;
      end;
 
    { I tried to convince Linus Torwald to add
@@ -630,20 +628,20 @@ begin
   ai.Ops:=Ops;
   for i:=1to Ops do
    begin
-     case operands[i]^.opr.typ of
+     case operands[i].opr.typ of
        OPR_CONSTANT :
-         ai.loadconst(i-1,operands[i]^.opr.val);
+         ai.loadconst(i-1,operands[i].opr.val);
        OPR_REGISTER:
-         ai.loadreg(i-1,operands[i]^.opr.reg);
+         ai.loadreg(i-1,operands[i].opr.reg);
        OPR_SYMBOL:
-         ai.loadsymbol(i-1,operands[i]^.opr.symbol,operands[i]^.opr.symofs);
+         ai.loadsymbol(i-1,operands[i].opr.symbol,operands[i].opr.symofs);
        OPR_REFERENCE:
          begin
-           ai.loadref(i-1,newreference(operands[i]^.opr.ref));
-           if operands[i]^.size<>S_NO then
+           ai.loadref(i-1,newreference(operands[i].opr.ref));
+           if operands[i].size<>S_NO then
              begin
                asize:=0;
-               case operands[i]^.size of
+               case operands[i].size of
                    S_B :
                      asize:=OT_BITS8;
                    S_W, S_IS :
@@ -688,7 +686,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.8  2001-04-05 21:33:45  peter
+  Revision 1.9  2001-04-13 01:22:19  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.8  2001/04/05 21:33:45  peter
     * movd and opsize fix merged
 
   Revision 1.7  2001/03/05 21:49:44  peter

compiler/i386/ra386att.pas

@@ -36,7 +36,7 @@ Implementation
 
     uses
        { common }
-       cutils,cobjects,
+       cutils,cclasses,
        { global }
        globtype,globals,verbose,
        systems,
@@ -108,7 +108,7 @@ var
   actasmregister : tregister;
   actopsize      : topsize;
   actcondition   : tasmcond;
-  iasmops        : Pdictionary;
+  iasmops        : tdictionary;
   iasmregs       : ^reg2strtable;
 
 
@@ -117,16 +117,16 @@ Procedure SetupTables;
 var
   i : tasmop;
   j : tregister;
-  str2opentry: pstr2opentry;
+  str2opentry: tstr2opentry;
 Begin
   { opcodes }
-  new(iasmops,init);
-  iasmops^.delete_doubles:=true;
+  iasmops:=TDictionary.Create;
+  iasmops.delete_doubles:=true;
   for i:=firstop to lastop do
     begin
-      new(str2opentry,initname(upper(att_op2str[i])));
-      str2opentry^.op:=i;
-      iasmops^.insert(str2opentry);
+      str2opentry:=tstr2opentry.createname(upper(att_op2str[i]));
+      str2opentry.op:=i;
+      iasmops.insert(str2opentry);
     end;
   { registers }
   new(iasmregs);
@@ -156,7 +156,7 @@ const
     S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_IL,S_IS,S_IQ,S_NO
   );
 var
-  str2opentry: pstr2opentry;
+  str2opentry: tstr2opentry;
   cond : string[4];
   cnd  : tasmcond;
   len,
@@ -178,10 +178,10 @@ Begin
         { here we search the entire table... }
         str2opentry:=nil;
         if {(length(s)>0) and} (len>0) then
-          str2opentry:=pstr2opentry(iasmops^.search(copy(s,1,len)));
+          str2opentry:=tstr2opentry(iasmops.search(copy(s,1,len)));
         if assigned(str2opentry) then
           begin
-            actopcode:=str2opentry^.op;
+            actopcode:=str2opentry.op;
             if att_needsuffix[actopcode]=attsufFPU then
              actopsize:=att_sizefpusuffix[sufidx]
             else if att_needsuffix[actopcode]=attsufFPUint then
@@ -818,9 +818,9 @@ var
   parenlevel,l,k : longint;
   errorflag : boolean;
   prevtok : tasmtoken;
-  sym : psym;
-  srsymtable : psymtable;
-  hl  : PAsmLabel;
+  sym : tsym;
+  srsymtable : tsymtable;
+  hl  : tasmlabel;
 Begin
   asmsym:='';
   value:=0;
@@ -952,13 +952,13 @@ Begin
                 searchsym(tempstr,sym,srsymtable);
                 if assigned(sym) then
                  begin
-                   case sym^.typ of
+                   case sym.typ of
                      varsym :
-                       l:=pvarsym(sym)^.getsize;
+                       l:=tvarsym(sym).getsize;
                      typedconstsym :
-                       l:=ptypedconstsym(sym)^.getsize;
+                       l:=ttypedconstsym(sym).getsize;
                      typesym :
-                       l:=ptypesym(sym)^.restype.def^.size;
+                       l:=ttypesym(sym).restype.def.size;
                      else
                        Message(asmr_e_wrong_sym_type);
                    end;
@@ -986,30 +986,30 @@ Begin
              if is_locallabel(tempstr) then
               begin
                 CreateLocalLabel(tempstr,hl,false);
-                hs:=hl^.name
+                hs:=hl.name
               end
              else
               if SearchLabel(tempstr,hl,false) then
-               hs:=hl^.name
+               hs:=hl.name
              else
               begin
                 searchsym(tempstr,sym,srsymtable);
                 if assigned(sym) then
                  begin
-                   case sym^.typ of
+                   case sym.typ of
                      varsym :
                        begin
-                         if sym^.owner^.symtabletype in [localsymtable,parasymtable] then
+                         if sym.owner.symtabletype in [localsymtable,parasymtable] then
                           Message(asmr_e_no_local_or_para_allowed);
-                         hs:=pvarsym(sym)^.mangledname;
+                         hs:=tvarsym(sym).mangledname;
                        end;
                      typedconstsym :
-                       hs:=ptypedconstsym(sym)^.mangledname;
+                       hs:=ttypedconstsym(sym).mangledname;
                      procsym :
-                       hs:=pprocsym(sym)^.mangledname;
+                       hs:=tprocsym(sym).mangledname;
                      typesym :
                        begin
-                         if not(ptypesym(sym)^.restype.def^.deftype in [recorddef,objectdef]) then
+                         if not(ttypesym(sym).restype.def.deftype in [recorddef,objectdef]) then
                           Message(asmr_e_wrong_sym_type);
                        end;
                      else
@@ -1095,9 +1095,8 @@ end;
 ****************************************************************************}
 
 type
-  P386ATTOperand=^T386ATTOperand;
-  T386ATTOperand=object(T386Operand)
-    Procedure BuildOperand;virtual;
+  T386ATTOperand=class(T386Operand)
+    Procedure BuildOperand;override;
   private
     Procedure BuildReference;
     Procedure BuildConstant;
@@ -1278,7 +1277,7 @@ var
   expr : string;
   l,k : longint;
 
-  procedure AddLabelOperand(hl:pasmlabel);
+  procedure AddLabelOperand(hl:tasmlabel);
   begin
     if not(actasmtoken in [AS_PLUS,AS_MINUS,AS_LPAREN]) and
        is_calljmp(actopcode) then
@@ -1387,7 +1386,7 @@ var
 
 var
   tempreg : tregister;
-  hl      : PAsmLabel;
+  hl      : tasmlabel;
 Begin
   expr:='';
   case actasmtoken of
@@ -1598,10 +1597,9 @@ end;
 *****************************************************************************}
 
 type
-  P386AttInstruction=^T386AttInstruction;
-  T386AttInstruction=object(T386Instruction)
-    procedure InitOperands;virtual;
-    procedure BuildOpcode;virtual;
+  T386AttInstruction=class(T386Instruction)
+    procedure InitOperands;override;
+    procedure BuildOpcode;override;
   end;
 
 procedure T386AttInstruction.InitOperands;
@@ -1609,7 +1607,7 @@ var
   i : longint;
 begin
   for i:=1to 3 do
-   Operands[i]:=new(P386AttOperand,Init);
+   Operands[i]:=T386AttOperand.Create;
 end;
 
 
@@ -1689,7 +1687,7 @@ Begin
           break;
         end;
     else
-      Operands[operandnum]^.BuildOperand;
+      Operands[operandnum].BuildOperand;
     end; { end case }
   until false;
   Ops:=operandnum;
@@ -1866,7 +1864,7 @@ end;
 
 Function Assemble: tnode;
 Var
-  hl         : PAsmLabel;
+  hl         : tasmlabel;
   commname   : string;
   lastsec    : tsection;
   l1,l2      : longint;
@@ -1887,7 +1885,7 @@ Begin
   curlist:=TAAsmoutput.Create;
   lastsec:=sec_code;
   { setup label linked list }
-  new(LocalLabelList,Init);
+  LocalLabelList:=TLocalLabelList.Create;
   { start tokenizer }
   c:=current_scanner^.asmgetchar;
   gettoken;
@@ -2057,13 +2055,13 @@ Begin
         end;
       AS_OPCODE:
         Begin
-          instr.init;
+          instr:=T386ATTInstruction.Create;
           instr.BuildOpcode;
           instr.AddReferenceSizes;
           instr.SetInstructionOpsize;
           instr.CheckOperandSizes;
           instr.ConcatInstruction(curlist);
-          instr.done;
+          instr.Free;
         end;
 
       AS_SEPARATOR:
@@ -2084,8 +2082,8 @@ Begin
     end;
   until false;
   { Check LocalLabelList }
-  LocalLabelList^.CheckEmitted;
-  dispose(LocalLabelList,Done);
+  LocalLabelList.CheckEmitted;
+  LocalLabelList.Free;
   { are we back in the code section? }
   if lastsec<>sec_code then
    begin
@@ -2109,7 +2107,7 @@ procedure ra386att_exit;
 begin
   exitproc:=old_exit;
   if assigned(iasmops) then
-    dispose(iasmops,done);
+    iasmops.Free;
   if assigned(iasmregs) then
     dispose(iasmregs);
 end;
@@ -2121,7 +2119,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.8  2001-03-25 12:29:45  peter
+  Revision 1.9  2001-04-13 01:22:21  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.8  2001/03/25 12:29:45  peter
     * offset_fixup fixes (merged)
 
   Revision 1.7  2001/03/11 22:58:52  peter

compiler/i386/ra386dir.pas

@@ -42,7 +42,7 @@ interface
        { aasm }
        cpubase,aasm,
        { symtable }
-       symconst,symbase,symtype,symdef,symsym,symtable,types,
+       symconst,symbase,symtype,symsym,symtable,types,
        { pass 1 }
        nbas,
        { parser }
@@ -62,8 +62,8 @@ interface
          retstr,s,hs : string;
          c : char;
          ende : boolean;
-         srsym,sym : psym;
-         srsymtable : psymtable;
+         srsym,sym : tsym;
+         srsymtable : tsymtable;
          code : TAAsmoutput;
          i,l : longint;
 
@@ -124,10 +124,10 @@ interface
                               begin
                                 searchsym(upper(hs),srsym,srsymtable);
                                 if srsym<>nil then
-                                  if (srsym^.typ = labelsym) then
+                                  if (srsym.typ = labelsym) then
                                     Begin
-                                       hs:=plabelsym(srsym)^.lab^.name;
-                                       plabelsym(srsym)^.lab^.is_set:=true;
+                                       hs:=tlabelsym(srsym).lab.name;
+                                       tlabelsym(srsym).lab.is_set:=true;
                                     end
                                   else
                                     Message(asmr_w_using_defined_as_local);
@@ -149,56 +149,56 @@ interface
                                    (s[length(s)]<>'$') and
                                    ((s[length(s)]<>'0') or (hs[1]<>'x')) then
                                    begin
-                                      if assigned(aktprocsym^.definition^.localst) and
+                                      if assigned(aktprocsym.definition.localst) and
                                          (lexlevel >= normal_function_level) then
-                                        sym:=psym(aktprocsym^.definition^.localst^.search(upper(hs)))
+                                        sym:=tsym(aktprocsym.definition.localst.search(upper(hs)))
                                       else
                                         sym:=nil;
                                       if assigned(sym) then
                                         begin
-                                           if (sym^.typ = labelsym) then
+                                           if (sym.typ = labelsym) then
                                              Begin
-                                                hs:=plabelsym(sym)^.lab^.name;
+                                                hs:=tlabelsym(sym).lab.name;
                                              end
-                                           else if sym^.typ=varsym then
+                                           else if sym.typ=varsym then
                                              begin
                                              {variables set are after a comma }
                                              {like in movl %eax,I }
                                              if pos(',',s) > 0 then
-                                               pvarsym(sym)^.varstate:=vs_used
+                                               tvarsym(sym).varstate:=vs_used
                                              else
-                                             if (pos('MOV',upper(s)) > 0) and (pvarsym(sym)^.varstate=vs_declared) then
+                                             if (pos('MOV',upper(s)) > 0) and (tvarsym(sym).varstate=vs_declared) then
                                               Message1(sym_n_uninitialized_local_variable,hs);
-                                             if (vo_is_external in pvarsym(sym)^.varoptions) then
-                                               hs:=pvarsym(sym)^.mangledname
+                                             if (vo_is_external in tvarsym(sym).varoptions) then
+                                               hs:=tvarsym(sym).mangledname
                                              else
-                                               hs:='-'+tostr(pvarsym(sym)^.address)+
+                                               hs:='-'+tostr(tvarsym(sym).address)+
                                                    '('+att_reg2str[procinfo^.framepointer]+')';
                                              end
                                            else
                                            { call to local function }
-                                           if (sym^.typ=procsym) and ((pos('CALL',upper(s))>0) or
+                                           if (sym.typ=procsym) and ((pos('CALL',upper(s))>0) or
                                               (pos('LEA',upper(s))>0)) then
                                              begin
-                                                hs:=pprocsym(sym)^.definition^.mangledname;
+                                                hs:=tprocsym(sym).definition.mangledname;
                                              end;
                                         end
                                       else
                                         begin
-                                           if assigned(aktprocsym^.definition^.parast) then
-                                             sym:=psym(aktprocsym^.definition^.parast^.search(upper(hs)))
+                                           if assigned(aktprocsym.definition.parast) then
+                                             sym:=tsym(aktprocsym.definition.parast.search(upper(hs)))
                                            else
                                              sym:=nil;
                                            if assigned(sym) then
                                              begin
-                                                if sym^.typ=varsym then
+                                                if sym.typ=varsym then
                                                   begin
-                                                     l:=pvarsym(sym)^.address;
+                                                     l:=tvarsym(sym).address;
                                                      { set offset }
-                                                     inc(l,aktprocsym^.definition^.parast^.address_fixup);
+                                                     inc(l,aktprocsym.definition.parast.address_fixup);
                                                      hs:=tostr(l)+'('+att_reg2str[procinfo^.framepointer]+')';
                                                      if pos(',',s) > 0 then
-                                                       pvarsym(sym)^.varstate:=vs_used;
+                                                       tvarsym(sym).varstate:=vs_used;
                                                   end;
                                              end
                                       { I added that but it creates a problem in line.ppi
@@ -210,24 +210,23 @@ interface
                                         begin
 {$ifndef IGNOREGLOBALVAR}
                                            searchsym(upper(hs),sym,srsymtable);
-                                           if assigned(sym) and (sym^.owner^.symtabletype in [unitsymtable,
-                                             globalsymtable,staticsymtable]) then
+                                           if assigned(sym) and (sym.owner.symtabletype in [globalsymtable,staticsymtable]) then
                                              begin
-                                                if (sym^.typ = varsym) or (sym^.typ = typedconstsym) then
+                                                if (sym.typ = varsym) or (sym.typ = typedconstsym) then
                                                   begin
-                                                     Message2(asmr_h_direct_global_to_mangled,hs,sym^.mangledname);
-                                                     hs:=sym^.mangledname;
-                                                     if sym^.typ=varsym then
-                                                       inc(pvarsym(sym)^.refs);
+                                                     Message2(asmr_h_direct_global_to_mangled,hs,sym.mangledname);
+                                                     hs:=sym.mangledname;
+                                                     if sym.typ=varsym then
+                                                       inc(tvarsym(sym).refs);
                                                   end;
                                                 { procs can be called or the address can be loaded }
-                                                if (sym^.typ=procsym) and
+                                                if (sym.typ=procsym) and
                                                    ((pos('CALL',upper(s))>0) or (pos('LEA',upper(s))>0)) then
                                                   begin
-                                                     if assigned(pprocsym(sym)^.definition^.nextoverloaded) then
+                                                     if assigned(tprocsym(sym).definition.nextoverloaded) then
                                                        Message1(asmr_w_direct_global_is_overloaded_func,hs);
-                                                     Message2(asmr_h_direct_global_to_mangled,hs,sym^.mangledname);
-                                                     hs:=sym^.mangledname;
+                                                     Message2(asmr_h_direct_global_to_mangled,hs,sym.mangledname);
+                                                     hs:=sym.mangledname;
                                                   end;
                                              end
                                            else
@@ -288,7 +287,12 @@ interface
 end.
 {
   $Log$
-  Revision 1.6  2001-04-02 21:20:40  peter
+  Revision 1.7  2001-04-13 01:22:21  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.6  2001/04/02 21:20:40  peter
     * resulttype rewrite
 
   Revision 1.5  2001/03/11 22:58:52  peter

compiler/i386/ra386int.pas

@@ -36,7 +36,7 @@ Implementation
 
     uses
        { common }
-       cutils,cobjects,
+       cutils,cclasses,
        { global }
        globtype,globals,verbose,
        systems,
@@ -123,7 +123,7 @@ var
   actopcode      : tasmop;
   actopsize      : topsize;
   actcondition   : tasmcond;
-  iasmops        : Pdictionary;
+  iasmops        : tdictionary;
   iasmregs       : ^reg2strtable;
 
 
@@ -132,16 +132,16 @@ Procedure SetupTables;
 var
   i : tasmop;
   j : tregister;
-  str2opentry: pstr2opentry;
+  str2opentry: tstr2opentry;
 Begin
   { opcodes }
-  new(iasmops,init);
-  iasmops^.delete_doubles:=true;
+  iasmops:=tdictionary.create;
+  iasmops.delete_doubles:=true;
   for i:=firstop to lastop do
     begin
-      new(str2opentry,initname(upper(int_op2str[i])));
-      str2opentry^.op:=i;
-      iasmops^.insert(str2opentry);
+      str2opentry:=tstr2opentry.createname(upper(int_op2str[i]));
+      str2opentry.op:=i;
+      iasmops.insert(str2opentry);
     end;
   { registers }
   new(iasmregs);
@@ -157,7 +157,7 @@ end;
 
    function is_asmopcode(const s: string):boolean;
    var
-     str2opentry: pstr2opentry;
+     str2opentry: tstr2opentry;
      cond : string[4];
      cnd : tasmcond;
      j: longint;
@@ -168,10 +168,10 @@ end;
      actcondition:=C_None;
      actopsize:=S_NO;
 
-     str2opentry:=pstr2opentry(iasmops^.search(s));
+     str2opentry:=tstr2opentry(iasmops.search(s));
      if assigned(str2opentry) then
        begin
-         actopcode:=str2opentry^.op;
+         actopcode:=str2opentry.op;
          actasmtoken:=AS_OPCODE;
          is_asmopcode:=TRUE;
          exit;
@@ -704,9 +704,9 @@ var
   parenlevel,l,k : longint;
   errorflag : boolean;
   prevtok : tasmtoken;
-  hl : PAsmLabel;
-  sym : psym;
-  srsymtable : psymtable;
+  hl : tasmlabel;
+  sym : tsym;
+  srsymtable : tsymtable;
 Begin
   { reset }
   value:=0;
@@ -817,13 +817,13 @@ Begin
                 searchsym(tempstr,sym,srsymtable);
                 if assigned(sym) then
                  begin
-                   case sym^.typ of
+                   case sym.typ of
                      varsym :
-                       l:=pvarsym(sym)^.getsize;
+                       l:=tvarsym(sym).getsize;
                      typedconstsym :
-                       l:=ptypedconstsym(sym)^.getsize;
+                       l:=ttypedconstsym(sym).getsize;
                      typesym :
-                       l:=ptypesym(sym)^.restype.def^.size;
+                       l:=ttypesym(sym).restype.def.size;
                      else
                        Message(asmr_e_wrong_sym_type);
                    end;
@@ -872,30 +872,30 @@ Begin
              if is_locallabel(tempstr) then
               begin
                 CreateLocalLabel(tempstr,hl,false);
-                hs:=hl^.name
+                hs:=hl.name
               end
              else
               if SearchLabel(tempstr,hl,false) then
-               hs:=hl^.name
+               hs:=hl.name
              else
               begin
                 searchsym(tempstr,sym,srsymtable);
                 if assigned(sym) then
                  begin
-                   case sym^.typ of
+                   case sym.typ of
                      varsym :
                        begin
-                         if sym^.owner^.symtabletype in [localsymtable,parasymtable] then
+                         if sym.owner.symtabletype in [localsymtable,parasymtable] then
                           Message(asmr_e_no_local_or_para_allowed);
-                         hs:=pvarsym(sym)^.mangledname;
+                         hs:=tvarsym(sym).mangledname;
                        end;
                      typedconstsym :
-                       hs:=ptypedconstsym(sym)^.mangledname;
+                       hs:=ttypedconstsym(sym).mangledname;
                      procsym :
-                       hs:=pprocsym(sym)^.mangledname;
+                       hs:=tprocsym(sym).mangledname;
                      typesym :
                        begin
-                         if not(ptypesym(sym)^.restype.def^.deftype in [recorddef,objectdef]) then
+                         if not(ttypesym(sym).restype.def.deftype in [recorddef,objectdef]) then
                           Message(asmr_e_wrong_sym_type);
                        end;
                      else
@@ -997,9 +997,8 @@ end;
 ****************************************************************************}
 
 type
-  P386IntelOperand=^T386IntelOperand;
-  T386IntelOperand=object(T386Operand)
-    Procedure BuildOperand;virtual;
+  T386IntelOperand=class(T386Operand)
+    Procedure BuildOperand;override;
   private
     Procedure BuildReference;
     Procedure BuildConstant;
@@ -1312,9 +1311,9 @@ var
   expr    : string;
   tempreg : tregister;
   l       : longint;
-  hl      : PAsmLabel;
+  hl      : tasmlabel;
 
-  procedure AddLabelOperand(hl:pasmlabel);
+  procedure AddLabelOperand(hl:tasmlabel);
   begin
     if is_calljmp(actopcode) then
      begin
@@ -1587,10 +1586,9 @@ end;
 *****************************************************************************}
 
 type
-  P386IntelInstruction=^T386IntelInstruction;
-  T386IntelInstruction=object(T386Instruction)
-    procedure InitOperands;virtual;
-    procedure BuildOpcode;virtual;
+  T386IntelInstruction=class(T386Instruction)
+    procedure InitOperands;override;
+    procedure BuildOpcode;override;
   end;
 
 procedure T386IntelInstruction.InitOperands;
@@ -1598,7 +1596,7 @@ var
   i : longint;
 begin
   for i:=1 to 3 do
-   Operands[i]:=new(P386IntelOperand,Init);
+   Operands[i]:=T386IntelOperand.Create;
 end;
 
 
@@ -1716,11 +1714,11 @@ Begin
           if actasmtoken=AS_PTR then
            begin
              Consume(AS_PTR);
-             Operands[operandnum]^.InitRef;
+             Operands[operandnum].InitRef;
            end;
-          Operands[operandnum]^.BuildOperand;
+          Operands[operandnum].BuildOperand;
           { now set the size which was specified by the override }
-          Operands[operandnum]^.size:=size;
+          Operands[operandnum].size:=size;
         end;
 
       { Type specifier }
@@ -1741,13 +1739,13 @@ Begin
           if actasmtoken=AS_PTR then
            begin
              Consume(AS_PTR);
-             Operands[operandnum]^.InitRef;
+             Operands[operandnum].InitRef;
            end;
-          Operands[operandnum]^.BuildOperand;
+          Operands[operandnum].BuildOperand;
         end;
 
       else
-        Operands[operandnum]^.BuildOperand;
+        Operands[operandnum].BuildOperand;
     end; { end case }
   until false;
   Ops:=operandnum;
@@ -1823,7 +1821,7 @@ end;
 
 Function Assemble: tnode;
 Var
-  hl : PAsmLabel;
+  hl : tasmlabel;
   instr : T386IntelInstruction;
 Begin
   Message1(asmr_d_start_reading,'intel');
@@ -1841,7 +1839,7 @@ Begin
    end;
   curlist:=TAAsmoutput.Create;
   { setup label linked list }
-  new(LocalLabelList,Init);
+  LocalLabelList:=TLocalLabelList.Create;
   { start tokenizer }
   c:=current_scanner^.asmgetchar;
   gettoken;
@@ -1890,17 +1888,17 @@ Begin
 
       AS_OPCODE :
         Begin
-          instr.init;
+          instr:=T386IntelInstruction.Create;
           instr.BuildOpcode;
           { We need AT&T style operands }
-          instr.SwapOperands;
+          instr.Swatoperands;
           { Must be done with args in ATT order }
           instr.CheckNonCommutativeOpcodes;
           instr.AddReferenceSizes;
           instr.SetInstructionOpsize;
           instr.CheckOperandSizes;
           instr.ConcatInstruction(curlist);
-          instr.done;
+          instr.Free;
         end;
 
       AS_SEPARATOR :
@@ -1919,8 +1917,8 @@ Begin
     end; { end case }
   until false;
   { Check LocalLabelList }
-  LocalLabelList^.CheckEmitted;
-  dispose(LocalLabelList,Done);
+  LocalLabelList.CheckEmitted;
+  LocalLabelList.Free;
   { Return the list in an asmnode }
   assemble:=casmnode.create(curlist);
   Message1(asmr_d_finish_reading,'intel');
@@ -1938,7 +1936,7 @@ procedure ra386int_exit;
 begin
   exitproc:=old_exit;
   if assigned(iasmops) then
-    dispose(iasmops,done);
+    iasmops.Free;
   if assigned(iasmregs) then
     dispose(iasmregs);
 end;
@@ -1950,7 +1948,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.11  2001-03-25 12:29:45  peter
+  Revision 1.12  2001-04-13 01:22:21  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.11  2001/03/25 12:29:45  peter
     * offset_fixup fixes (merged)
 
   Revision 1.10  2001/03/11 22:58:52  peter

compiler/i386/tgcpu.pas

@@ -27,7 +27,7 @@ unit tgcpu;
 interface
 
     uses
-       cobjects,globals,
+       globals,
        hcodegen,verbose,aasm,
        node,
        cpubase,cpuasm
@@ -674,7 +674,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2000-12-25 00:07:34  peter
+  Revision 1.4  2001-04-13 01:22:21  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.3  2000/12/25 00:07:34  peter
     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
       tlinkedlist objects)
 

compiler/impdef.pas

@@ -23,7 +23,7 @@
 
  ****************************************************************************
 }
-unit impdef;
+unit imtdef;
 
 {$ifndef STANDALONE}
   {$i defines.inc}
@@ -479,7 +479,12 @@ end.
 
 {
   $Log$
-  Revision 1.5  2001-01-13 00:09:21  peter
+  Revision 1.6  2001-04-13 01:22:08  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.5  2001/01/13 00:09:21  peter
     * made Pavel O. happy ;)
 
   Revision 1.4  2000/11/20 13:58:19  pierre

compiler/import.pas

@@ -26,14 +26,15 @@ unit import;
 interface
 
 uses
-  cutils,cclasses;
+  cutils,cclasses,
+  aasm;
 
 type
    timported_item = class(tlinkedlistitem)
       ordnr  : word;
       name,
       func   : pstring;
-      lab    : pointer; { should be plabel, but this gaves problems with circular units }
+      lab    : tasmlabel; { should be plabel, but this gaves problems with circular units }
       is_var : boolean;
       constructor Create(const n,s : string;o : word);
       constructor Create_var(const n,s : string);
@@ -290,7 +291,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.11  2001-03-06 18:28:02  peter
+  Revision 1.12  2001-04-13 01:22:08  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.11  2001/03/06 18:28:02  peter
     * patch from Pavel with a new and much faster DLL Scanner for
       automatic importing so $linklib works for DLLs. Thanks Pavel!
 

compiler/link.pas

@@ -32,7 +32,7 @@ unit link;
 
 interface
 uses
-  cobjects,cclasses,
+  cclasses,
   systems,
   fmodule;
 
@@ -557,7 +557,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.14  2001-02-26 19:44:52  peter
+  Revision 1.15  2001-04-13 01:22:08  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.14  2001/02/26 19:44:52  peter
     * merged generic m68k updates from fixes branch
 
   Revision 1.13  2001/02/20 21:41:17  peter

compiler/mdppc386.bat

@@ -1,2 +1,2 @@
-dcc32 -Di386 -DGDB -Ddelphi -CC -$O+ ppc.dpr %1 %2 %3 %4 %5 %6 %7 %8 %9
+dcc32 -Di386 -DGDB -Ddelphi -CC -Ui386 -Utargets -E. -N. -$O+ ppc.dpr %1 %2 %3 %4 %5 %6 %7 %8 %9
 

compiler/nadd.pas

@@ -78,7 +78,7 @@ implementation
       var
          hp,t    : tnode;
          lt,rt   : tnodetype;
-         rd,ld   : pdef;
+         rd,ld   : tdef;
          htype   : ttype;
          ot      : tnodetype;
          concatstrings : boolean;
@@ -102,27 +102,34 @@ implementation
          if codegenerror then
            exit;
 
-         { load easier access variables }
-         rd:=right.resulttype.def;
-         ld:=left.resulttype.def;
-         rt:=right.nodetype;
-         lt:=left.nodetype;
-
          { convert array constructors to sets, because there is no other operator
            possible for array constructors }
-         if is_array_constructor(ld) then
+         if is_array_constructor(left.resulttype.def) then
           begin
             arrayconstructor_to_set(tarrayconstructornode(left));
             resulttypepass(left);
-            ld:=left.resulttype.def;
           end;
-         if is_array_constructor(rd) then
+         if is_array_constructor(right.resulttype.def) then
           begin
             arrayconstructor_to_set(tarrayconstructornode(right));
             resulttypepass(right);
-            rd:=right.resulttype.def;
           end;
 
+         { is one a real float, then both need to be floats, this
+           need to be done before the constant folding so constant
+           operation on a float and int are also handled }
+         if (right.resulttype.def.deftype=floatdef) or (left.resulttype.def.deftype=floatdef) then
+          begin
+            inserttypeconv(right,pbestrealtype^);
+            inserttypeconv(left,pbestrealtype^);
+          end;
+
+         { load easier access variables }
+         rd:=right.resulttype.def;
+         ld:=left.resulttype.def;
+         rt:=right.nodetype;
+         lt:=left.nodetype;
+
          { both are int constants }
          if (((is_constintnode(left) and is_constintnode(right)) or
               (is_constboolnode(left) and is_constboolnode(right) and
@@ -154,7 +161,7 @@ implementation
                 begin
                   { make left const type the biggest, this type will be used
                     for orn,andn,xorn }
-                  if rd^.size>ld^.size then
+                  if rd.size>ld.size then
                     inserttypeconv(left,right.resulttype);
                 end;
 
@@ -169,10 +176,10 @@ implementation
                 rv:=tpointerconstnode(right).value;
               if (lt = pointerconstn) and
                  (rt <> pointerconstn) then
-                rv := rv * ppointerdef(left.resulttype.def)^.pointertype.def^.size;
+                rv := rv * tpointerdef(left.resulttype.def).pointertype.def.size;
               if (rt = pointerconstn) and
                  (lt <> pointerconstn) then
-                lv := lv * ppointerdef(right.resulttype.def)^.pointertype.def^.size;
+                lv := lv * tpointerdef(right.resulttype.def).pointertype.def.size;
               case nodetype of
                 addn :
                   if (lt <> pointerconstn) then
@@ -445,18 +452,18 @@ implementation
           end
 
          { if both are orddefs then check sub types }
-         else if (ld^.deftype=orddef) and (rd^.deftype=orddef) then
+         else if (ld.deftype=orddef) and (rd.deftype=orddef) then
            begin
              { 2 booleans? Make them equal to the largest boolean }
              if is_boolean(ld) and is_boolean(rd) then
               begin
-                if porddef(left.resulttype.def)^.size>porddef(right.resulttype.def)^.size then
+                if torddef(left.resulttype.def).size>torddef(right.resulttype.def).size then
                  begin
                    inserttypeconv(right,left.resulttype);
                    ttypeconvnode(right).convtype:=tc_bool_2_int;
                    include(right.flags,nf_explizit);
                  end
-                else if porddef(left.resulttype.def)^.size<porddef(right.resulttype.def)^.size then
+                else if torddef(left.resulttype.def).size<torddef(right.resulttype.def).size then
                  begin
                    inserttypeconv(left,right.resulttype);
                    ttypeconvnode(left).convtype:=tc_bool_2_int;
@@ -535,23 +542,23 @@ implementation
                   end;
                end
              { is there a signed 64 bit type ? }
-             else if ((porddef(rd)^.typ=s64bit) or (porddef(ld)^.typ=s64bit)) then
+             else if ((torddef(rd).typ=s64bit) or (torddef(ld).typ=s64bit)) then
                begin
-                  if (porddef(ld)^.typ<>s64bit) then
+                  if (torddef(ld).typ<>s64bit) then
                    inserttypeconv(left,cs64bittype);
-                  if (porddef(rd)^.typ<>s64bit) then
+                  if (torddef(rd).typ<>s64bit) then
                    inserttypeconv(right,cs64bittype);
                end
              { is there a unsigned 64 bit type ? }
-             else if ((porddef(rd)^.typ=u64bit) or (porddef(ld)^.typ=u64bit)) then
+             else if ((torddef(rd).typ=u64bit) or (torddef(ld).typ=u64bit)) then
                begin
-                  if (porddef(ld)^.typ<>u64bit) then
+                  if (torddef(ld).typ<>u64bit) then
                    inserttypeconv(left,cu64bittype);
-                  if (porddef(rd)^.typ<>u64bit) then
+                  if (torddef(rd).typ<>u64bit) then
                    inserttypeconv(right,cu64bittype);
                end
              { is there a cardinal? }
-             else if ((porddef(rd)^.typ=u32bit) or (porddef(ld)^.typ=u32bit)) then
+             else if ((torddef(rd).typ=u32bit) or (torddef(ld).typ=u32bit)) then
                begin
                  if is_signed(ld) and
                     { then rd = u32bit }
@@ -609,16 +616,28 @@ implementation
                end;
            end
 
+         { if both are floatdefs, conversion is already done before constant folding }
+           else if (ld.deftype=floatdef) then
+            begin
+              { already converted }
+            end
+
+         else if (right.resulttype.def.deftype=floatdef) or (left.resulttype.def.deftype=floatdef) then
+          begin
+            inserttypeconv(right,pbestrealtype^);
+            inserttypeconv(left,pbestrealtype^);
+          end
+
          { left side a setdef, must be before string processing,
            else array constructor can be seen as array of char (PFV) }
-         else if (ld^.deftype=setdef) then
+         else if (ld.deftype=setdef) then
           begin
             { trying to add a set element? }
-            if (nodetype=addn) and (rd^.deftype<>setdef) then
+            if (nodetype=addn) and (rd.deftype<>setdef) then
              begin
                if (rt=setelementn) then
                 begin
-                  if not(is_equal(psetdef(ld)^.elementtype.def,rd)) then
+                  if not(is_equal(tsetdef(ld).elementtype.def,rd)) then
                    CGMessage(type_e_set_element_are_not_comp);
                 end
                else
@@ -629,18 +648,18 @@ implementation
                if not(nodetype in [addn,subn,symdifn,muln,equaln,unequaln,lten,gten]) then
                 CGMessage(type_e_set_operation_unknown);
                { right def must be a also be set }
-               if (rd^.deftype<>setdef) or not(is_equal(rd,ld)) then
+               if (rd.deftype<>setdef) or not(is_equal(rd,ld)) then
                 CGMessage(type_e_set_element_are_not_comp);
              end;
 
             { ranges require normsets }
-            if (psetdef(ld)^.settype=smallset) and
+            if (tsetdef(ld).settype=smallset) and
                (rt=setelementn) and
                assigned(tsetelementnode(right).right) then
              begin
                { generate a temporary normset def, it'll be destroyed
                  when the symtable is unloaded }
-               htype.setdef(new(psetdef,init(psetdef(ld)^.elementtype,255)));
+               htype.setdef(tsetdef.create(tsetdef(ld).elementtype,255));
                inserttypeconv(left,htype);
              end;
           end
@@ -658,7 +677,7 @@ implementation
          { is one of the operands a string?,
            chararrays are also handled as strings (after conversion), also take
            care of chararray+chararray and chararray+char }
-         else if (rd^.deftype=stringdef) or (ld^.deftype=stringdef) or
+         else if (rd.deftype=stringdef) or (ld.deftype=stringdef) or
                  ((is_chararray(rd) or is_char(rd)) and
                   (is_chararray(ld) or is_char(ld))) then
           begin
@@ -694,16 +713,8 @@ implementation
               end;
           end
 
-         { is one a real float ? }
-         else if (rd^.deftype=floatdef) or (ld^.deftype=floatdef) then
-          begin
-          { convert both to bestreal }
-            inserttypeconv(right,pbestrealtype^);
-            inserttypeconv(left,pbestrealtype^);
-          end
-
          { pointer comparision and subtraction }
-         else if (rd^.deftype=pointerdef) and (ld^.deftype=pointerdef) then
+         else if (rd.deftype=pointerdef) and (ld.deftype=pointerdef) then
           begin
             case nodetype of
                equaln,unequaln :
@@ -771,7 +782,7 @@ implementation
           begin
             if is_class_or_interface(rd) and is_class_or_interface(ld) then
              begin
-               if pobjectdef(rd)^.is_related(pobjectdef(ld)) then
+               if tobjectdef(rd).is_related(tobjectdef(ld)) then
                 inserttypeconv(right,left.resulttype)
                else
                 inserttypeconv(left,right.resulttype);
@@ -785,10 +796,10 @@ implementation
              CGMessage(type_e_mismatch);
           end
 
-         else if (rd^.deftype=classrefdef) and (ld^.deftype=classrefdef) then
+         else if (rd.deftype=classrefdef) and (ld.deftype=classrefdef) then
           begin
-            if pobjectdef(pclassrefdef(rd)^.pointertype.def)^.is_related(
-                    pobjectdef(pclassrefdef(ld)^.pointertype.def)) then
+            if tobjectdef(tclassrefdef(rd).pointertype.def).is_related(
+                    tobjectdef(tclassrefdef(ld).pointertype.def)) then
               inserttypeconv(right,left.resulttype)
             else
               inserttypeconv(left,right.resulttype);
@@ -798,14 +809,14 @@ implementation
           end
 
          { allows comperasion with nil pointer }
-         else if is_class_or_interface(rd) or (rd^.deftype=classrefdef) then
+         else if is_class_or_interface(rd) or (rd.deftype=classrefdef) then
           begin
             inserttypeconv(left,right.resulttype);
             if not(nodetype in [equaln,unequaln]) then
              CGMessage(type_e_mismatch);
           end
 
-         else if is_class_or_interface(ld) or (ld^.deftype=classrefdef) then
+         else if is_class_or_interface(ld) or (ld.deftype=classrefdef) then
           begin
             inserttypeconv(right,left.resulttype);
             if not(nodetype in [equaln,unequaln]) then
@@ -813,8 +824,8 @@ implementation
           end
 
        { support procvar=nil,procvar<>nil }
-         else if ((ld^.deftype=procvardef) and (rt=niln)) or
-                 ((rd^.deftype=procvardef) and (lt=niln)) then
+         else if ((ld.deftype=procvardef) and (rt=niln)) or
+                 ((rd.deftype=procvardef) and (lt=niln)) then
           begin
             if not(nodetype in [equaln,unequaln]) then
              CGMessage(type_e_mismatch);
@@ -843,11 +854,11 @@ implementation
 
          { this is a little bit dangerous, also the left type }
          { pointer to should be checked! This broke the mmx support      }
-         else if (rd^.deftype=pointerdef) or is_zero_based_array(rd) then
+         else if (rd.deftype=pointerdef) or is_zero_based_array(rd) then
           begin
             if is_zero_based_array(rd) then
               begin
-                resulttype.setdef(new(ppointerdef,init(parraydef(rd)^.elementtype)));
+                resulttype.setdef(tpointerdef.create(tarraydef(rd).elementtype));
                 inserttypeconv(right,resulttype);
               end;
             inserttypeconv(left,s32bittype);
@@ -856,19 +867,19 @@ implementation
                 if not(cs_extsyntax in aktmoduleswitches) or
                    (not(is_pchar(ld)) and not(m_add_pointer in aktmodeswitches)) then
                   CGMessage(type_e_mismatch);
-                if (rd^.deftype=pointerdef) and
-                   (ppointerdef(rd)^.pointertype.def^.size>1) then
-                  left:=caddnode.create(muln,left,cordconstnode.create(ppointerdef(rd)^.pointertype.def^.size,s32bittype));
+                if (rd.deftype=pointerdef) and
+                   (tpointerdef(rd).pointertype.def.size>1) then
+                  left:=caddnode.create(muln,left,cordconstnode.create(tpointerdef(rd).pointertype.def.size,s32bittype));
               end
             else
               CGMessage(type_e_mismatch);
           end
 
-         else if (ld^.deftype=pointerdef) or is_zero_based_array(ld) then
+         else if (ld.deftype=pointerdef) or is_zero_based_array(ld) then
           begin
             if is_zero_based_array(ld) then
               begin
-                 resulttype.setdef(new(ppointerdef,init(parraydef(ld)^.elementtype)));
+                 resulttype.setdef(tpointerdef.create(tarraydef(ld).elementtype));
                  inserttypeconv(left,resulttype);
               end;
             inserttypeconv(right,s32bittype);
@@ -877,22 +888,22 @@ implementation
                 if not(cs_extsyntax in aktmoduleswitches) or
                    (not(is_pchar(ld)) and not(m_add_pointer in aktmodeswitches)) then
                   CGMessage(type_e_mismatch);
-                if (ld^.deftype=pointerdef) and
-                   (ppointerdef(ld)^.pointertype.def^.size>1) then
-                  right:=caddnode.create(muln,right,cordconstnode.create(ppointerdef(ld)^.pointertype.def^.size,s32bittype));
+                if (ld.deftype=pointerdef) and
+                   (tpointerdef(ld).pointertype.def.size>1) then
+                  right:=caddnode.create(muln,right,cordconstnode.create(tpointerdef(ld).pointertype.def.size,s32bittype));
               end
             else
               CGMessage(type_e_mismatch);
          end
 
-         else if (rd^.deftype=procvardef) and (ld^.deftype=procvardef) and is_equal(rd,ld) then
+         else if (rd.deftype=procvardef) and (ld.deftype=procvardef) and is_equal(rd,ld) then
           begin
             if not (nodetype in [equaln,unequaln]) then
              CGMessage(type_e_mismatch);
           end
 
          { enums }
-         else if (ld^.deftype=enumdef) and (rd^.deftype=enumdef) then
+         else if (ld.deftype=enumdef) and (rd.deftype=enumdef) then
           begin
             if not(is_equal(ld,rd)) then
              inserttypeconv(right,left.resulttype);
@@ -937,7 +948,7 @@ implementation
       var
          hp      : tnode;
          lt,rt   : tnodetype;
-         rd,ld   : pdef;
+         rd,ld   : tdef;
       begin
          result:=nil;
          { first do the two subtrees }
@@ -967,7 +978,7 @@ implementation
            end
 
          { if both are orddefs then check sub types }
-         else if (ld^.deftype=orddef) and (rd^.deftype=orddef) then
+         else if (ld.deftype=orddef) and (rd.deftype=orddef) then
            begin
            { 2 booleans ? }
              if is_boolean(ld) and is_boolean(rd) then
@@ -996,10 +1007,10 @@ implementation
                  calcregisters(self,1,0,0);
                end
               { is there a 64 bit type ? }
-             else if (porddef(ld)^.typ in [s64bit,u64bit]) then
+             else if (torddef(ld).typ in [s64bit,u64bit]) then
                calcregisters(self,2,0,0)
              { is there a cardinal? }
-             else if (porddef(ld)^.typ=u32bit) then
+             else if (torddef(ld).typ=u32bit) then
                begin
                  calcregisters(self,1,0,0);
                  { for unsigned mul we need an extra register }
@@ -1013,9 +1024,9 @@ implementation
 
          { left side a setdef, must be before string processing,
            else array constructor can be seen as array of char (PFV) }
-         else if (ld^.deftype=setdef) then
+         else if (ld.deftype=setdef) then
            begin
-             if psetdef(ld)^.settype=smallset then
+             if tsetdef(ld).settype=smallset then
               begin
                  { are we adding set elements ? }
                  if right.nodetype=setelementn then
@@ -1041,7 +1052,7 @@ implementation
            end
 
          { is one of the operands a string }
-         else if (ld^.deftype=stringdef) then
+         else if (ld.deftype=stringdef) then
             begin
               if is_widestring(ld) then
                 begin
@@ -1099,14 +1110,14 @@ implementation
            end
 
          { is one a real float ? }
-         else if (rd^.deftype=floatdef) or (ld^.deftype=floatdef) then
+         else if (rd.deftype=floatdef) or (ld.deftype=floatdef) then
             begin
               calcregisters(self,0,1,0);
               location.loc:=LOC_FPU;
             end
 
          { pointer comperation and subtraction }
-         else if (ld^.deftype=pointerdef) then
+         else if (ld.deftype=pointerdef) then
             begin
               location.loc:=LOC_REGISTER;
               calcregisters(self,1,0,0);
@@ -1118,15 +1129,15 @@ implementation
               calcregisters(self,1,0,0);
             end
 
-         else if (ld^.deftype=classrefdef) then
+         else if (ld.deftype=classrefdef) then
             begin
               location.loc:=LOC_REGISTER;
               calcregisters(self,1,0,0);
             end
 
          { support procvar=nil,procvar<>nil }
-         else if ((ld^.deftype=procvardef) and (rt=niln)) or
-                 ((rd^.deftype=procvardef) and (lt=niln)) then
+         else if ((ld.deftype=procvardef) and (rt=niln)) or
+                 ((rd.deftype=procvardef) and (lt=niln)) then
             begin
               calcregisters(self,1,0,0);
               location.loc:=LOC_REGISTER;
@@ -1143,19 +1154,19 @@ implementation
             end
 {$endif SUPPORT_MMX}
 
-         else if (rd^.deftype=pointerdef) or (ld^.deftype=pointerdef) then
+         else if (rd.deftype=pointerdef) or (ld.deftype=pointerdef) then
             begin
               location.loc:=LOC_REGISTER;
               calcregisters(self,1,0,0);
             end
 
-         else  if (rd^.deftype=procvardef) and (ld^.deftype=procvardef) and is_equal(rd,ld) then
+         else  if (rd.deftype=procvardef) and (ld.deftype=procvardef) and is_equal(rd,ld) then
            begin
              calcregisters(self,1,0,0);
              location.loc:=LOC_REGISTER;
            end
 
-         else if (ld^.deftype=enumdef) then
+         else if (ld.deftype=enumdef) then
            begin
               calcregisters(self,1,0,0);
            end
@@ -1197,7 +1208,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.24  2001-04-04 22:42:39  peter
+  Revision 1.25  2001-04-13 01:22:08  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.24  2001/04/04 22:42:39  peter
     * move constant folding into det_resulttype
 
   Revision 1.23  2001/04/02 21:20:30  peter

compiler/nbas.pas

@@ -159,7 +159,7 @@ implementation
          if (not (cs_extsyntax in aktmoduleswitches)) and
             assigned(right.resulttype.def) and
             not((right.nodetype=calln) and
-                (tcallnode(right).procdefinition^.proctypeoption=potype_constructor)) and
+                (tcallnode(right).procdefinition.proctypeoption=potype_constructor)) and
             not(is_void(right.resulttype.def)) then
            CGMessage(cg_e_illegal_expression);
          if codegenerror then
@@ -248,7 +248,7 @@ implementation
                    if (not (cs_extsyntax in aktmoduleswitches)) and
                       assigned(hp.right.resulttype.def) and
                       not((hp.right.nodetype=calln) and
-                          (tcallnode(hp.right).procdefinition^.proctypeoption=potype_constructor)) and
+                          (tcallnode(hp.right).procdefinition.proctypeoption=potype_constructor)) and
                       not(is_void(hp.right.resulttype.def)) then
                      CGMessage(cg_e_illegal_expression);
                 end;
@@ -401,7 +401,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.9  2001-04-02 21:20:30  peter
+  Revision 1.10  2001-04-13 01:22:08  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.9  2001/04/02 21:20:30  peter
     * resulttype rewrite
 
   Revision 1.8  2001/02/05 20:45:49  peter

compiler/ncal.pas

@@ -35,15 +35,15 @@ interface
        tcallnode = class(tbinarynode)
           { the symbol containing the definition of the procedure }
           { to call                                               }
-          symtableprocentry : pprocsym;
+          symtableprocentry : tprocsym;
           { the symtable containing symtableprocentry }
-          symtableproc   : psymtable;
+          symtableproc   : tsymtable;
           { the definition of the procedure to call }
-          procdefinition : pabstractprocdef;
+          procdefinition : tabstractprocdef;
           methodpointer  : tnode;
           { only the processor specific nodes need to override this }
           { constructor                                             }
-          constructor create(l:tnode; v : pprocsym;st : psymtable; mp : tnode);virtual;
+          constructor create(l:tnode; v : tprocsym;st : tsymtable; mp : tnode);virtual;
           destructor destroy;override;
           function  getcopy : tnode;override;
           procedure insertintolist(l : tnodelist);override;
@@ -83,7 +83,7 @@ interface
 
        tprocinlinenode = class(tnode)
           inlinetree : tnode;
-          inlineprocsym : pprocsym;
+          inlineprocsym : tprocsym;
           retoffset,para_offset,para_size : longint;
           constructor create(callp,code : tnode);virtual;
           destructor destroy;override;
@@ -209,7 +209,7 @@ implementation
            it here before the arrayconstructor node breaks the tree
            with its conversions of enum->ord }
          if (left.nodetype=arrayconstructorn) and
-            (defcoll.paratype.def^.deftype=setdef) then
+            (defcoll.paratype.def.deftype=setdef) then
            inserttypeconv(left,defcoll.paratype);
 
          { set some settings needed for arrayconstructor }
@@ -218,8 +218,8 @@ implementation
             if is_array_of_const(defcoll.paratype.def) then
              begin
                if assigned(aktcallprocsym) and
-                  (([pocall_cppdecl,pocall_cdecl]*aktcallprocsym^.definition^.proccalloptions)<>[]) and
-                  (po_external in aktcallprocsym^.definition^.procoptions) then
+                  (([pocall_cppdecl,pocall_cdecl]*aktcallprocsym.definition.proccalloptions)<>[]) and
+                  (po_external in aktcallprocsym.definition.procoptions) then
                  include(left.flags,nf_cargs);
                { force variant array }
                include(left.flags,nf_forcevaria);
@@ -227,7 +227,7 @@ implementation
             else
              begin
                include(left.flags,nf_novariaallowed);
-               tarrayconstructornode(left).constructortype:=parraydef(defcoll.paratype.def)^.elementtype;
+               tarrayconstructornode(left).constructortype:=tarraydef(defcoll.paratype.def).elementtype;
              end;
           end;
 
@@ -258,58 +258,58 @@ implementation
             allow_array_constructor:=old_array_constructor; }
           end;
          { check if local proc/func is assigned to procvar }
-         if left.resulttype.def^.deftype=procvardef then
-           test_local_to_procvar(pprocvardef(left.resulttype.def),defcoll.paratype.def);
+         if left.resulttype.def.deftype=procvardef then
+           test_local_to_procvar(tprocvardef(left.resulttype.def),defcoll.paratype.def);
          { property is not allowed as var parameter }
          if (defcoll.paratyp in [vs_out,vs_var]) and
             (nf_isproperty in left.flags) then
            CGMessagePos(left.fileinfo,type_e_argument_cant_be_assigned);
          { generate the high() value tree }
          if not(assigned(aktcallprocsym) and
-                (([pocall_cppdecl,pocall_cdecl]*aktcallprocsym^.definition^.proccalloptions)<>[]) and
-                (po_external in aktcallprocsym^.definition^.procoptions)) and
+                (([pocall_cppdecl,pocall_cdecl]*aktcallprocsym.definition.proccalloptions)<>[]) and
+                (po_external in aktcallprocsym.definition.procoptions)) and
             push_high_param(defcoll.paratype.def) then
            gen_high_tree(is_open_string(defcoll.paratype.def));
          if not(is_shortstring(left.resulttype.def) and
                 is_shortstring(defcoll.paratype.def)) and
-                (defcoll.paratype.def^.deftype<>formaldef) then
+                (defcoll.paratype.def.deftype<>formaldef) then
            begin
               if (defcoll.paratyp in [vs_var,vs_out]) and
               { allows conversion from word to integer and
                 byte to shortint }
                 (not(
-                   (left.resulttype.def^.deftype=orddef) and
-                   (defcoll.paratype.def^.deftype=orddef) and
-                   (left.resulttype.def^.size=defcoll.paratype.def^.size)
+                   (left.resulttype.def.deftype=orddef) and
+                   (defcoll.paratype.def.deftype=orddef) and
+                   (left.resulttype.def.size=defcoll.paratype.def.size)
                     ) and
               { an implicit pointer conversion is allowed }
                 not(
-                   (left.resulttype.def^.deftype=pointerdef) and
-                   (defcoll.paratype.def^.deftype=pointerdef)
+                   (left.resulttype.def.deftype=pointerdef) and
+                   (defcoll.paratype.def.deftype=pointerdef)
                     ) and
               { child classes can be also passed }
                 not(
-                   (left.resulttype.def^.deftype=objectdef) and
-                   (defcoll.paratype.def^.deftype=objectdef) and
-                   pobjectdef(left.resulttype.def)^.is_related(pobjectdef(defcoll.paratype.def))
+                   (left.resulttype.def.deftype=objectdef) and
+                   (defcoll.paratype.def.deftype=objectdef) and
+                   tobjectdef(left.resulttype.def).is_related(tobjectdef(defcoll.paratype.def))
                    ) and
               { passing a single element to a openarray of the same type }
                 not(
                    (is_open_array(defcoll.paratype.def) and
-                   is_equal(parraydef(defcoll.paratype.def)^.elementtype.def,left.resulttype.def))
+                   is_equal(tarraydef(defcoll.paratype.def).elementtype.def,left.resulttype.def))
                    ) and
               { an implicit file conversion is also allowed }
               { from a typed file to an untyped one           }
                 not(
-                   (left.resulttype.def^.deftype=filedef) and
-                   (defcoll.paratype.def^.deftype=filedef) and
-                   (pfiledef(defcoll.paratype.def)^.filetyp = ft_untyped) and
-                   (pfiledef(left.resulttype.def)^.filetyp = ft_typed)
+                   (left.resulttype.def.deftype=filedef) and
+                   (defcoll.paratype.def.deftype=filedef) and
+                   (tfiledef(defcoll.paratype.def).filetyp = ft_untyped) and
+                   (tfiledef(left.resulttype.def).filetyp = ft_typed)
                     ) and
                 not(is_equal(left.resulttype.def,defcoll.paratype.def))) then
                   begin
                      CGMessagePos2(left.fileinfo,parser_e_call_by_ref_without_typeconv,
-                       left.resulttype.def^.typename,defcoll.paratype.def^.typename);
+                       left.resulttype.def.typename,defcoll.paratype.def.typename);
                   end;
               { Process open parameters }
               if push_high_param(defcoll.paratype.def) then
@@ -345,7 +345,7 @@ implementation
          { into a register }
          { is this usefull here ? }
          { this was missing in formal parameter list   }
-         if (defcoll.paratype.def^.deftype=formaldef) then
+         if (defcoll.paratype.def.deftype=formaldef) then
            begin
              if defcoll.paratyp in [vs_var,vs_out] then
                begin
@@ -441,30 +441,30 @@ implementation
     procedure tcallparanode.gen_high_tree(openstring:boolean);
       var
         len : longint;
-        st  : psymtable;
+        st  : tsymtable;
         loadconst : boolean;
-        srsym : psym;
+        srsym : tsym;
       begin
         if assigned(hightree) then
           exit;
         len:=-1;
         loadconst:=true;
-        case left.resulttype.def^.deftype of
+        case left.resulttype.def.deftype of
           arraydef :
             begin
               if is_open_array(left.resulttype.def) or
                  is_array_of_const(left.resulttype.def) then
                begin
                  st:=tloadnode(left).symtable;
-                 srsym:=searchsymonlyin(st,'high'+pvarsym(tloadnode(left).symtableentry)^.name);
-                 hightree:=cloadnode.create(pvarsym(srsym),st);
+                 srsym:=searchsymonlyin(st,'high'+tvarsym(tloadnode(left).symtableentry).name);
+                 hightree:=cloadnode.create(tvarsym(srsym),st);
                  loadconst:=false;
                end
               else
                 begin
                   { this is an empty constructor }
-                  len:=parraydef(left.resulttype.def)^.highrange-
-                       parraydef(left.resulttype.def)^.lowrange;
+                  len:=tarraydef(left.resulttype.def).highrange-
+                       tarraydef(left.resulttype.def).lowrange;
                 end;
             end;
           stringdef :
@@ -474,12 +474,12 @@ implementation
                  if is_open_string(left.resulttype.def) then
                   begin
                     st:=tloadnode(left).symtable;
-                    srsym:=searchsymonlyin(st,'high'+pvarsym(tloadnode(left).symtableentry)^.name);
-                    hightree:=cloadnode.create(pvarsym(srsym),st);
+                    srsym:=searchsymonlyin(st,'high'+tvarsym(tloadnode(left).symtableentry).name);
+                    hightree:=cloadnode.create(tvarsym(srsym),st);
                     loadconst:=false;
                   end
                  else
-                  len:=pstringdef(left.resulttype.def)^.len;
+                  len:=tstringdef(left.resulttype.def).len;
                end
               else
              { passing a string to an array of char }
@@ -521,7 +521,7 @@ implementation
                                  TCALLNODE
  ****************************************************************************}
 
-    constructor tcallnode.create(l:tnode;v : pprocsym;st : psymtable; mp : tnode);
+    constructor tcallnode.create(l:tnode;v : tprocsym;st : tsymtable; mp : tnode);
 
       begin
          inherited create(calln,l,nil);
@@ -571,25 +571,25 @@ implementation
       type
          pprocdefcoll = ^tprocdefcoll;
          tprocdefcoll = record
-            data      : pprocdef;
+            data      : tprocdef;
             nextpara  : tparaitem;
             firstpara : tparaitem;
             next      : pprocdefcoll;
          end;
       var
          hp,procs,hp2 : pprocdefcoll;
-         pd : pprocdef;
-         oldcallprocsym : pprocsym;
-         def_from,def_to,conv_to : pdef;
-         hpt,hpt2 : tnode;
+         pd : tprocdef;
+         oldcallprocsym : tprocsym;
+         def_from,def_to,conv_to : tdef;
+         hpt : tnode;
          pt : tcallparanode;
          exactmatch : boolean;
          paralength,lastpara : longint;
-         lastparatype : pdef;
+         lastparatype : tdef;
          pdc : tparaitem;
 {$ifdef TEST_PROCSYMS}
-         nextprocsym : pprocsym;
-         symt : psymtable;
+         nextprocsym : tprocsym;
+         symt : tsymtable;
 {$endif TEST_PROCSYMS}
          { only Dummy }
          hcvt : tconverttype;
@@ -598,7 +598,7 @@ implementation
 
       { check if the resulttype.def from tree p is equal with def, needed
         for stringconstn and formaldef }
-      function is_equal(p:tcallparanode;def:pdef) : boolean;
+      function is_equal(p:tcallparanode;def:tdef) : boolean;
 
         begin
            { safety check }
@@ -608,7 +608,7 @@ implementation
               exit;
             end;
            { all types can be passed to a formaldef }
-           is_equal:=(def^.deftype=formaldef) or
+           is_equal:=(def.deftype=formaldef) or
              (types.is_equal(p.resulttype.def,def))
            { integer constants are compatible with all integer parameters if
              the specified value matches the range }
@@ -617,16 +617,16 @@ implementation
               (tbinarynode(p).left.nodetype=ordconstn) and
               is_integer(p.resulttype.def) and
               is_integer(def) and
-              (tordconstnode(p.left).value>=porddef(def)^.low) and
-              (tordconstnode(p.left).value<=porddef(def)^.high)
+              (tordconstnode(p.left).value>=torddef(def).low) and
+              (tordconstnode(p.left).value<=torddef(def).high)
              )
            { to support ansi/long/wide strings in a proper way }
            { string and string[10] are assumed as equal }
            { when searching the correct overloaded procedure   }
              or
              (
-              (def^.deftype=stringdef) and (p.resulttype.def^.deftype=stringdef) and
-              (pstringdef(def)^.string_typ=pstringdef(p.resulttype.def)^.string_typ)
+              (def.deftype=stringdef) and (p.resulttype.def.deftype=stringdef) and
+              (tstringdef(def).string_typ=tstringdef(p.resulttype.def).string_typ)
              )
              or
              (
@@ -641,32 +641,32 @@ implementation
            { set can also be a not yet converted array constructor }
              or
              (
-              (def^.deftype=setdef) and (p.resulttype.def^.deftype=arraydef) and
-              (parraydef(p.resulttype.def)^.IsConstructor) and not(parraydef(p.resulttype.def)^.IsVariant)
+              (def.deftype=setdef) and (p.resulttype.def.deftype=arraydef) and
+              (tarraydef(p.resulttype.def).IsConstructor) and not(tarraydef(p.resulttype.def).IsVariant)
              )
            { in tp7 mode proc -> procvar is allowed }
              or
              (
               (m_tp_procvar in aktmodeswitches) and
-              (def^.deftype=procvardef) and (p.left.nodetype=calln) and
-              (proc_to_procvar_equal(pprocdef(tcallnode(p.left).procdefinition),pprocvardef(def)))
+              (def.deftype=procvardef) and (p.left.nodetype=calln) and
+              (proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def)))
              )
              ;
         end;
 
-      function is_in_limit(def_from,def_to : pdef) : boolean;
+      function is_in_limit(def_from,def_to : tdef) : boolean;
 
         begin
-           is_in_limit:=(def_from^.deftype = orddef) and
-                        (def_to^.deftype = orddef) and
-                        (porddef(def_from)^.low>porddef(def_to)^.low) and
-                        (porddef(def_from)^.high<porddef(def_to)^.high);
+           is_in_limit:=(def_from.deftype = orddef) and
+                        (def_to.deftype = orddef) and
+                        (torddef(def_from).low>torddef(def_to).low) and
+                        (torddef(def_from).high<torddef(def_to).high);
         end;
 
       var
         i : longint;
         is_const : boolean;
-        bestord  : porddef;
+        bestord  : torddef;
       begin
          result:=nil;
 
@@ -683,7 +683,7 @@ implementation
                exit;
 
               { check the parameters }
-              pdc:=tparaitem(pprocvardef(right.resulttype.def)^.Para.first);
+              pdc:=tparaitem(tprocvardef(right.resulttype.def).Para.first);
               pt:=tcallparanode(left);
               while assigned(pdc) and assigned(pt) do
                 begin
@@ -697,7 +697,7 @@ implementation
                    CGMessage(parser_e_illegal_parameter_list);
                 end;
 
-              procdefinition:=pabstractprocdef(right.resulttype.def);
+              procdefinition:=tabstractprocdef(right.resulttype.def);
            end
          else
          { not a procedure variable }
@@ -710,7 +710,7 @@ implementation
                      goto errorexit;
                 end;
 
-              aktcallprocsym:=pprocsym(symtableprocentry);
+              aktcallprocsym:=tprocsym(symtableprocentry);
               { do we know the procedure to call ? }
               if not(assigned(procdefinition)) then
                 begin
@@ -725,9 +725,9 @@ implementation
                      while assigned(symt^.next) and not assigned(srsym) do
                        begin
                           symt:=symt^.next;
-                          srsym:=searchsymonlyin(symt,actprocsym^.name);
+                          srsym:=searchsymonlyin(symt,actprocsym.name);
                           if assigned(srsym) then
-                            if srsym^.typ<>procsym then
+                            if srsym.typ<>procsym then
                               begin
                                  { reject all that is not a procedure }
                                  srsym:=nil;
@@ -749,25 +749,25 @@ implementation
                      end;
 
                    { link all procedures which have the same # of parameters }
-                   pd:=aktcallprocsym^.definition;
+                   pd:=aktcallprocsym.definition;
                    while assigned(pd) do
                      begin
                         { only when the # of parameter are supported by the
                           procedure }
-                        if (paralength>=pd^.minparacount) and (paralength<=pd^.maxparacount) then
+                        if (paralength>=pd.minparacount) and (paralength<=pd.maxparacount) then
                           begin
                              new(hp);
                              hp^.data:=pd;
                              hp^.next:=procs;
-                             hp^.firstpara:=tparaitem(pd^.Para.first);
+                             hp^.firstpara:=tparaitem(pd.Para.first);
                              { if not all parameters are given, then skip the
                                default parameters }
-                             for i:=1 to pd^.maxparacount-paralength do
+                             for i:=1 to pd.maxparacount-paralength do
                               hp^.firstpara:=tparaitem(hp^.firstPara.next);
                              hp^.nextpara:=hp^.firstpara;
                              procs:=hp;
                           end;
-                        pd:=pd^.nextoverloaded;
+                        pd:=pd.nextoverloaded;
                      end;
 
                    { no procedures found? then there is something wrong
@@ -779,8 +779,8 @@ implementation
                       if not(assigned(left)) and
                          (m_tp_procvar in aktmodeswitches) then
                         begin
-                          hpt:=cloadnode.create(pprocsym(symtableprocentry),symtableproc);
-                          if (symtableprocentry^.owner^.symtabletype=objectsymtable) and
+                          hpt:=cloadnode.create(tprocsym(symtableprocentry),symtableproc);
+                          if (symtableprocentry.owner.symtabletype=objectsymtable) and
                              assigned(methodpointer) then
                             tloadnode(hpt).set_mp(methodpointer.getcopy);
                           resulttypepass(hpt);
@@ -791,7 +791,7 @@ implementation
                           if assigned(left) then
                            aktfilepos:=left.fileinfo;
                           CGMessage(parser_e_wrong_parameter_size);
-                          aktcallprocsym^.write_parameter_lists(nil);
+                          aktcallprocsym.write_parameter_lists(nil);
                         end;
                       goto errorexit;
                     end;
@@ -913,9 +913,9 @@ implementation
                         begin
                           aktfilepos:=pt.fileinfo;
                           CGMessage3(type_e_wrong_parameter_type,tostr(lastpara),
-                            pt.resulttype.def^.typename,lastparatype^.typename);
+                            pt.resulttype.def.typename,lastparatype.typename);
                         end;
-                      aktcallprocsym^.write_parameter_lists(nil);
+                      aktcallprocsym.write_parameter_lists(nil);
                       goto errorexit;
                     end;
 
@@ -947,10 +947,10 @@ implementation
                                   if not is_equal(pt,hp^.nextPara.paratype.def) then
                                     begin
                                        def_to:=hp^.nextPara.paratype.def;
-                                       if ((def_from^.deftype=orddef) and (def_to^.deftype=orddef)) and
+                                       if ((def_from.deftype=orddef) and (def_to.deftype=orddef)) and
                                          (is_in_limit(def_from,def_to) or
                                          ((hp^.nextPara.paratyp in [vs_var,vs_out]) and
-                                         (def_from^.size=def_to^.size))) then
+                                         (def_from.size=def_to.size))) then
                                          begin
                                             exactmatch:=true;
                                             conv_to:=def_to;
@@ -982,9 +982,9 @@ implementation
                                        else
                                          begin
                                            def_to:=hp^.next^.nextPara.paratype.def;
-                                           if (conv_to^.size>def_to^.size) or
-                                              ((porddef(conv_to)^.low<porddef(def_to)^.low) and
-                                              (porddef(conv_to)^.high>porddef(def_to)^.high)) then
+                                           if (conv_to.size>def_to.size) or
+                                              ((torddef(conv_to).low<torddef(def_to).low) and
+                                              (torddef(conv_to).high>torddef(def_to).high)) then
                                              begin
                                                 hp2:=procs;
                                                 procs:=hp;
@@ -1082,9 +1082,9 @@ implementation
                                   if not is_integer(def_to) then
                                    internalerror(43297815);
                                   if (not assigned(bestord)) or
-                                     ((porddef(def_to)^.low>bestord^.low) or
-                                      (porddef(def_to)^.high<bestord^.high)) then
-                                   bestord:=porddef(def_to);
+                                     ((torddef(def_to).low>bestord.low) or
+                                      (torddef(def_to).high<bestord.high)) then
+                                   bestord:=torddef(def_to);
                                   hp:=hp^.next;
                                 end;
                              end;
@@ -1098,7 +1098,7 @@ implementation
                                 begin
                                   hp2:=hp^.next;
                                   { keep matching bestord, dispose the others }
-                                  if (porddef(hp^.nextPara.paratype.def)=bestord) then
+                                  if (torddef(hp^.nextPara.paratype.def)=bestord) then
                                    begin
                                      hp^.next:=procs;
                                      procs:=hp;
@@ -1172,7 +1172,7 @@ implementation
                    if not(assigned(procs)) or assigned(procs^.next) then
                      begin
                         CGMessage(cg_e_cant_choose_overload_function);
-                        aktcallprocsym^.write_parameter_lists(nil);
+                        aktcallprocsym.write_parameter_lists(nil);
                         goto errorexit;
                      end;
 {$ifdef TEST_PROCSYMS}
@@ -1185,24 +1185,24 @@ implementation
 {$endif TEST_PROCSYMS}
                    if make_ref then
                      begin
-                        procs^.data^.lastref:=new(pref,init(procs^.data^.lastref,@fileinfo));
-                        inc(procs^.data^.refcount);
-                        if procs^.data^.defref=nil then
-                          procs^.data^.defref:=procs^.data^.lastref;
+                        procs^.data.lastref:=tref.create(procs^.data.lastref,@fileinfo);
+                        inc(procs^.data.refcount);
+                        if procs^.data.defref=nil then
+                          procs^.data.defref:=procs^.data.lastref;
                      end;
 
                    procdefinition:=procs^.data;
                    { big error for with statements
-                   symtableproc:=procdefinition^.owner;
+                   symtableproc:=procdefinition.owner;
                    but neede for overloaded operators !! }
                    if symtableproc=nil then
-                     symtableproc:=procdefinition^.owner;
+                     symtableproc:=procdefinition.owner;
 
 {$ifdef CHAINPROCSYMS}
                    { object with method read;
                      call to read(x) will be a usual procedure call }
                    if assigned(methodpointer) and
-                     (procdefinition^._class=nil) then
+                     (procdefinition._class=nil) then
                      begin
                         { not ok for extended }
                         case methodpointer^.nodetype of
@@ -1217,70 +1217,74 @@ implementation
 
               { add needed default parameters }
               if assigned(procs) and
-                 (paralength<procdefinition^.maxparacount) then
+                 (paralength<procdefinition.maxparacount) then
                begin
                  { add default parameters, just read back the skipped
                    paras starting from firstPara.previous, when not available
                    (all parameters are default) then start with the last
                    parameter and read backward (PFV) }
                  if not assigned(procs^.firstpara) then
-                  pdc:=tparaitem(procs^.data^.Para.last)
+                  pdc:=tparaitem(procs^.data.Para.last)
                  else
                   pdc:=tparaitem(procs^.firstPara.previous);
                  while assigned(pdc) do
                   begin
                     if not assigned(pdc.defaultvalue) then
                      internalerror(751349858);
-                    left:=ccallparanode.create(genconstsymtree(pconstsym(pdc.defaultvalue)),left);
+                    left:=ccallparanode.create(genconstsymtree(tconstsym(pdc.defaultvalue)),left);
                     pdc:=tparaitem(pdc.previous);
                   end;
                end;
            end;
 
               { handle predefined procedures }
-              is_const:=(pocall_internconst in procdefinition^.proccalloptions) and
+              is_const:=(pocall_internconst in procdefinition.proccalloptions) and
                         ((block_type in [bt_const,bt_type]) or
                          (assigned(left) and (tcallparanode(left).left.nodetype in [realconstn,ordconstn])));
-              if (pocall_internproc in procdefinition^.proccalloptions) or is_const then
+              if (pocall_internproc in procdefinition.proccalloptions) or is_const then
                 begin
                    if assigned(left) then
                      begin
-                       hpt2:=left;
-                       left:=nil;
                      { ptr and settextbuf needs two args }
-                       if assigned(tcallparanode(hpt2).right) then
-                        hpt:=geninlinenode(pprocdef(procdefinition)^.extnumber,is_const,hpt2)
+                       if assigned(tcallparanode(left).right) then
+                        begin
+                          hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,left);
+                          left:=nil;
+                        end
                        else
-                        hpt:=geninlinenode(pprocdef(procdefinition)^.extnumber,is_const,tcallparanode(hpt2).left);
+                        begin
+                          hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,tcallparanode(left).left);
+                          tcallparanode(left).left:=nil;
+                        end;
                      end
                    else
-                     hpt:=geninlinenode(pprocdef(procdefinition)^.extnumber,is_const,nil);
-                   firstpass(hpt);
+                     hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,nil);
+                   resulttypepass(hpt);
                    result:=hpt;
                    goto errorexit;
                 end;
 
          { Calling a message method directly ? }
          if assigned(procdefinition) and
-            (po_containsself in procdefinition^.procoptions) then
+            (po_containsself in procdefinition.procoptions) then
            message(cg_e_cannot_call_message_direct);
 
          { ensure that the result type is set }
-         resulttype:=procdefinition^.rettype;
+         resulttype:=procdefinition.rettype;
 
          { constructors return their current class type, not the type where the
            constructor is declared, this can be different because of inheritance }
-         if (procdefinition^.proctypeoption=potype_constructor) then
+         if (procdefinition.proctypeoption=potype_constructor) then
            begin
              if assigned(methodpointer) and
                 assigned(methodpointer.resulttype.def) and
-                (methodpointer.resulttype.def^.deftype=classrefdef) then
-               resulttype:=pclassrefdef(methodpointer.resulttype.def)^.pointertype;
+                (methodpointer.resulttype.def.deftype=classrefdef) then
+               resulttype:=tclassrefdef(methodpointer.resulttype.def).pointertype;
            end;
 
          { insert type conversions }
          if assigned(left) then
-          tcallparanode(left).insert_typeconv(tparaitem(procdefinition^.Para.first),true);
+          tcallparanode(left).insert_typeconv(tparaitem(procdefinition.Para.first),true);
 
       errorexit:
          { Reset some settings back }
@@ -1292,7 +1296,7 @@ implementation
 
     function tcallnode.pass_1 : tnode;
       var
-         hpt,hpt2,inlinecode : tnode;
+         inlinecode : tnode;
          inlined : boolean;
 {$ifdef m68k}
          regi : tregister;
@@ -1300,8 +1304,6 @@ implementation
          method_must_be_valid : boolean;
       label
         errorexit;
-      var
-        is_const : boolean;
       begin
          result:=nil;
          inlined:=false;
@@ -1311,13 +1313,13 @@ implementation
            tcallparanode(left).det_registers;
 
          if assigned(procdefinition) and
-            (pocall_inline in procdefinition^.proccalloptions) then
+            (pocall_inline in procdefinition.proccalloptions) then
            begin
               inlinecode:=right;
               if assigned(inlinecode) then
                 begin
                    inlined:=true;
-                   exclude(procdefinition^.proccalloptions,pocall_inline);
+                   exclude(procdefinition.proccalloptions,pocall_inline);
                 end;
               right:=nil;
            end;
@@ -1348,7 +1350,7 @@ implementation
 
               { calc the correture value for the register }
               { handle predefined procedures }
-              if (pocall_inline in procdefinition^.proccalloptions) then
+              if (pocall_inline in procdefinition.proccalloptions) then
                 begin
                    if assigned(methodpointer) then
                      CGMessage(cg_e_unable_inline_object_methods);
@@ -1357,15 +1359,15 @@ implementation
                    { nodetype:=procinlinen; }
                    if not assigned(right) then
                      begin
-                        if assigned(pprocdef(procdefinition)^.code) then
-                          inlinecode:=cprocinlinenode.create(self,tnode(pprocdef(procdefinition)^.code))
+                        if assigned(tprocdef(procdefinition).code) then
+                          inlinecode:=cprocinlinenode.create(self,tnode(tprocdef(procdefinition).code))
                         else
                           CGMessage(cg_e_no_code_for_inline_stored);
                         if assigned(inlinecode) then
                           begin
                              { consider it has not inlined if called
                                again inside the args }
-                             exclude(procdefinition^.proccalloptions,pocall_inline);
+                             exclude(procdefinition.proccalloptions,pocall_inline);
                              firstpass(inlinecode);
                              inlined:=true;
                           end;
@@ -1379,12 +1381,12 @@ implementation
 
 {$ifndef newcg}
 {$ifdef i386}
-              incrementregisterpushed(pprocdef(procdefinition)^.usedregisters);
+              incrementregisterpushed(tprocdef(procdefinition).usedregisters);
 {$endif}
 {$ifdef m68k}
              for regi:=R_D0 to R_A6 do
                begin
-                  if (pprocdef(procdefinition)^.usedregisters and ($800 shr word(regi)))<>0 then
+                  if (tprocdef(procdefinition).usedregisters and ($800 shr word(regi)))<>0 then
                     inc(reg_pushes[regi],t_times*2);
                end;
 {$endif}
@@ -1394,13 +1396,13 @@ implementation
          { get a register for the return value }
          if (not is_void(resulttype.def)) then
            begin
-              if (procdefinition^.proctypeoption=potype_constructor) then
+              if (procdefinition.proctypeoption=potype_constructor) then
                 begin
                    { extra handling of classes }
                    { methodpointer should be assigned! }
                    if assigned(methodpointer) and
                       assigned(methodpointer.resulttype.def) and
-                      (methodpointer.resulttype.def^.deftype=classrefdef) then
+                      (methodpointer.resulttype.def.deftype=classrefdef) then
                      begin
                         location.loc:=LOC_REGISTER;
                         registers32:=1;
@@ -1441,7 +1443,7 @@ implementation
                              registers32:=1;
                           end;
                      end
-                   else if (resulttype.def^.deftype=floatdef) then
+                   else if (resulttype.def.deftype=floatdef) then
                      begin
                         location.loc:=LOC_FPU;
                         registersfpu:=1;
@@ -1451,7 +1453,7 @@ implementation
                 end;
            end;
          { a fpu can be used in any procedure !! }
-         registersfpu:=procdefinition^.fpu_used;
+         registersfpu:=procdefinition.fpu_used;
          { if this is a call to a method calc the registers }
          if (methodpointer<>nil) then
            begin
@@ -1463,9 +1465,9 @@ implementation
                           registers32:=1;
                 else
                   begin
-                     if (procdefinition^.proctypeoption in [potype_constructor,potype_destructor]) and
-                        assigned(symtableproc) and (symtableproc^.symtabletype=withsymtable) and
-                        not pwithsymtable(symtableproc)^.direct_with then
+                     if (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) and
+                        assigned(symtableproc) and (symtableproc.symtabletype=withsymtable) and
+                        not twithsymtable(symtableproc).direct_with then
                        begin
                           CGmessage(cg_e_cannot_call_cons_dest_inside_with);
                        end; { Is accepted by Delphi !! }
@@ -1474,9 +1476,9 @@ implementation
 
                      { R.Assign is not a constructor !!! }
                      { but for R^.Assign, R must be valid !! }
-                     if (procdefinition^.proctypeoption=potype_constructor) or
+                     if (procdefinition.proctypeoption=potype_constructor) or
                         ((methodpointer.nodetype=loadn) and
-                        (not(oo_has_virtual in pobjectdef(methodpointer.resulttype.def)^.objectoptions))) then
+                        (not(oo_has_virtual in tobjectdef(methodpointer.resulttype.def).objectoptions))) then
                        method_must_be_valid:=false
                      else
                        method_must_be_valid:=true;
@@ -1484,8 +1486,8 @@ implementation
                      set_varstate(methodpointer,method_must_be_valid);
                      { The object is already used ven if it is called once }
                      if (methodpointer.nodetype=loadn) and
-                        (tloadnode(methodpointer).symtableentry^.typ=varsym) then
-                       pvarsym(tloadnode(methodpointer).symtableentry)^.varstate:=vs_used;
+                        (tloadnode(methodpointer).symtableentry.typ=varsym) then
+                       tvarsym(tloadnode(methodpointer).symtableentry).varstate:=vs_used;
 
                      registersfpu:=max(methodpointer.registersfpu,registersfpu);
                      registers32:=max(methodpointer.registers32,registers32);
@@ -1519,7 +1521,7 @@ implementation
            end;
       errorexit:
          if inlined then
-           include(procdefinition^.proccalloptions,pocall_inline);
+           include(procdefinition.proccalloptions,pocall_inline);
       end;
 
 
@@ -1544,8 +1546,8 @@ implementation
          inlineprocsym:=tcallnode(callp).symtableprocentry;
          retoffset:=-target_os.size_of_pointer; { less dangerous as zero (PM) }
          para_offset:=0;
-         para_size:=inlineprocsym^.definition^.para_size(target_os.stackalignment);
-         if ret_in_param(inlineprocsym^.definition^.rettype.def) then
+         para_size:=inlineprocsym.definition.para_size(target_os.stackalignment);
+         if ret_in_param(inlineprocsym.definition.rettype.def) then
            para_size:=para_size+target_os.size_of_pointer;
          { copy args }
          if assigned(code) then
@@ -1556,7 +1558,7 @@ implementation
 {$ifdef SUPPORT_MMX}
          registersmmx:=code.registersmmx;
 {$endif SUPPORT_MMX}
-         resulttype:=inlineprocsym^.definition^.rettype;
+         resulttype:=inlineprocsym.definition.rettype;
       end;
 
     destructor tprocinlinenode.destroy;
@@ -1613,7 +1615,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.26  2001-04-04 22:42:39  peter
+  Revision 1.27  2001-04-13 01:22:08  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.26  2001/04/04 22:42:39  peter
     * move constant folding into det_resulttype
 
   Revision 1.25  2001/04/02 21:20:30  peter

compiler/ncgbas.pas

@@ -52,7 +52,7 @@ unit ncgbas;
 
     uses
       globtype,systems,
-      cutils,cobjects,verbose,globals,
+      cutils,cclasses,verbose,globals,
       aasm,symtable,types,
       htypechk,
       cpubase,cpuasm,
@@ -108,7 +108,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2000-10-14 10:14:50  peter
+  Revision 1.2  2001-04-13 01:22:08  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.1  2000/10/14 10:14:50  peter
     * moehrendorf oct 2000 rewrite
 
-}
+}

compiler/ncnv.pas

@@ -153,14 +153,14 @@ implementation
 
         procedure update_constsethi(t:ttype);
         begin
-          if ((t.def^.deftype=orddef) and
-              (porddef(t.def)^.high>=constsethi)) then
+          if ((t.def.deftype=orddef) and
+              (torddef(t.def).high>=constsethi)) then
             begin
-               constsethi:=porddef(t.def)^.high;
+               constsethi:=torddef(t.def).high;
                if htype.def=nil then
                  begin
                     if (constsethi>255) or
-                       (porddef(t.def)^.low<0) then
+                       (torddef(t.def).low<0) then
                       htype:=u8bittype
                     else
                       htype:=t;
@@ -168,12 +168,12 @@ implementation
                if constsethi>255 then
                  constsethi:=255;
             end
-          else if ((t.def^.deftype=enumdef) and
-                  (penumdef(t.def)^.max>=constsethi)) then
+          else if ((t.def.deftype=enumdef) and
+                  (tenumdef(t.def).max>=constsethi)) then
             begin
                if htype.def=nil then
                  htype:=t;
-               constsethi:=penumdef(t.def)^.max;
+               constsethi:=tenumdef(t.def).max;
             end;
         end;
 
@@ -232,7 +232,7 @@ implementation
                resulttypepass(p3);
               if codegenerror then
                break;
-              case p2.resulttype.def^.deftype of
+              case p2.resulttype.def.deftype of
                  enumdef,
                  orddef:
                    begin
@@ -353,7 +353,7 @@ implementation
            p.free;
          end;
       { set the initial set type }
-        constp.resulttype.setdef(new(psetdef,init(htype,constsethi)));
+        constp.resulttype.setdef(tsetdef.create(htype,constsethi));
       { determine the resulttype for the tree }
         resulttypepass(buildp);
       { set the new tree }
@@ -427,7 +427,7 @@ implementation
          result:=nil;
          if left.nodetype=stringconstn then
           begin
-             tstringconstnode(left).st_type:=pstringdef(resulttype.def)^.string_typ;
+             tstringconstnode(left).st_type:=tstringdef(resulttype.def).string_typ;
              tstringconstnode(left).resulttype:=resulttype;
              result:=left;
              left:=nil;
@@ -443,7 +443,7 @@ implementation
          if left.nodetype=ordconstn then
            begin
               hp:=cstringconstnode.createstr(chr(tordconstnode(left).value),st_default);
-              hp.st_type:=pstringdef(resulttype.def)^.string_typ;
+              hp.st_type:=tstringdef(resulttype.def).string_typ;
               resulttypepass(hp);
               result:=hp;
            end;
@@ -558,8 +558,7 @@ implementation
     function ttypeconvnode.det_resulttype:tnode;
       var
         hp : tnode;
-        aprocdef : pprocdef;
-        enable_range_check: boolean;
+        aprocdef : tprocdef;
       begin
         result:=nil;
         resulttype:=totype;
@@ -573,16 +572,16 @@ implementation
           begin
           { becuase is_equal only checks the basetype for sets we need to
             check here if we are loading a smallset into a normalset }
-            if (resulttype.def^.deftype=setdef) and
-               (left.resulttype.def^.deftype=setdef) and
-               (psetdef(resulttype.def)^.settype<>smallset) and
-               (psetdef(left.resulttype.def)^.settype=smallset) then
+            if (resulttype.def.deftype=setdef) and
+               (left.resulttype.def.deftype=setdef) and
+               (tsetdef(resulttype.def).settype<>smallset) and
+               (tsetdef(left.resulttype.def).settype=smallset) then
              begin
              { try to define the set as a normalset if it's a constant set }
                if left.nodetype=setconstn then
                 begin
                   resulttype:=left.resulttype;
-                  psetdef(resulttype.def)^.settype:=normset
+                  tsetdef(resulttype.def).settype:=normset
                 end
                else
                 convtype:=tc_load_smallset;
@@ -618,45 +617,45 @@ implementation
            use an extra check for them.}
            if (m_tp_procvar in aktmodeswitches) then
             begin
-              if (resulttype.def^.deftype=procvardef) and
+              if (resulttype.def.deftype=procvardef) and
                  (is_procsym_load(left) or is_procsym_call(left)) then
                begin
                  if is_procsym_call(left) then
                   begin
-                    hp:=cloadnode.create(pprocsym(tcallnode(left).symtableprocentry),
+                    hp:=cloadnode.create(tprocsym(tcallnode(left).symtableprocentry),
                         tcallnode(left).symtableproc);
-                    if (tcallnode(left).symtableprocentry^.owner^.symtabletype=objectsymtable) and
+                    if (tcallnode(left).symtableprocentry.owner.symtabletype=objectsymtable) and
                        assigned(tcallnode(left).methodpointer) then
                       tloadnode(hp).set_mp(tcallnode(left).methodpointer.getcopy);
                     resulttypepass(hp);
                     left.free;
                     left:=hp;
-                    aprocdef:=pprocdef(left.resulttype.def);
+                    aprocdef:=tprocdef(left.resulttype.def);
                   end
                  else
                   begin
                     if (left.nodetype<>addrn) then
-                      aprocdef:=pprocsym(tloadnode(left).symtableentry)^.definition;
+                      aprocdef:=tprocsym(tloadnode(left).symtableentry).definition;
                   end;
                  convtype:=tc_proc_2_procvar;
                  { Now check if the procedure we are going to assign to
                    the procvar,  is compatible with the procvar's type }
                  if assigned(aprocdef) then
                   begin
-                    if not proc_to_procvar_equal(aprocdef,pprocvardef(resulttype.def)) then
-                     CGMessage2(type_e_incompatible_types,aprocdef^.typename,resulttype.def^.typename);
+                    if not proc_to_procvar_equal(aprocdef,tprocvardef(resulttype.def)) then
+                     CGMessage2(type_e_incompatible_types,aprocdef.typename,resulttype.def.typename);
                     result:=first_call_helper(convtype);
                   end
                  else
-                  CGMessage2(type_e_incompatible_types,left.resulttype.def^.typename,resulttype.def^.typename);
+                  CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
                  exit;
                end;
             end;
            if nf_explizit in flags then
             begin
               { check if the result could be in a register }
-              if not(pstoreddef(resulttype.def)^.is_intregable) and
-                not(pstoreddef(resulttype.def)^.is_fpuregable) then
+              if not(tstoreddef(resulttype.def).is_intregable) and
+                not(tstoreddef(resulttype.def).is_fpuregable) then
                 make_not_regable(left);
               { boolean to byte are special because the
                 location can be different }
@@ -680,7 +679,7 @@ implementation
               convtype:=tc_equal;
 
               { enum to ordinal will always be s32bit }
-              if (left.resulttype.def^.deftype=enumdef) and
+              if (left.resulttype.def.deftype=enumdef) and
                  is_ordinal(resulttype.def) then
                begin
                  if left.nodetype=ordconstn then
@@ -693,13 +692,13 @@ implementation
                  else
                   begin
                     if isconvertable(s32bittype.def,resulttype.def,convtype,ordconstn,false)=0 then
-                      CGMessage2(type_e_incompatible_types,left.resulttype.def^.typename,resulttype.def^.typename);
+                      CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
                   end;
                end
 
               { ordinal to enumeration }
               else
-               if (resulttype.def^.deftype=enumdef) and
+               if (resulttype.def.deftype=enumdef) and
                   is_ordinal(left.resulttype.def) then
                 begin
                   if left.nodetype=ordconstn then
@@ -712,7 +711,7 @@ implementation
                   else
                    begin
                      if IsConvertable(left.resulttype.def,s32bittype.def,convtype,ordconstn,false)=0 then
-                       CGMessage2(type_e_incompatible_types,left.resulttype.def^.typename,resulttype.def^.typename);
+                       CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
                    end;
                 end
 
@@ -750,7 +749,7 @@ implementation
                    else
                     begin
                       if IsConvertable(left.resulttype.def,u8bittype.def,convtype,ordconstn,false)=0 then
-                        CGMessage2(type_e_incompatible_types,left.resulttype.def^.typename,resulttype.def^.typename);
+                        CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
                     end;
                  end
 
@@ -769,7 +768,7 @@ implementation
                    else
                     begin
                       if IsConvertable(u8bittype.def,resulttype.def,convtype,ordconstn,false)=0 then
-                        CGMessage2(type_e_incompatible_types,left.resulttype.def^.typename,resulttype.def^.typename);
+                        CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
                     end;
                  end
 
@@ -778,23 +777,23 @@ implementation
                else
                 begin
                   if not(
-                     (left.resulttype.def^.deftype=formaldef) or
-                     (left.resulttype.def^.size=resulttype.def^.size) or
+                     (left.resulttype.def.deftype=formaldef) or
+                     (left.resulttype.def.size=resulttype.def.size) or
                      (is_void(left.resulttype.def)  and
                       (left.nodetype=derefn))
                      ) then
                     CGMessage(cg_e_illegal_type_conversion);
-                  if ((left.resulttype.def^.deftype=orddef) and
-                      (resulttype.def^.deftype=pointerdef)) or
-                      ((resulttype.def^.deftype=orddef) and
-                       (left.resulttype.def^.deftype=pointerdef)) then
+                  if ((left.resulttype.def.deftype=orddef) and
+                      (resulttype.def.deftype=pointerdef)) or
+                      ((resulttype.def.deftype=orddef) and
+                       (left.resulttype.def.deftype=pointerdef)) then
                     CGMessage(cg_d_pointer_to_longint_conv_not_portable);
                 end;
 
                { the conversion into a strutured type is only }
                { possible, if the source is no register    }
-               if ((resulttype.def^.deftype in [recorddef,stringdef,arraydef]) or
-                   ((resulttype.def^.deftype=objectdef) and not(is_class(resulttype.def)))
+               if ((resulttype.def.deftype in [recorddef,stringdef,arraydef]) or
+                   ((resulttype.def.deftype=objectdef) and not(is_class(resulttype.def)))
                   ) and (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) { and
                    it also works if the assignment is overloaded
                    YES but this code is not executed if assignment is overloaded (PM)
@@ -802,7 +801,7 @@ implementation
                  CGMessage(cg_e_illegal_type_conversion);
             end
            else
-            CGMessage2(type_e_incompatible_types,left.resulttype.def^.typename,resulttype.def^.typename);
+            CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
          end;
 
        { tp7 procvar support, when right is not a procvardef and we got a
@@ -810,8 +809,8 @@ implementation
          result is already done in is_convertible, also no conflict with
          @procvar is here because that has an extra addrn }
          if (m_tp_procvar in aktmodeswitches) and
-            (resulttype.def^.deftype<>procvardef) and
-            (left.resulttype.def^.deftype=procvardef) and
+            (resulttype.def.deftype<>procvardef) and
+            (left.resulttype.def.deftype=procvardef) and
             (left.nodetype=loadn) then
           begin
             hp:=ccallnode.create(nil,nil,nil,nil);
@@ -823,30 +822,11 @@ implementation
         { ordinal contants can be directly converted }
         if (left.nodetype=ordconstn) and is_ordinal(resulttype.def)  then
           begin
-             { range checking is done in cordconstnode.create (PFV) }
-             { disable for explicit type casts (JM) }
-             if (nf_explizit in flags) and
-                (cs_check_range in aktlocalswitches) then
-               begin
-                 exclude(aktlocalswitches,cs_check_range);
-                 enable_range_check := true;
-               end
-             else
-               enable_range_check := false;
-             hp:=cordconstnode.create(tordconstnode(left).value,resulttype);
-             resulttypepass(hp);
-             { do sign extension if necessary (JM) }
-             if not (cs_check_range in aktlocalswitches) and
-                is_signed(resulttype.def) then
-               with tordconstnode(hp) do
-                 case resulttype.def^.size of
-                   1: value := shortint(value);
-                   2: value := smallint(value);
-                   4: value := longint(value);
-                 end;
-             if enable_range_check then
-               include(aktlocalswitches,cs_check_range);
-             result:=hp;
+             { replace the resulttype and recheck the range }
+             left.resulttype:=resulttype;
+             testrange(left.resulttype.def,tordconstnode(left).value,(nf_explizit in flags));
+             result:=left;
+             left:=nil;
              exit;
           end;
 
@@ -866,7 +846,7 @@ implementation
       begin
         first_int_to_int:=nil;
         if (left.location.loc<>LOC_REGISTER) and
-           (resulttype.def^.size>left.resulttype.def^.size) then
+           (resulttype.def.size>left.resulttype.def.size) then
            location.loc:=LOC_REGISTER;
         if is_64bitint(resulttype.def) then
           registers32:=max(registers32,2)
@@ -894,14 +874,14 @@ implementation
     function ttypeconvnode.first_string_to_string : tnode;
       begin
          first_string_to_string:=nil;
-         if pstringdef(resulttype.def)^.string_typ<>
-            pstringdef(left.resulttype.def)^.string_typ then
+         if tstringdef(resulttype.def).string_typ<>
+            tstringdef(left.resulttype.def).string_typ then
            begin
              procinfo^.flags:=procinfo^.flags or pi_do_call;
            end;
          { for simplicity lets first keep all ansistrings
            as LOC_MEM, could also become LOC_REGISTER }
-         if pstringdef(resulttype.def)^.string_typ in [st_ansistring,st_widestring] then
+         if tstringdef(resulttype.def).string_typ in [st_ansistring,st_widestring] then
            { we may use ansistrings so no fast exit here }
            procinfo^.no_fast_exit:=true;
          location.loc:=LOC_MEM;
@@ -945,8 +925,8 @@ implementation
          first_real_to_real:=nil;
         { comp isn't a floating type }
 {$ifdef i386}
-         if (pfloatdef(resulttype.def)^.typ=s64comp) and
-            (pfloatdef(left.resulttype.def)^.typ<>s64comp) and
+         if (tfloatdef(resulttype.def).typ=s64comp) and
+            (tfloatdef(left.resulttype.def).typ<>s64comp) and
             not (nf_explizit in flags) then
            CGMessage(type_w_convert_real_2_comp);
 {$endif}
@@ -988,7 +968,7 @@ implementation
          { byte(boolean) or word(wordbool) or longint(longbool) must
          be accepted for var parameters }
          if (nf_explizit in flags) and
-            (left.resulttype.def^.size=resulttype.def^.size) and
+            (left.resulttype.def.size=resulttype.def.size) and
             (left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
            exit;
          location.loc:=LOC_REGISTER;
@@ -1003,7 +983,7 @@ implementation
          { byte(boolean) or word(wordbool) or longint(longbool) must
          be accepted for var parameters }
          if (nf_explizit in flags) and
-            (left.resulttype.def^.size=resulttype.def^.size) and
+            (left.resulttype.def.size=resulttype.def.size) and
             (left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
            exit;
          location.loc:=LOC_REGISTER;
@@ -1141,8 +1121,8 @@ implementation
         if nf_explizit in flags then
          begin
            { check if the result could be in a register }
-           if not(pstoreddef(resulttype.def)^.is_intregable) and
-              not(pstoreddef(resulttype.def)^.is_fpuregable) then
+           if not(tstoreddef(resulttype.def).is_intregable) and
+              not(tstoreddef(resulttype.def).is_fpuregable) then
             make_not_regable(left);
          end;
 
@@ -1187,16 +1167,16 @@ implementation
          if codegenerror then
            exit;
 
-         if (right.resulttype.def^.deftype=classrefdef) then
+         if (right.resulttype.def.deftype=classrefdef) then
           begin
             { left must be a class }
             if is_class(left.resulttype.def) then
              begin
                { the operands must be related }
-               if (not(pobjectdef(left.resulttype.def)^.is_related(
-                  pobjectdef(pclassrefdef(right.resulttype.def)^.pointertype.def)))) and
-                  (not(pobjectdef(pclassrefdef(right.resulttype.def)^.pointertype.def)^.is_related(
-                  pobjectdef(left.resulttype.def)))) then
+               if (not(tobjectdef(left.resulttype.def).is_related(
+                  tobjectdef(tclassrefdef(right.resulttype.def).pointertype.def)))) and
+                  (not(tobjectdef(tclassrefdef(right.resulttype.def).pointertype.def).is_related(
+                  tobjectdef(left.resulttype.def)))) then
                  CGMessage(type_e_mismatch);
              end
             else
@@ -1246,21 +1226,21 @@ implementation
          if codegenerror then
            exit;
 
-         if (right.resulttype.def^.deftype=classrefdef) then
+         if (right.resulttype.def.deftype=classrefdef) then
           begin
             { left must be a class }
             if is_class(left.resulttype.def) then
              begin
                { the operands must be related }
-               if (not(pobjectdef(left.resulttype.def)^.is_related(
-                  pobjectdef(pclassrefdef(right.resulttype.def)^.pointertype.def)))) and
-                  (not(pobjectdef(pclassrefdef(right.resulttype.def)^.pointertype.def)^.is_related(
-                  pobjectdef(left.resulttype.def)))) then
+               if (not(tobjectdef(left.resulttype.def).is_related(
+                  tobjectdef(tclassrefdef(right.resulttype.def).pointertype.def)))) and
+                  (not(tobjectdef(tclassrefdef(right.resulttype.def).pointertype.def).is_related(
+                  tobjectdef(left.resulttype.def)))) then
                  CGMessage(type_e_mismatch);
              end
             else
              CGMessage(type_e_mismatch);
-            resulttype:=pclassrefdef(right.resulttype.def)^.pointertype;
+            resulttype:=tclassrefdef(right.resulttype.def).pointertype;
           end
          else
           CGMessage(type_e_mismatch);
@@ -1295,7 +1275,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.23  2001-04-04 22:42:39  peter
+  Revision 1.24  2001-04-13 01:22:08  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.23  2001/04/04 22:42:39  peter
     * move constant folding into det_resulttype
 
   Revision 1.22  2001/04/02 21:20:30  peter

compiler/ncon.pas

@@ -36,7 +36,7 @@ interface
        trealconstnode = class(tnode)
           restype : ttype;
           value_real : bestreal;
-          lab_real : pasmlabel;
+          lab_real : tasmlabel;
           constructor create(v : bestreal;const t:ttype);virtual;
           function getcopy : tnode;override;
           function pass_1 : tnode;override;
@@ -67,7 +67,7 @@ interface
        tstringconstnode = class(tnode)
           value_str : pchar;
           len : longint;
-          lab_str : pasmlabel;
+          lab_str : tasmlabel;
           st_type : tstringtype;
           constructor createstr(const s : string;st:tstringtype);virtual;
           constructor createpchar(s : pchar;l : longint);virtual;
@@ -83,7 +83,7 @@ interface
        tsetconstnode = class(tunarynode)
           restype : ttype;
           value_set : pconstset;
-          lab_set : pasmlabel;
+          lab_set : tasmlabel;
           constructor create(s : pconstset;const t:ttype);virtual;
           destructor destroy;override;
           function getcopy : tnode;override;
@@ -107,7 +107,7 @@ interface
        cnilnode : class of tnilnode;
 
     function genintconstnode(v : TConstExprInt) : tordconstnode;
-    function genenumnode(v : penumsym) : tordconstnode;
+    function genenumnode(v : tenumsym) : tordconstnode;
 
     { some helper routines }
 {$ifdef INT64FUNCRESOK}
@@ -123,7 +123,7 @@ interface
     function is_constresourcestringnode(p : tnode) : boolean;
     function str_length(p : tnode) : longint;
     function is_emptyset(p : tnode):boolean;
-    function genconstsymtree(p : pconstsym) : tnode;
+    function genconstsymtree(p : tconstsym) : tnode;
 
 implementation
 
@@ -150,12 +150,12 @@ implementation
       end;
 
 
-    function genenumnode(v : penumsym) : tordconstnode;
+    function genenumnode(v : tenumsym) : tordconstnode;
       var
         htype : ttype;
       begin
-         htype.setdef(v^.definition);
-         genenumnode:=cordconstnode.create(v^.value,htype);
+         htype.setdef(v.definition);
+         genenumnode:=cordconstnode.create(v.value,htype);
       end;
 
 
@@ -211,8 +211,8 @@ implementation
     function is_constresourcestringnode(p : tnode) : boolean;
       begin
         is_constresourcestringnode:=(p.nodetype=loadn) and
-          (tloadnode(p).symtableentry^.typ=constsym) and
-          (pconstsym(tloadnode(p).symtableentry)^.consttyp=constresourcestring);
+          (tloadnode(p).symtableentry.typ=constsym) and
+          (tconstsym(tloadnode(p).symtableentry).consttyp=constresourcestring);
       end;
 
 
@@ -238,43 +238,43 @@ implementation
       end;
 
 
-    function genconstsymtree(p : pconstsym) : tnode;
+    function genconstsymtree(p : tconstsym) : tnode;
       var
         p1  : tnode;
         len : longint;
         pc  : pchar;
       begin
         p1:=nil;
-        case p^.consttyp of
+        case p.consttyp of
           constint :
-            p1:=genintconstnode(p^.value);
+            p1:=genintconstnode(p.value);
           conststring :
             begin
-              len:=p^.len;
+              len:=p.len;
               if not(cs_ansistrings in aktlocalswitches) and (len>255) then
                len:=255;
               getmem(pc,len+1);
-              move(pchar(tpointerord(p^.value))^,pc^,len);
+              move(pchar(tpointerord(p.value))^,pc^,len);
               pc[len]:=#0;
               p1:=cstringconstnode.createpchar(pc,len);
             end;
           constchar :
-            p1:=cordconstnode.create(p^.value,cchartype);
+            p1:=cordconstnode.create(p.value,cchartype);
           constreal :
-            p1:=crealconstnode.create(pbestreal(tpointerord(p^.value))^,pbestrealtype^);
+            p1:=crealconstnode.create(pbestreal(tpointerord(p.value))^,pbestrealtype^);
           constbool :
-            p1:=cordconstnode.create(p^.value,booltype);
+            p1:=cordconstnode.create(p.value,booltype);
           constset :
-            p1:=csetconstnode.create(pconstset(tpointerord(p^.value)),p^.consttype);
+            p1:=csetconstnode.create(pconstset(tpointerord(p.value)),p.consttype);
           constord :
-            p1:=cordconstnode.create(p^.value,p^.consttype);
+            p1:=cordconstnode.create(p.value,p.consttype);
           constpointer :
-            p1:=cpointerconstnode.create(p^.value,p^.consttype);
+            p1:=cpointerconstnode.create(p.value,p.consttype);
           constnil :
             p1:=cnilnode.create;
           constresourcestring:
             begin
-              p1:=cloadnode.create(pvarsym(p),pvarsym(p)^.owner);
+              p1:=cloadnode.create(tvarsym(p),tvarsym(p).owner);
               p1.resulttype:=cansistringtype;
             end;
         end;
@@ -358,8 +358,7 @@ implementation
       begin
         result:=nil;
         resulttype:=restype;
-        if resulttype.def^.deftype=orddef then
-         testrange(resulttype.def,value);
+        testrange(resulttype.def,value,false);
       end;
 
     function tordconstnode.pass_1 : tnode;
@@ -645,7 +644,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.16  2001-04-02 21:20:30  peter
+  Revision 1.17  2001-04-13 01:22:09  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.16  2001/04/02 21:20:30  peter
     * resulttype rewrite
 
   Revision 1.15  2000/12/31 11:14:10  jonas

compiler/nflw.pas

@@ -80,9 +80,9 @@ interface
        end;
 
        tgotonode = class(tnode)
-          labelnr : pasmlabel;
-          labsym : plabelsym;
-          constructor create(p : pasmlabel);virtual;
+          labelnr : tasmlabel;
+          labsym : tlabelsym;
+          constructor create(p : tasmlabel);virtual;
           function getcopy : tnode;override;
           function det_resulttype:tnode;override;
           function pass_1 : tnode;override;
@@ -90,10 +90,10 @@ interface
        end;
 
        tlabelnode = class(tunarynode)
-          labelnr : pasmlabel;
+          labelnr : tasmlabel;
           exceptionblock : tnode;
-          labsym : plabelsym;
-          constructor create(p : pasmlabel;l:tnode);virtual;
+          labsym : tlabelsym;
+          constructor create(p : tasmlabel;l:tnode);virtual;
           function getcopy : tnode;override;
           function det_resulttype:tnode;override;
           function pass_1 : tnode;override;
@@ -123,8 +123,8 @@ interface
        end;
 
        tonnode = class(tbinarynode)
-          exceptsymtable : psymtable;
-          excepttype : pobjectdef;
+          exceptsymtable : tsymtable;
+          excepttype : tobjectdef;
           constructor create(l,r:tnode);virtual;
           destructor destroy;override;
           function det_resulttype:tnode;override;
@@ -362,7 +362,7 @@ implementation
          if not codegenerror then
           begin
             if not is_boolean(left.resulttype.def) then
-              Message1(type_e_boolean_expr_expected,left.resulttype.def^.typename);
+              Message1(type_e_boolean_expr_expected,left.resulttype.def.typename);
           end;
 
          registers32:=left.registers32;
@@ -546,11 +546,11 @@ implementation
            in the same lexlevel }
          if (hp.nodetype=funcretn) or
             ((hp.nodetype=loadn) and
-             ((tloadnode(hp).symtable^.symtablelevel<=1) or
-              (tloadnode(hp).symtable^.symtablelevel=lexlevel))) then
+             ((tloadnode(hp).symtable.symtablelevel<=1) or
+              (tloadnode(hp).symtable.symtablelevel=lexlevel))) then
           begin
-            if tloadnode(hp).symtableentry^.typ=varsym then
-              pvarsym(tloadnode(hp).symtableentry)^.varstate:=vs_used;
+            if tloadnode(hp).symtableentry.typ=varsym then
+              tvarsym(tloadnode(hp).symtableentry).varstate:=vs_used;
             if (not(is_ordinal(t2.resulttype.def)) or is_64bitint(t2.resulttype.def)) then
               CGMessagePos(hp.fileinfo,type_e_ordinal_expr_expected);
           end
@@ -700,7 +700,7 @@ implementation
                              TGOTONODE
 *****************************************************************************}
 
-    constructor tgotonode.create(p : pasmlabel);
+    constructor tgotonode.create(p : tasmlabel);
 
       begin
         inherited create(goton);
@@ -741,7 +741,7 @@ implementation
                              TLABELNODE
 *****************************************************************************}
 
-    constructor tlabelnode.create(p : pasmlabel;l:tnode);
+    constructor tlabelnode.create(p : tasmlabel;l:tnode);
 
       begin
         inherited create(labeln,l);
@@ -1012,7 +1012,7 @@ implementation
     destructor tonnode.destroy;
       begin
         if assigned(exceptsymtable) then
-         dispose(exceptsymtable,done);
+         exceptsymtable.free;
         inherited destroy;
       end;
 
@@ -1136,7 +1136,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.15  2001-04-02 21:20:30  peter
+  Revision 1.16  2001-04-13 01:22:09  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.15  2001/04/02 21:20:30  peter
     * resulttype rewrite
 
   Revision 1.14  2001/03/25 12:27:59  peter

compiler/ninl.pas

@@ -95,16 +95,16 @@ implementation
         function do_lowhigh(const t:ttype) : tnode;
         var
            v    : tconstexprint;
-           enum : penumsym;
+           enum : tenumsym;
            hp   : tnode;
         begin
-           case t.def^.deftype of
+           case t.def.deftype of
              orddef:
                begin
                   if inlinenumber=in_low_x then
-                    v:=porddef(t.def)^.low
+                    v:=torddef(t.def).low
                   else
-                    v:=porddef(t.def)^.high;
+                    v:=torddef(t.def).high;
                   { low/high of torddef are longints, so we need special }
                   { handling for cardinal and 64bit types (JM)           }
                   if is_signed(t.def) and
@@ -127,17 +127,16 @@ implementation
                   if not is_signed(t.def) and
                      is_64bitint(t.def) and
                      (inlinenumber = in_high_x) then
-                    tordconstnode(hp).value :=
-                      tconstexprint(qword($ffffffff) shl 32 or $ffffffff);
+                    tordconstnode(hp).value := -1; { is the same as qword($ffffffffffffffff) }
                   do_lowhigh:=hp;
                end;
              enumdef:
                begin
-                  enum:=penumsym(Penumdef(t.def)^.firstenum);
-                  v:=Penumdef(t.def)^.maxval;
+                  enum:=tenumsym(tenumdef(t.def).firstenum);
+                  v:=tenumdef(t.def).maxval;
                   if inlinenumber=in_high_x then
-                    while assigned(enum) and (enum^.value <> v) do
-                      enum:=enum^.nextenum;
+                    while assigned(enum) and (enum.value <> v) do
+                      enum:=enum.nextenum;
                   if not assigned(enum) then
                     internalerror(309993)
                   else
@@ -178,7 +177,7 @@ implementation
          vl,vl2    : longint;
          vr        : bestreal;
          hp        :  tnode;
-         srsym     : psym;
+         srsym     : tsym;
       label
          myexit;
       begin
@@ -291,14 +290,14 @@ implementation
                  in_const_odd :
                    begin
                      if isreal then
-                      CGMessage1(type_e_integer_expr_expected,left.resulttype.def^.typename)
+                      CGMessage1(type_e_integer_expr_expected,left.resulttype.def.typename)
                      else
                       hp:=cordconstnode.create(byte(odd(vl)),booltype);
                    end;
                  in_const_swap_word :
                    begin
                      if isreal then
-                      CGMessage1(type_e_integer_expr_expected,left.resulttype.def^.typename)
+                      CGMessage1(type_e_integer_expr_expected,left.resulttype.def.typename)
                      else
                       hp:=cordconstnode.create((vl and $ff) shl 8+(vl shr 8),left.resulttype);
                    end;
@@ -463,10 +462,10 @@ implementation
                       goto myexit;
                     end;
                    set_varstate(left,true);
-                   case left.resulttype.def^.deftype of
+                   case left.resulttype.def.deftype of
                      orddef :
                        begin
-                         case porddef(left.resulttype.def)^.typ of
+                         case torddef(left.resulttype.def).typ of
                            bool8bit,
                            uchar:
                              begin
@@ -537,7 +536,7 @@ implementation
 
                   { we don't need string convertions here }
                   if (left.nodetype=typeconvn) and
-                     (ttypeconvnode(left).left.resulttype.def^.deftype=stringdef) then
+                     (ttypeconvnode(left).left.resulttype.def.deftype=stringdef) then
                     begin
                        hp:=ttypeconvnode(left).left;
                        ttypeconvnode(left).left:=nil;
@@ -570,7 +569,7 @@ implementation
                      resulttype:=u8bittype;
 
                    { check the type, must be string or char }
-                   if (left.resulttype.def^.deftype<>stringdef) and
+                   if (left.resulttype.def.deftype<>stringdef) and
                       (not is_char(left.resulttype.def)) then
                      CGMessage(type_e_mismatch);
                 end;
@@ -608,8 +607,8 @@ implementation
                      CGMessage(type_e_ordinal_expr_expected)
                    else
                      begin
-                       if (resulttype.def^.deftype=enumdef) and
-                          (penumdef(resulttype.def)^.has_jumps) then
+                       if (resulttype.def.deftype=enumdef) and
+                          (tenumdef(resulttype.def).has_jumps) then
                          CGMessage(type_e_succ_and_pred_enums_with_assign_not_possible);
                      end;
 
@@ -643,7 +642,7 @@ implementation
                         valid_for_assign(ppn.left,false);
                         set_varstate(ppn.left,false);
                         { first param must be a string or dynamic array ...}
-                        if not((ppn.left.resulttype.def^.deftype=stringdef) or
+                        if not((ppn.left.resulttype.def.deftype=stringdef) or
                            (is_dynamic_array(ppn.left.resulttype.def))) then
                           CGMessage(type_e_mismatch);
 
@@ -654,8 +653,8 @@ implementation
 
                        { convert shortstrings to openstring parameters }
                        { (generate the hightree) (JM)                  }
-                       if (ppn.left.resulttype.def^.deftype = stringdef) and
-                          (pstringdef(ppn.left.resulttype.def)^.string_typ =
+                       if (ppn.left.resulttype.def.deftype = stringdef) and
+                          (tstringdef(ppn.left.resulttype.def).string_typ =
                             st_shortstring) then
                          begin
                            dummycoll:=tparaitem.create;
@@ -698,7 +697,7 @@ implementation
                        { first param must be var }
                        valid_for_assign(tcallparanode(left).left,false);
 
-                       if (left.resulttype.def^.deftype in [enumdef,pointerdef]) or
+                       if (left.resulttype.def.deftype in [enumdef,pointerdef]) or
                           is_ordinal(left.resulttype.def) then
                         begin
                           { two paras ? }
@@ -764,7 +763,7 @@ implementation
                        valid_for_assign(tcallparanode(left).left,false);
                        { check type }
                        if assigned(left.resulttype.def) and
-                          (left.resulttype.def^.deftype=setdef) then
+                          (left.resulttype.def.deftype=setdef) then
                          begin
                             { two paras ? }
                             if assigned(tcallparanode(left).right) then
@@ -772,7 +771,7 @@ implementation
                                  { insert a type conversion       }
                                  { to the type of the set elements  }
                                  inserttypeconv(tcallparanode(tcallparanode(left).right).left,
-                                   psetdef(left.resulttype.def)^.elementtype);
+                                   tsetdef(left.resulttype.def).elementtype);
                                  { only three parameters are allowed }
                                  if assigned(tcallparanode(tcallparanode(left).right).right) then
                                    CGMessage(cg_e_illegal_expression);
@@ -789,7 +788,7 @@ implementation
               in_high_x:
                 begin
                   set_varstate(left,false);
-                  case left.resulttype.def^.deftype of
+                  case left.resulttype.def.deftype of
                     orddef,
                     enumdef:
                       begin
@@ -799,7 +798,7 @@ implementation
                       end;
                     setdef:
                       begin
-                        hp:=do_lowhigh(Psetdef(left.resulttype.def)^.elementtype);
+                        hp:=do_lowhigh(tsetdef(left.resulttype.def).elementtype);
                         resulttypepass(hp);
                         result:=hp;
                       end;
@@ -807,7 +806,7 @@ implementation
                       begin
                         if inlinenumber=in_low_x then
                          begin
-                           hp:=cordconstnode.create(Parraydef(left.resulttype.def)^.lowrange,parraydef(left.resulttype.def)^.rangetype);
+                           hp:=cordconstnode.create(tarraydef(left.resulttype.def).lowrange,tarraydef(left.resulttype.def).rangetype);
                            resulttypepass(hp);
                            result:=hp;
                          end
@@ -816,14 +815,14 @@ implementation
                            if is_open_array(left.resulttype.def) or
                              is_array_of_const(left.resulttype.def) then
                             begin
-                              srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+pvarsym(tloadnode(left).symtableentry)^.name);
-                              hp:=cloadnode.create(pvarsym(srsym),tloadnode(left).symtable);
+                              srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+tvarsym(tloadnode(left).symtableentry).name);
+                              hp:=cloadnode.create(tvarsym(srsym),tloadnode(left).symtable);
                               resulttypepass(hp);
                               result:=hp;
                             end
                            else
                             begin
-                              hp:=cordconstnode.create(Parraydef(left.resulttype.def)^.highrange,parraydef(left.resulttype.def)^.rangetype);
+                              hp:=cordconstnode.create(tarraydef(left.resulttype.def).highrange,tarraydef(left.resulttype.def).rangetype);
                               resulttypepass(hp);
                               result:=hp;
                             end;
@@ -841,14 +840,14 @@ implementation
                          begin
                            if is_open_string(left.resulttype.def) then
                             begin
-                              srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+pvarsym(tloadnode(left).symtableentry)^.name);
-                              hp:=cloadnode.create(pvarsym(srsym),tloadnode(left).symtable);
+                              srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+tvarsym(tloadnode(left).symtableentry).name);
+                              hp:=cloadnode.create(tvarsym(srsym),tloadnode(left).symtable);
                               resulttypepass(hp);
                               result:=hp;
                             end
                            else
                             begin
-                              hp:=cordconstnode.create(Pstringdef(left.resulttype.def)^.len,u8bittype);
+                              hp:=cordconstnode.create(tstringdef(left.resulttype.def).len,u8bittype);
                               resulttypepass(hp);
                               result:=hp;
                             end;
@@ -1010,7 +1009,7 @@ implementation
     function tinlinenode.pass_1 : tnode;
       var
          p1,hp,hpp  :  tnode;
-         srsym : psym;
+         srsym : tsym;
 {$ifndef NOCOLONCHECK}
          frac_para,length_para : tnode;
 {$endif ndef NOCOLONCHECK}
@@ -1052,12 +1051,12 @@ implementation
             begin
               if push_high_param(left.resulttype.def) then
                begin
-                 srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+pvarsym(tloadnode(left).symtableentry)^.name);
-                 hp:=caddnode.create(addn,cloadnode.create(pvarsym(srsym),tloadnode(left).symtable),
+                 srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+tvarsym(tloadnode(left).symtableentry).name);
+                 hp:=caddnode.create(addn,cloadnode.create(tvarsym(srsym),tloadnode(left).symtable),
                                   cordconstnode.create(1,s32bittype));
-                 if (left.resulttype.def^.deftype=arraydef) and
-                    (parraydef(left.resulttype.def)^.elesize<>1) then
-                   hp:=caddnode.create(muln,hp,cordconstnode.create(parraydef(left.resulttype.def)^.elesize,s32bittype));
+                 if (left.resulttype.def.deftype=arraydef) and
+                    (tarraydef(left.resulttype.def).elesize<>1) then
+                   hp:=caddnode.create(muln,hp,cordconstnode.create(tarraydef(left.resulttype.def).elesize,s32bittype));
                  firstpass(hp);
                  result:=hp;
                end
@@ -1136,7 +1135,7 @@ implementation
                if is_64bitint(left.resulttype.def) or
                   { range/overflow checking doesn't work properly }
                   { with the inc/dec code that's generated (JM)   }
-                  ((left.resulttype.def^.deftype = orddef) and
+                  ((left.resulttype.def.deftype = orddef) and
                    not(is_char(left.resulttype.def)) and
                    not(is_boolean(left.resulttype.def)) and
                    (aktlocalswitches *
@@ -1168,7 +1167,7 @@ implementation
                    { return new node }
                    result := hpp;
                  end
-               else if (left.resulttype.def^.deftype in [enumdef,pointerdef]) or
+               else if (left.resulttype.def.deftype in [enumdef,pointerdef]) or
                        is_ordinal(left.resulttype.def) then
                  begin
                     { two paras ? }
@@ -1212,15 +1211,15 @@ implementation
                     { file is not typed.                             }
                     if assigned(hp) and assigned(hp.resulttype.def) then
                       Begin
-                        if (hp.resulttype.def^.deftype=filedef) then
-                        if (pfiledef(hp.resulttype.def)^.filetyp=ft_untyped) then
+                        if (hp.resulttype.def.deftype=filedef) then
+                        if (tfiledef(hp.resulttype.def).filetyp=ft_untyped) then
                           begin
                            if (inlinenumber in [in_readln_x,in_writeln_x]) then
                              CGMessage(type_e_no_readln_writeln_for_typed_file)
                            else
                              CGMessage(type_e_no_read_write_for_untyped_file);
                           end
-                        else if (pfiledef(hp.resulttype.def)^.filetyp=ft_typed) then
+                        else if (tfiledef(hp.resulttype.def).filetyp=ft_typed) then
                          begin
                            file_is_typed:=true;
                            { test the type }
@@ -1231,7 +1230,7 @@ implementation
                             begin
                               if (tcallparanode(hpp).left.nodetype=typen) then
                                 CGMessage(type_e_cant_read_write_type);
-                              if not is_equal(hpp.resulttype.def,pfiledef(hp.resulttype.def)^.typedfiletype.def) then
+                              if not is_equal(hpp.resulttype.def,tfiledef(hp.resulttype.def).typedfiletype.def) then
                                 CGMessage(type_e_mismatch);
                               { generate the high() value for the shortstring }
                               if ((not iswrite) and is_shortstring(tcallparanode(hpp).left.resulttype.def)) or
@@ -1264,14 +1263,14 @@ implementation
                                begin
                                  isreal:=false;
                                  { support writeln(procvar) }
-                                 if (tcallparanode(hp).left.resulttype.def^.deftype=procvardef) then
+                                 if (tcallparanode(hp).left.resulttype.def.deftype=procvardef) then
                                   begin
                                     p1:=ccallnode.create(nil,nil,nil,nil);
                                     tcallnode(p1).set_procvar(tcallparanode(hp).left);
                                     firstpass(p1);
                                     tcallparanode(hp).left:=p1;
                                   end;
-                                 case tcallparanode(hp).left.resulttype.def^.deftype of
+                                 case tcallparanode(hp).left.resulttype.def.deftype of
                                    filedef :
                                      begin
                                        { only allowed as first parameter }
@@ -1296,7 +1295,7 @@ implementation
                                      end;
                                    orddef :
                                      begin
-                                       case porddef(tcallparanode(hp).left.resulttype.def)^.typ of
+                                       case torddef(tcallparanode(hp).left.resulttype.def).typ of
                                          uchar,
                                          u32bit,s32bit,
                                          u64bit,s64bit:
@@ -1348,10 +1347,10 @@ implementation
                                         end;
                                       { can be nil if you use "write(e:0:6)" while e is undeclared (JM) }
                                       if assigned(tcallparanode(hpp).left.resulttype.def) then
-                                        isreal:=(tcallparanode(hpp).left.resulttype.def^.deftype=floatdef)
+                                        isreal:=(tcallparanode(hpp).left.resulttype.def.deftype=floatdef)
                                       else exit;
                                       if (not is_integer(tcallparanode(length_para).left.resulttype.def)) then
-                                       CGMessage1(type_e_integer_expr_expected,tcallparanode(length_para).left.resulttype.def^.typename)
+                                       CGMessage1(type_e_integer_expr_expected,tcallparanode(length_para).left.resulttype.def.typename)
                                      else
                                        tcallparanode(length_para).left:=ctypeconvnode.create(tcallparanode(length_para).left,s32bittype);
                                      if assigned(frac_para) then
@@ -1359,7 +1358,7 @@ implementation
                                          if isreal then
                                           begin
                                             if (not is_integer(tcallparanode(frac_para).left.resulttype.def)) then
-                                              CGMessage1(type_e_integer_expr_expected,tcallparanode(frac_para).left.resulttype.def^.typename)
+                                              CGMessage1(type_e_integer_expr_expected,tcallparanode(frac_para).left.resulttype.def.typename)
                                             else
                                               tcallparanode(frac_para).left:=ctypeconvnode.create(tcallparanode(frac_para).left,s32bittype);
                                           end
@@ -1395,8 +1394,8 @@ implementation
                 already done in firstcalln }
               { now we know the type of buffer }
               srsym:=searchsymonlyin(systemunit,'SETTEXTBUF');
-              hp:=ccallparanode.create(cordconstnode.create(tcallparanode(left).left.resulttype.def^.size,s32bittype),left);
-              hp:=ccallnode.create(hp,pprocsym(srsym),systemunit,nil);
+              hp:=ccallparanode.create(cordconstnode.create(tcallparanode(left).left.resulttype.def.size,s32bittype),left);
+              hp:=ccallnode.create(hp,tprocsym(srsym),systemunit,nil);
               left:=nil;
               firstpass(hp);
               result:=hp;
@@ -1423,7 +1422,7 @@ implementation
               hp:=left;
               { valid string ? }
               if not assigned(hp) or
-                 (tcallparanode(hp).left.resulttype.def^.deftype<>stringdef) or
+                 (tcallparanode(hp).left.resulttype.def.deftype<>stringdef) or
                  (tcallparanode(hp).right=nil) then
                 CGMessage(cg_e_illegal_expression);
               { we need a var parameter }
@@ -1445,10 +1444,10 @@ implementation
                 CGMessage(cg_e_illegal_expression);
 
               isreal:=false;
-              case hp.resulttype.def^.deftype of
+              case hp.resulttype.def.deftype of
                 orddef :
                   begin
-                    case porddef(tcallparanode(hp).left.resulttype.def)^.typ of
+                    case torddef(tcallparanode(hp).left.resulttype.def).typ of
                       u32bit,s32bit,
                       s64bit,u64bit:
                         ;
@@ -1474,7 +1473,7 @@ implementation
                   firstpass(tcallparanode(hpp).left);
                   set_varstate(tcallparanode(hpp).left,true);
                   if (not is_integer(tcallparanode(hpp).left.resulttype.def)) then
-                    CGMessage1(type_e_integer_expr_expected,tcallparanode(hpp).left.resulttype.def^.typename)
+                    CGMessage1(type_e_integer_expr_expected,tcallparanode(hpp).left.resulttype.def.typename)
                   else
                     tcallparanode(hpp).left:=ctypeconvnode.create(tcallparanode(hpp).left,s32bittype);
                   hpp:=tcallparanode(hpp).right;
@@ -1483,7 +1482,7 @@ implementation
                       if isreal then
                        begin
                          if (not is_integer(tcallparanode(hpp).left.resulttype.def)) then
-                           CGMessage1(type_e_integer_expr_expected,tcallparanode(hpp).left.resulttype.def^.typename)
+                           CGMessage1(type_e_integer_expr_expected,tcallparanode(hpp).left.resulttype.def.typename)
                          else
                            begin
                              firstpass(tcallparanode(hpp).left);
@@ -1529,8 +1528,8 @@ implementation
                  {code has to be a var parameter}
                    if valid_for_assign(tcallparanode(left).left,false) then
                     begin
-                      if (tcallparanode(left).left.resulttype.def^.deftype <> orddef) or
-                        not(porddef(tcallparanode(left).left.resulttype.def)^.typ in
+                      if (tcallparanode(left).left.resulttype.def.deftype <> orddef) or
+                        not(torddef(tcallparanode(left).left.resulttype.def).typ in
                             [u16bit,s16bit,u32bit,s32bit]) then
                        CGMessage(type_e_mismatch);
                     end;
@@ -1553,9 +1552,9 @@ implementation
               tcallparanode(hpp).right := hp;
               if valid_for_assign(tcallparanode(hpp).left,false) then
                begin
-                 If Not((tcallparanode(hpp).left.resulttype.def^.deftype = floatdef) or
-                        ((tcallparanode(hpp).left.resulttype.def^.deftype = orddef) And
-                         (POrdDef(tcallparanode(hpp).left.resulttype.def)^.typ in
+                 If Not((tcallparanode(hpp).left.resulttype.def.deftype = floatdef) or
+                        ((tcallparanode(hpp).left.resulttype.def.deftype = orddef) And
+                         (torddef(tcallparanode(hpp).left.resulttype.def).typ in
                           [u32bit,s32bit,
                            u8bit,s8bit,u16bit,s16bit,s64bit,u64bit]))) Then
                    CGMessage(type_e_mismatch);
@@ -1568,7 +1567,7 @@ implementation
                 exit;
               { if not a stringdef then insert a type conv which
                 does the other type checking }
-              If (tcallparanode(hp).left.resulttype.def^.deftype<>stringdef) then
+              If (tcallparanode(hp).left.resulttype.def.deftype<>stringdef) then
                begin
                  tcallparanode(hp).left:=ctypeconvnode.create(tcallparanode(hp).left,cshortstringtype);
                  firstpass(tcallparanode(hp).left);
@@ -1721,7 +1720,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.35  2001-04-05 21:02:13  peter
+  Revision 1.36  2001-04-13 01:22:09  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.35  2001/04/05 21:02:13  peter
     * fixed fpu inline functions typeconvs
 
   Revision 1.34  2001/04/04 22:42:40  peter

compiler/nld.pas

@@ -32,9 +32,9 @@ interface
 
     type
        tloadnode = class(tunarynode)
-          symtableentry : psym;
-          symtable : psymtable;
-          constructor create(v : psym;st : psymtable);virtual;
+          symtableentry : tsym;
+          symtable : tsymtable;
+          constructor create(v : tsym;st : tsymtable);virtual;
           procedure set_mp(p:tnode);
           function  getcopy : tnode;override;
           function  pass_1 : tnode;override;
@@ -113,7 +113,7 @@ implementation
                              TLOADNODE
 *****************************************************************************}
 
-    constructor tloadnode.create(v : psym;st : psymtable);
+    constructor tloadnode.create(v : tsym;st : tsymtable);
 
       begin
          inherited create(loadn,nil);
@@ -143,16 +143,16 @@ implementation
     function tloadnode.det_resulttype:tnode;
       begin
          result:=nil;
-         case symtableentry^.typ of
+         case symtableentry.typ of
            absolutesym,
            varsym :
-             resulttype:=pvarsym(symtableentry)^.vartype;
+             resulttype:=tvarsym(symtableentry).vartype;
            constsym :
-             resulttype:=pconstsym(symtableentry)^.consttype;
+             resulttype:=tconstsym(symtableentry).consttype;
            typedconstsym :
-             resulttype:=ptypedconstsym(symtableentry)^.typedconsttype;
+             resulttype:=ttypedconstsym(symtableentry).typedconsttype;
            procsym :
-             resulttype.setdef(pprocsym(symtableentry)^.definition);
+             resulttype.setdef(tprocsym(symtableentry).definition);
            else
              internalerror(534785349);
          end;
@@ -166,12 +166,12 @@ implementation
          result:=nil;
 
          { optimize simple with loadings }
-         if (symtable^.symtabletype=withsymtable) and
-            (pwithsymtable(symtable)^.direct_with) and
-            (symtableentry^.typ=varsym) then
+         if (symtable.symtabletype=withsymtable) and
+            (twithsymtable(symtable).direct_with) and
+            (symtableentry.typ=varsym) then
            begin
-              p1:=tnode(pwithsymtable(symtable)^.withrefnode).getcopy;
-              p1:=csubscriptnode.create(pvarsym(symtableentry),p1);
+              p1:=tnode(twithsymtable(symtable).withrefnode).getcopy;
+              p1:=csubscriptnode.create(tvarsym(symtableentry),p1);
               left:=nil;
               firstpass(p1);
               result:=p1;
@@ -185,23 +185,23 @@ implementation
          registersmmx:=0;
 {$endif SUPPORT_MMX}
          { handle first absolute as it will replace the symtableentry }
-         if symtableentry^.typ=absolutesym then
+         if symtableentry.typ=absolutesym then
            begin
              { replace the symtableentry when it points to a var, else
                we are finished }
-             if pabsolutesym(symtableentry)^.abstyp=tovar then
+             if tabsolutesym(symtableentry).abstyp=tovar then
               begin
-                symtableentry:=pabsolutesym(symtableentry)^.ref;
-                symtable:=symtableentry^.owner;
+                symtableentry:=tabsolutesym(symtableentry).ref;
+                symtable:=symtableentry.owner;
                 include(flags,nf_absolute);
               end
              else
               exit;
            end;
-         case symtableentry^.typ of
+         case symtableentry.typ of
             funcretsym :
               begin
-                p1:=cfuncretnode.create(pfuncretsym(symtableentry)^.funcretprocinfo);
+                p1:=cfuncretnode.create(tfuncretsym(symtableentry).funcretprocinfo);
                 firstpass(p1);
                 { if it's refered as absolute then we need to have the
                   type of the absolute instead of the function return,
@@ -216,7 +216,7 @@ implementation
               end;
             constsym:
               begin
-                 if pconstsym(symtableentry)^.consttyp=constresourcestring then
+                 if tconstsym(symtableentry).consttyp=constresourcestring then
                    begin
                       resulttype:=cansistringtype;
                       { we use ansistrings so no fast exit here }
@@ -231,63 +231,63 @@ implementation
                 begin
                   { if it's refered by absolute then it's used }
                   if nf_absolute in flags then
-                   pvarsym(symtableentry)^.varstate:=vs_used;
-                  if (symtable^.symtabletype in [parasymtable,localsymtable]) and
-                      (lexlevel>symtable^.symtablelevel) then
+                   tvarsym(symtableentry).varstate:=vs_used;
+                  if (symtable.symtabletype in [parasymtable,localsymtable]) and
+                      (lexlevel>symtable.symtablelevel) then
                      begin
                        { if the variable is in an other stackframe then we need
                          a register to dereference }
-                       if (symtable^.symtablelevel)>0 then
+                       if (symtable.symtablelevel)>0 then
                         begin
                           registers32:=1;
                           { further, the variable can't be put into a register }
-                          pvarsym(symtableentry)^.varoptions:=
-                            pvarsym(symtableentry)^.varoptions-[vo_fpuregable,vo_regable];
+                          tvarsym(symtableentry).varoptions:=
+                            tvarsym(symtableentry).varoptions-[vo_fpuregable,vo_regable];
                         end;
                      end;
-                   if (pvarsym(symtableentry)^.varspez=vs_const) then
+                   if (tvarsym(symtableentry).varspez=vs_const) then
                      location.loc:=LOC_MEM;
                    { we need a register for call by reference parameters }
-                   if (pvarsym(symtableentry)^.varspez in [vs_var,vs_out]) or
-                      ((pvarsym(symtableentry)^.varspez=vs_const) and
-                      push_addr_param(pvarsym(symtableentry)^.vartype.def)) or
+                   if (tvarsym(symtableentry).varspez in [vs_var,vs_out]) or
+                      ((tvarsym(symtableentry).varspez=vs_const) and
+                      push_addr_param(tvarsym(symtableentry).vartype.def)) or
                       { call by value open arrays are also indirect addressed }
-                      is_open_array(pvarsym(symtableentry)^.vartype.def) then
+                      is_open_array(tvarsym(symtableentry).vartype.def) then
                      registers32:=1;
-                   if symtable^.symtabletype=withsymtable then
+                   if symtable.symtabletype=withsymtable then
                      inc(registers32);
 
-                   if ([vo_is_thread_var,vo_is_dll_var]*pvarsym(symtableentry)^.varoptions)<>[] then
+                   if ([vo_is_thread_var,vo_is_dll_var]*tvarsym(symtableentry).varoptions)<>[] then
                      registers32:=1;
                    { count variable references }
 
                      { this will create problem with local var set by
                      under_procedures
-                     if (assigned(pvarsym(symtableentry)^.owner) and assigned(aktprocsym)
-                       and ((pvarsym(symtableentry)^.owner = aktprocsym^.definition^.localst)
-                       or (pvarsym(symtableentry)^.owner = aktprocsym^.definition^.localst))) then }
+                     if (assigned(tvarsym(symtableentry).owner) and assigned(aktprocsym)
+                       and ((tvarsym(symtableentry).owner = aktprocsym.definition.localst)
+                       or (tvarsym(symtableentry).owner = aktprocsym.definition.localst))) then }
                    if t_times<1 then
-                     inc(pvarsym(symtableentry)^.refs)
+                     inc(tvarsym(symtableentry).refs)
                    else
-                     inc(pvarsym(symtableentry)^.refs,t_times);
+                     inc(tvarsym(symtableentry).refs,t_times);
                 end;
             typedconstsym :
                 if not(nf_absolute in flags) then
-                  resulttype:=ptypedconstsym(symtableentry)^.typedconsttype;
+                  resulttype:=ttypedconstsym(symtableentry).typedconsttype;
             procsym :
                 begin
-                   if assigned(pprocsym(symtableentry)^.definition^.nextoverloaded) then
+                   if assigned(tprocsym(symtableentry).definition.nextoverloaded) then
                      CGMessage(parser_e_no_overloaded_procvars);
-                   resulttype.setdef(pprocsym(symtableentry)^.definition);
+                   resulttype.setdef(tprocsym(symtableentry).definition);
                    { if the owner of the procsym is a object,  }
                    { left must be set, if left isn't set       }
                    { it can be only self                       }
                    { this code is only used in TP procvar mode }
                    if (m_tp_procvar in aktmodeswitches) and
                       not(assigned(left)) and
-                      (pprocsym(symtableentry)^.owner^.symtabletype=objectsymtable) then
+                      (tprocsym(symtableentry).owner.symtabletype=objectsymtable) then
                     begin
-                      left:=cselfnode.create(pobjectdef(symtableentry^.owner^.defowner));
+                      left:=cselfnode.create(tobjectdef(symtableentry.owner.defowner));
                     end;
                    { method pointer ? }
                    if assigned(left) then
@@ -378,8 +378,8 @@ implementation
         valid_for_assign(left,true);
 
         { check if local proc/func is assigned to procvar }
-        if right.resulttype.def^.deftype=procvardef then
-          test_local_to_procvar(pprocvardef(right.resulttype.def),left.resulttype.def);
+        if right.resulttype.def.deftype=procvardef then
+          test_local_to_procvar(tprocvardef(right.resulttype.def),left.resulttype.def);
       end;
 
 
@@ -590,10 +590,10 @@ implementation
          end;
          if not assigned(htype.def) then
           htype:=voidtype;
-         resulttype.setdef(new(parraydef,init(0,len-1,s32bittype)));
-         parraydef(resulttype.def)^.elementtype:=htype;
-         parraydef(resulttype.def)^.IsConstructor:=true;
-         parraydef(resulttype.def)^.IsVariant:=varia;
+         resulttype.setdef(tarraydef.create(0,len-1,s32bittype));
+         tarraydef(resulttype.def).elementtype:=htype;
+         tarraydef(resulttype.def).IsConstructor:=true;
+         tarraydef(resulttype.def).IsVariant:=varia;
       end;
 
 
@@ -605,7 +605,7 @@ implementation
         dovariant : boolean;
         htype     : ttype;
       begin
-        dovariant:=(nf_forcevaria in flags) or parraydef(resulttype.def)^.isvariant;
+        dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
         result:=nil;
       { only pass left tree, right tree contains next construct if any }
         if assigned(left) then
@@ -617,7 +617,7 @@ implementation
               { Insert typeconvs for array of const }
               if dovariant then
                begin
-                 case hp.left.resulttype.def^.deftype of
+                 case hp.left.resulttype.def.deftype of
                    enumdef :
                      begin
                        hp.left:=ctypeconvnode.create(hp.left,s32bittype);
@@ -654,7 +654,7 @@ implementation
                    classrefdef,
                    objectdef : ;
                    else
-                     CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def^.typename);
+                     CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
                  end;
                end;
               hp:=tarrayconstructornode(hp.right);
@@ -737,7 +737,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.13  2001-04-05 21:03:08  peter
+  Revision 1.14  2001-04-13 01:22:10  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.13  2001/04/05 21:03:08  peter
     * array constructor fix
 
   Revision 1.12  2001/04/04 22:42:40  peter

compiler/nmat.pas

@@ -82,7 +82,7 @@ implementation
     function tmoddivnode.det_resulttype:tnode;
       var
          t : tnode;
-         rd,ld : pdef;
+         rd,ld : tdef;
          rv,lv : tconstexprint;
       begin
          result:=nil;
@@ -133,22 +133,22 @@ implementation
          { Do the same for qwords and positive constants as well, otherwise things like   }
          { "qword mod 10" are evaluated with int64 as result, which is wrong if the       }
          { "qword" was > high(int64) (JM)                                                 }
-         if (left.resulttype.def^.deftype=orddef) and (right.resulttype.def^.deftype=orddef) then
-           if (porddef(right.resulttype.def)^.typ in [u32bit,u64bit]) and
+         if (left.resulttype.def.deftype=orddef) and (right.resulttype.def.deftype=orddef) then
+           if (torddef(right.resulttype.def).typ in [u32bit,u64bit]) and
               is_constintnode(left) and
               (tordconstnode(left).value >= 0) then
              inserttypeconv(left,right.resulttype)
-           else if (porddef(left.resulttype.def)^.typ in [u32bit,u64bit]) and
+           else if (torddef(left.resulttype.def).typ in [u32bit,u64bit]) and
               is_constintnode(right) and
               (tordconstnode(right).value >= 0) then
              inserttypeconv(right,left.resulttype);
 
-         if (left.resulttype.def^.deftype=orddef) and (right.resulttype.def^.deftype=orddef) and
+         if (left.resulttype.def.deftype=orddef) and (right.resulttype.def.deftype=orddef) and
             (is_64bitint(left.resulttype.def) or is_64bitint(right.resulttype.def) or
              { when mixing cardinals and signed numbers, convert everythign to 64bit (JM) }
-             ((porddef(right.resulttype.def)^.typ = u32bit) and
+             ((torddef(right.resulttype.def).typ = u32bit) and
               is_signed(left.resulttype.def)) or
-             ((porddef(left.resulttype.def)^.typ = u32bit) and
+             ((torddef(left.resulttype.def).typ = u32bit) and
               is_signed(right.resulttype.def))) then
            begin
               rd:=right.resulttype.def;
@@ -158,28 +158,28 @@ implementation
                 CGMessage(type_w_mixed_signed_unsigned);
               if is_signed(rd) or is_signed(ld) then
                 begin
-                   if (porddef(ld)^.typ<>s64bit) then
+                   if (torddef(ld).typ<>s64bit) then
                      inserttypeconv(left,cs64bittype);
-                   if (porddef(rd)^.typ<>s64bit) then
+                   if (torddef(rd).typ<>s64bit) then
                      inserttypeconv(right,cs64bittype);
                 end
               else
                 begin
-                   if (porddef(ld)^.typ<>u64bit) then
+                   if (torddef(ld).typ<>u64bit) then
                      inserttypeconv(left,cu64bittype);
-                   if (porddef(rd)^.typ<>u64bit) then
+                   if (torddef(rd).typ<>u64bit) then
                      inserttypeconv(right,cu64bittype);
                 end;
               resulttype:=left.resulttype;
            end
          else
            begin
-              if not(right.resulttype.def^.deftype=orddef) or
-                 not(porddef(right.resulttype.def)^.typ in [s32bit,u32bit]) then
+              if not(right.resulttype.def.deftype=orddef) or
+                 not(torddef(right.resulttype.def).typ in [s32bit,u32bit]) then
                 inserttypeconv(right,s32bittype);
 
-              if not(left.resulttype.def^.deftype=orddef) or
-                 not(porddef(left.resulttype.def)^.typ in [s32bit,u32bit]) then
+              if not(left.resulttype.def.deftype=orddef) or
+                 not(torddef(left.resulttype.def).typ in [s32bit,u32bit]) then
                 inserttypeconv(left,s32bittype);
 
               { the resulttype.def depends on the right side, because the left becomes }
@@ -190,8 +190,6 @@ implementation
 
 
     function tmoddivnode.pass_1 : tnode;
-      var
-         t : tnode;
       begin
          result:=nil;
          firstpass(left);
@@ -200,7 +198,7 @@ implementation
            exit;
 
          { 64bit }
-         if (left.resulttype.def^.deftype=orddef) and (right.resulttype.def^.deftype=orddef) and
+         if (left.resulttype.def.deftype=orddef) and (right.resulttype.def.deftype=orddef) and
             (is_64bitint(left.resulttype.def) or is_64bitint(right.resulttype.def)) then
            begin
              calcregisters(self,2,0,0);
@@ -258,7 +256,7 @@ implementation
          { 64 bit ints have their own shift handling }
          if not(is_64bitint(left.resulttype.def)) then
            begin
-              if porddef(left.resulttype.def)^.typ <> u32bit then
+              if torddef(left.resulttype.def).typ <> u32bit then
                inserttypeconv(left,s32bittype);
            end;
 
@@ -270,7 +268,6 @@ implementation
 
     function tshlshrnode.pass_1 : tnode;
       var
-         t : tnode;
          regs : longint;
       begin
          result:=nil;
@@ -305,7 +302,7 @@ implementation
     function tunaryminusnode.det_resulttype : tnode;
       var
          t : tnode;
-         minusdef : pprocdef;
+         minusdef : tprocdef;
       begin
          result:=nil;
          resulttypepass(left);
@@ -330,7 +327,7 @@ implementation
            end;
 
          resulttype:=left.resulttype;
-         if (left.resulttype.def^.deftype=floatdef) then
+         if (left.resulttype.def.deftype=floatdef) then
            begin
            end
 {$ifdef SUPPORT_MMX}
@@ -340,7 +337,7 @@ implementation
                { if saturation is on, left.resulttype.def isn't
                  "mmx able" (FK)
                if (cs_mmx_saturation in aktlocalswitches^) and
-                 (porddef(parraydef(resulttype.def)^.definition)^.typ in
+                 (torddef(tarraydef(resulttype.def).definition).typ in
                  [s32bit,u32bit]) then
                  CGMessage(type_e_mismatch);
                }
@@ -349,7 +346,7 @@ implementation
          else if is_64bitint(left.resulttype.def) then
            begin
            end
-         else if (left.resulttype.def^.deftype=orddef) then
+         else if (left.resulttype.def.deftype=orddef) then
            begin
               inserttypeconv(left,s32bittype);
               resulttype:=left.resulttype;
@@ -357,13 +354,13 @@ implementation
          else
            begin
               if assigned(overloaded_operators[_minus]) then
-                minusdef:=overloaded_operators[_minus]^.definition
+                minusdef:=overloaded_operators[_minus].definition
               else
                 minusdef:=nil;
               while assigned(minusdef) do
                 begin
-                   if is_equal(tparaitem(minusdef^.para.first).paratype.def,left.resulttype.def) and
-                      (tparaitem(minusdef^.para.first).next=nil) then
+                   if is_equal(tparaitem(minusdef.para.first).paratype.def,left.resulttype.def) and
+                      (tparaitem(minusdef.para.first).next=nil) then
                      begin
                         t:=ccallnode.create(ccallparanode.create(left,nil),
                                             overloaded_operators[_minus],nil,nil);
@@ -372,7 +369,7 @@ implementation
                         result:=t;
                         exit;
                      end;
-                   minusdef:=minusdef^.nextoverloaded;
+                   minusdef:=minusdef.nextoverloaded;
                 end;
               CGMessage(type_e_mismatch);
            end;
@@ -380,8 +377,6 @@ implementation
 
 
     function tunaryminusnode.pass_1 : tnode;
-      var
-         t : tnode;
       begin
          result:=nil;
          firstpass(left);
@@ -394,7 +389,7 @@ implementation
          registersmmx:=left.registersmmx;
 {$endif SUPPORT_MMX}
 
-         if (left.resulttype.def^.deftype=floatdef) then
+         if (left.resulttype.def.deftype=floatdef) then
            begin
              location.loc:=LOC_FPU;
            end
@@ -414,7 +409,7 @@ implementation
                 registers32:=2;
               location.loc:=LOC_REGISTER;
            end
-         else if (left.resulttype.def^.deftype=orddef) then
+         else if (left.resulttype.def.deftype=orddef) then
            begin
               if (left.location.loc<>LOC_REGISTER) and
                  (registers32<1) then
@@ -437,7 +432,7 @@ implementation
     function tnotnode.det_resulttype : tnode;
       var
          t : tnode;
-         notdef : pprocdef;
+         notdef : tprocdef;
          v : tconstexprint;
       begin
          result:=nil;
@@ -450,7 +445,7 @@ implementation
          if (left.nodetype=ordconstn) then
            begin
               v:=tordconstnode(left).value;
-              case porddef(left.resulttype.def)^.typ of
+              case torddef(left.resulttype.def).typ of
                 bool8bit,
                 bool16bit,
                 bool32bit :
@@ -507,13 +502,13 @@ implementation
          else
            begin
               if assigned(overloaded_operators[_op_not]) then
-                notdef:=overloaded_operators[_op_not]^.definition
+                notdef:=overloaded_operators[_op_not].definition
               else
                 notdef:=nil;
               while assigned(notdef) do
                 begin
-                   if is_equal(tparaitem(notdef^.para.first).paratype.def,left.resulttype.def) and
-                      (tparaitem(notdef^.para.first).next=nil) then
+                   if is_equal(tparaitem(notdef.para.first).paratype.def,left.resulttype.def) and
+                      (tparaitem(notdef.para.first).next=nil) then
                      begin
                         t:=ccallnode.create(ccallparanode.create(left,nil),
                                             overloaded_operators[_op_not],nil,nil);
@@ -522,7 +517,7 @@ implementation
                         result:=t;
                         exit;
                      end;
-                   notdef:=notdef^.nextoverloaded;
+                   notdef:=notdef.nextoverloaded;
                 end;
               CGMessage(type_e_mismatch);
            end;
@@ -530,8 +525,6 @@ implementation
 
 
     function tnotnode.pass_1 : tnode;
-      var
-         t : tnode;
       begin
          result:=nil;
          firstpass(left);
@@ -595,7 +588,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.19  2001-04-05 21:00:27  peter
+  Revision 1.20  2001-04-13 01:22:10  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.19  2001/04/05 21:00:27  peter
     * fix constant not evaluation
 
   Revision 1.18  2001/04/04 22:42:40  peter

compiler/nmem.pas

@@ -81,8 +81,8 @@ interface
        end;
 
        tsubscriptnode = class(tunarynode)
-          vs : pvarsym;
-          constructor create(varsym : psym;l : tnode);virtual;
+          vs : tvarsym;
+          constructor create(varsym : tsym;l : tnode);virtual;
           function getcopy : tnode;override;
           function pass_1 : tnode;override;
           function docompare(p: tnode): boolean; override;
@@ -96,17 +96,17 @@ interface
        end;
 
        tselfnode = class(tnode)
-          classdef : pobjectdef;
-          constructor create(_class : pobjectdef);virtual;
+          classdef : tobjectdef;
+          constructor create(_class : tobjectdef);virtual;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
        end;
 
        twithnode = class(tbinarynode)
-          withsymtable : pwithsymtable;
+          withsymtable : twithsymtable;
           tablecount : longint;
-          withreference:preference;
-          constructor create(symtable : pwithsymtable;l,r : tnode;count : longint);virtual;
+          withreference : preference;
+          constructor create(symtable : twithsymtable;l,r : tnode;count : longint);virtual;
           destructor destroy;override;
           function getcopy : tnode;override;
           function pass_1 : tnode;override;
@@ -158,7 +158,7 @@ implementation
         if codegenerror then
          exit;
 
-        resulttype.setdef(new(pclassrefdef,init(left.resulttype)));;
+        resulttype.setdef(tclassrefdef.create(left.resulttype));
       end;
 
     function tloadvmtnode.pass_1 : tnode;
@@ -248,7 +248,7 @@ implementation
         resulttypepass(left);
         if codegenerror then
          exit;
-        resulttype:=ppointerdef(left.resulttype.def)^.pointertype;
+        resulttype:=tpointerdef(left.resulttype.def).pointertype;
       end;
 
 
@@ -293,8 +293,8 @@ implementation
         resulttypepass(left);
         if codegenerror then
          exit;
-        if (left.resulttype.def^.deftype<>pointerdef) then
-          CGMessage1(type_e_pointer_type_expected,left.resulttype.def^.typename);
+        if (left.resulttype.def.deftype<>pointerdef) then
+          CGMessage1(type_e_pointer_type_expected,left.resulttype.def.typename);
         resulttype:=voidtype;
       end;
 
@@ -337,7 +337,7 @@ implementation
       var
          hp  : tnode;
          hp2 : TParaItem;
-         hp3 : pabstractprocdef;
+         hp3 : tabstractprocdef;
       begin
         result:=nil;
         resulttypepass(left);
@@ -379,7 +379,7 @@ implementation
              vecn,
              derefn :
                begin
-                 if left.resulttype.def^.deftype=procvardef then
+                 if left.resulttype.def.deftype=procvardef then
                    include(flags,nf_procvarload);
                end;
            end;
@@ -394,7 +394,7 @@ implementation
         if left.nodetype=calln then
          internalerror(200103253)
         else
-         if (left.nodetype=loadn) and (tloadnode(left).symtableentry^.typ=procsym) then
+         if (left.nodetype=loadn) and (tloadnode(left).symtableentry.typ=procsym) then
           begin
             { the address is already available when loading a procedure of object }
             if assigned(tloadnode(left).left) then
@@ -406,26 +406,26 @@ implementation
             if not(m_tp_procvar in aktmodeswitches) then
               begin
 
-                 hp3:=pabstractprocdef(pprocsym(tloadnode(left).symtableentry)^.definition);
+                 hp3:=tabstractprocdef(tprocsym(tloadnode(left).symtableentry).definition);
 
                  { create procvardef }
-                 resulttype.setdef(new(pprocvardef,init));
-                 pprocvardef(resulttype.def)^.proctypeoption:=hp3^.proctypeoption;
-                 pprocvardef(resulttype.def)^.proccalloptions:=hp3^.proccalloptions;
-                 pprocvardef(resulttype.def)^.procoptions:=hp3^.procoptions;
-                 pprocvardef(resulttype.def)^.rettype:=hp3^.rettype;
-                 pprocvardef(resulttype.def)^.symtablelevel:=hp3^.symtablelevel;
+                 resulttype.setdef(tprocvardef.create);
+                 tprocvardef(resulttype.def).proctypeoption:=hp3.proctypeoption;
+                 tprocvardef(resulttype.def).proccalloptions:=hp3.proccalloptions;
+                 tprocvardef(resulttype.def).procoptions:=hp3.procoptions;
+                 tprocvardef(resulttype.def).rettype:=hp3.rettype;
+                 tprocvardef(resulttype.def).symtablelevel:=hp3.symtablelevel;
 
                  { method ? then set the methodpointer flag }
-                 if (hp3^.owner^.symtabletype=objectsymtable) then
-                   include(pprocvardef(resulttype.def)^.procoptions,po_methodpointer);
+                 if (hp3.owner.symtabletype=objectsymtable) then
+                   include(tprocvardef(resulttype.def).procoptions,po_methodpointer);
 
                  { we need to process the parameters reverse so they are inserted
                    in the correct right2left order (PFV) }
-                 hp2:=TParaItem(hp3^.Para.last);
+                 hp2:=TParaItem(hp3.Para.last);
                  while assigned(hp2) do
                    begin
-                      pprocvardef(resulttype.def)^.concatpara(hp2.paratype,hp2.paratyp,hp2.defaultvalue);
+                      tprocvardef(resulttype.def).concatpara(hp2.paratype,hp2.paratyp,hp2.defaultvalue);
                       hp2:=TParaItem(hp2.previous);
                    end;
               end
@@ -439,20 +439,20 @@ implementation
             while assigned(hp) and (hp.nodetype in [vecn,derefn,subscriptn]) do
              hp:=tunarynode(hp).left;
             if assigned(hp) and (hp.nodetype=loadn) and
-               ((tloadnode(hp).symtableentry^.typ=absolutesym) and
-                pabsolutesym(tloadnode(hp).symtableentry)^.absseg) then
+               ((tloadnode(hp).symtableentry.typ=absolutesym) and
+                tabsolutesym(tloadnode(hp).symtableentry).absseg) then
              begin
                if not(cs_typed_addresses in aktlocalswitches) then
                  resulttype:=voidfarpointertype
                else
-                 resulttype.setdef(new(ppointerdef,initfar(left.resulttype)));
+                 resulttype.setdef(tpointerdef.createfar(left.resulttype));
              end
             else
              begin
                if not(cs_typed_addresses in aktlocalswitches) then
                  resulttype:=voidpointertype
                else
-                 resulttype.setdef(new(ppointerdef,init(left.resulttype)));
+                 resulttype.setdef(tpointerdef.create(left.resulttype));
              end;
           end;
 
@@ -525,7 +525,7 @@ implementation
          set_varstate(left,false);
          dec(parsing_para_level);
 
-         if (left.resulttype.def^.deftype)<>procvardef then
+         if (left.resulttype.def.deftype)<>procvardef then
            CGMessage(cg_e_illegal_expression);
 
          resulttype:=voidpointertype;
@@ -573,8 +573,8 @@ implementation
          if codegenerror then
           exit;
 
-         if left.resulttype.def^.deftype=pointerdef then
-          resulttype:=ppointerdef(left.resulttype.def)^.pointertype
+         if left.resulttype.def.deftype=pointerdef then
+          resulttype:=tpointerdef(left.resulttype.def).pointertype
          else
           CGMessage(cg_e_invalid_qualifier);
       end;
@@ -600,12 +600,12 @@ implementation
                             TSUBSCRIPTNODE
 *****************************************************************************}
 
-    constructor tsubscriptnode.create(varsym : psym;l : tnode);
+    constructor tsubscriptnode.create(varsym : tsym;l : tnode);
 
       begin
          inherited create(subscriptn,l);
-         { vs should be changed to psym! }
-         vs:=pvarsym(varsym);
+         { vs should be changed to tsym! }
+         vs:=tvarsym(varsym);
       end;
 
     function tsubscriptnode.getcopy : tnode;
@@ -625,7 +625,7 @@ implementation
         result:=nil;
         resulttypepass(left);
         set_varstate(left,false);
-        resulttype:=vs^.vartype;
+        resulttype:=vs.vartype;
       end;
 
 
@@ -688,16 +688,16 @@ implementation
           exit;
 
          { range check only for arrays }
-         if (left.resulttype.def^.deftype=arraydef) then
+         if (left.resulttype.def.deftype=arraydef) then
            begin
-              if (isconvertable(right.resulttype.def,parraydef(left.resulttype.def)^.rangetype.def,
+              if (isconvertable(right.resulttype.def,tarraydef(left.resulttype.def).rangetype.def,
                     ct,ordconstn,false)=0) and
-                 not(is_equal(right.resulttype.def,parraydef(left.resulttype.def)^.rangetype.def)) then
+                 not(is_equal(right.resulttype.def,tarraydef(left.resulttype.def).rangetype.def)) then
                 CGMessage(type_e_mismatch);
            end;
          { Never convert a boolean or a char !}
          { maybe type conversion }
-         if (right.resulttype.def^.deftype<>enumdef) and
+         if (right.resulttype.def.deftype<>enumdef) and
             not(is_char(right.resulttype.def)) and
             not(is_boolean(right.resulttype.def)) then
            begin
@@ -707,27 +707,27 @@ implementation
          { 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 (left.resulttype.def^.deftype=pointerdef) and
+         if (left.resulttype.def.deftype=pointerdef) 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(new(parraydef,init(0,$7fffffff,s32bittype)));
-            parraydef(htype.def)^.elementtype:=ppointerdef(left.resulttype.def)^.pointertype;
+            htype.setdef(tarraydef.create(0,$7fffffff,s32bittype));
+            tarraydef(htype.def).elementtype:=tpointerdef(left.resulttype.def).pointertype;
             inserttypeconv(left,htype);
 
-            resulttype:=parraydef(htype.def)^.elementtype;
+            resulttype:=tarraydef(htype.def).elementtype;
           end;
 
          { determine return type }
          if not assigned(resulttype.def) then
-           if left.resulttype.def^.deftype=arraydef then
-             resulttype:=parraydef(left.resulttype.def)^.elementtype
-           else if left.resulttype.def^.deftype=stringdef then
+           if left.resulttype.def.deftype=arraydef then
+             resulttype:=tarraydef(left.resulttype.def).elementtype
+           else if left.resulttype.def.deftype=stringdef then
              begin
                 { indexed access to strings }
-                case pstringdef(left.resulttype.def)^.string_typ of
+                case tstringdef(left.resulttype.def).string_typ of
                    st_widestring :
                      resulttype:=cwidechartype;
                    st_ansistring :
@@ -746,7 +746,7 @@ implementation
     function tvecnode.pass_1 : tnode;
 {$ifdef consteval}
       var
-         tcsym : ptypedconstsym;
+         tcsym : ttypedconstsym;
 {$endif}
       begin
          result:=nil;
@@ -761,10 +761,10 @@ implementation
 {$ifdef consteval}
               { constant evaluation }
               if (left.nodetype=loadn) and
-                 (left.symtableentry^.typ=typedconstsym) then
+                 (left.symtableentry.typ=typedconstsym) then
                begin
-                 tcsym:=ptypedconstsym(left.symtableentry);
-                 if tcsym^.defintion^.typ=stringdef then
+                 tcsym:=ttypedconstsym(left.symtableentry);
+                 if tcsym.defintion^.typ=stringdef then
                   begin
 
                   end;
@@ -829,7 +829,7 @@ implementation
                                TSELFNODE
 *****************************************************************************}
 
-    constructor tselfnode.create(_class : pobjectdef);
+    constructor tselfnode.create(_class : tobjectdef);
 
       begin
          inherited create(selfn);
@@ -845,7 +845,7 @@ implementation
     function tselfnode.pass_1 : tnode;
       begin
          result:=nil;
-         if (resulttype.def^.deftype=classrefdef) or
+         if (resulttype.def.deftype=classrefdef) or
            is_class(resulttype.def) then
            location.loc:=LOC_CREGISTER
          else
@@ -857,7 +857,7 @@ implementation
                                TWITHNODE
 *****************************************************************************}
 
-    constructor twithnode.create(symtable : pwithsymtable;l,r : tnode;count : longint);
+    constructor twithnode.create(symtable : twithsymtable;l,r : tnode;count : longint);
 
       begin
          inherited create(withn,l,r);
@@ -870,7 +870,7 @@ implementation
 
     destructor twithnode.destroy;
       var
-        symt : psymtable;
+        symt : tsymtable;
         i    : longint;
       begin
         symt:=withsymtable;
@@ -878,8 +878,8 @@ implementation
          begin
            if assigned(symt) then
             begin
-              withsymtable:=pwithsymtable(symt^.next);
-              dispose(symt,done);
+              withsymtable:=twithsymtable(symt.next);
+              symt.free;
             end;
            symt:=withsymtable;
          end;
@@ -902,7 +902,7 @@ implementation
 
     function twithnode.det_resulttype:tnode;
       var
-         symtable : pwithsymtable;
+         symtable : twithsymtable;
          i : longint;
       begin
          result:=nil;
@@ -919,10 +919,10 @@ implementation
             for i:=1 to tablecount do
              begin
                if (left.nodetype=loadn) and
-                  (tloadnode(left).symtable=aktprocsym^.definition^.localst) then
-                symtable^.direct_with:=true;
-               symtable^.withnode:=self;
-               symtable:=pwithsymtable(symtable^.next);
+                  (tloadnode(left).symtable=aktprocsym.definition.localst) then
+                symtable.direct_with:=true;
+               symtable.withnode:=self;
+               symtable:=twithsymtable(symtable.next);
              end;
 
             resulttypepass(right);
@@ -976,7 +976,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.16  2001-04-02 21:20:31  peter
+  Revision 1.17  2001-04-13 01:22:10  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.16  2001/04/02 21:20:31  peter
     * resulttype rewrite
 
   Revision 1.15  2001/03/23 00:16:07  florian

compiler/node.pas

@@ -27,7 +27,7 @@ unit node;
 interface
 
     uses
-       cobjects,cclasses,
+       cclasses,
        globtype,globals,
        cpubase,
        aasm,
@@ -298,7 +298,6 @@ interface
           fileinfo : tfileposinfo;
           localswitches : tlocalswitches;
 {$ifdef extdebug}
-          oldresulttype : ttype; { to detect changed resulttype }
           maxfirstpasscount,
           firstpasscount : longint;
 {$endif extdebug}
@@ -351,7 +350,7 @@ interface
        { true- and falselabel                                     }
        tparentnode = class(tnode)
 {$ifdef newcg}
-          falselabel,truelabel : pasmlabel;
+          falselabel,truelabel : tasmlabel;
 {$endif newcg}
        end;
 
@@ -430,7 +429,6 @@ implementation
          registersmmx:=0;
 {$endif SUPPORT_MMX}
 {$ifdef EXTDEBUG}
-         oldresulttype.reset;
          maxfirstpasscount:=0;
          firstpasscount:=0;
 {$endif EXTDEBUG}
@@ -792,7 +790,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.14  2001-04-02 21:20:31  peter
+  Revision 1.15  2001-04-13 01:22:10  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.14  2001/04/02 21:20:31  peter
     * resulttype rewrite
 
   Revision 1.13  2001/01/13 00:08:09  peter

compiler/nopt.pas

@@ -84,7 +84,7 @@ var
 
 implementation
 
-uses cutils, htypechk, types, globtype, globals, cpubase, pass_1, ncnv, ncon,
+uses cutils, htypechk, types, globtype, globals, cpubase, ncnv, ncon,
      verbose, symdef, hcodegen;
 
 
@@ -196,7 +196,7 @@ begin
 {       doesn't work yet, don't know why (JM)
         tc_chararray_2_string:
           curmaxlen :=
-            min(ttypeconvnode(left).left.resulttype.def^.size,255); }
+            min(ttypeconvnode(left).left.resulttype.def.size,255); }
         else curmaxlen := 255;
       end;
     end
@@ -278,7 +278,12 @@ end.
 
 {
   $Log$
-  Revision 1.2  2001-04-02 21:20:31  peter
+  Revision 1.3  2001-04-13 01:22:10  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.2  2001/04/02 21:20:31  peter
     * resulttype rewrite
 
   Revision 1.1  2001/01/04 11:24:19  jonas

compiler/nset.pas

@@ -36,10 +36,10 @@ interface
           _low,_high : TConstExprInt;
 
           { only used by gentreejmp }
-          _at : pasmlabel;
+          _at : tasmlabel;
 
           { label of instruction }
-          statement : pasmlabel;
+          statement : tasmlabel;
 
           { is this the first of an case entry, needed to release statement
             label (PFV) }
@@ -180,26 +180,26 @@ implementation
         t : tnode;
         pst : pconstset;
 
-        function createsetconst(psd : psetdef) : pconstset;
+        function createsetconst(psd : tsetdef) : pconstset;
         var
           pcs : pconstset;
-          pes : penumsym;
+          pes : tenumsym;
           i : longint;
         begin
           new(pcs);
-          case psd^.elementtype.def^.deftype of
+          case psd.elementtype.def.deftype of
             enumdef :
               begin
-                pes:=penumsym(penumdef(psd^.elementtype.def)^.firstenum);
+                pes:=tenumsym(tenumdef(psd.elementtype.def).firstenum);
                 while assigned(pes) do
                   begin
-                    pcs^[pes^.value div 8]:=pcs^[pes^.value div 8] or (1 shl (pes^.value mod 8));
-                    pes:=pes^.nextenum;
+                    pcs^[pes.value div 8]:=pcs^[pes.value div 8] or (1 shl (pes.value mod 8));
+                    pes:=pes.nextenum;
                   end;
               end;
             orddef :
               begin
-                for i:=porddef(psd^.elementtype.def)^.low to porddef(psd^.elementtype.def)^.high do
+                for i:=torddef(psd.elementtype.def).low to torddef(psd.elementtype.def).high do
                   begin
                     pcs^[i div 8]:=pcs^[i div 8] or (1 shl (i mod 8));
                   end;
@@ -225,13 +225,13 @@ implementation
              exit;
           end;
 
-         if right.resulttype.def^.deftype<>setdef then
+         if right.resulttype.def.deftype<>setdef then
            CGMessage(sym_e_set_expected);
 
          if (right.nodetype=typen) then
            begin
              { we need to create a setconstn }
-             pst:=createsetconst(psetdef(ttypenode(right).resulttype.def));
+             pst:=createsetconst(tsetdef(ttypenode(right).resulttype.def));
              t:=csetconstnode.create(pst,ttypenode(right).resulttype);
              dispose(pst);
              right.free;
@@ -244,8 +244,8 @@ implementation
            exit;
 
          { type conversion/check }
-         if assigned(psetdef(right.resulttype.def)^.elementtype.def) then
-          inserttypeconv(left,psetdef(right.resulttype.def)^.elementtype);
+         if assigned(tsetdef(right.resulttype.def).elementtype.def) then
+          inserttypeconv(left,tsetdef(right.resulttype.def).elementtype);
       end;
 
 
@@ -264,7 +264,7 @@ implementation
            exit;
 
          { empty set then return false }
-         if not assigned(psetdef(right.resulttype.def)^.elementtype.def) then
+         if not assigned(tsetdef(right.resulttype.def).elementtype.def) then
           begin
             t:=cordconstnode.create(0,booltype);
             firstpass(t);
@@ -284,7 +284,7 @@ implementation
          left_right_max;
          { this is not allways true due to optimization }
          { but if we don't set this we get problems with optimizing self code }
-         if psetdef(right.resulttype.def)^.settype<>smallset then
+         if tsetdef(right.resulttype.def).settype<>smallset then
            procinfo^.flags:=procinfo^.flags or pi_do_call
          else
            begin
@@ -588,7 +588,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.12  2001-04-02 21:20:31  peter
+  Revision 1.13  2001-04-13 01:22:10  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.12  2001/04/02 21:20:31  peter
     * resulttype rewrite
 
   Revision 1.11  2000/12/31 11:14:11  jonas

compiler/ogbase.pas

@@ -34,7 +34,7 @@ interface
        dos,
 {$endif Delphi}
        { common }
-       cclasses,cobjects,
+       cclasses,
        { targets }
        systems,
        { outputwriters }
@@ -51,7 +51,7 @@ interface
        toutputreloc = packed record
           next     : poutputreloc;
           address  : longint;
-          symbol   : pasmsymbol;
+          symbol   : tasmsymbol;
           section  : tsection; { only used if symbol=nil }
           typ      : relative_type;
        end;
@@ -90,7 +90,7 @@ interface
          function  aligneddatasize:longint;
          procedure alignsection;
          procedure alloc(l:longint);
-         procedure addsymreloc(ofs:longint;p:pasmsymbol;relative:relative_type);
+         procedure addsymreloc(ofs:longint;p:tasmsymbol;relative:relative_type);
          procedure addsectionreloc(ofs:longint;sec:tsection;relative:relative_type);
        end;
 
@@ -98,7 +98,7 @@ interface
          { section }
          currsec   : tsection;
          sects     : array[TSection] of tobjectsection;
-         localsyms : pdictionary;
+         localsyms : tdictionary;
          constructor create;
          destructor  destroy;override;
          procedure createsection(sec:tsection);virtual;
@@ -108,11 +108,11 @@ interface
          procedure alloc(len:longint);
          procedure allocalign(len:longint);
          procedure writebytes(var data;len:longint);
-         procedure writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);virtual;abstract;
-         procedure writesymbol(p:pasmsymbol);virtual;abstract;
+         procedure writereloc(data,len:longint;p:tasmsymbol;relative:relative_type);virtual;abstract;
+         procedure writesymbol(p:tasmsymbol);virtual;abstract;
          procedure writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);virtual;abstract;
-         procedure writesymstabs(section:tsection;offset:longint;p:pchar;ps:pasmsymbol;nidx,nother,line:longint;reloc:boolean);virtual;abstract;
-         procedure addsymbol(p:pasmsymbol);
+         procedure writesymstabs(section:tsection;offset:longint;p:pchar;ps:tasmsymbol;nidx,nother,line:longint;reloc:boolean);virtual;abstract;
+         procedure addsymbol(p:tasmsymbol);
        end;
 
        tobjectalloc = class
@@ -140,7 +140,7 @@ interface
          destructor  destroy;override;
          function  initwriting(const fn:string):boolean;virtual;
          procedure donewriting;virtual;
-         procedure exportsymbol(p:pasmsymbol);
+         procedure exportsymbol(p:tasmsymbol);
          property Data:TObjectData read FData write FData;
          property Writer:TObjectWriter read FWriter;
        end;
@@ -173,13 +173,12 @@ interface
       objectoutput : tobjectoutput;
 
       { globals }
-      globalsyms : pdictionary;
+      globalsyms : tdictionary;
 
 
 implementation
 
     uses
-      comphook,
       cutils,globtype,globals,verbose,fmodule;
 
 
@@ -330,7 +329,7 @@ implementation
       end;
 
 
-    procedure tobjectsection.addsymreloc(ofs:longint;p:pasmsymbol;relative:relative_type);
+    procedure tobjectsection.addsymreloc(ofs:longint;p:tasmsymbol;relative:relative_type);
       var
         r : POutputReloc;
       begin
@@ -370,8 +369,8 @@ implementation
       begin
         { reset }
         FillChar(Sects,sizeof(Sects),0);
-        localsyms:=new(pdictionary,init);
-        localsyms^.usehash;
+        localsyms:=tdictionary.create;
+        localsyms.usehash;
       end;
 
 
@@ -383,7 +382,7 @@ implementation
         for sec:=low(tsection) to high(tsection) do
          if assigned(sects[sec]) then
           sects[sec].free;
-        dispose(localsyms,done);
+        localsyms.free;
       end;
 
 
@@ -441,12 +440,12 @@ implementation
       end;
 
 
-    procedure tobjectdata.addsymbol(p:pasmsymbol);
+    procedure tobjectdata.addsymbol(p:tasmsymbol);
       begin
-        if (p^.bind=AB_LOCAL) then
-         localsyms^.insert(p)
+        if (p.bind=AB_LOCAL) then
+         localsyms.insert(p)
         else
-         globalsyms^.insert(p);
+         globalsyms.insert(p);
       end;
 
 
@@ -497,12 +496,12 @@ implementation
       end;
 
 
-    procedure tobjectoutput.exportsymbol(p:pasmsymbol);
+    procedure tobjectoutput.exportsymbol(p:tasmsymbol);
       begin
         { export globals and common symbols, this is needed
           for .a files }
-        if p^.bind in [AB_GLOBAL,AB_COMMON] then
-         FWriter.writesym(p^.name);
+        if p.bind in [AB_GLOBAL,AB_COMMON] then
+         FWriter.writesym(p.name);
       end;
 
 
@@ -569,7 +568,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  2001-03-05 21:40:38  peter
+  Revision 1.7  2001-04-13 01:22:10  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.6  2001/03/05 21:40:38  peter
     * more things for tcoffobjectinput
 
   Revision 1.5  2000/12/25 00:07:26  peter

compiler/ogcoff.pas

@@ -32,7 +32,7 @@ interface
 
     uses
        { common }
-       cclasses,cobjects,
+       cclasses,
        { target }
        systems,
        { assembler }
@@ -61,10 +61,10 @@ interface
          destructor  destroy;override;
          procedure setsectionsizes(var s:tsecsize);override;
          procedure createsection(sec:tsection);override;
-         procedure writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);override;
-         procedure writesymbol(p:pasmsymbol);override;
+         procedure writereloc(data,len:longint;p:tasmsymbol;relative:relative_type);override;
+         procedure writesymbol(p:tasmsymbol);override;
          procedure writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);override;
-         procedure writesymstabs(section:tsection;offset:longint;p:pchar;ps:pasmsymbol;nidx,nother,line:longint;reloc:boolean);override;
+         procedure writesymstabs(section:tsection;offset:longint;p:pchar;ps:tasmsymbol;nidx,nother,line:longint;reloc:boolean);override;
        end;
 
        tcoffobjectoutput = class(tobjectoutput)
@@ -82,13 +82,13 @@ interface
          function  initwriting(const fn:string):boolean;override;
        end;
 
-       tpasmsymbolarray = array[0..high(word)] of pasmsymbol;
+       ttasmsymbolarray = array[0..high(word)] of tasmsymbol;
 
        tcoffobjectinput = class(tobjectinput)
        private
          Fidx2sec  : array[0..255] of tsection;
          FCoffsyms : tdynamicarray;
-         FSymTbl   : ^tpasmsymbolarray;
+         FSymTbl   : ^ttasmsymbolarray;
          win32     : boolean;
          procedure read_relocs(s:tcoffsection);
          procedure handle_symbols;
@@ -293,33 +293,33 @@ implementation
       end;
 
 
-    procedure tcoffdata.writesymbol(p:pasmsymbol);
+    procedure tcoffdata.writesymbol(p:tasmsymbol);
       var
         sym : toutputsymbol;
         s   : string;
       begin
         { already written ? }
-        if p^.idx<>-1 then
+        if p.idx<>-1 then
          exit;
         { be sure that the section will exists }
-        if (p^.section<>sec_none) and not(assigned(sects[p^.section])) then
-          createsection(p^.section);
+        if (p.section<>sec_none) and not(assigned(sects[p.section])) then
+          createsection(p.section);
         FillChar(sym,sizeof(sym),0);
-        sym.value:=p^.size;
-        sym.bind:=p^.bind;
+        sym.value:=p.size;
+        sym.bind:=p.bind;
         sym.typ:=AT_NONE;
         { if local of global then set the section value to the address
           of the symbol }
         if sym.bind in [AB_LOCAL,AB_GLOBAL] then
          begin
-           sym.section:=p^.section;
-           sym.value:=p^.address+sects[sym.section].mempos;
+           sym.section:=p.section;
+           sym.value:=p.address+sects[sym.section].mempos;
          end;
         { store the symbol, but not the local ones }
         if (sym.bind<>AB_LOCAL) then
          begin
            { symbolname }
-           s:=p^.name;
+           s:=p.name;
            if length(s)>8 then
             begin
               sym.nameidx:=FStrs.size+4;
@@ -332,18 +332,18 @@ implementation
               sym.namestr:=s;
             end;
            { update the asmsymbol index }
-           p^.idx:=FSyms.size div sizeof(TOutputSymbol);
+           p.idx:=FSyms.size div sizeof(TOutputSymbol);
            { write the symbol }
            FSyms.write(sym,sizeof(toutputsymbol));
          end
         else
          begin
-           p^.idx:=-2; { local }
+           p.idx:=-2; { local }
          end;
       end;
 
 
-    procedure tcoffdata.writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);
+    procedure tcoffdata.writereloc(data,len:longint;p:tasmsymbol;relative:relative_type);
       var
         curraddr,
         symaddr : longint;
@@ -355,11 +355,11 @@ implementation
            { current address }
            curraddr:=sects[currsec].mempos+sects[currsec].datasize;
            { real address of the symbol }
-           symaddr:=p^.address;
-           if p^.section<>sec_none then
-            inc(symaddr,sects[p^.section].mempos);
+           symaddr:=p.address;
+           if p.section<>sec_none then
+            inc(symaddr,sects[p.section].mempos);
            { no symbol relocation need inside a section }
-           if p^.section=currsec then
+           if p.section=currsec then
              begin
                case relative of
                  relative_false :
@@ -381,14 +381,14 @@ implementation
            else
              begin
                writesymbol(p);
-               if (p^.section<>sec_none) and (relative<>relative_true) then
-                 sects[currsec].addsectionreloc(curraddr,p^.section,relative)
+               if (p.section<>sec_none) and (relative<>relative_true) then
+                 sects[currsec].addsectionreloc(curraddr,p.section,relative)
                else
                  sects[currsec].addsymreloc(curraddr,p,relative);
                if not win32 then {seems wrong to me (PM) }
                 inc(data,symaddr)
                else
-                if (relative<>relative_true) and (p^.section<>sec_none) then
+                if (relative<>relative_true) and (p.section<>sec_none) then
                  inc(data,symaddr);
                if relative=relative_true then
                 begin
@@ -451,7 +451,7 @@ implementation
       end;
 
 
-    procedure tcoffdata.writesymstabs(section:tsection;offset:longint;p:pchar;ps:pasmsymbol;
+    procedure tcoffdata.writesymstabs(section:tsection;offset:longint;p:pchar;ps:tasmsymbol;
                                                  nidx,nother,line:longint;reloc:boolean);
       var
         stab : coffstab;
@@ -579,13 +579,13 @@ implementation
            rel.address:=r^.address;
            if assigned(r^.symbol) then
             begin
-              if (r^.symbol^.bind=AB_LOCAL) then
-               rel.sym:=2*data.sects[r^.symbol^.section].secsymidx
+              if (r^.symbol.bind=AB_LOCAL) then
+               rel.sym:=2*data.sects[r^.symbol.section].secsymidx
               else
                begin
-                 if r^.symbol^.idx=-1 then
+                 if r^.symbol.idx=-1 then
                    internalerror(4321);
-                 rel.sym:=r^.symbol^.idx+initsym;
+                 rel.sym:=r^.symbol.idx+initsym;
                end;
             end
            else
@@ -845,7 +845,7 @@ implementation
         rel  : coffreloc;
         rel_type : relative_type;
         i        : longint;
-        p        : pasmsymbol;
+        p        : tasmsymbol;
       begin
         for i:=1 to s.coffrelocs do
          begin
@@ -882,13 +882,13 @@ implementation
         symidx    : longint;
         sym       : coffsymbol;
         strname   : string;
-        p         : pasmsymbol;
+        p         : tasmsymbol;
         auxrec    : array[0..17] of byte;
       begin
         with tcoffdata(data) do
          begin
            nsyms:=FCoffSyms.Size div sizeof(CoffSymbol);
-           { Allocate memory for symidx -> pasmsymbol table }
+           { Allocate memory for symidx -> tasmsymbol table }
            GetMem(FSymTbl,nsyms*sizeof(pointer));
            FillChar(FSymTbl^,nsyms*sizeof(pointer),0);
            { Loop all symbols }
@@ -916,17 +916,17 @@ implementation
                   begin
                     if sym.section=0 then
                      begin
-                       p:=new(pasmsymbol,init(strname,AB_EXTERNAL,AT_FUNCTION));
+                       p:=tasmsymbol.create(strname,AB_EXTERNAL,AT_FUNCTION);
                      end
                     else
                      begin
-                       p:=new(pasmsymbol,init(strname,AB_GLOBAL,AT_FUNCTION));
+                       p:=tasmsymbol.create(strname,AB_GLOBAL,AT_FUNCTION);
                        sec:=Fidx2sec[sym.section];
                        if assigned(sects[sec]) then
                         begin
-                          p^.section:=sec;
+                          p.section:=sec;
                           if sym.value>=sects[sec].mempos then
-                           p^.address:=sym.value-sects[sec].mempos
+                           p.address:=sym.value-sects[sec].mempos
                           else
                            internalerror(432432432);
                         end
@@ -938,13 +938,13 @@ implementation
                   end;
                 COFF_SYM_STATIC :
                   begin
-                    p:=new(pasmsymbol,init(strname,AB_LOCAL,AT_FUNCTION));
+                    p:=tasmsymbol.create(strname,AB_LOCAL,AT_FUNCTION);
                     sec:=Fidx2sec[sym.section];
                     if assigned(sects[sec]) then
                      begin
-                       p^.section:=sec;
+                       p.section:=sec;
                        if sym.value>=sects[sec].mempos then
-                        p^.address:=sym.value-sects[sec].mempos
+                        p.address:=sym.value-sects[sec].mempos
                        else
                         begin
                           if Str2Sec(strname)<>sec then
@@ -1088,7 +1088,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.11  2001-04-02 21:20:31  peter
+  Revision 1.12  2001-04-13 01:22:10  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.11  2001/04/02 21:20:31  peter
     * resulttype rewrite
 
   Revision 1.10  2001/03/13 18:45:07  peter

compiler/ogelf.pas

@@ -32,7 +32,7 @@ interface
 
     uses
        { common }
-       cclasses,cobjects,
+       cclasses,
        { target }
        systems,
        { assembler }
@@ -72,10 +72,10 @@ interface
          destructor  destroy;override;
          procedure createsection(sec:tsection);override;
          procedure setsectionsizes(var s:tsecsize);override;
-         procedure writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);override;
-         procedure writesymbol(p:pasmsymbol);override;
+         procedure writereloc(data,len:longint;p:tasmsymbol;relative:relative_type);override;
+         procedure writesymbol(p:tasmsymbol);override;
          procedure writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);override;
-         procedure writesymstabs(section:tsection;offset:longint;p:pchar;ps:pasmsymbol;
+         procedure writesymstabs(section:tsection;offset:longint;p:pchar;ps:tasmsymbol;
                                  nidx,nother,line:longint;reloc:boolean);override;
        end;
 
@@ -325,28 +325,28 @@ implementation
       end;
 
 
-    procedure telf32data.writesymbol(p:pasmsymbol);
+    procedure telf32data.writesymbol(p:tasmsymbol);
       var
         sym : toutputsymbol;
       begin
         { already written ? }
-        if p^.idx<>-1 then
+        if p.idx<>-1 then
          exit;
         { be sure that the section will exists }
-        if (p^.section<>sec_none) and not(assigned(sects[p^.section])) then
-          createsection(p^.section);
+        if (p.section<>sec_none) and not(assigned(sects[p.section])) then
+          createsection(p.section);
         FillChar(sym,sizeof(sym),0);
-        sym.size:=p^.size;
-        sym.bind:=p^.bind;
-        sym.typ:=p^.typ;
+        sym.size:=p.size;
+        sym.bind:=p.bind;
+        sym.typ:=p.typ;
         { if local of global then set the section value to the address
           of the symbol }
         case sym.bind of
           AB_LOCAL,
           AB_GLOBAL :
             begin
-              sym.section:=p^.section;
-              sym.value:=p^.address;
+              sym.section:=p.section;
+              sym.value:=p.address;
             end;
           AB_COMMON :
             begin
@@ -358,21 +358,21 @@ implementation
          begin
            { symbolname, write the #0 separate to overcome 255+1 char not possible }
            sym.nameidx:=strtabsect.datasize;
-           strtabsect.writestr(p^.name);
+           strtabsect.writestr(p.name);
            strtabsect.writestr(#0);
            { update the asmsymbol index }
-           p^.idx:=syms.size div sizeof(toutputsymbol);
+           p.idx:=syms.size div sizeof(toutputsymbol);
            { symbol }
            Syms.write(sym,sizeof(toutputsymbol));
          end
         else
          begin
-           p^.idx:=-2; { local }
+           p.idx:=-2; { local }
          end;
       end;
 
 
-    procedure telf32data.writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);
+    procedure telf32data.writereloc(data,len:longint;p:tasmsymbol;relative:relative_type);
       var
         symaddr : longint;
       begin
@@ -381,9 +381,9 @@ implementation
         if assigned(p) then
          begin
            { real address of the symbol }
-           symaddr:=p^.address;
+           symaddr:=p.address;
            { no symbol relocation need inside a section }
-           if p^.section=currsec then
+           if p.section=currsec then
              begin
                case relative of
                  relative_false :
@@ -402,16 +402,16 @@ implementation
            else
              begin
                writesymbol(p);
-               if (p^.section<>sec_none) and (relative<>relative_true) then
+               if (p.section<>sec_none) and (relative<>relative_true) then
                 begin
-                  sects[currsec].addsectionreloc(sects[currsec].datasize,p^.section,relative);
+                  sects[currsec].addsectionreloc(sects[currsec].datasize,p.section,relative);
                   inc(data,symaddr);
                 end
                else
                 sects[currsec].addsymreloc(sects[currsec].datasize,p,relative);
                if relative=relative_true then
                 begin
-                  if p^.bind=AB_EXTERNAL then
+                  if p.bind=AB_EXTERNAL then
                    dec(data,len)
                   else
                    dec(data,len+sects[currsec].datasize);
@@ -456,7 +456,7 @@ implementation
       end;
 
 
-    procedure telf32data.writesymstabs(section:tsection;offset:longint;p:pchar;ps:pasmsymbol;
+    procedure telf32data.writesymstabs(section:tsection;offset:longint;p:pchar;ps:tasmsymbol;
                                                  nidx,nother,line:longint;reloc:boolean);
       var
         stab : telf32stab;
@@ -526,13 +526,13 @@ implementation
               rel.address:=r^.address;
               if assigned(r^.symbol) then
                begin
-                 if (r^.symbol^.bind=AB_LOCAL) then
-                  relsym:=sects[r^.symbol^.section].secsymidx
+                 if (r^.symbol.bind=AB_LOCAL) then
+                  relsym:=sects[r^.symbol.section].secsymidx
                  else
                   begin
-                    if r^.symbol^.idx=-1 then
+                    if r^.symbol.idx=-1 then
                       internalerror(4321);
-                    relsym:=(r^.symbol^.idx+initsym);
+                    relsym:=(r^.symbol.idx+initsym);
                   end;
                end
               else
@@ -846,7 +846,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  2001-03-05 21:40:39  peter
+  Revision 1.7  2001-04-13 01:22:10  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.6  2001/03/05 21:40:39  peter
     * more things for tcoffobjectinput
 
   Revision 1.5  2000/12/25 00:07:26  peter

compiler/options.pas

@@ -56,8 +56,10 @@ type
     procedure parsecmd(cmd:string);
   end;
 
+  TOptionClass=class of toption;
+
 var
-  coption : class of toption;
+  coption : TOptionClass;
 
 procedure read_arguments(cmd:string);
 
@@ -71,7 +73,7 @@ uses
   dos,
 {$endif Delphi}
   version,systems,
-  cutils,cobjects,messages
+  cutils,messages
 {$ifdef BrowserLog}
   ,browlog
 {$endif BrowserLog}
@@ -771,7 +773,7 @@ begin
                        case More[j] of
                         'B': {bind_win32_dll:=true}
                              begin
-                               {  -WB200000 means set prefered base address
+                               {  -WB200000 means set trefered base address
                                  to $200000, but does not change relocsection boolean
                                  this way we can create both relocatble and
                                  non relocatable DLL at a specific base address PM }
@@ -1555,7 +1557,12 @@ finalization
 end.
 {
   $Log$
-  Revision 1.38  2001-03-25 12:27:31  peter
+  Revision 1.39  2001-04-13 01:22:10  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.38  2001/03/25 12:27:31  peter
     * fixed -Se (merged)
 
   Revision 1.37  2001/03/23 00:16:07  florian

compiler/parser.pas

@@ -36,7 +36,7 @@ interface
 implementation
 
     uses
-      cutils,cobjects,cclasses,
+      cutils,cclasses,
       globtype,version,tokens,systems,globals,verbose,
       symbase,symtable,symsym,fmodule,aasm,
       hcodegen,
@@ -92,10 +92,10 @@ implementation
           stacksize:=target_info.stacksize;
 
          { open assembler response }
-         AsmRes.Init(outputexedir+'ppas');
+         AsmRes:=TAsmScript.Create(outputexedir+'ppas');
 
          { open deffile }
-         DefFile.Init(outputexedir+inputfile+target_os.defext);
+         DefFile:=TDefFile.Create(outputexedir+inputfile+target_os.defext);
 
          { list of generated .o files, so the linker can remove them }
          SmartLinkOFiles:=TStringList.Create;
@@ -108,9 +108,17 @@ implementation
          loaded_units.free;
          usedunits.free;
 
+         { if there was an error in the scanner, the scanner is
+           still assinged }
+         if assigned(current_scanner) then
+          begin
+            dispose(current_scanner,done);
+            current_scanner:=nil;
+          end;
+
          { close ppas,deffile }
-         asmres.done;
-         deffile.done;
+         asmres.free;
+         deffile.free;
 
          { free list of .o files }
          SmartLinkOFiles.Free;
@@ -200,6 +208,7 @@ implementation
          until false;
        { free scanner }
          dispose(current_scanner,done);
+         current_scanner:=nil;
        { close }
          dispose(preprocfile,done);
       end;
@@ -221,9 +230,9 @@ implementation
        { symtable }
          oldrefsymtable,
          olddefaultsymtablestack,
-         oldsymtablestack : psymtable;
+         oldsymtablestack : tsymtable;
          oldprocprefix    : string;
-         oldaktprocsym    : pprocsym;
+         oldaktprocsym    : tprocsym;
          oldoverloaded_operators : toverloaded_operators;
        { cg }
          oldnextlabelnr : longint;
@@ -241,7 +250,7 @@ implementation
          olddebuglist,
          oldwithdebuglist,
          oldconsts     : taasmoutput;
-         oldasmsymbollist : pdictionary;
+         oldasmsymbollist : tdictionary;
        { resourcestrings }
          OldResourceStrings : tResourceStrings;
        { akt.. things }
@@ -363,6 +372,10 @@ implementation
             main_module:=current_module;
           end;
 
+         { a unit compiled at command line must be inside the loaded_unit list }
+         if (compile_level=1) then
+           loaded_units.insert(current_module);
+
          { Set the module to use for verbose }
          SetCompileModule(current_module);
 
@@ -461,6 +474,7 @@ implementation
           end;
        { free scanner }
          dispose(current_scanner,done);
+         current_scanner:=nil;
        { restore previous scanner !! }
          current_module.scanner:=prev_scanner;
          if assigned(prev_scanner) then
@@ -567,11 +581,11 @@ implementation
           (* Obsolete code aktprocsym
              is disposed by the localsymtable disposal (PM)
           { Free last aktprocsym }
-            if assigned(aktprocsym) and (aktprocsym^.owner=nil) then
+            if assigned(aktprocsym) and (aktprocsym.owner=nil) then
              begin
                { init parts are not needed in units !! }
                if current_module.is_unit then
-                 aktprocsym^.definition^.forwarddef:=false;
+                 aktprocsym.definition.forwarddef:=false;
                dispose(aktprocsym,done);
              end; *)
           end;
@@ -589,7 +603,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.13  2000-12-25 00:07:27  peter
+  Revision 1.14  2001-04-13 01:22:10  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.13  2000/12/25 00:07:27  peter
     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
       tlinkedlist objects)
 

compiler/pass_1.pas

@@ -47,9 +47,10 @@ implementation
 
     uses
       globtype,systems,
-      cutils,cobjects,globals,verbose,
+      cutils,globals,
       hcodegen,symdef,
 {$ifdef extdebug}
+      verbose,
       htypechk,
 {$endif extdebug}
       tgcpu
@@ -79,17 +80,12 @@ implementation
            aktfilepos:=p.fileinfo;
            aktlocalswitches:=p.localswitches;
            hp:=p.det_resulttype;
-//writeln('result: ',nodetype2str[p.nodetype],' ',dword(hp));
            { should the node be replaced? }
            if assigned(hp) then
             begin
                p.free;
                p:=hp;
             end;
-{$ifdef EXTDEBUG}
-           { save resulttype for checking of changes in pass_1 }
-           p.oldresulttype:=p.resulttype;
-{$endif EXTDEBUG}
            aktlocalswitches:=oldlocalswitches;
            aktfilepos:=oldpos;
            if codegenerror then
@@ -149,10 +145,6 @@ implementation
                      p.free;
                      p:=hp;
                   end;
-{$ifdef EXTDEBUG}
-                 { save resulttype for checking of changes in pass_1 }
-                 p.oldresulttype:=p.resulttype;
-{$endif EXTDEBUG}
                end;
               { first pass }
               hp:=p.pass_1;
@@ -162,12 +154,6 @@ implementation
                    p.free;
                    p:=hp;
                 end;
-{$ifdef EXTDEBUG}
-              { check if the resulttype is still the same }
-              if (p.oldresulttype.def<>p.resulttype.def) and
-                 (p.oldresulttype.sym<>p.resulttype.sym) then
-               Comment(V_Warning,'Resulttype change in '+nodetype2str[p.nodetype]+'.pass_1');
-{$endif EXTDEBUG}
               aktlocalswitches:=oldlocalswitches;
               aktfilepos:=oldpos;
               if codegenerror then
@@ -194,7 +180,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.12  2001-04-02 21:20:31  peter
+  Revision 1.13  2001-04-13 01:22:10  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.12  2001/04/02 21:20:31  peter
     * resulttype rewrite
 
   Revision 1.11  2000/12/18 21:56:52  peter

compiler/pass_2.pas

@@ -51,7 +51,7 @@ implementation
      cutils,
 {$endif}
      globtype,systems,
-     cobjects,globals,
+     cclasses,globals,
      symconst,symbase,symtype,symsym,aasm,
      pass_1,hcodegen,temp_gen,regvars,nflw,tgcpu;
 
@@ -215,12 +215,12 @@ implementation
          do_secondpass:=codegenerror;
       end;
 
-    procedure clearrefs(p : pnamedindexobject);
+    procedure clearrefs(p : tnamedindexitem);
 
       begin
-         if (psym(p)^.typ=varsym) then
-           if pvarsym(p)^.refs>1 then
-             pvarsym(p)^.refs:=1;
+         if (tsym(p).typ=varsym) then
+           if tvarsym(p).refs>1 then
+             tvarsym(p).refs:=1;
       end;
 
     procedure generatecode(var p : tnode);
@@ -237,8 +237,8 @@ implementation
          clearregistercount;
          use_esp_stackframe:=false;
          aktexceptblock:=nil;
-         symtablestack^.foreach(@clearrefs);
-         symtablestack^.next^.foreach(@clearrefs);
+         symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}clearrefs);
+         symtablestack.next.foreach_static({$ifdef FPCPROCVAR}@{$endif}clearrefs);
          if not(do_firstpass(p)) then
            begin
              if (cs_regalloc in aktglobalswitches) and
@@ -258,8 +258,8 @@ implementation
                                    if assigned(aktprocsym) then
                                      begin
                                        if not(assigned(procinfo^._class)) and
-                                          not(aktprocsym^.definition^.proctypeoption in [potype_constructor,potype_destructor]) and
-                                          not(po_interrupt in aktprocsym^.definition^.procoptions) and
+                                          not(aktprocsym.definition.proctypeoption in [potype_constructor,potype_destructor]) and
+                                          not(po_interrupt in aktprocsym.definition.procoptions) and
                                           ((procinfo^.flags and pi_do_call)=0) and
                                           (lexlevel>=normal_function_level) then
                                          begin
@@ -278,7 +278,7 @@ implementation
                                              dec(procinfo^.retoffset,4);
 
                                            dec(procinfo^.para_offset,4);
-                                           aktprocsym^.definition^.parast^.address_fixup:=procinfo^.para_offset;
+                                           aktprocsym.definition.parast.address_fixup:=procinfo^.para_offset;
                                          end;
                                      end;
                                     *)
@@ -289,12 +289,12 @@ implementation
               cleanup_regvars(procinfo^.aktexitcode);
 
               if assigned(aktprocsym) and
-                 (pocall_inline in aktprocsym^.definition^.proccalloptions) then
+                 (pocall_inline in aktprocsym.definition.proccalloptions) then
                 make_const_global:=true;
               do_secondpass(p);
 
               if assigned(procinfo^.def) then
-                procinfo^.def^.fpu_used:=p.registersfpu;
+                procinfo^.def.fpu_used:=p.registersfpu;
 
            end;
          procinfo^.aktproccode.concatlist(exprasmlist);
@@ -304,7 +304,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.13  2001-04-02 21:20:31  peter
+  Revision 1.14  2001-04-13 01:22:10  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.13  2001/04/02 21:20:31  peter
     * resulttype rewrite
 
   Revision 1.12  2000/12/25 00:07:27  peter

compiler/pbase.pas

@@ -27,7 +27,7 @@ unit pbase;
 interface
 
     uses
-       cutils,cobjects,cclasses,
+       cutils,cclasses,
        tokens,globals,
        symconst,symbase,symtype,symdef,symsym,symtable
 {$ifdef fixLeaksOnError}
@@ -41,7 +41,7 @@ interface
 
        { sspecial for handling procedure vars }
        getprocvar : boolean = false;
-       getprocvardef : pprocvardef = nil;
+       getprocvardef : tprocvardef = nil;
 
     type
        { listitem }
@@ -64,10 +64,10 @@ interface
 
        { for operators }
        optoken : ttoken;
-       opsym : pvarsym;
+       otsym : tvarsym;
 
        { symtable were unit references are stored }
-       refsymtable : psymtable;
+       refsymtable : tsymtable;
 
        { true, if only routine headers should be parsed }
        parse_only : boolean;
@@ -100,7 +100,7 @@ interface
 
     { consume a symbol, if not found give an error and
       and return an errorsym }
-    function consume_sym(var srsym:psym;var srsymtable:psymtable):boolean;
+    function consume_sym(var srsym:tsym;var srsymtable:tsymtable):boolean;
 
     { reads a list of identifiers into a string list }
     function idlist : tidstringlist;
@@ -244,7 +244,7 @@ implementation
 
 
 
-    function consume_sym(var srsym:psym;var srsymtable:psymtable):boolean;
+    function consume_sym(var srsym:tsym;var srsymtable:tsymtable):boolean;
       begin
         { first check for identifier }
         if token<>_ID then
@@ -258,15 +258,15 @@ implementation
         searchsym(pattern,srsym,srsymtable);
         if assigned(srsym) then
          begin
-           if (srsym^.typ=unitsym) then
+           if (srsym.typ=unitsym) then
             begin
               { only allow unit.symbol access if the name was
                 found in the current module }
-              if srsym^.owner^.unitid=0 then
+              if srsym.owner.unitid=0 then
                begin
                  consume(_ID);
                  consume(_POINT);
-                 srsymtable:=punitsym(srsym)^.unitsymtable;
+                 srsymtable:=tunitsym(srsym).unitsymtable;
                  srsym:=searchsymonlyin(srsymtable,pattern);
                end
               else
@@ -322,7 +322,12 @@ end.
 
 {
   $Log$
-  Revision 1.9  2001-04-02 21:20:31  peter
+  Revision 1.10  2001-04-13 01:22:11  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.9  2001/04/02 21:20:31  peter
     * resulttype rewrite
 
   Revision 1.8  2001/03/11 22:58:49  peter

compiler/pdecl.pas

@@ -27,8 +27,6 @@ unit pdecl;
 interface
 
     uses
-      { common }
-      cobjects,
       { global }
       globals,
       { symtable }
@@ -36,7 +34,7 @@ interface
       { pass_1 }
       node;
 
-    function  readconstant(const name:string;const filepos:tfileposinfo):pconstsym;
+    function  readconstant(const name:string;const filepos:tfileposinfo):tconstsym;
 
     procedure const_dec;
     procedure label_dec;
@@ -49,7 +47,7 @@ implementation
 
     uses
        { common }
-       cutils,
+       cutils,cclasses,
        { global }
        globtype,tokens,verbose,
        systems,
@@ -58,16 +56,15 @@ implementation
        { symtable }
        symconst,symbase,symtype,symdef,symtable,
        { pass 1 }
-       pass_1,
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
        { parser }
        scanner,
        pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj;
 
 
-    function readconstant(const name:string;const filepos:tfileposinfo):pconstsym;
+    function readconstant(const name:string;const filepos:tfileposinfo):tconstsym;
       var
-        hp : pconstsym;
+        hp : tconstsym;
         p : tnode;
         ps : pconstset;
         pd : pbestreal;
@@ -85,42 +82,42 @@ implementation
            ordconstn:
              begin
                 if is_constintnode(p) then
-                  hp:=new(pconstsym,init_typed(name,constint,tordconstnode(p).value,tordconstnode(p).resulttype))
+                  hp:=tconstsym.create_typed(name,constint,tordconstnode(p).value,tordconstnode(p).resulttype)
                 else if is_constcharnode(p) then
-                  hp:=new(pconstsym,init(name,constchar,tordconstnode(p).value))
+                  hp:=tconstsym.create(name,constchar,tordconstnode(p).value)
                 else if is_constboolnode(p) then
-                  hp:=new(pconstsym,init(name,constbool,tordconstnode(p).value))
-                else if p.resulttype.def^.deftype=enumdef then
-                  hp:=new(pconstsym,init_typed(name,constord,tordconstnode(p).value,p.resulttype))
-                else if p.resulttype.def^.deftype=pointerdef then
-                  hp:=new(pconstsym,init_typed(name,constord,tordconstnode(p).value,p.resulttype))
+                  hp:=tconstsym.create(name,constbool,tordconstnode(p).value)
+                else if p.resulttype.def.deftype=enumdef then
+                  hp:=tconstsym.create_typed(name,constord,tordconstnode(p).value,p.resulttype)
+                else if p.resulttype.def.deftype=pointerdef then
+                  hp:=tconstsym.create_typed(name,constord,tordconstnode(p).value,p.resulttype)
                 else internalerror(111);
              end;
            stringconstn:
              begin
                 getmem(sp,tstringconstnode(p).len+1);
                 move(tstringconstnode(p).value_str^,sp^,tstringconstnode(p).len+1);
-                hp:=new(pconstsym,init_string(name,conststring,sp,tstringconstnode(p).len));
+                hp:=tconstsym.create_string(name,conststring,sp,tstringconstnode(p).len);
              end;
            realconstn :
              begin
                 new(pd);
                 pd^:=trealconstnode(p).value_real;
-                hp:=new(pconstsym,init(name,constreal,longint(pd)));
+                hp:=tconstsym.create(name,constreal,longint(pd));
              end;
            setconstn :
              begin
                new(ps);
                ps^:=tsetconstnode(p).value_set^;
-               hp:=new(pconstsym,init_typed(name,constset,longint(ps),p.resulttype));
+               hp:=tconstsym.create_typed(name,constset,longint(ps),p.resulttype);
              end;
            pointerconstn :
              begin
-               hp:=new(pconstsym,init_typed(name,constpointer,tordconstnode(p).value,p.resulttype));
+               hp:=tconstsym.create_typed(name,constpointer,tordconstnode(p).value,p.resulttype);
              end;
            niln :
              begin
-               hp:=new(pconstsym,init_typed(name,constnil,0,p.resulttype));
+               hp:=tconstsym.create_typed(name,constnil,0,p.resulttype);
              end;
            else
              Message(cg_e_illegal_expression);
@@ -135,7 +132,7 @@ implementation
       var
          name : stringid;
          tt  : ttype;
-         sym : psym;
+         sym : tsym;
          storetokenpos,filepos : tfileposinfo;
          old_block_type : tblock_type;
          skipequal : boolean;
@@ -154,7 +151,7 @@ implementation
                    consume(_EQUAL);
                    sym:=readconstant(name,filepos);
                    if assigned(sym) then
-                    symtablestack^.insert(sym);
+                    symtablestack.insert(sym);
                    consume(_SEMICOLON);
                 end;
 
@@ -176,19 +173,19 @@ implementation
                    if m_delphi in aktmodeswitches then
                      begin
                        if assigned(readtypesym) then
-                        sym:=new(ptypedconstsym,initsym(name,readtypesym,true))
+                        sym:=ttypedconstsym.createsym(name,readtypesym,true)
                        else
-                        sym:=new(ptypedconstsym,init(name,def,true))
+                        sym:=ttypedconstsym.create(name,def,true)
                      end
                    else
 {$endif DELPHI_CONST_IN_RODATA}
                      begin
-                       sym:=new(ptypedconstsym,inittype(name,tt,false))
+                       sym:=ttypedconstsym.createtype(name,tt,false)
                      end;
                    akttokenpos:=storetokenpos;
-                   symtablestack^.insert(sym);
+                   symtablestack.insert(sym);
                    { procvar can have proc directives }
-                   if (tt.def^.deftype=procvardef) then
+                   if (tt.def.deftype=procvardef) then
                     begin
                       { support p : procedure;stdcall=nil; }
                       if (token=_SEMICOLON) then
@@ -215,10 +212,10 @@ implementation
                       consume(_EQUAL);
 {$ifdef DELPHI_CONST_IN_RODATA}
                       if m_delphi in aktmodeswitches then
-                       readtypedconst(tt,ptypedconstsym(sym),true)
+                       readtypedconst(tt,ttypedconstsym(sym),true)
                       else
 {$endif DELPHI_CONST_IN_RODATA}
-                       readtypedconst(tt,ptypedconstsym(sym),false);
+                       readtypedconst(tt,ttypedconstsym(sym),false);
                       consume(_SEMICOLON);
                     end;
                 end;
@@ -234,7 +231,7 @@ implementation
 
     procedure label_dec;
       var
-         hl : pasmlabel;
+         hl : tasmlabel;
       begin
          consume(_LABEL);
          if not(cs_support_goto in aktmoduleswitches) then
@@ -248,11 +245,11 @@ implementation
                   begin
                     getdatalabel(hl);
                     { we still want a warning if unused }
-                    hl^.refs:=0;
+                    hl.refs:=0;
                   end
                 else
                   getlabel(hl);
-                symtablestack^.insert(new(plabelsym,init(pattern,hl)));
+                symtablestack.insert(tlabelsym.create(pattern,hl));
                 consume(token);
              end;
            if token<>_SEMICOLON then consume(_COMMA);
@@ -262,21 +259,21 @@ implementation
 
 
     { search in symtablestack used, but not defined type }
-    procedure resolve_type_forward(p : pnamedindexobject);
+    procedure resolve_type_forward(p : tnamedindexitem);
       var
-        hpd,pd : pdef;
+        hpd,pd : tdef;
         stpos  : tfileposinfo;
         again  : boolean;
-        srsym  : psym;
-        srsymtable : psymtable;
+        srsym  : tsym;
+        srsymtable : tsymtable;
       begin
          { Check only typesyms or record/object fields }
-         case psym(p)^.typ of
+         case tsym(p).typ of
            typesym :
-             pd:=ptypesym(p)^.restype.def;
+             pd:=ttypesym(p).restype.def;
            varsym :
-             if (psym(p)^.owner^.symtabletype in [objectsymtable,recordsymtable]) then
-               pd:=pvarsym(p)^.vartype.def
+             if (tsym(p).owner.symtabletype in [objectsymtable,recordsymtable]) then
+               pd:=tvarsym(p).vartype.def
              else
                exit;
            else
@@ -284,80 +281,80 @@ implementation
          end;
          repeat
            again:=false;
-           case pd^.deftype of
+           case pd.deftype of
              arraydef :
                begin
                  { elementtype could also be defined using a forwarddef }
-                 pd:=parraydef(pd)^.elementtype.def;
+                 pd:=tarraydef(pd).elementtype.def;
                  again:=true;
                end;
              pointerdef,
              classrefdef :
                begin
                  { classrefdef inherits from pointerdef }
-                 hpd:=ppointerdef(pd)^.pointertype.def;
+                 hpd:=tpointerdef(pd).pointertype.def;
                  { still a forward def ? }
-                 if hpd^.deftype=forwarddef then
+                 if hpd.deftype=forwarddef then
                   begin
                     { try to resolve the forward }
                     { get the correct position for it }
                     stpos:=akttokenpos;
-                    akttokenpos:=pforwarddef(hpd)^.forwardpos;
+                    akttokenpos:=tforwarddef(hpd).forwardpos;
                     resolving_forward:=true;
                     make_ref:=false;
-                    searchsym(pforwarddef(hpd)^.tosymname,srsym,srsymtable);
+                    searchsym(tforwarddef(hpd).tosymname,srsym,srsymtable);
                     make_ref:=true;
                     resolving_forward:=false;
                     akttokenpos:=stpos;
                     { we don't need the forwarddef anymore, dispose it }
-                    dispose(hpd,done);
-                    ppointerdef(pd)^.pointertype.def:=nil; { if error occurs }
+                    hpd.free;
+                    tpointerdef(pd).pointertype.def:=nil; { if error occurs }
                     { was a type sym found ? }
                     if assigned(srsym) and
-                       (srsym^.typ=typesym) then
+                       (srsym.typ=typesym) then
                      begin
-                       ppointerdef(pd)^.pointertype.setsym(srsym);
+                       tpointerdef(pd).pointertype.setsym(srsym);
                        { avoid wrong unused warnings web bug 801 PM }
-                       inc(pstoredsym(srsym)^.refs);
+                       inc(tstoredsym(srsym).refs);
 {$ifdef GDB}
                        if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) and
-                          (psym(p)^.owner^.symtabletype in [globalsymtable,staticsymtable]) then
+                          (tsym(p).owner.symtabletype in [globalsymtable,staticsymtable]) then
                         begin
-                          ptypesym(p)^.isusedinstab := true;
-                          ptypesym(p)^.concatstabto(debuglist);
+                          ttypesym(p).isusedinstab := true;
+                          ttypesym(p).concatstabto(debuglist);
                         end;
 {$endif GDB}
                        { we need a class type for classrefdef }
-                       if (pd^.deftype=classrefdef) and
-                          not(is_class(ptypesym(srsym)^.restype.def)) then
-                         Message1(type_e_class_type_expected,ptypesym(srsym)^.restype.def^.typename);
+                       if (pd.deftype=classrefdef) and
+                          not(is_class(ttypesym(srsym).restype.def)) then
+                         Message1(type_e_class_type_expected,ttypesym(srsym).restype.def.typename);
                      end
                     else
                      begin
-                       MessagePos1(psym(p)^.fileinfo,sym_e_forward_type_not_resolved,psym(p)^.realname);
+                       MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
                        { try to recover }
-                       ppointerdef(pd)^.pointertype:=generrortype;
+                       tpointerdef(pd).pointertype:=generrortype;
                      end;
                   end;
                end;
              recorddef :
-               precorddef(pd)^.symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}resolve_type_forward);
+               trecorddef(pd).symtable.foreach_static({$ifdef FPCPROCVAR}@{$endif}resolve_type_forward);
              objectdef :
                begin
                  if not(m_fpc in aktmodeswitches) and
-                    (oo_is_forward in pobjectdef(pd)^.objectoptions) then
+                    (oo_is_forward in tobjectdef(pd).objectoptions) then
                   begin
                     { only give an error as the implementation may follow in an
                       other type block which is allowed by FPC modes }
-                    MessagePos1(psym(p)^.fileinfo,sym_e_forward_type_not_resolved,psym(p)^.realname);
+                    MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
                   end
                  else
                   begin
                     { Check all fields of the object declaration, but don't
                       check objectdefs in objects/records, because these
                       can't exist (anonymous objects aren't allowed) }
-                    if not(psym(p)^.owner^.symtabletype in [objectsymtable,recordsymtable]) then
-                     pobjectdef(pd)^.symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}resolve_type_forward);
+                    if not(tsym(p).owner.symtabletype in [objectsymtable,recordsymtable]) then
+                     tobjectdef(pd).symtable.foreach_static({$ifdef FPCPROCVAR}@{$endif}resolve_type_forward);
                   end;
                end;
           end;
@@ -369,9 +366,9 @@ implementation
     procedure type_dec;
       var
          typename,orgtypename : stringid;
-         newtype  : ptypesym;
-         sym      : psym;
-         srsymtable : psymtable;
+         newtype  : ttypesym;
+         sym      : tsym;
+         srsymtable : tsymtable;
          tt       : ttype;
          defpos,storetokenpos : tfileposinfo;
          old_block_type : tblock_type;
@@ -395,18 +392,18 @@ implementation
            { found a symbol with this name? }
            if assigned(sym) then
             begin
-              if (sym^.typ=typesym) then
+              if (sym.typ=typesym) then
                begin
                  if ((token=_CLASS) or
                      (token=_INTERFACE)) and
-                    (assigned(ptypesym(sym)^.restype.def)) and
-                    is_class_or_interface(ptypesym(sym)^.restype.def) and
-                    (oo_is_forward in pobjectdef(ptypesym(sym)^.restype.def)^.objectoptions) then
+                    (assigned(ttypesym(sym).restype.def)) and
+                    is_class_or_interface(ttypesym(sym).restype.def) and
+                    (oo_is_forward in tobjectdef(ttypesym(sym).restype.def).objectoptions) then
                   begin
                     { we can ignore the result   }
                     { the definition is modified }
-                    object_dec(orgtypename,pobjectdef(ptypesym(sym)^.restype.def));
-                    newtype:=ptypesym(sym);
+                    object_dec(orgtypename,tobjectdef(ttypesym(sym).restype.def));
+                    newtype:=ttypesym(sym);
                   end;
                end;
             end;
@@ -418,33 +415,33 @@ implementation
                 will give an error (PFV) }
               tt:=generrortype;
               storetokenpos:=akttokenpos;
-              newtype:=new(ptypesym,init(orgtypename,tt));
-              symtablestack^.insert(newtype);
+              newtype:=ttypesym.create(orgtypename,tt);
+              symtablestack.insert(newtype);
               akttokenpos:=defpos;
               akttokenpos:=storetokenpos;
               { read the type definition }
               read_type(tt,orgtypename);
               { update the definition of the type }
-              newtype^.restype:=tt;
+              newtype.restype:=tt;
               if not assigned(tt.sym) then
                 tt.sym:=newtype;
-              if assigned(tt.def) and not assigned(tt.def^.typesym) then
-                tt.def^.typesym:=newtype;
+              if assigned(tt.def) and not assigned(tt.def.typesym) then
+                tt.def.typesym:=newtype;
               { KAZ: handle TGUID declaration in system unit }
               if (cs_compilesystem in aktmoduleswitches) and not assigned(rec_tguid) and
                  (typename='TGUID') and { name: TGUID and size=16 bytes that is 128 bits }
-                 assigned(tt.def) and (tt.def^.deftype=recorddef) and (tt.def^.size=16) then
-                rec_tguid:=precorddef(tt.def);
+                 assigned(tt.def) and (tt.def.deftype=recorddef) and (tt.def.size=16) then
+                rec_tguid:=trecorddef(tt.def);
             end;
-           if assigned(newtype^.restype.def) then
+           if assigned(newtype.restype.def) then
             begin
-              case newtype^.restype.def^.deftype of
+              case newtype.restype.def.deftype of
                 pointerdef :
                   begin
                     consume(_SEMICOLON);
                     if try_to_consume(_FAR) then
                      begin
-                       ppointerdef(newtype^.restype.def)^.is_far:=true;
+                       tpointerdef(newtype.restype.def).is_far:=true;
                        consume(_SEMICOLON);
                      end;
                   end;
@@ -452,7 +449,7 @@ implementation
                   begin
                     if not is_proc_directive(token) then
                      consume(_SEMICOLON);
-                    parse_var_proc_directives(psym(newtype));
+                    parse_var_proc_directives(tsym(newtype));
                   end;
                 else
                   consume(_SEMICOLON);
@@ -460,7 +457,7 @@ implementation
             end;
          until token<>_ID;
          typecanbeforward:=false;
-         symtablestack^.foreach({$ifdef FPCPROCVAR}@{$endif}resolve_type_forward);
+         symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}resolve_type_forward);
          block_type:=old_block_type;
       end;
 
@@ -479,7 +476,7 @@ implementation
     { the top symbol table of symtablestack                }
       begin
         consume(_THREADVAR);
-        if not(symtablestack^.symtabletype in [staticsymtable,globalsymtable]) then
+        if not(symtablestack.symtabletype in [staticsymtable,globalsymtable]) then
           message(parser_e_threadvars_only_sg);
         read_var_decs(false,false,true);
       end;
@@ -494,7 +491,7 @@ implementation
          sp : pchar;
       begin
          consume(_RESOURCESTRING);
-         if not(symtablestack^.symtabletype in [staticsymtable,globalsymtable]) then
+         if not(symtablestack.symtabletype in [staticsymtable,globalsymtable]) then
            message(parser_e_resourcestring_only_sg);
          old_block_type:=block_type;
          block_type:=bt_const;
@@ -517,7 +514,7 @@ implementation
                                 getmem(sp,2);
                                 sp[0]:=chr(tordconstnode(p).value);
                                 sp[1]:=#0;
-                                symtablestack^.insert(new(pconstsym,init_string(name,constresourcestring,sp,1)));
+                                symtablestack.insert(tconstsym.create_string(name,constresourcestring,sp,1));
                              end
                            else
                              Message(cg_e_illegal_expression);
@@ -526,7 +523,7 @@ implementation
                         begin
                            getmem(sp,tstringconstnode(p).len+1);
                            move(tstringconstnode(p).value_str^,sp^,tstringconstnode(p).len+1);
-                           symtablestack^.insert(new(pconstsym,init_string(name,constresourcestring,sp,tstringconstnode(p).len)));
+                           symtablestack.insert(tconstsym.create_string(name,constresourcestring,sp,tstringconstnode(p).len));
                         end;
                       else
                         Message(cg_e_illegal_expression);
@@ -544,7 +541,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.28  2001-04-04 22:43:50  peter
+  Revision 1.29  2001-04-13 01:22:11  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.28  2001/04/04 22:43:50  peter
     * remove unnecessary calls to firstpass
 
   Revision 1.27  2001/04/04 21:30:43  florian

compiler/pdecobj.pas

@@ -30,30 +30,27 @@ interface
       globtype,symtype,symdef;
 
     { parses a object declaration }
-    function object_dec(const n : stringid;fd : pobjectdef) : pdef;
+    function object_dec(const n : stringid;fd : tobjectdef) : tdef;
 
 implementation
 
     uses
-      cutils,cobjects,cclasses,
+      cutils,cclasses,
       globals,verbose,systems,tokens,
       aasm,symconst,symbase,symsym,symtable,types,
-{$ifdef GDB}
-      gdb,
-{$endif}
       hcodegen,hcgdata,
       node,nld,ncon,ncnv,pass_1,
       scanner,
       pbase,pexpr,pdecsub,pdecvar,ptype;
 
-    function object_dec(const n : stringid;fd : pobjectdef) : pdef;
+    function object_dec(const n : stringid;fd : tobjectdef) : tdef;
     { this function parses an object or class declaration }
       var
          actmembertype : tsymoptions;
          there_is_a_destructor : boolean;
          classtype : tobjectdeftype;
-         childof : pobjectdef;
-         aktclass : pobjectdef;
+         childof : tobjectdef;
+         aktclass : tobjectdef;
 
       procedure constructor_head;
 
@@ -64,21 +61,21 @@ implementation
            parse_proc_head(potype_constructor);
            dec(lexlevel);
 
-           if (cs_constructor_name in aktglobalswitches) and (aktprocsym^.name<>'INIT') then
+           if (cs_constructor_name in aktglobalswitches) and (aktprocsym.name<>'INIT') then
             Message(parser_e_constructorname_must_be_init);
 
-           include(aktclass^.objectoptions,oo_has_constructor);
+           include(aktclass.objectoptions,oo_has_constructor);
            consume(_SEMICOLON);
              begin
                 if is_class(aktclass) then
                   begin
                      { CLASS constructors return the created instance }
-                     aktprocsym^.definition^.rettype.def:=aktclass;
+                     aktprocsym.definition.rettype.def:=aktclass;
                   end
                 else
                   begin
                      { OBJECT constructors return a boolean }
-                     aktprocsym^.definition^.rettype:=booltype;
+                     aktprocsym.definition.rettype:=booltype;
                   end;
              end;
         end;
@@ -87,38 +84,38 @@ implementation
       procedure property_dec;
 
         var
-           sym : psym;
+           sym : tsym;
            propertyparas : tlinkedlist;
 
         { returns the matching procedure to access a property }
-        function get_procdef : pprocdef;
+        function get_procdef : tprocdef;
 
           var
-             p : pprocdef;
+             p : tprocdef;
 
           begin
-             p:=pprocsym(sym)^.definition;
+             p:=tprocsym(sym).definition;
              get_procdef:=nil;
              while assigned(p) do
                begin
-                  if equal_paras(p^.para,propertyparas,cp_value_equal_const) or convertable_paras(p^.para,propertyparas,cp_value_equal_const) then {MvdV: Ozerski 14.03.01}
+                  if equal_paras(p.para,propertyparas,cp_value_equal_const) or convertable_paras(p.para,propertyparas,cp_value_equal_const) then {MvdV: Ozerski 14.03.01}
                     break;
-                  p:=p^.nextoverloaded;
+                  p:=p.nextoverloaded;
                end;
              get_procdef:=p;
           end;
 
         var
            hp2,datacoll : tparaitem;
-           p : ppropertysym;
-           overriden : psym;
+           p : tpropertysym;
+           overriden : tsym;
            hs : string;
            varspez : tvarspez;
            sc : tidstringlist;
            s : string;
            tt : ttype;
            declarepos : tfileposinfo;
-           pp : pprocdef;
+           pp : tprocdef;
            pt : tnode;
            propname : stringid;
 
@@ -132,7 +129,7 @@ implementation
            datacoll:=nil;
            if token=_ID then
              begin
-                p:=new(ppropertysym,init(orgpattern));
+                p:=tpropertysym.create(orgpattern);
                 propname:=pattern;
                 consume(_ID);
                 { property parameters ? }
@@ -181,9 +178,9 @@ implementation
                                  consume(_ARRAY);
                                  consume(_OF);
                                  { define range and type of range }
-                                 tt.setdef(new(parraydef,init(0,-1,s32bittype)));
+                                 tt.setdef(tarraydef.create(0,-1,s32bittype));
                                  { define field type }
-                                 single_type(parraydef(tt.def)^.elementtype,s,false);
+                                 single_type(tarraydef(tt.def).elementtype,s,false);
                               end
                             else
                               single_type(tt,s,false);
@@ -213,7 +210,7 @@ implementation
                 if (token=_COLON) or not(propertyparas.empty) then
                   begin
                      consume(_COLON);
-                     single_type(p^.proptype,hs,false);
+                     single_type(p.proptype,hs,false);
                      if (idtoken=_INDEX) then
                        begin
                           consume(_INDEX);
@@ -221,51 +218,51 @@ implementation
                           if is_constnode(pt) and
                              is_ordinal(pt.resulttype.def) and
                              (not is_64bitint(pt.resulttype.def)) then
-                            p^.index:=tordconstnode(pt).value
+                            p.index:=tordconstnode(pt).value
                           else
                             begin
                               Message(parser_e_invalid_property_index_value);
-                              p^.index:=0;
+                              p.index:=0;
                             end;
-                          p^.indextype.setdef(pt.resulttype.def);
-                          include(p^.propoptions,ppo_indexed);
+                          p.indextype.setdef(pt.resulttype.def);
+                          include(p.propoptions,ppo_indexed);
                           { concat a longint to the para template }
                           hp2:=TParaItem.Create;
                           hp2.paratyp:=vs_value;
-                          hp2.paratype:=p^.indextype;
+                          hp2.paratype:=p.indextype;
                           propertyparas.insert(hp2);
                           pt.free;
                        end;
                      { the parser need to know if a property has parameters }
                      if not(propertyparas.empty) then
-                       include(p^.propoptions,ppo_hasparameters);
+                       include(p.propoptions,ppo_hasparameters);
                   end
                 else
                   begin
                      { do an property override }
                      overriden:=search_class_member(aktclass,propname);
-                     if assigned(overriden) and (overriden^.typ=propertysym) then
+                     if assigned(overriden) and (overriden.typ=propertysym) then
                        begin
-                         p^.dooverride(ppropertysym(overriden));
+                         p.dooverride(tpropertysym(overriden));
                        end
                      else
                        begin
-                         p^.proptype:=generrortype;
+                         p.proptype:=generrortype;
                          message(parser_e_no_property_found_to_override);
                        end;
                   end;
                 if (sp_published in current_object_option) and
-                   not(p^.proptype.def^.is_publishable) then
+                   not(p.proptype.def.is_publishable) then
                   Message(parser_e_cant_publish_that_property);
 
                 { create data defcoll to allow correct parameter checks }
                 datacoll:=TParaItem.Create;
                 datacoll.paratyp:=vs_value;
-                datacoll.paratype:=p^.proptype;
+                datacoll.paratype:=p.proptype;
 
                 if (idtoken=_READ) then
                   begin
-                     p^.readaccess^.clear;
+                     p.readaccess.clear;
                      consume(_READ);
                      sym:=search_class_member(aktclass,pattern);
                      if not(assigned(sym)) then
@@ -277,12 +274,12 @@ implementation
                        begin
                           consume(_ID);
                           while (token=_POINT) and
-                                ((sym^.typ=varsym) and
-                                 (pvarsym(sym)^.vartype.def^.deftype=recorddef)) do
+                                ((sym.typ=varsym) and
+                                 (tvarsym(sym).vartype.def.deftype=recorddef)) do
                            begin
-                             p^.readaccess^.addsym(sym);
+                             p.readaccess.addsym(sym);
                              consume(_POINT);
-                             sym:=searchsymonlyin(precorddef(pvarsym(sym)^.vartype.def)^.symtable,pattern);
+                             sym:=searchsymonlyin(trecorddef(tvarsym(sym).vartype.def).symtable,pattern);
                              if not assigned(sym) then
                                Message1(sym_e_illegal_field,pattern);
                              consume(_ID);
@@ -292,30 +289,30 @@ implementation
                      if assigned(sym) then
                        begin
                           { search the matching definition }
-                          case sym^.typ of
+                          case sym.typ of
                             procsym :
                               begin
                                  pp:=get_procdef;
                                  if not(assigned(pp)) or
-                                    not(is_equal(pp^.rettype.def,p^.proptype.def)) then
+                                    not(is_equal(pp.rettype.def,p.proptype.def)) then
                                    Message(parser_e_ill_property_access_sym);
-                                 p^.readaccess^.setdef(pp);
+                                 p.readaccess.setdef(pp);
                               end;
                             varsym :
                               begin
                                 if not(propertyparas.empty) or
-                                   not(is_equal(pvarsym(sym)^.vartype.def,p^.proptype.def)) then
+                                   not(is_equal(tvarsym(sym).vartype.def,p.proptype.def)) then
                                   Message(parser_e_ill_property_access_sym);
                               end;
                             else
                               Message(parser_e_ill_property_access_sym);
                           end;
-                          p^.readaccess^.addsym(sym);
+                          p.readaccess.addsym(sym);
                        end;
                   end;
                 if (idtoken=_WRITE) then
                   begin
-                     p^.writeaccess^.clear;
+                     p.writeaccess.clear;
                      consume(_WRITE);
                      sym:=search_class_member(aktclass,pattern);
                      if not(assigned(sym)) then
@@ -327,12 +324,12 @@ implementation
                        begin
                           consume(_ID);
                           while (token=_POINT) and
-                                ((sym^.typ=varsym) and
-                                 (pvarsym(sym)^.vartype.def^.deftype=recorddef)) do
+                                ((sym.typ=varsym) and
+                                 (tvarsym(sym).vartype.def.deftype=recorddef)) do
                            begin
-                             p^.writeaccess^.addsym(sym);
+                             p.writeaccess.addsym(sym);
                              consume(_POINT);
-                             sym:=searchsymonlyin(precorddef(pvarsym(sym)^.vartype.def)^.symtable,pattern);
+                             sym:=searchsymonlyin(trecorddef(tvarsym(sym).vartype.def).symtable,pattern);
                              if not assigned(sym) then
                                Message1(sym_e_illegal_field,pattern);
                              consume(_ID);
@@ -342,7 +339,7 @@ implementation
                      if assigned(sym) then
                        begin
                           { search the matching definition }
-                          case sym^.typ of
+                          case sym.typ of
                             procsym :
                               begin
                                  { insert data entry to check access method }
@@ -352,25 +349,25 @@ implementation
                                  propertyparas.remove(datacoll);
                                  if not(assigned(pp)) then
                                    Message(parser_e_ill_property_access_sym);
-                                 p^.writeaccess^.setdef(pp);
+                                 p.writeaccess.setdef(pp);
                               end;
                             varsym :
                               begin
                                  if not(propertyparas.empty) or
-                                    not(is_equal(pvarsym(sym)^.vartype.def,p^.proptype.def)) then
+                                    not(is_equal(tvarsym(sym).vartype.def,p.proptype.def)) then
                                    Message(parser_e_ill_property_access_sym);
                               end
                             else
                               Message(parser_e_ill_property_access_sym);
                           end;
-                          p^.writeaccess^.addsym(sym);
+                          p.writeaccess.addsym(sym);
                        end;
                   end;
-                include(p^.propoptions,ppo_stored);
+                include(p.propoptions,ppo_stored);
                 if (idtoken=_STORED) then
                   begin
                      consume(_STORED);
-                     p^.storedaccess^.clear;
+                     p.storedaccess.clear;
                      case token of
                         _ID:
                            { in the case that idtoken=_DEFAULT }
@@ -389,12 +386,12 @@ implementation
                                   begin
                                      consume(_ID);
                                      while (token=_POINT) and
-                                           ((sym^.typ=varsym) and
-                                            (pvarsym(sym)^.vartype.def^.deftype=recorddef)) do
+                                           ((sym.typ=varsym) and
+                                            (tvarsym(sym).vartype.def.deftype=recorddef)) do
                                       begin
-                                        p^.storedaccess^.addsym(sym);
+                                        p.storedaccess.addsym(sym);
                                         consume(_POINT);
-                                        sym:=searchsymonlyin(precorddef(pvarsym(sym)^.vartype.def)^.symtable,pattern);
+                                        sym:=searchsymonlyin(trecorddef(tvarsym(sym).vartype.def).symtable,pattern);
                                         if not assigned(sym) then
                                           Message1(sym_e_illegal_field,pattern);
                                         consume(_ID);
@@ -404,39 +401,39 @@ implementation
                                 if assigned(sym) then
                                   begin
                                      { only non array properties can be stored }
-                                     case sym^.typ of
+                                     case sym.typ of
                                        procsym :
                                          begin
-                                           pp:=pprocsym(sym)^.definition;
+                                           pp:=tprocsym(sym).definition;
                                            while assigned(pp) do
                                              begin
                                                 { the stored function shouldn't have any parameters }
-                                                if pp^.Para.empty then
+                                                if pp.Para.empty then
                                                   break;
-                                                 pp:=pp^.nextoverloaded;
+                                                 pp:=pp.nextoverloaded;
                                              end;
                                            { found we a procedure and does it really return a bool? }
                                            if not(assigned(pp)) or
-                                              not(is_boolean(pp^.rettype.def)) then
+                                              not(is_boolean(pp.rettype.def)) then
                                              Message(parser_e_ill_property_storage_sym);
-                                           p^.storedaccess^.setdef(pp);
+                                           p.storedaccess.setdef(pp);
                                          end;
                                        varsym :
                                          begin
                                            if not(propertyparas.empty) or
-                                              not(is_boolean(pvarsym(sym)^.vartype.def)) then
+                                              not(is_boolean(tvarsym(sym).vartype.def)) then
                                              Message(parser_e_stored_property_must_be_boolean);
                                          end;
                                        else
                                          Message(parser_e_ill_property_storage_sym);
                                      end;
-                                     p^.storedaccess^.addsym(sym);
+                                     p.storedaccess.addsym(sym);
                                   end;
                              end;
                         _FALSE:
                           begin
                              consume(_FALSE);
-                             exclude(p^.propoptions,ppo_stored);
+                             exclude(p.propoptions,ppo_stored);
                           end;
                         _TRUE:
                           consume(_TRUE);
@@ -445,37 +442,37 @@ implementation
                 if (idtoken=_DEFAULT) then
                   begin
                      consume(_DEFAULT);
-                     if not(is_ordinal(p^.proptype.def) or
-                            is_64bitint(p^.proptype.def) or
-                            ((p^.proptype.def^.deftype=setdef) and
-                             (psetdef(p^.proptype.def)^.settype=smallset))) or
+                     if not(is_ordinal(p.proptype.def) or
+                            is_64bitint(p.proptype.def) or
+                            ((p.proptype.def.deftype=setdef) and
+                             (tsetdef(p.proptype.def).settype=smallset))) or
                         not(propertyparas.empty) then
                        Message(parser_e_property_cant_have_a_default_value);
                      { Get the result of the default, the firstpass is
                        needed to support values like -1 }
                      pt:=comp_expr(true);
-                     if (p^.proptype.def^.deftype=setdef) and
+                     if (p.proptype.def.deftype=setdef) and
                         (pt.nodetype=arrayconstructorn) then
                        begin
                          arrayconstructor_to_set(tarrayconstructornode(pt));
                          do_resulttypepass(pt);
                        end;
-                     inserttypeconv(pt,p^.proptype);
+                     inserttypeconv(pt,p.proptype);
                      if not(is_constnode(pt)) then
                        Message(parser_e_property_default_value_must_const);
 
                      if pt.nodetype=setconstn then
-                       p^.default:=plongint(tsetconstnode(pt).value_set)^
+                       p.default:=plongint(tsetconstnode(pt).value_set)^
                      else
-                       p^.default:=tordconstnode(pt).value;
+                       p.default:=tordconstnode(pt).value;
                      pt.free;
                   end
                 else if (idtoken=_NODEFAULT) then
                   begin
                      consume(_NODEFAULT);
-                     p^.default:=0;
+                     p.default:=0;
                   end;
-                symtablestack^.insert(p);
+                symtablestack.insert(p);
                 { default property ? }
                 consume(_SEMICOLON);
                 if (idtoken=_DEFAULT) then
@@ -485,11 +482,11 @@ implementation
                      p2:=search_default_property(aktclass);
                      if assigned(p2) then
                        message1(parser_e_only_one_default_property,
-                         pobjectdef(p2^.owner^.defowner)^.objname^)
+                         tobjectdef(p2.owner.defowner)^.objname^)
                      else
                      }
                        begin
-                          include(p^.propoptions,ppo_defaultproperty);
+                          include(p.propoptions,ppo_defaultproperty);
                           if propertyparas.empty then
                             message(parser_e_property_need_paras);
                        end;
@@ -514,27 +511,24 @@ implementation
            inc(lexlevel);
            parse_proc_head(potype_destructor);
            dec(lexlevel);
-           if (cs_constructor_name in aktglobalswitches) and (aktprocsym^.name<>'DONE') then
+           if (cs_constructor_name in aktglobalswitches) and (aktprocsym.name<>'DONE') then
             Message(parser_e_destructorname_must_be_done);
-           include(aktclass^.objectoptions,oo_has_destructor);
+           include(aktclass.objectoptions,oo_has_destructor);
            consume(_SEMICOLON);
-           if not(aktprocsym^.definition^.Para.empty) then
+           if not(aktprocsym.definition.Para.empty) then
              if not (m_tp in aktmodeswitches) then
                Message(parser_e_no_paras_for_destructor);
            { no return value }
-           aktprocsym^.definition^.rettype:=voidtype;
+           aktprocsym.definition.rettype:=voidtype;
         end;
 
       var
          hs      : string;
-         pcrd       : pclassrefdef;
+         pcrd       : tclassrefdef;
          tt     : ttype;
          oldprocinfo : pprocinfo;
-         oldprocsym : pprocsym;
+         oldprocsym : tprocsym;
          oldparse_only : boolean;
-         methodnametable,intmessagetable,
-         strmessagetable,classnamelabel,
-         fieldtablelabel : pasmlabel;
          storetypecanbeforward : boolean;
 
       procedure setclassattributes;
@@ -542,12 +536,12 @@ implementation
         begin
            if classtype=odt_class then
              begin
-                aktclass^.objecttype:=odt_class;
+                aktclass.objecttype:=odt_class;
                 if (cs_generate_rtti in aktlocalswitches) or
-                    (assigned(aktclass^.childof) and
-                     (oo_can_have_published in aktclass^.childof^.objectoptions)) then
+                    (assigned(aktclass.childof) and
+                     (oo_can_have_published in aktclass.childof.objectoptions)) then
                   begin
-                     include(aktclass^.objectoptions,oo_can_have_published);
+                     include(aktclass.objectoptions,oo_can_have_published);
                      { in "publishable" classes the default access type is published }
                      actmembertype:=[sp_published];
                      { don't know if this is necessary (FK) }
@@ -562,7 +556,7 @@ implementation
            if assigned(fd) then
              aktclass:=fd
            else
-             aktclass:=new(pobjectdef,init(classtype,n,nil));
+             aktclass:=tobjectdef.create(classtype,n,nil);
            { is the current class tobject?   }
            { so you could define your own tobject }
            if (cs_compilesystem in aktmoduleswitches) and (classtype=odt_class) and (upper(n)='TOBJECT') then
@@ -577,160 +571,30 @@ implementation
                   odt_interfacecom:
                     childof:=interface_iunknown;
                 end;
-                if (oo_is_forward in childof^.objectoptions) then
-                  Message1(parser_e_forward_declaration_must_be_resolved,childof^.objname^);
-                aktclass^.set_parent(childof);
+                if (oo_is_forward in childof.objectoptions) then
+                  Message1(parser_e_forward_declaration_must_be_resolved,childof.objname^);
+                aktclass.set_parent(childof);
              end;
          end;
 
-      { generates the vmt for classes as well as for objects }
-      procedure writevmt;
-
-        var
-           vmtlist : taasmoutput;
-{$ifdef WITHDMT}
-           dmtlabel : pasmlabel;
-{$endif WITHDMT}
-           interfacetable : pasmlabel;
-
-        begin
-{$ifdef WITHDMT}
-           dmtlabel:=gendmt(aktclass);
-{$endif WITHDMT}
-           { this generates the entries }
-           vmtlist:=TAasmoutput.Create;
-           genvmt(vmtlist,aktclass);
-
-           { write tables for classes, this must be done before the actual
-             class is written, because we need the labels defined }
-           if classtype=odt_class then
-            begin
-              methodnametable:=genpublishedmethodstable(aktclass);
-              fieldtablelabel:=aktclass^.generate_field_table;
-              { rtti }
-              if (oo_can_have_published in aktclass^.objectoptions) then
-               aktclass^.generate_rtti;
-              { write class name }
-              getdatalabel(classnamelabel);
-              dataSegment.concat(Tai_label.Create(classnamelabel));
-              dataSegment.concat(Tai_const.Create_8bit(length(aktclass^.objname^)));
-              dataSegment.concat(Tai_string.Create(aktclass^.objname^));
-              { generate message and dynamic tables }
-              if (oo_has_msgstr in aktclass^.objectoptions) then
-                strmessagetable:=genstrmsgtab(aktclass);
-              if (oo_has_msgint in aktclass^.objectoptions) then
-                intmessagetable:=genintmsgtab(aktclass)
-              else
-                dataSegment.concat(Tai_const.Create_32bit(0));
-              if aktclass^.implementedinterfaces^.count>0 then
-                interfacetable:=genintftable(aktclass);
-            end;
-
-          { write debug info }
-{$ifdef GDB}
-          if (cs_debuginfo in aktmoduleswitches) then
-           begin
-             do_count_dbx:=true;
-             if assigned(aktclass^.owner) and assigned(aktclass^.owner^.name) then
-               dataSegment.concat(Tai_stabs.Create(strpnew('"vmt_'+aktclass^.owner^.name^+n+':S'+
-                 typeglobalnumber('__vtbl_ptr_type')+'",'+tostr(N_STSYM)+',0,0,'+aktclass^.vmt_mangledname)));
-           end;
-{$endif GDB}
-           dataSegment.concat(Tai_symbol.Createdataname_global(aktclass^.vmt_mangledname,0));
-
-           { determine the size with symtable^.datasize, because }
-           { size gives back 4 for classes                    }
-           dataSegment.concat(Tai_const.Create_32bit(aktclass^.symtable^.datasize));
-           dataSegment.concat(Tai_const.Create_32bit(-aktclass^.symtable^.datasize));
-{$ifdef WITHDMT}
-           if classtype=ct_object then
-             begin
-                if assigned(dmtlabel) then
-                  dataSegment.concat(Tai_const_symbol.Create(dmtlabel)))
-                else
-                  dataSegment.concat(Tai_const.Create_32bit(0));
-             end;
-{$endif WITHDMT}
-           { write pointer to parent VMT, this isn't implemented in TP }
-           { but this is not used in FPC ? (PM) }
-           { it's not used yet, but the delphi-operators as and is need it (FK) }
-           { it is not written for parents that don't have any vmt !! }
-           if assigned(aktclass^.childof) and
-              (oo_has_vmt in aktclass^.childof^.objectoptions) then
-             dataSegment.concat(Tai_const_symbol.Createname(aktclass^.childof^.vmt_mangledname))
-           else
-             dataSegment.concat(Tai_const.Create_32bit(0));
-
-           { write extended info for classes, for the order see rtl/inc/objpash.inc }
-           if classtype=odt_class then
-            begin
-              { pointer to class name string }
-              dataSegment.concat(Tai_const_symbol.Create(classnamelabel));
-              { pointer to dynamic table }
-              if (oo_has_msgint in aktclass^.objectoptions) then
-                dataSegment.concat(Tai_const_symbol.Create(intmessagetable))
-              else
-                dataSegment.concat(Tai_const.Create_32bit(0));
-              { pointer to method table }
-              if assigned(methodnametable) then
-                dataSegment.concat(Tai_const_symbol.Create(methodnametable))
-              else
-                dataSegment.concat(Tai_const.Create_32bit(0));
-              { pointer to field table }
-              dataSegment.concat(Tai_const_symbol.Create(fieldtablelabel));
-              { pointer to type info of published section }
-              if (oo_can_have_published in aktclass^.objectoptions) then
-                dataSegment.concat(Tai_const_symbol.Createname(aktclass^.rtti_name))
-              else
-                dataSegment.concat(Tai_const.Create_32bit(0));
-              { inittable for con-/destruction }
-              {
-              if aktclass^.needs_inittable then
-              }
-              { we generate the init table for classes always, because needs_inittable }
-              { for classes is always false, it applies only for objects               }
-              dataSegment.concat(Tai_const_symbol.Create(aktclass^.get_inittable_label));
-              {
-              else
-                dataSegment.concat(Tai_const.Create_32bit(0));
-              }
-              { auto table }
-              dataSegment.concat(Tai_const.Create_32bit(0));
-              { interface table }
-              if aktclass^.implementedinterfaces^.count>0 then
-                dataSegment.concat(Tai_const_symbol.Create(interfacetable))
-              else
-                dataSegment.concat(Tai_const.Create_32bit(0));
-              { table for string messages }
-              if (oo_has_msgstr in aktclass^.objectoptions) then
-                dataSegment.concat(Tai_const_symbol.Create(strmessagetable))
-              else
-                dataSegment.concat(Tai_const.Create_32bit(0));
-            end;
-           dataSegment.concatlist(vmtlist);
-           vmtlist.free;
-           { write the size of the VMT }
-           dataSegment.concat(Tai_symbol_end.Createname(aktclass^.vmt_mangledname));
-        end;
-
       procedure setinterfacemethodoptions;
 
         var
           i: longint;
-          defs: pindexarray;
-          pd: pprocdef;
+          defs: TIndexArray;
+          pd: tprocdef;
         begin
-          include(aktclass^.objectoptions,oo_has_virtual);
-          defs:=aktclass^.symtable^.defindex;
-          for i:=1 to defs^.count do
+          include(aktclass.objectoptions,oo_has_virtual);
+          defs:=aktclass.symtable.defindex;
+          for i:=1 to defs.count do
             begin
-              pd:=pprocdef(defs^.search(i));
-              if pd^.deftype=procdef then
+              pd:=tprocdef(defs.search(i));
+              if pd.deftype=procdef then
                 begin
-                  pd^.extnumber:=aktclass^.lastvtableindex;
-                  inc(aktclass^.lastvtableindex);
-                  include(pd^.procoptions,po_virtualmethod);
-                  pd^.forwarddef:=false;
+                  pd.extnumber:=aktclass.lastvtableindex;
+                  inc(aktclass.lastvtableindex);
+                  include(pd.procoptions,po_virtualmethod);
+                  pd.forwarddef:=false;
                 end;
             end;
         end;
@@ -764,11 +628,11 @@ implementation
                        { also anonym objects aren't allow (o : object a : longint; end;) }
                        if n='' then
                          Message(parser_f_no_anonym_objects);
-                       aktclass:=new(pobjectdef,init(classtype,n,nil));
+                       aktclass:=tobjectdef.create(classtype,n,nil);
                        if (cs_compilesystem in aktmoduleswitches) and
                           (classtype=odt_interfacecom) and (upper(n)='IUNKNOWN') then
                          interface_iunknown:=aktclass;
-                       include(aktclass^.objectoptions,oo_is_forward);
+                       include(aktclass.objectoptions,oo_is_forward);
                        object_dec:=aktclass;
                        typecanbeforward:=storetypecanbeforward;
                        readobjecttype:=false;
@@ -787,16 +651,16 @@ implementation
                         single_type(tt,hs,typecanbeforward);
 
                         { accept hp1, if is a forward def or a class }
-                        if (tt.def^.deftype=forwarddef) or
+                        if (tt.def.deftype=forwarddef) or
                            is_class(tt.def) then
                           begin
-                             pcrd:=new(pclassrefdef,init(tt));
+                             pcrd:=tclassrefdef.create(tt);
                              object_dec:=pcrd;
                           end
                         else
                           begin
                              object_dec:=generrortype.def;
-                             Message1(type_e_class_type_expected,generrortype.def^.typename);
+                             Message1(type_e_class_type_expected,generrortype.def.typename);
                           end;
                         typecanbeforward:=storetypecanbeforward;
                         readobjecttype:=false;
@@ -808,14 +672,14 @@ implementation
                         { also anonym objects aren't allow (o : object a : longint; end;) }
                         if n='' then
                           Message(parser_f_no_anonym_objects);
-                        aktclass:=new(pobjectdef,init(odt_class,n,nil));
+                        aktclass:=tobjectdef.create(odt_class,n,nil);
                         if (cs_compilesystem in aktmoduleswitches) and (upper(n)='TOBJECT') then
                           class_tobject:=aktclass;
-                        aktclass^.objecttype:=odt_class;
-                        include(aktclass^.objectoptions,oo_is_forward);
+                        aktclass.objecttype:=odt_class;
+                        include(aktclass.objectoptions,oo_is_forward);
                         { all classes must have a vmt !!  at offset zero }
-                        if not(oo_has_vmt in aktclass^.objectoptions) then
-                          aktclass^.insertvmt;
+                        if not(oo_has_vmt in aktclass.objectoptions) then
+                          aktclass.insertvmt;
 
                         object_dec:=aktclass;
                         typecanbeforward:=storetypecanbeforward;
@@ -833,24 +697,24 @@ implementation
 
       procedure readimplementedinterfaces;
         var
-          implintf: pobjectdef;
+          implintf: tobjectdef;
           tt      : ttype;
         begin
           while try_to_consume(_COMMA) do begin
             id_type(tt,pattern,false);
-            implintf:=pobjectdef(tt.def);
-            if (tt.def^.deftype<>objectdef) then begin
-              Message1(type_e_interface_type_expected,tt.def^.typename);
+            implintf:=tobjectdef(tt.def);
+            if (tt.def.deftype<>objectdef) then begin
+              Message1(type_e_interface_type_expected,tt.def.typename);
               Continue; { omit }
             end;
             if not is_interface(implintf) then begin
-              Message1(type_e_interface_type_expected,implintf^.typename);
+              Message1(type_e_interface_type_expected,implintf.typename);
               Continue; { omit }
             end;
-            if aktclass^.implementedinterfaces^.searchintf(tt.def)<>-1 then
-              Message1(sym_e_duplicate_id,tt.def^.name)
+            if aktclass.implementedinterfaces.searchintf(tt.def)<>-1 then
+              Message1(sym_e_duplicate_id,tt.def.name)
             else
-              aktclass^.implementedinterfaces^.addintf(tt.def);
+              aktclass.implementedinterfaces.addintf(tt.def);
           end;
         end;
 
@@ -861,10 +725,10 @@ implementation
           p:=comp_expr(true);
           if p.nodetype=stringconstn then
             begin
-              aktclass^.iidstr:=stringdup(strpas(tstringconstnode(p).value_str)); { or upper? }
+              aktclass.iidstr:=stringdup(strpas(tstringconstnode(p).value_str)); { or upper? }
               p.free;
-              aktclass^.isiidguidvalid:=string2guid(aktclass^.iidstr^,aktclass^.iidguid);
-              if (classtype=odt_interfacecom) and not aktclass^.isiidguidvalid then
+              aktclass.isiidguidvalid:=string2guid(aktclass.iidstr^,aktclass.iidguid);
+              if (classtype=odt_interfacecom) and not aktclass.isiidguidvalid then
                 Message(parser_e_improper_guid_syntax);
             end
           else
@@ -882,14 +746,14 @@ implementation
              begin
                 consume(_LKLAMMER);
                 id_type(tt,pattern,false);
-                childof:=pobjectdef(tt.def);
+                childof:=tobjectdef(tt.def);
                 if (not assigned(childof)) or
-                   (childof^.deftype<>objectdef) then
+                   (childof.deftype<>objectdef) then
                  begin
                    if assigned(childof) then
-                    Message1(type_e_class_type_expected,childof^.typename);
+                    Message1(type_e_class_type_expected,childof.typename);
                    childof:=nil;
-                   aktclass:=new(pobjectdef,init(classtype,n,nil));
+                   aktclass:=tobjectdef.create(classtype,n,nil);
                  end
                 else
                  begin
@@ -915,18 +779,18 @@ implementation
                      correct field addresses }
                    if assigned(fd) then
                     begin
-                      if (oo_is_forward in childof^.objectoptions) then
-                       Message1(parser_e_forward_declaration_must_be_resolved,childof^.objname^);
+                      if (oo_is_forward in childof.objectoptions) then
+                       Message1(parser_e_forward_declaration_must_be_resolved,childof.objname^);
                       aktclass:=fd;
                       { we must inherit several options !!
                         this was missing !!
                         all is now done in set_parent
                         including symtable datasize setting PM }
-                      fd^.set_parent(childof);
+                      fd.set_parent(childof);
                     end
                    else
-                    aktclass:=new(pobjectdef,init(classtype,n,childof));
-                   if aktclass^.objecttype=odt_class then
+                    aktclass:=tobjectdef.create(classtype,n,childof);
+                   if aktclass.objecttype=odt_class then
                     readimplementedinterfaces;
                  end;
                 consume(_RKLAMMER);
@@ -935,7 +799,7 @@ implementation
            else if classtype in [odt_class,odt_interfacecom] then
              setclassparent
            else
-             aktclass:=new(pobjectdef,init(classtype,n,nil));
+             aktclass:=tobjectdef.create(classtype,n,nil);
            { read GUID }
              if (classtype in [odt_interfacecom,odt_interfacecorba]) and
                 try_to_consume(_LECKKLAMMER) then
@@ -950,28 +814,28 @@ implementation
         begin
            if is_cppclass(aktclass) then
              begin
-                include(aktprocsym^.definition^.proccalloptions,pocall_cppdecl);
-                aktprocsym^.definition^.setmangledname(
-                  target_os.Cprefix+aktprocsym^.definition^.cplusplusmangledname);
+                include(aktprocsym.definition.proccalloptions,pocall_cppdecl);
+                aktprocsym.definition.setmangledname(
+                  target_os.Cprefix+aktprocsym.definition.cplusplusmangledname);
              end;
         end;
 
       var
-        temppd : pprocdef;
+        temppd : tprocdef;
+        ch : tclassheader;
       begin
          {Nowadays aktprocsym may already have a value, so we need to save
           it.}
          oldprocsym:=aktprocsym;
          { forward is resolved }
          if assigned(fd) then
-           exclude(fd^.objectoptions,oo_is_forward);
+           exclude(fd.objectoptions,oo_is_forward);
 
          there_is_a_destructor:=false;
          actmembertype:=[sp_public];
 
          { objects and class types can't be declared local }
-         if (symtablestack^.symtabletype<>globalsymtable) and
-           (symtablestack^.symtabletype<>staticsymtable) then
+         if not(symtablestack.symtabletype in [globalsymtable,staticsymtable]) then
            Message(parser_e_no_local_objects);
 
          storetypecanbeforward:=typecanbeforward;
@@ -996,8 +860,8 @@ implementation
          setclassattributes;
 
          aktobjectdef:=aktclass;
-         aktclass^.symtable^.next:=symtablestack;
-         symtablestack:=aktclass^.symtable;
+         aktclass.symtable.next:=symtablestack;
+         symtablestack:=aktclass.symtable;
          testcurobject:=1;
          curobjectname:=Upper(n);
 
@@ -1013,9 +877,9 @@ implementation
           { Parse componenten }
             repeat
               if (sp_private in actmembertype) then
-                include(aktclass^.objectoptions,oo_has_private);
+                include(aktclass.objectoptions,oo_has_private);
               if (sp_protected in actmembertype) then
-                include(aktclass^.objectoptions,oo_has_protected);
+                include(aktclass.objectoptions,oo_has_protected);
               case token of
               _ID : begin
                       case idtoken of
@@ -1044,7 +908,7 @@ implementation
                                     if is_interface(aktclass) then
                                       Message(parser_e_no_access_specifier_in_interfaces)
                                     else
-                                      if not(oo_can_have_published in aktclass^.objectoptions) then
+                                      if not(oo_can_have_published in aktclass.objectoptions) then
                                         Message(parser_e_cant_have_published);
                                     consume(_PUBLISHED);
                                     current_object_option:=[sp_published];
@@ -1068,14 +932,14 @@ implementation
 {$endif newcg}
                       { check if there are duplicates }
                       check_identical_proc(temppd);
-                      if (po_msgint in aktprocsym^.definition^.procoptions) then
-                        include(aktclass^.objectoptions,oo_has_msgint);
+                      if (po_msgint in aktprocsym.definition.procoptions) then
+                        include(aktclass.objectoptions,oo_has_msgint);
 
-                      if (po_msgstr in aktprocsym^.definition^.procoptions) then
-                        include(aktclass^.objectoptions,oo_has_msgstr);
+                      if (po_msgstr in aktprocsym.definition.procoptions) then
+                        include(aktclass.objectoptions,oo_has_msgstr);
 
-                      if (po_virtualmethod in aktprocsym^.definition^.procoptions) then
-                        include(aktclass^.objectoptions,oo_has_virtual);
+                      if (po_virtualmethod in aktprocsym.definition.procoptions) then
+                        include(aktclass.objectoptions,oo_has_virtual);
 
                       chkcpp;
 
@@ -1092,8 +956,8 @@ implementation
 {$ifndef newcg}
                       parse_object_proc_directives(aktprocsym);
 {$endif newcg}
-                      if (po_virtualmethod in aktprocsym^.definition^.procoptions) then
-                        include(aktclass^.objectoptions,oo_has_virtual);
+                      if (po_virtualmethod in aktprocsym.definition.procoptions) then
+                        include(aktclass.objectoptions,oo_has_virtual);
 
                       chkcpp;
 
@@ -1113,8 +977,8 @@ implementation
 {$ifndef newcg}
                       parse_object_proc_directives(aktprocsym);
 {$endif newcg}
-                      if (po_virtualmethod in aktprocsym^.definition^.procoptions) then
-                        include(aktclass^.objectoptions,oo_has_virtual);
+                      if (po_virtualmethod in aktprocsym.definition.procoptions) then
+                        include(aktclass.objectoptions,oo_has_virtual);
 
                       chkcpp;
 
@@ -1135,25 +999,26 @@ implementation
          typecanbeforward:=storetypecanbeforward;
 
          { generate vmt space if needed }
-         if not(oo_has_vmt in aktclass^.objectoptions) and
-            (([oo_has_virtual,oo_has_constructor,oo_has_destructor]*aktclass^.objectoptions<>[]) or
+         if not(oo_has_vmt in aktclass.objectoptions) and
+            (([oo_has_virtual,oo_has_constructor,oo_has_destructor]*aktclass.objectoptions<>[]) or
              (classtype in [odt_class])
             ) then
-           aktclass^.insertvmt;
+           aktclass.insertvmt;
          if (cs_create_smart in aktmoduleswitches) then
            dataSegment.concat(Tai_cut.Create);
 
+         ch:=tclassheader.create(aktclass);
          if is_interface(aktclass) then
-           writeinterfaceids(aktclass);
-
-         if (oo_has_vmt in aktclass^.objectoptions) then
-           writevmt;
+           ch.writeinterfaceids;
+         if (oo_has_vmt in aktclass.objectoptions) then
+           ch.writevmt;
+         ch.free;
 
          if is_interface(aktclass) then
            setinterfacemethodoptions;
 
          { restore old state }
-         symtablestack:=symtablestack^.next;
+         symtablestack:=symtablestack.next;
          aktobjectdef:=nil;
          {Restore procinfo}
          dispose(procinfo,done);
@@ -1167,7 +1032,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.20  2001-04-04 22:43:51  peter
+  Revision 1.21  2001-04-13 01:22:11  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.20  2001/04/04 22:43:51  peter
     * remove unnecessary calls to firstpass
 
   Revision 1.19  2001/04/04 21:30:43  florian

compiler/pdecsub.pas

@@ -27,7 +27,7 @@ unit pdecsub;
 interface
 
     uses
-      cobjects,tokens,symconst,symtype,symdef,symsym;
+      tokens,symconst,symtype,symdef,symsym;
 
     const
       pd_global    = $1;    { directive must be global }
@@ -40,16 +40,16 @@ interface
       pd_notobjintf= $80;   { directive can not be used interface declaration }
 
     function  is_proc_directive(tok:ttoken):boolean;
-    function  check_identical_proc(var p : pprocdef) : boolean;
+    function  check_identical_proc(var p : tprocdef) : boolean;
 
-    procedure parameter_dec(aktprocdef:pabstractprocdef);
+    procedure parameter_dec(aktprocdef:tabstractprocdef);
 
     procedure parse_proc_directives(var pdflags:word);
 
     procedure parse_proc_head(options:tproctypeoption);
     procedure parse_proc_dec;
-    procedure parse_var_proc_directives(var sym : psym);
-    procedure parse_object_proc_directives(var sym : pprocsym);
+    procedure parse_var_proc_directives(var sym : tsym);
+    procedure parse_object_proc_directives(var sym : tprocsym);
 
 
 implementation
@@ -61,7 +61,7 @@ implementation
        strings,
 {$endif delphi}
        { common }
-       cutils,
+       cutils,cclasses,
        { global }
        globtype,globals,verbose,
        systems,
@@ -70,7 +70,7 @@ implementation
        { symtable }
        symbase,symtable,types,
        { pass 1 }
-       node,pass_1,htypechk,
+       node,htypechk,
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
        { parser }
        fmodule,scanner,
@@ -86,7 +86,7 @@ implementation
        ;
 
 
-    procedure parameter_dec(aktprocdef:pabstractprocdef);
+    procedure parameter_dec(aktprocdef:tabstractprocdef);
       {
         handle_procvar needs the same changes
       }
@@ -99,18 +99,18 @@ implementation
         htype,
         tt      : ttype;
         hvs,
-        vs      : Pvarsym;
-        srsym   : psym;
+        vs      : tvarsym;
+        srsym   : tsym;
         hs1,hs2 : string;
         varspez : Tvarspez;
         inserthigh : boolean;
-        pdefaultvalue : pconstsym;
+        tdefaultvalue : tconstsym;
         defaultrequired : boolean;
       begin
         { reset }
         defaultrequired:=false;
         { parsing a proc or procvar ? }
-        is_procvar:=(aktprocdef^.deftype=procvardef);
+        is_procvar:=(aktprocdef.deftype=procvardef);
         consume(_LKLAMMER);
         { Delphi/Kylix supports nonsense like }
         { procedure p();                      }
@@ -130,7 +130,7 @@ implementation
           else
               varspez:=vs_value;
           inserthigh:=false;
-          pdefaultvalue:=nil;
+          tdefaultvalue:=nil;
           tt.reset;
           { self is only allowed in procvars and class methods }
           if (idtoken=_SELF) and
@@ -145,17 +145,17 @@ implementation
                  hs2:=hs2+tostr(length('self'))+'self';
 {$endif UseNiceNames}
                  htype.setdef(procinfo^._class);
-                 vs:=new(Pvarsym,init('@',htype));
-                 vs^.varspez:=vs_var;
+                 vs:=tvarsym.create('@',htype);
+                 vs.varspez:=vs_var;
                { insert the sym in the parasymtable }
-                 pprocdef(aktprocdef)^.parast^.insert(vs);
-                 include(aktprocdef^.procoptions,po_containsself);
-                 inc(procinfo^.selfpointer_offset,vs^.address);
+                 tprocdef(aktprocdef).parast.insert(vs);
+                 include(aktprocdef.procoptions,po_containsself);
+                 inc(procinfo^.selfpointer_offset,vs.address);
                end;
               consume(idtoken);
               consume(_COLON);
               single_type(tt,hs1,false);
-              aktprocdef^.concatpara(tt,vs_value,nil);
+              aktprocdef.concatpara(tt,vs_value,nil);
               { check the types for procedures only }
               if not is_procvar then
                CheckTypes(tt.def,procinfo^._class);
@@ -177,7 +177,7 @@ implementation
                      consume(_ARRAY);
                      consume(_OF);
                    { define range and type of range }
-                     tt.setdef(new(Parraydef,init(0,-1,s32bittype)));
+                     tt.setdef(tarraydef.create(0,-1,s32bittype));
                    { array of const ? }
                      if (token=_CONST) and (m_objpas in aktmodeswitches) then
                       begin
@@ -185,14 +185,14 @@ implementation
                         srsym:=searchsymonlyin(systemunit,'TVARREC');
                         if not assigned(srsym) then
                          InternalError(1234124);
-                        Parraydef(tt.def)^.elementtype:=ptypesym(srsym)^.restype;
-                        Parraydef(tt.def)^.IsArrayOfConst:=true;
+                        tarraydef(tt.def).elementtype:=ttypesym(srsym).restype;
+                        tarraydef(tt.def).IsArrayOfConst:=true;
                         hs1:='array_of_const';
                       end
                      else
                       begin
                         { define field type }
-                        single_type(parraydef(tt.def)^.elementtype,hs1,false);
+                        single_type(tarraydef(tt.def).elementtype,hs1,false);
                         hs1:='array_of_'+hs1;
                       end;
                      inserthigh:=true;
@@ -229,9 +229,9 @@ implementation
                             Comment(V_Error,'default value only allowed for one parameter');
                            sc.add(s,hpos);
                            { prefix 'def' to the parameter name }
-                           pdefaultvalue:=ReadConstant('$def'+Upper(s),hpos);
-                           if assigned(pdefaultvalue) then
-                            pprocdef(aktprocdef)^.parast^.insert(pdefaultvalue);
+                           tdefaultvalue:=ReadConstant('$def'+Upper(s),hpos);
+                           if assigned(tdefaultvalue) then
+                            tprocdef(aktprocdef).parast.insert(tdefaultvalue);
                            defaultrequired:=true;
                          end
                         else
@@ -252,12 +252,12 @@ implementation
                   tt:=cformaltype;
                 end;
                if not is_procvar then
-                hs2:=pprocdef(aktprocdef)^.mangledname;
+                hs2:=tprocdef(aktprocdef).mangledname;
                storetokenpos:=akttokenpos;
                while not sc.empty do
                 begin
                   s:=sc.get(akttokenpos);
-                  aktprocdef^.concatpara(tt,varspez,pdefaultvalue);
+                  aktprocdef.concatpara(tt,varspez,tdefaultvalue);
                   { For proc vars we only need the definitions }
                   if not is_procvar then
                    begin
@@ -266,32 +266,32 @@ implementation
 {$else UseNiceNames}
                      hs2:=hs2+tostr(length(hs1))+hs1;
 {$endif UseNiceNames}
-                     vs:=new(pvarsym,init(s,tt));
-                     vs^.varspez:=varspez;
+                     vs:=tvarsym.create(s,tt);
+                     vs.varspez:=varspez;
                    { we have to add this to avoid var param to be in registers !!!}
                    { I don't understand the comment above,                          }
                    { but I suppose the comment is wrong and                         }
                    { it means that the address of var parameters can be placed      }
                    { in a register (FK)                                             }
                      if (varspez in [vs_var,vs_const,vs_out]) and push_addr_param(tt.def) then
-                       include(vs^.varoptions,vo_regable);
+                       include(vs.varoptions,vo_regable);
 
                    { insert the sym in the parasymtable }
-                     pprocdef(aktprocdef)^.parast^.insert(vs);
+                     tprocdef(aktprocdef).parast.insert(vs);
 
                    { do we need a local copy? Then rename the varsym, do this after the
                      insert so the dup id checking is done correctly }
                      if (varspez=vs_value) and
                         push_addr_param(tt.def) and
                         not(is_open_array(tt.def) or is_array_of_const(tt.def)) then
-                       pprocdef(aktprocdef)^.parast^.rename(vs^.name,'val'+vs^.name);
+                       tprocdef(aktprocdef).parast.rename(vs.name,'val'+vs.name);
 
                    { also need to push a high value? }
                      if inserthigh then
                       begin
-                        hvs:=new(Pvarsym,init('$high'+Upper(s),s32bittype));
-                        hvs^.varspez:=vs_const;
-                        pprocdef(aktprocdef)^.parast^.insert(hvs);
+                        hvs:=tvarsym.create('$high'+Upper(s),s32bittype);
+                        hvs.varspez:=vs_const;
+                        tprocdef(aktprocdef).parast.insert(hvs);
                       end;
 
                    end;
@@ -305,7 +305,7 @@ implementation
             end;
           { set the new mangled name }
           if not is_procvar then
-            pprocdef(aktprocdef)^.setmangledname(hs2);
+            tprocdef(aktprocdef).setmangledname(hs2);
         until not try_to_consume(_SEMICOLON);
         dec(testcurobject);
         consume(_RKLAMMER);
@@ -316,12 +316,12 @@ implementation
 
 procedure parse_proc_head(options:tproctypeoption);
 var orgsp,sp:stringid;
-    pd:Pprocdef;
+    pd:tprocdef;
     paramoffset:longint;
-    sym:Psym;
+    sym:tsym;
     hs:string;
-    st : psymtable;
-    srsymtable : psymtable;
+    st : tsymtable;
+    srsymtable : tsymtable;
     overloaded_level:word;
     storepos,procstartfilepos : tfileposinfo;
     i: longint;
@@ -347,8 +347,8 @@ begin
     { examine interface map: function/procedure iname.functionname=locfuncname }
     if parse_only and
        assigned(procinfo^._class) and
-       assigned(procinfo^._class^.implementedinterfaces) and
-       (procinfo^._class^.implementedinterfaces^.count>0) and
+       assigned(procinfo^._class.implementedinterfaces) and
+       (procinfo^._class.implementedinterfaces.count>0) and
        try_to_consume(_POINT) then
       begin
          storepos:=akttokenpos;
@@ -362,10 +362,10 @@ begin
           end;
          akttokenpos:=storepos;
          { load proc name }
-         if sym^.typ=typesym then
-           i:=procinfo^._class^.implementedinterfaces^.searchintf(ptypesym(sym)^.restype.def);
+         if sym.typ=typesym then
+           i:=procinfo^._class.implementedinterfaces.searchintf(ttypesym(sym).restype.def);
          { qualifier is interface name? }
-         if (sym^.typ<>typesym) or (ptypesym(sym)^.restype.def^.deftype<>objectdef) or
+         if (sym.typ<>typesym) or (ttypesym(sym).restype.def.deftype<>objectdef) or
             (i=-1) then
            begin
               Message(parser_e_interface_id_expected);
@@ -373,14 +373,14 @@ begin
            end
          else
            begin
-              aktprocsym:=pprocsym(procinfo^._class^.implementedinterfaces^.interfaces(i)^.symtable^.search(sp));
+              aktprocsym:=tprocsym(procinfo^._class.implementedinterfaces.interfaces(i).symtable.search(sp));
               if not(assigned(aktprocsym)) then
                 Message(parser_e_methode_id_expected);
            end;
          consume(_ID);
          consume(_EQUAL);
          if (token=_ID) and assigned(aktprocsym) then
-           procinfo^._class^.implementedinterfaces^.addmappings(i,sp,pattern);
+           procinfo^._class.implementedinterfaces.addmappings(i,sp,pattern);
          consume(_ID);
          exit;
     end;
@@ -406,8 +406,8 @@ begin
      procstartfilepos:=akttokenpos;
      consume(_ID);
      { qualifier is class name ? }
-     if (sym^.typ<>typesym) or
-        (ptypesym(sym)^.restype.def^.deftype<>objectdef) then
+     if (sym.typ<>typesym) or
+        (ttypesym(sym).restype.def.deftype<>objectdef) then
        begin
           Message(parser_e_class_id_expected);
           aktprocsym:=nil;
@@ -415,9 +415,9 @@ begin
      else
        begin
           { used to allow private syms to be seen }
-          aktobjectdef:=pobjectdef(ptypesym(sym)^.restype.def);
-          procinfo^._class:=pobjectdef(ptypesym(sym)^.restype.def);
-          aktprocsym:=pprocsym(procinfo^._class^.symtable^.search(sp));
+          aktobjectdef:=tobjectdef(ttypesym(sym).restype.def);
+          procinfo^._class:=tobjectdef(ttypesym(sym).restype.def);
+          aktprocsym:=tprocsym(procinfo^._class.symtable.search(sp));
           {The procedure has been found. So it is
            a global one. Set the flags to mark this.}
           procinfo^.flags:=procinfo^.flags or pi_is_global;
@@ -435,7 +435,7 @@ begin
         Message(parser_e_constructors_always_objects);
 
      akttokenpos:=procstartfilepos;
-     aktprocsym:=pprocsym(symtablestack^.search(sp));
+     aktprocsym:=tprocsym(symtablestack.search(sp));
 
      if not(parse_only) then
        begin
@@ -447,14 +447,14 @@ begin
           We need to find out if the procedure is global. If it is
           global, it is in the global symtable.}
          if not assigned(aktprocsym) and
-            (symtablestack^.symtabletype=staticsymtable) then
+            (symtablestack.symtabletype=staticsymtable) then
           begin
             {Search the procedure in the global symtable.}
-            aktprocsym:=Pprocsym(search_a_symtable(sp,globalsymtable));
+            aktprocsym:=tprocsym(search_a_symtable(sp,globalsymtable));
             if assigned(aktprocsym) then
              begin
                {Check if it is a procedure.}
-               if aktprocsym^.typ<>procsym then
+               if aktprocsym.typ<>procsym then
                 DuplicateSym(aktprocsym);
                {The procedure has been found. So it is
                 a global one. Set the flags to mark this.}
@@ -469,7 +469,7 @@ begin
   if assigned(procinfo^._class) then
    begin
      if (pos('_$$_',procprefix)=0) then
-      hs:=procprefix+'_$$_'+upper(procinfo^._class^.objname^)+'_$$_'+sp
+      hs:=procprefix+'_$$_'+upper(procinfo^._class.objname^)+'_$$_'+sp
      else
       hs:=procprefix+'_$'+sp;
    end
@@ -484,7 +484,7 @@ begin
   if assigned(procinfo^._class) then
    begin
      if (pos('_5Class_',procprefix)=0) then
-      hs:=procprefix+'_5Class_'+procinfo^._class^.name^+'_'+tostr(length(sp))+sp
+      hs:=procprefix+'_5Class_'+procinfo^._class.name^+'_'+tostr(length(sp))+sp
      else
       hs:=procprefix+'_'+tostr(length(sp))+sp;
    end
@@ -501,15 +501,15 @@ begin
    begin
      { Check if overloaded is a procsym, we use a different error message
        for tp7 so it looks more compatible }
-     if aktprocsym^.typ<>procsym then
+     if aktprocsym.typ<>procsym then
       begin
         if (m_fpc in aktmodeswitches) then
-         Message1(parser_e_overloaded_no_procedure,aktprocsym^.realname)
+         Message1(parser_e_overloaded_no_procedure,aktprocsym.realname)
         else
          DuplicateSym(aktprocsym);
         { try to recover by creating a new aktprocsym }
         akttokenpos:=procstartfilepos;
-        aktprocsym:=new(pprocsym,init(orgsp));
+        aktprocsym:=tprocsym.create(orgsp);
       end;
    end
   else
@@ -521,30 +521,28 @@ begin
      if (options=potype_operator) then
        begin
           { create the procsym with saving the original case }
-          aktprocsym:=new(pprocsym,init('$'+sp));
+          aktprocsym:=tprocsym.create('$'+sp);
           { the only problem is that nextoverloaded might not be in a unit
             known for the unit itself }
           { not anymore PM }
           if assigned(overloaded_operators[optoken]) then
-            aktprocsym^.definition:=overloaded_operators[optoken]^.definition;
-{$ifndef DONOTCHAINOPERATORS}
+            aktprocsym.definition:=overloaded_operators[optoken].definition;
           overloaded_operators[optoken]:=aktprocsym;
-{$endif DONOTCHAINOPERATORS}
        end
       else
-       aktprocsym:=new(pprocsym,init(orgsp));
-     symtablestack^.insert(aktprocsym);
+       aktprocsym:=tprocsym.create(orgsp);
+     symtablestack.insert(aktprocsym);
    end;
 
   st:=symtablestack;
-  pd:=new(pprocdef,init);
-  pd^.symtablelevel:=symtablestack^.symtablelevel;
+  pd:=tprocdef.create;
+  pd.symtablelevel:=symtablestack.symtablelevel;
 
   if assigned(procinfo^._class) then
-    pd^._class := procinfo^._class;
+    pd._class := procinfo^._class;
 
   { set the options from the caller (podestructor or poconstructor) }
-  pd^.proctypeoption:=options;
+  pd.proctypeoption:=options;
 
   { calculate the offset of the parameters }
   paramoffset:=8;
@@ -556,12 +554,12 @@ begin
       inc(paramoffset,target_os.size_of_pointer);
       { this is needed to get correct framepointer push for local
         forward functions !! }
-      pd^.parast^.symtablelevel:=lexlevel;
+      pd.parast.symtablelevel:=lexlevel;
     end;
 
   if assigned (procinfo^._Class)  and
      is_object(procinfo^._Class) and
-     (pd^.proctypeoption in [potype_constructor,potype_destructor]) then
+     (pd.proctypeoption in [potype_constructor,potype_destructor]) then
     inc(paramoffset,target_os.size_of_pointer);
 
   { self pointer offset                       }
@@ -569,27 +567,27 @@ begin
   if assigned(procinfo^._class) and (lexlevel=normal_function_level) then
     begin
       procinfo^.selfpointer_offset:=paramoffset;
-      if assigned(aktprocsym^.definition) and
-         not(po_containsself in aktprocsym^.definition^.procoptions) then
+      if assigned(aktprocsym.definition) and
+         not(po_containsself in aktprocsym.definition.procoptions) then
         inc(paramoffset,target_os.size_of_pointer);
     end;
 
   { con/-destructor flag ? }
   if assigned (procinfo^._Class) and
      is_class(procinfo^._class) and
-     (pd^.proctypeoption in [potype_destructor,potype_constructor]) then
+     (pd.proctypeoption in [potype_destructor,potype_constructor]) then
     inc(paramoffset,target_os.size_of_pointer);
 
   procinfo^.para_offset:=paramoffset;
 
-  pd^.parast^.datasize:=0;
+  pd.parast.datasize:=0;
 
-  pd^.nextoverloaded:=aktprocsym^.definition;
-  aktprocsym^.definition:=pd;
+  pd.nextoverloaded:=aktprocsym.definition;
+  aktprocsym.definition:=pd;
   { this is probably obsolete now PM }
-  aktprocsym^.definition^.fileinfo:=procstartfilepos;
-  aktprocsym^.definition^.setmangledname(hs);
-  aktprocsym^.definition^.procsym:=aktprocsym;
+  aktprocsym.definition.fileinfo:=procstartfilepos;
+  aktprocsym.definition.setmangledname(hs);
+  aktprocsym.definition.procsym:=aktprocsym;
 
   if not parse_only then
     begin
@@ -597,12 +595,12 @@ begin
        { we need another procprefix !!! }
        { count, but only those in the same unit !!}
        while assigned(pd) and
-          (pd^.owner^.symtabletype in [globalsymtable,staticsymtable]) do
+          (pd.owner.symtabletype in [globalsymtable,staticsymtable]) do
          begin
             { only count already implemented functions }
-            if  not(pd^.forwarddef) then
+            if  not(pd.forwarddef) then
               inc(overloaded_level);
-            pd:=pd^.nextoverloaded;
+            pd:=pd.nextoverloaded;
          end;
        if overloaded_level>0 then
          procprefix:=hs+'$'+tostr(overloaded_level)+'$'
@@ -615,7 +613,7 @@ begin
     definitions of args defs in staticsymtable for
     implementation of a global method }
   if token=_LKLAMMER then
-    parameter_dec(aktprocsym^.definition);
+    parameter_dec(aktprocsym.definition);
 
   { so we only restore the symtable now }
   symtablestack:=st;
@@ -644,8 +642,8 @@ begin
                    parse_proc_head(potype_none);
                    if token<>_COLON then
                     begin
-                       if not(is_interface(aktprocsym^.definition^._class)) and
-                          not(aktprocsym^.definition^.forwarddef) or
+                       if not(is_interface(aktprocsym.definition._class)) and
+                          not(aktprocsym.definition.forwarddef) or
                          (m_repeat_forward in aktmodeswitches) then
                        begin
                          consume(_COLON);
@@ -656,15 +654,15 @@ begin
                     begin
                       consume(_COLON);
                       inc(testcurobject);
-                      single_type(aktprocsym^.definition^.rettype,hs,false);
-                      aktprocsym^.definition^.test_if_fpu_result;
+                      single_type(aktprocsym.definition.rettype,hs,false);
+                      aktprocsym.definition.test_if_fpu_result;
                       dec(testcurobject);
                     end;
                  end;
     _PROCEDURE : begin
                    consume(_PROCEDURE);
                    parse_proc_head(potype_none);
-                   aktprocsym^.definition^.rettype:=voidtype;
+                   aktprocsym.definition.rettype:=voidtype;
                  end;
   _CONSTRUCTOR : begin
                    consume(_CONSTRUCTOR);
@@ -673,18 +671,18 @@ begin
                       is_class(procinfo^._class) then
                     begin
                       { CLASS constructors return the created instance }
-                      aktprocsym^.definition^.rettype.setdef(procinfo^._class);
+                      aktprocsym.definition.rettype.setdef(procinfo^._class);
                     end
                    else
                     begin
                       { OBJECT constructors return a boolean }
-                      aktprocsym^.definition^.rettype:=booltype;
+                      aktprocsym.definition.rettype:=booltype;
                     end;
                  end;
    _DESTRUCTOR : begin
                    consume(_DESTRUCTOR);
                    parse_proc_head(potype_destructor);
-                   aktprocsym^.definition^.rettype:=voidtype;
+                   aktprocsym.definition.rettype:=voidtype;
                  end;
      _OPERATOR : begin
                    if lexlevel>normal_function_level then
@@ -706,48 +704,48 @@ begin
                    parse_proc_head(potype_operator);
                    if token<>_ID then
                      begin
-                        opsym:=nil;
+                        otsym:=nil;
                         if not(m_result in aktmodeswitches) then
                           consume(_ID);
                      end
                    else
                      begin
-                       opsym:=new(pvarsym,init(pattern,voidtype));
+                       otsym:=tvarsym.create(pattern,voidtype);
                        consume(_ID);
                      end;
                    if not try_to_consume(_COLON) then
                      begin
                        consume(_COLON);
-                       aktprocsym^.definition^.rettype:=generrortype;
+                       aktprocsym.definition.rettype:=generrortype;
                        consume_all_until(_SEMICOLON);
                      end
                    else
                     begin
-                      single_type(aktprocsym^.definition^.rettype,hs,false);
-                      aktprocsym^.definition^.test_if_fpu_result;
+                      single_type(aktprocsym.definition.rettype,hs,false);
+                      aktprocsym.definition.test_if_fpu_result;
                       if (optoken in [_EQUAL,_GT,_LT,_GTE,_LTE]) and
-                         ((aktprocsym^.definition^.rettype.def^.deftype<>
-                         orddef) or (porddef(aktprocsym^.definition^.
-                         rettype.def)^.typ<>bool8bit)) then
+                         ((aktprocsym.definition.rettype.def.deftype<>
+                         orddef) or (torddef(aktprocsym.definition.
+                         rettype.def).typ<>bool8bit)) then
                         Message(parser_e_comparative_operator_return_boolean);
-                       if assigned(opsym) then
-                         opsym^.vartype.def:=aktprocsym^.definition^.rettype.def;
+                       if assigned(otsym) then
+                         otsym.vartype.def:=aktprocsym.definition.rettype.def;
                        { We need to add the return type in the mangledname
                          to allow overloading with just different results !! (PM) }
-                       aktprocsym^.definition^.setmangledname(
-                         aktprocsym^.definition^.mangledname+'$$'+hs);
+                       aktprocsym.definition.setmangledname(
+                         aktprocsym.definition.mangledname+'$$'+hs);
                        if (optoken=_ASSIGNMENT) and
-                          is_equal(aktprocsym^.definition^.rettype.def,
-                             pvarsym(aktprocsym^.definition^.parast^.symindex^.first)^.vartype.def) then
+                          is_equal(aktprocsym.definition.rettype.def,
+                             tvarsym(aktprocsym.definition.parast.symindex.first).vartype.def) then
                          message(parser_e_no_such_assignment)
-                       else if not isoperatoracceptable(aktprocsym^.definition,optoken) then
+                       else if not isoperatoracceptable(aktprocsym.definition,optoken) then
                          Message(parser_e_overload_impossible);
                      end;
                  end;
   end;
   if isclassmethod and
      assigned(aktprocsym) then
-    include(aktprocsym^.definition^.procoptions,po_classmethod);
+    include(aktprocsym.definition.procoptions,po_classmethod);
   { support procedure proc;stdcall export; in Delphi mode only }
   if not((m_delphi in aktmodeswitches) and
      is_proc_directive(token)) then
@@ -779,10 +777,10 @@ begin
   { only os/2 needs this }
   if target_info.target=target_i386_os2 then
    begin
-     aktprocsym^.definition^.aliasnames.insert(aktprocsym^.realname);
+     aktprocsym.definition.aliasnames.insert(aktprocsym.realname);
      procinfo^.exported:=true;
      if cs_link_deffile in aktglobalswitches then
-       deffile.AddExport(aktprocsym^.definition^.mangledname);
+       deffile.AddExport(aktprocsym.definition.mangledname);
    end;
 end;
 
@@ -794,7 +792,7 @@ end;
 
 procedure pd_forward;
 begin
-  aktprocsym^.definition^.forwarddef:=true;
+  aktprocsym.definition.forwarddef:=true;
 end;
 
 procedure pd_stdcall;
@@ -808,24 +806,24 @@ end;
 procedure pd_alias;
 begin
   consume(_COLON);
-  aktprocsym^.definition^.aliasnames.insert(get_stringconst);
+  aktprocsym.definition.aliasnames.insert(get_stringconst);
 end;
 
 procedure pd_asmname;
 begin
-  aktprocsym^.definition^.setmangledname(target_os.Cprefix+pattern);
+  aktprocsym.definition.setmangledname(target_os.Cprefix+pattern);
   if token=_CCHAR then
     consume(_CCHAR)
   else
     consume(_CSTRING);
   { we don't need anything else }
-  aktprocsym^.definition^.forwarddef:=false;
+  aktprocsym.definition.forwarddef:=false;
 end;
 
 procedure pd_intern;
 begin
   consume(_COLON);
-  aktprocsym^.definition^.extnumber:=get_intconst;
+  aktprocsym.definition.extnumber:=get_intconst;
 end;
 
 procedure pd_interrupt;
@@ -840,17 +838,17 @@ end;
 
 procedure pd_system;
 begin
-  aktprocsym^.definition^.setmangledname(aktprocsym^.realname);
+  aktprocsym.definition.setmangledname(aktprocsym.realname);
 end;
 
 procedure pd_abstract;
 begin
-  if (po_virtualmethod in aktprocsym^.definition^.procoptions) then
-    include(aktprocsym^.definition^.procoptions,po_abstractmethod)
+  if (po_virtualmethod in aktprocsym.definition.procoptions) then
+    include(aktprocsym.definition.procoptions,po_abstractmethod)
   else
     Message(parser_e_only_virtual_methods_abstract);
   { the method is defined }
-  aktprocsym^.definition^.forwarddef:=false;
+  aktprocsym.definition.forwarddef:=false;
 end;
 
 procedure pd_virtual;
@@ -859,19 +857,19 @@ var
   pt : tnode;
 {$endif WITHDMT}
 begin
-  if (aktprocsym^.definition^.proctypeoption=potype_constructor) and
-     is_object(aktprocsym^.definition^._class) then
+  if (aktprocsym.definition.proctypeoption=potype_constructor) and
+     is_object(aktprocsym.definition._class) then
     Message(parser_e_constructor_cannot_be_not_virtual);
 {$ifdef WITHDMT}
-  if is_object(aktprocsym^.definition^._class) and
+  if is_object(aktprocsym.definition._class) and
     (token<>_SEMICOLON) then
     begin
        { any type of parameter is allowed here! }
        pt:=comp_expr(true);
        if is_constintnode(pt) then
          begin
-           include(aktprocsym^.definition^.procoptions,po_msgint);
-           aktprocsym^.definition^.messageinf.i:=pt^.value;
+           include(aktprocsym.definition.procoptions,po_msgint);
+           aktprocsym.definition.messageinf.i:=pt^.value;
          end
        else
          Message(parser_e_ill_msg_expr);
@@ -884,14 +882,14 @@ procedure pd_static;
 begin
   if (cs_static_keyword in aktmoduleswitches) then
     begin
-      include(aktprocsym^.symoptions,sp_static);
-      include(aktprocsym^.definition^.procoptions,po_staticmethod);
+      include(aktprocsym.symoptions,sp_static);
+      include(aktprocsym.definition.procoptions,po_staticmethod);
     end;
 end;
 
 procedure pd_override;
 begin
-  if not(is_class_or_interface(aktprocsym^.definition^._class)) then
+  if not(is_class_or_interface(aktprocsym.definition._class)) then
     Message(parser_e_no_object_override);
 end;
 
@@ -904,22 +902,22 @@ var
   pt : tnode;
 begin
   { check parameter type }
-  if not(po_containsself in aktprocsym^.definition^.procoptions) and
-     ((aktprocsym^.definition^.minparacount<>1) or
-      (aktprocsym^.definition^.maxparacount<>1) or
-      (TParaItem(aktprocsym^.definition^.Para.first).paratyp<>vs_var)) then
+  if not(po_containsself in aktprocsym.definition.procoptions) and
+     ((aktprocsym.definition.minparacount<>1) or
+      (aktprocsym.definition.maxparacount<>1) or
+      (TParaItem(aktprocsym.definition.Para.first).paratyp<>vs_var)) then
    Message(parser_e_ill_msg_param);
   pt:=comp_expr(true);
   if pt.nodetype=stringconstn then
     begin
-      include(aktprocsym^.definition^.procoptions,po_msgstr);
-      aktprocsym^.definition^.messageinf.str:=strnew(tstringconstnode(pt).value_str);
+      include(aktprocsym.definition.procoptions,po_msgstr);
+      aktprocsym.definition.messageinf.str:=strnew(tstringconstnode(pt).value_str);
     end
   else
    if is_constintnode(pt) then
     begin
-      include(aktprocsym^.definition^.procoptions,po_msgint);
-      aktprocsym^.definition^.messageinf.i:=tordconstnode(pt).value;
+      include(aktprocsym.definition.procoptions,po_msgint);
+      aktprocsym.definition.messageinf.i:=tordconstnode(pt).value;
     end
   else
     Message(parser_e_ill_msg_expr);
@@ -927,56 +925,56 @@ begin
 end;
 
 
-procedure resetvaluepara(p:pnamedindexobject);
+procedure resetvaluepara(p:tnamedindexitem);
 begin
-  if psym(p)^.typ=varsym then
-    with pvarsym(p)^ do
+  if tsym(p).typ=varsym then
+    with tvarsym(p) do
        if copy(name,1,3)='val' then
-          aktprocsym^.definition^.parast^.symsearch^.rename(name,copy(name,4,length(name)));
+          aktprocsym.definition.parast.symsearch.rename(name,copy(name,4,length(name)));
 end;
 
 
 procedure pd_cdecl;
 begin
-  if aktprocsym^.definition^.deftype<>procvardef then
-    aktprocsym^.definition^.setmangledname(target_os.Cprefix+aktprocsym^.realname);
+  if aktprocsym.definition.deftype<>procvardef then
+    aktprocsym.definition.setmangledname(target_os.Cprefix+aktprocsym.realname);
   { do not copy on local !! }
-  if (aktprocsym^.definition^.deftype=procdef) and
-     assigned(aktprocsym^.definition^.parast) then
-    aktprocsym^.definition^.parast^.foreach({$ifdef FPCPROCVAR}@{$endif}resetvaluepara);
+  if (aktprocsym.definition.deftype=procdef) and
+     assigned(aktprocsym.definition.parast) then
+    aktprocsym.definition.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}resetvaluepara);
 end;
 
 procedure pd_cppdecl;
 begin
-  if aktprocsym^.definition^.deftype<>procvardef then
-    aktprocsym^.definition^.setmangledname(
-      target_os.Cprefix+aktprocsym^.definition^.cplusplusmangledname);
+  if aktprocsym.definition.deftype<>procvardef then
+    aktprocsym.definition.setmangledname(
+      target_os.Cprefix+aktprocsym.definition.cplusplusmangledname);
   { do not copy on local !! }
-  if (aktprocsym^.definition^.deftype=procdef) and
-     assigned(aktprocsym^.definition^.parast) then
-    aktprocsym^.definition^.parast^.foreach({$ifdef FPCPROCVAR}@{$endif}resetvaluepara);
+  if (aktprocsym.definition.deftype=procdef) and
+     assigned(aktprocsym.definition.parast) then
+    aktprocsym.definition.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}resetvaluepara);
 end;
 
 
 procedure pd_pascal;
-var st,parast : psymtable;
-    lastps,ps : psym;
+var st,parast : tsymtable;
+    lastps,ps : tsym;
 begin
-   new(st,init(parasymtable));
-   parast:=aktprocsym^.definition^.parast;
+   st:=tparasymtable.create;
+   parast:=aktprocsym.definition.parast;
    lastps:=nil;
-   while assigned(parast^.symindex^.first) and (lastps<>psym(parast^.symindex^.first)) do
+   while assigned(parast.symindex.first) and (lastps<>tsym(parast.symindex.first)) do
      begin
-       ps:=psym(parast^.symindex^.first);
-       while assigned(ps^.indexnext) and (psym(ps^.indexnext)<>lastps) do
-         ps:=psym(ps^.indexnext);
-       ps^.owner:=st;
+       ps:=tsym(parast.symindex.first);
+       while assigned(ps.indexnext) and (tsym(ps.indexnext)<>lastps) do
+         ps:=tsym(ps.indexnext);
+       ps.owner:=st;
        { recalculate the corrected offset }
        { the really_insert_in_data procedure
          for parasymtable should only calculateoffset PM }
-       pstoredsym(ps)^.insert_in_data;
+       tstoredsym(ps).insert_in_data;
        { reset the owner correctly }
-       ps^.owner:=parast;
+       ps.owner:=parast;
        lastps:=ps;
      end;
 end;
@@ -996,8 +994,8 @@ end;
 
 procedure pd_syscall;
 begin
-  aktprocsym^.definition^.forwarddef:=false;
-  aktprocsym^.definition^.extnumber:=get_intconst;
+  aktprocsym.definition.forwarddef:=false;
+  aktprocsym.definition.extnumber:=get_intconst;
 end;
 
 
@@ -1015,7 +1013,7 @@ var
   import_name : string;
   import_nr   : word;
 begin
-  aktprocsym^.definition^.forwarddef:=false;
+  aktprocsym.definition.forwarddef:=false;
 { If the procedure should be imported from a DLL, a constant string follows.
   This isn't really correct, an contant string expression follows
   so we check if an semicolon follows, else a string constant have to
@@ -1037,12 +1035,12 @@ begin
          import_nr:=get_intconst;
        end;
       if (import_nr=0) and (import_name='') then
-        {if (aktprocsym^.definition^.options and pocdecl)<>0 then
-          import_name:=aktprocsym^.definition^.mangledname
+        {if (aktprocsym.definition.options and pocdecl)<>0 then
+          import_name:=aktprocsym.definition.mangledname
         else
           Message(parser_w_empty_import_name);}
         { this should work both for win32 and Linux !! PM }
-        import_name:=aktprocsym^.realname;
+        import_name:=aktprocsym.realname;
       if not(current_module.uses_imports) then
        begin
          current_module.uses_imports:=true;
@@ -1051,14 +1049,14 @@ begin
       if not(m_repeat_forward in aktmodeswitches) then
         begin
           { we can only have one overloaded here ! }
-          if assigned(aktprocsym^.definition^.nextoverloaded) then
-            importlib.importprocedure(aktprocsym^.definition^.nextoverloaded^.mangledname,
+          if assigned(aktprocsym.definition.nextoverloaded) then
+            importlib.importprocedure(aktprocsym.definition.nextoverloaded.mangledname,
               import_dll,import_nr,import_name)
           else
-            importlib.importprocedure(aktprocsym^.mangledname,import_dll,import_nr,import_name);
+            importlib.importprocedure(aktprocsym.mangledname,import_dll,import_nr,import_name);
         end
       else
-        importlib.importprocedure(aktprocsym^.mangledname,import_dll,import_nr,import_name);
+        importlib.importprocedure(aktprocsym.mangledname,import_dll,import_nr,import_name);
     end
   else
     begin
@@ -1066,18 +1064,18 @@ begin
        begin
          consume(_NAME);
          import_name:=get_stringconst;
-         aktprocsym^.definition^.setmangledname(import_name);
+         aktprocsym.definition.setmangledname(import_name);
          if target_info.DllScanSupported then
            current_module.externals.insert(tExternalsItem.create(import_name));
        end
       else
        begin
          { external shouldn't override the cdecl/system name }
-         if not (pocall_clearstack in aktprocsym^.definition^.proccalloptions) then
+         if not (pocall_clearstack in aktprocsym.definition.proccalloptions) then
           begin
-            aktprocsym^.definition^.setmangledname(aktprocsym^.realname);
+            aktprocsym.definition.setmangledname(aktprocsym.realname);
             if target_info.DllScanSupported then
-             current_module.externals.insert(tExternalsItem.create(aktprocsym^.realname));
+             current_module.externals.insert(tExternalsItem.create(aktprocsym.realname));
           end;
        end;
     end;
@@ -1400,493 +1398,456 @@ const
    );
 
 
-function is_proc_directive(tok:ttoken):boolean;
-var
-  i : longint;
-begin
-  is_proc_directive:=false;
-  for i:=1 to num_proc_directives do
-   if proc_direcdata[i].idtok=idtoken then
-    begin
-      is_proc_directive:=true;
-      exit;
-    end;
-end;
+    function is_proc_directive(tok:ttoken):boolean;
+      var
+        i : longint;
+      begin
+        is_proc_directive:=false;
+        for i:=1 to num_proc_directives do
+         if proc_direcdata[i].idtok=idtoken then
+          begin
+            is_proc_directive:=true;
+            exit;
+          end;
+      end;
 
 
-function parse_proc_direc(var pdflags:word):boolean;
-{
-  Parse the procedure directive, returns true if a correct directive is found
-}
-var
-  p     : longint;
-  found : boolean;
-  name  : string;
-begin
-  parse_proc_direc:=false;
-  name:=pattern;
-  found:=false;
-  for p:=1 to num_proc_directives do
-   if proc_direcdata[p].idtok=idtoken then
-    begin
-      found:=true;
-      break;
-    end;
+    function parse_proc_direc(var pdflags:word):boolean;
+      {
+        Parse the procedure directive, returns true if a correct directive is found
+      }
+      var
+        p     : longint;
+        found : boolean;
+        name  : string;
+      begin
+        parse_proc_direc:=false;
+        name:=pattern;
+        found:=false;
+        for p:=1 to num_proc_directives do
+         if proc_direcdata[p].idtok=idtoken then
+          begin
+            found:=true;
+            break;
+          end;
 
-{ Check if the procedure directive is known }
-  if not found then
-   begin
-      { parsing a procvar type the name can be any
-        next variable !! }
-      if (pdflags and (pd_procvar or pd_object))=0 then
-        Message1(parser_w_unknown_proc_directive_ignored,name);
-      exit;
-   end;
+      { Check if the procedure directive is known }
+        if not found then
+         begin
+            { parsing a procvar type the name can be any
+              next variable !! }
+            if (pdflags and (pd_procvar or pd_object))=0 then
+              Message1(parser_w_unknown_proc_directive_ignored,name);
+            exit;
+         end;
 
-  { static needs a special treatment }
-  if (idtoken=_STATIC) and not (cs_static_keyword in aktmoduleswitches) then
-    exit;
+        { static needs a special treatment }
+        if (idtoken=_STATIC) and not (cs_static_keyword in aktmoduleswitches) then
+          exit;
 
-{ Conflicts between directives ? }
-  if (aktprocsym^.definition^.proctypeoption in proc_direcdata[p].mutexclpotype) or
-     ((aktprocsym^.definition^.proccalloptions*proc_direcdata[p].mutexclpocall)<>[]) or
-     ((aktprocsym^.definition^.procoptions*proc_direcdata[p].mutexclpo)<>[]) then
-   begin
-     Message1(parser_e_proc_dir_conflict,name);
-     exit;
-   end;
+      { Conflicts between directives ? }
+        if (aktprocsym.definition.proctypeoption in proc_direcdata[p].mutexclpotype) or
+           ((aktprocsym.definition.proccalloptions*proc_direcdata[p].mutexclpocall)<>[]) or
+           ((aktprocsym.definition.procoptions*proc_direcdata[p].mutexclpo)<>[]) then
+         begin
+           Message1(parser_e_proc_dir_conflict,name);
+           exit;
+         end;
 
-{ Check if the directive is only for objects }
-  if ((proc_direcdata[p].pd_flags and pd_object)<>0) and
-     not assigned(aktprocsym^.definition^._class) then
-    begin
-      exit;
-    end;
-{ check if method and directive not for object public }
-  if ((proc_direcdata[p].pd_flags and pd_notobject)<>0) and
-     assigned(aktprocsym^.definition^._class) then
-    begin
-      exit;
-    end;
+      { Check if the directive is only for objects }
+        if ((proc_direcdata[p].pd_flags and pd_object)<>0) and
+           not assigned(aktprocsym.definition._class) then
+          begin
+            exit;
+          end;
+      { check if method and directive not for object public }
+        if ((proc_direcdata[p].pd_flags and pd_notobject)<>0) and
+           assigned(aktprocsym.definition._class) then
+          begin
+            exit;
+          end;
 
-{ check if method and directive not for interface }
-  if ((proc_direcdata[p].pd_flags and pd_notobjintf)<>0) and
-     is_interface(aktprocsym^.definition^._class) then
-    begin
-      exit;
-    end;
+      { check if method and directive not for interface }
+        if ((proc_direcdata[p].pd_flags and pd_notobjintf)<>0) and
+           is_interface(aktprocsym.definition._class) then
+          begin
+            exit;
+          end;
 
-{ consume directive, and turn flag on }
-  consume(token);
-  parse_proc_direc:=true;
+      { consume directive, and turn flag on }
+        consume(token);
+        parse_proc_direc:=true;
 
-{ Check the pd_flags if the directive should be allowed }
-  if ((pdflags and pd_interface)<>0) and
-     ((proc_direcdata[p].pd_flags and pd_interface)=0) then
-    begin
-      Message1(parser_e_proc_dir_not_allowed_in_interface,name);
-      exit;
-    end;
-  if ((pdflags and pd_implemen)<>0) and
-     ((proc_direcdata[p].pd_flags and pd_implemen)=0) then
-    begin
-      Message1(parser_e_proc_dir_not_allowed_in_implementation,name);
-      exit;
-    end;
-  if ((pdflags and pd_procvar)<>0) and
-     ((proc_direcdata[p].pd_flags and pd_procvar)=0) then
-    begin
-      Message1(parser_e_proc_dir_not_allowed_in_procvar,name);
-      exit;
-    end;
+      { Check the pd_flags if the directive should be allowed }
+        if ((pdflags and pd_interface)<>0) and
+           ((proc_direcdata[p].pd_flags and pd_interface)=0) then
+          begin
+            Message1(parser_e_proc_dir_not_allowed_in_interface,name);
+            exit;
+          end;
+        if ((pdflags and pd_implemen)<>0) and
+           ((proc_direcdata[p].pd_flags and pd_implemen)=0) then
+          begin
+            Message1(parser_e_proc_dir_not_allowed_in_implementation,name);
+            exit;
+          end;
+        if ((pdflags and pd_procvar)<>0) and
+           ((proc_direcdata[p].pd_flags and pd_procvar)=0) then
+          begin
+            Message1(parser_e_proc_dir_not_allowed_in_procvar,name);
+            exit;
+          end;
 
-{ Return the new pd_flags }
-  if (proc_direcdata[p].pd_flags and pd_body)=0 then
-    pdflags:=pdflags and (not pd_body);
-  if (proc_direcdata[p].pd_flags and pd_global)<>0 then
-    pdflags:=pdflags or pd_global;
+      { Return the new pd_flags }
+        if (proc_direcdata[p].pd_flags and pd_body)=0 then
+          pdflags:=pdflags and (not pd_body);
+        if (proc_direcdata[p].pd_flags and pd_global)<>0 then
+          pdflags:=pdflags or pd_global;
 
-{ Add the correct flag }
-  aktprocsym^.definition^.proccalloptions:=aktprocsym^.definition^.proccalloptions+proc_direcdata[p].pocall;
-  aktprocsym^.definition^.procoptions:=aktprocsym^.definition^.procoptions+proc_direcdata[p].pooption;
+      { Add the correct flag }
+        aktprocsym.definition.proccalloptions:=aktprocsym.definition.proccalloptions+proc_direcdata[p].pocall;
+        aktprocsym.definition.procoptions:=aktprocsym.definition.procoptions+proc_direcdata[p].pooption;
 
- { Adjust positions of args for cdecl or stdcall }
-   if (aktprocsym^.definition^.deftype=procdef) and
-      (([pocall_cdecl,pocall_cppdecl,pocall_stdcall]*aktprocsym^.definition^.proccalloptions)<>[]) then
-     pstoredsymtable(aktprocsym^.definition^.parast)^.set_alignment(target_os.size_of_longint);
+       { Adjust positions of args for cdecl or stdcall }
+         if (aktprocsym.definition.deftype=procdef) and
+            (([pocall_cdecl,pocall_cppdecl,pocall_stdcall]*aktprocsym.definition.proccalloptions)<>[]) then
+           tstoredsymtable(aktprocsym.definition.parast).set_alignment(target_os.size_of_longint);
 
-{ Call the handler }
-  if pointer({$ifndef FPCPROCVAR}@{$endif}proc_direcdata[p].handler)<>nil then
-    proc_direcdata[p].handler{$ifdef FPCPROCVAR}(){$endif};
-end;
+      { Call the handler }
+        if pointer({$ifndef FPCPROCVAR}@{$endif}proc_direcdata[p].handler)<>nil then
+          proc_direcdata[p].handler{$ifdef FPCPROCVAR}(){$endif};
+      end;
 
 
-procedure parse_proc_directives(var pdflags:word);
-{
-  Parse the procedure directives. It does not matter if procedure directives
-  are written using ;procdir; or ['procdir'] syntax.
-}
-var
-  res : boolean;
-begin
-  while token in [_ID,_LECKKLAMMER] do
-   begin
-     if try_to_consume(_LECKKLAMMER) then
-      begin
-        repeat
-          parse_proc_direc(pdflags);
-        until not try_to_consume(_COMMA);
-        consume(_RECKKLAMMER);
-        { we always expect at least '[];' }
-        res:=true;
-      end
-     else
-      res:=parse_proc_direc(pdflags);
-   { A procedure directive normally followed by a semicolon, but in
-     a const section we should stop when _EQUAL is found }
-     if res then
+    procedure parse_proc_directives(var pdflags:word);
+      {
+        Parse the procedure directives. It does not matter if procedure directives
+        are written using ;procdir; or ['procdir'] syntax.
+      }
+      var
+        res : boolean;
       begin
-        if (block_type=bt_const) and
-           (token=_EQUAL) then
-         break;
-        { support procedure proc;stdcall export; in Delphi mode only }
-        if not((m_delphi in aktmodeswitches) and
-               is_proc_directive(token)) then
-         consume(_SEMICOLON);
-      end
-     else
-      break;
-   end;
-end;
+        while token in [_ID,_LECKKLAMMER] do
+         begin
+           if try_to_consume(_LECKKLAMMER) then
+            begin
+              repeat
+                parse_proc_direc(pdflags);
+              until not try_to_consume(_COMMA);
+              consume(_RECKKLAMMER);
+              { we always expect at least '[];' }
+              res:=true;
+            end
+           else
+            res:=parse_proc_direc(pdflags);
+         { A procedure directive normally followed by a semicolon, but in
+           a const section we should stop when _EQUAL is found }
+           if res then
+            begin
+              if (block_type=bt_const) and
+                 (token=_EQUAL) then
+               break;
+              { support procedure proc;stdcall export; in Delphi mode only }
+              if not((m_delphi in aktmodeswitches) and
+                     is_proc_directive(token)) then
+               consume(_SEMICOLON);
+            end
+           else
+            break;
+         end;
+      end;
 
-procedure parse_var_proc_directives(var sym : psym);
-var
-  pdflags : word;
-  oldsym  : pprocsym;
-  pd      : pabstractprocdef;
-begin
-  oldsym:=aktprocsym;
-  pdflags:=pd_procvar;
-  { we create a temporary aktprocsym to read the directives }
-  aktprocsym:=new(pprocsym,init(sym^.name));
-  case sym^.typ of
-    varsym :
-      pd:=pabstractprocdef(pvarsym(sym)^.vartype.def);
-    typedconstsym :
-      pd:=pabstractprocdef(ptypedconstsym(sym)^.typedconsttype.def);
-    typesym :
-      pd:=pabstractprocdef(ptypesym(sym)^.restype.def);
-    else
-      internalerror(994932432);
-  end;
-  if pd^.deftype<>procvardef then
-   internalerror(994932433);
-  pabstractprocdef(aktprocsym^.definition):=pd;
-  { names should never be used anyway }
-  inc(lexlevel);
-  parse_proc_directives(pdflags);
-  dec(lexlevel);
-  aktprocsym^.definition:=nil;
-  dispose(aktprocsym,done);
-  aktprocsym:=oldsym;
-end;
+
+    procedure parse_var_proc_directives(var sym : tsym);
+      var
+        pdflags : word;
+        oldsym  : tprocsym;
+        pd      : tabstractprocdef;
+      begin
+        oldsym:=aktprocsym;
+        pdflags:=pd_procvar;
+        { we create a temporary aktprocsym to read the directives }
+        aktprocsym:=tprocsym.create(sym.name);
+        case sym.typ of
+          varsym :
+            pd:=tabstractprocdef(tvarsym(sym).vartype.def);
+          typedconstsym :
+            pd:=tabstractprocdef(ttypedconstsym(sym).typedconsttype.def);
+          typesym :
+            pd:=tabstractprocdef(ttypesym(sym).restype.def);
+          else
+            internalerror(994932432);
+        end;
+        if pd.deftype<>procvardef then
+         internalerror(994932433);
+        tabstractprocdef(aktprocsym.definition):=pd;
+        { names should never be used anyway }
+        inc(lexlevel);
+        parse_proc_directives(pdflags);
+        dec(lexlevel);
+        aktprocsym.definition:=nil;
+        aktprocsym.free;
+        aktprocsym:=oldsym;
+      end;
 
 
-procedure parse_object_proc_directives(var sym : pprocsym);
-var
-  pdflags : word;
-begin
-  pdflags:=pd_object;
-  inc(lexlevel);
-  parse_proc_directives(pdflags);
-  dec(lexlevel);
-  if (po_containsself in aktprocsym^.definition^.procoptions) and
-     (([po_msgstr,po_msgint]*aktprocsym^.definition^.procoptions)=[]) then
-    Message(parser_e_self_in_non_message_handler);
-end;
+    procedure parse_object_proc_directives(var sym : tprocsym);
+      var
+        pdflags : word;
+      begin
+        pdflags:=pd_object;
+        inc(lexlevel);
+        parse_proc_directives(pdflags);
+        dec(lexlevel);
+        if (po_containsself in aktprocsym.definition.procoptions) and
+           (([po_msgstr,po_msgint]*aktprocsym.definition.procoptions)=[]) then
+          Message(parser_e_self_in_non_message_handler);
+      end;
 
-{***************************************************************************}
 
-function check_identical_proc(var p : pprocdef) : boolean;
-{
-  Search for idendical definitions,
-  if there is a forward, then kill this.
+    function check_identical_proc(var p : tprocdef) : boolean;
+      {
+        Search for idendical definitions,
+        if there is a forward, then kill this.
 
-  Returns the result of the forward check.
+        Returns the result of the forward check.
 
-  Removed from unter_dec to keep the source readable
-}
-var
-  hd,pd : Pprocdef;
-  storeparast : psymtable;
-  ad,fd : psym;
-  s : string;
-begin
-  check_identical_proc:=false;
-  p:=nil;
-  pd:=aktprocsym^.definition;
-  if assigned(pd) then
-   begin
-   { Is there an overload/forward ? }
-     if assigned(pd^.nextoverloaded) then
+        Removed from unter_dec to keep the source readable
+      }
+      var
+        hd,pd : tprocdef;
+        ad,fd : tsym;
       begin
-      { walk the procdef list }
-        while (assigned(pd)) and (assigned(pd^.nextoverloaded)) do
+        check_identical_proc:=false;
+        p:=nil;
+        pd:=aktprocsym.definition;
+        if assigned(pd) then
          begin
-           hd:=pd^.nextoverloaded;
-
-           { check the parameters }
-           if (not(m_repeat_forward in aktmodeswitches) and
-               (aktprocsym^.definition^.maxparacount=0)) or
-              (equal_paras(aktprocsym^.definition^.para,hd^.para,cp_none) and
-              { for operators equal_paras is not enough !! }
-              ((aktprocsym^.definition^.proctypeoption<>potype_operator) or (optoken<>_ASSIGNMENT) or
-               is_equal(hd^.rettype.def,aktprocsym^.definition^.rettype.def))) then
-             begin
-               if not equal_paras(aktprocsym^.definition^.para,hd^.para,cp_all) and
-                  ((m_repeat_forward in aktmodeswitches) or
-                   (aktprocsym^.definition^.maxparacount>0)) then
-                 begin
-                    MessagePos1(aktprocsym^.definition^.fileinfo,parser_e_header_dont_match_forward,
-                                aktprocsym^.definition^.fullprocname);
-                    exit;
-                 end;
-               if hd^.forwarddef then
-               { remove the forward definition  but don't delete it,      }
-               { the symtable is the owner !!  }
-                 begin
-                 { Check if the procedure type and return type are correct }
-                   if (hd^.proctypeoption<>aktprocsym^.definition^.proctypeoption) or
-                      (not(is_equal(hd^.rettype.def,aktprocsym^.definition^.rettype.def)) and
-                      (m_repeat_forward in aktmodeswitches)) then
-                     begin
-                       MessagePos1(aktprocsym^.definition^.fileinfo,parser_e_header_dont_match_forward,
-                                   aktprocsym^.definition^.fullprocname);
-                       exit;
-                     end;
-                   { Check calling convention, no check for internconst,internproc which
-                     are only defined in interface or implementation }
-                   if (hd^.proccalloptions-[pocall_internconst,pocall_internproc]<>
-                       aktprocsym^.definition^.proccalloptions-[pocall_internconst,pocall_internproc]) then
-                    begin
-                      { only trigger an error, becuase it doesn't hurt, for delphi check
-                        if the current implementation has no proccalloptions, then
-                        take the options from the interface }
-                      if (m_delphi in aktmodeswitches) then
-                       begin
-                         if (aktprocsym^.definition^.proccalloptions=[]) then
-                          aktprocsym^.definition^.proccalloptions:=hd^.proccalloptions
-                         else
-                          MessagePos(aktprocsym^.definition^.fileinfo,parser_e_call_convention_dont_match_forward);
-                       end
-                      else
-                       MessagePos(aktprocsym^.definition^.fileinfo,parser_e_call_convention_dont_match_forward);
-                      { set the mangledname to the interface name so it doesn't trigger
-                        the Note about different manglednames (PFV) }
-                      aktprocsym^.definition^.setmangledname(hd^.mangledname);
-                    end;
-                   { manglednames are equal? }
-                   hd^.count:=false;
-                   if (m_repeat_forward in aktmodeswitches) or
-                      aktprocsym^.definition^.haspara then
-                    begin
-                      if (hd^.mangledname<>aktprocsym^.definition^.mangledname) then
+         { Is there an overload/forward ? }
+           if assigned(pd.nextoverloaded) then
+            begin
+            { walk the procdef list }
+              while (assigned(pd)) and (assigned(pd.nextoverloaded)) do
+               begin
+                 hd:=pd.nextoverloaded;
+
+                 { check the parameters }
+                 if (not(m_repeat_forward in aktmodeswitches) and
+                     (aktprocsym.definition.maxparacount=0)) or
+                    (equal_paras(aktprocsym.definition.para,hd.para,cp_none) and
+                    { for operators equal_paras is not enough !! }
+                    ((aktprocsym.definition.proctypeoption<>potype_operator) or (optoken<>_ASSIGNMENT) or
+                     is_equal(hd.rettype.def,aktprocsym.definition.rettype.def))) then
+                   begin
+                     if not equal_paras(aktprocsym.definition.para,hd.para,cp_all) and
+                        ((m_repeat_forward in aktmodeswitches) or
+                         (aktprocsym.definition.maxparacount>0)) then
                        begin
-                         if not(po_external in aktprocsym^.definition^.procoptions) then
-                           MessagePos2(aktprocsym^.definition^.fileinfo,parser_n_interface_name_diff_implementation_name,hd^.mangledname,
-                             aktprocsym^.definition^.mangledname);
-                       { reset the mangledname of the interface part to be sure }
-                       { this is wrong because the mangled name might have been used already !! }
-                          if hd^.is_used then
-                            renameasmsymbol(hd^.mangledname,aktprocsym^.definition^.mangledname);
-                          hd^.setmangledname(aktprocsym^.definition^.mangledname);
-                       { so we need to keep the name of interface !!
-                         No!!!! The procedure directives can change the mangledname.
-                         I fixed this by first calling check_identical_proc and then doing
-                         the proc directives, but this is not a good solution.(DM)}
-                         { this is also wrong (PM)
-                         aktprocsym^.definition^.setmangledname(hd^.mangledname);}
-                       end
-                      else
+                          MessagePos1(aktprocsym.definition.fileinfo,parser_e_header_dont_match_forward,
+                                      aktprocsym.definition.fullprocname);
+                          exit;
+                       end;
+                     if hd.forwarddef then
+                     { remove the forward definition  but don't delete it,      }
+                     { the symtable is the owner !!  }
                        begin
-                       { If mangled names are equal, therefore    }
-                       { they have the same number of parameters  }
-                       { Therefore we can check the name of these }
-                       { parameters...                      }
-                         if hd^.forwarddef and aktprocsym^.definition^.forwarddef then
+                       { Check if the procedure type and return type are correct }
+                         if (hd.proctypeoption<>aktprocsym.definition.proctypeoption) or
+                            (not(is_equal(hd.rettype.def,aktprocsym.definition.rettype.def)) and
+                            (m_repeat_forward in aktmodeswitches)) then
                            begin
-                             MessagePos1(aktprocsym^.definition^.fileinfo,
-                                         parser_e_function_already_declared_public_forward,
-                                         aktprocsym^.definition^.fullprocname);
-                             check_identical_proc:=true;
-                           { Remove other forward from the list to reduce errors }
-                             pd^.nextoverloaded:=pd^.nextoverloaded^.nextoverloaded;
+                             MessagePos1(aktprocsym.definition.fileinfo,parser_e_header_dont_match_forward,
+                                         aktprocsym.definition.fullprocname);
                              exit;
                            end;
-                         ad:=psym(hd^.parast^.symindex^.first);
-                         fd:=psym(aktprocsym^.definition^.parast^.symindex^.first);
-                         if assigned(ad) and assigned(fd) then
-                           begin
-                             while assigned(ad) and assigned(fd) do
-                               begin
-                                 s:=ad^.name;
-                                 if s<>fd^.name then
+                         { Check calling convention, no check for internconst,internproc which
+                           are only defined in interface or implementation }
+                         if (hd.proccalloptions-[pocall_internconst,pocall_internproc]<>
+                             aktprocsym.definition.proccalloptions-[pocall_internconst,pocall_internproc]) then
+                          begin
+                            { only trigger an error, becuase it doesn't hurt, for delphi check
+                              if the current implementation has no proccalloptions, then
+                              take the options from the interface }
+                            if (m_delphi in aktmodeswitches) then
+                             begin
+                               if (aktprocsym.definition.proccalloptions=[]) then
+                                aktprocsym.definition.proccalloptions:=hd.proccalloptions
+                               else
+                                MessagePos(aktprocsym.definition.fileinfo,parser_e_call_convention_dont_match_forward);
+                             end
+                            else
+                             MessagePos(aktprocsym.definition.fileinfo,parser_e_call_convention_dont_match_forward);
+                            { set the mangledname to the interface name so it doesn't trigger
+                              the Note about different manglednames (PFV) }
+                            aktprocsym.definition.setmangledname(hd.mangledname);
+                          end;
+                         { manglednames are equal? }
+                         hd.count:=false;
+                         if (m_repeat_forward in aktmodeswitches) or
+                            aktprocsym.definition.haspara then
+                          begin
+                            if (hd.mangledname<>aktprocsym.definition.mangledname) then
+                             begin
+                               if not(po_external in aktprocsym.definition.procoptions) then
+                                 MessagePos2(aktprocsym.definition.fileinfo,parser_n_interface_name_diff_implementation_name,hd.mangledname,
+                                   aktprocsym.definition.mangledname);
+                             { reset the mangledname of the interface part to be sure }
+                             { this is wrong because the mangled name might have been used already !! }
+                                if hd.is_used then
+                                  renameasmsymbol(hd.mangledname,aktprocsym.definition.mangledname);
+                                hd.setmangledname(aktprocsym.definition.mangledname);
+                             end
+                            else
+                             begin
+                             { If mangled names are equal, therefore    }
+                             { they have the same number of parameters  }
+                             { Therefore we can check the name of these }
+                             { parameters...                      }
+                               if hd.forwarddef and aktprocsym.definition.forwarddef then
+                                 begin
+                                   MessagePos1(aktprocsym.definition.fileinfo,
+                                               parser_e_function_already_declared_public_forward,
+                                               aktprocsym.definition.fullprocname);
+                                   check_identical_proc:=true;
+                                 { Remove other forward from the list to reduce errors }
+                                   pd.nextoverloaded:=pd.nextoverloaded.nextoverloaded;
+                                   exit;
+                                 end;
+                               { both symtables are in the same order from left to right }
+                               ad:=tsym(hd.parast.symindex.first);
+                               fd:=tsym(aktprocsym.definition.parast.symindex.first);
+                               while assigned(ad) and assigned(fd) do
+                                begin
+                                  if ad.name<>fd.name then
                                    begin
-                                     MessagePos3(aktprocsym^.definition^.fileinfo,parser_e_header_different_var_names,
-                                       aktprocsym^.name,s,fd^.name);
+                                     MessagePos3(aktprocsym.definition.fileinfo,parser_e_header_different_var_names,
+                                                 aktprocsym.name,ad.name,fd.name);
                                      break;
                                    end;
-                               { it is impossible to have a nil pointer }
-                               { for only one parameter - since they    }
-                               { have the same number of parameters.    }
-                               { Left = next parameter.          }
-                                 ad:=psym(ad^.left);
-                                 fd:=psym(fd^.left);
-                               end;
-                           end;
-                       end;
-                    end;
-                 { also the para_offset }
-                   hd^.parast^.address_fixup:=aktprocsym^.definition^.parast^.address_fixup;
-                   hd^.count:=true;
-
-                 { remove pd^.nextoverloaded from the list }
-                 { and add aktprocsym^.definition }
-                   pd^.nextoverloaded:=pd^.nextoverloaded^.nextoverloaded;
-                   hd^.nextoverloaded:=aktprocsym^.definition^.nextoverloaded;
-                 { Alert! All fields of aktprocsym^.definition that are modified
-                   by the procdir handlers must be copied here!.}
-                   hd^.forwarddef:=false;
-                   hd^.hasforward:=true;
-                   hd^.proccalloptions:=hd^.proccalloptions + aktprocsym^.definition^.proccalloptions;
-                   hd^.procoptions:=hd^.procoptions + aktprocsym^.definition^.procoptions;
-                   if aktprocsym^.definition^.extnumber=-1 then
-                     aktprocsym^.definition^.extnumber:=hd^.extnumber
-                   else
-                     if hd^.extnumber=-1 then
-                       hd^.extnumber:=aktprocsym^.definition^.extnumber;
-                   { copy all aliasnames }
-                   while not aktprocsym^.definition^.aliasnames.empty do
-                    hd^.aliasnames.insert(aktprocsym^.definition^.aliasnames.getfirst);
-                   { switch parast for warning in implementation  PM }
-                   if (m_repeat_forward in aktmodeswitches) or
-                      aktprocsym^.definition^.haspara then
-                     begin
-                        storeparast:=hd^.parast;
-                        hd^.parast:=aktprocsym^.definition^.parast;
-                        aktprocsym^.definition^.parast:=storeparast;
-                     end;
-                   if pd=aktprocsym^.definition then
-                     p:=nil
-                   else
-                     p:=pd;
-                   aktprocsym^.definition:=hd;
-                   check_identical_proc:=true;
-                 end
-               else
-               { abstract methods aren't forward defined, but this }
-               { needs another error message                   }
-                 if not(po_abstractmethod in pd^.nextoverloaded^.procoptions) then
-                   MessagePos(aktprocsym^.definition^.fileinfo,parser_e_overloaded_have_same_parameters)
-                 else
-                   MessagePos(aktprocsym^.definition^.fileinfo,parser_e_abstract_no_definition);
-               break;
-             end;
+                                  ad:=tsym(ad.indexnext);
+                                  fd:=tsym(fd.indexnext);
+                                end;
+                             end;
+                          end;
+                       { also the para_offset }
+                         hd.parast.address_fixup:=aktprocsym.definition.parast.address_fixup;
+                         hd.count:=true;
+
+                       { remove pd.nextoverloaded from the list }
+                       { and add aktprocsym.definition }
+                         pd.nextoverloaded:=pd.nextoverloaded.nextoverloaded;
+                         hd.nextoverloaded:=aktprocsym.definition.nextoverloaded;
+                       { Alert! All fields of aktprocsym.definition that are modified
+                         by the procdir handlers must be copied here!.}
+                         hd.forwarddef:=false;
+                         hd.hasforward:=true;
+                         hd.proccalloptions:=hd.proccalloptions + aktprocsym.definition.proccalloptions;
+                         hd.procoptions:=hd.procoptions + aktprocsym.definition.procoptions;
+                         if aktprocsym.definition.extnumber=-1 then
+                           aktprocsym.definition.extnumber:=hd.extnumber
+                         else
+                           if hd.extnumber=-1 then
+                             hd.extnumber:=aktprocsym.definition.extnumber;
+                         { copy all aliasnames }
+                         while not aktprocsym.definition.aliasnames.empty do
+                          hd.aliasnames.insert(aktprocsym.definition.aliasnames.getfirst);
+                         { switch parast for warning in implementation  PM
+                           This can't be done, because the parasymtable is also
+                           stored in the ppu and loaded when only the interface
+                           units are loaded. Using the implementation parast can
+                           cause problems with redefined types in units only included
+                           in the implementation uses (PFV) }
+                         {if (m_repeat_forward in aktmodeswitches) or
+                            aktprocsym.definition.haspara then
+                           begin
+                              storeparast:=hd.parast;
+                              hd.parast:=aktprocsym.definition.parast;
+                              aktprocsym.definition.parast:=storeparast;
+                           end;}
+                         if pd=aktprocsym.definition then
+                           p:=nil
+                         else
+                           p:=pd;
+                         aktprocsym.definition:=hd;
+                         check_identical_proc:=true;
+                       end
+                     else
+                     { abstract methods aren't forward defined, but this }
+                     { needs another error message                   }
+                       if not(po_abstractmethod in pd.nextoverloaded.procoptions) then
+                         MessagePos(aktprocsym.definition.fileinfo,parser_e_overloaded_have_same_parameters)
+                       else
+                         MessagePos(aktprocsym.definition.fileinfo,parser_e_abstract_no_definition);
+                     break;
+                   end;
 
-           { check for allowing overload directive }
-           if not(m_fpc in aktmodeswitches) then
-            begin
-              { overload directive turns on overloading }
-              if ((po_overload in aktprocsym^.definition^.procoptions) or
-                  ((po_overload in hd^.procoptions))) then
-               begin
-                 { check if all procs have overloading, but not if the proc was
-                   already declared forward, then the check is already done }
-                 if not(hd^.hasforward) and
-                    (aktprocsym^.definition^.forwarddef=hd^.forwarddef) and
-                    not((po_overload in aktprocsym^.definition^.procoptions) and
-                        ((po_overload in hd^.procoptions))) then
+                 { check for allowing overload directive }
+                 if not(m_fpc in aktmodeswitches) then
                   begin
-                    MessagePos1(aktprocsym^.definition^.fileinfo,parser_e_no_overload_for_all_procs,aktprocsym^.realname);
-                    break;
-                  end;
-               end
-              else
-               begin
-                 if not(hd^.forwarddef) then
-                  begin
-                    MessagePos(aktprocsym^.definition^.fileinfo,parser_e_procedure_overloading_is_off);
-                    break;
+                    { overload directive turns on overloading }
+                    if ((po_overload in aktprocsym.definition.procoptions) or
+                        ((po_overload in hd.procoptions))) then
+                     begin
+                       { check if all procs have overloading, but not if the proc was
+                         already declared forward, then the check is already done }
+                       if not(hd.hasforward) and
+                          (aktprocsym.definition.forwarddef=hd.forwarddef) and
+                          not((po_overload in aktprocsym.definition.procoptions) and
+                              ((po_overload in hd.procoptions))) then
+                        begin
+                          MessagePos1(aktprocsym.definition.fileinfo,parser_e_no_overload_for_all_procs,aktprocsym.realname);
+                          break;
+                        end;
+                     end
+                    else
+                     begin
+                       if not(hd.forwarddef) then
+                        begin
+                          MessagePos(aktprocsym.definition.fileinfo,parser_e_procedure_overloading_is_off);
+                          break;
+                        end;
+                     end;
                   end;
+
+                 { try next overloaded }
+                 pd:=pd.nextoverloaded;
                end;
+            end
+           else
+            begin
+            { there is no overloaded, so its always identical with itself }
+              check_identical_proc:=true;
             end;
-
-           { try next overloaded }
-           pd:=pd^.nextoverloaded;
          end;
-      end
-     else
-      begin
-      { there is no overloaded, so its always identical with itself }
-        check_identical_proc:=true;
+      { insert otsym only in the right symtable }
+        if ((procinfo^.flags and pi_operator)<>0) and assigned(otsym)
+           and not parse_only then
+          begin
+            if ret_in_param(aktprocsym.definition.rettype.def) then
+              begin
+                tprocdef(aktprocsym.definition).parast.insert(otsym);
+              { this increases the data size }
+              { correct this to get the right ret $value }
+                dec(tprocdef(aktprocsym.definition).parast.datasize,otsym.getpushsize);
+                { this allows to read the funcretoffset }
+                otsym.address:=-4;
+                otsym.varspez:=vs_var;
+              end
+            else
+              tprocdef(aktprocsym.definition).localst.insert(otsym);
+          end;
       end;
-   end;
-{ insert opsym only in the right symtable }
-  if ((procinfo^.flags and pi_operator)<>0) and assigned(opsym)
-     and not parse_only then
-    begin
-      if ret_in_param(aktprocsym^.definition^.rettype.def) then
-        begin
-          pprocdef(aktprocsym^.definition)^.parast^.insert(opsym);
-        { this increases the data size }
-        { correct this to get the right ret $value }
-          dec(pprocdef(aktprocsym^.definition)^.parast^.datasize,opsym^.getpushsize);
-          { this allows to read the funcretoffset }
-          opsym^.address:=-4;
-          opsym^.varspez:=vs_var;
-        end
-      else
-        pprocdef(aktprocsym^.definition)^.localst^.insert(opsym);
-    end;
-end;
-
-
 
-procedure checkvaluepara(p:pnamedindexobject);
-var
-  vs : pvarsym;
-  s  : string;
-begin
-  with pvarsym(p)^ do
-   begin
-     if copy(name,1,3)='val' then
-      begin
-        s:=Copy(name,4,255);
-        if not(po_assembler in aktprocsym^.definition^.procoptions) then
-         begin
-           vs:=new(Pvarsym,init(s,vartype));
-           vs^.fileinfo:=fileinfo;
-           vs^.varspez:=varspez;
-           aktprocsym^.definition^.localst^.insert(vs);
-           include(vs^.varoptions,vo_is_local_copy);
-           vs^.varstate:=vs_assigned;
-           localvarsym:=vs;
-           inc(refs); { the para was used to set the local copy ! }
-           { warnings only on local copy ! }
-           varstate:=vs_used;
-         end
-        else
-         begin
-           aktprocsym^.definition^.parast^.rename(name,s);
-         end;
-      end;
-   end;
-end;
 
 end.
 {
   $Log$
-  Revision 1.17  2001-04-04 22:43:52  peter
+  Revision 1.18  2001-04-13 01:22:11  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.17  2001/04/04 22:43:52  peter
     * remove unnecessary calls to firstpass
 
   Revision 1.16  2001/04/02 21:20:33  peter

compiler/pdecvar.pas

@@ -34,14 +34,14 @@ implementation
 
     uses
        { common }
-       cutils,cobjects,
+       cutils,
        { global }
        globtype,globals,tokens,verbose,
        systems,
        { symtable }
        symconst,symbase,symtype,symdef,symsym,symtable,types,fmodule,
        { pass 1 }
-       node,pass_1,
+       node,
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
        { parser }
        scanner,
@@ -62,27 +62,27 @@ implementation
     { => the procedure is also used to read     }
     { a sequence of variable declaration        }
 
-      procedure insert_syms(st : psymtable;sc : tidstringlist;tt : ttype;is_threadvar : boolean);
-      { inserts the symbols of sc in st with def as definition or sym as ptypesym, sc is disposed }
+      procedure insert_syms(st : tsymtable;sc : tidstringlist;tt : ttype;is_threadvar : boolean);
+      { inserts the symbols of sc in st with def as definition or sym as ttypesym, sc is disposed }
         var
            s : string;
            filepos : tfileposinfo;
-           ss : pvarsym;
+           ss : tvarsym;
         begin
            filepos:=akttokenpos;
            while not sc.empty do
              begin
                 s:=sc.get(akttokenpos);
-                ss:=new(pvarsym,init(s,tt));
+                ss:=tvarsym.Create(s,tt);
                 if is_threadvar then
-                  include(ss^.varoptions,vo_is_thread_var);
-                st^.insert(ss);
+                  include(ss.varoptions,vo_is_thread_var);
+                st.insert(ss);
                 { static data fields are inserted in the globalsymtable }
-                if (st^.symtabletype=objectsymtable) and
+                if (st.symtabletype=objectsymtable) and
                    (sp_static in current_object_option) then
                   begin
-                     s:='$'+lower(st^.name^)+'_'+upper(s);
-                     st^.defowner^.owner^.insert(new(pvarsym,init(s,tt)));
+                     s:='$'+lower(st.name^)+'_'+upper(s);
+                     st.defowner.owner.insert(tvarsym.create(s,tt));
                   end;
              end;
 {$ifdef fixLeaksOnError}
@@ -98,14 +98,14 @@ implementation
          s : stringid;
          old_block_type : tblock_type;
          declarepos,storetokenpos : tfileposinfo;
-         oldsymtablestack : psymtable;
+         oldsymtablestack : tsymtable;
          symdone : boolean;
          { to handle absolute }
-         abssym : pabsolutesym;
+         abssym : tabsolutesym;
          l    : longint;
          code : integer;
          { c var }
-         newtype : ptypesym;
+         newtype : ttypesym;
          is_dll,
          is_gpc_name,is_cdecl,extern_aktvarsym,export_aktvarsym : boolean;
          old_current_object_option : tsymoptions;
@@ -113,17 +113,17 @@ implementation
          C_name : string;
          tt,casetype : ttype;
          { Delphi initialized vars }
-         pconstsym : ptypedconstsym;
+         tconstsym : ttypedconstsym;
          { maxsize contains the max. size of a variant }
          { startvarrec contains the start of the variant part of a record }
          maxsize,maxalignment,startvarrecalign,startvarrecsize : longint;
          pt : tnode;
-         srsym : psym;
-         srsymtable : psymtable;
-         unionsymtable : psymtable;
+         srsym : tsym;
+         srsymtable : tsymtable;
+         unionsymtable : tsymtable;
          offset : longint;
-         uniondef : precorddef;
-         unionsym : pvarsym;
+         uniondef : trecorddef;
+         unionsym : tvarsym;
          uniontype : ttype;
       begin
          old_current_object_option:=current_object_option;
@@ -166,13 +166,13 @@ implementation
                 { for records, don't search the recordsymtable for
                   the symbols of the types }
                     oldsymtablestack:=symtablestack;
-                    symtablestack:=symtablestack^.next;
+                    symtablestack:=symtablestack.next;
                 read_type(tt,'');
                     symtablestack:=oldsymtablestack;
                   end
                  else
                   read_type(tt,'');
-             if (variantrecordlevel>0) and tt.def^.needs_inittable then
+             if (variantrecordlevel>0) and tt.def.needs_inittable then
                Message(parser_e_cant_use_inittable_here);
              ignore_equal:=false;
              symdone:=false;
@@ -187,9 +187,9 @@ implementation
                      writeln('problem with strContStack in pdecl (3)');
 {$endif fixLeaksOnError}
                   sc.free;
-                  aktvarsym:=new(pvarsym,init_C(s,target_os.Cprefix+C_name,tt));
-                  include(aktvarsym^.varoptions,vo_is_external);
-                  symtablestack^.insert(aktvarsym);
+                  aktvarsym:=tvarsym.create_C(s,target_os.Cprefix+C_name,tt);
+                  include(aktvarsym.varoptions,vo_is_external);
+                  symtablestack.insert(aktvarsym);
                   akttokenpos:=storetokenpos;
                   symdone:=true;
                end;
@@ -212,14 +212,14 @@ implementation
                  begin
                    consume_sym(srsym,srsymtable);
                    { we should check the result type of srsym }
-                   if not (srsym^.typ in [varsym,typedconstsym,funcretsym]) then
+                   if not (srsym.typ in [varsym,typedconstsym,funcretsym]) then
                      Message(parser_e_absolute_only_to_var_or_const);
                    storetokenpos:=akttokenpos;
                    akttokenpos:=declarepos;
-                   abssym:=new(pabsolutesym,init(s,tt));
-                   abssym^.abstyp:=tovar;
-                   abssym^.ref:=pstoredsym(srsym);
-                   symtablestack^.insert(abssym);
+                   abssym:=tabsolutesym.create(s,tt);
+                   abssym.abstyp:=tovar;
+                   abssym.ref:=tstoredsym(srsym);
+                   symtablestack.insert(abssym);
                    akttokenpos:=storetokenpos;
                  end
                 else
@@ -227,12 +227,12 @@ implementation
                   begin
                     storetokenpos:=akttokenpos;
                     akttokenpos:=declarepos;
-                    abssym:=new(pabsolutesym,init(s,tt));
+                    abssym:=tabsolutesym.create(s,tt);
                     s:=pattern;
                     consume(token);
-                    abssym^.abstyp:=toasm;
-                    abssym^.asmname:=stringdup(s);
-                    symtablestack^.insert(abssym);
+                    abssym.abstyp:=toasm;
+                    abssym.asmname:=stringdup(s);
+                    symtablestack.insert(abssym);
                     akttokenpos:=storetokenpos;
                   end
                 else
@@ -245,12 +245,12 @@ implementation
                      begin
                        storetokenpos:=akttokenpos;
                        akttokenpos:=declarepos;
-                       abssym:=new(pabsolutesym,init(s,tt));
-                       abssym^.abstyp:=toaddr;
-                       abssym^.absseg:=false;
+                       abssym:=tabsolutesym.create(s,tt);
+                       abssym.abstyp:=toaddr;
+                       abssym.absseg:=false;
                        s:=pattern;
                        consume(_INTCONST);
-                       val(s,abssym^.address,code);
+                       val(s,abssym.address,code);
                        if (token=_COLON) and
                          (target_info.target=target_i386_go32v2) then
                         begin
@@ -258,10 +258,10 @@ implementation
                           s:=pattern;
                           consume(_INTCONST);
                           val(s,l,code);
-                          abssym^.address:=abssym^.address shl 4+l;
-                          abssym^.absseg:=true;
+                          abssym.address:=abssym.address shl 4+l;
+                          abssym.absseg:=true;
                         end;
-                       symtablestack^.insert(abssym);
+                       symtablestack.insert(abssym);
                        akttokenpos:=storetokenpos;
                      end
                     else
@@ -277,31 +277,31 @@ implementation
                - in record or object
                - ... (PM) }
              if (m_delphi in aktmodeswitches) and (token=_EQUAL) and
-                not (symtablestack^.symtabletype in [parasymtable]) and
+                not (symtablestack.symtabletype in [parasymtable]) and
                 not is_record and not is_object then
                begin
                   storetokenpos:=akttokenpos;
                   s:=sc.get(akttokenpos);
                   if not sc.empty then
                     Message(parser_e_initialized_only_one_var);
-                  pconstsym:=new(ptypedconstsym,inittype(s,tt,false));
-                  symtablestack^.insert(pconstsym);
+                  tconstsym:=ttypedconstsym.createtype(s,tt,false);
+                  symtablestack.insert(tconstsym);
                   akttokenpos:=storetokenpos;
                   consume(_EQUAL);
-                  readtypedconst(tt,pconstsym,false);
+                  readtypedconst(tt,tconstsym,false);
                   symdone:=true;
                end;
              { for a record there doesn't need to be a ; before the END or ) }
              if not((is_record or is_object) and (token in [_END,_RKLAMMER])) then
                consume(_SEMICOLON);
              { procvar handling }
-             if (tt.def^.deftype=procvardef) and (tt.def^.typesym=nil) then
+             if (tt.def.deftype=procvardef) and (tt.def.typesym=nil) then
                begin
-                  newtype:=new(ptypesym,init('unnamed',tt));
-                  parse_var_proc_directives(psym(newtype));
-                  newtype^.restype.def:=nil;
-                  tt.def^.typesym:=nil;
-                  dispose(newtype,done);
+                  newtype:=ttypesym.create('unnamed',tt);
+                  parse_var_proc_directives(tsym(newtype));
+                  newtype.restype.def:=nil;
+                  tt.def.typesym:=nil;
+                  newtype.free;
                end;
              { Check for variable directives }
              if not symdone and (token=_ID) then
@@ -344,7 +344,7 @@ implementation
                     begin
                       consume(_ID);
                       if extern_aktvarsym or
-                         (symtablestack^.symtabletype in [parasymtable,localsymtable]) then
+                         (symtablestack.symtabletype in [parasymtable,localsymtable]) then
                        Message(parser_e_not_external_and_export)
                       else
                        export_aktvarsym:=true;
@@ -368,19 +368,19 @@ implementation
                    storetokenpos:=akttokenpos;
                    akttokenpos:=declarepos;
                    if is_dll then
-                    aktvarsym:=new(pvarsym,init_dll(s,tt))
+                    aktvarsym:=tvarsym.create_dll(s,tt)
                    else
-                    aktvarsym:=new(pvarsym,init_C(s,C_name,tt));
+                    aktvarsym:=tvarsym.create_C(s,C_name,tt);
                    { set some vars options }
                    if export_aktvarsym then
                     begin
-                      inc(aktvarsym^.refs);
-                      include(aktvarsym^.varoptions,vo_is_exported);
+                      inc(aktvarsym.refs);
+                      include(aktvarsym.varoptions,vo_is_exported);
                     end;
                    if extern_aktvarsym then
-                    include(aktvarsym^.varoptions,vo_is_external);
+                    include(aktvarsym.varoptions,vo_is_external);
                    { insert in the stack/datasegment }
-                   symtablestack^.insert(aktvarsym);
+                   symtablestack.insert(aktvarsym);
                    akttokenpos:=storetokenpos;
                    { now we can insert it in the import lib if its a dll, or
                      add it to the externals }
@@ -393,11 +393,11 @@ implementation
                             current_module.uses_imports:=true;
                             importlib.preparelib(current_module.modulename^);
                           end;
-                         importlib.importvariable(aktvarsym^.mangledname,dll_name,C_name)
+                         importlib.importvariable(aktvarsym.mangledname,dll_name,C_name)
                        end
                       else
                        if target_info.DllScanSupported then
-                        current_module.Externals.insert(tExternalsItem.create(aktvarsym^.mangledname));
+                        current_module.Externals.insert(tExternalsItem.create(aktvarsym.mangledname));
                     end;
                    symdone:=true;
                  end
@@ -424,7 +424,7 @@ implementation
                    end
                   else
                    if (sp_published in current_object_option) and
-                      not(oo_can_have_published in pobjectdef(tt.def)^.objectoptions) then
+                      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);
@@ -442,12 +442,12 @@ implementation
               s:=pattern;
               searchsym(s,srsym,srsymtable);
               { may be only a type: }
-              if assigned(srsym) and (srsym^.typ in [typesym,unitsym]) then
+              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;
+                 symtablestack:=symtablestack.next;
                  read_type(casetype,'');
                  symtablestack:=oldsymtablestack;
                end
@@ -458,22 +458,22 @@ implementation
                   { for records, don't search the recordsymtable for
                     the symbols of the types }
                   oldsymtablestack:=symtablestack;
-                  symtablestack:=symtablestack^.next;
+                  symtablestack:=symtablestack.next;
                   read_type(casetype,'');
                   symtablestack:=oldsymtablestack;
-                  symtablestack^.insert(new(pvarsym,init(s,casetype)));
+                  symtablestack.insert(tvarsym.create(s,casetype));
                 end;
               if not(is_ordinal(casetype.def)) or is_64bitint(casetype.def)  then
                Message(type_e_ordinal_expr_expected);
               consume(_OF);
-              UnionSymtable:=new(pstoredsymtable,init(recordsymtable));
-              UnionSymtable^.next:=symtablestack;
+              UnionSymtable:=trecordsymtable.create;
+              Unionsymtable.next:=symtablestack;
               registerdef:=false;
-              UnionDef:=new(precorddef,init(unionsymtable));
+              UnionDef:=trecorddef.create(unionsymtable);
               registerdef:=true;
               symtablestack:=UnionSymtable;
-              startvarrecsize:=symtablestack^.datasize;
-              startvarrecalign:=symtablestack^.dataalignment;
+              startvarrecsize:=symtablestack.datasize;
+              startvarrecalign:=symtablestack.dataalignment;
               repeat
                 repeat
                   pt:=comp_expr(true);
@@ -494,33 +494,33 @@ implementation
                 dec(variantrecordlevel);
                 consume(_RKLAMMER);
                 { calculates maximal variant size }
-                maxsize:=max(maxsize,symtablestack^.datasize);
-                maxalignment:=max(maxalignment,symtablestack^.dataalignment);
+                maxsize:=max(maxsize,symtablestack.datasize);
+                maxalignment:=max(maxalignment,symtablestack.dataalignment);
                 { the items of the next variant are overlayed }
-                symtablestack^.datasize:=startvarrecsize;
-                symtablestack^.dataalignment:=startvarrecalign;
+                symtablestack.datasize:=startvarrecsize;
+                symtablestack.dataalignment:=startvarrecalign;
                 if (token<>_END) and (token<>_RKLAMMER) then
                   consume(_SEMICOLON)
                 else
                   break;
               until (token=_END) or (token=_RKLAMMER);
               { at last set the record size to that of the biggest variant }
-              symtablestack^.datasize:=maxsize;
-              symtablestack^.dataalignment:=maxalignment;
+              symtablestack.datasize:=maxsize;
+              symtablestack.dataalignment:=maxalignment;
               uniontype.def:=uniondef;
               uniontype.sym:=nil;
-              UnionSym:=new(pvarsym,init('case',uniontype));
-              symtablestack:=symtablestack^.next;
-              { we do NOT call symtablestack^.insert
+              UnionSym:=tvarsym.create('case',uniontype);
+              symtablestack:=symtablestack.next;
+              { we do NOT call symtablestack.insert
                on purpose PM }
-              offset:=align_from_size(symtablestack^.datasize,maxalignment);
-              symtablestack^.datasize:=offset+unionsymtable^.datasize;
-              if maxalignment>symtablestack^.dataalignment then
-                symtablestack^.dataalignment:=maxalignment;
-              pstoredsymtable(UnionSymtable)^.Insert_in(symtablestack,offset);
-              UnionSym^.owner:=nil;
-              dispose(unionsym,done);
-              dispose(uniondef,done);
+              offset:=align_from_size(symtablestack.datasize,maxalignment);
+              symtablestack.datasize:=offset+unionsymtable.datasize;
+              if maxalignment>symtablestack.dataalignment then
+                symtablestack.dataalignment:=maxalignment;
+              trecordsymtable(Unionsymtable).Insert_in(symtablestack,offset);
+              Unionsym.owner:=nil;
+              unionsym.free;
+              uniondef.free;
            end;
          block_type:=old_block_type;
          current_object_option:=old_current_object_option;
@@ -529,7 +529,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.14  2001-04-04 22:43:52  peter
+  Revision 1.15  2001-04-13 01:22:12  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.14  2001/04/04 22:43:52  peter
     * remove unnecessary calls to firstpass
 
   Revision 1.13  2001/04/04 21:30:45  florian

compiler/pexports.pas

@@ -39,9 +39,9 @@ implementation
        globals,tokens,verbose,
        systems,
        { symtable }
-       symconst,symbase,symtype,symdef,symsym,symtable,
+       symconst,symbase,symtype,symdef,symsym,
        { pass 1 }
-       node,pass_1,
+       node,
        ncon,
        { parser }
        scanner,
@@ -58,8 +58,8 @@ implementation
          DefString : string;
          InternalProcName : string;
          pt               : tnode;
-         srsym            : psym;
-         srsymtable : psymtable;
+         srsym            : tsym;
+         srsymtable : tsymtable;
       begin
          DefString:='';
          InternalProcName:='';
@@ -72,16 +72,16 @@ implementation
                    orgs:=orgpattern;
                    consume_sym(srsym,srsymtable);
                    hp.sym:=srsym;
-                   if ((hp.sym^.typ<>procsym) or
+                   if ((hp.sym.typ<>procsym) or
                        ((tf_need_export in target_info.flags) and
-                        not(po_exports in pprocdef(pprocsym(srsym)^.definition)^.procoptions)
+                        not(po_exports in tprocdef(tprocsym(srsym).definition).procoptions)
                        )
                       ) and
-                      (srsym^.typ<>varsym) and (srsym^.typ<>typedconstsym) then
+                      (srsym.typ<>varsym) and (srsym.typ<>typedconstsym) then
                     Message(parser_e_illegal_symbol_exported)
                    else
                     begin
-                      InternalProcName:=srsym^.mangledname;
+                      InternalProcName:=srsym.mangledname;
                       { This is wrong if the first is not
                         an underline }
                       if InternalProcName[1]='_' then
@@ -93,7 +93,7 @@ implementation
                         end;
                       if length(InternalProcName)<2 then
                        Message(parser_e_procname_to_short_for_export);
-                      DefString:=srsym^.realname+'='+InternalProcName;
+                      DefString:=srsym.realname+'='+InternalProcName;
                     end;
                    if (idtoken=_INDEX) then
                     begin
@@ -109,9 +109,9 @@ implementation
                       hp.options:=hp.options or eo_index;
                       pt.free;
                       if target_os.id=os_i386_win32 then
-                       DefString:=srsym^.realname+'='+InternalProcName+' @ '+tostr(hp.index)
+                       DefString:=srsym.realname+'='+InternalProcName+' @ '+tostr(hp.index)
                       else
-                       DefString:=srsym^.realname+'='+InternalProcName; {Index ignored!}
+                       DefString:=srsym.realname+'='+InternalProcName; {Index ignored!}
                     end;
                    if (idtoken=_NAME) then
                     begin
@@ -132,7 +132,7 @@ implementation
                     begin
                       consume(_RESIDENT);
                       hp.options:=hp.options or eo_resident;
-                      DefString:=srsym^.realname+'='+InternalProcName;{Resident ignored!}
+                      DefString:=srsym.realname+'='+InternalProcName;{Resident ignored!}
                     end;
                    if (DefString<>'') and UseDeffileForExport then
                     DefFile.AddExport(DefString);
@@ -142,7 +142,7 @@ implementation
                       hp.name:=stringdup(orgs);
                       hp.options:=hp.options or eo_name;
                     end;
-                   if hp.sym^.typ=procsym then
+                   if hp.sym.typ=procsym then
                     exportlib.exportprocedure(hp)
                    else
                     exportlib.exportvar(hp);
@@ -163,7 +163,12 @@ end.
 
 {
   $Log$
-  Revision 1.13  2001-04-04 22:43:52  peter
+  Revision 1.14  2001-04-13 01:22:12  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.13  2001/04/04 22:43:52  peter
     * remove unnecessary calls to firstpass
 
   Revision 1.12  2001/03/11 22:58:50  peter

compiler/pmodules.pas

@@ -45,9 +45,9 @@ implementation
 
     uses
        globtype,version,systems,tokens,
-       cutils,cobjects,comphook,
+       cutils,comphook,
        globals,verbose,fmodule,finput,
-       symconst,symbase,symppu,symdef,symsym,symtable,aasm,types,
+       symconst,symbase,symppu,symdef,symsym,symtable,aasm,
 {$ifdef newcg}
        cgbase,
 {$else newcg}
@@ -76,16 +76,19 @@ implementation
            (not current_module.linkOtherSharedLibs.Empty) then
          begin
            { Init DLLScanner }
+           DLLScanner:=nil;
            case target_info.target of
+             target_none :
+               ;
 {$ifdef i386}
   {$ifndef NOTARGETWIN32}
              target_i386_win32 :
                DLLScanner:=tDLLscannerWin32.create;
-  {$endif}
+  {$endif NOTARGETWIN32}
 {$endif}
-             else
-               internalerror(769795413);
            end;
+           if DLLScanner=nil then
+            internalerror(200104121);
            { Walk all shared libs }
            While not current_module.linkOtherSharedLibs.Empty do
             begin
@@ -405,7 +408,8 @@ implementation
            pu:=tused_unit(pu.next);
          end;
       { ok, now load the unit }
-        current_module.globalsymtable:=new(punitsymtable,loadasunit);
+        current_module.globalsymtable:=tglobalsymtable.create(current_module.modulename^);
+        tglobalsymtable(current_module.globalsymtable).load;
       { now only read the implementation part }
         current_module.in_implementation:=true;
       { load the used units from implementation }
@@ -445,7 +449,7 @@ implementation
          end;
         { load browser info if stored }
         if ((current_module.flags and uf_has_browser)<>0) and load_refs then
-          punitsymtable(current_module.globalsymtable)^.load_symtable_refs;
+          tglobalsymtable(current_module.globalsymtable).load_symtable_refs;
         { remove the map, it's not needed anymore }
         dispose(current_module.map);
         current_module.map:=nil;
@@ -456,7 +460,7 @@ implementation
       const
         ImplIntf : array[boolean] of string[15]=('interface','implementation');
       var
-        st : punitsymtable;
+        st : tglobalsymtable;
         second_time : boolean;
         old_current_ppu : pppufile;
         old_current_module,hp,hp2 : tmodule;
@@ -556,7 +560,7 @@ implementation
                    { is already compiled              }
                    { else there is a cyclic unit use  }
                    if assigned(hp.globalsymtable) then
-                     st:=punitsymtable(hp.globalsymtable)
+                     st:=tglobalsymtable(hp.globalsymtable)
                    else
                     begin
                     { both units in interface ? }
@@ -657,7 +661,7 @@ implementation
     procedure loaddefaultunits;
       var
         hp : tmodule;
-        unitsym : punitsym;
+        unitsym : tunitsym;
       begin
       { are we compiling the system unit? }
         if (cs_compilesystem in aktmoduleswitches) then
@@ -669,51 +673,42 @@ implementation
          end;
      { insert the system unit, it is allways the first }
         hp:=loadunit('SYSTEM',true);
-        systemunit:=hp.globalsymtable;
+        systemunit:=tglobalsymtable(hp.globalsymtable);
         { it's always the first unit }
-        systemunit^.next:=nil;
+        systemunit.next:=nil;
         symtablestack:=systemunit;
         { add to the used units }
         current_module.used_units.concat(tused_unit.create(hp,true));
-        unitsym:=new(punitsym,init('System',systemunit));
-        inc(unitsym^.refs);
-        refsymtable^.insert(unitsym);
+        unitsym:=tunitsym.create('System',systemunit);
+        inc(unitsym.refs);
+        refsymtable.insert(unitsym);
         { read default constant definitions }
         make_ref:=false;
         readconstdefs;
-        { if POWER is defined in the RTL then use it for starstar overloading }
-{$ifdef DONOTCHAINOPERATORS}
-        getsym('POWER',false);
-{$endif DONOTCHAINOPERATORS}
         make_ref:=true;
-{$ifdef DONOTCHAINOPERATORS}
-        { Code now in chainoperators PM }
-        if assigned(srsym) and (srsym^.typ=procsym) and (overloaded_operators[_STARSTAR]=nil) then
-          overloaded_operators[_STARSTAR]:=pprocsym(srsym);
-{$endif DONOTCHAINOPERATORS}
       { Objpas unit? }
         if m_objpas in aktmodeswitches then
          begin
            hp:=loadunit('ObjPas',false);
-           psymtable(hp.globalsymtable)^.next:=symtablestack;
+           tsymtable(hp.globalsymtable).next:=symtablestack;
            symtablestack:=hp.globalsymtable;
            { add to the used units }
            current_module.used_units.concat(tused_unit.create(hp,true));
-           unitsym:=new(punitsym,init('ObjPas',hp.globalsymtable));
-           inc(unitsym^.refs);
-           refsymtable^.insert(unitsym);
+           unitsym:=tunitsym.create('ObjPas',hp.globalsymtable);
+           inc(unitsym.refs);
+           refsymtable.insert(unitsym);
          end;
       { Profile unit? Needed for go32v2 only }
         if (cs_profile in aktmoduleswitches) and (target_info.target=target_i386_go32v2) then
          begin
            hp:=loadunit('Profile',false);
-           psymtable(hp.globalsymtable)^.next:=symtablestack;
+           tsymtable(hp.globalsymtable).next:=symtablestack;
            symtablestack:=hp.globalsymtable;
            { add to the used units }
            current_module.used_units.concat(tused_unit.create(hp,true));
-           unitsym:=new(punitsym,init('Profile',hp.globalsymtable));
-           inc(unitsym^.refs);
-           refsymtable^.insert(unitsym);
+           unitsym:=tunitsym.create('Profile',hp.globalsymtable);
+           inc(unitsym.refs);
+           refsymtable.insert(unitsym);
          end;
       { Units only required for main module }
         if not(current_module.is_unit) then
@@ -722,25 +717,25 @@ implementation
            if (cs_gdb_heaptrc in aktglobalswitches) then
             begin
               hp:=loadunit('HeapTrc',false);
-              psymtable(hp.globalsymtable)^.next:=symtablestack;
+              tsymtable(hp.globalsymtable).next:=symtablestack;
               symtablestack:=hp.globalsymtable;
               { add to the used units }
               current_module.used_units.concat(tused_unit.create(hp,true));
-              unitsym:=new(punitsym,init('HeapTrc',hp.globalsymtable));
-              inc(unitsym^.refs);
-              refsymtable^.insert(unitsym);
+              unitsym:=tunitsym.create('HeapTrc',hp.globalsymtable);
+              inc(unitsym.refs);
+              refsymtable.insert(unitsym);
             end;
            { Lineinfo unit }
            if (cs_gdb_lineinfo in aktglobalswitches) then
             begin
               hp:=loadunit('LineInfo',false);
-              psymtable(hp.globalsymtable)^.next:=symtablestack;
+              tsymtable(hp.globalsymtable).next:=symtablestack;
               symtablestack:=hp.globalsymtable;
               { add to the used units }
               current_module.used_units.concat(tused_unit.create(hp,true));
-              unitsym:=new(punitsym,init('LineInfo',hp.globalsymtable));
-              inc(unitsym^.refs);
-              refsymtable^.insert(unitsym);
+              unitsym:=tunitsym.create('LineInfo',hp.globalsymtable);
+              inc(unitsym.refs);
+              refsymtable.insert(unitsym);
             end;
          end;
       { save default symtablestack }
@@ -754,9 +749,9 @@ implementation
          pu,
          hp : tused_unit;
          hp2 : tmodule;
-         hp3 : psymtable;
-         oldprocsym:Pprocsym;
-         unitsym : punitsym;
+         hp3 : tsymtable;
+         oldprocsym:tprocsym;
+         unitsym : tunitsym;
       begin
          oldprocsym:=aktprocsym;
          consume(_USES);
@@ -788,12 +783,12 @@ implementation
               tused_unit(current_module.used_units.last).in_uses:=true;
               if current_module.compiled then
                 exit;
-              unitsym:=new(punitsym,init(sorg,hp2.globalsymtable));
+              unitsym:=tunitsym.create(sorg,hp2.globalsymtable);
               { never claim about unused unit if
                 there is init or finalize code  PM }
               if (hp2.flags and (uf_init or uf_finalize))<>0 then
-                inc(unitsym^.refs);
-              refsymtable^.insert(unitsym);
+                inc(unitsym.refs);
+              refsymtable.insert(unitsym);
             end
            else
             Message1(sym_e_duplicate_id,s);
@@ -819,9 +814,9 @@ implementation
                  (cs_gdb_dbx in aktglobalswitches) and
                 not hp.is_stab_written then
                 begin
-                   punitsymtable(hp.u.globalsymtable)^.concattypestabto(debuglist);
+                   tglobalsymtable(hp.u.globalsymtable).concattypestabto(debuglist);
                    hp.is_stab_written:=true;
-                   hp.unitid:=psymtable(hp.u.globalsymtable)^.unitid;
+                   hp.unitid:=tsymtable(hp.u.globalsymtable).unitid;
                 end;
 {$EndIf GDB}
               if hp.in_uses then
@@ -832,14 +827,14 @@ implementation
                         { insert units only once ! }
                         if hp.u.globalsymtable=hp3 then
                           break;
-                        hp3:=hp3^.next;
+                        hp3:=hp3.next;
                         { unit isn't inserted }
                         if hp3=nil then
                           begin
-                             psymtable(hp.u.globalsymtable)^.next:=symtablestack;
-                             symtablestack:=psymtable(hp.u.globalsymtable);
+                             tsymtable(hp.u.globalsymtable).next:=symtablestack;
+                             symtablestack:=tsymtable(hp.u.globalsymtable);
 {$ifdef CHAINPROCSYMS}
-                             symtablestack^.chainprocsyms;
+                             symtablestack.chainprocsyms;
 {$endif CHAINPROCSYMS}
 {$ifdef DEBUG}
                              test_symtablestack;
@@ -863,13 +858,13 @@ implementation
          if (cs_gdb_dbx in aktglobalswitches) then
            begin
              debugList.concat(Tai_asm_comment.Create(strpnew('EINCL of global '+
-               punitsymtable(current_module.globalsymtable)^.name^+' has index '+
-               tostr(punitsymtable(current_module.globalsymtable)^.unitid))));
+               tglobalsymtable(current_module.globalsymtable).name^+' has index '+
+               tostr(tglobalsymtable(current_module.globalsymtable).unitid))));
              debugList.concat(Tai_stabs.Create(strpnew('"'+
-               punitsymtable(current_module.globalsymtable)^.name^+'",'+
+               tglobalsymtable(current_module.globalsymtable).name^+'",'+
                tostr(N_EINCL)+',0,0,0')));
-             punitsymtable(current_module.globalsymtable)^.dbx_count_ok:={true}false;
-             dbx_counter:=punitsymtable(current_module.globalsymtable)^.prev_dbx_counter;
+             tglobalsymtable(current_module.globalsymtable).dbx_count_ok:={true}false;
+             dbx_counter:=tglobalsymtable(current_module.globalsymtable).prev_dbx_counter;
              do_count_dbx:=false;
            end;
 
@@ -880,9 +875,9 @@ implementation
               if (cs_debuginfo in aktmoduleswitches) and
                 not hp.is_stab_written then
                 begin
-                   punitsymtable(hp.u.globalsymtable)^.concattypestabto(debuglist);
+                   tglobalsymtable(hp.u.globalsymtable).concattypestabto(debuglist);
                    hp.is_stab_written:=true;
-                   hp.unitid:=psymtable(hp.u.globalsymtable)^.unitid;
+                   hp.unitid:=tsymtable(hp.u.globalsymtable).unitid;
                 end;
               hp:=tused_unit(hp.next);
            end;
@@ -890,16 +885,16 @@ implementation
             assigned(current_module.localsymtable) then
            begin
               { all types }
-              punitsymtable(current_module.localsymtable)^.concattypestabto(debuglist);
+              tstaticsymtable(current_module.localsymtable).concattypestabto(debuglist);
               { and all local symbols}
-              punitsymtable(current_module.localsymtable)^.concatstabto(debuglist);
+              tstaticsymtable(current_module.localsymtable).concatstabto(debuglist);
            end
          else if assigned(current_module.globalsymtable) then
            begin
               { all types }
-              punitsymtable(current_module.globalsymtable)^.concattypestabto(debuglist);
+              tglobalsymtable(current_module.globalsymtable).concattypestabto(debuglist);
               { and all local symbols}
-              punitsymtable(current_module.globalsymtable)^.concatstabto(debuglist);
+              tglobalsymtable(current_module.globalsymtable).concatstabto(debuglist);
            end;
        end;
 {$Else GDB}
@@ -908,13 +903,11 @@ implementation
 {$EndIf GDB}
 
 
-    procedure parse_implementation_uses(symt:Psymtable);
+    procedure parse_implementation_uses(symt:tsymtable);
       begin
          if token=_USES then
            begin
-              symt^.symtabletype:=unitsymtable;
               loadunits;
-              symt^.symtabletype:=globalsymtable;
 {$ifdef DEBUG}
               test_symtablestack;
 {$endif DEBUG}
@@ -944,30 +937,30 @@ implementation
       end;
 
 
-    procedure gen_main_procsym(const name:string;options:tproctypeoption;st:psymtable);
+    procedure gen_main_procsym(const name:string;options:tproctypeoption;st:tsymtable);
       var
-        stt : psymtable;
+        stt : tsymtable;
       begin
         {Generate a procsym for main}
         make_ref:=false;
-        aktprocsym:=new(Pprocsym,init('$'+name));
+        aktprocsym:=tprocsym.create('$'+name);
         { main are allways used }
-        inc(aktprocsym^.refs);
+        inc(aktprocsym.refs);
         {Try to insert in in static symtable ! }
         stt:=symtablestack;
         symtablestack:=st;
-        aktprocsym^.definition:=new(Pprocdef,init);
+        aktprocsym.definition:=tprocdef.create;
         symtablestack:=stt;
-        aktprocsym^.definition^.proctypeoption:=options;
-        aktprocsym^.definition^.setmangledname(target_os.cprefix+name);
-        aktprocsym^.definition^.forwarddef:=false;
+        aktprocsym.definition.proctypeoption:=options;
+        aktprocsym.definition.setmangledname(target_os.cprefix+name);
+        aktprocsym.definition.forwarddef:=false;
         make_ref:=true;
         { The localst is a local symtable. Change it into the static
           symtable }
-        dispose(aktprocsym^.definition^.localst,done);
-        aktprocsym^.definition^.localst:=st;
+        aktprocsym.definition.localst.free;
+        aktprocsym.definition.localst:=st;
         { and insert the procsym in symtable }
-        st^.insert(aktprocsym);
+        st.insert(aktprocsym);
         { set some informations about the main program }
         with procinfo^ do
          begin
@@ -997,8 +990,8 @@ implementation
 
       var
          main_file: tinputfile;
-         st     : psymtable;
-         unitst : punitsymtable;
+         st     : tsymtable;
+         unitst : tglobalsymtable;
 {$ifdef GDB}
          pu     : tused_unit;
 {$endif GDB}
@@ -1073,9 +1066,9 @@ implementation
          parse_only:=true;
 
          { generate now the global symboltable }
-         st:=new(punitsymtable,init(globalsymtable,current_module.modulename^));
+         st:=tglobalsymtable.create(current_module.modulename^);
          refsymtable:=st;
-         unitst:=punitsymtable(st);
+         unitst:=tglobalsymtable(st);
          { define first as local to overcome dependency conflicts }
          current_module.localsymtable:=st;
 
@@ -1083,11 +1076,7 @@ implementation
          { inside the unit itself (PM)                }
          { this also forbids to have another symbol      }
          { with the same name as the unit                  }
-         refsymtable^.insert(new(punitsym,init(current_module.realmodulename^,unitst)));
-
-         { a unit compiled at command line must be inside the loaded_unit list }
-         if (compile_level=1) then
-           loaded_units.insert(current_module);
+         refsymtable.insert(tunitsym.create(current_module.realmodulename^,unitst));
 
          { load default units, like the system unit }
          loaddefaultunits;
@@ -1101,7 +1090,6 @@ implementation
            begin
               if token=_USES then
                 begin
-                   unitst^.symtabletype:=unitsymtable;
                    loadunits;
                    { has it been compiled at a higher level ?}
                    if current_module.compiled then
@@ -1112,16 +1100,15 @@ implementation
                         RestoreUnitSyms;
                         exit;
                      end;
-                   unitst^.symtabletype:=globalsymtable;
                 end;
               { ... but insert the symbol table later }
-              st^.next:=symtablestack;
+              st.next:=symtablestack;
               symtablestack:=st;
            end
          else
          { while compiling a system unit, some types are directly inserted }
            begin
-              st^.next:=symtablestack;
+              st.next:=symtablestack;
               symtablestack:=st;
               insert_intern_types(st);
            end;
@@ -1159,7 +1146,7 @@ implementation
 
          if not(cs_compilesystem in aktmoduleswitches) then
            if (Errorcount=0) then
-             writeunitas(current_module.ppufilename^,punitsymtable(symtablestack),true);
+             writeunitas(current_module.ppufilename^,tglobalsymtable(symtablestack),true);
 
          { Parse the implementation section }
          consume(_IMPLEMENTATION);
@@ -1169,12 +1156,12 @@ implementation
          parse_only:=false;
 
          { generates static symbol table }
-         st:=new(punitsymtable,init(staticsymtable,current_module.modulename^));
+         st:=tstaticsymtable.create(current_module.modulename^);
          current_module.localsymtable:=st;
 
          { remove the globalsymtable from the symtable stack }
          { to reinsert it after loading the implementation units }
-         symtablestack:=unitst^.next;
+         symtablestack:=unitst.next;
 
          { we don't want implementation units symbols in unitsymtable !! PM }
          refsymtable:=st;
@@ -1198,12 +1185,10 @@ implementation
          refsymtable:=st;
 
          { but reinsert the global symtable as lasts }
-         unitst^.next:=symtablestack;
+         unitst.next:=symtablestack;
          symtablestack:=unitst;
 
-{$ifndef DONOTCHAINOPERATORS}
-         pstoredsymtable(symtablestack)^.chainoperators;
-{$endif DONOTCHAINOPERATORS}
+         tstoredsymtable(symtablestack).chainoperators;
 
 {$ifdef DEBUG}
          test_symtablestack;
@@ -1226,18 +1211,18 @@ implementation
          { Compile the unit }
          codegen_newprocedure;
          gen_main_procsym(current_module.modulename^+'_init',potype_unitinit,st);
-         aktprocsym^.definition^.aliasnames.insert('INIT$$'+current_module.modulename^);
-         aktprocsym^.definition^.aliasnames.insert(target_os.cprefix+current_module.modulename^+'_init');
+         aktprocsym.definition.aliasnames.insert('INIT$$'+current_module.modulename^);
+         aktprocsym.definition.aliasnames.insert(target_os.cprefix+current_module.modulename^+'_init');
          compile_proc_body(true,false);
          codegen_doneprocedure;
 
          { avoid self recursive destructor call !! PM }
-         aktprocsym^.definition^.localst:=nil;
+         aktprocsym.definition.localst:=nil;
 
          { if the unit contains ansi/widestrings, initialization and
            finalization code must be forced }
-         force_init_final:=needs_init_final(current_module.globalsymtable)
-           or needs_init_final(current_module.localsymtable);
+         force_init_final:=tglobalsymtable(current_module.globalsymtable).needs_init_final or
+                           tstaticsymtable(current_module.localsymtable).needs_init_final;
 
          { should we force unit initialization? }
          { this is a hack, but how can it be done better ? }
@@ -1258,8 +1243,8 @@ implementation
               { Compile the finalize }
               codegen_newprocedure;
               gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
-              aktprocsym^.definition^.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
-              aktprocsym^.definition^.aliasnames.insert(target_os.cprefix+current_module.modulename^+'_finalize');
+              aktprocsym.definition.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
+              aktprocsym.definition.aliasnames.insert(target_os.cprefix+current_module.modulename^+'_finalize');
               compile_proc_body(true,false);
               codegen_doneprocedure;
            end
@@ -1285,19 +1270,19 @@ implementation
           end;
 
          { avoid self recursive destructor call !! PM }
-         aktprocsym^.definition^.localst:=nil;
+         aktprocsym.definition.localst:=nil;
          { absence does not matter here !! }
-         aktprocsym^.definition^.forwarddef:=false;
+         aktprocsym.definition.forwarddef:=false;
          { test static symtable }
          if (Errorcount=0) then
            begin
-             pstoredsymtable(st)^.allsymbolsused;
-             pstoredsymtable(st)^.allunitsused;
-             pstoredsymtable(st)^.allprivatesused;
+             tstoredsymtable(st).allsymbolsused;
+             tstoredsymtable(st).allunitsused;
+             tstoredsymtable(st).allprivatesused;
            end;
 
          { size of the static data }
-         datasize:=st^.datasize;
+         datasize:=st.datasize;
 
 {$ifdef GDB}
          { add all used definitions even for implementation}
@@ -1307,12 +1292,12 @@ implementation
             if assigned(current_module.globalsymtable) then
               begin
                  { all types }
-                 punitsymtable(current_module.globalsymtable)^.concattypestabto(debuglist);
+                 tglobalsymtable(current_module.globalsymtable).concattypestabto(debuglist);
                  { and all local symbols}
-                 punitsymtable(current_module.globalsymtable)^.concatstabto(debuglist);
+                 tglobalsymtable(current_module.globalsymtable).concatstabto(debuglist);
               end;
             { all local types }
-            punitsymtable(st)^.concattypestabto(debuglist);
+            tglobalsymtable(st)^.concattypestabto(debuglist);
             { and all local symbols}
             st^.concatstabto(debuglist);
 {$else New_GDB}
@@ -1326,15 +1311,13 @@ implementation
          { tests, if all (interface) forwards are resolved }
          if (Errorcount=0) then
            begin
-             pstoredsymtable(symtablestack)^.check_forwards;
-             pstoredsymtable(symtablestack)^.allprivatesused;
+             tstoredsymtable(symtablestack).check_forwards;
+             tstoredsymtable(symtablestack).allprivatesused;
            end;
 
-         { now we have a correct unit, change the symtable type }
          current_module.in_implementation:=false;
-         symtablestack^.symtabletype:=unitsymtable;
 {$ifdef GDB}
-         punitsymtable(symtablestack)^.is_stab_written:=false;
+         tglobalsymtable(symtablestack).is_stab_written:=false;
 {$endif GDB}
 
          { leave when we got an error }
@@ -1363,7 +1346,7 @@ implementation
          store_interface_crc:=current_module.interface_crc;
          store_crc:=current_module.crc;
          if (Errorcount=0) then
-           writeunitas(current_module.ppufilename^,punitsymtable(symtablestack),false);
+           writeunitas(current_module.ppufilename^,tglobalsymtable(symtablestack),false);
 
          if not(cs_compilesystem in aktmoduleswitches) then
            if store_interface_crc<>current_module.interface_crc then
@@ -1382,7 +1365,7 @@ implementation
          while assigned(pu) do
            begin
               if assigned(pu.u.globalsymtable) then
-                punitsymtable(pu.u.globalsymtable)^.is_stab_written:=false;
+                tglobalsymtable(pu.u.globalsymtable).is_stab_written:=false;
               pu:=tused_unit(pu.next);
            end;
 {$endif GDB}
@@ -1390,7 +1373,7 @@ implementation
          { remove static symtable (=refsymtable) here to save some mem }
          if not (cs_local_browser in aktmoduleswitches) then
            begin
-              dispose(st,done);
+              st.free;
               current_module.localsymtable:=nil;
            end;
 
@@ -1417,7 +1400,7 @@ implementation
     procedure proc_program(islibrary : boolean);
       var
          main_file: tinputfile;
-         st    : psymtable;
+         st    : tsymtable;
          hp    : tmodule;
       begin
          DLLsource:=islibrary;
@@ -1491,14 +1474,10 @@ implementation
 
          { insert after the unit symbol tables the static symbol table }
          { of the program                                             }
-         st:=new(punitsymtable,init(staticsymtable,current_module.modulename^));
+         st:=tstaticsymtable.create(current_module.modulename^);;
          current_module.localsymtable:=st;
          refsymtable:=st;
 
-         { a unit compiled at command line must be inside the loaded_unit list }
-         if (compile_level=1) then
-           loaded_units.insert(current_module);
-
          { load standard units (system,objpas,profile unit) }
          loaddefaultunits;
 
@@ -1509,9 +1488,7 @@ implementation
          if token=_USES then
            loadunits;
 
-{$ifndef DONOTCHAINOPERATORS}
-         pstoredsymtable(symtablestack)^.chainoperators;
-{$endif DONOTCHAINOPERATORS}
+         tstoredsymtable(symtablestack).chainoperators;
 
          { reset ranges/stabs in exported definitions }
          reset_global_defs;
@@ -1521,7 +1498,7 @@ implementation
 
          {Insert the name of the main program into the symbol table.}
          if current_module.realmodulename^<>'' then
-           st^.insert(new(punitsym,init(current_module.realmodulename^,punitsymtable(st))));
+           st.insert(tunitsym.create(current_module.realmodulename^,tglobalsymtable(st)));
 
          { ...is also constsymtable, this is the symtable where }
          { the elements of enumeration types are inserted       }
@@ -1536,22 +1513,23 @@ implementation
           from the bootstrap code.}
          codegen_newprocedure;
          gen_main_procsym('main',potype_proginit,st);
-         aktprocsym^.definition^.aliasnames.insert('program_init');
-         aktprocsym^.definition^.aliasnames.insert('PASCALMAIN');
-         aktprocsym^.definition^.aliasnames.insert(target_os.cprefix+'main');
+         aktprocsym.definition.aliasnames.insert('program_init');
+         aktprocsym.definition.aliasnames.insert('PASCALMAIN');
+         aktprocsym.definition.aliasnames.insert(target_os.cprefix+'main');
 {$ifdef m68k}
          if target_info.target=target_m68k_PalmOS then
-           aktprocsym^.definition^.aliasnames.insert('PilotMain');
+           aktprocsym.definition.aliasnames.insert('PilotMain');
 {$endif m68k}
          compile_proc_body(true,false);
 
          { avoid self recursive destructor call !! PM }
-         aktprocsym^.definition^.localst:=nil;
+         aktprocsym.definition.localst:=nil;
 
-         { consider these symbols as global ones }
-         { for browser }
+         { consider these symbols as global ones for browser
+           but the typecasting of the globalsymtable with tglobalsymtable
+           can then lead to problems (PFV)
          current_module.globalsymtable:=current_module.localsymtable;
-         current_module.localsymtable:=nil;
+         current_module.localsymtable:=nil;}
 
          If ResourceStrings.ResStrCount>0 then
           begin
@@ -1572,8 +1550,8 @@ implementation
               { Compile the finalize }
               codegen_newprocedure;
               gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
-              aktprocsym^.definition^.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
-              aktprocsym^.definition^.aliasnames.insert(target_os.cprefix+current_module.modulename^+'_finalize');
+              aktprocsym.definition.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
+              aktprocsym.definition.aliasnames.insert(target_os.cprefix+current_module.modulename^+'_finalize');
               compile_proc_body(true,false);
               codegen_doneprocedure;
            end;
@@ -1595,9 +1573,9 @@ implementation
          { test static symtable }
          if (Errorcount=0) then
            begin
-             pstoredsymtable(st)^.allsymbolsused;
-             pstoredsymtable(st)^.allunitsused;
-             pstoredsymtable(st)^.allprivatesused;
+             tstoredsymtable(st).allsymbolsused;
+             tstoredsymtable(st).allunitsused;
+             tstoredsymtable(st).allprivatesused;
            end;
 
          { generate imports }
@@ -1615,7 +1593,7 @@ implementation
          insertheap;
          inserttargetspecific;
 
-         datasize:=symtablestack^.datasize;
+         datasize:=symtablestack.datasize;
 
          { finish asmlist by adding segment starts }
          insertsegment;
@@ -1661,7 +1639,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.26  2001-04-02 21:20:33  peter
+  Revision 1.27  2001-04-13 01:22:12  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.26  2001/04/02 21:20:33  peter
     * resulttype rewrite
 
   Revision 1.25  2001/03/13 18:45:07  peter

compiler/ppheap.pas

@@ -75,6 +75,7 @@ implementation
     begin
        if not pp_heap_inited then
          begin
+            keepreleased:=true;
             SetHeapTraceOutput('heap.log');
             SetHeapExtraInfo(sizeof(textra_info),
                              {$ifdef FPCPROCVAR}@{$endif}set_extra_info,
@@ -89,8 +90,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.6  2001-04-11 12:36:26  peter
-    * use new heaptrc version
+  Revision 1.7  2001-04-13 01:22:13  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
 
   Revision 1.5  2001/03/13 18:43:17  peter
     * made memdebug and heaptrc compilable again

compiler/pstatmnt.pas

@@ -135,12 +135,12 @@ implementation
     function case_statement : tnode;
       var
          { contains the label number of currently parsed case block }
-         aktcaselabel : pasmlabel;
+         aktcaselabel : tasmlabel;
          firstlabel : boolean;
          root : pcaserecord;
 
          { the typ of the case expression }
-         casedef : pdef;
+         casedef : tdef;
 
       procedure newcaselabel(l,h : TConstExprInt;first:boolean);
 
@@ -237,8 +237,8 @@ implementation
                         CGMessage(parser_e_case_lower_less_than_upper_bound);
                       if not casedeferror then
                        begin
-                         testrange(casedef,hl1);
-                         testrange(casedef,hl2);
+                         testrange(casedef,hl1,false);
+                         testrange(casedef,hl2,false);
                        end;
                     end
                   else
@@ -252,7 +252,7 @@ implementation
                     CGMessage(parser_e_case_mismatch);
                   hl1:=get_ordinal_value(p);
                   if not casedeferror then
-                    testrange(casedef,hl1);
+                    testrange(casedef,hl1,false);
                   newcaselabel(hl1,hl1,firstlabel);
                end;
              p.free;
@@ -378,8 +378,8 @@ implementation
       var
          right,p : tnode;
          i,levelcount : longint;
-         withsymtable,symtab : psymtable;
-         obj : pobjectdef;
+         withsymtable,symtab : tsymtable;
+         obj : tobjectdef;
          hp : tnode;
       begin
          p:=comp_expr(true);
@@ -387,51 +387,42 @@ implementation
          set_varstate(p,false);
          right:=nil;
          if (not codegenerror) and
-            (p.resulttype.def^.deftype in [objectdef,recorddef]) then
+            (p.resulttype.def.deftype in [objectdef,recorddef]) then
           begin
-            case p.resulttype.def^.deftype of
+            case p.resulttype.def.deftype of
              objectdef : begin
-                           obj:=pobjectdef(p.resulttype.def);
-                           withsymtable:=new(pwithsymtable,init);
-                           withsymtable^.symsearch:=obj^.symtable^.symsearch;
-                           withsymtable^.defowner:=obj;
-                           symtab:=withsymtable;
+                           obj:=tobjectdef(p.resulttype.def);
+                           symtab:=twithsymtable.Create(obj,obj.symtable.symsearch);
+                           withsymtable:=symtab;
                            if (p.nodetype=loadn) and
-                              (tloadnode(p).symtable=aktprocsym^.definition^.localst) then
-                             pwithsymtable(symtab)^.direct_with:=true;
-                           {symtab^.withnode:=p; not yet allocated !! }
-                           pwithsymtable(symtab)^.withrefnode:=p;
+                              (tloadnode(p).symtable=aktprocsym.definition.localst) then
+                             twithsymtable(symtab).direct_with:=true;
+                           twithsymtable(symtab).withrefnode:=p;
                            levelcount:=1;
-                           obj:=obj^.childof;
+                           obj:=obj.childof;
                            while assigned(obj) do
                             begin
-                              symtab^.next:=new(pwithsymtable,init);
-                              symtab:=symtab^.next;
-                              symtab^.symsearch:=obj^.symtable^.symsearch;
+                              symtab.next:=twithsymtable.create(obj,obj.symtable.symsearch);
+                              symtab:=symtab.next;
                               if (p.nodetype=loadn) and
-                                 (tloadnode(p).symtable=aktprocsym^.definition^.localst) then
-                                pwithsymtable(symtab)^.direct_with:=true;
-                              {symtab^.withnode:=p; not yet allocated !! }
-                              pwithsymtable(symtab)^.withrefnode:=p;
-                              symtab^.defowner:=obj;
-                              obj:=obj^.childof;
+                                 (tloadnode(p).symtable=aktprocsym.definition.localst) then
+                                twithsymtable(symtab).direct_with:=true;
+                              twithsymtable(symtab).withrefnode:=p;
+                              obj:=obj.childof;
                               inc(levelcount);
                             end;
-                           symtab^.next:=symtablestack;
+                           symtab.next:=symtablestack;
                            symtablestack:=withsymtable;
                          end;
              recorddef : begin
-                           symtab:=precorddef(p.resulttype.def)^.symtable;
+                           symtab:=trecorddef(p.resulttype.def).symtable;
                            levelcount:=1;
-                           withsymtable:=new(pwithsymtable,init);
-                           withsymtable^.symsearch:=symtab^.symsearch;
+                           withsymtable:=twithsymtable.create(trecorddef(p.resulttype.def),symtab.symsearch);
                            if (p.nodetype=loadn) and
-                              (tloadnode(p).symtable=aktprocsym^.definition^.localst) then
-                           pwithsymtable(withsymtable)^.direct_with:=true;
-                           {symtab^.withnode:=p; not yet allocated !! }
-                           pwithsymtable(withsymtable)^.withrefnode:=p;
-                           withsymtable^.defowner:=precorddef(p.resulttype.def);
-                           withsymtable^.next:=symtablestack;
+                              (tloadnode(p).symtable=aktprocsym.definition.localst) then
+                           twithsymtable(withsymtable).direct_with:=true;
+                           twithsymtable(withsymtable).withrefnode:=p;
+                           withsymtable.next:=symtablestack;
                            symtablestack:=withsymtable;
                         end;
             end;
@@ -449,8 +440,8 @@ implementation
                 right:=nil;
              end;
             for i:=1 to levelcount do
-             symtablestack:=symtablestack^.next;
-            _with_statement:=cwithnode.create(pwithsymtable(withsymtable),p,right,levelcount);
+             symtablestack:=symtablestack.next;
+            _with_statement:=cwithnode.create(twithsymtable(withsymtable),p,right,levelcount);
           end
          else
           begin
@@ -518,12 +509,12 @@ implementation
          p_try_block,p_finally_block,first,last,
          p_default,p_specific,hp : tnode;
          ot : ttype;
-         sym : pvarsym;
+         sym : tvarsym;
          old_block_type : tblock_type;
-         exceptsymtable : psymtable;
+         exceptsymtable : tsymtable;
          objname,objrealname : stringid;
-         srsym : psym;
-         srsymtable : psymtable;
+         srsym : tsym;
+         srsymtable : tsymtable;
 
       begin
          procinfo^.flags:=procinfo^.flags or pi_uses_exceptions;
@@ -584,24 +575,24 @@ implementation
                           if try_to_consume(_COLON) then
                             begin
                                consume_sym(srsym,srsymtable);
-                               if (srsym^.typ=typesym) and
-                                  is_class(ptypesym(srsym)^.restype.def) then
+                               if (srsym.typ=typesym) and
+                                  is_class(ttypesym(srsym).restype.def) then
                                  begin
-                                    ot:=ptypesym(srsym)^.restype;
-                                    sym:=new(pvarsym,init(objrealname,ot));
+                                    ot:=ttypesym(srsym).restype;
+                                    sym:=tvarsym.create(objrealname,ot);
                                  end
                                else
                                  begin
-                                    sym:=new(pvarsym,init(objrealname,generrortype));
-                                    if (srsym^.typ=typesym) then
-                                      Message1(type_e_class_type_expected,ptypesym(srsym)^.restype.def^.typename)
+                                    sym:=tvarsym.create(objrealname,generrortype);
+                                    if (srsym.typ=typesym) then
+                                      Message1(type_e_class_type_expected,ttypesym(srsym).restype.def.typename)
                                     else
-                                      Message1(type_e_class_type_expected,ot.def^.typename);
+                                      Message1(type_e_class_type_expected,ot.def.typename);
                                  end;
-                               exceptsymtable:=new(pstoredsymtable,init(stt_exceptsymtable));
-                               exceptsymtable^.insert(sym);
+                               exceptsymtable:=tstt_exceptsymtable.create;
+                               exceptsymtable.insert(sym);
                                { insert the exception symtable stack }
-                               exceptsymtable^.next:=symtablestack;
+                               exceptsymtable.next:=symtablestack;
                                symtablestack:=exceptsymtable;
                             end
                           else
@@ -614,10 +605,10 @@ implementation
                                   srsym:=generrorsym;
                                 end;
                                { support unit.identifier }
-                               if srsym^.typ=unitsym then
+                               if srsym.typ=unitsym then
                                  begin
                                     consume(_POINT);
-                                    srsym:=searchsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
+                                    srsym:=searchsymonlyin(tunitsym(srsym).unitsymtable,pattern);
                                     if srsym=nil then
                                      begin
                                        identifier_not_found(orgpattern);
@@ -627,16 +618,16 @@ implementation
                                  end;
                                { check if type is valid, must be done here because
                                  with "e: Exception" the e is not necessary }
-                               if (srsym^.typ=typesym) and
-                                  is_class(ptypesym(srsym)^.restype.def) then
-                                 ot:=ptypesym(srsym)^.restype
+                               if (srsym.typ=typesym) and
+                                  is_class(ttypesym(srsym).restype.def) then
+                                 ot:=ttypesym(srsym).restype
                                else
                                  begin
                                     ot:=generrortype;
-                                    if (srsym^.typ=typesym) then
-                                      Message1(type_e_class_type_expected,ptypesym(srsym)^.restype.def^.typename)
+                                    if (srsym.typ=typesym) then
+                                      Message1(type_e_class_type_expected,ttypesym(srsym).restype.def.typename)
                                     else
-                                      Message1(type_e_class_type_expected,ot.def^.typename);
+                                      Message1(type_e_class_type_expected,ot.def.typename);
                                  end;
                                exceptsymtable:=nil;
                             end;
@@ -645,7 +636,7 @@ implementation
                        consume(_ID);
                      consume(_DO);
                      hp:=connode.create(nil,statement);
-                     if ot.def^.deftype=errordef then
+                     if ot.def.deftype=errordef then
                        begin
                           hp.free;
                           hp:=cerrornode.create;
@@ -665,7 +656,7 @@ implementation
                      { that last and hp are errornodes (JM)                            }
                      if last.nodetype = onn then
                        begin
-                         tonnode(last).excepttype:=pobjectdef(ot.def);
+                         tonnode(last).excepttype:=tobjectdef(ot.def);
                          tonnode(last).exceptsymtable:=exceptsymtable;
                        end;
                      { remove exception symtable }
@@ -673,7 +664,7 @@ implementation
                        begin
                          dellexlevel;
                          if last.nodetype <> onn then
-                           dispose(exceptsymtable,done);
+                           exceptsymtable.free;
                        end;
                      if not try_to_consume(_SEMICOLON) then
                         break;
@@ -748,11 +739,11 @@ implementation
              begin
                if not target_asm.allowdirect then
                  Message(parser_f_direct_assembler_not_allowed);
-               if (pocall_inline in aktprocsym^.definition^.proccalloptions) then
+               if (pocall_inline in aktprocsym.definition.proccalloptions) then
                  Begin
                     Message1(parser_w_not_supported_for_inline,'direct asm');
                     Message(parser_w_inlining_disabled);
-                    exclude(aktprocsym^.definition^.proccalloptions,pocall_inline);
+                    exclude(aktprocsym.definition.proccalloptions,pocall_inline);
                  End;
                asmstat:=tasmnode(ra386dir.assemble);
              end;
@@ -839,8 +830,8 @@ implementation
         p,p2     : tnode;
         again    : boolean; { dummy for do_proc_call }
         destructorname : stringid;
-        sym      : psym;
-        classh   : pobjectdef;
+        sym      : tsym;
+        classh   : tobjectdef;
         destructorpos,
         storepos : tfileposinfo;
         is_new   : boolean;
@@ -867,9 +858,9 @@ implementation
             destructorpos:=akttokenpos;
             consume(_ID);
 
-            if (p.resulttype.def^.deftype<>pointerdef) then
+            if (p.resulttype.def.deftype<>pointerdef) then
               begin
-                 Message1(type_e_pointer_type_expected,p.resulttype.def^.typename);
+                 Message1(type_e_pointer_type_expected,p.resulttype.def.typename);
                  p.free;
                  p:=factor(false);
                  p.free;
@@ -878,7 +869,7 @@ implementation
                  exit;
               end;
             { first parameter must be an object or class }
-            if ppointerdef(p.resulttype.def)^.pointertype.def^.deftype<>objectdef then
+            if tpointerdef(p.resulttype.def).pointertype.def.deftype<>objectdef then
               begin
                  Message(parser_e_pointer_to_class_expected);
                  p.free;
@@ -888,7 +879,7 @@ implementation
                  exit;
               end;
             { check, if the first parameter is a pointer to a _class_ }
-            classh:=pobjectdef(ppointerdef(p.resulttype.def)^.pointertype.def);
+            classh:=tobjectdef(tpointerdef(p.resulttype.def).pointertype.def);
             if is_class(classh) then
               begin
                  Message(parser_e_no_new_or_dispose_for_classes);
@@ -905,7 +896,7 @@ implementation
 
             { the second parameter of new/dispose must be a call }
             { to a cons-/destructor                              }
-            if (not assigned(sym)) or (sym^.typ<>procsym) then
+            if (not assigned(sym)) or (sym.typ<>procsym) then
               begin
                  if is_new then
                   Message(parser_e_expr_have_to_be_constructor_call)
@@ -921,7 +912,7 @@ implementation
                 else
                  p2:=chdisposenode.create(p);
                 do_resulttypepass(p2);
-                p2.resulttype:=ppointerdef(p.resulttype.def)^.pointertype;
+                p2.resulttype:=tpointerdef(p.resulttype.def).pointertype;
                 if is_new then
                   do_member_read(false,sym,p2,again)
                 else
@@ -930,7 +921,7 @@ implementation
                       do_member_read(false,sym,p2,again)
                     else
                       begin
-                        p2:=ccallnode.create(nil,pprocsym(sym),sym^.owner,p2);
+                        p2:=ccallnode.create(nil,tprocsym(sym),sym.owner,p2);
                         { support dispose(p,done()); }
                         if try_to_consume(_LKLAMMER) then
                           begin
@@ -951,7 +942,7 @@ implementation
                  begin
                    if is_new then
                     begin
-                      if (tcallnode(p2).procdefinition^.proctypeoption<>potype_constructor) then
+                      if (tcallnode(p2).procdefinition.proctypeoption<>potype_constructor) then
                         Message(parser_e_expr_have_to_be_constructor_call);
                       p2:=cnewnode.create(p2);
                       do_resulttypepass(p2);
@@ -960,7 +951,7 @@ implementation
                     end
                    else
                     begin
-                      if (tcallnode(p2).procdefinition^.proctypeoption<>potype_destructor) then
+                      if (tcallnode(p2).procdefinition.proctypeoption<>potype_destructor) then
                         Message(parser_e_expr_have_to_be_destructor_call);
                     end;
                  end;
@@ -969,18 +960,18 @@ implementation
           end
         else
           begin
-             if (p.resulttype.def^.deftype<>pointerdef) then
+             if (p.resulttype.def.deftype<>pointerdef) then
                Begin
-                  Message1(type_e_pointer_type_expected,p.resulttype.def^.typename);
+                  Message1(type_e_pointer_type_expected,p.resulttype.def.typename);
                   new_dispose_statement:=cerrornode.create;
                end
              else
                begin
-                  if (ppointerdef(p.resulttype.def)^.pointertype.def^.deftype=objectdef) and
-                     (oo_has_vmt in pobjectdef(ppointerdef(p.resulttype.def)^.pointertype.def)^.objectoptions) then
+                  if (tpointerdef(p.resulttype.def).pointertype.def.deftype=objectdef) and
+                     (oo_has_vmt in tobjectdef(tpointerdef(p.resulttype.def).pointertype.def).objectoptions) then
                     Message(parser_w_use_extended_syntax_for_objects);
-                  if (ppointerdef(p.resulttype.def)^.pointertype.def^.deftype=orddef) and
-                     (porddef(ppointerdef(p.resulttype.def)^.pointertype.def)^.typ=uvoid) then
+                  if (tpointerdef(p.resulttype.def).pointertype.def.deftype=orddef) and
+                     (torddef(tpointerdef(p.resulttype.def).pointertype.def).typ=uvoid) then
                     begin
                       if (m_tp in aktmodeswitches) or
                          (m_delphi in aktmodeswitches) then
@@ -1004,8 +995,8 @@ implementation
          p       : tnode;
          code    : tnode;
          filepos : tfileposinfo;
-         srsym   : psym;
-         srsymtable : psymtable;
+         srsym   : tsym;
+         srsymtable : tsymtable;
       begin
          filepos:=akttokenpos;
          case token of
@@ -1022,17 +1013,17 @@ implementation
                 else
                   begin
                      consume_sym(srsym,srsymtable);
-                     if srsym^.typ<>labelsym then
+                     if srsym.typ<>labelsym then
                        begin
                           Message(sym_e_id_is_no_label_id);
                           code:=cerrornode.create;
                        end
                      else
                        begin
-                         code:=cgotonode.create(plabelsym(srsym)^.lab);
-                         tgotonode(code).labsym:=plabelsym(srsym);
+                         code:=cgotonode.create(tlabelsym(srsym).lab);
+                         tgotonode(code).labsym:=tlabelsym(srsym);
                          { set flag that this label is used }
-                         plabelsym(srsym)^.used:=true;
+                         tlabelsym(srsym).used:=true;
                        end;
                   end;
              end;
@@ -1065,7 +1056,7 @@ implementation
              code:=cnothingnode.create;
            _FAIL :
              begin
-                if (aktprocsym^.definition^.proctypeoption<>potype_constructor) then
+                if (aktprocsym.definition.proctypeoption<>potype_constructor) then
                   Message(parser_e_fail_only_in_constructor);
                 consume(_FAIL);
                 code:=cfailnode.create;
@@ -1163,8 +1154,8 @@ implementation
 
       begin
          { temporary space is set, while the BEGIN of the procedure }
-         if symtablestack^.symtabletype=localsymtable then
-           procinfo^.firsttemp_offset := -symtablestack^.datasize
+         if symtablestack.symtabletype=localsymtable then
+           procinfo^.firsttemp_offset := -symtablestack.datasize
          else
            procinfo^.firsttemp_offset := 0;
 
@@ -1175,7 +1166,7 @@ implementation
               if ret_in_acc(procinfo^.returntype.def) then
                 begin
                    { in assembler code the result should be directly in %eax
-                   procinfo^.retoffset:=procinfo^.firsttemp-procinfo^.retdef^.size;
+                   procinfo^.retoffset:=procinfo^.firsttemp-procinfo^.retdef.size;
                    procinfo^.firsttemp:=procinfo^.retoffset;                 }
 
 {$ifndef newcg}
@@ -1201,14 +1192,14 @@ implementation
            { at -8(%ebp) (JM)                                      }
            { why if se use %esp then self is still at the correct address PM }
            if {not(assigned(procinfo^._class)) and}
-              (po_assembler in aktprocsym^.definition^.procoptions) and
-              (aktprocsym^.definition^.localst^.datasize=0) and
-              (aktprocsym^.definition^.parast^.datasize=0) and
-              not(ret_in_param(aktprocsym^.definition^.rettype.def)) then
+              (po_assembler in aktprocsym.definition.procoptions) and
+              (aktprocsym.definition.localst.datasize=0) and
+              (aktprocsym.definition.parast.datasize=0) and
+              not(ret_in_param(aktprocsym.definition.rettype.def)) then
              begin
                procinfo^.framepointer:=stack_pointer;
                { set the right value for parameters }
-               dec(aktprocsym^.definition^.parast^.address_fixup,target_os.size_of_pointer);
+               dec(aktprocsym.definition.parast.address_fixup,target_os.size_of_pointer);
                dec(procinfo^.para_offset,target_os.size_of_pointer);
              end;
           { force the asm statement }
@@ -1224,7 +1215,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.23  2001-04-04 22:43:52  peter
+  Revision 1.24  2001-04-13 01:22:13  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.23  2001/04/04 22:43:52  peter
     * remove unnecessary calls to firstpass
 
   Revision 1.22  2001/04/02 21:20:34  peter

compiler/psub.pas

@@ -26,9 +26,6 @@ unit psub;
 
 interface
 
-    uses
-       cobjects;
-
     procedure compile_proc_body(make_global,parent_has_class:boolean);
 
     { reads the declaration blocks }
@@ -42,14 +39,14 @@ implementation
 
     uses
        { common }
-       cutils,
+       cutils,cclasses,
        { global }
        globtype,globals,tokens,verbose,
        systems,
        { aasm }
        cpubase,aasm,
        { symtable }
-       symconst,symbase,symtype,symdef,symsym,symtable,types,
+       symconst,symbase,symdef,symsym,symtable,types,
        ppu,fmodule,
        { pass 1 }
        node,
@@ -87,16 +84,16 @@ implementation
 
     function block(islibrary : boolean) : tnode;
       var
-         funcretsym : pfuncretsym;
+         funcretsym : tfuncretsym;
          storepos : tfileposinfo;
       begin
          { do we have an assembler block without the po_assembler?
            we should allow this for Delphi compatibility (PFV) }
          if (token=_ASM) and (m_delphi in aktmodeswitches) then
-          include(aktprocsym^.definition^.procoptions,po_assembler);
+          include(aktprocsym.definition.procoptions,po_assembler);
 
          { Handle assembler block different }
-         if (po_assembler in aktprocsym^.definition^.procoptions) then
+         if (po_assembler in aktprocsym.definition.procoptions) then
           begin
             read_declarations(false);
             block:=assembler_block;
@@ -108,26 +105,26 @@ implementation
               { if the current is a function aktprocsym is non nil }
               { and there is a local symtable set }
               storepos:=akttokenpos;
-              akttokenpos:=aktprocsym^.fileinfo;
-              funcretsym:=new(pfuncretsym,init(aktprocsym^.name,procinfo));
+              akttokenpos:=aktprocsym.fileinfo;
+              funcretsym:=tfuncretsym.create(aktprocsym.name,procinfo);
               { insert in local symtable }
-              symtablestack^.insert(funcretsym);
+              symtablestack.insert(funcretsym);
               akttokenpos:=storepos;
-              if ret_in_acc(procinfo^.returntype.def) or (procinfo^.returntype.def^.deftype=floatdef) then
-                procinfo^.return_offset:=-funcretsym^.address;
+              if ret_in_acc(procinfo^.returntype.def) or (procinfo^.returntype.def.deftype=floatdef) then
+                procinfo^.return_offset:=-funcretsym.address;
               procinfo^.funcretsym:=funcretsym;
               { insert result also if support is on }
               if (m_result in aktmodeswitches) then
                begin
-                 procinfo^.resultfuncretsym:=new(pfuncretsym,init('RESULT',procinfo));
-                 symtablestack^.insert(procinfo^.resultfuncretsym);
+                 procinfo^.resultfuncretsym:=tfuncretsym.create('RESULT',procinfo);
+                 symtablestack.insert(procinfo^.resultfuncretsym);
                end;
            end;
          read_declarations(islibrary);
 
          { temporary space is set, while the BEGIN of the procedure }
-         if (symtablestack^.symtabletype=localsymtable) then
-           procinfo^.firsttemp_offset := -symtablestack^.datasize
+         if (symtablestack.symtabletype=localsymtable) then
+           procinfo^.firsttemp_offset := -symtablestack.datasize
          else
            procinfo^.firsttemp_offset := 0;
 
@@ -137,13 +134,13 @@ implementation
          { because we don't know yet where the address is }
          if not is_void(procinfo^.returntype.def) then
            begin
-              if ret_in_acc(procinfo^.returntype.def) or (procinfo^.returntype.def^.deftype=floatdef) then
+              if ret_in_acc(procinfo^.returntype.def) or (procinfo^.returntype.def.deftype=floatdef) then
                 begin
                    { the space has been set in the local symtable }
-                   procinfo^.return_offset:=-funcretsym^.address;
+                   procinfo^.return_offset:=-funcretsym.address;
                    if ((procinfo^.flags and pi_operator)<>0) and
-                      assigned(opsym) then
-                     opsym^.address:=-procinfo^.return_offset;
+                      assigned(otsym) then
+                     otsym.address:=-procinfo^.return_offset;
                    { eax is modified by a function }
 {$ifndef newcg}
 {$ifdef i386}
@@ -216,9 +213,9 @@ implementation
         Compile the body of a procedure
       }
       var
-         oldexitlabel,oldexit2label : pasmlabel;
-         oldfaillabel,oldquickexitlabel:Pasmlabel;
-         _class,hp:Pobjectdef;
+         oldexitlabel,oldexit2label : tasmlabel;
+         oldfaillabel,oldquickexitlabel:tasmlabel;
+         _class,hp:tobjectdef;
          { switches can change inside the procedure }
          entryswitches, exitswitches : tlocalswitches;
          oldaktmaxfpuregisters,localmaxfpuregisters : longint;
@@ -241,7 +238,7 @@ implementation
           Message(parser_e_too_much_lexlevel);
 
          { static is also important for local procedures !! }
-         if (po_staticmethod in aktprocsym^.definition^.procoptions) then
+         if (po_staticmethod in aktprocsym.definition.procoptions) then
            allow_only_static:=true
          else if (lexlevel=normal_function_level) then
            allow_only_static:=false;
@@ -255,7 +252,7 @@ implementation
          getlabel(aktexitlabel);
          getlabel(aktexit2label);
          { exit for fail in constructors }
-         if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
+         if (aktprocsym.definition.proctypeoption=potype_constructor) then
            begin
              getlabel(faillabel);
              getlabel(quickexitlabel);
@@ -272,11 +269,11 @@ implementation
              hp:=nil;
              repeat
                _class:=procinfo^._class;
-               while _class^.childof<>hp do
-                 _class:=_class^.childof;
+               while _class.childof<>hp do
+                 _class:=_class.childof;
                hp:=_class;
-               _class^.symtable^.next:=symtablestack;
-               symtablestack:=_class^.symtable;
+               _class.symtable.next:=symtablestack;
+               symtablestack:=_class.symtable;
              until hp=procinfo^._class;
            end;
 
@@ -285,14 +282,14 @@ implementation
            for checking of same names used in interface and implementation !! }
          if lexlevel>=normal_function_level then
            begin
-              aktprocsym^.definition^.parast^.next:=symtablestack;
-              symtablestack:=aktprocsym^.definition^.parast;
-              symtablestack^.symtablelevel:=lexlevel;
+              aktprocsym.definition.parast.next:=symtablestack;
+              symtablestack:=aktprocsym.definition.parast;
+              symtablestack.symtablelevel:=lexlevel;
            end;
          { insert localsymtable in symtablestack}
-         aktprocsym^.definition^.localst^.next:=symtablestack;
-         symtablestack:=aktprocsym^.definition^.localst;
-         symtablestack^.symtablelevel:=lexlevel;
+         aktprocsym.definition.localst.next:=symtablestack;
+         symtablestack:=aktprocsym.definition.localst;
+         symtablestack.symtablelevel:=lexlevel;
          { constant symbols are inserted in this symboltable }
          constsymtable:=symtablestack;
 
@@ -347,10 +344,10 @@ implementation
 
          if assigned(code) then
            begin
-              aktprocsym^.definition^.code:=code;
+              aktprocsym.definition.code:=code;
 
               { the procedure is now defined }
-              aktprocsym^.definition^.forwarddef:=false;
+              aktprocsym.definition.forwarddef:=false;
            end;
 
 {$ifdef newcg}
@@ -386,9 +383,9 @@ implementation
 {$endif newcg}
              { now all the registers used are known }
 {$ifdef newcg}
-             aktprocsym^.definition^.usedregisters:=tg.usedinproc;
+             aktprocsym.definition.usedregisters:=tg.usedinproc;
 {$else newcg}
-             aktprocsym^.definition^.usedregisters:=usedinproc;
+             aktprocsym.definition.usedregisters:=usedinproc;
 {$endif newcg}
              procinfo^.aktproccode.insertlist(procinfo^.aktentrycode);
              procinfo^.aktproccode.concatlist(procinfo^.aktexitcode);
@@ -415,19 +412,16 @@ implementation
              { add the procedure to the codesegment }
              codeSegment.concatlist(procinfo^.aktproccode);
            end;
-{$else NOPASS2}
-         if assigned(code) then
-          firstpass(code);
 {$endif NOPASS2}
 
          { ... remove symbol tables, for the browser leave the static table }
-      {    if (cs_browser in aktmoduleswitches) and (symtablestack^.symtabletype=staticsymtable) then
-          symtablestack^.next:=symtablestack^.next^.next
+      {    if (cs_browser in aktmoduleswitches) and (symtablestack.symtabletype=staticsymtable) then
+          symtablestack.next:=symtablestack.next^.next
          else }
          if lexlevel>=normal_function_level then
-           symtablestack:=symtablestack^.next^.next
+           symtablestack:=symtablestack.next.next
          else
-           symtablestack:=symtablestack^.next;
+           symtablestack:=symtablestack.next;
 
          { ... check for unused symbols      }
          { but only if there is no asm block }
@@ -435,17 +429,17 @@ implementation
            begin
              if (Errorcount=0) then
                begin
-                 pstoredsymtable(aktprocsym^.definition^.localst)^.check_forwards;
-                 pstoredsymtable(aktprocsym^.definition^.localst)^.checklabels;
+                 tstoredsymtable(aktprocsym.definition.localst).check_forwards;
+                 tstoredsymtable(aktprocsym.definition.localst).checklabels;
                end;
              if (procinfo^.flags and pi_uses_asm)=0 then
                begin
                   { not for unit init, becuase the var can be used in finalize,
                     it will be done in proc_unit }
-                  if not(aktprocsym^.definition^.proctypeoption
+                  if not(aktprocsym.definition.proctypeoption
                      in [potype_proginit,potype_unitinit,potype_unitfinalize]) then
-                     pstoredsymtable(aktprocsym^.definition^.localst)^.allsymbolsused;
-                  pstoredsymtable(aktprocsym^.definition^.parast)^.allsymbolsused;
+                     tstoredsymtable(aktprocsym.definition.localst).allsymbolsused;
+                  tstoredsymtable(aktprocsym.definition.parast).allsymbolsused;
                end;
            end;
 
@@ -457,11 +451,11 @@ implementation
          { so no dispose here !!                              }
          if assigned(code) and
             not(cs_browser in aktmoduleswitches) and
-            not(pocall_inline in aktprocsym^.definition^.proccalloptions) then
+            not(pocall_inline in aktprocsym.definition.proccalloptions) then
            begin
              if lexlevel>=normal_function_level then
-               dispose(aktprocsym^.definition^.localst,done);
-             aktprocsym^.definition^.localst:=nil;
+               aktprocsym.definition.localst.free;
+             aktprocsym.definition.localst:=nil;
            end;
 
 {$ifdef newcg}
@@ -477,12 +471,12 @@ implementation
 {$endif newcg}
 
          { remove code tree, if not inline procedure }
-         if assigned(code) and not(pocall_inline in aktprocsym^.definition^.proccalloptions) then
+         if assigned(code) and not(pocall_inline in aktprocsym.definition.proccalloptions) then
            code.free;
 
          { remove class member symbol tables }
-         while symtablestack^.symtabletype=objectsymtable do
-           symtablestack:=symtablestack^.next;
+         while symtablestack.symtabletype=objectsymtable do
+           symtablestack:=symtablestack.next;
 
          aktmaxfpuregisters:=oldaktmaxfpuregisters;
 
@@ -506,24 +500,24 @@ implementation
                         PROCEDURE/FUNCTION PARSING
 ****************************************************************************}
 
-      procedure checkvaluepara(p:pnamedindexobject);
+    procedure checkvaluepara(p:tnamedindexitem);
       var
-        vs : pvarsym;
+        vs : tvarsym;
         s  : string;
       begin
-        with pvarsym(p)^ do
+        with tvarsym(p) do
          begin
            if copy(name,1,3)='val' then
             begin
               s:=Copy(name,4,255);
-              if not(po_assembler in aktprocsym^.definition^.procoptions) then
+              if not(po_assembler in aktprocsym.definition.procoptions) then
                begin
-                 vs:=new(Pvarsym,init(s,vartype));
-                 vs^.fileinfo:=fileinfo;
-                 vs^.varspez:=varspez;
-                 aktprocsym^.definition^.localst^.insert(vs);
-                 include(vs^.varoptions,vo_is_local_copy);
-                 vs^.varstate:=vs_assigned;
+                 vs:=tvarsym.create(s,vartype);
+                 vs.fileinfo:=fileinfo;
+                 vs.varspez:=varspez;
+                 aktprocsym.definition.localst.insert(vs);
+                 include(vs.varoptions,vo_is_local_copy);
+                 vs.varstate:=vs_assigned;
                  localvarsym:=vs;
                  inc(refs); { the para was used to set the local copy ! }
                  { warnings only on local copy ! }
@@ -531,7 +525,7 @@ implementation
                end
               else
                begin
-                 aktprocsym^.definition^.parast^.rename(name,s);
+                 aktprocsym.definition.parast.rename(name,s);
                end;
             end;
          end;
@@ -545,12 +539,12 @@ implementation
       }
       var
         oldprefix     : string;
-        oldprocsym       : Pprocsym;
+        oldprocsym       : tprocsym;
         oldprocinfo      : pprocinfo;
-        oldconstsymtable : Psymtable;
+        oldconstsymtable : tsymtable;
         oldfilepos       : tfileposinfo;
         pdflags         : word;
-        prevdef,stdef   : pprocdef;
+        prevdef,stdef   : tprocdef;
       begin
       { save old state }
          oldprocsym:=aktprocsym;
@@ -576,15 +570,15 @@ implementation
          parse_proc_dec;
 
          procinfo^.sym:=aktprocsym;
-         procinfo^.def:=aktprocsym^.definition;
+         procinfo^.def:=aktprocsym.definition;
 
       { set the default function options }
          if parse_only then
           begin
-            aktprocsym^.definition^.forwarddef:=true;
+            aktprocsym.definition.forwarddef:=true;
             { set also the interface flag, for better error message when the
               implementation doesn't much this header }
-            aktprocsym^.definition^.interfacedef:=true;
+            aktprocsym.definition.interfacedef:=true;
             pdflags:=pd_interface;
           end
          else
@@ -595,7 +589,7 @@ implementation
             if (not current_module.is_unit) or (cs_create_smart in aktmoduleswitches) then
              pdflags:=pdflags or pd_global;
             procinfo^.exported:=false;
-            aktprocsym^.definition^.forwarddef:=false;
+            aktprocsym.definition.forwarddef:=false;
           end;
 
       { parse the directives that may follow }
@@ -605,7 +599,7 @@ implementation
 
       { set aktfilepos to the beginning of the function declaration }
          oldfilepos:=aktfilepos;
-         aktfilepos:=aktprocsym^.definition^.fileinfo;
+         aktfilepos:=aktprocsym.definition.fileinfo;
 
       { search for forward declarations }
          if not check_identical_proc(prevdef) then
@@ -614,22 +608,22 @@ implementation
              if assigned(procinfo^._class) and (not assigned(oldprocinfo^._class)) then
               begin
                 Message1(parser_e_header_dont_match_any_member,
-                         aktprocsym^.definition^.fullprocname);
-                aktprocsym^.write_parameter_lists(aktprocsym^.definition);
+                         aktprocsym.definition.fullprocname);
+                aktprocsym.write_parameter_lists(aktprocsym.definition);
               end
              else
               begin
                 { Give a better error if there is a forward def in the interface and only
                   a single implementation }
-                if (not aktprocsym^.definition^.forwarddef) and
-                   assigned(aktprocsym^.definition^.nextoverloaded) and
-                   aktprocsym^.definition^.nextoverloaded^.forwarddef and
-                   aktprocsym^.definition^.nextoverloaded^.interfacedef and
-                   not(assigned(aktprocsym^.definition^.nextoverloaded^.nextoverloaded)) then
+                if (not aktprocsym.definition.forwarddef) and
+                   assigned(aktprocsym.definition.nextoverloaded) and
+                   aktprocsym.definition.nextoverloaded.forwarddef and
+                   aktprocsym.definition.nextoverloaded.interfacedef and
+                   not(assigned(aktprocsym.definition.nextoverloaded.nextoverloaded)) then
                  begin
                    Message1(parser_e_header_dont_match_forward,
-                            aktprocsym^.definition^.fullprocname);
-                   aktprocsym^.write_parameter_lists(aktprocsym^.definition);
+                            aktprocsym.definition.fullprocname);
+                   aktprocsym.write_parameter_lists(aktprocsym.definition);
                  end
                 else
                  begin
@@ -640,12 +634,12 @@ implementation
               end;
            end;
 
-         { set return type here, becuase the aktprocsym^.definition can be
+         { set return type here, becuase the aktprocsym.definition can be
            changed by check_identical_proc (PFV) }
-         procinfo^.returntype.def:=aktprocsym^.definition^.rettype.def;
+         procinfo^.returntype.def:=aktprocsym.definition.rettype.def;
 
 {$ifdef i386}
-         if (po_interrupt in aktprocsym^.definition^.procoptions) then
+         if (po_interrupt in aktprocsym.definition.procoptions) then
            begin
              { we push Flags and CS as long
                to cope with the IRETD
@@ -661,13 +655,13 @@ implementation
             inc(procinfo^.para_offset,target_os.size_of_pointer);
           end;
          { allows to access the parameters of main functions in nested functions }
-         aktprocsym^.definition^.parast^.address_fixup:=procinfo^.para_offset;
+         aktprocsym.definition.parast.address_fixup:=procinfo^.para_offset;
 
          { when it is a value para and it needs a local copy then rename
            the parameter and insert a copy in the localst. This is not done
            for assembler procedures }
-         if (not parse_only) and (not aktprocsym^.definition^.forwarddef) then
-           aktprocsym^.definition^.parast^.foreach({$ifdef FPCPROCVAR}@{$endif}checkvaluepara);
+         if (not parse_only) and (not aktprocsym.definition.forwarddef) then
+           aktprocsym.definition.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}checkvaluepara);
 
       { restore file pos }
          aktfilepos:=oldfilepos;
@@ -676,20 +670,20 @@ implementation
          if (pdflags and pd_body)<>0 then
            begin
              Message1(parser_p_procedure_start,
-                      aktprocsym^.definition^.fullprocname);
-             aktprocsym^.definition^.aliasnames.insert(aktprocsym^.definition^.mangledname);
+                      aktprocsym.definition.fullprocname);
+             aktprocsym.definition.aliasnames.insert(aktprocsym.definition.mangledname);
             { set _FAIL as keyword if constructor }
-            if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
+            if (aktprocsym.definition.proctypeoption=potype_constructor) then
               tokeninfo^[_FAIL].keyword:=m_all;
-            if assigned(aktprocsym^.definition^._class) then
+            if assigned(aktprocsym.definition._class) then
               tokeninfo^[_SELF].keyword:=m_all;
 
              compile_proc_body(((pdflags and pd_global)<>0),assigned(oldprocinfo^._class));
 
             { reset _FAIL as normal }
-            if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
+            if (aktprocsym.definition.proctypeoption=potype_constructor) then
               tokeninfo^[_FAIL].keyword:=m_none;
-            if assigned(aktprocsym^.definition^._class) and (lexlevel=main_program_level) then
+            if assigned(aktprocsym.definition._class) and (lexlevel=main_program_level) then
               tokeninfo^[_SELF].keyword:=m_none;
              consume(_SEMICOLON);
            end;
@@ -699,19 +693,19 @@ implementation
          constsymtable:=oldconstsymtable;
          { from now on all refernece to mangledname means
            that the function is already used }
-         aktprocsym^.definition^.count:=true;
+         aktprocsym.definition.count:=true;
          { restore the interface order to maintain CRC values PM }
-         if assigned(prevdef) and assigned(aktprocsym^.definition^.nextoverloaded) then
+         if assigned(prevdef) and assigned(aktprocsym.definition.nextoverloaded) then
            begin
-             stdef:=aktprocsym^.definition;
-             aktprocsym^.definition:=stdef^.nextoverloaded;
-             stdef^.nextoverloaded:=prevdef^.nextoverloaded;
-             prevdef^.nextoverloaded:=stdef;
+             stdef:=aktprocsym.definition;
+             aktprocsym.definition:=stdef.nextoverloaded;
+             stdef.nextoverloaded:=prevdef.nextoverloaded;
+             prevdef.nextoverloaded:=stdef;
            end;
          aktprocsym:=oldprocsym;
          procprefix:=oldprefix;
          procinfo:=oldprocinfo;
-         opsym:=nil;
+         otsym:=nil;
       end;
 
 
@@ -724,11 +718,11 @@ implementation
         procedure Not_supported_for_inline(t : ttoken);
         begin
            if assigned(aktprocsym) and
-              (pocall_inline in aktprocsym^.definition^.proccalloptions) then
+              (pocall_inline in aktprocsym.definition.proccalloptions) then
              Begin
                 Message1(parser_w_not_supported_for_inline,tokenstring(t));
                 Message(parser_w_inlining_disabled);
-                exclude(aktprocsym^.definition^.proccalloptions,pocall_inline);
+                exclude(aktprocsym.definition.proccalloptions,pocall_inline);
              End;
         end;
 
@@ -813,7 +807,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.26  2001-04-02 21:20:34  peter
+  Revision 1.27  2001-04-13 01:22:13  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.26  2001/04/02 21:20:34  peter
     * resulttype rewrite
 
   Revision 1.25  2001/02/26 19:44:53  peter

compiler/psystem.pas

@@ -28,8 +28,8 @@ interface
 uses
   symbase;
 
-procedure insertinternsyms(p : psymtable);
-procedure insert_intern_types(p : psymtable);
+procedure insertinternsyms(p : tsymtable);
+procedure insert_intern_types(p : tsymtable);
 
 procedure readconstdefs;
 procedure createconstdefs;
@@ -42,65 +42,65 @@ uses
   symconst,symtype,symsym,symdef,symtable,
   ninl;
 
-procedure insertinternsyms(p : psymtable);
+procedure insertinternsyms(p : tsymtable);
 {
   all intern procedures for the system unit
 }
 begin
-  p^.insert(new(psyssym,init('Concat',in_concat_x)));
-  p^.insert(new(psyssym,init('Write',in_write_x)));
-  p^.insert(new(psyssym,init('WriteLn',in_writeln_x)));
-  p^.insert(new(psyssym,init('Assigned',in_assigned_x)));
-  p^.insert(new(psyssym,init('Read',in_read_x)));
-  p^.insert(new(psyssym,init('ReadLn',in_readln_x)));
-  p^.insert(new(psyssym,init('Ofs',in_ofs_x)));
-  p^.insert(new(psyssym,init('SizeOf',in_sizeof_x)));
-  p^.insert(new(psyssym,init('TypeOf',in_typeof_x)));
-  p^.insert(new(psyssym,init('Low',in_low_x)));
-  p^.insert(new(psyssym,init('High',in_high_x)));
-  p^.insert(new(psyssym,init('Seg',in_seg_x)));
-  p^.insert(new(psyssym,init('Ord',in_ord_x)));
-  p^.insert(new(psyssym,init('Pred',in_pred_x)));
-  p^.insert(new(psyssym,init('Succ',in_succ_x)));
-  p^.insert(new(psyssym,init('Exclude',in_exclude_x_y)));
-  p^.insert(new(psyssym,init('Include',in_include_x_y)));
-  p^.insert(new(psyssym,init('Break',in_break)));
-  p^.insert(new(psyssym,init('Continue',in_continue)));
-  p^.insert(new(psyssym,init('Dec',in_dec_x)));
-  p^.insert(new(psyssym,init('Inc',in_inc_x)));
-  p^.insert(new(psyssym,init('Str',in_str_x_string)));
-  p^.insert(new(psyssym,init('Assert',in_assert_x_y)));
-  p^.insert(new(psyssym,init('Val',in_val_x)));
-  p^.insert(new(psyssym,init('Addr',in_addr_x)));
-  p^.insert(new(psyssym,init('TypeInfo',in_typeinfo_x)));
-  p^.insert(new(psyssym,init('SetLength',in_setlength_x)));
-  p^.insert(new(psyssym,init('Finalize',in_finalize_x)));
+  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('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('Continue',in_continue));
+  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('Finalize',in_finalize_x));
 end;
 
 
-procedure insert_intern_types(p : psymtable);
+procedure insert_intern_types(p : tsymtable);
 {
   all the types inserted into the system unit
 }
 
   procedure addtype(const s:string;const t:ttype);
   begin
-    p^.insert(new(ptypesym,init(s,t)));
+    p.insert(ttypesym.create(s,t));
   end;
 
-  procedure adddef(const s:string;def:pdef);
+  procedure adddef(const s:string;def:tdef);
   var
     t : ttype;
   begin
     t.setdef(def);
-    p^.insert(new(ptypesym,init(s,t)));
+    p.insert(ttypesym.create(s,t));
   end;
 
 var
   { several defs to simulate more or less C++ objects for GDB }
   vmttype,
   vmtarraytype : ttype;
-  vmtsymtable  : psymtable;
+  vmtsymtable  : tsymtable;
 begin
 { Internal types }
   addtype('$formal',cformaltype);
@@ -130,19 +130,19 @@ begin
   addtype('$s80real',s80floattype);
   { Add a type for virtual method tables in lowercase }
   { so it isn't reachable!                            }
-  vmtsymtable:=new(pstoredsymtable,init(recordsymtable));
-  vmttype.setdef(new(precorddef,init(vmtsymtable)));
-  pvmttype.setdef(new(ppointerdef,init(vmttype)));
-  vmtsymtable^.insert(new(pvarsym,init('$parent',pvmttype)));
-  vmtsymtable^.insert(new(pvarsym,init('$length',s32bittype)));
-  vmtsymtable^.insert(new(pvarsym,init('$mlength',s32bittype)));
-  vmtarraytype.setdef(new(parraydef,init(0,1,s32bittype)));
-  parraydef(vmtarraytype.def)^.elementtype:=voidpointertype;
-  vmtsymtable^.insert(new(pvarsym,init('$__pfn',vmtarraytype)));
+  vmtsymtable:=trecordsymtable.create;
+  vmttype.setdef(trecorddef.create(vmtsymtable));
+  pvmttype.setdef(tpointerdef.create(vmttype));
+  vmtsymtable.insert(tvarsym.create('$parent',pvmttype));
+  vmtsymtable.insert(tvarsym.create('$length',s32bittype));
+  vmtsymtable.insert(tvarsym.create('$mlength',s32bittype));
+  vmtarraytype.setdef(tarraydef.create(0,1,s32bittype));
+  tarraydef(vmtarraytype.def).elementtype:=voidpointertype;
+  vmtsymtable.insert(tvarsym.create('$__pfn',vmtarraytype));
   addtype('$__vtbl_ptr_type',vmttype);
   addtype('$pvmt',pvmttype);
-  vmtarraytype.setdef(new(parraydef,init(0,1,s32bittype)));
-  parraydef(vmtarraytype.def)^.elementtype:=pvmttype;
+  vmtarraytype.setdef(tarraydef.create(0,1,s32bittype));
+  tarraydef(vmtarraytype.def).elementtype:=pvmttype;
   addtype('$vtblarray',vmtarraytype);
 { Add functions that require compiler magic }
   insertinternsyms(p);
@@ -152,7 +152,7 @@ begin
   addtype('Extended',s80floattype);
   addtype('Real',s64floattype);
 {$ifdef i386}
-  adddef('Comp',new(pfloatdef,init(s64comp)));
+  adddef('Comp',tfloatdef.create(s64comp));
 {$endif}
   addtype('Pointer',voidpointertype);
   addtype('FarPointer',voidfarpointertype);
@@ -162,15 +162,15 @@ begin
   addtype('WideString',cwidestringtype);
   addtype('Boolean',booltype);
   addtype('ByteBool',booltype);
-  adddef('WordBool',new(porddef,init(bool16bit,0,1)));
-  adddef('LongBool',new(porddef,init(bool32bit,0,1)));
+  adddef('WordBool',torddef.create(bool16bit,0,1));
+  adddef('LongBool',torddef.create(bool32bit,0,1));
   addtype('Char',cchartype);
   addtype('WideChar',cwidechartype);
-  adddef('Text',new(pfiledef,inittext));
+  adddef('Text',tfiledef.createtext);
   addtype('Cardinal',u32bittype);
   addtype('QWord',cu64bittype);
   addtype('Int64',cs64bittype);
-  adddef('TypedFile',new(pfiledef,inittyped(voidtype)));
+  adddef('TypedFile',tfiledef.createtyped(voidtype));
   addtype('Variant',cvarianttype);
 end;
 
@@ -219,45 +219,45 @@ begin
   { create definitions for constants }
   oldregisterdef:=registerdef;
   registerdef:=false;
-  cformaltype.setdef(new(pformaldef,init));
-  voidtype.setdef(new(porddef,init(uvoid,0,0)));
-  u8bittype.setdef(new(porddef,init(u8bit,0,255)));
-  u16bittype.setdef(new(porddef,init(u16bit,0,65535)));
-  u32bittype.setdef(new(porddef,init(u32bit,0,longint($ffffffff))));
-  s32bittype.setdef(new(porddef,init(s32bit,longint($80000000),$7fffffff)));
-  cu64bittype.setdef(new(porddef,init(u64bit,0,0)));
-  cs64bittype.setdef(new(porddef,init(s64bit,0,0)));
-  booltype.setdef(new(porddef,init(bool8bit,0,1)));
-  cchartype.setdef(new(porddef,init(uchar,0,255)));
-  cwidechartype.setdef(new(porddef,init(uwidechar,0,65535)));
-  cshortstringtype.setdef(new(pstringdef,shortinit(255)));
+  cformaltype.setdef(tformaldef.create);
+  voidtype.setdef(torddef.create(uvoid,0,0));
+  u8bittype.setdef(torddef.create(u8bit,0,255));
+  u16bittype.setdef(torddef.create(u16bit,0,65535));
+  u32bittype.setdef(torddef.create(u32bit,0,longint($ffffffff)));
+  s32bittype.setdef(torddef.create(s32bit,longint($80000000),$7fffffff));
+  cu64bittype.setdef(torddef.create(u64bit,0,0));
+  cs64bittype.setdef(torddef.create(s64bit,0,0));
+  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(new(pstringdef,longinit(-1)));
-  cansistringtype.setdef(new(pstringdef,ansiinit(-1)));
-  cwidestringtype.setdef(new(pstringdef,wideinit(-1)));
+  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(new(pstringdef,shortinit(0)));
-  openchararraytype.setdef(new(parraydef,init(0,-1,s32bittype)));
-  parraydef(openchararraytype.def)^.elementtype:=cchartype;
+  openshortstringtype.setdef(tstringdef.createshort(0));
+  openchararraytype.setdef(tarraydef.create(0,-1,s32bittype));
+  tarraydef(openchararraytype.def).elementtype:=cchartype;
 {$ifdef i386}
-  s32floattype.setdef(new(pfloatdef,init(s32real)));
-  s64floattype.setdef(new(pfloatdef,init(s64real)));
-  s80floattype.setdef(new(pfloatdef,init(s80real)));
+  s32floattype.setdef(tfloatdef.create(s32real));
+  s64floattype.setdef(tfloatdef.create(s64real));
+  s80floattype.setdef(tfloatdef.create(s80real));
 {$endif}
 {$ifdef m68k}
-  s32floattype.setdef(new(pfloatdef,init(s32real)));
-  s64floattype.setdef(new(pfloatdef,init(s64real)));
+  s32floattype.setdef(tfloatdef.create(s32real));
+  s64floattype.setdef(tfloatdef.create(s64real));
   if (cs_fp_emulation in aktmoduleswitches) then
-   s80floattype.setdef(new(pfloatdef,init(s32real)))
+   s80floattype.setdef(tfloatdef.create(s32real)))
   else
-   s80floattype.setdef(new(pfloatdef,init(s80real)));
+   s80floattype.setdef(tfloatdef.create(s80real));
 {$endif}
   { some other definitions }
-  voidpointertype.setdef(new(ppointerdef,init(voidtype)));
-  charpointertype.setdef(new(ppointerdef,init(cchartype)));
-  voidfarpointertype.setdef(new(ppointerdef,initfar(voidtype)));
-  cfiletype.setdef(new(pfiledef,inituntyped));
-  cvarianttype.setdef(new(pvariantdef,init));
+  voidpointertype.setdef(tpointerdef.create(voidtype));
+  charpointertype.setdef(tpointerdef.create(cchartype));
+  voidfarpointertype.setdef(tpointerdef.createfar(voidtype));
+  cfiletype.setdef(tfiledef.createuntyped);
+  cvarianttype.setdef(tvariantdef.create);
   registerdef:=oldregisterdef;
 end;
 
@@ -265,7 +265,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.14  2001-04-02 21:20:34  peter
+  Revision 1.15  2001-04-13 01:22:13  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.14  2001/04/02 21:20:34  peter
     * resulttype rewrite
 
   Revision 1.13  2001/03/25 12:40:00  florian

compiler/ptconst.pas

@@ -31,7 +31,7 @@ interface
     { this procedure reads typed constants }
     { sym is only needed for ansi strings  }
     { the assembler label is in the middle (PM) }
-    procedure readtypedconst(const t:ttype;sym : ptypedconstsym;no_change_allowed : boolean);
+    procedure readtypedconst(const t:ttype;sym : ttypedconstsym;no_change_allowed : boolean);
 
 implementation
 
@@ -60,7 +60,7 @@ implementation
   {$maxfpuregisters 0}
 {$endif fpc}
     { this procedure reads typed constants }
-    procedure readtypedconst(const t:ttype;sym : ptypedconstsym;no_change_allowed : boolean);
+    procedure readtypedconst(const t:ttype;sym : ttypedconstsym;no_change_allowed : boolean);
 
       var
 {$ifdef m68k}
@@ -71,21 +71,21 @@ implementation
          i,l,offset,
          strlength : longint;
          curconstsegment : TAAsmoutput;
-         ll        : pasmlabel;
+         ll        : tasmlabel;
          s         : string;
          ca        : pchar;
          tmpguid   : tguid;
          aktpos    : longint;
-         obj       : pobjectdef;
-         srsym     : psym;
-         symt      : psymtable;
+         obj       : tobjectdef;
+         srsym     : tsym;
+         symt      : tsymtable;
          value     : bestreal;
          strval    : pchar;
 
-      procedure check_range(def:porddef);
+      procedure check_range(def:torddef);
         begin
-           if ((tordconstnode(p).value>def^.high) or
-               (tordconstnode(p).value<def^.low)) then
+           if ((tordconstnode(p).value>def.high) or
+               (tordconstnode(p).value<def.low)) then
              begin
                 if (cs_check_range in aktlocalswitches) then
                   Message(parser_e_range_check_error)
@@ -100,11 +100,11 @@ implementation
            curconstsegment:=consts
          else
            curconstsegment:=datasegment;
-         case t.def^.deftype of
+         case t.def.deftype of
             orddef:
               begin
                  p:=comp_expr(true);
-                 case porddef(t.def)^.typ of
+                 case torddef(t.def).typ of
                     bool8bit :
                       begin
                          if is_constboolnode(p) then
@@ -146,7 +146,7 @@ implementation
                          if is_constintnode(p) then
                            begin
                               curconstSegment.concat(Tai_const.Create_8bit(tordconstnode(p).value));
-                              check_range(porddef(t.def));
+                              check_range(torddef(t.def));
                            end
                          else
                            Message(cg_e_illegal_expression);
@@ -157,7 +157,7 @@ implementation
                          if is_constintnode(p) then
                            begin
                              curconstSegment.concat(Tai_const.Create_16bit(tordconstnode(p).value));
-                             check_range(porddef(t.def));
+                             check_range(torddef(t.def));
                            end
                          else
                            Message(cg_e_illegal_expression);
@@ -168,8 +168,8 @@ implementation
                          if is_constintnode(p) then
                            begin
                               curconstSegment.concat(Tai_const.Create_32bit(tordconstnode(p).value));
-                              if porddef(t.def)^.typ<>u32bit then
-                               check_range(porddef(t.def));
+                              if torddef(t.def).typ<>u32bit then
+                               check_range(torddef(t.def));
                            end
                          else
                            Message(cg_e_illegal_expression);
@@ -201,7 +201,7 @@ implementation
               else
                 Message(cg_e_illegal_expression);
 
-              case pfloatdef(t.def)^.typ of
+              case tfloatdef(t.def).typ of
                  s32real :
                    curconstSegment.concat(Tai_real_32bit.Create(value));
                  s64real :
@@ -221,11 +221,11 @@ implementation
               case p.nodetype of
                  loadvmtn:
                    begin
-                      if not(pobjectdef(pclassrefdef(p.resulttype.def)^.pointertype.def)^.is_related(
-                        pobjectdef(pclassrefdef(t.def)^.pointertype.def))) then
+                      if not(tobjectdef(tclassrefdef(p.resulttype.def).pointertype.def).is_related(
+                        tobjectdef(tclassrefdef(t.def).pointertype.def))) then
                         Message(cg_e_illegal_expression);
-                      curconstSegment.concat(Tai_const_symbol.Create(newasmsymbol(pobjectdef(
-                        pclassrefdef(p.resulttype.def)^.pointertype.def)^.vmt_mangledname)));
+                      curconstSegment.concat(Tai_const_symbol.Create(newasmsymbol(tobjectdef(
+                        tclassrefdef(p.resulttype.def).pointertype.def).vmt_mangledname)));
                    end;
                  niln:
                    curconstSegment.concat(Tai_const.Create_32bit(0));
@@ -263,7 +263,7 @@ implementation
                 curconstSegment.concat(Tai_const.Create_32bit(0))
               { maybe pchar ? }
               else
-                if is_char(ppointerdef(t.def)^.pointertype.def) and
+                if is_char(tpointerdef(t.def).pointertype.def) and
                    (p.nodetype<>addrn) then
                   begin
                     getdatalabel(ll);
@@ -292,9 +292,9 @@ implementation
                     hp:=taddrnode(p).left;
                     while assigned(hp) and (hp.nodetype in [subscriptn,vecn]) do
                       hp:=tbinarynode(hp).left;
-                    if (is_equal(ppointerdef(p.resulttype.def)^.pointertype.def,ppointerdef(t.def)^.pointertype.def) or
-                       (is_void(ppointerdef(p.resulttype.def)^.pointertype.def)) or
-                       (is_void(ppointerdef(t.def)^.pointertype.def))) and
+                    if (is_equal(tpointerdef(p.resulttype.def).pointertype.def,tpointerdef(t.def).pointertype.def) or
+                       (is_void(tpointerdef(p.resulttype.def).pointertype.def)) or
+                       (is_void(tpointerdef(t.def).pointertype.def))) and
                        (hp.nodetype=loadn) then
                       begin
                         do_resulttypepass(taddrnode(p).left);
@@ -305,7 +305,7 @@ implementation
                              case hp.nodetype of
                                vecn :
                                  begin
-                                   case tvecnode(hp).left.resulttype.def^.deftype of
+                                   case tvecnode(hp).left.resulttype.def.deftype of
                                      stringdef :
                                        begin
                                           { this seems OK for shortstring and ansistrings PM }
@@ -315,8 +315,8 @@ implementation
                                        end;
                                      arraydef :
                                        begin
-                                          len:=parraydef(tvecnode(hp).left.resulttype.def)^.elesize;
-                                          base:=parraydef(tvecnode(hp).left.resulttype.def)^.lowrange;
+                                          len:=tarraydef(tvecnode(hp).left.resulttype.def).elesize;
+                                          base:=tarraydef(tvecnode(hp).left.resulttype.def).lowrange;
                                        end
                                      else
                                        Message(cg_e_illegal_expression);
@@ -327,15 +327,15 @@ implementation
                                      Message(cg_e_illegal_expression);
                                  end;
                                subscriptn :
-                                 inc(offset,tsubscriptnode(hp).vs^.address)
+                                 inc(offset,tsubscriptnode(hp).vs.address)
                                else
                                  Message(cg_e_illegal_expression);
                              end;
                              hp:=tbinarynode(hp).left;
                           end;
-                        if tloadnode(hp).symtableentry^.typ=constsym then
+                        if tloadnode(hp).symtableentry.typ=constsym then
                           Message(type_e_variable_id_expected);
-                        curconstSegment.concat(Tai_const_symbol.Createname_offset(tloadnode(hp).symtableentry^.mangledname,offset));
+                        curconstSegment.concat(Tai_const_symbol.Createname_offset(tloadnode(hp).symtableentry.mangledname,offset));
                       end
                     else
                       Message(cg_e_illegal_expression);
@@ -348,7 +348,7 @@ implementation
                     if (tinlinenode(p).left.nodetype=typen) then
                       begin
                         curconstSegment.concat(Tai_const_symbol.createname(
-                          pobjectdef(tinlinenode(p).left.resulttype.def)^.vmt_mangledname));
+                          tobjectdef(tinlinenode(p).left.resulttype.def).vmt_mangledname));
                       end
                     else
                       Message(cg_e_illegal_expression);
@@ -368,12 +368,12 @@ implementation
                    else
                      begin
 {$ifdef i386}
-                        for l:=0 to t.def^.size-1 do
+                        for l:=0 to t.def.size-1 do
                           curconstSegment.concat(Tai_const.Create_8bit(tsetconstnode(p).value_set^[l]));
 {$endif}
 {$ifdef m68k}
                         j:=0;
-                        for l:=0 to ((def^.size-1) div 4) do
+                        for l:=0 to ((def.size-1) div 4) do
                         { HORRIBLE HACK because of endian       }
                         { now use intel endian for constant sets }
                          begin
@@ -398,14 +398,14 @@ implementation
                   if is_equal(p.resulttype.def,t.def) or
                      is_subequal(p.resulttype.def,t.def) then
                    begin
-                     case p.resulttype.def^.size of
+                     case p.resulttype.def.size of
                        1 : curconstSegment.concat(Tai_const.Create_8bit(tordconstnode(p).value));
                        2 : curconstSegment.concat(Tai_const.Create_16bit(tordconstnode(p).value));
                        4 : curconstSegment.concat(Tai_const.Create_32bit(tordconstnode(p).value));
                      end;
                    end
                   else
-                   Message2(type_e_incompatible_types,t.def^.typename,p.resulttype.def^.typename);
+                   Message2(type_e_incompatible_types,t.def.typename,p.resulttype.def.typename);
                 end
               else
                 Message(cg_e_illegal_expression);
@@ -427,8 +427,8 @@ implementation
                 end
               else if is_constresourcestringnode(p) then
                 begin
-                  strval:=pchar(tpointerord(pconstsym(tloadnode(p).symtableentry)^.value));
-                  strlength:=pconstsym(tloadnode(p).symtableentry)^.len;
+                  strval:=pchar(tpointerord(tconstsym(tloadnode(p).symtableentry).value));
+                  strlength:=tconstsym(tloadnode(p).symtableentry).len;
                 end
               else
                 begin
@@ -437,13 +437,13 @@ implementation
                 end;
               if strlength>=0 then
                begin
-                 case pstringdef(t.def)^.string_typ of
+                 case tstringdef(t.def).string_typ of
                    st_shortstring:
                      begin
-                       if strlength>=t.def^.size then
+                       if strlength>=t.def.size then
                         begin
-                          message2(parser_w_string_too_long,strpas(strval),tostr(t.def^.size-1));
-                          strlength:=t.def^.size-1;
+                          message2(parser_w_string_too_long,strpas(strval),tostr(t.def.size-1));
+                          strlength:=t.def.size-1;
                         end;
                        curconstSegment.concat(Tai_const.Create_8bit(strlength));
                        { this can also handle longer strings }
@@ -452,15 +452,15 @@ implementation
                        ca[strlength]:=#0;
                        curconstSegment.concat(Tai_string.Create_length_pchar(ca,strlength));
                        { fillup with spaces if size is shorter }
-                       if t.def^.size>strlength then
+                       if t.def.size>strlength then
                         begin
-                          getmem(ca,t.def^.size-strlength);
-                          { def^.size contains also the leading length, so we }
+                          getmem(ca,t.def.size-strlength);
+                          { def.size contains also the leading length, so we }
                           { we have to subtract one                       }
-                          fillchar(ca[0],t.def^.size-strlength-1,' ');
-                          ca[t.def^.size-strlength-1]:=#0;
+                          fillchar(ca[0],t.def.size-strlength-1,' ');
+                          ca[t.def.size-strlength-1]:=#0;
                           { this can also handle longer strings }
-                          curconstSegment.concat(Tai_string.Create_length_pchar(ca,t.def^.size-strlength-1));
+                          curconstSegment.concat(Tai_string.Create_length_pchar(ca,t.def.size-strlength-1));
                         end;
                      end;
 {$ifdef UseLongString}
@@ -513,17 +513,17 @@ implementation
               if token=_LKLAMMER then
                 begin
                     consume(_LKLAMMER);
-                    for l:=parraydef(t.def)^.lowrange to parraydef(t.def)^.highrange-1 do
+                    for l:=tarraydef(t.def).lowrange to tarraydef(t.def).highrange-1 do
                       begin
-                         readtypedconst(parraydef(t.def)^.elementtype,nil,no_change_allowed);
+                         readtypedconst(tarraydef(t.def).elementtype,nil,no_change_allowed);
                          consume(_COMMA);
                       end;
-                    readtypedconst(parraydef(t.def)^.elementtype,nil,no_change_allowed);
+                    readtypedconst(tarraydef(t.def).elementtype,nil,no_change_allowed);
                     consume(_RKLAMMER);
                  end
               else
               { if array of char then we allow also a string }
-               if is_char(parraydef(t.def)^.elementtype.def) then
+               if is_char(tarraydef(t.def).elementtype.def) then
                 begin
                    p:=comp_expr(true);
                    if p.nodetype=stringconstn then
@@ -546,11 +546,11 @@ implementation
                        Message(cg_e_illegal_expression);
                        len:=0;
                      end;
-                   if len>(Parraydef(t.def)^.highrange-Parraydef(t.def)^.lowrange+1) then
+                   if len>(tarraydef(t.def).highrange-tarraydef(t.def).lowrange+1) then
                      Message(parser_e_string_larger_array);
-                   for i:=Parraydef(t.def)^.lowrange to Parraydef(t.def)^.highrange do
+                   for i:=tarraydef(t.def).lowrange to tarraydef(t.def).highrange do
                      begin
-                        if i+1-Parraydef(t.def)^.lowrange<=len then
+                        if i+1-tarraydef(t.def).lowrange<=len then
                           begin
                              curconstSegment.concat(Tai_const.Create_8bit(byte(ca^)));
                              inc(ca);
@@ -582,7 +582,7 @@ implementation
                   if token=_KLAMMERAFFE then
                     consume(_KLAMMERAFFE);
               getprocvar:=true;
-              getprocvardef:=pprocvardef(t.def);
+              getprocvardef:=tprocvardef(t.def);
               p:=comp_expr(true);
               getprocvar:=false;
               if codegenerror then
@@ -593,9 +593,9 @@ implementation
               { convert calln to loadn }
               if p.nodetype=calln then
                begin
-                 hp:=cloadnode.create(pprocsym(tcallnode(p).symtableprocentry),tcallnode(p).symtableproc);
-                 if (tcallnode(p).symtableprocentry^.owner^.symtabletype=objectsymtable) and
-                    is_class(pdef(tcallnode(p).symtableprocentry^.owner^.defowner)) then
+                 hp:=cloadnode.create(tprocsym(tcallnode(p).symtableprocentry),tcallnode(p).symtableproc);
+                 if (tcallnode(p).symtableprocentry.owner.symtabletype=objectsymtable) and
+                    is_class(tdef(tcallnode(p).symtableprocentry.owner.defowner)) then
                   tloadnode(hp).set_mp(tcallnode(p).methodpointer.getcopy);
                  p.free;
                  do_resulttypepass(hp);
@@ -609,10 +609,10 @@ implementation
               else if (p.nodetype=addrn) and assigned(taddrnode(p).left) and
                 (taddrnode(p).left.nodetype=calln) then
                 begin
-                   hp:=cloadnode.create(pprocsym(tcallnode(taddrnode(p).left).symtableprocentry),
+                   hp:=cloadnode.create(tprocsym(tcallnode(taddrnode(p).left).symtableprocentry),
                      tcallnode(taddrnode(p).left).symtableproc);
-                   if (tcallnode(taddrnode(p).left).symtableprocentry^.owner^.symtabletype=objectsymtable) and
-                      is_class(pdef(tcallnode(taddrnode(p).left).symtableprocentry^.owner^.defowner)) then
+                   if (tcallnode(taddrnode(p).left).symtableprocentry.owner.symtabletype=objectsymtable) and
+                      is_class(tdef(tcallnode(taddrnode(p).left).symtableprocentry.owner.defowner)) then
                     tloadnode(hp).set_mp(tcallnode(taddrnode(p).left).methodpointer.getcopy);
                    p.free;
                    do_resulttypepass(hp);
@@ -649,10 +649,10 @@ implementation
                end;
               { we now need to have a loadn with a procsym }
               if (p.nodetype=loadn) and
-                 (tloadnode(p).symtableentry^.typ=procsym) then
+                 (tloadnode(p).symtableentry.typ=procsym) then
                begin
                  curconstSegment.concat(Tai_const_symbol.createname(
-                   pprocsym(tloadnode(p).symtableentry)^.definition^.mangledname));
+                   tprocsym(tloadnode(p).symtableentry).definition.mangledname));
                end
               else
                Message(cg_e_illegal_expression);
@@ -662,7 +662,7 @@ implementation
          recorddef:
            begin
               { KAZ }
-              if (precorddef(t.def)=rec_tguid) and
+              if (trecorddef(t.def)=rec_tguid) and
                  ((token=_CSTRING) or (token=_CCHAR) or (token=_ID)) then
                 begin
                   p:=comp_expr(true);
@@ -698,7 +698,7 @@ implementation
                         s:=pattern;
                         consume(_ID);
                         consume(_COLON);
-                        srsym:=psym(precorddef(t.def)^.symtable^.search(s));
+                        srsym:=tsym(trecorddef(t.def).symtable.search(s));
                         if srsym=nil then
                           begin
                              Message1(sym_e_id_not_found,s);
@@ -707,26 +707,26 @@ implementation
                         else
                           begin
                              { check position }
-                             if pvarsym(srsym)^.address<aktpos then
+                             if tvarsym(srsym).address<aktpos then
                                Message(parser_e_invalid_record_const);
 
                              { if needed fill }
-                             if pvarsym(srsym)^.address>aktpos then
-                               for i:=1 to pvarsym(srsym)^.address-aktpos do
+                             if tvarsym(srsym).address>aktpos then
+                               for i:=1 to tvarsym(srsym).address-aktpos do
                                  curconstSegment.concat(Tai_const.Create_8bit(0));
 
                              { new position }
-                             aktpos:=pvarsym(srsym)^.address+pvarsym(srsym)^.vartype.def^.size;
+                             aktpos:=tvarsym(srsym).address+tvarsym(srsym).vartype.def.size;
 
                              { read the data }
-                             readtypedconst(pvarsym(srsym)^.vartype,nil,no_change_allowed);
+                             readtypedconst(tvarsym(srsym).vartype,nil,no_change_allowed);
 
                              if token=_SEMICOLON then
                                consume(_SEMICOLON)
                              else break;
                           end;
                    end;
-                 for i:=1 to t.def^.size-aktpos do
+                 for i:=1 to t.def.size-aktpos do
                    curconstSegment.concat(Tai_const.Create_8bit(0));
                  consume(_RKLAMMER);
               end;
@@ -749,7 +749,7 @@ implementation
                   p.free;
                 end
               { for objects we allow it only if it doesn't contain a vmt }
-              else if (oo_has_vmt in pobjectdef(t.def)^.objectoptions) and
+              else if (oo_has_vmt in tobjectdef(t.def).objectoptions) and
                       not(m_tp in aktmodeswitches) then
                  Message(parser_e_type_const_not_possible)
               else
@@ -762,15 +762,15 @@ implementation
                         consume(_ID);
                         consume(_COLON);
                         srsym:=nil;
-                        obj:=pobjectdef(t.def);
-                        symt:=obj^.symtable;
+                        obj:=tobjectdef(t.def);
+                        symt:=obj.symtable;
                         while (srsym=nil) and assigned(symt) do
                           begin
-                             srsym:=psym(symt^.search(s));
+                             srsym:=tsym(symt.search(s));
                              if assigned(obj) then
-                               obj:=obj^.childof;
+                               obj:=obj.childof;
                              if assigned(obj) then
-                               symt:=obj^.symtable
+                               symt:=obj.symtable
                              else
                                symt:=nil;
                           end;
@@ -783,31 +783,31 @@ implementation
                         else
                           begin
                              { check position }
-                             if pvarsym(srsym)^.address<aktpos then
+                             if tvarsym(srsym).address<aktpos then
                                Message(parser_e_invalid_record_const);
 
                              { check in VMT needs to be added for TP mode }
                              if (m_tp in aktmodeswitches) and
-                                (oo_has_vmt in pobjectdef(t.def)^.objectoptions) and
-                                (pobjectdef(t.def)^.vmt_offset<pvarsym(srsym)^.address) then
+                                (oo_has_vmt in tobjectdef(t.def).objectoptions) and
+                                (tobjectdef(t.def).vmt_offset<tvarsym(srsym).address) then
                                begin
-                                 for i:=1 to pobjectdef(t.def)^.vmt_offset-aktpos do
+                                 for i:=1 to tobjectdef(t.def).vmt_offset-aktpos do
                                    curconstsegment.concat(tai_const.create_8bit(0));
-                                 curconstsegment.concat(tai_const_symbol.createname(pobjectdef(t.def)^.vmt_mangledname));
+                                 curconstsegment.concat(tai_const_symbol.createname(tobjectdef(t.def).vmt_mangledname));
                                  { this is more general }
-                                 aktpos:=pobjectdef(t.def)^.vmt_offset + target_os.size_of_pointer;
+                                 aktpos:=tobjectdef(t.def).vmt_offset + target_os.size_of_pointer;
                                end;
 
                              { if needed fill }
-                             if pvarsym(srsym)^.address>aktpos then
-                               for i:=1 to pvarsym(srsym)^.address-aktpos do
+                             if tvarsym(srsym).address>aktpos then
+                               for i:=1 to tvarsym(srsym).address-aktpos do
                                  curconstSegment.concat(Tai_const.Create_8bit(0));
 
                              { new position }
-                             aktpos:=pvarsym(srsym)^.address+pvarsym(srsym)^.vartype.def^.size;
+                             aktpos:=tvarsym(srsym).address+tvarsym(srsym).vartype.def.size;
 
                              { read the data }
-                             readtypedconst(pvarsym(srsym)^.vartype,nil,no_change_allowed);
+                             readtypedconst(tvarsym(srsym).vartype,nil,no_change_allowed);
 
                              if token=_SEMICOLON then
                                consume(_SEMICOLON)
@@ -815,16 +815,16 @@ implementation
                           end;
                      end;
                    if (m_tp in aktmodeswitches) and
-                      (oo_has_vmt in pobjectdef(t.def)^.objectoptions) and
-                      (pobjectdef(t.def)^.vmt_offset>=aktpos) then
+                      (oo_has_vmt in tobjectdef(t.def).objectoptions) and
+                      (tobjectdef(t.def).vmt_offset>=aktpos) then
                      begin
-                       for i:=1 to pobjectdef(t.def)^.vmt_offset-aktpos do
+                       for i:=1 to tobjectdef(t.def).vmt_offset-aktpos do
                          curconstsegment.concat(tai_const.create_8bit(0));
-                       curconstsegment.concat(tai_const_symbol.createname(pobjectdef(t.def)^.vmt_mangledname));
+                       curconstsegment.concat(tai_const_symbol.createname(tobjectdef(t.def).vmt_mangledname));
                        { this is more general }
-                       aktpos:=pobjectdef(t.def)^.vmt_offset + target_os.size_of_pointer;
+                       aktpos:=tobjectdef(t.def).vmt_offset + target_os.size_of_pointer;
                      end;
-                   for i:=1 to t.def^.size-aktpos do
+                   for i:=1 to t.def.size-aktpos do
                      curconstSegment.concat(Tai_const.Create_8bit(0));
                    consume(_RKLAMMER);
                 end;
@@ -847,7 +847,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.20  2001-04-04 22:43:53  peter
+  Revision 1.21  2001-04-13 01:22:13  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.20  2001/04/04 22:43:53  peter
     * remove unnecessary calls to firstpass
 
   Revision 1.19  2001/04/02 21:20:34  peter

compiler/ptype.pas

@@ -40,13 +40,13 @@ interface
        curobjectname : stringid;
 
     { reads a string, file type or a type id and returns a name and }
-    { pdef }
+    { tdef }
     procedure single_type(var tt:ttype;var s : string;isforwarddef:boolean);
 
     procedure read_type(var tt:ttype;const name : stringid);
 
     { reads a type definition }
-    { to a appropriating pdef, s gets the name of   }
+    { to a appropriating tdef, s gets the name of   }
     { the type to allow name mangling          }
     procedure id_type(var tt : ttype;var s : string;isforwarddef:boolean);
 
@@ -71,13 +71,13 @@ implementation
 
     procedure id_type(var tt : ttype;var s : string;isforwarddef:boolean);
     { reads a type definition }
-    { to a appropriating pdef, s gets the name of   }
+    { to a appropriating tdef, s gets the name of   }
     { the type to allow name mangling          }
       var
         is_unit_specific : boolean;
         pos : tfileposinfo;
-        srsym : psym;
-        srsymtable : psymtable;
+        srsym : tsym;
+        srsymtable : tsymtable;
       begin
          s:=pattern;
          pos:=akttokenpos;
@@ -100,13 +100,13 @@ implementation
          searchsym(s,srsym,srsymtable);
          consume(_ID);
          if assigned(srsym) and
-            (srsym^.typ=unitsym) then
+            (srsym.typ=unitsym) then
            begin
               is_unit_specific:=true;
               consume(_POINT);
-              if srsym^.owner^.unitid=0 then
+              if srsym.owner.unitid=0 then
                begin
-                 srsym:=searchsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
+                 srsym:=searchsymonlyin(tunitsym(srsym).unitsymtable,pattern);
                  pos:=akttokenpos;
                  s:=pattern;
                end
@@ -118,7 +118,7 @@ implementation
          if isforwarddef and
             not(is_unit_specific) then
           begin
-            tt.setdef(new(pforwarddef,init(s,pos)));
+            tt.setdef(tforwarddef.create(s,pos));
             exit;
           end;
          { unknown sym ? }
@@ -129,7 +129,7 @@ implementation
             exit;
           end;
          { type sym ? }
-         if (srsym^.typ<>typesym) then
+         if (srsym.typ<>typesym) then
           begin
             Message(type_e_type_id_expected);
             tt:=generrortype;
@@ -138,7 +138,7 @@ implementation
          { 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 }
-         if (ptypesym(srsym)^.restype.def^.deftype=errordef) then
+         if (ttypesym(srsym).restype.def.deftype=errordef) then
           begin
             Message(sym_e_error_in_type_def);
             tt:=generrortype;
@@ -149,9 +149,9 @@ implementation
            loaded at that time. A symbol reference to an other unit
            is still possible, because it's already loaded (PFV)
            can't use in [] here, becuase unitid can be > 255 }
-         if (ptypesym(srsym)^.owner^.unitid=0) or
-            (ptypesym(srsym)^.owner^.unitid=1) then
-          tt.setdef(ptypesym(srsym)^.restype.def)
+         if (ttypesym(srsym).owner.unitid=0) or
+            (ttypesym(srsym).owner.unitid=1) then
+          tt.setdef(ttypesym(srsym).restype.def)
          else
           tt.setsym(srsym);
       end;
@@ -159,7 +159,7 @@ implementation
 
     procedure single_type(var tt:ttype;var s : string;isforwarddef:boolean);
     { reads a string, file type or a type id and returns a name and }
-    { pdef                                                        }
+    { tdef                                                        }
        var
           hs : string;
           t2 : ttype;
@@ -177,7 +177,7 @@ implementation
                      begin
                         consume(_OF);
                         single_type(t2,hs,false);
-                        tt.setdef(new(pfiledef,inittyped(t2)));
+                        tt.setdef(tfiledef.createtyped(t2));
                         s:='FILE$OF$'+hs;
                      end
                    else
@@ -194,18 +194,18 @@ implementation
       end;
 
     { reads a record declaration }
-    function record_dec : pdef;
+    function record_dec : tdef;
 
       var
-         symtable : psymtable;
+         symtable : tsymtable;
          storetypecanbeforward : boolean;
 
       begin
          { create recdef }
-         symtable:=new(pstoredsymtable,init(recordsymtable));
-         record_dec:=new(precorddef,init(symtable));
+         symtable:=trecordsymtable.create;
+         record_dec:=trecorddef.create(symtable);
          { update symtable stack }
-         symtable^.next:=symtablestack;
+         symtable.next:=symtablestack;
          symtablestack:=symtable;
          { parse record }
          consume(_RECORD);
@@ -217,9 +217,9 @@ implementation
          consume(_END);
          typecanbeforward:=storetypecanbeforward;
          { may be scale record size to a size of n*4 ? }
-         symtablestack^.datasize:=align(symtablestack^.datasize,symtablestack^.dataalignment);
+         symtablestack.datasize:=align(symtablestack.datasize,symtablestack.dataalignment);
          { restore symtable stack }
-         symtablestack:=symtable^.next;
+         symtablestack:=symtable.next;
       end;
 
 
@@ -228,8 +228,8 @@ implementation
       var
         pt : tnode;
         tt2 : ttype;
-        aktenumdef : penumdef;
-        ap : parraydef;
+        aktenumdef : tenumdef;
+        ap : tarraydef;
         s : stringid;
         l,v : TConstExprInt;
         oldaktpackrecords : tpackrecords;
@@ -276,18 +276,18 @@ implementation
                        else
                         begin
                         { All checks passed, create the new def }
-                          case pt1.resulttype.def^.deftype of
+                          case pt1.resulttype.def.deftype of
                             enumdef :
-                              tt.setdef(new(penumdef,init_subrange(penumdef(pt1.resulttype.def),tordconstnode(pt1).value,tordconstnode(pt2).value)));
+                              tt.setdef(tenumdef.create_subrange(tenumdef(pt1.resulttype.def),tordconstnode(pt1).value,tordconstnode(pt2).value));
                             orddef :
                               begin
                                 if is_char(pt1.resulttype.def) then
-                                  tt.setdef(new(porddef,init(uchar,tordconstnode(pt1).value,tordconstnode(pt2).value)))
+                                  tt.setdef(torddef.create(uchar,tordconstnode(pt1).value,tordconstnode(pt2).value))
                                 else
                                   if is_boolean(pt1.resulttype.def) then
-                                    tt.setdef(new(porddef,init(bool8bit,tordconstnode(pt1).value,tordconstnode(pt2).value)))
+                                    tt.setdef(torddef.create(bool8bit,tordconstnode(pt1).value,tordconstnode(pt2).value))
                                   else
-                                    tt.setdef(new(porddef,init(uauto,tordconstnode(pt1).value,tordconstnode(pt2).value)));
+                                    tt.setdef(torddef.create(uauto,tordconstnode(pt1).value,tordconstnode(pt2).value));
                               end;
                           end;
                         end;
@@ -317,27 +317,27 @@ implementation
 
           procedure setdefdecl(const t:ttype);
           begin
-            case t.def^.deftype of
+            case t.def.deftype of
               enumdef :
                 begin
-                  lowval:=penumdef(t.def)^.min;
-                  highval:=penumdef(t.def)^.max;
+                  lowval:=tenumdef(t.def).min;
+                  highval:=tenumdef(t.def).max;
                   arraytype:=t;
                 end;
               orddef :
                 begin
-                  if porddef(t.def)^.typ in [uchar,
+                  if torddef(t.def).typ in [uchar,
                     u8bit,u16bit,
                     s8bit,s16bit,s32bit,
                     bool8bit,bool16bit,bool32bit,
                     uwidechar] then
                     begin
-                       lowval:=porddef(t.def)^.low;
-                       highval:=porddef(t.def)^.high;
+                       lowval:=torddef(t.def).low;
+                       highval:=torddef(t.def).high;
                        arraytype:=t;
                     end
                   else
-                    Message1(parser_e_type_cant_be_used_in_array_index,t.def^.gettypename);
+                    Message1(parser_e_type_cant_be_used_in_array_index,t.def.gettypename);
                 end;
               else
                 Message(sym_e_error_in_type_def);
@@ -398,13 +398,13 @@ implementation
                 { create arraydef }
                   if not assigned(tt.def) then
                    begin
-                     ap:=new(parraydef,init(lowval,highval,arraytype));
+                     ap:=tarraydef.create(lowval,highval,arraytype);
                      tt.setdef(ap);
                    end
                   else
                    begin
-                     ap^.elementtype.setdef(new(parraydef,init(lowval,highval,arraytype)));
-                     ap:=parraydef(ap^.elementtype.def);
+                     ap.elementtype.setdef(tarraydef.create(lowval,highval,arraytype));
+                     ap:=tarraydef(ap.elementtype.def);
                    end;
 
                   if token=_COMMA then
@@ -416,15 +416,15 @@ implementation
              end
            else
              begin
-                ap:=new(parraydef,init(0,-1,s32bittype));
-                ap^.IsDynamicArray:=true;
+                ap:=tarraydef.create(0,-1,s32bittype);
+                ap.IsDynamicArray:=true;
                 tt.setdef(ap);
              end;
            consume(_OF);
            read_type(tt2,'');
            { if no error, set element type }
            if assigned(ap) then
-             ap^.elementtype:=tt2;
+             ap.elementtype:=tt2;
         end;
 
       begin
@@ -439,7 +439,7 @@ implementation
                 consume(_LKLAMMER);
                 { allow negativ value_str }
                 l:=-1;
-                aktenumdef:=new(penumdef,init);
+                aktenumdef:=tenumdef.create;
                 repeat
                   s:=orgpattern;
                   defpos:=akttokenpos;
@@ -471,7 +471,7 @@ implementation
                     inc(l);
                   storepos:=akttokenpos;
                   akttokenpos:=defpos;
-                  constsymtable^.insert(new(penumsym,init(s,aktenumdef,l)));
+                  constsymtable.insert(tenumsym.create(s,aktenumdef,l));
                   akttokenpos:=storepos;
                 until not try_to_consume(_COMMA);
                 tt.setdef(aktenumdef);
@@ -488,23 +488,23 @@ implementation
                 read_type(tt2,'');
                 if assigned(tt2.def) then
                  begin
-                   case tt2.def^.deftype of
+                   case tt2.def.deftype of
                      { don't forget that min can be negativ  PM }
                      enumdef :
-                       if penumdef(tt2.def)^.min>=0 then
-                        tt.setdef(new(psetdef,init(tt2,penumdef(tt2.def)^.max)))
+                       if tenumdef(tt2.def).min>=0 then
+                        tt.setdef(tsetdef.create(tt2,tenumdef(tt2.def).max))
                        else
                         Message(sym_e_ill_type_decl_set);
                      orddef :
                        begin
-                         case porddef(tt2.def)^.typ of
+                         case torddef(tt2.def).typ of
                            uchar :
-                             tt.setdef(new(psetdef,init(tt2,255)));
+                             tt.setdef(tsetdef.create(tt2,255));
                            u8bit,u16bit,u32bit,
                            s8bit,s16bit,s32bit :
                              begin
-                               if (porddef(tt2.def)^.low>=0) then
-                                tt.setdef(new(psetdef,init(tt2,porddef(tt2.def)^.high)))
+                               if (torddef(tt2.def).low>=0) then
+                                tt.setdef(tsetdef.create(tt2,torddef(tt2.def).high))
                                else
                                 Message(sym_e_ill_type_decl_set);
                              end;
@@ -523,7 +523,7 @@ implementation
               begin
                 consume(_CARET);
                 single_type(tt2,hs,typecanbeforward);
-                tt.setdef(new(ppointerdef,init(tt2)));
+                tt.setdef(tpointerdef.create(tt2));
               end;
             _RECORD:
               begin
@@ -555,29 +555,29 @@ implementation
             _PROCEDURE:
               begin
                 consume(_PROCEDURE);
-                tt.setdef(new(pprocvardef,init));
+                tt.setdef(tprocvardef.create);
                 if token=_LKLAMMER then
-                 parameter_dec(pprocvardef(tt.def));
+                 parameter_dec(tprocvardef(tt.def));
                 if token=_OF then
                   begin
                     consume(_OF);
                     consume(_OBJECT);
-                    include(pprocvardef(tt.def)^.procoptions,po_methodpointer);
+                    include(tprocvardef(tt.def).procoptions,po_methodpointer);
                   end;
               end;
             _FUNCTION:
               begin
                 consume(_FUNCTION);
-                tt.def:=new(pprocvardef,init);
+                tt.def:=tprocvardef.create;
                 if token=_LKLAMMER then
-                 parameter_dec(pprocvardef(tt.def));
+                 parameter_dec(tprocvardef(tt.def));
                 consume(_COLON);
-                single_type(pprocvardef(tt.def)^.rettype,hs,false);
+                single_type(tprocvardef(tt.def).rettype,hs,false);
                 if token=_OF then
                   begin
                     consume(_OF);
                     consume(_OBJECT);
-                    include(pprocvardef(tt.def)^.procoptions,po_methodpointer);
+                    include(tprocvardef(tt.def).procoptions,po_methodpointer);
                   end;
               end;
             else
@@ -590,7 +590,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.22  2001-04-04 22:43:53  peter
+  Revision 1.23  2001-04-13 01:22:13  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.22  2001/04/04 22:43:53  peter
     * remove unnecessary calls to firstpass
 
   Revision 1.21  2001/04/02 21:20:34  peter

compiler/rautils.pas

@@ -27,7 +27,7 @@ Unit RAUtils;
 Interface
 
 Uses
-  cutils,cobjects,
+  cutils,cclasses,
   globtype,aasm,cpubase,symconst,symdef;
 
 Const
@@ -43,25 +43,23 @@ Const
 
 Type
   { Each local label has this structure associated with it }
-  PLocalLabel = ^TLocalLabel;
-  TLocalLabel = object(TNamedIndexObject)
+  TLocalLabel = class(TNamedIndexItem)
     Emitted : boolean;
-    constructor Init(const n:string);
-    function  Getpasmlabel:pasmlabel;
+    constructor Create(const n:string);
+    function  Gettasmlabel:tasmlabel;
   private
-    lab : pasmlabel;
+    lab : tasmlabel;
   end;
 
-  PLocalLabelList = ^TLocalLabelList;
-  TLocalLabelList = Object(TDictionary)
+  TLocalLabelList = class(TDictionary)
     procedure CheckEmitted;
   end;
 
 var
-  LocalLabelList : PLocalLabelList;
+  LocalLabelList : TLocalLabelList;
 
-function CreateLocalLabel(const s: string; var hl: pasmlabel; emit:boolean):boolean;
-Function SearchLabel(const s: string; var hl: pasmlabel;emit:boolean): boolean;
+function CreateLocalLabel(const s: string; var hl: tasmlabel; emit:boolean):boolean;
+Function SearchLabel(const s: string; var hl: tasmlabel;emit:boolean): boolean;
 
 
 {---------------------------------------------------------------------
@@ -76,7 +74,7 @@ type
     case typ:TOprType of
       OPR_NONE   : ();
       OPR_CONSTANT  : (val:longint);
-      OPR_SYMBOL    : (symbol:PAsmSymbol;symofs:longint);
+      OPR_SYMBOL    : (symbol:tasmsymbol;symofs:longint);
       OPR_REFERENCE : (ref:treference);
       OPR_REGISTER  : (reg:tregister);
 {$ifdef m68k}
@@ -86,14 +84,13 @@ type
 {$endif m68k}
   end;
 
-  POperand = ^TOperand;
-  TOperand = object
+  TOperand = class
     size   : topsize;
     hastype,          { if the operand has typecasted variable }
     hasvar : boolean; { if the operand is loaded with a variable }
     opr    : TOprRec;
-    constructor init;
-    destructor  done;virtual;
+    constructor create;
+    destructor  destroy;override;
     Procedure BuildOperand;virtual;
     Procedure SetSize(_size:longint;force:boolean);
     Procedure SetCorrectSize(opcode:tasmop);virtual;
@@ -105,20 +102,19 @@ type
     Procedure InitRef;
   end;
 
-  PInstruction = ^TInstruction;
-  TInstruction = object
+  TInstruction = class
     opcode    : tasmop;
     opsize    : topsize;
     condition : tasmcond;
     ops       : byte;
     labeled   : boolean;
-    operands  : array[1..maxoperands] of POperand;
-    constructor init;
-    destructor  done;virtual;
+    operands  : array[1..maxoperands] of toperand;
+    constructor create;
+    destructor  destroy;override;
     Procedure InitOperands;virtual;
     Procedure BuildOpcode;virtual;
     procedure ConcatInstruction(p:TAAsmoutput);virtual;
-    Procedure SwapOperands;
+    Procedure Swatoperands;
   end;
 
 
@@ -149,12 +145,12 @@ type
   {  ( and ) parenthesis                                                }
   {**********************************************************************}
 
-  TExprParse = Object
+  TExprParse = class
     public
-     Constructor Init;
-     Destructor Done;
+     Constructor create;
+     Destructor Destroy;override;
      Function Evaluate(Expr:  String): longint;
-     Function Priority(_Operator: Char): longint; virtual;
+     Function Priority(_Operator: Char): longint;
     private
      RPNStack   : Array[1..RPNMax] of longint;        { Stack For RPN calculator }
      RPNTop     : longint;
@@ -198,7 +194,7 @@ Function SearchIConstant(const s:string; var l:longint): boolean;
 
   Procedure ConcatPasString(p : TAAsmoutput;s:string);
   Procedure ConcatDirect(p : TAAsmoutput;s:string);
-  Procedure ConcatLabel(p: TAAsmoutput;var l : pasmlabel);
+  Procedure ConcatLabel(p: TAAsmoutput;var l : tasmlabel);
   Procedure ConcatConstant(p : TAAsmoutput;value: longint; maxvalue: longint);
   Procedure ConcatConstSymbol(p : TAAsmoutput;const sym:string;l:longint);
   Procedure ConcatRealConstant(p : TAAsmoutput;value: bestreal; real_typ : tfloattype);
@@ -230,7 +226,7 @@ uses
                               TExprParse
 *************************************************************************}
 
-Constructor TExprParse.Init;
+Constructor TExprParse.create;
 Begin
 end;
 
@@ -491,7 +487,7 @@ begin
 end;
 
 
-Destructor TExprParse.Done;
+Destructor TExprParse.Destroy;
 Begin
 end;
 
@@ -500,9 +496,9 @@ Function CalculateExpression(const expression: string): longint;
 var
   expr: TExprParse;
 Begin
-  expr.Init;
+  expr:=TExprParse.create;
   CalculateExpression:=expr.Evaluate(expression);
-  expr.Done;
+  expr.Free;
 end;
 
 
@@ -694,7 +690,7 @@ end;
                                    TOperand
 ****************************************************************************}
 
-constructor TOperand.init;
+constructor TOperand.Create;
 begin
   size:=S_NO;
   hastype:=false;
@@ -703,7 +699,7 @@ begin
 end;
 
 
-destructor TOperand.done;
+destructor TOperand.destroy;
 begin
 end;
 
@@ -790,23 +786,23 @@ Function TOperand.SetupVar(const hs:string;GetOffset : boolean): Boolean;
 { for the NON-constant identifier passed to the routine.    }
 { if not found returns FALSE.                               }
 var
-  sym : psym;
-  srsymtable : psymtable;
-  harrdef : parraydef;
+  sym : tsym;
+  srsymtable : tsymtable;
+  harrdef : tarraydef;
 Begin
   SetupVar:=false;
 { are we in a routine ? }
   searchsym(hs,sym,srsymtable);
   if sym=nil then
    exit;
-  case sym^.typ of
+  case sym.typ of
     varsym :
       begin
         { we always assume in asm statements that     }
         { that the variable is valid.                 }
-        pvarsym(sym)^.varstate:=vs_used;
-        inc(pvarsym(sym)^.refs);
-        case pvarsym(sym)^.owner^.symtabletype of
+        tvarsym(sym).varstate:=vs_used;
+        inc(tvarsym(sym).refs);
+        case tvarsym(sym).owner.symtabletype of
           objectsymtable :
             begin
               { this is not allowed, because we don't know if the self
@@ -816,32 +812,31 @@ Begin
               if (m_tp in aktmodeswitches) then
                 begin
                   opr.typ:=OPR_CONSTANT;
-                  opr.val:=pvarsym(sym)^.address;
+                  opr.val:=tvarsym(sym).address;
                 end
               { I do not agree here people using method vars should ensure
                 that %esi is valid there }
               else
                 begin
                   opr.ref.base:=self_pointer;
-                  opr.ref.offset:=pvarsym(sym)^.address;
+                  opr.ref.offset:=tvarsym(sym).address;
                 end;
               hasvar:=true;
               SetupVar:=true;
               Exit;
             end;
-          unitsymtable,
           globalsymtable,
           staticsymtable :
-            opr.ref.symbol:=newasmsymbol(pvarsym(sym)^.mangledname);
+            opr.ref.symbol:=newasmsymbol(tvarsym(sym).mangledname);
           parasymtable :
             begin
               { if we only want the offset we don't have to care
                 the base will be zeroed after ! }
-              if (lexlevel=pvarsym(sym)^.owner^.symtablelevel) or
+              if (lexlevel=tvarsym(sym).owner.symtablelevel) or
               { this below is wrong because there are two parast
                 for global functions one of interface the second of
                 implementation
-              if (pvarsym(sym)^.owner=procinfo^.def^.parast) or }
+              if (tvarsym(sym).owner=procinfo^.def.parast) or }
                 GetOffset then
                 begin
                   opr.ref.base:=procinfo^.framepointer;
@@ -850,18 +845,18 @@ Begin
                 begin
                   if (procinfo^.framepointer=stack_pointer) and
                      assigned(procinfo^.parent) and
-                     (lexlevel=pvarsym(sym)^.owner^.symtablelevel+1) and
+                     (lexlevel=tvarsym(sym).owner.symtablelevel+1) and
                      { same problem as above !!
-                     (procinfo^.parent^.sym^.definition^.parast=pvarsym(sym)^.owner) and }
+                     (procinfo^.parent^.sym.definition.parast=tvarsym(sym).owner) and }
                      (lexlevel>normal_function_level) then
                     opr.ref.base:=procinfo^.parent^.framepointer
                   else
                     message1(asmr_e_local_para_unreachable,hs);
                 end;
-              opr.ref.offset:=pvarsym(sym)^.address;
-              if (lexlevel=pvarsym(sym)^.owner^.symtablelevel) then
+              opr.ref.offset:=tvarsym(sym).address;
+              if (lexlevel=tvarsym(sym).owner.symtablelevel) then
                 begin
-                  opr.ref.offsetfixup:=aktprocsym^.definition^.parast^.address_fixup;
+                  opr.ref.offsetfixup:=aktprocsym.definition.parast.address_fixup;
                   opr.ref.options:=ref_parafixup;
                 end
               else
@@ -869,38 +864,38 @@ Begin
                   opr.ref.offsetfixup:=0;
                   opr.ref.options:=ref_none;
                 end;
-              if (pvarsym(sym)^.varspez=vs_var) or
-                 ((pvarsym(sym)^.varspez=vs_const) and
-                 push_addr_param(pvarsym(sym)^.vartype.def)) then
+              if (tvarsym(sym).varspez=vs_var) or
+                 ((tvarsym(sym).varspez=vs_const) and
+                 push_addr_param(tvarsym(sym).vartype.def)) then
                 SetSize(target_os.size_of_pointer,false);
             end;
           localsymtable :
             begin
-              if (vo_is_external in pvarsym(sym)^.varoptions) then
-                opr.ref.symbol:=newasmsymbol(pvarsym(sym)^.mangledname)
+              if (vo_is_external in tvarsym(sym).varoptions) then
+                opr.ref.symbol:=newasmsymbol(tvarsym(sym).mangledname)
               else
                 begin
                   { if we only want the offset we don't have to care
                     the base will be zeroed after ! }
-                  if (lexlevel=pvarsym(sym)^.owner^.symtablelevel) or
-                  {if (pvarsym(sym)^.owner=procinfo^.def^.localst) or}
+                  if (lexlevel=tvarsym(sym).owner.symtablelevel) or
+                  {if (tvarsym(sym).owner=procinfo^.def.localst) or}
                     GetOffset then
                     opr.ref.base:=procinfo^.framepointer
                   else
                     begin
                       if (procinfo^.framepointer=stack_pointer) and
                          assigned(procinfo^.parent) and
-                         (lexlevel=pvarsym(sym)^.owner^.symtablelevel+1) and
-                         {(procinfo^.parent^.sym^.definition^.localst=pvarsym(sym)^.owner) and}
+                         (lexlevel=tvarsym(sym).owner.symtablelevel+1) and
+                         {(procinfo^.parent^.sym.definition.localst=tvarsym(sym).owner) and}
                          (lexlevel>normal_function_level) then
                         opr.ref.base:=procinfo^.parent^.framepointer
                       else
                         message1(asmr_e_local_para_unreachable,hs);
                     end;
-                  opr.ref.offset:=-(pvarsym(sym)^.address);
-                  if (lexlevel=pvarsym(sym)^.owner^.symtablelevel) then
+                  opr.ref.offset:=-(tvarsym(sym).address);
+                  if (lexlevel=tvarsym(sym).owner.symtablelevel) then
                     begin
-                      opr.ref.offsetfixup:=aktprocsym^.definition^.localst^.address_fixup;
+                      opr.ref.offsetfixup:=aktprocsym.definition.localst.address_fixup;
                       opr.ref.options:=ref_localfixup;
                     end
                   else
@@ -909,27 +904,27 @@ Begin
                       opr.ref.options:=ref_none;
                     end;
                 end;
-              if (pvarsym(sym)^.varspez in [vs_var,vs_out]) or
-                 ((pvarsym(sym)^.varspez=vs_const) and
-                  push_addr_param(pvarsym(sym)^.vartype.def)) then
+              if (tvarsym(sym).varspez in [vs_var,vs_out]) or
+                 ((tvarsym(sym).varspez=vs_const) and
+                  push_addr_param(tvarsym(sym).vartype.def)) then
                 SetSize(target_os.size_of_pointer,false);
             end;
         end;
-        case pvarsym(sym)^.vartype.def^.deftype of
+        case tvarsym(sym).vartype.def.deftype of
           orddef,
           enumdef,
           pointerdef,
           floatdef :
-            SetSize(pvarsym(sym)^.getsize,false);
+            SetSize(tvarsym(sym).getsize,false);
           arraydef :
             begin
               { for arrays try to get the element size, take care of
                 multiple indexes }
-              harrdef:=Parraydef(PVarsym(sym)^.vartype.def);
-              while assigned(harrdef^.elementtype.def) and
-                    (harrdef^.elementtype.def^.deftype=arraydef) do
-               harrdef:=parraydef(harrdef^.elementtype.def);
-              SetSize(harrdef^.elesize,false);
+              harrdef:=tarraydef(tvarsym(sym).vartype.def);
+              while assigned(harrdef.elementtype.def) and
+                    (harrdef.elementtype.def.deftype=arraydef) do
+               harrdef:=tarraydef(harrdef.elementtype.def);
+              SetSize(harrdef.elesize,false);
             end;
         end;
         hasvar:=true;
@@ -938,22 +933,22 @@ Begin
       end;
     typedconstsym :
       begin
-        opr.ref.symbol:=newasmsymbol(ptypedconstsym(sym)^.mangledname);
-        case ptypedconstsym(sym)^.typedconsttype.def^.deftype of
+        opr.ref.symbol:=newasmsymbol(ttypedconstsym(sym).mangledname);
+        case ttypedconstsym(sym).typedconsttype.def.deftype of
           orddef,
           enumdef,
           pointerdef,
           floatdef :
-            SetSize(ptypedconstsym(sym)^.getsize,false);
+            SetSize(ttypedconstsym(sym).getsize,false);
           arraydef :
             begin
               { for arrays try to get the element size, take care of
                 multiple indexes }
-              harrdef:=Parraydef(PTypedConstSym(sym)^.typedconsttype.def);
-              while assigned(harrdef^.elementtype.def) and
-                    (harrdef^.elementtype.def^.deftype=arraydef) do
-               harrdef:=parraydef(harrdef^.elementtype.def);
-              SetSize(harrdef^.elesize,false);
+              harrdef:=tarraydef(ttypedconstsym(sym).typedconsttype.def);
+              while assigned(harrdef.elementtype.def) and
+                    (harrdef.elementtype.def.deftype=arraydef) do
+               harrdef:=tarraydef(harrdef.elementtype.def);
+              SetSize(harrdef.elesize,false);
             end;
         end;
         hasvar:=true;
@@ -962,17 +957,17 @@ Begin
       end;
     constsym :
       begin
-        if pconstsym(sym)^.consttyp in [constint,constchar,constbool] then
+        if tconstsym(sym).consttyp in [constint,constchar,constbool] then
          begin
            opr.typ:=OPR_CONSTANT;
-           opr.val:=pconstsym(sym)^.value;
+           opr.val:=tconstsym(sym).value;
            SetupVar:=true;
            Exit;
          end;
       end;
     typesym :
       begin
-        if ptypesym(sym)^.restype.def^.deftype in [recorddef,objectdef] then
+        if ttypesym(sym).restype.def.deftype in [recorddef,objectdef] then
          begin
            opr.typ:=OPR_CONSTANT;
            opr.val:=0;
@@ -982,10 +977,10 @@ Begin
       end;
     procsym :
       begin
-        if assigned(pprocsym(sym)^.definition^.nextoverloaded) then
+        if assigned(tprocsym(sym).definition.nextoverloaded) then
           Message(asmr_w_calling_overload_func);
         opr.typ:=OPR_SYMBOL;
-        opr.symbol:=newasmsymbol(pprocsym(sym)^.definition^.mangledname);
+        opr.symbol:=newasmsymbol(tprocsym(sym).definition.mangledname);
         hasvar:=true;
         SetupVar:=TRUE;
         Exit;
@@ -1002,7 +997,7 @@ end;
 { looks for internal names of variables and routines }
 Function TOperand.SetupDirectVar(const hs:string): Boolean;
 var
-  p : pasmsymbol;
+  p : tasmsymbol;
 begin
   SetupDirectVar:=false;
   p:=getasmsymbol(hs);
@@ -1046,7 +1041,7 @@ end;
                                  TInstruction
 ****************************************************************************}
 
-constructor TInstruction.init;
+constructor TInstruction.create;
 Begin
   Opcode:=A_NONE;
   Opsize:=S_NO;
@@ -1057,12 +1052,12 @@ Begin
 end;
 
 
-destructor TInstruction.done;
+destructor TInstruction.destroy;
 var
   i : longint;
 Begin
   for i:=1 to 3 do
-   Dispose(Operands[i],Done);
+   Operands[i].free;
 end;
 
 
@@ -1071,13 +1066,13 @@ var
   i : longint;
 begin
   for i:=1 to 3 do
-   New(Operands[i],init);
+   Operands[i].create;
 end;
 
 
-Procedure TInstruction.SwapOperands;
+Procedure TInstruction.Swatoperands;
 Var
-  p : POperand;
+  p : toperand;
 Begin
   case Ops of
    2 :
@@ -1112,23 +1107,23 @@ end;
                                  TLocalLabel
 ***************************************************************************}
 
-constructor TLocalLabel.Init(const n:string);
+constructor TLocalLabel.create(const n:string);
 begin
-  inherited InitName(n);
+  inherited CreateName(n);
   lab:=nil;
   emitted:=false;
 end;
 
 
-function TLocalLabel.Getpasmlabel:pasmlabel;
+function TLocalLabel.Gettasmlabel:tasmlabel;
 begin
   if not assigned(lab) then
    begin
      getlabel(lab);
      { this label is forced to be used so it's always written }
-     inc(lab^.refs);
+     inc(lab.refs);
    end;
-  Getpasmlabel:=lab;
+  Gettasmlabel:=lab;
 end;
 
 
@@ -1136,41 +1131,41 @@ end;
                              TLocalLabelList
 ***************************************************************************}
 
-procedure LocalLabelEmitted(p:PNamedIndexObject);
+procedure LocalLabelEmitted(p:tnamedindexitem);
 begin
-  if not PLocalLabel(p)^.emitted  then
-   Message1(asmr_e_unknown_label_identifier,p^.name);
+  if not TLocalLabel(p).emitted  then
+   Message1(asmr_e_unknown_label_identifier,p.name);
 end;
 
 procedure TLocalLabelList.CheckEmitted;
 begin
-  ForEach({$ifdef FPCPROCVAR}@{$endif}LocalLabelEmitted)
+  ForEach_Static({$ifdef FPCPROCVAR}@{$endif}LocalLabelEmitted)
 end;
 
 
-function CreateLocalLabel(const s: string; var hl: pasmlabel; emit:boolean):boolean;
+function CreateLocalLabel(const s: string; var hl: tasmlabel; emit:boolean):boolean;
 var
-  lab : PLocalLabel;
+  lab : TLocalLabel;
 Begin
   CreateLocalLabel:=true;
 { Check if it already is defined }
-  lab:=PLocalLabel(LocalLabelList^.Search(s));
+  lab:=TLocalLabel(LocalLabellist.Search(s));
   if not assigned(lab) then
    begin
-     new(lab,init(s));
-     LocalLabelList^.Insert(lab);
+     lab:=TLocalLabel.Create(s);
+     LocalLabellist.Insert(lab);
    end;
 { set emitted flag and check for dup syms }
   if emit then
    begin
-     if lab^.Emitted then
+     if lab.Emitted then
       begin
-        Message1(asmr_e_dup_local_sym,lab^.Name);
+        Message1(asmr_e_dup_local_sym,lab.Name);
         CreateLocalLabel:=false;
       end;
-     lab^.Emitted:=true;
+     lab.Emitted:=true;
    end;
-  hl:=lab^.Getpasmlabel;
+  hl:=lab.Gettasmlabel;
 end;
 
 
@@ -1180,30 +1175,30 @@ end;
 
 Function SearchType(const hs:string): Boolean;
 var
-  srsym : psym;
-  srsymtable : psymtable;
+  srsym : tsym;
+  srsymtable : tsymtable;
 begin
   searchsym(hs,srsym,srsymtable);
   SearchType:=assigned(srsym) and
-             (srsym^.typ=typesym);
+             (srsym.typ=typesym);
 end;
 
 
 
 Function SearchRecordType(const s:string): boolean;
 var
-  srsym : psym;
-  srsymtable : psymtable;
+  srsym : tsym;
+  srsymtable : tsymtable;
 Begin
   SearchRecordType:=false;
 { Check the constants in symtable }
   searchsym(s,srsym,srsymtable);
   if srsym <> nil then
    Begin
-     case srsym^.typ of
+     case srsym.typ of
        typesym :
          begin
-           if ptypesym(srsym)^.restype.def^.deftype in [recorddef,objectdef] then
+           if ttypesym(srsym).restype.def.deftype in [recorddef,objectdef] then
             begin
               SearchRecordType:=true;
               exit;
@@ -1224,8 +1219,8 @@ Function SearchIConstant(const s:string; var l:longint): boolean;
 {  respectively.                                                       }
 {**********************************************************************}
 var
-  srsym : psym;
-  srsymtable : psymtable;
+  srsym : tsym;
+  srsymtable : tsymtable;
 Begin
   SearchIConstant:=false;
 { check for TRUE or FALSE reserved words first }
@@ -1245,19 +1240,19 @@ Begin
   searchsym(s,srsym,srsymtable);
   if srsym <> nil then
    Begin
-     case srsym^.typ of
+     case srsym.typ of
        constsym :
          begin
-           if (pconstsym(srsym)^.consttyp in [constord,constint,constchar,constbool]) then
+           if (tconstsym(srsym).consttyp in [constord,constint,constchar,constbool]) then
             Begin
-              l:=pconstsym(srsym)^.value;
+              l:=tconstsym(srsym).value;
               SearchIConstant:=TRUE;
               exit;
             end;
          end;
        enumsym:
          Begin
-           l:=penumsym(srsym)^.value;
+           l:=tenumsym(srsym).value;
            SearchIConstant:=TRUE;
            exit;
          end;
@@ -1272,10 +1267,10 @@ Function GetRecordOffsetSize(s:string;Var Offset: longint;var Size:longint):bool
 { returns FALSE if not found.                                  }
 { used when base is a variable or a typed constant name.       }
 var
-  st   : psymtable;
-  harrdef : parraydef;
-  sym  : psym;
-  srsymtable : psymtable;
+  st   : tsymtable;
+  harrdef : tarraydef;
+  sym  : tsym;
+  srsymtable : tsymtable;
   i    : longint;
   base : string;
 Begin
@@ -1288,38 +1283,38 @@ Begin
   base:=Copy(s,1,i-1);
   delete(s,1,i);
   if base='SELF' then
-   st:=procinfo^._class^.symtable
+   st:=procinfo^._class.symtable
   else
    begin
      searchsym(base,sym,srsymtable);
      st:=nil;
      { we can start with a var,type,typedconst }
-     case sym^.typ of
+     case sym.typ of
        varsym :
          begin
-           case pvarsym(sym)^.vartype.def^.deftype of
+           case tvarsym(sym).vartype.def.deftype of
              recorddef :
-               st:=precorddef(pvarsym(sym)^.vartype.def)^.symtable;
+               st:=trecorddef(tvarsym(sym).vartype.def).symtable;
              objectdef :
-               st:=pobjectdef(pvarsym(sym)^.vartype.def)^.symtable;
+               st:=tobjectdef(tvarsym(sym).vartype.def).symtable;
            end;
          end;
        typesym :
          begin
-           case ptypesym(sym)^.restype.def^.deftype of
+           case ttypesym(sym).restype.def.deftype of
              recorddef :
-               st:=precorddef(ptypesym(sym)^.restype.def)^.symtable;
+               st:=trecorddef(ttypesym(sym).restype.def).symtable;
              objectdef :
-               st:=pobjectdef(ptypesym(sym)^.restype.def)^.symtable;
+               st:=tobjectdef(ttypesym(sym).restype.def).symtable;
            end;
          end;
        typedconstsym :
          begin
-           case ptypedconstsym(sym)^.typedconsttype.def^.deftype of
+           case ttypedconstsym(sym).typedconsttype.def.deftype of
              recorddef :
-               st:=precorddef(ptypedconstsym(sym)^.typedconsttype.def)^.symtable;
+               st:=trecorddef(ttypedconstsym(sym).typedconsttype.def).symtable;
              objectdef :
-               st:=pobjectdef(ptypedconstsym(sym)^.typedconsttype.def)^.symtable;
+               st:=tobjectdef(ttypedconstsym(sym).typedconsttype.def).symtable;
            end;
          end;
      end;
@@ -1333,36 +1328,36 @@ Begin
       i:=255;
      base:=Copy(s,1,i-1);
      delete(s,1,i);
-     if st^.symtabletype=objectsymtable then
-       sym:=search_class_member(pobjectdef(st^.defowner),base)
+     if st.symtabletype=objectsymtable then
+       sym:=search_class_member(tobjectdef(st.defowner),base)
      else
-       sym:=psym(st^.search(base));
+       sym:=tsym(st.search(base));
      if not assigned(sym) then
       begin
         GetRecordOffsetSize:=false;
         exit;
       end;
      st:=nil;
-     case sym^.typ of
+     case sym.typ of
        varsym :
          begin
-           inc(Offset,pvarsym(sym)^.address);
-           Size:=PVarsym(sym)^.getsize;
-           case pvarsym(sym)^.vartype.def^.deftype of
+           inc(Offset,tvarsym(sym).address);
+           Size:=tvarsym(sym).getsize;
+           case tvarsym(sym).vartype.def.deftype of
              arraydef :
                begin
                  { for arrays try to get the element size, take care of
                    multiple indexes }
-                 harrdef:=Parraydef(PVarsym(sym)^.vartype.def);
-                 while assigned(harrdef^.elementtype.def) and
-                       (harrdef^.elementtype.def^.deftype=arraydef) do
-                  harrdef:=parraydef(harrdef^.elementtype.def);
-                 size:=harrdef^.elesize;
+                 harrdef:=tarraydef(tvarsym(sym).vartype.def);
+                 while assigned(harrdef.elementtype.def) and
+                       (harrdef.elementtype.def.deftype=arraydef) do
+                  harrdef:=tarraydef(harrdef.elementtype.def);
+                 size:=harrdef.elesize;
                end;
              recorddef :
-               st:=precorddef(pvarsym(sym)^.vartype.def)^.symtable;
+               st:=trecorddef(tvarsym(sym).vartype.def).symtable;
              objectdef :
-               st:=pobjectdef(pvarsym(sym)^.vartype.def)^.symtable;
+               st:=tobjectdef(tvarsym(sym).vartype.def).symtable;
            end;
          end;
      end;
@@ -1371,10 +1366,10 @@ Begin
 end;
 
 
-Function SearchLabel(const s: string; var hl: pasmlabel;emit:boolean): boolean;
+Function SearchLabel(const s: string; var hl: tasmlabel;emit:boolean): boolean;
 var
-  sym : psym;
-  srsymtable : psymtable;
+  sym : tsym;
+  srsymtable : tsymtable;
   hs  : string;
 Begin
   hl:=nil;
@@ -1384,14 +1379,14 @@ Begin
   searchsym(hs,sym,srsymtable);
   if sym=nil then
    exit;
-  case sym^.typ of
+  case sym.typ of
     labelsym :
       begin
-        hl:=plabelsym(sym)^.lab;
+        hl:=tlabelsym(sym).lab;
         if emit then
-         plabelsym(sym)^.defined:=true
+         tlabelsym(sym).defined:=true
         else
-         plabelsym(sym)^.used:=true;
+         tlabelsym(sym).used:=true;
         SearchLabel:=true;
         exit;
       end;
@@ -1501,7 +1496,7 @@ end;
        end;
     end;
 
-   Procedure ConcatLabel(p: TAAsmoutput;var l : pasmlabel);
+   Procedure ConcatLabel(p: TAAsmoutput;var l : tasmlabel);
   {*********************************************************************}
   { PROCEDURE ConcatLabel                                               }
   {  Description: This routine either emits a label or a labeled        }
@@ -1564,7 +1559,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.17  2001-04-02 21:20:34  peter
+  Revision 1.18  2001-04-13 01:22:13  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.17  2001/04/02 21:20:34  peter
     * resulttype rewrite
 
   Revision 1.16  2001/03/11 22:58:50  peter

compiler/regvars.pas

@@ -37,7 +37,7 @@ interface
     procedure cleanup_regvars(asml: TAAsmoutput);
 {$ifdef i386}
     procedure store_regvar(asml: TAAsmoutput; reg: tregister);
-    procedure load_regvar(asml: TAAsmoutput; vsym: pvarsym);
+    procedure load_regvar(asml: TAAsmoutput; vsym: tvarsym);
     procedure load_regvar_reg(asml: TAAsmoutput; reg: tregister);
     procedure load_all_regvars(asml: TAAsmoutput);
 {$endif i386}
@@ -46,21 +46,20 @@ implementation
 
     uses
       globtype,systems,comphook,
-      cutils,cobjects,verbose,globals,
+      cutils,cclasses,verbose,globals,
       symconst,symbase,symtype,symdef,types,
       hcodegen,cpuasm,tgcpu;
 
-
     var
       parasym : boolean;
 
-    procedure searchregvars(p : pnamedindexobject);
+    procedure searchregvars(p : tnamedindexitem);
       var
          i,j,k : longint;
       begin
-         if (psym(p)^.typ=varsym) and (vo_regable in pvarsym(p)^.varoptions) then
+         if (tsym(p).typ=varsym) and (vo_regable in tvarsym(p).varoptions) then
            begin
-              j:=pvarsym(p)^.refs;
+              j:=tvarsym(p).refs;
               { parameter get a less value }
               if parasym then
                 begin
@@ -72,7 +71,7 @@ implementation
               { walk through all momentary register variables }
               for i:=1 to maxvarregs do
                 begin
-                  with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do
+                  with pregvarinfo(aktprocsym.definition.regvarinfo)^ do
                    if ((regvars[i]=nil) or (j>regvars_refs[i])) and (j>0) then
                      begin
                         for k:=maxvarregs-1 downto i do
@@ -82,8 +81,8 @@ implementation
                              regvars_refs[k+1]:=regvars_refs[k];
                           end;
                         { calc the new refs
-                        pvarsym(p)^.refs:=j; }
-                        regvars[i]:=pvarsym(p);
+                        tvarsym(p).refs:=j; }
+                        regvars[i]:=tvarsym(p);
                         regvars_para[i]:=parasym;
                         regvars_refs[i]:=j;
                         break;
@@ -93,13 +92,13 @@ implementation
       end;
 
 
-    procedure searchfpuregvars(p : pnamedindexobject);
+    procedure searchfpuregvars(p : tnamedindexitem);
       var
          i,j,k : longint;
       begin
-         if (psym(p)^.typ=varsym) and (vo_fpuregable in pvarsym(p)^.varoptions) then
+         if (tsym(p).typ=varsym) and (vo_fpuregable in tvarsym(p).varoptions) then
            begin
-              j:=pvarsym(p)^.refs;
+              j:=tvarsym(p).refs;
               { parameter get a less value }
               if parasym then
                 begin
@@ -111,7 +110,7 @@ implementation
               { walk through all momentary register variables }
               for i:=1 to maxfpuvarregs do
                 begin
-                  with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do
+                  with pregvarinfo(aktprocsym.definition.regvarinfo)^ do
                    if ((fpuregvars[i]=nil) or (j>fpuregvars_refs[i])) and (j>0) then
                      begin
                         for k:=maxfpuvarregs-1 downto i do
@@ -121,8 +120,8 @@ implementation
                              fpuregvars_refs[k+1]:=fpuregvars_refs[k];
                           end;
                         { calc the new refs
-                        pvarsym(p)^.refs:=j; }
-                        fpuregvars[i]:=pvarsym(p);
+                        tvarsym(p).refs:=j; }
+                        fpuregvars[i]:=tvarsym(p);
                         fpuregvars_para[i]:=parasym;
                         fpuregvars_refs[i]:=j;
                         break;
@@ -162,14 +161,14 @@ implementation
         begin
           new(regvarinfo);
           fillchar(regvarinfo^,sizeof(regvarinfo^),0);
-          aktprocsym^.definition^.regvarinfo := regvarinfo;
+          aktprocsym.definition.regvarinfo := regvarinfo;
           if (p.registers32<4) then
             begin
               parasym:=false;
-              symtablestack^.foreach({$ifdef FPCPROCVAR}@{$endif}searchregvars);
+              symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}searchregvars);
               { copy parameter into a register ? }
               parasym:=true;
-              symtablestack^.next^.foreach({$ifdef FPCPROCVAR}@{$endif}searchregvars);
+              symtablestack.next.foreach_static({$ifdef FPCPROCVAR}@{$endif}searchregvars);
               { hold needed registers free }
               for i:=maxvarregs downto maxvarregs-p.registers32+1 do
                 begin
@@ -180,7 +179,7 @@ implementation
               for i:=1 to maxvarregs-p.registers32 do
                 begin
                   if assigned(regvarinfo^.regvars[i]) and
-                    (reg_pushes[varregs[i]] < regvarinfo^.regvars[i]^.refs) then
+                    (reg_pushes[varregs[i]] < regvarinfo^.regvars[i].refs) then
                     begin
                       { register is no longer available for }
                       { expressions                          }
@@ -192,34 +191,34 @@ implementation
 
                       { possibly no 32 bit register are needed }
                       { call by reference/const ? }
-                      if (regvarinfo^.regvars[i]^.varspez in [vs_var,vs_out]) or
-                         ((regvarinfo^.regvars[i]^.varspez=vs_const) and
-                           push_addr_param(regvarinfo^.regvars[i]^.vartype.def)) then
+                      if (regvarinfo^.regvars[i].varspez in [vs_var,vs_out]) or
+                         ((regvarinfo^.regvars[i].varspez=vs_const) and
+                           push_addr_param(regvarinfo^.regvars[i].vartype.def)) then
                         begin
-                           regvarinfo^.regvars[i]^.reg:=varregs[i];
+                           regvarinfo^.regvars[i].reg:=varregs[i];
                         end
                       else
-                       if (regvarinfo^.regvars[i]^.vartype.def^.deftype in [orddef,enumdef]) and
-                          (porddef(regvarinfo^.regvars[i]^.vartype.def)^.size=1) then
+                       if (regvarinfo^.regvars[i].vartype.def.deftype in [orddef,enumdef]) and
+                          (torddef(regvarinfo^.regvars[i].vartype.def).size=1) then
                         begin
 {$ifdef i386}
-                          regvarinfo^.regvars[i]^.reg:=reg32toreg8(varregs[i]);
+                          regvarinfo^.regvars[i].reg:=reg32toreg8(varregs[i]);
 {$endif}
                         end
                       else
-                       if (regvarinfo^.regvars[i]^.vartype.def^.deftype in [orddef,enumdef]) and
-                          (porddef(regvarinfo^.regvars[i]^.vartype.def)^.size=2) then
+                       if (regvarinfo^.regvars[i].vartype.def.deftype in [orddef,enumdef]) and
+                          (torddef(regvarinfo^.regvars[i].vartype.def).size=2) then
                          begin
 {$ifdef i386}
-                           regvarinfo^.regvars[i]^.reg:=reg32toreg16(varregs[i]);
+                           regvarinfo^.regvars[i].reg:=reg32toreg16(varregs[i]);
 {$endif}
                          end
                       else
                         begin
-                          regvarinfo^.regvars[i]^.reg:=varregs[i];
+                          regvarinfo^.regvars[i].reg:=varregs[i];
                         end;
                       if regvarinfo^.regvars_para[i] then
-                        unused:=unused - [regvarinfo^.regvars[i]^.reg];
+                        unused:=unused - [regvarinfo^.regvars[i].reg];
                       { procedure uses this register }
 {$ifdef i386}
                       usedinproc:=usedinproc or ($80 shr byte(varregs[i]));
@@ -238,11 +237,11 @@ implementation
             if ((p.registersfpu+1)<maxfpuvarregs) then
               begin
                 parasym:=false;
-                symtablestack^.foreach({$ifdef FPCPROCVAR}@{$endif}searchfpuregvars);
+                symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}searchfpuregvars);
 {$ifdef dummy}
                 { copy parameter into a register ? }
                 parasym:=true;
-                symtablestack^.next^.foreach({$ifdef FPCPROCVAR}@{$endif}searchregvars);
+                symtablestack.next.foreach_static({$ifdef FPCPROCVAR}@{$endif}searchregvars);
 {$endif dummy}
                 { hold needed registers free }
 
@@ -273,10 +272,10 @@ implementation
                      begin
 {$ifdef i386}
                        { reserve place on the FPU stack }
-                       regvarinfo^.fpuregvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
+                       regvarinfo^.fpuregvars[i].reg:=correct_fpuregister(R_ST0,i-1);
 {$endif i386}
 {$ifdef m68k}
-                       regvarinfo^.fpuregvars[i]^.reg:=fpuvarregs[i];
+                       regvarinfo^.fpuregvars[i].reg:=fpuvarregs[i];
 {$endif m68k}
                      end;
                   end;
@@ -291,25 +290,25 @@ implementation
       i: longint;
       hr: preference;
       regvarinfo: pregvarinfo;
-      vsym: pvarsym;
+      vsym: tvarsym;
     begin
-      regvarinfo := pregvarinfo(aktprocsym^.definition^.regvarinfo);
+      regvarinfo := pregvarinfo(aktprocsym.definition.regvarinfo);
       if not assigned(regvarinfo) then
         exit;
       for i := 1 to maxvarregs do
         if assigned(regvarinfo^.regvars[i]) and
-           (reg32(regvarinfo^.regvars[i]^.reg) = reg) then
+           (reg32(regvarinfo^.regvars[i].reg) = reg) then
           begin
             if regvar_loaded[reg32(reg)] then
               begin
-                vsym := pvarsym(regvarinfo^.regvars[i]);
+                vsym := tvarsym(regvarinfo^.regvars[i]);
                 new(hr);
                 reset_reference(hr^);
-                if vsym^.owner^.symtabletype in [inlinelocalsymtable,localsymtable] then
-                  hr^.offset:=-vsym^.address+vsym^.owner^.address_fixup
-                else hr^.offset:=vsym^.address+vsym^.owner^.address_fixup;
+                if vsym.owner.symtabletype in [inlinelocalsymtable,localsymtable] then
+                  hr^.offset:=-vsym.address+vsym.owner.address_fixup
+                else hr^.offset:=vsym.address+vsym.owner.address_fixup;
                 hr^.base:=procinfo^.framepointer;
-                asml.concat(Taicpu.op_reg_ref(A_MOV,regsize(vsym^.reg),vsym^.reg,hr));
+                asml.concat(Taicpu.op_reg_ref(A_MOV,regsize(vsym.reg),vsym.reg,hr));
                 asml.concat(Tairegalloc.dealloc(reg32(reg)));
                 regvar_loaded[reg32(reg)] := false;
               end;
@@ -317,20 +316,20 @@ implementation
           end;
     end;
 
-    procedure load_regvar(asml: TAAsmoutput; vsym: pvarsym);
+    procedure load_regvar(asml: TAAsmoutput; vsym: tvarsym);
     var
       hr: preference;
       opsize: topsize;
       opcode: tasmop;
     begin
-      if not regvar_loaded[reg32(vsym^.reg)] then
+      if not regvar_loaded[reg32(vsym.reg)] then
         begin
-          asml.concat(Tairegalloc.alloc(reg32(vsym^.reg)));
+          asml.concat(Tairegalloc.alloc(reg32(vsym.reg)));
           { zero the regvars because the upper 48bits must be clear }
           { for 8bits vars when using them with btrl                }
           { don't care about sign extension, since the upper 24/16  }
           { bits won't be adapted when doing maths anyway (JM)      }
-          case regsize(vsym^.reg) of
+          case regsize(vsym.reg) of
             S_L:
               begin
                 opsize := S_L;
@@ -347,15 +346,15 @@ implementation
                 opcode := A_MOVZX;
               end;
           end;
-          asml.concat(Tairegalloc.alloc(reg32(vsym^.reg)));
+          asml.concat(Tairegalloc.alloc(reg32(vsym.reg)));
           new(hr);
           reset_reference(hr^);
-          if vsym^.owner^.symtabletype in [inlinelocalsymtable,localsymtable] then
-            hr^.offset:=-vsym^.address+vsym^.owner^.address_fixup
-          else hr^.offset:=vsym^.address+vsym^.owner^.address_fixup;
+          if vsym.owner.symtabletype in [inlinelocalsymtable,localsymtable] then
+            hr^.offset:=-vsym.address+vsym.owner.address_fixup
+          else hr^.offset:=vsym.address+vsym.owner.address_fixup;
           hr^.base:=procinfo^.framepointer;
-          asml.concat(Taicpu.op_ref_reg(opcode,opsize,hr,reg32(vsym^.reg)));
-          regvar_loaded[reg32(vsym^.reg)] := true;
+          asml.concat(Taicpu.op_ref_reg(opcode,opsize,hr,reg32(vsym.reg)));
+          regvar_loaded[reg32(vsym.reg)] := true;
         end;
     end;
 
@@ -364,14 +363,14 @@ implementation
       i: longint;
       regvarinfo: pregvarinfo;
     begin
-      regvarinfo := pregvarinfo(aktprocsym^.definition^.regvarinfo);
+      regvarinfo := pregvarinfo(aktprocsym.definition.regvarinfo);
       if not assigned(regvarinfo) then
         exit;
       reg := reg32(reg);
       for i := 1 to maxvarregs do
         if assigned(regvarinfo^.regvars[i]) and
-           (reg32(regvarinfo^.regvars[i]^.reg) = reg) then
-          load_regvar(asml,pvarsym(regvarinfo^.regvars[i]))
+           (reg32(regvarinfo^.regvars[i].reg) = reg) then
+          load_regvar(asml,tvarsym(regvarinfo^.regvars[i]))
     end;
 
     procedure load_all_regvars(asml: TAAsmoutput);
@@ -379,13 +378,13 @@ implementation
       i: longint;
       regvarinfo: pregvarinfo;
     begin
-      regvarinfo := pregvarinfo(aktprocsym^.definition^.regvarinfo);
+      regvarinfo := pregvarinfo(aktprocsym.definition.regvarinfo);
       if not assigned(regvarinfo) then
         exit;
       for i := 1 to maxvarregs do
         if assigned(regvarinfo^.regvars[i]) and
-           (reg32(regvarinfo^.regvars[i]^.reg) in [R_EAX,R_EBX,R_ECX,R_EDX]) then
-          load_regvar(asml,pvarsym(regvarinfo^.regvars[i]))
+           (reg32(regvarinfo^.regvars[i].reg) in [R_EAX,R_EBX,R_ECX,R_EDX]) then
+          load_regvar(asml,tvarsym(regvarinfo^.regvars[i]))
     end;
 
 {$endif i386}
@@ -394,13 +393,13 @@ implementation
     procedure load_regvars(asml: TAAsmoutput; p: tnode);
     var
       i: longint;
-      {hr      : preference;}
+      {hr      : treference;}
       regvarinfo: pregvarinfo;
     begin
       if (cs_regalloc in aktglobalswitches) and
          ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
         begin
-          regvarinfo := pregvarinfo(aktprocsym^.definition^.regvarinfo);
+          regvarinfo := pregvarinfo(aktprocsym.definition.regvarinfo);
           { can happen when inlining assembler procedures (JM) }
           if not assigned(regvarinfo) then
             exit;
@@ -416,10 +415,10 @@ implementation
                   { when loading parameter to reg  }
                   new(hr);
                   reset_reference(hr^);
-                  hr^.offset:=pvarsym(regvarinfo^.regvars[i])^.address+procinfo^.para_offset;
+                  hr^.offset:=tvarsym(regvarinfo^.regvars[i])^.address+procinfo^.para_offset;
                   hr^.base:=procinfo^.framepointer;
-                  asml.concat(Taicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i]^.reg),
-                    hr,regvarinfo^.regvars[i]^.reg)));
+                  asml.concat(Taicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i].reg),
+                    hr,regvarinfo^.regvars[i].reg)));
                 end
             end;
 {$endif m68k}
@@ -428,12 +427,12 @@ implementation
              if assigned(regvarinfo^.regvars[i]) then
                begin
                 if cs_asm_source in aktglobalswitches then
-                 asml.insert(Tai_asm_comment.Create(strpnew(regvarinfo^.regvars[i]^.name+
-                  ' with weight '+tostr(regvarinfo^.regvars[i]^.refs)+' assigned to register '+
-                  reg2str(regvarinfo^.regvars[i]^.reg))));
+                 asml.insert(Tai_asm_comment.Create(strpnew(regvarinfo^.regvars[i].name+
+                  ' with weight '+tostr(regvarinfo^.regvars[i].refs)+' assigned to register '+
+                  reg2str(regvarinfo^.regvars[i].reg))));
                 if (status.verbosity and v_debug)=v_debug then
-                 Message3(cg_d_register_weight,reg2str(regvarinfo^.regvars[i]^.reg),
-                  tostr(regvarinfo^.regvars[i]^.refs),regvarinfo^.regvars[i]^.name);
+                 Message3(cg_d_register_weight,reg2str(regvarinfo^.regvars[i].reg),
+                  tostr(regvarinfo^.regvars[i].refs),regvarinfo^.regvars[i].name);
                end;
             end;
           for i:=1 to maxfpuvarregs do
@@ -442,7 +441,7 @@ implementation
                 begin
 {$ifdef i386}
                   { reserve place on the FPU stack }
-                  regvarinfo^.fpuregvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
+                  regvarinfo^.fpuregvars[i].reg:=correct_fpuregister(R_ST0,i-1);
                   asml.concat(Taicpu.op_none(A_FLDZ,S_NO));
 {$endif i386}
 {$ifdef dummy}
@@ -455,15 +454,15 @@ implementation
                       { when loading parameter to reg  }
                       new(hr);
                       reset_reference(hr^);
-                      hr^.offset:=pvarsym(regvarinfo^.regvars[i])^.address+procinfo^.para_offset;
+                      hr^.offset:=tvarsym(regvarinfo^.regvars[i])^.address+procinfo^.para_offset;
                       hr^.base:=procinfo^.framepointer;
 {$ifdef i386}
-                      asml.concat(Taicpu,op_ref_reg(A_MOV,regsize(regvarinfo^.regvars[i]^.reg),
-                        hr,regvarinfo^.regvars[i]^.reg)));
+                      asml.concat(Taicpu,op_ref_reg(A_MOV,regsize(regvarinfo^.regvars[i].reg),
+                        hr,regvarinfo^.regvars[i].reg)));
 {$endif i386}
 {$ifdef m68k}
-                      asml.concat(Taicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i]^.reg),
-                        hr,regvarinfo^.regvars[i]^.reg)));
+                      asml.concat(Taicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i].reg),
+                        hr,regvarinfo^.regvars[i].reg)));
 {$endif m68k}
                     end;
 {$endif dummy}
@@ -478,12 +477,12 @@ implementation
                if assigned(regvarinfo^.fpuregvars[i]) then
                  begin
                     if cs_asm_source in aktglobalswitches then
-                      asml.insert(Tai_asm_comment.Create(strpnew(regvarinfo^.fpuregvars[i]^.name+
-                        ' with weight '+tostr(regvarinfo^.fpuregvars[i]^.refs)+' assigned to register '+
-                        reg2str(regvarinfo^.fpuregvars[i]^.reg))));
+                      asml.insert(Tai_asm_comment.Create(strpnew(regvarinfo^.fpuregvars[i].name+
+                        ' with weight '+tostr(regvarinfo^.fpuregvars[i].refs)+' assigned to register '+
+                        reg2str(regvarinfo^.fpuregvars[i].reg))));
                     if (status.verbosity and v_debug)=v_debug then
-                      Message3(cg_d_register_weight,reg2str(regvarinfo^.fpuregvars[i]^.reg),
-                        tostr(regvarinfo^.fpuregvars[i]^.refs),regvarinfo^.fpuregvars[i]^.name);
+                      Message3(cg_d_register_weight,reg2str(regvarinfo^.fpuregvars[i].reg),
+                        tostr(regvarinfo^.fpuregvars[i].refs),regvarinfo^.fpuregvars[i].name);
                  end;
             end;
           if cs_asm_source in aktglobalswitches then
@@ -498,11 +497,11 @@ implementation
     begin
 {$ifdef i386}
       { can happen when inlining assembler procedures (JM) }
-      if not assigned(aktprocsym^.definition^.regvarinfo) then
+      if not assigned(aktprocsym.definition.regvarinfo) then
         exit;
       if (cs_regalloc in aktglobalswitches) and
          ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
-        with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do
+        with pregvarinfo(aktprocsym.definition.regvarinfo)^ do
           begin
             for i:=1 to maxfpuvarregs do
               if assigned(fpuregvars[i]) then
@@ -510,8 +509,8 @@ implementation
                 asml.concat(Taicpu.op_reg(A_FSTP,S_NO,R_ST0));
             for i := 1 to maxvarregs do
               if assigned(regvars[i]) and
-                 (regvar_loaded[reg32(regvars[i]^.reg)]) then
-                asml.concat(Tairegalloc.dealloc(reg32(regvars[i]^.reg)));
+                 (regvar_loaded[reg32(regvars[i].reg)]) then
+                asml.concat(Tairegalloc.dealloc(reg32(regvars[i].reg)));
           end;
 {$endif i386}
     end;
@@ -520,7 +519,12 @@ end.
 
 {
   $Log$
-  Revision 1.15  2000-12-25 00:07:28  peter
+  Revision 1.16  2001-04-13 01:22:13  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.15  2000/12/25 00:07:28  peter
     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
       tlinkedlist objects)
 

compiler/scandir.inc

@@ -177,7 +177,7 @@ const
     function read_factor : string;
       var
          hs : string;
-         mac : pmacro;
+         mac : tmacro;
          len : byte;
       begin
          if preproc_token=_ID then
@@ -193,22 +193,22 @@ const
                 end
               else
                 begin
-                   mac:=pmacro(current_scanner^.macros^.search(hs));
+                   mac:=tmacro(current_scanner^.macros.search(hs));
                    hs:=preprocpat;
                    preproc_consume(_ID);
                    if assigned(mac) then
                      begin
-                        if mac^.defined and assigned(mac^.buftext) then
+                        if mac.defined and assigned(mac.buftext) then
                           begin
-                             if mac^.buflen>255 then
+                             if mac.buflen>255 then
                                begin
                                   len:=255;
                                   Message(scan_w_macro_cut_after_255_chars);
                                end
                              else
-                               len:=mac^.buflen;
+                               len:=mac.buflen;
                              hs[0]:=char(len);
-                             move(mac^.buftext^,hs[1],len);
+                             move(mac.buftext^,hs[1],len);
                           end
                         else
                           read_factor:='';
@@ -340,7 +340,7 @@ const
     procedure dir_conditional(t:tdirectivetoken);
       var
         hs    : string;
-        mac   : pmacro;
+        mac   : tmacro;
         found : boolean;
         state : char;
         oldaktfilepos : tfileposinfo;
@@ -359,10 +359,10 @@ const
    _DIR_IFDEF : begin
                   current_scanner^.skipspace;
                   hs:=current_scanner^.readid;
-                  mac:=pmacro(current_scanner^.macros^.search(hs));
+                  mac:=tmacro(current_scanner^.macros.search(hs));
                   if assigned(mac) then
-                    mac^.is_used:=true;
-                  current_scanner^.addpreprocstack(pp_ifdef,assigned(mac) and mac^.defined,hs,scan_c_ifdef_found);
+                    mac.is_used:=true;
+                  current_scanner^.addpreprocstack(pp_ifdef,assigned(mac) and mac.defined,hs,scan_c_ifdef_found);
                 end;
    _DIR_IFOPT : begin
                   current_scanner^.skipspace;
@@ -387,14 +387,14 @@ const
   _DIR_IFNDEF : begin
                   current_scanner^.skipspace;
                   hs:=current_scanner^.readid;
-                  mac:=pmacro(current_scanner^.macros^.search(hs));
+                  mac:=tmacro(current_scanner^.macros.search(hs));
                   if assigned(mac) then
-                    mac^.is_used:=true;
-                  current_scanner^.addpreprocstack(pp_ifndef,not(assigned(mac) and mac^.defined),hs,scan_c_ifndef_found);
+                    mac.is_used:=true;
+                  current_scanner^.addpreprocstack(pp_ifndef,not(assigned(mac) and mac.defined),hs,scan_c_ifndef_found);
                 end;
            end;
          { accept the text ? }
-           if (current_scanner^.preprocstack=nil) or current_scanner^.preprocstack^.accept then
+           if (current_scanner^.preprocstack=nil) or current_scanner^.preprocstack.accept then
             break
            else
             begin
@@ -416,32 +416,32 @@ const
       var
         hs  : string;
         bracketcount : longint;
-        mac : pmacro;
+        mac : tmacro;
         macropos : longint;
         macrobuffer : pmacrobuffer;
       begin
         current_scanner^.skipspace;
         hs:=current_scanner^.readid;
-        mac:=pmacro(current_scanner^.macros^.search(hs));
+        mac:=tmacro(current_scanner^.macros.search(hs));
         if not assigned(mac) then
           begin
-            mac:=new(pmacro,init(hs));
-            mac^.defined:=true;
-            Message1(parser_m_macro_defined,mac^.name);
-            current_scanner^.macros^.insert(mac);
+            mac:=tmacro.create(hs);
+            mac.defined:=true;
+            Message1(parser_m_macro_defined,mac.name);
+            current_scanner^.macros.insert(mac);
           end
         else
           begin
-            Message1(parser_m_macro_defined,mac^.name);
-            mac^.defined:=true;
+            Message1(parser_m_macro_defined,mac.name);
+            mac.defined:=true;
           { delete old definition }
-            if assigned(mac^.buftext) then
+            if assigned(mac.buftext) then
              begin
-               freemem(mac^.buftext,mac^.buflen);
-               mac^.buftext:=nil;
+               freemem(mac.buftext,mac.buflen);
+               mac.buftext:=nil;
              end;
           end;
-        mac^.is_used:=true;
+        mac.is_used:=true;
         if (cs_support_macro in aktmoduleswitches) then
           begin
           { key words are never substituted }
@@ -479,13 +479,13 @@ const
                           Message(scan_f_macro_buffer_overflow);
                        until false;
                        { free buffer of macro ?}
-                       if assigned(mac^.buftext) then
-                         freemem(mac^.buftext,mac^.buflen);
+                       if assigned(mac.buftext) then
+                         freemem(mac.buftext,mac.buflen);
                        { get new mem }
-                       getmem(mac^.buftext,macropos);
-                       mac^.buflen:=macropos;
+                       getmem(mac.buftext,macropos);
+                       mac.buflen:=macropos;
                        { copy the text }
-                       move(macrobuffer^,mac^.buftext^,macropos);
+                       move(macrobuffer^,mac.buftext^,macropos);
                        dispose(macrobuffer);
                     end;
                end;
@@ -508,30 +508,30 @@ const
     procedure dir_undef(t:tdirectivetoken);
       var
         hs  : string;
-        mac : pmacro;
+        mac : tmacro;
       begin
         current_scanner^.skipspace;
         hs:=current_scanner^.readid;
-        mac:=pmacro(current_scanner^.macros^.search(hs));
+        mac:=tmacro(current_scanner^.macros.search(hs));
         if not assigned(mac) then
           begin
-             mac:=new(pmacro,init(hs));
-             Message1(parser_m_macro_undefined,mac^.name);
-             mac^.defined:=false;
-             current_scanner^.macros^.insert(mac);
+             mac:=tmacro.create(hs);
+             Message1(parser_m_macro_undefined,mac.name);
+             mac.defined:=false;
+             current_scanner^.macros.insert(mac);
           end
         else
           begin
-             Message1(parser_m_macro_undefined,mac^.name);
-             mac^.defined:=false;
+             Message1(parser_m_macro_undefined,mac.name);
+             mac.defined:=false;
              { delete old definition }
-             if assigned(mac^.buftext) then
+             if assigned(mac.buftext) then
                begin
-                  freemem(mac^.buftext,mac^.buflen);
-                  mac^.buftext:=nil;
+                  freemem(mac.buftext,mac.buflen);
+                  mac.buftext:=nil;
                end;
           end;
-        mac^.is_used:=true;
+        mac.is_used:=true;
       end;
 
 
@@ -1394,7 +1394,12 @@ const
 
 {
   $Log$
-  Revision 1.19  2001-03-13 18:45:07  peter
+  Revision 1.20  2001-04-13 01:22:13  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.19  2001/03/13 18:45:07  peter
     * fixed some memory leaks
 
   Revision 1.18  2001/02/20 21:41:18  peter

compiler/scanner.pas

@@ -27,7 +27,7 @@ unit scanner;
 interface
 
     uses
-       cobjects,cclasses,
+       cclasses,
        globtype,globals,version,tokens,
        verbose,comphook,
        finput,
@@ -45,27 +45,25 @@ interface
        pmacrobuffer = ^tmacrobuffer;
        tmacrobuffer = array[0..maxmacrolen-1] of char;
 
-       pmacro = ^tmacro;
-       tmacro = object(tnamedindexobject)
+       tmacro = class(TNamedIndexItem)
           defined,
           defined_at_startup,
           is_used : boolean;
           buftext : pchar;
           buflen  : longint;
-          constructor init(const n : string);
-          destructor  done;virtual;
+          constructor Create(const n : string);
+          destructor  destroy;override;
        end;
 
        preproctyp = (pp_ifdef,pp_ifndef,pp_if,pp_ifopt,pp_else);
-       ppreprocstack = ^tpreprocstack;
-       tpreprocstack = object
+
+       tpreprocstack = class
           typ     : preproctyp;
           accept  : boolean;
-          next    : ppreprocstack;
+          next    : tpreprocstack;
           name    : stringid;
           line_nb : longint;
-          constructor init(atyp:preproctyp;a:boolean;n:ppreprocstack);
-          destructor done;
+          constructor Create(atyp:preproctyp;a:boolean;n:tpreprocstack);
        end;
 
        pscannerfile = ^tscannerfile;
@@ -87,9 +85,9 @@ interface
           yylexcount     : longint;
           lastasmgetchar : char;
           ignoredirectives : tstringlist; { ignore directives, used to give warnings only once }
-          preprocstack   : ppreprocstack;
+          preprocstack   : tpreprocstack;
           invalid        : boolean; { flag if sourcefiles have been destroyed ! }
-          macros         : pdictionary;
+          macros         : Tdictionary;
           in_asm_string  : boolean;
 
           constructor init(const fn:string);
@@ -136,7 +134,7 @@ interface
        end;
 
 {$ifdef PREPROCWRITE}
-       ppreprocfile=^tpreprocfile;
+       tpreprocfile=^tpreprocfile;
        tpreprocfile=object
          f   : text;
          buf : pointer;
@@ -163,7 +161,7 @@ interface
         current_scanner : pscannerfile;
         aktcommentstyle : tcommentstyle; { needed to use read_comment from directives }
 {$ifdef PREPROCWRITE}
-        preprocfile     : ppreprocfile; { used with only preprocessing }
+        preprocfile     : tpreprocfile; { used with only preprocessing }
 {$endif PREPROCWRITE}
 
 
@@ -218,9 +216,9 @@ implementation
                                  TMacro
 *****************************************************************************}
 
-    constructor tmacro.init(const n : string);
+    constructor tmacro.create(const n : string);
       begin
-         inherited initname(n);
+         inherited createname(n);
          defined:=true;
          defined_at_startup:=false;
          is_used:=false;
@@ -229,11 +227,11 @@ implementation
       end;
 
 
-    destructor tmacro.done;
+    destructor tmacro.destroy;
       begin
          if assigned(buftext) then
            freemem(buftext,buflen);
-         inherited done;
+         inherited destroy;
       end;
 
 
@@ -293,7 +291,7 @@ implementation
                               TPreProcStack
 *****************************************************************************}
 
-    constructor tpreprocstack.init(atyp : preproctyp;a:boolean;n:ppreprocstack);
+    constructor tpreprocstack.create(atyp : preproctyp;a:boolean;n:tpreprocstack);
       begin
         accept:=a;
         typ:=atyp;
@@ -301,11 +299,6 @@ implementation
       end;
 
 
-    destructor tpreprocstack.done;
-      begin
-      end;
-
-
 {****************************************************************************
                                 TSCANNERFILE
  ****************************************************************************}
@@ -333,7 +326,7 @@ implementation
         ignoredirectives:=TStringList.Create;
         invalid:=false;
         in_asm_string:=false;
-        new(macros,init);
+        macros:=tdictionary.create;
       { load block }
         if not openinputfile then
          Message1(scan_f_cannot_open_input,fn);
@@ -352,7 +345,12 @@ implementation
         if not invalid then
           begin
              if status.errorcount=0 then
-              checkpreprocstack;
+              checkpreprocstack
+             else
+              begin
+                while assigned(preprocstack) do
+                 poppreprocstack;
+              end;
            { close file, but only if we are the first compile }
            { probably not necessary anymore with invalid flag PM }
              if not current_module.in_second_compile then
@@ -362,47 +360,47 @@ implementation
               end;
           end;
          ignoredirectives.free;
-         dispose(macros,done);
+         macros.free;
        end;
 
 
     procedure tscannerfile.def_macro(const s : string);
       var
-        mac : pmacro;
+        mac : tmacro;
       begin
-         mac:=pmacro(macros^.search(s));
+         mac:=tmacro(macros.search(s));
          if mac=nil then
            begin
-             mac:=new(pmacro,init(s));
-             Message1(parser_m_macro_defined,mac^.name);
-             macros^.insert(mac);
+             mac:=tmacro.create(s);
+             Message1(parser_m_macro_defined,mac.name);
+             macros.insert(mac);
            end;
-         mac^.defined:=true;
-         mac^.defined_at_startup:=true;
+         mac.defined:=true;
+         mac.defined_at_startup:=true;
       end;
 
 
     procedure tscannerfile.set_macro(const s : string;value : string);
       var
-        mac : pmacro;
+        mac : tmacro;
       begin
-         mac:=pmacro(macros^.search(s));
+         mac:=tmacro(macros.search(s));
          if mac=nil then
            begin
-             mac:=new(pmacro,init(s));
-             macros^.insert(mac);
+             mac:=tmacro.create(s);
+             macros.insert(mac);
            end
          else
            begin
-              if assigned(mac^.buftext) then
-                freemem(mac^.buftext,mac^.buflen);
+              if assigned(mac.buftext) then
+                freemem(mac.buftext,mac.buflen);
            end;
-         Message2(parser_m_macro_set_to,mac^.name,value);
-         mac^.buflen:=length(value);
-         getmem(mac^.buftext,mac^.buflen);
-         move(value[1],mac^.buftext^,mac^.buflen);
-         mac^.defined:=true;
-         mac^.defined_at_startup:=true;
+         Message2(parser_m_macro_set_to,mac.name,value);
+         mac.buflen:=length(value);
+         getmem(mac.buftext,mac.buflen);
+         move(value[1],mac.buftext^,mac.buflen);
+         mac.defined:=true;
+         mac.defined_at_startup:=true;
       end;
 
 
@@ -700,7 +698,7 @@ implementation
       { check for missing ifdefs }
         while assigned(preprocstack) do
          begin
-           Message3(scan_e_endif_expected,preprocstring[preprocstack^.typ],preprocstack^.name,tostr(preprocstack^.line_nb));
+           Message3(scan_e_endif_expected,preprocstring[preprocstack.typ],preprocstack.name,tostr(preprocstack.line_nb));
            poppreprocstack;
          end;
       end;
@@ -708,13 +706,13 @@ implementation
 
     procedure tscannerfile.poppreprocstack;
       var
-        hp : ppreprocstack;
+        hp : tpreprocstack;
       begin
         if assigned(preprocstack) then
          begin
-           Message1(scan_c_endif_found,preprocstack^.name);
-           hp:=preprocstack^.next;
-           dispose(preprocstack,done);
+           Message1(scan_c_endif_found,preprocstack.name);
+           hp:=preprocstack.next;
+           preprocstack.free;
            preprocstack:=hp;
          end
         else
@@ -724,13 +722,13 @@ implementation
 
     procedure tscannerfile.addpreprocstack(atyp : preproctyp;a:boolean;const s:string;w:longint);
       begin
-        preprocstack:=new(ppreprocstack,init(atyp,((preprocstack=nil) or preprocstack^.accept) and a,preprocstack));
-        preprocstack^.name:=s;
-        preprocstack^.line_nb:=line_no;
-        if preprocstack^.accept then
-         Message2(w,preprocstack^.name,'accepted')
+        preprocstack:=tpreprocstack.create(atyp,((preprocstack=nil) or preprocstack.accept) and a,preprocstack);
+        preprocstack.name:=s;
+        preprocstack.line_nb:=line_no;
+        if preprocstack.accept then
+         Message2(w,preprocstack.name,'accepted')
         else
-         Message2(w,preprocstack^.name,'rejected');
+         Message2(w,preprocstack.name,'rejected');
       end;
 
 
@@ -738,14 +736,14 @@ implementation
       begin
         if assigned(preprocstack) then
          begin
-           preprocstack^.typ:=pp_else;
-           preprocstack^.line_nb:=line_no;
-           if not(assigned(preprocstack^.next)) or (preprocstack^.next^.accept) then
-            preprocstack^.accept:=not preprocstack^.accept;
-           if preprocstack^.accept then
-            Message2(scan_c_else_found,preprocstack^.name,'accepted')
+           preprocstack.typ:=pp_else;
+           preprocstack.line_nb:=line_no;
+           if not(assigned(preprocstack.next)) or (preprocstack.next.accept) then
+            preprocstack.accept:=not preprocstack.accept;
+           if preprocstack.accept then
+            Message2(scan_c_else_found,preprocstack.name,'accepted')
            else
-            Message2(scan_c_else_found,preprocstack^.name,'rejected');
+            Message2(scan_c_else_found,preprocstack.name,'rejected');
          end
         else
          Message(scan_e_endif_without_if);
@@ -1240,7 +1238,7 @@ implementation
         code    : integer;
         low,high,mid : longint;
         m       : longint;
-        mac     : pmacro;
+        mac     : tmacro;
         asciinr : string[6];
         iswidestring : boolean;
       label
@@ -1322,10 +1320,10 @@ implementation
             { this takes some time ... }
               if (cs_support_macro in aktmoduleswitches) then
                begin
-                 mac:=pmacro(macros^.search(pattern));
-                 if assigned(mac) and (assigned(mac^.buftext)) then
+                 mac:=tmacro(macros.search(pattern));
+                 if assigned(mac) and (assigned(mac.buftext)) then
                   begin
-                    insertmacro(pattern,mac^.buftext,mac^.buflen);
+                    insertmacro(pattern,mac.buftext,mac.buflen);
                   { handle empty macros }
                     if c=#0 then
                      begin
@@ -1946,7 +1944,12 @@ exit_label:
 end.
 {
   $Log$
-  Revision 1.13  2000-12-25 00:07:28  peter
+  Revision 1.14  2001-04-13 01:22:13  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.13  2000/12/25 00:07:28  peter
     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
       tlinkedlist objects)
 

compiler/script.pas

@@ -30,31 +30,28 @@ uses
   cclasses;
 
 type
-  PScript=^TScript;
-  TScript=object
+  TScript=class
     fn   : string[80];
     data : TStringList;
     executable : boolean;
-    constructor Init(const s:string);
-    constructor InitExec(const s:string);
-    destructor Done;
+    constructor Create(const s:string);
+    constructor CreateExec(const s:string);
+    destructor Destroy;override;
     procedure AddStart(const s:string);
     procedure Add(const s:string);
     Function  Empty:boolean;
     procedure WriteToDisk;virtual;
   end;
 
-  PAsmScript = ^TAsmScript;
-  TAsmScript = Object (TScript)
-    Constructor Init (Const ScriptName : String);
+  TAsmScript = class (TScript)
+    Constructor Create(Const ScriptName : String);
     Procedure AddAsmCommand (Const Command, Options,FileName : String);
     Procedure AddLinkCommand (Const Command, Options, FileName : String);
     Procedure AddDeleteCommand (Const FileName : String);
-    Procedure WriteToDisk;virtual;
+    Procedure WriteToDisk;override;
   end;
 
-  PLinkRes = ^TLinkRes;
-  TLinkRes = Object (TScript)
+  TLinkRes = Class (TScript)
     procedure Add(const s:string);
     procedure AddFileName(const s:string);
   end;
@@ -81,7 +78,7 @@ uses
                                   TScript
 ****************************************************************************}
 
-constructor TScript.Init(const s:string);
+constructor TScript.Create(const s:string);
 begin
   fn:=FixFileName(s);
   executable:=false;
@@ -89,7 +86,7 @@ begin
 end;
 
 
-constructor TScript.InitExec(const s:string);
+constructor TScript.CreateExec(const s:string);
 begin
   fn:=FixFileName(s)+source_os.scriptext;
   executable:=true;
@@ -97,7 +94,7 @@ begin
 end;
 
 
-destructor TScript.Done;
+destructor TScript.Destroy;
 begin
   data.Free;
 end;
@@ -141,9 +138,9 @@ end;
                                   Asm Response
 ****************************************************************************}
 
-Constructor TAsmScript.Init (Const ScriptName : String);
+Constructor TAsmScript.Create (Const ScriptName : String);
 begin
-  Inherited InitExec(ScriptName);
+  Inherited CreateExec(ScriptName);
 end;
 
 
@@ -241,7 +238,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.7  2001-02-05 20:47:00  peter
+  Revision 1.8  2001-04-13 01:22:14  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.7  2001/02/05 20:47:00  peter
     * support linux unit for ver1_0 compilers
 
   Revision 1.6  2001/01/21 20:32:45  marco

compiler/symbase.pas

@@ -27,7 +27,7 @@ interface
 
     uses
        { common }
-       cutils,cobjects,
+       cutils,cclasses,
        { global }
        globtype,globals,
        { symtable }
@@ -42,28 +42,32 @@ interface
        hasharraysize    = 256;
        indexgrowsize    = 64;
 
+{$ifdef GDB}
+       memsizeinc = 2048; { for long stabstrings }
+{$endif GDB}
+
+
 {************************************************
             Needed forward pointers
 ************************************************}
 
     type
-       psymtable = ^tsymtable;
+       tsymtable = class;
 
 {************************************************
                TSymtableEntry
 ************************************************}
 
-      psymtableentry = ^tsymtableentry;
-      tsymtableentry = object(tnamedindexobject)
-         owner : psymtable;
+      tsymtableentry = class(TNamedIndexItem)
+         owner : tsymtable;
       end;
 
 
 {************************************************
                  TDefEntry
 ************************************************}
-      pdefentry = ^tdefentry;
-      tdefentry = object(tsymtableentry)
+
+      tdefentry = class(tsymtableentry)
          deftype : tdeftype;
       end;
 
@@ -73,8 +77,7 @@ interface
 ************************************************}
 
       { this object is the base for all symbol objects }
-      psymentry = ^tsymentry;
-      tsymentry = object(tsymtableentry)
+      tsymentry = class(tsymtableentry)
          typ : tsymtyp;
       end;
 
@@ -83,38 +86,41 @@ interface
                  TSymtable
 ************************************************}
 
-       tsearchhasharray = array[0..hasharraysize-1] of psymentry;
+       tsearchhasharray = array[0..hasharraysize-1] of tsymentry;
        psearchhasharray = ^tsearchhasharray;
 
-       tsymtable = object
+       tsymtable = class
+       public
+          name      : pstring;
+          realname  : pstring;
           symtabletype : tsymtabletype;
           { each symtable gets a number }
           unitid    : word{integer give range check errors PM};
-          name      : pstring;
           datasize  : longint;
           dataalignment : longint;
           symindex,
-          defindex  : pindexarray;
-          symsearch : pdictionary;
-          next      : psymtable;
-          defowner  : pdefentry; { for records and objects }
+          defindex  : TIndexArray;
+          symsearch : Tdictionary;
+          next      : tsymtable;
+          defowner  : tdefentry; { for records and objects }
           { only used for parameter symtable to determine the offset relative }
           { to the frame pointer and for local inline }
           address_fixup : longint;
           { this saves all definition to allow a proper clean up }
           { separate lexlevel from symtable type }
           symtablelevel : byte;
-          constructor init(t : tsymtabletype);
-          destructor  done;virtual;
+          constructor Create(const s:string);
+          destructor  destroy;override;
           procedure clear;virtual;
-          function  rename(const olds,news : stringid):psymentry;
+          function  rename(const olds,news : stringid):tsymentry;
           procedure foreach(proc2call : tnamedindexcallback);
-          procedure insert(sym : psymentry);virtual;
-          function  search(const s : stringid) : psymentry;
-          function  speedsearch(const s : stringid;speedvalue : longint) : psymentry;virtual;
-          procedure registerdef(p : pdefentry);
-          function  getdefnr(l : longint) : pdefentry;
-          function  getsymnr(l : longint) : psymentry;
+          procedure foreach_static(proc2call : tnamedindexstaticcallback);
+          procedure insert(sym : tsymentry);virtual;
+          function  search(const s : stringid) : tsymentry;
+          function  speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;virtual;
+          procedure registerdef(p : tdefentry);
+          function  getdefnr(l : longint) : tdefentry;
+          function  getsymnr(l : longint) : tsymentry;
 {$ifdef GDB}
           function getnewtypecount : word; virtual;
 {$endif GDB}
@@ -124,24 +130,23 @@ interface
                     TDeref
 ************************************************}
 
-      pderef = ^tderef;
-      tderef = object
+      tderef = class
         dereftype : tdereftype;
         index     : word;
-        next      : pderef;
-        constructor init(typ:tdereftype;i:word);
-        destructor  done;
+        next      : tderef;
+        constructor create(typ:tdereftype;i:word);
+        destructor  destroy;override;
       end;
 
 
     var
        registerdef : boolean;      { true, when defs should be registered }
 
-       defaultsymtablestack : psymtable;  { symtablestack after default units have been loaded }
-       symtablestack     : psymtable;     { linked list of symtables }
-       aktrecordsymtable : psymtable;     { current record read from ppu symtable }
-       aktstaticsymtable : psymtable;     { current static for local ppu symtable }
-       aktlocalsymtable  : psymtable;     { current proc local for local ppu symtable }
+       defaultsymtablestack : tsymtable;  { symtablestack after default units have been loaded }
+       symtablestack     : tsymtable;     { linked list of symtables }
+       aktrecordsymtable : tsymtable;     { current record read from ppu symtable }
+       aktstaticsymtable : tsymtable;     { current static for local ppu symtable }
+       aktlocalsymtable  : tsymtable;     { current proc local for local ppu symtable }
 
 
 implementation
@@ -153,42 +158,65 @@ implementation
                                 TSYMTABLE
 ****************************************************************************}
 
-    constructor tsymtable.init(t : tsymtabletype);
+    constructor tsymtable.Create(const s:string);
       begin
-         symtabletype:=t;
+         if s<>'' then
+          begin
+            name:=stringdup(upper(s));
+            realname:=stringdup(s);
+          end
+         else
+          begin
+            name:=nil;
+            realname:=nil;
+          end;
+         symtabletype:=abstractsymtable;
+         symtablelevel:=0;
          defowner:=nil;
-         new(symindex,init(indexgrowsize));
-         new(defindex,init(indexgrowsize));
-         new(symsearch,init);
-         symsearch^.noclear:=true;
+         next:=nil;
+         symindex:=tindexarray.create(indexgrowsize);
+         defindex:=TIndexArray.create(indexgrowsize);
+         symsearch:=tdictionary.create;
+         symsearch.noclear:=true;
+         unitid:=0;
+         address_fixup:=0;
+         datasize:=0;
+         dataalignment:=1;
       end;
 
 
-    destructor tsymtable.done;
+    destructor tsymtable.destroy;
       begin
         stringdispose(name);
-        dispose(symindex,done);
-        dispose(defindex,done);
+        stringdispose(realname);
+        symindex.destroy;
+        defindex.destroy;
         { symsearch can already be disposed or set to nil for withsymtable }
         if assigned(symsearch) then
          begin
-           dispose(symsearch,done);
+           symsearch.destroy;
            symsearch:=nil;
          end;
       end;
 
 
-    procedure tsymtable.registerdef(p : pdefentry);
+    procedure tsymtable.registerdef(p : tdefentry);
       begin
-         defindex^.insert(p);
+         defindex.insert(p);
          { set def owner and indexnb }
-         p^.owner:=@self;
+         p.owner:=self;
       end;
 
 
     procedure tsymtable.foreach(proc2call : tnamedindexcallback);
       begin
-        symindex^.foreach(proc2call);
+        symindex.foreach(proc2call);
+      end;
+
+
+    procedure tsymtable.foreach_static(proc2call : tnamedindexstaticcallback);
+      begin
+        symindex.foreach_static(proc2call);
       end;
 
 
@@ -198,54 +226,54 @@ implementation
 
     procedure tsymtable.clear;
       begin
-         symindex^.clear;
-         defindex^.clear;
+         symindex.clear;
+         defindex.clear;
       end;
 
 
-    procedure tsymtable.insert(sym:psymentry);
+    procedure tsymtable.insert(sym:tsymentry);
       begin
-         sym^.owner:=@self;
+         sym.owner:=self;
          { insert in index and search hash }
-         symindex^.insert(sym);
-         symsearch^.insert(sym);
+         symindex.insert(sym);
+         symsearch.insert(sym);
       end;
 
 
-    function tsymtable.search(const s : stringid) : psymentry;
+    function tsymtable.search(const s : stringid) : tsymentry;
       begin
         search:=speedsearch(s,getspeedvalue(s));
       end;
 
 
-    function tsymtable.speedsearch(const s : stringid;speedvalue : longint) : psymentry;
+    function tsymtable.speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;
       begin
-        speedsearch:=psymentry(symsearch^.speedsearch(s,speedvalue));
+        speedsearch:=tsymentry(symsearch.speedsearch(s,speedvalue));
       end;
 
 
-    function tsymtable.rename(const olds,news : stringid):psymentry;
+    function tsymtable.rename(const olds,news : stringid):tsymentry;
       begin
-        rename:=psymentry(symsearch^.rename(olds,news));
+        rename:=tsymentry(symsearch.rename(olds,news));
       end;
 
 
-    function tsymtable.getsymnr(l : longint) : psymentry;
+    function tsymtable.getsymnr(l : longint) : tsymentry;
       var
-        hp : psymentry;
+        hp : tsymentry;
       begin
-        hp:=psymentry(symindex^.search(l));
+        hp:=tsymentry(symindex.search(l));
         if hp=nil then
          internalerror(10999);
         getsymnr:=hp;
       end;
 
 
-    function tsymtable.getdefnr(l : longint) : pdefentry;
+    function tsymtable.getdefnr(l : longint) : tdefentry;
       var
-        hp : pdefentry;
+        hp : tdefentry;
       begin
-        hp:=pdefentry(defindex^.search(l));
+        hp:=tdefentry(defindex.search(l));
         if hp=nil then
          internalerror(10998);
         getdefnr:=hp;
@@ -264,7 +292,7 @@ implementation
                                TDeref
 ****************************************************************************}
 
-    constructor tderef.init(typ:tdereftype;i:word);
+    constructor tderef.create(typ:tdereftype;i:word);
       begin
         dereftype:=typ;
         index:=i;
@@ -272,7 +300,7 @@ implementation
       end;
 
 
-    destructor tderef.done;
+    destructor tderef.destroy;
       begin
       end;
 
@@ -283,7 +311,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.1  2000-10-31 22:02:51  peter
+  Revision 1.2  2001-04-13 01:22:15  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.1  2000/10/31 22:02:51  peter
     * symtable splitted, no real code changes
 
 }

compiler/symconst.pas

@@ -372,15 +372,14 @@ type
   tvaroptions=set of tvaroption;
 
   { types of the symtables }
-  tsymtabletype = (invalidsymtable,withsymtable,staticsymtable,
-                   globalsymtable,unitsymtable,
-                   objectsymtable,recordsymtable,
-                   macrosymtable,localsymtable,
-                   parasymtable,inlineparasymtable,
-                   inlinelocalsymtable,stt_exceptsymtable,
-                   { only used for PPU reading of static part
-                     of a unit }
-                   staticppusymtable);
+  tsymtabletype = (abstractsymtable,
+    globalsymtable,staticsymtable,
+    objectsymtable,recordsymtable,
+    localsymtable,parasymtable,
+    withsymtable,stt_exceptsymtable,
+    { used for inline detection }
+    inlineparasymtable,inlinelocalsymtable
+  );
 
 
   { definition contains the informations about a type }
@@ -452,7 +451,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.15  2001-04-02 21:20:34  peter
+  Revision 1.16  2001-04-13 01:22:15  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.15  2001/04/02 21:20:34  peter
     * resulttype rewrite
 
   Revision 1.14  2001/03/22 00:10:58  florian

compiler/symppu.pas

@@ -23,7 +23,6 @@ unit symppu;
 interface
 
     uses
-       cobjects,
        globtype,globals,
        symbase,
        ppu;
@@ -40,7 +39,7 @@ interface
     procedure writesmallset(var s);
     procedure writeguid(var g: tguid);
     procedure writeposinfo(const p:tfileposinfo);
-    procedure writederef(p : psymtableentry);
+    procedure writederef(p : tsymtableentry);
 
     function readbyte:byte;
     function readword:word;
@@ -51,7 +50,7 @@ interface
     procedure readsmallset(var s);
     procedure readguid(var g: tguid);
     procedure readposinfo(var p:tfileposinfo);
-    function readderef : psymtableentry;
+    function readderef : tsymtableentry;
 
     procedure closecurrentppu;
 
@@ -127,77 +126,76 @@ implementation
         current_ppu^.putdata(g,sizeof(g));
       end;
 
-    procedure writederef(p : psymtableentry);
+    procedure writederef(p : tsymtableentry);
       begin
         if p=nil then
          current_ppu^.putbyte(ord(derefnil))
         else
          begin
            { Static symtable ? }
-           if p^.owner^.symtabletype=staticsymtable then
+           if p.owner.symtabletype=staticsymtable then
             begin
               current_ppu^.putbyte(ord(derefaktstaticindex));
-              current_ppu^.putword(p^.indexnr);
+              current_ppu^.putword(p.indexnr);
             end
            { Local record/object symtable ? }
-           else if (p^.owner=aktrecordsymtable) then
+           else if (p.owner=aktrecordsymtable) then
             begin
               current_ppu^.putbyte(ord(derefaktrecordindex));
-              current_ppu^.putword(p^.indexnr);
+              current_ppu^.putword(p.indexnr);
             end
            { Local local/para symtable ? }
-           else if (p^.owner=aktlocalsymtable) then
+           else if (p.owner=aktlocalsymtable) then
             begin
               current_ppu^.putbyte(ord(derefaktlocal));
-              current_ppu^.putword(p^.indexnr);
+              current_ppu^.putword(p.indexnr);
             end
            else
             begin
               current_ppu^.putbyte(ord(derefindex));
-              current_ppu^.putword(p^.indexnr);
+              current_ppu^.putword(p.indexnr);
            { Current unit symtable ? }
               repeat
                 if not assigned(p) then
                  internalerror(556655);
-                case p^.owner^.symtabletype of
+                case p.owner.symtabletype of
                  { when writing the pseudo PPU file
                    to get CRC values the globalsymtable is not yet
                    a unitsymtable PM }
-                  globalsymtable,
-                  unitsymtable :
+                  globalsymtable :
                     begin
                       { check if the unit is available in the uses
                         clause, else it's an error }
-                      if p^.owner^.unitid=$ffff then
+                      if p.owner.unitid=$ffff then
                        internalerror(55665566);
                       current_ppu^.putbyte(ord(derefunit));
-                      current_ppu^.putword(p^.owner^.unitid);
+                      current_ppu^.putword(p.owner.unitid);
                       break;
                     end;
                   staticsymtable :
                     begin
                       current_ppu^.putbyte(ord(derefaktstaticindex));
-                      current_ppu^.putword(p^.indexnr);
+                      current_ppu^.putword(p.indexnr);
                       break;
                     end;
                   localsymtable :
                     begin
-                      p:=p^.owner^.defowner;
+                      p:=p.owner.defowner;
                       current_ppu^.putbyte(ord(dereflocal));
-                      current_ppu^.putword(p^.indexnr);
+                      current_ppu^.putword(p.indexnr);
                     end;
                   parasymtable :
                     begin
-                      p:=p^.owner^.defowner;
+                      p:=p.owner.defowner;
                       current_ppu^.putbyte(ord(derefpara));
-                      current_ppu^.putword(p^.indexnr);
+                      current_ppu^.putword(p.indexnr);
                     end;
                   objectsymtable,
                   recordsymtable :
                     begin
-                      p:=p^.owner^.defowner;
+                      p:=p.owner.defowner;
                       current_ppu^.putbyte(ord(derefrecord));
-                      current_ppu^.putword(p^.indexnr);
+                      current_ppu^.putword(p.indexnr);
                     end;
                   else
                     internalerror(556656);
@@ -297,9 +295,9 @@ implementation
       end;
 
 
-    function readderef : psymtableentry;
+    function readderef : tsymtableentry;
       var
-        hp,p : pderef;
+        hp,p : tderef;
         b : tdereftype;
       begin
         p:=nil;
@@ -314,8 +312,8 @@ implementation
             derefaktlocal,
             derefaktstaticindex :
               begin
-                new(p,init(b,current_ppu^.getword));
-                p^.next:=hp;
+                p:=tderef.create(b,current_ppu^.getword);
+                p.next:=hp;
                 break;
               end;
             derefindex,
@@ -323,18 +321,23 @@ implementation
             derefpara,
             derefrecord :
               begin
-                new(p,init(b,current_ppu^.getword));
-                p^.next:=hp;
+                p:=tderef.create(b,current_ppu^.getword);
+                p.next:=hp;
               end;
           end;
         until false;
-        readderef:=psymtableentry(p);
+        readderef:=tsymtableentry(p);
       end;
 
 end.
 {
   $Log$
-  Revision 1.4  2000-12-25 00:07:29  peter
+  Revision 1.5  2001-04-13 01:22:16  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.4  2000/12/25 00:07:29  peter
     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
       tlinkedlist objects)
 

compiler/symtype.pas

@@ -26,7 +26,7 @@ interface
 
     uses
       { common }
-      cutils,cobjects,
+      cutils,
       { global }
       globtype,globals,
       { symtable }
@@ -40,21 +40,20 @@ interface
                 Required Forwards
 ************************************************}
 
-      psym = ^tsym;
+      tsym = class;
 
 {************************************************
                      TRef
 ************************************************}
 
-      pref = ^tref;
-      tref = object
-        nextref     : pref;
+      tref = class
+        nextref     : tref;
         posinfo     : tfileposinfo;
         moduleindex : longint;
         is_written  : boolean;
-        constructor init(ref:pref;pos:pfileposinfo);
+        constructor create(ref:tref;pos:pfileposinfo);
         procedure   freechain;
-        destructor  done; virtual;
+        destructor  destroy;override;
       end;
 
 {************************************************
@@ -63,16 +62,15 @@ interface
 
       tgetsymtable = (gs_none,gs_record,gs_local,gs_para);
 
-      pdef = ^tdef;
-      tdef = object(tdefentry)
-         typesym    : psym;  { which type the definition was generated this def }
-         constructor init;
+      tdef = class(tdefentry)
+         typesym    : tsym;  { which type the definition was generated this def }
+         constructor create;
          procedure deref;virtual;
          function  typename:string;
          function  gettypename:string;virtual;
          function  size:longint;virtual;abstract;
          function  alignment:longint;virtual;abstract;
-         function  getsymtable(t:tgetsymtable):psymtable;virtual;
+         function  getsymtable(t:tgetsymtable):tsymtable;virtual;
          function  is_publishable:boolean;virtual;abstract;
          function  needs_inittable:boolean;virtual;abstract;
          function  get_rtti_label : string;virtual;abstract;
@@ -83,16 +81,16 @@ interface
 ************************************************}
 
       { this object is the base for all symbol objects }
-      tsym = object(tsymentry)
+      tsym = class(tsymentry)
          _realname  : pstring;
          fileinfo   : tfileposinfo;
          symoptions : tsymoptions;
-         constructor init(const n : string);
-         destructor done;virtual;
+         constructor create(const n : string);
+         destructor destroy;override;
          function  realname:string;
          procedure prederef;virtual; { needed for ttypesym to be deref'd first }
          procedure deref;virtual;
-         function  gettypedef:pdef;virtual;
+         function  gettypedef:tdef;virtual;
          function  mangledname : string;virtual;abstract;
       end;
 
@@ -101,11 +99,11 @@ interface
 ************************************************}
 
       ttype = object
-        def : pdef;
-        sym : psym;
+        def : tdef;
+        sym : tsym;
         procedure reset;
-        procedure setdef(p:pdef);
-        procedure setsym(p:psym);
+        procedure setdef(p:tdef);
+        procedure setsym(p:tsym);
         procedure load;
         procedure write;
         procedure resolve;
@@ -117,31 +115,30 @@ interface
 
       psymlistitem = ^tsymlistitem;
       tsymlistitem = record
-        sym  : psym;
+        sym  : tsym;
         next : psymlistitem;
       end;
 
-      psymlist = ^tsymlist;
-      tsymlist = object
-        def      : pdef;
+      tsymlist = class
+        def      : tdef;
         firstsym,
         lastsym  : psymlistitem;
-        constructor init;
+        constructor create;
         constructor load;
-        destructor  done;
+        destructor  destroy;override;
         function  empty:boolean;
-        procedure setdef(p:pdef);
-        procedure addsym(p:psym);
+        procedure setdef(p:tdef);
+        procedure addsym(p:tsym);
         procedure clear;
-        function  getcopy:psymlist;
+        function  getcopy:tsymlist;
         procedure resolve;
         procedure write;
       end;
 
 
     { resolving }
-    procedure resolvesym(var sym:psym);
-    procedure resolvedef(var def:pdef);
+    procedure resolvesym(var sym:tsym);
+    procedure resolvedef(var def:tdef);
 
 
 implementation
@@ -155,9 +152,9 @@ implementation
                                 Tdef
 ****************************************************************************}
 
-    constructor tdef.init;
+    constructor tdef.create;
       begin
-         inherited init;
+         inherited create;
          deftype:=abstractdef;
          owner := nil;
          typesym := nil;
@@ -168,9 +165,9 @@ implementation
       begin
         if assigned(typesym) and
            not(deftype=procvardef) and
-           assigned(typesym^._realname) and
-           (typesym^._realname^[1]<>'$') then
-         typename:=typesym^._realname^
+           assigned(typesym._realname) and
+           (typesym._realname^[1]<>'$') then
+         typename:=typesym._realname^
         else
          typename:=gettypename;
       end;
@@ -188,7 +185,7 @@ implementation
       end;
 
 
-    function tdef.getsymtable(t:tgetsymtable):psymtable;
+    function tdef.getsymtable(t:tgetsymtable):tsymtable;
       begin
         getsymtable:=nil;
       end;
@@ -198,21 +195,21 @@ implementation
                           TSYM (base for all symtypes)
 ****************************************************************************}
 
-    constructor tsym.init(const n : string);
+    constructor tsym.create(const n : string);
       begin
          if n[1]='$' then
-          inherited initname(copy(n,2,255))
+          inherited createname(copy(n,2,255))
          else
-          inherited initname(upper(n));
+          inherited createname(upper(n));
          _realname:=stringdup(n);
          typ:=abstractsym;
       end;
 
 
-    destructor tsym.done;
+    destructor tsym.destroy;
       begin
         stringdispose(_realname);
-        inherited done;
+        inherited destroy;
       end;
 
 
@@ -234,7 +231,7 @@ implementation
       end;
 
 
-    function tsym.gettypedef:pdef;
+    function tsym.gettypedef:tdef;
       begin
         gettypedef:=nil;
       end;
@@ -244,7 +241,7 @@ implementation
                                TRef
 ****************************************************************************}
 
-    constructor tref.init(ref :pref;pos : pfileposinfo);
+    constructor tref.create(ref :tref;pos : pfileposinfo);
       begin
         nextref:=nil;
         if pos<>nil then
@@ -252,25 +249,25 @@ implementation
         if assigned(current_module) then
           moduleindex:=current_module.unit_index;
         if assigned(ref) then
-          ref^.nextref:=@self;
+          ref.nextref:=self;
         is_written:=false;
       end;
 
     procedure tref.freechain;
       var
-        p,q : pref;
+        p,q : tref;
       begin
         p:=nextref;
         nextref:=nil;
         while assigned(p) do
           begin
-            q:=p^.nextref;
-            dispose(p,done);
+            q:=p.nextref;
+            p.free;
             p:=q;
           end;
       end;
 
-    destructor tref.done;
+    destructor tref.destroy;
       begin
          nextref:=nil;
       end;
@@ -287,17 +284,17 @@ implementation
       end;
 
 
-    procedure ttype.setdef(p:pdef);
+    procedure ttype.setdef(p:tdef);
       begin
         def:=p;
         sym:=nil;
       end;
 
 
-    procedure ttype.setsym(p:psym);
+    procedure ttype.setsym(p:tsym);
       begin
         sym:=p;
-        def:=p^.gettypedef;
+        def:=p.gettypedef;
         if not assigned(def) then
          internalerror(1234005);
       end;
@@ -305,8 +302,8 @@ implementation
 
     procedure ttype.load;
       begin
-        def:=pdef(readderef);
-        sym:=psym(readderef);
+        def:=tdef(readderef);
+        sym:=tsym(readderef);
       end;
 
 
@@ -315,8 +312,8 @@ implementation
         { Don't write symbol references for the current unit
           and for the system unit }
         if assigned(sym) and
-           (sym^.owner^.unitid<>0) and
-           (sym^.owner^.unitid<>1) then
+           (sym.owner.unitid<>0) and
+           (sym.owner.unitid<>1) then
          begin
            writederef(nil);
            writederef(sym);
@@ -344,7 +341,7 @@ implementation
                                  TSymList
 ****************************************************************************}
 
-    constructor tsymlist.init;
+    constructor tsymlist.create;
       begin
         def:=nil; { needed for procedures }
         firstsym:=nil;
@@ -354,13 +351,13 @@ implementation
 
     constructor tsymlist.load;
       var
-        sym : psym;
+        sym : tsym;
       begin
-        def:=pdef(readderef);
+        def:=tdef(readderef);
         firstsym:=nil;
         lastsym:=nil;
         repeat
-          sym:=psym(readderef);
+          sym:=tsym(readderef);
           if sym=nil then
            break;
           addsym(sym);
@@ -368,7 +365,7 @@ implementation
       end;
 
 
-    destructor tsymlist.done;
+    destructor tsymlist.destroy;
       begin
         clear;
       end;
@@ -396,13 +393,13 @@ implementation
       end;
 
 
-    procedure tsymlist.setdef(p:pdef);
+    procedure tsymlist.setdef(p:tdef);
       begin
         def:=p;
       end;
 
 
-    procedure tsymlist.addsym(p:psym);
+    procedure tsymlist.addsym(p:tsym);
       var
         hp : psymlistitem;
       begin
@@ -419,17 +416,17 @@ implementation
       end;
 
 
-    function tsymlist.getcopy:psymlist;
+    function tsymlist.getcopy:tsymlist;
       var
-        hp  : psymlist;
+        hp  : tsymlist;
         hp2 : psymlistitem;
       begin
-        new(hp,init);
-        hp^.def:=def;
+        hp:=tsymlist.create;
+        hp.def:=def;
         hp2:=firstsym;
         while assigned(hp2) do
          begin
-           hp^.addsym(hp2^.sym);
+           hp.addsym(hp2^.sym);
            hp2:=hp2^.next;
          end;
         getcopy:=hp;
@@ -469,95 +466,95 @@ implementation
                         Symbol / Definition Resolving
 *****************************************************************************}
 
-    procedure resolvederef(var p:pderef;var st:psymtable;var idx:word);
+    procedure resolvederef(var p:tderef;var st:tsymtable;var idx:word);
       var
-        hp : pderef;
-        pd : pdef;
+        hp : tderef;
+        pd : tdef;
       begin
         st:=nil;
         idx:=0;
         while assigned(p) do
          begin
-           case p^.dereftype of
+           case p.dereftype of
              derefaktrecordindex :
                begin
                  st:=aktrecordsymtable;
-                 idx:=p^.index;
+                 idx:=p.index;
                end;
              derefaktstaticindex :
                begin
                  st:=aktstaticsymtable;
-                 idx:=p^.index;
+                 idx:=p.index;
                end;
              derefaktlocal :
                begin
                  st:=aktlocalsymtable;
-                 idx:=p^.index;
+                 idx:=p.index;
                end;
              derefunit :
                begin
 {$ifdef NEWMAP}
-                 st:=psymtable(current_module.map^[p^.index]^.globalsymtable);
+                 st:=tsymtable(current_module.map^[p.index]^.globalsymtable);
 {$else NEWMAP}
-                 st:=psymtable(current_module.map^[p^.index]);
+                 st:=tsymtable(current_module.map^[p.index]);
 {$endif NEWMAP}
                end;
              derefrecord :
                begin
-                 pd:=pdef(st^.getdefnr(p^.index));
-                 st:=pd^.getsymtable(gs_record);
+                 pd:=tdef(st.getdefnr(p.index));
+                 st:=pd.getsymtable(gs_record);
                  if not assigned(st) then
                   internalerror(556658);
                end;
              dereflocal :
                begin
-                 pd:=pdef(st^.getdefnr(p^.index));
-                 st:=pd^.getsymtable(gs_local);
+                 pd:=tdef(st.getdefnr(p.index));
+                 st:=pd.getsymtable(gs_local);
                  if not assigned(st) then
                   internalerror(556658);
                end;
              derefpara :
                begin
-                 pd:=pdef(st^.getdefnr(p^.index));
-                 st:=pd^.getsymtable(gs_para);
+                 pd:=tdef(st.getdefnr(p.index));
+                 st:=pd.getsymtable(gs_para);
                  if not assigned(st) then
                   internalerror(556658);
                end;
              derefindex :
                begin
-                 idx:=p^.index;
+                 idx:=p.index;
                end;
              else
                internalerror(556658);
            end;
            hp:=p;
-           p:=p^.next;
-           dispose(hp,done);
+           p:=p.next;
+           hp.free;
          end;
       end;
 
 
-    procedure resolvedef(var def:pdef);
+    procedure resolvedef(var def:tdef);
       var
-        st   : psymtable;
+        st   : tsymtable;
         idx  : word;
       begin
-        resolvederef(pderef(def),st,idx);
+        resolvederef(tderef(def),st,idx);
         if assigned(st) then
-         def:=pdef(st^.getdefnr(idx))
+         def:=tdef(st.getdefnr(idx))
         else
          def:=nil;
       end;
 
 
-    procedure resolvesym(var sym:psym);
+    procedure resolvesym(var sym:tsym);
       var
-        st   : psymtable;
+        st   : tsymtable;
         idx  : word;
       begin
-        resolvederef(pderef(sym),st,idx);
+        resolvederef(tderef(sym),st,idx);
         if assigned(st) then
-         sym:=psym(st^.getsymnr(idx))
+         sym:=tsym(st.getsymnr(idx))
         else
          sym:=nil;
       end;
@@ -565,7 +562,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.5  2001-04-02 21:20:35  peter
+  Revision 1.6  2001-04-13 01:22:17  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.5  2001/04/02 21:20:35  peter
     * resulttype rewrite
 
   Revision 1.4  2000/12/25 00:07:30  peter

compiler/targets/t_fbsd.pas

@@ -82,7 +82,7 @@ begin
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { do nothing with the procedure, only set the mangledname }
   if name<>'' then
-    aktprocsym^.definition^.setmangledname(name)
+    aktprocsym.definition.setmangledname(name)
   else
     message(parser_e_empty_import_name);
 end;
@@ -93,8 +93,8 @@ begin
   { insert sharedlibrary }
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { reset the mangledname and turn off the dll_var option }
-  aktvarsym^.setmangledname(name);
-  exclude(aktvarsym^.varoptions,vo_is_dll_var);
+  aktvarsym.setmangledname(name);
+  exclude(aktvarsym.varoptions,vo_is_dll_var);
 end;
 
 
@@ -169,7 +169,7 @@ begin
         { place jump in codesegment }
         codeSegment.concat(Tai_align.Create_op(4,$90));
         codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
-        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym^.mangledname)));
+        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym.mangledname)));
         codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
 {$endif i386}
       end
@@ -265,7 +265,7 @@ begin
    end;
 
   { Open link.res file }
-  LinkRes.Init(outputexedir+Info.ResName);
+  LinkRes:=TLinkRes.Create(outputexedir+Info.ResName);
 
   { Write path to search libraries }
   HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
@@ -355,7 +355,7 @@ begin
    end;
 { Write and Close response }
   linkres.writetodisk;
-  linkres.done;
+  linkres.Free;
 
   WriteResponseFile:=True;
 end;
@@ -444,7 +444,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.1  2001-02-26 19:43:11  peter
+  Revision 1.2  2001-04-13 01:22:21  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.1  2001/02/26 19:43:11  peter
     * moved target units to subdir
 
   Revision 1.7  2001/02/20 21:41:17  peter

compiler/targets/t_go32v1.pas

@@ -82,7 +82,7 @@ begin
   WriteResponseFile:=False;
 
   { Open link.res file }
-  LinkRes.Init(outputexedir+Info.ResName);
+  LinkRes:=TLinkRes.Create(outputexedir+Info.ResName);
 
   { Write path to search libraries }
   HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
@@ -147,7 +147,7 @@ begin
 
 { Write and Close response }
   linkres.writetodisk;
-  linkres.done;
+  LinkRes.Free;
 
   WriteResponseFile:=True;
 end;
@@ -189,7 +189,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.1  2001-02-26 19:43:11  peter
+  Revision 1.2  2001-04-13 01:22:21  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.1  2001/02/26 19:43:11  peter
     * moved target units to subdir
 
   Revision 1.5  2000/12/25 00:07:30  peter

compiler/targets/t_go32v2.pas

@@ -85,7 +85,7 @@ begin
   WriteResponseFile:=False;
 
   { Open link.res file }
-  LinkRes.Init(outputexedir+Info.ResName);
+  LinkRes:=TLinkRes.Create(outputexedir+Info.ResName);
 
   { Write path to search libraries }
   HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
@@ -150,7 +150,7 @@ begin
 
 { Write and Close response }
   linkres.writetodisk;
-  linkres.done;
+  LinkRes.Free;
 
   WriteResponseFile:=True;
 end;
@@ -165,7 +165,7 @@ begin
   WriteScript:=False;
 
   { Open link.res file }
-  ScriptRes.Init(outputexedir+Info.ResName);
+  ScriptRes:=TLinkRes.Create(outputexedir+Info.ResName);
   ScriptRes.Add('OUTPUT_FORMAT("coff-go32-exe")');
   ScriptRes.Add('ENTRY(start)');
 
@@ -271,7 +271,7 @@ begin
 
 { Write and Close response }
   ScriptRes.WriteToDisk;
-  ScriptRes.done;
+  ScriptRes.Free;
 
   WriteScript:=True;
 end;
@@ -419,7 +419,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.1  2001-02-26 19:43:11  peter
+  Revision 1.2  2001-04-13 01:22:21  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.1  2001/02/26 19:43:11  peter
     * moved target units to subdir
 
   Revision 1.7  2001/01/27 21:29:35  florian

compiler/targets/t_linux.pas

@@ -81,7 +81,7 @@ begin
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { do nothing with the procedure, only set the mangledname }
   if name<>'' then
-    aktprocsym^.definition^.setmangledname(name)
+    aktprocsym.definition.setmangledname(name)
   else
     message(parser_e_empty_import_name);
 end;
@@ -92,8 +92,8 @@ begin
   { insert sharedlibrary }
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { reset the mangledname and turn off the dll_var option }
-  aktvarsym^.setmangledname(name);
-  exclude(aktvarsym^.varoptions,vo_is_dll_var);
+  aktvarsym.setmangledname(name);
+  exclude(aktvarsym.varoptions,vo_is_dll_var);
 end;
 
 
@@ -168,7 +168,7 @@ begin
         { place jump in codesegment }
         codesegment.concat(Tai_align.Create_op(4,$90));
         codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
-        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym^.mangledname)));
+        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym.mangledname)));
         codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
 {$endif i386}
       end
@@ -262,7 +262,7 @@ begin
    end;
 
   { Open link.res file }
-  LinkRes.Init(outputexedir+Info.ResName);
+  LinkRes:=TLinkRes.Create(outputexedir+Info.ResName);
 
   { Write path to search libraries }
   HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
@@ -355,7 +355,7 @@ begin
    end;
 { Write and Close response }
   linkres.writetodisk;
-  linkres.done;
+  linkres.Free;
 
   WriteResponseFile:=True;
 end;
@@ -445,7 +445,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2001-03-22 10:08:12  michael
+  Revision 1.3  2001-04-13 01:22:21  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.2  2001/03/22 10:08:12  michael
   + .ctor patch merged from fixbranch
 
   Revision 1.1  2001/02/26 19:43:11  peter

compiler/targets/t_nwm.pas

@@ -134,7 +134,7 @@ begin
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { do nothing with the procedure, only set the mangledname }
   if name<>'' then
-    aktprocsym^.definition^.setmangledname(name)
+    aktprocsym.definition.setmangledname(name)
   else
     message(parser_e_empty_import_name);
 end;
@@ -145,8 +145,8 @@ begin
   { insert sharedlibrary }
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { reset the mangledname and turn off the dll_var option }
-  aktvarsym^.setmangledname(name);
-  exclude(aktvarsym^.varoptions,vo_is_dll_var);
+  aktvarsym.setmangledname(name);
+  exclude(aktvarsym.varoptions,vo_is_dll_var);
 end;
 
 
@@ -177,7 +177,7 @@ begin
   { use pascal name is none specified }
   if (hp.options and eo_name)=0 then
     begin
-       hp.name:=stringdup(hp.sym^.name);
+       hp.name:=stringdup(hp.sym.name);
        hp.options:=hp.options or eo_name;
     end;
   { now place in correct order }
@@ -227,7 +227,7 @@ begin
         { place jump in codesegment }
         codeSegment.concat(Tai_align.Create_op(4,$90));
         codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
-        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym^.mangledname)));
+        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym.mangledname)));
         codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
 {$endif i386}
       end
@@ -277,7 +277,7 @@ begin
   NlmNam := ProgNam + target_os.exeext;
 
   { Open link.res file }
-  LinkRes.Init(outputexedir+Info.ResName);
+  LinkRes:=TLinkRes.Create(outputexedir+Info.ResName);
 
   if Description <> '' then
     LinkRes.Add('DESCRIPTION "' + Description + '"');
@@ -375,7 +375,7 @@ begin
 
 { Write and Close response }
   linkres.writetodisk;
-  linkres.done;
+  LinkRes.Free;
 
   WriteResponseFile:=True;
 end;
@@ -421,7 +421,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.1  2001-02-26 19:43:11  peter
+  Revision 1.2  2001-04-13 01:22:21  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.1  2001/02/26 19:43:11  peter
     * moved target units to subdir
 
   Revision 1.6  2001/02/20 21:41:16  peter