diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas index c1586b1c1b..573712a378 100644 --- a/compiler/pdecvar.pas +++ b/compiler/pdecvar.pas @@ -392,10 +392,10 @@ implementation begin if try_to_consume(_READ) then begin - p.readaccess.clear; - if parse_symlist(p.readaccess,def) then + p.propaccesslist[palt_read].clear; + if parse_symlist(p.propaccesslist[palt_read],def) then begin - sym:=p.readaccess.firstsym^.sym; + sym:=p.propaccesslist[palt_read].firstsym^.sym; case sym.typ of procsym : begin @@ -407,8 +407,8 @@ implementation { we ignore hidden stuff here because the property access symbol might have non default calling conventions which might change the hidden stuff; see tw3216.pp (FK) } - p.readaccess.procdef:=Tprocsym(sym).search_procdef_bypara(readprocdef.paras,p.propdef,[cpo_allowdefaults,cpo_ignorehidden]); - if not assigned(p.readaccess.procdef) then + p.propaccesslist[palt_read].procdef:=Tprocsym(sym).search_procdef_bypara(readprocdef.paras,p.propdef,[cpo_allowdefaults,cpo_ignorehidden]); + if not assigned(p.propaccesslist[palt_read].procdef) then Message(parser_e_ill_property_access_sym); end; fieldvarsym : @@ -435,10 +435,10 @@ implementation end; if try_to_consume(_WRITE) then begin - p.writeaccess.clear; - if parse_symlist(p.writeaccess,def) then + p.propaccesslist[palt_write].clear; + if parse_symlist(p.propaccesslist[palt_write],def) then begin - sym:=p.writeaccess.firstsym^.sym; + sym:=p.propaccesslist[palt_write].firstsym^.sym; case sym.typ of procsym : begin @@ -451,8 +451,8 @@ implementation { Insert hidden parameters } handle_calling_convention(writeprocdef); { search procdefs matching writeprocdef } - p.writeaccess.procdef:=Tprocsym(sym).search_procdef_bypara(writeprocdef.paras,writeprocdef.returndef,[cpo_allowdefaults]); - if not assigned(p.writeaccess.procdef) then + p.propaccesslist[palt_write].procdef:=Tprocsym(sym).search_procdef_bypara(writeprocdef.paras,writeprocdef.returndef,[cpo_allowdefaults]); + if not assigned(p.propaccesslist[palt_write].procdef) then Message(parser_e_ill_property_access_sym); end; fieldvarsym : @@ -505,7 +505,7 @@ implementation if try_to_consume(_STORED) then begin include(p.propoptions,ppo_stored); - p.storedaccess.clear; + p.propaccesslist[palt_stored].clear; case token of _ID: begin @@ -515,16 +515,16 @@ implementation { as stored true } if idtoken<>_DEFAULT then begin - if parse_symlist(p.storedaccess,def) then + if parse_symlist(p.propaccesslist[palt_stored],def) then begin - sym:=p.storedaccess.firstsym^.sym; + sym:=p.propaccesslist[palt_stored].firstsym^.sym; case sym.typ of procsym : begin { Insert hidden parameters } handle_calling_convention(storedprocdef); - p.storedaccess.procdef:=Tprocsym(sym).search_procdef_bypara(storedprocdef.paras,storedprocdef.returndef,[cpo_allowdefaults,cpo_ignorehidden]); - if not assigned(p.storedaccess.procdef) then + p.propaccesslist[palt_stored].procdef:=Tprocsym(sym).search_procdef_bypara(storedprocdef.paras,storedprocdef.returndef,[cpo_allowdefaults,cpo_ignorehidden]); + if not assigned(p.propaccesslist[palt_stored].procdef) then message(parser_e_ill_property_storage_sym); end; fieldvarsym : @@ -633,7 +633,7 @@ implementation if intfidx > 0 then begin interfaces(intfidx).iitype := etFieldValue; - interfaces(intfidx).iioffset := tfieldvarsym(p.readaccess.firstsym^.sym).fieldoffset; + interfaces(intfidx).iioffset := tfieldvarsym(p.propaccesslist[palt_read].firstsym^.sym).fieldoffset; end else begin writeln('Implements-property used on unimplemented interface'); diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index ab6d6633f4..20d635a1f5 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -1076,8 +1076,26 @@ implementation p2 : tnode; membercall : boolean; callflags : tcallnodeflags; - hpropsym : tpropertysym; propaccesslist : tpropaccesslist; + + function getpropaccesslist(pap:tpropaccesslisttypes):boolean; + var + hpropsym : tpropertysym; + begin + result:=false; + { find property in the overriden list } + hpropsym:=propsym; + repeat + propaccesslist:=hpropsym.propaccesslist[pap]; + if not propaccesslist.empty then + begin + result:=true; + exit; + end; + hpropsym:=hpropsym.overridenpropsym; + until not assigned(hpropsym); + end; + begin { property parameters? read them only if the property really } { has parameters } @@ -1100,15 +1118,7 @@ implementation { if not(afterassignment) and not(in_args) then } if token=_ASSIGNMENT then begin - { 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 + if getpropaccesslist(palt_write) then begin case propaccesslist.firstsym^.sym.typ of procsym : @@ -1158,15 +1168,7 @@ implementation end else begin - { 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 + if getpropaccesslist(palt_read) then begin case propaccesslist.firstsym^.sym.typ of fieldvarsym : diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 18d544d60d..20f7ad23db 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -4828,23 +4828,31 @@ implementation proctypesinfo : byte; propnameitem : tpropnamelistitem; - procedure writeproc(proc : tpropaccesslist; shiftvalue : byte; unsetvalue: byte); - + procedure writeaccessproc(pap:tpropaccesslisttypes; shiftvalue : byte; unsetvalue: byte); var typvalue : byte; hp : ppropaccesslistitem; address : longint; def : tdef; + hpropsym : tpropertysym; + propaccesslist : tpropaccesslist; begin - if not(assigned(proc) and assigned(proc.firstsym)) then + hpropsym:=tpropertysym(sym); + repeat + propaccesslist:=hpropsym.propaccesslist[pap]; + if not propaccesslist.empty then + break; + hpropsym:=hpropsym.overridenpropsym; + until not assigned(hpropsym); + if not(assigned(propaccesslist) and assigned(propaccesslist.firstsym)) then begin current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,unsetvalue)); typvalue:=3; end - else if proc.firstsym^.sym.typ=fieldvarsym then + else if propaccesslist.firstsym^.sym.typ=fieldvarsym then begin address:=0; - hp:=proc.firstsym; + hp:=propaccesslist.firstsym; def:=nil; while assigned(hp) do begin @@ -4877,18 +4885,18 @@ implementation else begin { When there was an error then procdef is not assigned } - if not assigned(proc.procdef) then + if not assigned(propaccesslist.procdef) then exit; - if not(po_virtualmethod in tprocdef(proc.procdef).procoptions) then + if not(po_virtualmethod in tprocdef(propaccesslist.procdef).procoptions) then begin - current_asmdata.asmlists[al_rtti].concat(Tai_const.createname(tprocdef(proc.procdef).mangledname,0)); + current_asmdata.asmlists[al_rtti].concat(Tai_const.createname(tprocdef(propaccesslist.procdef).mangledname,0)); typvalue:=1; end else begin { virtual method, write vmt offset } current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr, - tprocdef(proc.procdef)._class.vmtmethodoffset(tprocdef(proc.procdef).extnumber))); + tprocdef(propaccesslist.procdef)._class.vmtmethodoffset(tprocdef(propaccesslist.procdef).extnumber))); typvalue:=2; end; end; @@ -4904,13 +4912,17 @@ implementation else proctypesinfo:=0; current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(tstoreddef(tpropertysym(sym).propdef).get_rtti_label(fullrtti))); - writeproc(tpropertysym(sym).readaccess,0,0); - writeproc(tpropertysym(sym).writeaccess,2,0); + writeaccessproc(palt_read,0,0); + writeaccessproc(palt_write,2,0); { is it stored ? } if not(ppo_stored in tpropertysym(sym).propoptions) then - writeproc(nil,4,0) { no, so put a constant zero } + begin + { no, so put a constant zero } + current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,0)); + proctypesinfo:=proctypesinfo or (3 shl 4); + end else - writeproc(tpropertysym(sym).storedaccess,4,1); { maybe; if no procedure put a constant 1 (=true) } + writeaccessproc(palt_stored,4,1); { maybe; if no procedure put a constant 1 (=true) } current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tpropertysym(sym).index)); current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tpropertysym(sym).default)); propnameitem:=searchpropnamelist(tpropertysym(sym).name); diff --git a/compiler/symsym.pas b/compiler/symsym.pas index 6c23dca1c1..fbc91c2d9c 100644 --- a/compiler/symsym.pas +++ b/compiler/symsym.pas @@ -231,6 +231,8 @@ interface procedure ppuwrite(ppufile:tcompilerppufile);override; end; + tpropaccesslisttypes=(palt_none,palt_read,palt_write,palt_stored); + tpropertysym = class(Tstoredsym) propoptions : tpropertyoptions; overridenpropsym : tpropertysym; @@ -240,10 +242,8 @@ interface indexdef : tdef; indexdefderef : tderef; index, - default : longint; - readaccess, - writeaccess, - storedaccess : tpropaccesslist; + default : longint; + propaccesslist : array[tpropaccesslisttypes] of tpropaccesslist; constructor create(const n : string); destructor destroy;override; constructor ppuload(ppufile:tcompilerppufile); @@ -1067,6 +1067,8 @@ implementation ****************************************************************************} constructor tpropertysym.create(const n : string); + var + pap : tpropaccesslisttypes; begin inherited create(propertysym,n); propoptions:=[]; @@ -1074,13 +1076,14 @@ implementation default:=0; propdef:=nil; indexdef:=nil; - readaccess:=tpropaccesslist.create; - writeaccess:=tpropaccesslist.create; - storedaccess:=tpropaccesslist.create; + for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do + propaccesslist[pap]:=tpropaccesslist.create; end; constructor tpropertysym.ppuload(ppufile:tcompilerppufile); + var + pap : tpropaccesslisttypes; begin inherited ppuload(propertysym,ppufile); ppufile.getsmallset(propoptions); @@ -1089,17 +1092,17 @@ implementation index:=ppufile.getlongint; default:=ppufile.getlongint; ppufile.getderef(indexdefderef); - readaccess:=ppufile.getpropaccesslist; - writeaccess:=ppufile.getpropaccesslist; - storedaccess:=ppufile.getpropaccesslist; + for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do + propaccesslist[pap]:=ppufile.getpropaccesslist; end; destructor tpropertysym.destroy; + var + pap : tpropaccesslisttypes; begin - readaccess.free; - writeaccess.free; - storedaccess.free; + for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do + propaccesslist[pap].free; inherited destroy; end; @@ -1111,24 +1114,26 @@ implementation procedure tpropertysym.buildderef; + var + pap : tpropaccesslisttypes; begin overridenpropsymderef.build(overridenpropsym); propdefderef.build(propdef); indexdefderef.build(indexdef); - readaccess.buildderef; - writeaccess.buildderef; - storedaccess.buildderef; + for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do + propaccesslist[pap].buildderef; end; procedure tpropertysym.deref; + var + pap : tpropaccesslisttypes; begin overridenpropsym:=tpropertysym(overridenpropsymderef.resolve); indexdef:=tdef(indexdefderef.resolve); propdef:=tdef(propdefderef.resolve); - readaccess.resolve; - writeaccess.resolve; - storedaccess.resolve; + for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do + propaccesslist[pap].resolve; end; @@ -1139,6 +1144,8 @@ implementation procedure tpropertysym.ppuwrite(ppufile:tcompilerppufile); + var + pap : tpropaccesslisttypes; begin inherited ppuwrite(ppufile); ppufile.putsmallset(propoptions); @@ -1147,9 +1154,8 @@ implementation ppufile.putlongint(index); ppufile.putlongint(default); ppufile.putderef(indexdefderef); - ppufile.putpropaccesslist(readaccess); - ppufile.putpropaccesslist(writeaccess); - ppufile.putpropaccesslist(storedaccess); + for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do + ppufile.putpropaccesslist(propaccesslist[pap]); ppufile.writeentry(ibpropertysym); end;