diff --git a/compiler/dbgdwarf.pas b/compiler/dbgdwarf.pas index 5f4a99eaf7..338317e784 100644 --- a/compiler/dbgdwarf.pas +++ b/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; diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index 0accf36056..f5e50c6e65 100644 --- a/compiler/pdecsub.pas +++ b/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); diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas index 363c8c2dec..fd3d476190 100644 --- a/compiler/pdecvar.pas +++ b/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 diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index f1ab617379..8349a6f857 100644 --- a/compiler/pexpr.pas +++ b/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 : diff --git a/compiler/ppu.pas b/compiler/ppu.pas index 4f5bac2db3..89ed8a1734 100644 --- a/compiler/ppu.pas +++ b/compiler/ppu.pas @@ -43,7 +43,7 @@ type {$endif Test_Double_checksum} const - CurrentPPUVersion=65; + CurrentPPUVersion=66; { buffer sizes } maxentrysize = 1024; diff --git a/compiler/rautils.pas b/compiler/rautils.pas index 2c155b9ebf..49feb5c81f 100644 --- a/compiler/rautils.pas +++ b/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); diff --git a/compiler/symconst.pas b/compiler/symconst.pas index 53fb789049..90c83f6e78 100644 --- a/compiler/symconst.pas +++ b/compiler/symconst.pas @@ -332,7 +332,6 @@ type ppo_defaultproperty, ppo_stored, ppo_hasparameters, - ppo_is_override, ppo_implements ); tpropertyoptions=set of tpropertyoption; diff --git a/compiler/symdef.pas b/compiler/symdef.pas index e02cab021b..1dd8d27c1a 100644 --- a/compiler/symdef.pas +++ b/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 diff --git a/compiler/symsym.pas b/compiler/symsym.pas index 3fe06b3122..1c8ea212ec 100644 --- a/compiler/symsym.pas +++ b/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 : diff --git a/compiler/symtable.pas b/compiler/symtable.pas index 18150ddd39..2f1329f74d 100644 --- a/compiler/symtable.pas +++ b/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; diff --git a/compiler/symtype.pas b/compiler/symtype.pas index a9a5e0e802..9808b2e7a6 100644 --- a/compiler/symtype.pas +++ b/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; + procedure tpropaccesslist.resolve; 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; - 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; diff --git a/compiler/utils/ppudump.pp b/compiler/utils/ppudump.pp index 71c67cdd4b..64623df93a 100644 --- a/compiler/utils/ppudump.pp +++ b/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 :