From 2be8f01efe35eec1c1bb9b278b54de3715fc5b2f Mon Sep 17 00:00:00 2001 From: Sven/Sarah Barth Date: Thu, 22 Jul 2021 17:44:01 +0200 Subject: [PATCH] * implement assignment of anonymous functions to procedure or method variables if they either capture nothing or (in case of method variables) at most the Self variable --- compiler/defcmp.pas | 5 +- compiler/htypechk.pas | 1 + compiler/ncnv.pas | 224 +++++++++++++++++++++++++++++++++++++++++- compiler/nld.pas | 20 +++- compiler/pparautl.pas | 5 +- compiler/symdef.pas | 7 +- 6 files changed, 254 insertions(+), 8 deletions(-) diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas index 54ecf54498..2b9dcfc6e2 100644 --- a/compiler/defcmp.pas +++ b/compiler/defcmp.pas @@ -1766,7 +1766,8 @@ implementation begin { proc -> procvar } if (m_tp_procvar in current_settings.modeswitches) or - (m_mac_procvar in current_settings.modeswitches) then + (m_mac_procvar in current_settings.modeswitches) or + (po_anonymous in tprocdef(def_from).procoptions) then begin subeq:=proc_to_procvar_equal(tprocdef(def_from),tprocvardef(def_to),cdo_warn_incompatible_univ in cdoptions); if subeq>te_incompatible then @@ -2536,6 +2537,8 @@ implementation pa_comp:=[cpo_ignoreframepointer]; if is_block(def2) then include(pa_comp,cpo_ignorehidden); + if po_anonymous in def1.procoptions then + include(pa_comp,cpo_ignoreself); if checkincompatibleuniv then include(pa_comp,cpo_warn_incompatible_univ); { check return value and options, methodpointer is already checked } diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 665852a7a7..df2beb39c8 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -1195,6 +1195,7 @@ implementation begin if not(m_nested_procvars in current_settings.modeswitches) and (from_def.parast.symtablelevel>normal_function_level) and + not (po_anonymous in from_def.procoptions) and (to_def.typ=procvardef) then CGMessage(type_e_cannot_local_proc_to_procvar); end; diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas index 1814873d7f..509ee29745 100644 --- a/compiler/ncnv.pas +++ b/compiler/ncnv.pas @@ -323,8 +323,9 @@ implementation cutils,verbose,globals,widestr,ppu, symconst,symdef,symsym,symcpu,symtable, ncon,ncal,nset,nadd,nmem,nmat,nbas,nutils,ninl,nflw, + psub, cgbase,procinfo, - htypechk,blockutl,pass_1,cpuinfo; + htypechk,blockutl,pparautl,pass_1,cpuinfo; {***************************************************************************** @@ -2361,11 +2362,58 @@ implementation end; + type + tsym_mapping = record + oldsym:tsym; + newsym:tsym; + end; + psym_mapping = ^tsym_mapping; + + + function replace_self_sym(var n:tnode;arg:pointer):foreachnoderesult; + var + mapping : psym_mapping absolute arg; + ld : tloadnode; + begin + if n.nodetype=loadn then + begin + ld:=tloadnode(n); + if ld.symtableentry=mapping^.oldsym then + begin + ld.symtableentry:=mapping^.newsym; + { make sure that the node is processed again } + ld.resultdef:=nil; + if assigned(ld.left) then + begin + { no longer loaded through the frame pointer } + ld.left.free; + ld.left:=nil; + end; + typecheckpass(n); + end; + end; + result:=fen_true; + end; + + function ttypeconvnode.typecheck_proc_to_procvar : tnode; + + function is_self_sym(sym:tsym):boolean; + begin + result:=(sym.typ in [localvarsym,paravarsym]) and + (vo_is_self in tabstractvarsym(sym).varoptions); + end; + var pd : tabstractprocdef; copytype : tproccopytyp; source: pnode; + fpsym, + selfsym, + sym : tsym; + mapping : tsym_mapping; + pi : tprocinfo; + i : longint; begin result:=nil; pd:=tabstractprocdef(left.resultdef); @@ -2403,6 +2451,174 @@ implementation end else CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename); + end + else if (pd.typ=procdef) and + (po_anonymous in pd.procoptions) then + begin + if left.nodetype<>loadn then + internalerror(2021062402); + { get rid of any potential framepointer loading; if it's necessary + (for a nested procvar for example) it will be added again } + if assigned(tloadnode(left).left) and (tloadnode(left).left.nodetype=loadparentfpn) then + begin + tloadnode(left).left.free; + tloadnode(left).left:=nil; + tloadnode(left).resultdef:=nil; + end; + if tprocvardef(totypedef).is_methodpointer then + begin + if assigned(tprocdef(pd).capturedsyms) and + ( + (tprocdef(pd).capturedsyms.count>1) or + ( + (tprocdef(pd).capturedsyms.count=1) and + not is_self_sym(tsym(pcapturedsyminfo(tprocdef(pd).capturedsyms[0])^.sym)) + ) + ) then + internalerror(2021060801); + + selfsym:=nil; + fpsym:=nil; + { find the framepointer parameter and an eventual self } + for i:=0 to tprocdef(pd).parast.symlist.count-1 do + begin + sym:=tsym(tprocdef(pd).parast.symlist[i]); + if sym.typ<>paravarsym then + continue; + if vo_is_parentfp in tparavarsym(sym).varoptions then + fpsym:=sym; + if vo_is_self in tparavarsym(sym).varoptions then + selfsym:=sym; + if assigned(fpsym) and assigned(selfsym) then + break; + end; + + if assigned(fpsym) then + tprocdef(pd).parast.symlist.remove(fpsym); + + { if we don't have a self parameter already we need to + insert a suitable one } + + if not assigned(selfsym) then + begin + { replace the self symbol by the new parameter if it was + captured } + if assigned(tprocdef(pd).capturedsyms) and + (tprocdef(pd).capturedsyms.count>0) then + begin + if not assigned(tprocdef(pd).struct) then + { we can't use the captured symbol for the struct as that + might be the self of a type helper, thus we need to find + the parent procinfo that provides the Self } + tprocdef(pd).struct:=current_procinfo.get_normal_proc.procdef.struct; + if not assigned(tprocdef(pd).struct) then + internalerror(2021062204); + + insert_self_and_vmt_para(pd); + + mapping.oldsym:=tsym(pcapturedsyminfo(tprocdef(pd).capturedsyms[0])^.sym); + mapping.newsym:=nil; + + { find the new self parameter } + for i:=0 to tprocdef(pd).parast.symlist.count-1 do + begin + sym:=tsym(tprocdef(pd).parast.symlist[i]); + if (sym.typ=paravarsym) and (vo_is_self in tparavarsym(sym).varoptions) then + begin + mapping.newsym:=sym; + + break; + end; + end; + + if not assigned(mapping.newsym) then + internalerror(2021062202); + + { the anonymous function can only be a direct child of the + current_procinfo } + pi:=current_procinfo.get_first_nestedproc; + while assigned(pi) do + begin + if pi.procdef=pd then + break; + pi:=tprocinfo(pi.next); + end; + + if not assigned(pi) then + internalerror(2021062203); + + { replace all uses of the captured Self by the new Self + parameter } + foreachnodestatic(pm_preprocess,tcgprocinfo(pi).code,@replace_self_sym,@mapping); + + mapping.oldsym.free; + end + else + begin + { for a nested function of a method struct is already + set } + if not assigned(tprocdef(pd).struct) then + { simply add a TObject as Self parameter } + tprocdef(pd).struct:=class_tobject; + + insert_self_and_vmt_para(pd); + + { there is no self, so load a nil value } + tloadnode(left).set_mp(cnilnode.create); + end; + end; + + { the anonymous function no longer adheres to the nested + calling convention } + exclude(pd.procoptions,po_delphi_nested_cc); + + tprocdef(pd).calcparas; + + if not assigned(tloadnode(left).left) then + tloadnode(left).set_mp(load_self_node); + end + else if tprocvardef(totypedef).is_addressonly then + begin + if assigned(tprocdef(pd).capturedsyms) and (tprocdef(pd).capturedsyms.count>0) then + internalerror(2021060802); + + { remove framepointer and Self parameters } + for i:=tprocdef(pd).parast.symlist.count-1 downto 0 do + begin + sym:=tsym(tprocdef(pd).parast.symlist[i]); + if (sym.typ=paravarsym) and (tparavarsym(sym).varoptions*[vo_is_parentfp,vo_is_self]<>[]) then + tprocdef(pd).parast.symlist.delete(i); + end; + + { the anonymous function no longer adheres to the nested + calling convention } + exclude(pd.procoptions,po_delphi_nested_cc); + + { we don't need to look through the existing nodes, cause + the parameter was never used anyway } + tprocdef(pd).calcparas; + end + else + begin + { this is a nested function pointer, so ensure that the + anonymous function is handled as such } + if assigned(tprocdef(pd).capturedsyms) and + (tprocdef(pd).capturedsyms.count>0) and + (left.nodetype=loadn) then + begin + tloadnode(left).left:=cloadparentfpnode.create(tprocdef(tloadnode(left).symtable.defowner),lpf_forload); + + pi:=current_procinfo.get_first_nestedproc; + while assigned(pi) do + begin + if pi.procdef=pd then + break; + pi:=tprocinfo(pi.next); + end; + + pi.set_needs_parentfp(tprocdef(tloadnode(left).symtable.defowner).parast.symtablelevel); + end; + end; end; resultdef:=totypedef; end @@ -3804,7 +4020,11 @@ implementation { if we take the address of a nested function, the current function/ procedure needs a stack frame since it's required to construct the nested procvar } - if is_nested_pd(tprocvardef(resultdef)) then + if is_nested_pd(tprocvardef(resultdef)) and + ( + not (po_anonymous in tprocdef(left.resultdef).procoptions) or + (po_delphi_nested_cc in tprocvardef(resultdef).procoptions) + ) then include(current_procinfo.flags,pi_needs_stackframe); if tabstractprocdef(resultdef).is_addressonly then expectloc:=LOC_REGISTER diff --git a/compiler/nld.pas b/compiler/nld.pas index d11e74b620..6f819826eb 100644 --- a/compiler/nld.pas +++ b/compiler/nld.pas @@ -549,7 +549,11 @@ implementation resultdef:=p; { nested procedure? } if assigned(p) and - is_nested_pd(p) then + is_nested_pd(p) and + ( + not (po_anonymous in p.procoptions) or + (po_delphi_nested_cc in p.procoptions) + ) then begin if not(m_nested_procvars in current_settings.modeswitches) then CGMessage(type_e_cant_take_address_of_local_subroutine) @@ -560,10 +564,20 @@ implementation left:=cloadparentfpnode.create(tprocdef(p.owner.defowner),lpf_forpara); end; end - { we should never go from nested to non-nested } + { we should never go from nested to non-nested (except for an anonymous + function which might have been changed to a global function or a + method) } else if assigned(left) and (left.nodetype=loadparentfpn) then - internalerror(2010072201); + begin + if po_anonymous in p.procoptions then + begin + left.free; + left:=nil; + end + else + internalerror(2010072201); + end; end; {***************************************************************************** diff --git a/compiler/pparautl.pas b/compiler/pparautl.pas index 5e222c4747..4412c7cab1 100644 --- a/compiler/pparautl.pas +++ b/compiler/pparautl.pas @@ -241,7 +241,10 @@ implementation begin if (pd.typ=procdef) and assigned(tprocdef(pd).struct) and - (pd.parast.symtablelevel=normal_function_level) then + ( + (pd.parast.symtablelevel=normal_function_level) or + (po_anonymous in pd.procoptions) + ) then begin { static class methods have no hidden self/vmt pointer } if pd.no_self_node then diff --git a/compiler/symdef.pas b/compiler/symdef.pas index e898c7d887..644b51242f 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -6754,7 +6754,12 @@ implementation result:=assigned(owner) and not is_methodpointer and (not(m_nested_procvars in current_settings.modeswitches) or - not is_nested_pd(self)); + not is_nested_pd(self)) and + ( + not (po_anonymous in procoptions) or + not assigned(capturedsyms) or + (capturedsyms.count=0) + ); end;