mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-27 20:54:30 +02:00
* fix property overriding
git-svn-id: trunk@5045 -
This commit is contained in:
peter
parent
9fc11fc5dc
commit
0f6355e805
@ -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;
|
||||
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 :
|
||||
|
||||
@ -43,7 +43,7 @@ type
|
||||
{$endif Test_Double_checksum}
|
||||
|
||||
const
|
||||
CurrentPPUVersion=65;
|
||||
CurrentPPUVersion=66;
|
||||
|
||||
{ buffer sizes }
|
||||
maxentrysize = 1024;
|
||||
|
||||
@ -761,7 +761,7 @@ var
|
||||
harrdef : tarraydef;
|
||||
indexreg : tregister;
|
||||
l : aint;
|
||||
plist : psymlistitem;
|
||||
plist : ppropaccesslistitem;
|
||||
Begin
|
||||
SetupVar:=false;
|
||||
asmsearchsym(s,sym,srsymtable);
|
||||
|
||||
@ -332,7 +332,6 @@ type
|
||||
ppo_defaultproperty,
|
||||
ppo_stored,
|
||||
ppo_hasparameters,
|
||||
ppo_is_override,
|
||||
ppo_implements
|
||||
);
|
||||
tpropertyoptions=set of tpropertyoption;
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 :
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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 :
|
||||
|
||||
Loading…
Reference in New Issue
Block a user