diff --git a/compiler/cg386cal.pas b/compiler/cg386cal.pas index c88bb3f470..88a5a4ac51 100644 --- a/compiler/cg386cal.pas +++ b/compiler/cg386cal.pas @@ -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 diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 58e9a18384..406ed5af82 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -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 diff --git a/compiler/tcmem.pas b/compiler/tcmem.pas index 02c509c39c..286f5ad6d0 100644 --- a/compiler/tcmem.pas +++ b/compiler/tcmem.pas @@ -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 diff --git a/compiler/tree.pas b/compiler/tree.pas index c3d22fa84a..47a00a7490 100644 --- a/compiler/tree.pas +++ b/compiler/tree.pas @@ -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 diff --git a/compiler/types.pas b/compiler/types.pas index 467ab4eefa..60cb4c3a2b 100644 --- a/compiler/types.pas +++ b/compiler/types.pas @@ -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