mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 19:29:24 +02:00
* procedure of object and addrn fixes
This commit is contained in:
peter
parent
aa90381b86
commit
d4659125d9
@ -490,10 +490,10 @@ implementation
|
||||
end;
|
||||
|
||||
if not(is_con_or_destructor and
|
||||
pobjectdef(p^.methodpointer^.resulttype)^.isclass and
|
||||
assigned(aktprocsym) and
|
||||
((aktprocsym^.definition^.options and
|
||||
(poconstructor or podestructor))<>0)) then
|
||||
pobjectdef(p^.methodpointer^.resulttype)^.isclass and
|
||||
assigned(aktprocsym) and
|
||||
((aktprocsym^.definition^.options and (poconstructor or podestructor))<>0)
|
||||
) then
|
||||
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
|
||||
{ if an inherited con- or destructor should be }
|
||||
{ called in a con- or destructor then a warning }
|
||||
@ -808,7 +808,7 @@ implementation
|
||||
{ which is a class member }
|
||||
{ else ESI is overwritten ! }
|
||||
if (p^.right^.location.reference.base=R_ESI) or
|
||||
(p^.right^.location.reference.index=R_ESI) then
|
||||
(p^.right^.location.reference.index=R_ESI) then
|
||||
begin
|
||||
del_reference(p^.right^.location.reference);
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
|
||||
@ -823,6 +823,7 @@ implementation
|
||||
newreference(p^.right^.location.reference),R_ESI)));
|
||||
{ push self pointer }
|
||||
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
|
||||
|
||||
dec(p^.right^.location.reference.offset,4);
|
||||
|
||||
if hregister=R_NO then
|
||||
@ -1187,7 +1188,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.80 1999-05-17 23:51:37 peter
|
||||
Revision 1.81 1999-05-18 09:52:17 peter
|
||||
* procedure of object and addrn fixes
|
||||
|
||||
Revision 1.80 1999/05/17 23:51:37 peter
|
||||
* with temp vars now use a reference with a persistant temp instead
|
||||
of setting datasize
|
||||
|
||||
|
||||
@ -544,7 +544,8 @@ unit pexpr;
|
||||
begin
|
||||
if ((procvar^.options and pomethodpointer)<>0) then
|
||||
begin
|
||||
if (t^.methodpointer^.resulttype^.deftype=objectdef) and
|
||||
if assigned(t^.methodpointer) and
|
||||
(t^.methodpointer^.resulttype^.deftype=objectdef) and
|
||||
(pobjectdef(t^.methodpointer^.resulttype)^.isclass) and
|
||||
(proc_to_procvar_equal(procvar,pprocsym(t^.symtableentry)^.definition)) then
|
||||
begin
|
||||
@ -1371,7 +1372,7 @@ unit pexpr;
|
||||
classh:=classh^.childof;
|
||||
end;
|
||||
consume(ID);
|
||||
do_member_read(false,sym,p1,pd,again);
|
||||
do_member_read(getaddr,sym,p1,pd,again);
|
||||
end;
|
||||
|
||||
objectdef:
|
||||
@ -1390,8 +1391,9 @@ unit pexpr;
|
||||
end;
|
||||
allow_only_static:=store_static;
|
||||
consume(ID);
|
||||
do_member_read(false,sym,p1,pd,again);
|
||||
do_member_read(getaddr,sym,p1,pd,again);
|
||||
end;
|
||||
|
||||
pointerdef:
|
||||
begin
|
||||
Message(cg_e_invalid_qualifier);
|
||||
@ -1988,7 +1990,10 @@ unit pexpr;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.106 1999-05-16 17:06:31 peter
|
||||
Revision 1.107 1999-05-18 09:52:18 peter
|
||||
* procedure of object and addrn fixes
|
||||
|
||||
Revision 1.106 1999/05/16 17:06:31 peter
|
||||
* remove firstcallparan which looks obsolete
|
||||
|
||||
Revision 1.105 1999/05/12 22:36:09 florian
|
||||
|
||||
@ -180,13 +180,29 @@ implementation
|
||||
make_not_regable(p^.left);
|
||||
if not(assigned(p^.resulttype)) then
|
||||
begin
|
||||
{ proc/procvar 2 procvar ? }
|
||||
if p^.left^.treetype=calln then
|
||||
begin
|
||||
{ it could also be a procvar, not only pprocsym ! }
|
||||
if p^.left^.symtableprocentry^.typ=varsym then
|
||||
hp:=genloadnode(pvarsym(p^.left^.symtableprocentry),p^.left^.symtableproc)
|
||||
else
|
||||
hp:=genloadcallnode(pprocsym(p^.left^.symtableprocentry),p^.left^.symtableproc);
|
||||
begin
|
||||
if assigned(p^.left^.methodpointer) and
|
||||
(p^.left^.methodpointer^.resulttype^.deftype=objectdef) and
|
||||
(pobjectdef(p^.left^.methodpointer^.resulttype)^.isclass) then
|
||||
begin
|
||||
hp:=genloadmethodcallnode(pprocsym(p^.left^.symtableprocentry),p^.left^.symtableproc,
|
||||
getcopy(p^.left^.methodpointer));
|
||||
disposetree(p);
|
||||
firstpass(hp);
|
||||
p:=hp;
|
||||
exit;
|
||||
end
|
||||
else
|
||||
hp:=genloadcallnode(pprocsym(p^.left^.symtableprocentry),p^.left^.symtableproc);
|
||||
end;
|
||||
|
||||
{ result is a procedure variable }
|
||||
{ No, to be TP compatible, you must return a pointer to
|
||||
the procedure that is stored in the procvar.}
|
||||
@ -553,7 +569,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.15 1999-05-17 23:51:46 peter
|
||||
Revision 1.16 1999-05-18 09:52:21 peter
|
||||
* procedure of object and addrn fixes
|
||||
|
||||
Revision 1.15 1999/05/17 23:51:46 peter
|
||||
* with temp vars now use a reference with a persistant temp instead
|
||||
of setting datasize
|
||||
|
||||
|
||||
@ -249,6 +249,7 @@ unit tree;
|
||||
function genlabelnode(t : ttreetyp;nr : plabel) : ptree;
|
||||
function genloadnode(v : pvarsym;st : psymtable) : ptree;
|
||||
function genloadcallnode(v: pprocsym;st: psymtable): ptree;
|
||||
function genloadmethodcallnode(v: pprocsym;st: psymtable; mp:ptree): ptree;
|
||||
function gensinglenode(t : ttreetyp;l : ptree) : ptree;
|
||||
function gensubscriptnode(varsym : pvarsym;l : ptree) : ptree;
|
||||
function genordinalconstnode(v : longint;def : pdef) : ptree;
|
||||
@ -965,6 +966,30 @@ unit tree;
|
||||
genloadcallnode:=p;
|
||||
end;
|
||||
|
||||
function genloadmethodcallnode(v: pprocsym;st: psymtable; mp:ptree): ptree;
|
||||
var
|
||||
p : ptree;
|
||||
|
||||
begin
|
||||
p:=getnode;
|
||||
p^.registers32:=0;
|
||||
{ p^.registers16:=0;
|
||||
p^.registers8:=0; }
|
||||
p^.registersfpu:=0;
|
||||
{$ifdef SUPPORT_MMX}
|
||||
p^.registersmmx:=0;
|
||||
{$endif SUPPORT_MMX}
|
||||
p^.treetype:=loadn;
|
||||
p^.left:=nil;
|
||||
p^.resulttype:=v^.definition;
|
||||
p^.symtableentry:=v;
|
||||
p^.symtable:=st;
|
||||
p^.is_first := False;
|
||||
p^.disposetyp:=dt_left;
|
||||
p^.left:=mp;
|
||||
genloadmethodcallnode:=p;
|
||||
end;
|
||||
|
||||
|
||||
function gentypedconstloadnode(sym : ptypedconstsym;st : psymtable) : ptree;
|
||||
|
||||
@ -1708,7 +1733,10 @@ unit tree;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.80 1999-05-17 23:51:48 peter
|
||||
Revision 1.81 1999-05-18 09:52:22 peter
|
||||
* procedure of object and addrn fixes
|
||||
|
||||
Revision 1.80 1999/05/17 23:51:48 peter
|
||||
* with temp vars now use a reference with a persistant temp instead
|
||||
of setting datasize
|
||||
|
||||
|
||||
@ -486,7 +486,7 @@ implementation
|
||||
(pstringdef(p)^.string_typ in [st_ansistring,st_widestring]) then
|
||||
ungettempoftype:=false;
|
||||
end;
|
||||
|
||||
|
||||
function mmx_type(p : pdef) : tmmxtype;
|
||||
begin
|
||||
mmx_type:=mmxno;
|
||||
@ -611,6 +611,9 @@ implementation
|
||||
|
||||
|
||||
function is_equal(def1,def2 : pdef) : boolean;
|
||||
const
|
||||
procvarmask = not(poassembler or pomethodpointer or povirtualmethod or pooverridingmethod or
|
||||
pocontainsself or pomsgstr or pomsgint);
|
||||
var
|
||||
b : boolean;
|
||||
hd : pdef;
|
||||
@ -711,12 +714,8 @@ implementation
|
||||
{ poassembler isn't important for compatibility }
|
||||
{ if a method is assigned to a methodpointer }
|
||||
{ is checked before }
|
||||
b:=((pprocvardef(def1)^.options and not(poassembler or pomethodpointer or
|
||||
povirtualmethod or pooverridingmethod))=
|
||||
(pprocvardef(def2)^.options and not(poassembler or pomethodpointer or
|
||||
povirtualmethod or pooverridingmethod))
|
||||
) and
|
||||
is_equal(pprocvardef(def1)^.retdef,pprocvardef(def2)^.retdef);
|
||||
b:=((pprocvardef(def1)^.options and procvarmask)=(pprocvardef(def2)^.options and procvarmask)) and
|
||||
is_equal(pprocvardef(def1)^.retdef,pprocvardef(def2)^.retdef);
|
||||
{ now evalute the parameters }
|
||||
if b then
|
||||
begin
|
||||
@ -794,7 +793,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.58 1999-04-19 09:29:51 pierre
|
||||
Revision 1.59 1999-05-18 09:52:24 peter
|
||||
* procedure of object and addrn fixes
|
||||
|
||||
Revision 1.58 1999/04/19 09:29:51 pierre
|
||||
+ ungettempoftype(pdef) boolean function
|
||||
returns true (can call ungetiftemp )
|
||||
unless the temp should be "unget" with temptoremove
|
||||
|
||||
Loading…
Reference in New Issue
Block a user