From ac400051bd1ca37842102bd189fbb7194736e861 Mon Sep 17 00:00:00 2001 From: peter Date: Sun, 28 Oct 2001 17:22:25 +0000 Subject: [PATCH] * allow assignment of overloaded procedures to procvars when we know which procedure to take --- compiler/i386/n386ld.pas | 16 ++++++---- compiler/ncal.pas | 7 +++-- compiler/ncnv.pas | 14 ++++++--- compiler/nld.pas | 34 ++++++++++++++++----- compiler/nmem.pas | 12 +++++--- compiler/pexpr.pas | 33 +++++++++++++-------- compiler/types.pas | 64 ++++++++++++++++++++++++++++++++++++---- 7 files changed, 138 insertions(+), 42 deletions(-) diff --git a/compiler/i386/n386ld.pas b/compiler/i386/n386ld.pas index 0be02c5bab..510bf0f628 100644 --- a/compiler/i386/n386ld.pas +++ b/compiler/i386/n386ld.pas @@ -352,7 +352,7 @@ implementation hregister,hp); { virtual method ? } - if (po_virtualmethod in tprocsym(symtableentry).definition.procoptions) then + if (po_virtualmethod in tprocdef(resulttype.def).procoptions) then begin new(hp); reset_reference(hp^); @@ -367,8 +367,8 @@ implementation new(hp); reset_reference(hp^); hp^.base:=R_EDI; - hp^.offset:=tprocsym(symtableentry).definition._class.vmtmethodoffset( - tprocsym(symtableentry).definition.extnumber); + hp^.offset:=tprocdef(resulttype.def)._class.vmtmethodoffset( + tprocdef(resulttype.def).extnumber); emit_ref_reg(A_MOV,S_L, hp,R_EDI); { ... and store it } @@ -379,7 +379,7 @@ implementation else begin ungetregister32(R_EDI); - s:=newasmsymbol(tprocsym(symtableentry).definition.mangledname); + s:=newasmsymbol(tprocdef(resulttype.def).mangledname); emit_sym_ofs_ref(A_MOV,S_L,s,0, newreference(location.reference)); end; @@ -387,7 +387,7 @@ implementation else begin {!!!!! Be aware, work on virtual methods too } - location.reference.symbol:=newasmsymbol(tprocsym(symtableentry).definition.mangledname); + location.reference.symbol:=newasmsymbol(tprocdef(resulttype.def).mangledname); end; end; typedconstsym : @@ -1085,7 +1085,11 @@ begin end. { $Log$ - Revision 1.24 2001-10-14 11:49:51 jonas + Revision 1.25 2001-10-28 17:22:25 peter + * allow assignment of overloaded procedures to procvars when we know + which procedure to take + + Revision 1.24 2001/10/14 11:49:51 jonas * finetuned register allocation info for assignments Revision 1.23 2001/10/04 14:33:28 jonas diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 9d8f6829b8..ef85453e5a 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -726,7 +726,7 @@ implementation ( (m_tp_procvar in aktmodeswitches) and (def.deftype=procvardef) and (p.left.nodetype=calln) and - (proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def))) + (proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def),false)) ) ; end; @@ -1743,8 +1743,9 @@ begin end. { $Log$ - Revision 1.52 2001-10-25 21:22:33 peter - * calling convention rewrite + Revision 1.53 2001-10-28 17:22:25 peter + * allow assignment of overloaded procedures to procvars when we know + which procedure to take Revision 1.51 2001/10/13 09:01:14 jonas * fixed bug with using procedures as procvar parameters in TP/Delphi mode diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas index 6c94c7f855..dd1e13c2ea 100644 --- a/compiler/ncnv.pas +++ b/compiler/ncnv.pas @@ -766,6 +766,7 @@ implementation var hp : tnode; + currprocdef, aprocdef : tprocdef; begin @@ -837,8 +838,9 @@ implementation begin if is_procsym_call(left) then begin - hp:=cloadnode.create(tprocsym(tcallnode(left).symtableprocentry), - tcallnode(left).symtableproc); + currprocdef:=get_proc_2_procvar_def(tprocsym(tcallnode(left).symtableprocentry),tprocvardef(resulttype.def)); + hp:=cloadnode.create_procvar(tprocsym(tcallnode(left).symtableprocentry), + currprocdef,tcallnode(left).symtableproc); if (tcallnode(left).symtableprocentry.owner.symtabletype=objectsymtable) and assigned(tcallnode(left).methodpointer) then tloadnode(hp).set_mp(tcallnode(left).methodpointer.getcopy); @@ -857,7 +859,7 @@ implementation the procvar, is compatible with the procvar's type } if assigned(aprocdef) then begin - if not proc_to_procvar_equal(aprocdef,tprocvardef(resulttype.def)) then + if not proc_to_procvar_equal(aprocdef,tprocvardef(resulttype.def),false) then CGMessage2(type_e_incompatible_types,aprocdef.typename,resulttype.def.typename); end else @@ -1595,7 +1597,11 @@ begin end. { $Log$ - Revision 1.41 2001-10-20 19:28:37 peter + Revision 1.42 2001-10-28 17:22:25 peter + * allow assignment of overloaded procedures to procvars when we know + which procedure to take + + Revision 1.41 2001/10/20 19:28:37 peter * interface 2 guid support * guid constants support diff --git a/compiler/nld.pas b/compiler/nld.pas index 5d378a0f1d..20fc11615f 100644 --- a/compiler/nld.pas +++ b/compiler/nld.pas @@ -28,13 +28,15 @@ interface uses node, - symbase,symtype,symsym; + symbase,symtype,symsym,symdef; type tloadnode = class(tunarynode) symtableentry : tsym; symtable : tsymtable; + procsymdef : tprocdef; constructor create(v : tsym;st : tsymtable);virtual; + constructor create_procvar(v : tsym;d:tprocdef;st : tsymtable);virtual; procedure set_mp(p:tnode); function getcopy : tnode;override; function pass_1 : tnode;override; @@ -106,7 +108,7 @@ implementation uses cutils,verbose,globtype,globals,systems, - symconst,symdef,symtable,types, + symconst,symtable,types, htypechk,pass_1, ncnv,nmem,cpubase,tgcpu,cgbase ; @@ -117,15 +119,24 @@ implementation *****************************************************************************} constructor tloadnode.create(v : tsym;st : tsymtable); - begin inherited create(loadn,nil); if not assigned(v) then internalerror(200108121); symtableentry:=v; symtable:=st; + procsymdef:=nil; end; + constructor tloadnode.create_procvar(v : tsym;d:tprocdef;st : tsymtable); + begin + inherited create(loadn,nil); + if not assigned(v) then + internalerror(200108121); + symtableentry:=v; + symtable:=st; + procsymdef:=d; + end; procedure tloadnode.set_mp(p:tnode); begin @@ -228,9 +239,14 @@ implementation resulttype:=ttypedconstsym(symtableentry).typedconsttype; procsym : begin - if assigned(tprocsym(symtableentry).definition.nextoverloaded) then - CGMessage(parser_e_no_overloaded_procvars); - resulttype.setdef(tprocsym(symtableentry).definition); + if not assigned(procsymdef) then + begin + if assigned(tprocsym(symtableentry).definition.nextoverloaded) then + CGMessage(parser_e_no_overloaded_procvars); + resulttype.setdef(tprocsym(symtableentry).definition); + end + else + resulttype.setdef(procsymdef); { if the owner of the procsym is a object, } { left must be set, if left isn't set } { it can be only self } @@ -801,7 +817,11 @@ begin end. { $Log$ - Revision 1.26 2001-10-12 13:51:51 jonas + Revision 1.27 2001-10-28 17:22:25 peter + * allow assignment of overloaded procedures to procvars when we know + which procedure to take + + Revision 1.26 2001/10/12 13:51:51 jonas * fixed internalerror(10) due to previous fpu overflow fixes ("merged") * fixed bug in n386add (introduced after compilerproc changes for string operations) where calcregisters wasn't called for shortstring addnodes diff --git a/compiler/nmem.pas b/compiler/nmem.pas index e649e485ee..fd88cd5503 100644 --- a/compiler/nmem.pas +++ b/compiler/nmem.pas @@ -68,6 +68,7 @@ interface tsimplenewdisposenodeclass = class of tsimplenewdisposenode; taddrnode = class(tunarynode) + getprocvardef : tprocvardef; constructor create(l : tnode);virtual; function pass_1 : tnode;override; function det_resulttype:tnode;override; @@ -412,8 +413,10 @@ implementation the procedure that is stored in the procvar.} if not(m_tp_procvar in aktmodeswitches) then begin - - hp3:=tabstractprocdef(tprocsym(tloadnode(left).symtableentry).definition); + if assigned(getprocvardef) then + hp3:=getprocvardef + else + hp3:=tabstractprocdef(tprocsym(tloadnode(left).symtableentry).definition); { create procvardef } resulttype.setdef(tprocvardef.create); @@ -982,8 +985,9 @@ begin end. { $Log$ - Revision 1.21 2001-10-25 21:22:35 peter - * calling convention rewrite + Revision 1.22 2001-10-28 17:22:25 peter + * allow assignment of overloaded procedures to procvars when we know + which procedure to take Revision 1.20 2001/09/02 21:12:07 peter * move class of definitions into type section for delphi diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index e10dad8c89..ecdd87284d 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -822,6 +822,7 @@ implementation hs,hs1 : tvarsym; para,p2 : tnode; hst : tsymtable; + aprocdef : tprocdef; begin prevafterassn:=afterassignment; afterassignment:=false; @@ -886,7 +887,11 @@ implementation { generate a methodcallnode or proccallnode } { we shouldn't convert things like @tcollection.load } - p2:=cloadnode.create(sym,st); + if getprocvar then + aprocdef:=get_proc_2_procvar_def(tprocsym(sym),getprocvardef) + else + aprocdef:=nil; + p2:=cloadnode.create_procvar(sym,aprocdef,st); if assigned(p1) then tloadnode(p2).set_mp(p1); p1:=p2; @@ -902,16 +907,15 @@ implementation procedure doconv(procvar : tprocvardef;var t : tnode); var hp : tnode; + currprocdef : tprocdef; begin hp:=nil; - if (proc_to_procvar_equal(tprocsym(tcallnode(t).symtableprocentry).definition,procvar)) then + currprocdef:=get_proc_2_procvar_def(tcallnode(t).symtableprocentry,procvar); + if assigned(currprocdef) then begin - hp:=cloadnode.create(tprocsym(tcallnode(t).symtableprocentry),tcallnode(t).symtableproc); + hp:=cloadnode.create_procvar(tprocsym(tcallnode(t).symtableprocentry),currprocdef,tcallnode(t).symtableproc); if (po_methodpointer in procvar.procoptions) then tloadnode(hp).set_mp(tnode(tcallnode(t).methodpointer).getcopy); - end; - if assigned(hp) then - begin t.destroy; t:=hp; end; @@ -1133,7 +1137,7 @@ implementation (getprocvar and ((block_type=bt_const) or ((m_tp_procvar in aktmodeswitches) and - proc_to_procvar_equal(tprocsym(sym).definition,getprocvardef) + proc_to_procvar_equal(tprocsym(sym).definition,getprocvardef,false) ) ) ),again,p1); @@ -1473,7 +1477,7 @@ implementation (getprocvar and ((block_type=bt_const) or ((m_tp_procvar in aktmodeswitches) and - proc_to_procvar_equal(tprocsym(srsym).definition,getprocvardef) + proc_to_procvar_equal(tprocsym(srsym).definition,getprocvardef,false) ) ) ),again,p1); @@ -1903,7 +1907,7 @@ implementation card : cardinal; ic : TConstExprInt; oldp1, - p1,p2 : tnode; + p1 : tnode; code : integer; {$ifdef TEST_PROCSYMS} unit_specific, @@ -2177,6 +2181,8 @@ implementation p1:=factor(true); got_addrn:=false; p1:=caddrnode.create(p1); + if getprocvar then + taddrnode(p1).getprocvardef:=getprocvardef; end; _LKLAMMER : @@ -2416,8 +2422,7 @@ implementation _ASSIGNMENT : begin consume(_ASSIGNMENT); - if (m_tp_procvar in aktmodeswitches) and - (p1.resulttype.def.deftype=procvardef) then + if (p1.resulttype.def.deftype=procvardef) then begin getprocvar:=true; getprocvardef:=tprocvardef(p1.resulttype.def); @@ -2508,7 +2513,11 @@ implementation end. { $Log$ - Revision 1.47 2001-10-24 11:51:39 marco + Revision 1.48 2001-10-28 17:22:25 peter + * allow assignment of overloaded procedures to procvars when we know + which procedure to take + + Revision 1.47 2001/10/24 11:51:39 marco * Make new/dispose system functions instead of keywords Revision 1.46 2001/10/21 13:10:51 peter diff --git a/compiler/types.pas b/compiler/types.pas index 8ccd521907..613081234b 100644 --- a/compiler/types.pas +++ b/compiler/types.pas @@ -221,7 +221,9 @@ interface function convertable_paras(paralist1,paralist2 : tlinkedlist; acp : compare_type) : boolean; { true if a function can be assigned to a procvar } - function proc_to_procvar_equal(def1:tprocdef;def2:tprocvardef) : boolean; + function proc_to_procvar_equal(def1:tprocdef;def2:tprocvardef;exact:boolean) : boolean; + + function get_proc_2_procvar_def(p:tprocsym;d:tprocvardef):tprocdef; { if l isn't in the range of def a range check error (if not explicit) is generated and the value is placed within the range } @@ -411,7 +413,7 @@ implementation { true if a function can be assigned to a procvar } - function proc_to_procvar_equal(def1:tprocdef;def2:tprocvardef) : boolean; + function proc_to_procvar_equal(def1:tprocdef;def2:tprocvardef;exact:boolean) : boolean; const po_comp = po_compatibility_options-[po_methodpointer,po_classmethod]; var @@ -438,7 +440,7 @@ implementation parameters may also be convertable } if is_equal(def1.rettype.def,def2.rettype.def) and (equal_paras(def1.para,def2.para,cp_all) or - convertable_paras(def1.para,def2.para,cp_all)) and + ((not exact) and convertable_paras(def1.para,def2.para,cp_all))) and ((po_comp * def1.procoptions)= (po_comp * def2.procoptions)) then proc_to_procvar_equal:=true else @@ -446,6 +448,55 @@ implementation end; + function get_proc_2_procvar_def(p:tprocsym;d:tprocvardef):tprocdef; + var + matchprocdef, + currprocdef : tprocdef; + begin + { This function will return the pprocdef of pprocsym that + is the best match for procvardef. When there are multiple + matches it returns nil } + { exact match } + currprocdef:=p.definition; + matchprocdef:=nil; + while assigned(currprocdef) do + begin + if proc_to_procvar_equal(currprocdef,d,true) then + begin + { already found a match ? Then stop and return nil } + if assigned(matchprocdef) then + begin + matchprocdef:=nil; + break; + end; + matchprocdef:=currprocdef; + end; + currprocdef:=currprocdef.nextoverloaded; + end; + { convertable match, if no exact match was found } + if not assigned(matchprocdef) and + not assigned(currprocdef) then + begin + currprocdef:=p.definition; + while assigned(currprocdef) do + begin + if proc_to_procvar_equal(currprocdef,d,false) then + begin + { already found a match ? Then stop and return nil } + if assigned(matchprocdef) then + begin + matchprocdef:=nil; + break; + end; + matchprocdef:=currprocdef; + end; + currprocdef:=currprocdef.nextoverloaded; + end; + end; + get_proc_2_procvar_def:=matchprocdef; + end; + + { returns true, if def uses FPU } function is_fpu(def : tdef) : boolean; begin @@ -1626,7 +1677,7 @@ implementation (m_tp_procvar in aktmodeswitches) then begin doconv:=tc_proc_2_procvar; - if proc_to_procvar_equal(tprocdef(def_from),tprocvardef(def_to)) then + if proc_to_procvar_equal(tprocdef(def_from),tprocvardef(def_to),false) then b:=1; end else @@ -1808,8 +1859,9 @@ implementation end. { $Log$ - Revision 1.53 2001-10-25 21:22:40 peter - * calling convention rewrite + Revision 1.54 2001-10-28 17:22:25 peter + * allow assignment of overloaded procedures to procvars when we know + which procedure to take Revision 1.52 2001/10/22 21:21:09 peter * allow enum(enum)