Sfoglia il codice sorgente

* fix property overriding

git-svn-id: trunk@5045 -
peter 19 anni fa
parent
commit
0f6355e805

+ 7 - 7
compiler/dbgdwarf.pas

@@ -259,7 +259,7 @@ interface
         procedure appendsym_absolute(sym:tabsolutevarsym); virtual;
         procedure appendsym_property(sym:tpropertysym); virtual;
         procedure appendsym_proc(sym:tprocsym); virtual;
-        
+
         function symname(sym:tsym): String; virtual;
 
         procedure enum_membersyms_callback(p:Tnamedindexitem;arg:pointer);
@@ -1404,7 +1404,7 @@ end;
           current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0))
         else
           current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
-          
+
         case def.deftype of
           stringdef :
             appenddef_string(tstringdef(def));
@@ -1805,7 +1805,7 @@ end;
           ]);
           append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.restype.def));
           finish_entry;
-          
+
           { Moved fom append sym, do we need this (MWE)
           { For object types write also the symtable entries }
           if (sym.typ=typesym) and (ttypesym(sym).restype.def.deftype=objectdef) then
@@ -1822,7 +1822,7 @@ end;
         var
           templist : TAsmList;
           blocksize : longint;
-          symlist : psymlistitem;
+          symlist : ppropaccesslistitem;
         begin
           templist:=TAsmList.create;
           case tabsolutevarsym(sym).abstyp of
@@ -2140,7 +2140,7 @@ end;
           templist.free;
         end;
 
-    
+
       var
         storefilepos  : tfileposinfo;
         lenstartlabel : tasmlabel;
@@ -2231,7 +2231,7 @@ end;
           write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
         if assigned(current_module.localsymtable) then
           write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
-          
+
         { write defs not written yet }
         write_defs_to_write;
 
@@ -2260,7 +2260,7 @@ end;
         defnumberlist:=nil;
         deftowritelist.free;
         deftowritelist:=nil;
-        
+
         aktfilepos:=storefilepos;
       end;
 

+ 3 - 3
compiler/pdecsub.pas

@@ -204,7 +204,7 @@ implementation
         storepos : tfileposinfo;
         vs       : tlocalvarsym;
         aliasvs  : tabsolutevarsym;
-        sl       : tsymlist;
+        sl       : tpropaccesslist;
       begin
         { The result from constructors and destructors can't be accessed directly }
         if not(pd.proctypeoption in [potype_constructor,potype_destructor]) and
@@ -231,7 +231,7 @@ implementation
              as the name is lowercase and unreachable from the code }
            if pd.resultname='' then
             pd.resultname:=pd.procsym.name;
-           sl:=tsymlist.create;
+           sl:=tpropaccesslist.create;
            sl.addsym(sl_load,pd.funcretsym);
            aliasvs:=tabsolutevarsym.create_ref(pd.resultname,pd.rettype,sl);
            include(aliasvs.varoptions,vo_is_funcret);
@@ -240,7 +240,7 @@ implementation
            { insert result also if support is on }
            if (m_result in aktmodeswitches) then
             begin
-              sl:=tsymlist.create;
+              sl:=tpropaccesslist.create;
               sl.addsym(sl_load,pd.funcretsym);
               aliasvs:=tabsolutevarsym.create_ref('RESULT',pd.rettype,sl);
               include(aliasvs.varoptions,vo_is_funcret);

+ 15 - 8
compiler/pdecvar.pas

@@ -68,7 +68,7 @@ implementation
 
         { convert a node tree to symlist and return the last
           symbol }
-        function parse_symlist(pl:tsymlist;var def:tdef):boolean;
+        function parse_symlist(pl:tpropaccesslist;var def:tdef):boolean;
           var
             idx : longint;
             sym : tsym;
@@ -366,9 +366,16 @@ implementation
            begin
               { do an property override }
               overriden:=search_class_member(aclass.childof,p.name);
-              if assigned(overriden) and (overriden.typ=propertysym) and not(is_dispinterface(aclass)) then
+              if assigned(overriden) and
+                 (overriden.typ=propertysym) and
+                 not(is_dispinterface(aclass)) then
                 begin
-                  p.dooverride(tpropertysym(overriden));
+                  p.overridenpropsym:=tpropertysym(overriden);
+                  { inherit all type related entries }
+                  p.indextype:=tpropertysym(overriden).indextype;
+                  p.proptype:=tpropertysym(overriden).proptype;
+                  p.index:=tpropertysym(overriden).index;
+                  p.default:=tpropertysym(overriden).default;
                 end
               else
                 begin
@@ -491,8 +498,8 @@ implementation
 
          if assigned(aclass) and not(is_dispinterface(aclass)) then
            begin
-             { ppo_stored might be not set by an overridden property }
-             if not(ppo_is_override in p.propoptions) then
+             { ppo_stored is default on for not overriden properties }
+             if not assigned(p.overridenpropsym) then
                include(p.propoptions,ppo_stored);
              if try_to_consume(_STORED) then
               begin
@@ -540,8 +547,8 @@ implementation
                     end;
                   _TRUE:
                     begin
-                    p.default:=longint($80000000);
-                    consume(_TRUE);
+                      p.default:=longint($80000000);
+                      consume(_TRUE);
                     end;
                 end;
               end;
@@ -867,7 +874,7 @@ implementation
                        abssym:=tabsolutevarsym.create(vs.realname,tt);
                        abssym.fileinfo:=vs.fileinfo;
                        abssym.abstyp:=tovar;
-                       abssym.ref:=node_to_symlist(pt);
+                       abssym.ref:=node_to_propaccesslist(pt);
                        symtablestack.top.replace(vs,abssym);
                        vs.free;
                      end

+ 44 - 28
compiler/pexpr.pas

@@ -41,9 +41,9 @@ interface
 
     procedure string_dec(var t: ttype);
 
-    procedure symlist_to_node(var p1:tnode;st:tsymtable;pl:tsymlist);
+    procedure propaccesslist_to_node(var p1:tnode;st:tsymtable;pl:tpropaccesslist);
 
-    function node_to_symlist(p1:tnode):tsymlist;
+    function node_to_propaccesslist(p1:tnode):tpropaccesslist;
 
     function parse_paras(__colon : boolean;end_of_paras : ttoken) : tnode;
 
@@ -142,9 +142,9 @@ implementation
 
 
 
-    procedure symlist_to_node(var p1:tnode;st:tsymtable;pl:tsymlist);
+    procedure propaccesslist_to_node(var p1:tnode;st:tsymtable;pl:tpropaccesslist);
       var
-        plist : psymlistitem;
+        plist : ppropaccesslistitem;
       begin
         plist:=pl.firstsym;
         while assigned(plist) do
@@ -194,9 +194,9 @@ implementation
       end;
 
 
-    function node_to_symlist(p1:tnode):tsymlist;
+    function node_to_propaccesslist(p1:tnode):tpropaccesslist;
       var
-        sl : tsymlist;
+        sl : tpropaccesslist;
 
         procedure addnode(p:tnode);
         begin
@@ -234,7 +234,7 @@ implementation
         end;
 
       begin
-        sl:=tsymlist.create;
+        sl:=tpropaccesslist.create;
         addnode(p1);
         result:=sl;
       end;
@@ -1070,17 +1070,19 @@ implementation
 
 
     { the following procedure handles the access to a property symbol }
-    procedure handle_propertysym(sym : tsym;st : tsymtable;var p1 : tnode);
+    procedure handle_propertysym(propsym : tpropertysym;st : tsymtable;var p1 : tnode);
       var
          paras : tnode;
          p2    : tnode;
          membercall : boolean;
          callflags  : tcallnodeflags;
+         hpropsym : tpropertysym;
+         propaccesslist : tpropaccesslist;
       begin
-         paras:=nil;
          { property parameters? read them only if the property really }
          { has parameters                                             }
-         if (ppo_hasparameters in tpropertysym(sym).propoptions) then
+         paras:=nil;
+         if (ppo_hasparameters in propsym.propoptions) then
            begin
              if try_to_consume(_LECKKLAMMER) then
                begin
@@ -1089,19 +1091,26 @@ implementation
                end;
            end;
          { indexed property }
-         if (ppo_indexed in tpropertysym(sym).propoptions) then
+         if (ppo_indexed in propsym.propoptions) then
            begin
-             p2:=cordconstnode.create(tpropertysym(sym).index,tpropertysym(sym).indextype,true);
+             p2:=cordconstnode.create(propsym.index,propsym.indextype,true);
              paras:=ccallparanode.create(p2,paras);
            end;
          { we need only a write property if a := follows }
          { if not(afterassignment) and not(in_args) then }
          if token=_ASSIGNMENT then
            begin
-              { write property: }
-              if not tpropertysym(sym).writeaccess.empty then
+              { write property, find property in the overriden list }
+              hpropsym:=propsym;
+              repeat
+                propaccesslist:=hpropsym.writeaccess;
+                if not propaccesslist.empty then
+                   break;
+                hpropsym:=hpropsym.overridenpropsym;
+              until not assigned(hpropsym);
+              if not propaccesslist.empty then
                 begin
-                   case tpropertysym(sym).writeaccess.firstsym^.sym.typ of
+                   case propaccesslist.firstsym^.sym.typ of
                      procsym :
                        begin
                          callflags:=[];
@@ -1109,13 +1118,13 @@ implementation
                          membercall:=maybe_load_methodpointer(st,p1);
                          if membercall then
                            include(callflags,cnf_member_call);
-                         p1:=ccallnode.create(paras,tprocsym(tpropertysym(sym).writeaccess.firstsym^.sym),st,p1,callflags);
-                         addsymref(tpropertysym(sym).writeaccess.firstsym^.sym);
+                         p1:=ccallnode.create(paras,tprocsym(propaccesslist.firstsym^.sym),st,p1,callflags);
+                         addsymref(propaccesslist.firstsym^.sym);
                          paras:=nil;
                          consume(_ASSIGNMENT);
                          { read the expression }
-                         if tpropertysym(sym).proptype.def.deftype=procvardef then
-                           getprocvardef:=tprocvardef(tpropertysym(sym).proptype.def);
+                         if propsym.proptype.def.deftype=procvardef then
+                           getprocvardef:=tprocvardef(propsym.proptype.def);
                          p2:=comp_expr(true);
                          if assigned(getprocvardef) then
                            handle_procvar(getprocvardef,p2);
@@ -1127,7 +1136,7 @@ implementation
                      fieldvarsym :
                        begin
                          { generate access code }
-                         symlist_to_node(p1,st,tpropertysym(sym).writeaccess);
+                         propaccesslist_to_node(p1,st,propaccesslist);
                          include(p1.flags,nf_isproperty);
                          consume(_ASSIGNMENT);
                          { read the expression }
@@ -1149,14 +1158,21 @@ implementation
            end
          else
            begin
-              { read property: }
-              if not tpropertysym(sym).readaccess.empty then
+              { read property, find property in the overriden list }
+              hpropsym:=propsym;
+              repeat
+                propaccesslist:=hpropsym.readaccess;
+                if not propaccesslist.empty then
+                   break;
+                hpropsym:=hpropsym.overridenpropsym;
+              until not assigned(hpropsym);
+              if not propaccesslist.empty then
                 begin
-                   case tpropertysym(sym).readaccess.firstsym^.sym.typ of
+                   case propaccesslist.firstsym^.sym.typ of
                      fieldvarsym :
                        begin
                           { generate access code }
-                          symlist_to_node(p1,st,tpropertysym(sym).readaccess);
+                          propaccesslist_to_node(p1,st,propaccesslist);
                           include(p1.flags,nf_isproperty);
                        end;
                      procsym :
@@ -1166,7 +1182,7 @@ implementation
                           membercall:=maybe_load_methodpointer(st,p1);
                           if membercall then
                             include(callflags,cnf_member_call);
-                          p1:=ccallnode.create(paras,tprocsym(tpropertysym(sym).readaccess.firstsym^.sym),st,p1,callflags);
+                          p1:=ccallnode.create(paras,tprocsym(propaccesslist.firstsym^.sym),st,p1,callflags);
                           paras:=nil;
                           include(p1.flags,nf_isproperty);
                        end
@@ -1258,7 +1274,7 @@ implementation
                    begin
                       if isclassref then
                         Message(parser_e_only_class_methods_via_class_ref);
-                      handle_propertysym(sym,sym.owner,p1);
+                      handle_propertysym(tpropertysym(sym),sym.owner,p1);
                    end;
                  else internalerror(16);
               end;
@@ -1337,7 +1353,7 @@ implementation
                     if (tabsolutevarsym(srsym).abstyp=tovar) then
                       begin
                         p1:=nil;
-                        symlist_to_node(p1,nil,tabsolutevarsym(srsym).ref);
+                        propaccesslist_to_node(p1,nil,tabsolutevarsym(srsym).ref);
                         p1:=ctypeconvnode.create(p1,tabsolutevarsym(srsym).vartype);
                         include(p1.flags,nf_absolute);
                       end
@@ -1585,7 +1601,7 @@ implementation
                      Message(parser_e_only_class_methods);
                     { no method pointer }
                     p1:=nil;
-                    handle_propertysym(srsym,srsymtable,p1);
+                    handle_propertysym(tpropertysym(srsym),srsymtable,p1);
                   end;
 
                 labelsym :

+ 1 - 1
compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion=65;
+  CurrentPPUVersion=66;
 
 { buffer sizes }
   maxentrysize = 1024;

+ 1 - 1
compiler/rautils.pas

@@ -761,7 +761,7 @@ var
   harrdef : tarraydef;
   indexreg : tregister;
   l : aint;
-  plist : psymlistitem;
+  plist : ppropaccesslistitem;
 Begin
   SetupVar:=false;
   asmsearchsym(s,sym,srsymtable);

+ 0 - 1
compiler/symconst.pas

@@ -332,7 +332,6 @@ type
     ppo_defaultproperty,
     ppo_stored,
     ppo_hasparameters,
-    ppo_is_override,
     ppo_implements
   );
   tpropertyoptions=set of tpropertyoption;

+ 2 - 19
compiler/symdef.pas

@@ -185,8 +185,6 @@ interface
           symtable : tsymtable;
           procedure reset;override;
           function  getsymtable(t:tgetsymtable):tsymtable;override;
-          procedure buildderefimpl;override;
-          procedure derefimpl;override;
           function is_packed:boolean;
        end;
 
@@ -2763,21 +2761,6 @@ implementation
       end;
 
 
-    procedure tabstractrecorddef.buildderefimpl;
-      begin
-        inherited buildderefimpl;
-        tstoredsymtable(symtable).buildderefimpl;
-      end;
-
-
-   procedure tabstractrecorddef.derefimpl;
-     begin
-       inherited derefimpl;
-       tstoredsymtable(symtable).derefimpl;
-     end;
-
-
-
 {***************************************************************************
                                   trecorddef
 ***************************************************************************}
@@ -4826,11 +4809,11 @@ implementation
          proctypesinfo : byte;
          propnameitem  : tpropnamelistitem;
 
-      procedure writeproc(proc : tsymlist; shiftvalue : byte; unsetvalue: byte);
+      procedure writeproc(proc : tpropaccesslist; shiftvalue : byte; unsetvalue: byte);
 
         var
            typvalue : byte;
-           hp : psymlistitem;
+           hp : ppropaccesslistitem;
            address : longint;
            def : tdef;
         begin

+ 39 - 90
compiler/symsym.pas

@@ -218,9 +218,9 @@ interface
 {$endif i386}
          asmname : pstring;
          addroffset : aint;
-         ref     : tsymlist;
+         ref     : tpropaccesslist;
          constructor create(const n : string;const tt : ttype);
-         constructor create_ref(const n : string;const tt : ttype;_ref:tsymlist);
+         constructor create_ref(const n : string;const tt : ttype;_ref:tpropaccesslist);
          destructor  destroy;override;
          constructor ppuload(ppufile:tcompilerppufile);
          procedure buildderef;override;
@@ -231,15 +231,15 @@ interface
 
        tpropertysym = class(Tstoredsym)
           propoptions   : tpropertyoptions;
-          propoverriden : tpropertysym;
-          propoverridenderef : tderef;
+          overridenpropsym : tpropertysym;
+          overridenpropsymderef : tderef;
           proptype,
           indextype     : ttype;
           index,
           default       : longint;
           readaccess,
           writeaccess,
-          storedaccess  : tsymlist;
+          storedaccess  : tpropaccesslist;
           constructor create(const n : string);
           destructor  destroy;override;
           constructor ppuload(ppufile:tcompilerppufile);
@@ -248,8 +248,6 @@ interface
           function  gettypedef:tdef;override;
           procedure buildderef;override;
           procedure deref;override;
-          procedure derefimpl;override;
-          procedure dooverride(overriden:tpropertysym);
        end;
 
        ttypedconstsym = class(tstoredsym)
@@ -1061,9 +1059,9 @@ implementation
          default:=0;
          proptype.reset;
          indextype.reset;
-         readaccess:=tsymlist.create;
-         writeaccess:=tsymlist.create;
-         storedaccess:=tsymlist.create;
+         readaccess:=tpropaccesslist.create;
+         writeaccess:=tpropaccesslist.create;
+         storedaccess:=tpropaccesslist.create;
       end;
 
 
@@ -1071,24 +1069,14 @@ implementation
       begin
          inherited ppuload(propertysym,ppufile);
          ppufile.getsmallset(propoptions);
-         if (ppo_is_override in propoptions) then
-          begin
-            ppufile.getderef(propoverridenderef);
-            { we need to have these objects initialized }
-            readaccess:=tsymlist.create;
-            writeaccess:=tsymlist.create;
-            storedaccess:=tsymlist.create;
-          end
-         else
-          begin
-            ppufile.gettype(proptype);
-            index:=ppufile.getlongint;
-            default:=ppufile.getlongint;
-            ppufile.gettype(indextype);
-            readaccess:=ppufile.getsymlist;
-            writeaccess:=ppufile.getsymlist;
-            storedaccess:=ppufile.getsymlist;
-          end;
+         ppufile.getderef(overridenpropsymderef);
+         ppufile.gettype(proptype);
+         index:=ppufile.getlongint;
+         default:=ppufile.getlongint;
+         ppufile.gettype(indextype);
+         readaccess:=ppufile.getpropaccesslist;
+         writeaccess:=ppufile.getpropaccesslist;
+         storedaccess:=ppufile.getpropaccesslist;
       end;
 
 
@@ -1109,41 +1097,23 @@ implementation
 
     procedure tpropertysym.buildderef;
       begin
-        if (ppo_is_override in propoptions) then
-         begin
-           propoverridenderef.build(propoverriden);
-         end
-        else
-         begin
-           proptype.buildderef;
-           indextype.buildderef;
-           readaccess.buildderef;
-           writeaccess.buildderef;
-           storedaccess.buildderef;
-         end;
+        overridenpropsymderef.build(overridenpropsym);
+        proptype.buildderef;
+        indextype.buildderef;
+        readaccess.buildderef;
+        writeaccess.buildderef;
+        storedaccess.buildderef;
       end;
 
 
     procedure tpropertysym.deref;
       begin
-        if not(ppo_is_override in propoptions) then
-         begin
-           proptype.resolve;
-           indextype.resolve;
-           readaccess.resolve;
-           writeaccess.resolve;
-           storedaccess.resolve;
-         end;
-      end;
-
-
-    procedure tpropertysym.derefimpl;
-      begin
-        if (ppo_is_override in propoptions) then
-         begin
-           propoverriden:=tpropertysym(propoverridenderef.resolve);
-           dooverride(propoverriden);
-         end
+        overridenpropsym:=tpropertysym(overridenpropsymderef.resolve);
+        indextype.resolve;
+        proptype.resolve;
+        readaccess.resolve;
+        writeaccess.resolve;
+        storedaccess.resolve;
       end;
 
 
@@ -1157,39 +1127,18 @@ implementation
       begin
         inherited ppuwrite(ppufile);
         ppufile.putsmallset(propoptions);
-        if (ppo_is_override in propoptions) then
-         ppufile.putderef(propoverridenderef)
-        else
-         begin
-           ppufile.puttype(proptype);
-           ppufile.putlongint(index);
-           ppufile.putlongint(default);
-           ppufile.puttype(indextype);
-           ppufile.putsymlist(readaccess);
-           ppufile.putsymlist(writeaccess);
-           ppufile.putsymlist(storedaccess);
-         end;
+        ppufile.putderef(overridenpropsymderef);
+        ppufile.puttype(proptype);
+        ppufile.putlongint(index);
+        ppufile.putlongint(default);
+        ppufile.puttype(indextype);
+        ppufile.putpropaccesslist(readaccess);
+        ppufile.putpropaccesslist(writeaccess);
+        ppufile.putpropaccesslist(storedaccess);
         ppufile.writeentry(ibpropertysym);
       end;
 
 
-    procedure tpropertysym.dooverride(overriden:tpropertysym);
-      begin
-        propoverriden:=overriden;
-        proptype:=overriden.proptype;
-        propoptions:=overriden.propoptions+[ppo_is_override];
-        index:=overriden.index;
-        default:=overriden.default;
-        indextype:=overriden.indextype;
-        readaccess.free;
-        readaccess:=overriden.readaccess.getcopy;
-        writeaccess.free;
-        writeaccess:=overriden.writeaccess.getcopy;
-        storedaccess.free;
-        storedaccess:=overriden.storedaccess.getcopy;
-      end;
-
-
 {****************************************************************************
                             TABSTRACTVARSYM
 ****************************************************************************}
@@ -1643,7 +1592,7 @@ implementation
       end;
 
 
-    constructor tabsolutevarsym.create_ref(const n : string;const tt : ttype;_ref:tsymlist);
+    constructor tabsolutevarsym.create_ref(const n : string;const tt : ttype;_ref:tpropaccesslist);
       begin
         inherited create(absolutevarsym,n,vs_value,tt,[]);
         ref:=_ref;
@@ -1669,7 +1618,7 @@ implementation
 {$endif i386}
          case abstyp of
            tovar :
-             ref:=ppufile.getsymlist;
+             ref:=ppufile.getpropaccesslist;
            toasm :
              asmname:=stringdup(ppufile.getstring);
            toaddr :
@@ -1689,7 +1638,7 @@ implementation
          ppufile.putbyte(byte(abstyp));
          case abstyp of
            tovar :
-             ppufile.putsymlist(ref);
+             ppufile.putpropaccesslist(ref);
            toasm :
              ppufile.putstring(asmname^);
            toaddr :

+ 0 - 22
compiler/symtable.pas

@@ -90,7 +90,6 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
           procedure write_references(ppufile:tcompilerppufile;locals:boolean);override;
-          procedure derefimpl; override;
           procedure addfield(sym:tfieldvarsym);
           procedure insertfield(sym:tfieldvarsym);
           procedure addalignmentpadding;
@@ -575,7 +574,6 @@ implementation
     procedure tstoredsymtable.derefimpl;
       var
         hp : tdef;
-        hs: tsym;
       begin
         { definitions }
         hp:=tdef(defindex.first);
@@ -584,13 +582,6 @@ implementation
            hp.derefimpl;
            hp:=tdef(hp.indexnext);
          end;
-        { symbols }
-        hs:=tsym(symindex.first);
-        while assigned(hs) do
-         begin
-           hs.derefimpl;
-           hs:=tsym(hs.indexnext);
-         end;
       end;
 
 
@@ -899,19 +890,6 @@ implementation
       end;
 
 
-   procedure tabstractrecordsymtable.derefimpl;
-     var
-       storesymtable : tsymtable;
-     begin
-       storesymtable:=aktrecordsymtable;
-       aktrecordsymtable:=self;
-
-       inherited derefimpl;
-
-       aktrecordsymtable:=storesymtable;
-     end;
-
-
     procedure tabstractrecordsymtable.addfield(sym:tfieldvarsym);
       var
         l      : aint;

+ 36 - 68
compiler/symtype.pas

@@ -119,7 +119,6 @@ interface
          function  mangledname:string; virtual;
          procedure buildderef;virtual;
          procedure deref;virtual;
-         procedure derefimpl; virtual;
          function  gettypedef:tdef;virtual;
          procedure load_references(ppufile:tcompilerppufile;locals:boolean);virtual;
          function  write_references(ppufile:tcompilerppufile;locals:boolean):boolean;virtual;
@@ -160,24 +159,24 @@ interface
       end;
 
 {************************************************
-                   TSymList
+                   tpropaccesslist
 ************************************************}
 
-      psymlistitem = ^tsymlistitem;
-      tsymlistitem = record
+      ppropaccesslistitem = ^tpropaccesslistitem;
+      tpropaccesslistitem = record
         sltype : tsltype;
-        next   : psymlistitem;
+        next   : ppropaccesslistitem;
         case byte of
           0 : (sym : tsym; symderef : tderef);
           1 : (value  : TConstExprInt; valuett: ttype);
           2 : (tt : ttype);
       end;
 
-      tsymlist = class
+      tpropaccesslist = class
         procdef  : tdef;
         procdefderef : tderef;
         firstsym,
-        lastsym  : psymlistitem;
+        lastsym  : ppropaccesslistitem;
         constructor create;
         destructor  destroy;override;
         function  empty:boolean;
@@ -186,7 +185,6 @@ interface
         procedure addconst(slt:tsltype;v:TConstExprInt;const tt:ttype);
         procedure addtype(slt:tsltype;const tt:ttype);
         procedure clear;
-        function  getcopy:tsymlist;
         procedure resolve;
         procedure buildderef;
       end;
@@ -202,7 +200,7 @@ interface
          function  getptruint:TConstPtrUInt;
          procedure getposinfo(var p:tfileposinfo);
          procedure getderef(var d:tderef);
-         function  getsymlist:tsymlist;
+         function  getpropaccesslist:tpropaccesslist;
          procedure gettype(var t:ttype);
          function  getasmsymbol:tasmsymbol;
          procedure putguid(const g: tguid);
@@ -210,7 +208,7 @@ interface
          procedure PutPtrUInt(v:TConstPtrUInt);
          procedure putposinfo(const p:tfileposinfo);
          procedure putderef(const d:tderef);
-         procedure putsymlist(p:tsymlist);
+         procedure putpropaccesslist(p:tpropaccesslist);
          procedure puttype(const t:ttype);
          procedure putasmsymbol(s:tasmsymbol);
        end;
@@ -363,11 +361,6 @@ implementation
       end;
 
 
-    procedure Tsym.derefimpl;
-      begin
-      end;
-
-
     function tsym.realname : string;
       begin
         if assigned(_realname) then
@@ -612,10 +605,10 @@ implementation
 
 
 {****************************************************************************
-                                 TSymList
+                                 tpropaccesslist
 ****************************************************************************}
 
-    constructor tsymlist.create;
+    constructor tpropaccesslist.create;
       begin
         procdef:=nil; { needed for procedures }
         firstsym:=nil;
@@ -623,21 +616,21 @@ implementation
       end;
 
 
-    destructor tsymlist.destroy;
+    destructor tpropaccesslist.destroy;
       begin
         clear;
       end;
 
 
-    function tsymlist.empty:boolean;
+    function tpropaccesslist.empty:boolean;
       begin
         empty:=(firstsym=nil);
       end;
 
 
-    procedure tsymlist.clear;
+    procedure tpropaccesslist.clear;
       var
-        hp : psymlistitem;
+        hp : ppropaccesslistitem;
       begin
         while assigned(firstsym) do
          begin
@@ -651,14 +644,14 @@ implementation
       end;
 
 
-    procedure tsymlist.addsym(slt:tsltype;p:tsym);
+    procedure tpropaccesslist.addsym(slt:tsltype;p:tsym);
       var
-        hp : psymlistitem;
+        hp : ppropaccesslistitem;
       begin
         if not assigned(p) then
          internalerror(200110203);
         new(hp);
-        fillchar(hp^,sizeof(tsymlistitem),0);
+        fillchar(hp^,sizeof(tpropaccesslistitem),0);
         hp^.sltype:=slt;
         hp^.sym:=p;
         hp^.symderef.reset;
@@ -670,12 +663,12 @@ implementation
       end;
 
 
-    procedure tsymlist.addsymderef(slt:tsltype;const d:tderef);
+    procedure tpropaccesslist.addsymderef(slt:tsltype;const d:tderef);
       var
-        hp : psymlistitem;
+        hp : ppropaccesslistitem;
       begin
         new(hp);
-        fillchar(hp^,sizeof(tsymlistitem),0);
+        fillchar(hp^,sizeof(tpropaccesslistitem),0);
         hp^.sltype:=slt;
         hp^.symderef:=d;
         if assigned(lastsym) then
@@ -686,12 +679,12 @@ implementation
       end;
 
 
-    procedure tsymlist.addconst(slt:tsltype;v:TConstExprInt;const tt:ttype);
+    procedure tpropaccesslist.addconst(slt:tsltype;v:TConstExprInt;const tt:ttype);
       var
-        hp : psymlistitem;
+        hp : ppropaccesslistitem;
       begin
         new(hp);
-        fillchar(hp^,sizeof(tsymlistitem),0);
+        fillchar(hp^,sizeof(tpropaccesslistitem),0);
         hp^.sltype:=slt;
         hp^.value:=v;
         hp^.valuett:=tt;
@@ -703,12 +696,12 @@ implementation
       end;
 
 
-    procedure tsymlist.addtype(slt:tsltype;const tt:ttype);
+    procedure tpropaccesslist.addtype(slt:tsltype;const tt:ttype);
       var
-        hp : psymlistitem;
+        hp : ppropaccesslistitem;
       begin
         new(hp);
-        fillchar(hp^,sizeof(tsymlistitem),0);
+        fillchar(hp^,sizeof(tpropaccesslistitem),0);
         hp^.sltype:=slt;
         hp^.tt:=tt;
         if assigned(lastsym) then
@@ -719,34 +712,9 @@ implementation
       end;
 
 
-    function tsymlist.getcopy:tsymlist;
-      var
-        hp  : tsymlist;
-        hp2 : psymlistitem;
-        hpn : psymlistitem;
-      begin
-        hp:=tsymlist.create;
-        hp.procdef:=procdef;
-        hp2:=firstsym;
-        while assigned(hp2) do
-         begin
-           new(hpn);
-           hpn^:=hp2^;
-           hpn^.next:=nil;
-           if assigned(hp.lastsym) then
-            hp.lastsym^.next:=hpn
-           else
-            hp.firstsym:=hpn;
-           hp.lastsym:=hpn;
-           hp2:=hp2^.next;
-         end;
-        getcopy:=hp;
-      end;
-
-
-    procedure tsymlist.resolve;
+    procedure tpropaccesslist.resolve;
       var
-        hp : psymlistitem;
+        hp : ppropaccesslistitem;
       begin
         procdef:=tdef(procdefderef.resolve);
         hp:=firstsym;
@@ -770,9 +738,9 @@ implementation
       end;
 
 
-    procedure tsymlist.buildderef;
+    procedure tpropaccesslist.buildderef;
       var
-        hp : psymlistitem;
+        hp : ppropaccesslistitem;
       begin
         procdefderef.build(procdef);
         hp:=firstsym;
@@ -1212,15 +1180,15 @@ implementation
       end;
 
 
-    function tcompilerppufile.getsymlist:tsymlist;
+    function tcompilerppufile.getpropaccesslist:tpropaccesslist;
       var
         symderef : tderef;
         tt  : ttype;
         slt : tsltype;
         idx : longint;
-        p   : tsymlist;
+        p   : tpropaccesslist;
       begin
-        p:=tsymlist.create;
+        p:=tpropaccesslist.create;
         getderef(p.procdefderef);
         repeat
           slt:=tsltype(getbyte);
@@ -1250,7 +1218,7 @@ implementation
               internalerror(200110204);
           end;
         until false;
-        getsymlist:=tsymlist(p);
+        getpropaccesslist:=tpropaccesslist(p);
       end;
 
 
@@ -1387,9 +1355,9 @@ implementation
       end;
 
 
-    procedure tcompilerppufile.putsymlist(p:tsymlist);
+    procedure tcompilerppufile.putpropaccesslist(p:tpropaccesslist);
       var
-        hp : psymlistitem;
+        hp : ppropaccesslistitem;
       begin
         putderef(p.procdefderef);
         hp:=p.firstsym;

+ 16 - 22
compiler/utils/ppudump.pp

@@ -27,9 +27,9 @@ uses
   ppu;
 
 const
-  Version   = 'Version 2.0.2';
+  Version   = 'Version 2.1.1';
   Title     = 'PPU-Analyser';
-  Copyright = 'Copyright (c) 1998-2005 by the Free Pascal Development Team';
+  Copyright = 'Copyright (c) 1998-2006 by the Free Pascal Development Team';
 
 { verbosity }
   v_none           = $0;
@@ -1552,26 +1552,20 @@ begin
              readcommonsym('Property ');
              i:=getlongint;
              writeln(space,'  PropOptions : ',i);
-             if (i and 32)>0 then
-              begin
-                write  (space,' OverrideProp : ');
-                readderef;
-              end
-             else
-              begin
-                write  (space,'    Prop Type : ');
-                readtype;
-                writeln(space,'        Index : ',getlongint);
-                writeln(space,'      Default : ',getlongint);
-                write  (space,'   Index Type : ');
-                readtype;
-                write  (space,'   Readaccess : ');
-                readsymlist(space+'         Sym: ');
-                write  (space,'  Writeaccess : ');
-                readsymlist(space+'         Sym: ');
-                write  (space,' Storedaccess : ');
-                readsymlist(space+'         Sym: ');
-              end;
+             write  (space,' OverrideProp : ');
+             readderef;
+             write  (space,'    Prop Type : ');
+             readtype;
+             writeln(space,'        Index : ',getlongint);
+             writeln(space,'      Default : ',getlongint);
+             write  (space,'   Index Type : ');
+             readtype;
+             write  (space,'   Readaccess : ');
+             readsymlist(space+'         Sym: ');
+             write  (space,'  Writeaccess : ');
+             readsymlist(space+'         Sym: ');
+             write  (space,' Storedaccess : ');
+             readsymlist(space+'         Sym: ');
            end;
 
          iberror :