diff --git a/compiler/hlcgobj.pas b/compiler/hlcgobj.pas index f3d834cc2f..7149039903 100644 --- a/compiler/hlcgobj.pas +++ b/compiler/hlcgobj.pas @@ -1936,7 +1936,13 @@ implementation function thlcgobj.get_call_result_cgpara(pd: tabstractprocdef; forceresdef: tdef): tcgpara; begin - if not assigned(forceresdef) then + if pd.generate_safecall_wrapper then + begin + if assigned(forceresdef) then + internalerror(2019112401); + result:=paramanager.get_safecallresult_funcretloc(pd,callerside) + end + else if not assigned(forceresdef) then begin pd.init_paraloc_info(callerside); result:=pd.funcretloc[callerside]; @@ -5307,27 +5313,39 @@ implementation retdef : tdef; begin { Is the loading needed? } - if is_void(current_procinfo.procdef.returndef) or + if (is_void(current_procinfo.procdef.returndef) and + not current_procinfo.procdef.generate_safecall_wrapper) or ( (po_assembler in current_procinfo.procdef.procoptions) and - (not(assigned(current_procinfo.procdef.funcretsym)) or + (current_procinfo.procdef.generate_safecall_wrapper or + not assigned(current_procinfo.procdef.funcretsym) or (tabstractvarsym(current_procinfo.procdef.funcretsym).refs=0) or - (po_nostackframe in current_procinfo.procdef.procoptions)) + (po_nostackframe in current_procinfo.procdef.procoptions) + ) ) then exit; { constructors return self } - if not current_procinfo.procdef.getfuncretsyminfo(ressym,retdef) then - internalerror(2018122501); - if (ressym.refs>0) or - is_managed_type(retdef) then + if current_procinfo.procdef.generate_safecall_wrapper then begin - { was: don't do anything if funcretloc.loc in [LOC_INVALID,LOC_REFERENCE] } - if not paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then - gen_load_loc_function_result(list,retdef,tabstractnormalvarsym(ressym).localloc); + if not current_procinfo.procdef.get_safecall_funcretsym_info(ressym,retdef) then + internalerror(2019112402); + gen_load_loc_function_result(list,retdef,tabstractnormalvarsym(ressym).localloc); end else - gen_load_uninitialized_function_result(list,current_procinfo.procdef,retdef,current_procinfo.procdef.funcretloc[calleeside]); + begin + if not current_procinfo.procdef.get_funcretsym_info(ressym,retdef) then + internalerror(2018122501); + if (ressym.refs>0) or + is_managed_type(retdef) then + begin + { was: don't do anything if funcretloc.loc in [LOC_INVALID,LOC_REFERENCE] } + if not paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then + gen_load_loc_function_result(list,retdef,tabstractnormalvarsym(ressym).localloc); + end + else + gen_load_uninitialized_function_result(list,current_procinfo.procdef,retdef,current_procinfo.procdef.funcretloc[calleeside]); + end; if tabstractnormalvarsym(ressym).localloc.loc=LOC_REFERENCE then tg.UnGetLocal(list,tabstractnormalvarsym(ressym).localloc.reference); end; diff --git a/compiler/i386/n386flw.pas b/compiler/i386/n386flw.pas index e67c84a1a7..c7cac7a84f 100644 --- a/compiler/i386/n386flw.pas +++ b/compiler/i386/n386flw.pas @@ -375,14 +375,10 @@ procedure ti386tryfinallynode.pass_generate_code; emit_scope_end; if is_safecall then begin - current_asmdata.getjumplabel(safecalllabel); - hreg:=cg.GetIntRegister(current_asmdata.CurrAsmList,OS_INT); - cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hreg); cg.a_jmp_always(current_asmdata.CurrAsmList,safecalllabel); { RTL handler will jump here on exception } cg.a_label(current_asmdata.CurrAsmList,exceptlabel); handle_safecall_exception; - cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_FUNCTION_RESULT_REG,hreg); cg.a_label(current_asmdata.CurrAsmList,safecalllabel); end; @@ -432,8 +428,6 @@ procedure ti386tryfinallynode.pass_generate_code; cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel); end; end; - if is_safecall then - cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,hreg,NR_FUNCTION_RETURN_REG); cg.a_label(current_asmdata.CurrAsmList,endfinallylabel); { end cleanup } diff --git a/compiler/jvm/symcpu.pas b/compiler/jvm/symcpu.pas index cbe06c8ae2..6e6ce3296c 100644 --- a/compiler/jvm/symcpu.pas +++ b/compiler/jvm/symcpu.pas @@ -100,6 +100,7 @@ type procedure buildderef;override; procedure deref;override; function getcopy: tstoreddef; override; + function generate_safecall_wrapper: boolean; override; end; tcpuprocvardefclass = class of tcpuprocvardef; @@ -109,7 +110,8 @@ type exprasmlist : TAsmList; function jvmmangledbasename(signature: boolean): TSymStr; function mangledname: TSymStr; override; - function getfuncretsyminfo(out ressym: tsym; out resdef: tdef): boolean; override; + function get_funcretsym_info(out ressym: tsym; out resdef: tdef): boolean; override; + function generate_safecall_wrapper: boolean; override; destructor destroy; override; end; tcpuprocdefclass = class of tcpuprocdef; @@ -748,7 +750,8 @@ implementation result:=_mangledname; end; - function tcpuprocdef.getfuncretsyminfo(out ressym: tsym; out resdef: tdef): boolean; + + function tcpuprocdef.get_funcretsym_info(out ressym: tsym; out resdef: tdef): boolean; begin { constructors don't have a result on the JVM platform } if proctypeoption<>potype_constructor then @@ -758,6 +761,12 @@ implementation end; + function tcpuprocdef.generate_safecall_wrapper: boolean; + begin + result:=false; + end; + + destructor tcpuprocdef.destroy; begin exprasmlist.free; @@ -802,6 +811,12 @@ implementation end; + function tcpuprocvardef.generate_safecall_wrapper: boolean; + begin + result:=false; + end; + + {**************************************************************************** tcpuprocsym ****************************************************************************} diff --git a/compiler/llvm/hlcgllvm.pas b/compiler/llvm/hlcgllvm.pas index 810ea237e9..46a51156dd 100644 --- a/compiler/llvm/hlcgllvm.pas +++ b/compiler/llvm/hlcgllvm.pas @@ -526,15 +526,24 @@ implementation end; { the Pascal level may expect a different returndef compared to the declared one } - if not assigned(forceresdef) then - hlretdef:=pd.returndef + if pd.generate_safecall_wrapper then + begin + hlretdef:=ossinttype; + llvmretdef:=ossinttype; + end else - hlretdef:=forceresdef; - { llvm will always expect the original return def } - if not paramanager.ret_in_param(hlretdef, pd) then - llvmretdef:=llvmgetcgparadef(pd.funcretloc[callerside], true, callerside) - else - llvmretdef:=voidtype; + begin + if not assigned(forceresdef) then + hlretdef:=pd.returndef + else + hlretdef:=forceresdef; + { llvm will always expect the original return def } + if not paramanager.ret_in_param(hlretdef, pd) or + pd.generate_safecall_wrapper then + llvmretdef:=llvmgetcgparadef(pd.funcretloc[callerside], true, callerside) + else + llvmretdef:=voidtype; + end; if not is_void(llvmretdef) then res:=getregisterfordef(list, llvmretdef) else @@ -1354,10 +1363,11 @@ implementation retpara:=get_call_result_cgpara(current_procinfo.procdef,nil); retpara.check_simple_location; retdef:=retpara.location^.def; - if is_void(retdef) or - { don't check retdef here, it is e.g. a pshortstring in case it's - shortstring that's returned in a parameter } - paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then + if (is_void(retdef) or + { don't check retdef here, it is e.g. a pshortstring in case it's + shortstring that's returned in a parameter } + paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef)) and + not current_procinfo.procdef.generate_safecall_wrapper then list.concat(taillvm.op_size(la_ret,voidtype)) else begin @@ -1371,7 +1381,8 @@ implementation in the code generator -> remove any explicit extensions here } retreg:=retpara.location^.register; if (current_procinfo.procdef.returndef.typ in [orddef,enumdef]) and - (retdef.typ in [orddef,enumdef]) then + (retdef.typ in [orddef,enumdef]) and + not current_procinfo.procdef.generate_safecall_wrapper then begin if (current_procinfo.procdef.returndef.sizeparavarsym) then InternalError(2011123101); - cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,selfsym.localloc,cgpara); + hlcg.a_load_loc_cgpara(current_asmdata.CurrAsmList,selfsym.vardef,selfsym.localloc,cgpara); end else - cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_ADDR,0,cgpara); + hlcg.a_load_const_cgpara(current_asmdata.CurrAsmList,voidpointertype,0,cgpara); paramanager.freecgpara(current_asmdata.CurrAsmList,cgpara); + resultpara:=hlcg.g_call_system_proc(current_asmdata.CurrAsmList,pd,[@cgpara],nil); cgpara.done; - cg.g_call(current_asmdata.CurrAsmList,'FPC_SAFECALLHANDLER'); - cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_FUNCTION_RESULT_REG, NR_FUNCTION_RETURN_REG); + safecallresult:=tlocalvarsym(current_procinfo.procdef.localst.Find('safecallresult')); + hlcg.gen_load_cgpara_loc(current_asmdata.CurrAsmList,resultpara.def,resultpara,safecallresult.localloc,false); + resultpara.resetiftemp; end; @@ -1052,8 +1055,7 @@ implementation hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,0,reasonreg,endfinallylabel); { finally code only needed to be executed on exception (-> in if-branch -> fc_inflowcontrol) } - if (tf_safecall_exceptions in target_info.flags) and - (current_procinfo.procdef.proccalloption=pocall_safecall) then + if current_procinfo.procdef.generate_safecall_wrapper then begin handle_safecall_exception; { we have to jump immediatly as we have to return the value of FPC_SAFECALL } @@ -1073,8 +1075,7 @@ implementation begin if implicitframe then begin - if (tf_safecall_exceptions in target_info.flags) and - (current_procinfo.procdef.proccalloption=pocall_safecall) then + if current_procinfo.procdef.generate_safecall_wrapper then handle_safecall_exception else cexceptionstatehandler.handle_reraise(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate,exceptframekind); diff --git a/compiler/ncgutil.pas b/compiler/ncgutil.pas index c44d90e77e..0de268b2fd 100644 --- a/compiler/ncgutil.pas +++ b/compiler/ncgutil.pas @@ -767,9 +767,7 @@ implementation parasize:=0; { For safecall functions with safecall-exceptions enabled the funcret is always returned as a para which is considered a normal para on the c-side, so the funcret has to be pop'ed normally. } - if not ( (current_procinfo.procdef.proccalloption=pocall_safecall) and - (tf_safecall_exceptions in target_info.flags) ) and - paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then + if not current_procinfo.procdef.generate_safecall_wrapper then inc(parasize,sizeof(pint)); end else diff --git a/compiler/nflw.pas b/compiler/nflw.pas index 8a5a3c0081..94f46d331b 100644 --- a/compiler/nflw.pas +++ b/compiler/nflw.pas @@ -1946,7 +1946,7 @@ implementation gets inserted before the exit label to which this node will jump } if (target_info.system in systems_fpnestedstruct) and not(nf_internal in flags) and - current_procinfo.procdef.getfuncretsyminfo(ressym,resdef) and + current_procinfo.procdef.get_funcretsym_info(ressym,resdef) and (tabstractnormalvarsym(ressym).inparentfpstruct) then begin if not assigned(result) then diff --git a/compiler/ngenutil.pas b/compiler/ngenutil.pas index 69650011c1..d220f1a051 100644 --- a/compiler/ngenutil.pas +++ b/compiler/ngenutil.pas @@ -618,6 +618,21 @@ implementation begin result:=maybe_insert_trashing(pd,n); + { initialise safecall result variable } + if pd.generate_safecall_wrapper then + begin + ressym:=tsym(pd.localst.Find('safecallresult')); + block:=internalstatements(stat); + addstatement(stat, + cassignmentnode.create( + cloadnode.create(ressym,ressym.owner), + genintconstnode(0) + ) + ); + addstatement(stat,result); + result:=block; + end; + if (m_isolike_program_para in current_settings.modeswitches) and (pd.proctypeoption=potype_proginit) then begin @@ -687,7 +702,7 @@ implementation end; end; if (target_info.system in systems_fpnestedstruct) and - pd.getfuncretsyminfo(ressym,resdef) and + pd.get_funcretsym_info(ressym,resdef) and (tabstractnormalvarsym(ressym).inparentfpstruct) then begin block:=internalstatements(stat); diff --git a/compiler/paramgr.pas b/compiler/paramgr.pas index 9dafef31a2..7778ab9fdf 100644 --- a/compiler/paramgr.pas +++ b/compiler/paramgr.pas @@ -128,6 +128,7 @@ unit paramgr; forces the function result to something different than the real result. } function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;virtual;abstract; + function get_safecallresult_funcretloc(p : tabstractprocdef; side: tcallercallee): tcgpara; virtual; procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); { This is used to populate the location information on all parameters @@ -441,6 +442,27 @@ implementation end; + function tparamanager.get_safecallresult_funcretloc(p: tabstractprocdef; side: tcallercallee): tcgpara; + var + paraloc: pcgparalocation; + begin + result.init; + result.def:=ossinttype; + result.intsize:=result.def.size; + result.size:=def_cgsize(result.def); + result.alignment:=result.def.alignment; + paraloc:=result.add_location; + paraloc^.size:=result.size; + paraloc^.def:=result.def; + paraloc^.loc:=LOC_REGISTER; + if side=callerside then + paraloc^.register:=NR_FUNCTION_RESULT_REG + else + paraloc^.register:=NR_FUNCTION_RETURN_REG; + result.Temporary:=true;; + end; + + function tparamanager.is_stack_paraloc(paraloc: pcgparalocation): boolean; begin result:= diff --git a/compiler/pparautl.pas b/compiler/pparautl.pas index 723be9816b..48909fe81f 100644 --- a/compiler/pparautl.pas +++ b/compiler/pparautl.pas @@ -300,14 +300,14 @@ implementation sl : tpropaccesslist; hs : string; begin + storepos:=current_tokenpos; + current_tokenpos:=pd.fileinfo; + { The result from constructors and destructors can't be accessed directly } if not(pd.proctypeoption in [potype_constructor,potype_destructor]) and not is_void(pd.returndef) and (not(po_assembler in pd.procoptions) or paramanager.asm_result_var(pd.returndef,pd)) then begin - storepos:=current_tokenpos; - current_tokenpos:=pd.fileinfo; - { We need to insert a varsym for the result in the localst when it is returning in a register } { we also need to do this for a generic procdef as we didn't allow @@ -348,8 +348,17 @@ implementation tlocalsymtable(pd.localst).insert(aliasvs); end; - current_tokenpos:=storepos; end; + + if pd.generate_safecall_wrapper then + begin + { vo_is_funcret is necessary so the local only gets freed after we loaded its + value into the return register } + vs:=clocalvarsym.create('$safecallresult',vs_value,search_system_type('HRESULT').typedef,[vo_is_funcret]); + pd.localst.insert(vs); + end; + + current_tokenpos:=storepos; end; diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 773ff2ce9f..cb8cee3812 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -688,6 +688,7 @@ interface function ofs_address_type:tdef;virtual; procedure declared_far;virtual; procedure declared_near;virtual; + function generate_safecall_wrapper: boolean; virtual; private procedure count_para(p:TObject;arg:pointer); procedure insert_para(p:TObject;arg:pointer); @@ -878,7 +879,8 @@ interface procedure make_external; procedure init_genericdecl; - function getfuncretsyminfo(out ressym: tsym; out resdef: tdef): boolean; virtual; + function get_funcretsym_info(out ressym: tsym; out resdef: tdef): boolean; virtual; + function get_safecall_funcretsym_info(out ressym: tsym; out resdef: tdef): boolean; virtual; { returns whether the mangled name or any of its aliases is equal to s } @@ -5716,6 +5718,19 @@ implementation end; + function tabstractprocdef.generate_safecall_wrapper: boolean; + begin +{$ifdef SUPPORT_SAFECALL} + result:= + (proccalloption=pocall_safecall) and + not(po_assembler in procoptions) and + (tf_safecall_exceptions in target_info.flags); +{$else SUPPORT_SAFECALL} + result:=false; +{$endif} + end; + + {*************************************************************************** TPROCDEF ***************************************************************************} @@ -6382,7 +6397,7 @@ implementation end; - function tprocdef.getfuncretsyminfo(out ressym: tsym; out resdef: tdef): boolean; + function tprocdef.get_funcretsym_info(out ressym: tsym; out resdef: tdef): boolean; begin result:=false; if proctypeoption=potype_constructor then @@ -6394,6 +6409,13 @@ implementation if is_object(resdef) then resdef:=cpointerdef.getreusable(resdef); end + else if (proccalloption=pocall_safecall) and + (tf_safecall_exceptions in target_info.flags) then + begin + result:=true; + ressym:=tsym(localst.Find('safecallresult')); + resdef:=tabstractnormalvarsym(ressym).vardef; + end else if not is_void(returndef) then begin result:=true; @@ -6403,6 +6425,20 @@ implementation end; + function tprocdef.get_safecall_funcretsym_info(out ressym: tsym; out resdef: tdef): boolean; + begin + result:=false; + if (proctypeoption<>potype_constructor) and + (proccalloption=pocall_safecall) and + (tf_safecall_exceptions in target_info.flags) then + begin + result:=true; + ressym:=tsym(localst.Find('safecallresult')); + resdef:=tabstractnormalvarsym(ressym).vardef; + end + end; + + function tprocdef.has_alias_name(const s: TSymStr): boolean; var item : TCmdStrListItem;