diff --git a/compiler/ncgld.pas b/compiler/ncgld.pas index e94b373a65..ef31b2d324 100644 --- a/compiler/ncgld.pas +++ b/compiler/ncgld.pas @@ -68,7 +68,6 @@ implementation var intreg, hregister : tregister; - freereg : boolean; symtabletype : tsymtabletype; i : longint; href : treference; @@ -290,107 +289,80 @@ implementation begin if assigned(left) then begin - { - THIS IS A TERRIBLE HACK!!!!!! WHICH WILL NOT WORK - ON 64-BIT SYSTEMS: SINCE PROCSYM FOR METHODS - CONSISTS OF TWO OS_ADDR, so you cannot set it - to OS_64 - how to solve?? Carl - } - if (sizeof(aword) = 4) then - location_reset(location,LOC_CREFERENCE,OS_64) - else - internalerror(20020520); - tg.GetTemp(exprasmlist,2*POINTER_SIZE,tt_normal,location.reference); - freereg:=false; + { + THIS IS A TERRIBLE HACK!!!!!! WHICH WILL NOT WORK + ON 64-BIT SYSTEMS: SINCE PROCSYM FOR METHODS + CONSISTS OF TWO OS_ADDR, so you cannot set it + to OS_64 - how to solve?? Carl + } + if (sizeof(aword) = 4) then + location_reset(location,LOC_CREFERENCE,OS_64) + else + internalerror(20020520); + tg.GetTemp(exprasmlist,2*POINTER_SIZE,tt_normal,location.reference); + secondpass(left); - { called as type.method, then we only need to return - the address of the function, not the self pointer } - if left.nodetype=typen then + { load class instance address } + case left.location.loc of + LOC_CREGISTER, + LOC_REGISTER: + begin + hregister:=left.location.register; + if is_object(left.resulttype.def) then + CGMessage(cg_e_illegal_expression); + end; + LOC_CREFERENCE, + LOC_REFERENCE: + begin + hregister:=rg.getaddressregister(exprasmlist); + if is_class_or_interface(left.resulttype.def) then + cg.a_load_ref_reg(exprasmlist,OS_ADDR,left.location.reference,hregister) + else + cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,hregister); + location_release(exprasmlist,left.location); + location_freetemp(exprasmlist,left.location); + end; + else + internalerror(26019); + end; + + { store the class instance address } + href:=location.reference; + inc(href.offset,POINTER_SIZE); + cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,href); + + { virtual method ? } + if (po_virtualmethod in tprocdef(resulttype.def).procoptions) then begin - { there is no instance, we return 0 } - href:=location.reference; - inc(href.offset,POINTER_SIZE); - cg.a_load_const_ref(exprasmlist,OS_ADDR,0,href); + { load vmt pointer } + reference_reset_base(href,hregister,0); + reference_release(exprasmlist,href); + hregister:=rg.getaddressregister(exprasmlist); + cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister); + + + reference_reset_base(href,hregister,tprocdef(resulttype.def)._class.vmtmethodoffset( + tprocdef(resulttype.def).extnumber)); + reference_release(exprasmlist,href); + + { load method address } + hregister:=rg.getaddressregister(exprasmlist); + cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister); + { ... and store it } + cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,location.reference); + rg.ungetaddressregister(exprasmlist,hregister); end - else + else begin - secondpass(left); - - { load class instance address } - case left.location.loc of - LOC_CREGISTER, - LOC_REGISTER: - begin - hregister:=left.location.register; - if is_object(left.resulttype.def) then - CGMessage(cg_e_illegal_expression); - end; - LOC_CREFERENCE, - LOC_REFERENCE: - begin - hregister:=rg.getaddressregister(exprasmlist); - if is_class_or_interface(left.resulttype.def) then - cg.a_load_ref_reg(exprasmlist,OS_ADDR,left.location.reference,hregister) - else - cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,hregister); - location_release(exprasmlist,left.location); - location_freetemp(exprasmlist,left.location); - end; - else - internalerror(26019); - end; - - { store the class instance address } - href:=location.reference; - inc(href.offset,POINTER_SIZE); - cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,href); - { hregister will be reused when loading a virtual method } - freereg:=true; + { we don't use the hregister } + rg.ungetregister(exprasmlist,hregister); + { load address of the function } + reference_reset_symbol(href,objectlibrary.newasmsymbol(tprocdef(resulttype.def).mangledname),0); + hregister:=cg.get_scratch_reg_address(exprasmlist); + cg.a_loadaddr_ref_reg(exprasmlist,href,hregister); + cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,location.reference); + cg.free_scratch_reg(exprasmlist,hregister); end; - - { virtual method ? } - if (po_virtualmethod in tprocdef(resulttype.def).procoptions) then - begin - if not freereg then - begin - if left.nodetype <> typen then - internalerror(200205161); - reference_reset_symbol(href,objectlibrary.newasmsymbol(tobjectdef(left.resulttype.def).vmt_mangledname), - tprocdef(resulttype.def)._class.vmtmethodoffset(tprocdef(resulttype.def).extnumber)); - end - else - begin - { load vmt pointer } - reference_reset_base(href,hregister,0); - reference_release(exprasmlist,href); - hregister:=rg.getaddressregister(exprasmlist); - cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister); - - - reference_reset_base(href,hregister,tprocdef(resulttype.def)._class.vmtmethodoffset( - tprocdef(resulttype.def).extnumber)); - reference_release(exprasmlist,href); - end; - - { load method address } - hregister:=rg.getaddressregister(exprasmlist); - cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister); - { ... and store it } - cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,location.reference); - rg.ungetaddressregister(exprasmlist,hregister); - end - else - begin - { we don't use the hregister } - if freereg then - rg.ungetregister(exprasmlist,hregister); - { load address of the function } - reference_reset_symbol(href,objectlibrary.newasmsymbol(tprocdef(resulttype.def).mangledname),0); - hregister:=cg.get_scratch_reg_address(exprasmlist); - cg.a_loadaddr_ref_reg(exprasmlist,href,hregister); - cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,location.reference); - cg.free_scratch_reg(exprasmlist,hregister); - end; end else begin @@ -987,7 +959,10 @@ begin end. { $Log$ - Revision 1.42 2002-12-20 18:13:46 peter + Revision 1.43 2003-01-05 22:44:14 peter + * remove a lot of code to support typen in loadn-procsym + + Revision 1.42 2002/12/20 18:13:46 peter * fixes for fpu values in arrayconstructor Revision 1.41 2002/11/27 20:04:39 peter diff --git a/compiler/nld.pas b/compiler/nld.pas index 8eec0e42be..c3899adbeb 100644 --- a/compiler/nld.pas +++ b/compiler/nld.pas @@ -178,7 +178,11 @@ implementation begin p2:=cloadnode.create_procvar(tcallnode(p1).symtableprocentry, tprocdef(tcallnode(p1).procdefinition),tcallnode(p1).symtableproc); - if assigned(tcallnode(p1).methodpointer) then + { when the methodpointer is typen we've something like: + tobject.create. Then only the address is needed of the + method without a self pointer } + if assigned(tcallnode(p1).methodpointer) and + (tcallnode(p1).methodpointer.nodetype<>typen) then begin tloadnode(p2).set_mp(tcallnode(p1).methodpointer); tcallnode(p1).methodpointer:=nil; @@ -268,6 +272,9 @@ implementation procedure tloadnode.set_mp(p:tnode); begin + { typen nodes should not be set } + if p.nodetype=typen then + internalerror(200301042); left:=p; end; @@ -376,38 +383,9 @@ implementation else resulttype.setdef(procdef); - if (m_tp_procvar in aktmodeswitches) then - begin - if assigned(left) then - begin - if left.nodetype=typen then - begin - { we need to return only a voidpointer, - so no need to keep the typen } - left.free; - left:=nil; - end; - end - else - begin - { if the owner of the procsym is a object, } - { left must be set, if left isn't set } - { it can be only self } - if (tprocsym(symtableentry).owner.symtabletype=objectsymtable) then - left:=cselfnode.create(tobjectdef(symtableentry.owner.defowner)); - end; - end; - { process methodpointer } if assigned(left) then - begin - resulttypepass(left); - - { turn on the allowed flag, the secondpass - will handle the typen itself } - if left.nodetype=typen then - ttypenode(left).allowed:=true; - end; + resulttypepass(left); end; else internalerror(200104141); @@ -1272,7 +1250,10 @@ begin end. { $Log$ - Revision 1.78 2003-01-03 12:15:56 daniel + Revision 1.79 2003-01-05 22:44:14 peter + * remove a lot of code to support typen in loadn-procsym + + Revision 1.78 2003/01/03 12:15:56 daniel * Removed ifdefs around notifications ifdefs around for loop optimizations remain diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 25ba17d2d7..8679793e4f 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -709,7 +709,8 @@ implementation else aprocdef:=nil; p2:=cloadnode.create_procvar(sym,aprocdef,st); - if assigned(p1) then + if assigned(p1) and + (p1.nodetype<>typen) then tloadnode(p2).set_mp(p1); p1:=p2; @@ -2303,7 +2304,10 @@ implementation end. { $Log$ - Revision 1.96 2002-12-11 22:40:36 peter + Revision 1.97 2003-01-05 22:44:14 peter + * remove a lot of code to support typen in loadn-procsym + + Revision 1.96 2002/12/11 22:40:36 peter * assigned(procvar) fix for delphi mode, fixes tb0430 Revision 1.95 2002/11/30 11:12:48 carl