diff --git a/compiler/hlcg2ll.pas b/compiler/hlcg2ll.pas index 22c07ec202..5bf670f586 100644 --- a/compiler/hlcg2ll.pas +++ b/compiler/hlcg2ll.pas @@ -149,11 +149,11 @@ unit hlcg2ll; } procedure a_loadaddr_ref_cgpara(list : TAsmList;fromsize : tdef;const r : treference;const cgpara : TCGPara);override; - function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;override; - procedure a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister);override; + function a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara; override; + function a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister; const paras: array of pcgpara): tcgpara;override; { same as a_call_name, might be overridden on certain architectures to emit static calls without usage of a got trampoline } - function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef): tcgpara;override; + function a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef): tcgpara; override; { move instructions } procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : tcgint;register : tregister);override; @@ -450,18 +450,19 @@ implementation cg.a_loadaddr_ref_cgpara(list,r,cgpara); end; - function thlcg2ll.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara; + function thlcg2ll.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara; begin cg.a_call_name(list,s,weak); result:=get_call_result_cgpara(pd,forceresdef); end; - procedure thlcg2ll.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister); + function thlcg2ll.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara; begin cg.a_call_reg(list,reg); + result:=get_call_result_cgpara(pd,nil); end; - function thlcg2ll.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef): tcgpara; + function thlcg2ll.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef): tcgpara; begin cg.a_call_name_static(list,s); result:=get_call_result_cgpara(pd,forceresdef); diff --git a/compiler/hlcgobj.pas b/compiler/hlcgobj.pas index 20df5336f8..daf7ab6fe5 100644 --- a/compiler/hlcgobj.pas +++ b/compiler/hlcgobj.pas @@ -193,14 +193,14 @@ unit hlcgobj; Returns the function result location. This routine must be overridden for each new target cpu. } - function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;virtual;abstract; - procedure a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister);virtual;abstract; + function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;virtual;abstract; + function a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister; const paras: array of pcgpara): tcgpara;virtual;abstract; { same as a_call_name, might be overridden on certain architectures to emit static calls without usage of a got trampoline } - function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef): tcgpara;virtual; + function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef): tcgpara;virtual; { same as a_call_name, might be overridden on certain architectures to emit special static calls for inherited methods } - procedure a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : TSymStr);virtual; + function a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara): tcgpara;virtual; { move instructions } procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : tcgint;register : tregister);virtual;abstract; @@ -258,8 +258,8 @@ unit hlcgobj; procedure a_bit_set_reg_loc(list: TAsmList; doset: boolean; regsize, tosize: tdef; bitnumber: tregister; const loc: tlocation);virtual; procedure a_bit_set_const_loc(list: TAsmList; doset: boolean; tosize: tdef; bitnumber: tcgint; const loc: tlocation);virtual; + function get_call_result_cgpara(pd: tabstractprocdef; forceresdef: tdef): tcgpara; virtual; protected - function get_call_result_cgpara(pd: tprocdef; forceresdef: tdef): tcgpara; procedure get_subsetref_load_info(const sref: tsubsetreference; out loadsize: torddef; out extra_load: boolean); procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); virtual; procedure a_load_subsetref_regs_index(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg: tregister); virtual; @@ -536,10 +536,10 @@ unit hlcgobj; procedure record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList); virtual; { generate a call to a routine in the system unit } - function g_call_system_proc(list: TAsmList; const procname: string; forceresdef: tdef): tcgpara; - function g_call_system_proc(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara; + function g_call_system_proc(list: TAsmList; const procname: string; const paras: array of pcgpara; forceresdef: tdef): tcgpara; + function g_call_system_proc(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara; protected - function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara; virtual; + function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara; virtual; public @@ -986,15 +986,15 @@ implementation end; end; - function thlcgobj.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef): tcgpara; + function thlcgobj.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef): tcgpara; begin - result:=a_call_name(list,pd,s,forceresdef,false); + result:=a_call_name(list,pd,s,paras,forceresdef,false); end; - procedure thlcgobj.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr); - begin - a_call_name(list,pd,s,nil,false); - end; + function thlcgobj.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara): tcgpara; + begin + result:=a_call_name(list,pd,s,paras,nil,false); + end; procedure thlcgobj.a_load_const_ref(list: TAsmList; tosize: tdef; a: tcgint; const ref: treference); var @@ -1670,7 +1670,7 @@ implementation end; - function thlcgobj.get_call_result_cgpara(pd: tprocdef; forceresdef: tdef): tcgpara; + function thlcgobj.get_call_result_cgpara(pd: tabstractprocdef; forceresdef: tdef): tcgpara; begin if not assigned(forceresdef) then begin @@ -2936,7 +2936,7 @@ implementation paramanager.getintparaloc(pd,1,cgpara1); a_load_const_cgpara(list,s32inttype,aint(210),cgpara1); paramanager.freecgpara(list,cgpara1); - g_call_system_proc(list,pd,nil); + g_call_system_proc(list,pd,[@cgpara1],nil); cgpara1.done; a_label(list,oklabel); end; @@ -2984,7 +2984,7 @@ implementation paramanager.freecgpara(list,cgpara3); paramanager.freecgpara(list,cgpara2); paramanager.freecgpara(list,cgpara1); - g_call_system_proc(list,pd,nil); + g_call_system_proc(list,pd,[@cgpara1,@cgpara2,@cgpara3],nil); cgpara3.done; cgpara2.done; cgpara1.done; @@ -3012,7 +3012,7 @@ implementation end; paramanager.freecgpara(list,cgpara2); paramanager.freecgpara(list,cgpara1); - g_call_system_proc(list,pd,nil); + g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil); cgpara2.done; cgpara1.done; end; @@ -3051,7 +3051,7 @@ implementation { these functions get the pointer by value } a_load_ref_cgpara(list,t,ref,cgpara1); paramanager.freecgpara(list,cgpara1); - g_call_system_proc(list,pd,nil); + g_call_system_proc(list,pd,[@cgpara1],nil); end else begin @@ -3073,7 +3073,7 @@ implementation end; paramanager.freecgpara(list,cgpara1); paramanager.freecgpara(list,cgpara2); - g_call_system_proc(list,pd,nil); + g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil); end; cgpara2.done; cgpara1.done; @@ -3099,7 +3099,7 @@ implementation paramanager.getintparaloc(pd,1,cgpara1); a_loadaddr_ref_cgpara(list,t,ref,cgpara1); paramanager.freecgpara(list,cgpara1); - g_call_system_proc(list,pd,nil); + g_call_system_proc(list,pd,[@cgpara1],nil); end else begin @@ -3121,7 +3121,7 @@ implementation end; paramanager.freecgpara(list,cgpara1); paramanager.freecgpara(list,cgpara2); - g_call_system_proc(list,pd,nil); + g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil); end; cgpara1.done; cgpara2.done; @@ -3171,7 +3171,7 @@ implementation end; paramanager.freecgpara(list,cgpara1); paramanager.freecgpara(list,cgpara2); - g_call_system_proc(list,pd,nil); + g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil); cgpara1.done; cgpara2.done; exit; @@ -3181,7 +3181,7 @@ implementation paramanager.getintparaloc(pd,1,cgpara1); a_loadaddr_ref_cgpara(list,t,ref,cgpara1); paramanager.freecgpara(list,cgpara1); - g_call_system_proc(list,pd,nil); + g_call_system_proc(list,pd,[@cgpara1],nil); cgpara1.done; end; @@ -3235,7 +3235,7 @@ implementation paramanager.freecgpara(list,cgpara1); paramanager.freecgpara(list,cgpara2); paramanager.freecgpara(list,cgpara3); - g_call_system_proc(list,pd,nil); + g_call_system_proc(list,pd,[@cgpara1,@cgpara2,@cgpara3],nil); cgpara3.done; cgpara2.done; @@ -3406,7 +3406,7 @@ implementation { if low(to) > maxlongint also range error } (lto > aintmax) then begin - g_call_system_proc(list,'fpc_rangeerror',nil); + g_call_system_proc(list,'fpc_rangeerror',[],nil); exit end; { from is signed and to is unsigned -> when looking at to } @@ -3421,7 +3421,7 @@ implementation if (lfrom > aintmax) or (hto < 0) then begin - g_call_system_proc(list,'fpc_rangeerror',nil); + g_call_system_proc(list,'fpc_rangeerror',[],nil); exit end; { from is unsigned and to is signed -> when looking at to } @@ -3444,7 +3444,7 @@ implementation a_cmp_const_reg_label(list,maxdef,OC_BE,aintmax,hreg,neglabel) else a_cmp_const_reg_label(list,maxdef,OC_BE,tcgint(int64(hto-lto)),hreg,neglabel); - g_call_system_proc(list,'fpc_rangeerror',nil); + g_call_system_proc(list,'fpc_rangeerror',[],nil); a_label(list,neglabel); end; @@ -3486,7 +3486,7 @@ implementation paramanager.getintparaloc(pd,1,cgpara1); a_load_reg_cgpara(list,sinttype,sizereg,cgpara1); paramanager.freecgpara(list,cgpara1); - getmemres:=g_call_system_proc(list,pd,ptrarrdef); + getmemres:=g_call_system_proc(list,pd,[@cgpara1],ptrarrdef); cgpara1.done; { return the new address } location_reset(destloc,LOC_REGISTER,OS_ADDR); @@ -3522,7 +3522,7 @@ implementation paramanager.freecgpara(list,cgpara3); paramanager.freecgpara(list,cgpara2); paramanager.freecgpara(list,cgpara1); - g_call_system_proc(list,pd,nil); + g_call_system_proc(list,pd,[@cgpara1,@cgpara2,@cgpara3],nil); cgpara3.done; cgpara2.done; cgpara1.done; @@ -3541,7 +3541,7 @@ implementation { load source } a_load_loc_cgpara(list,getpointerdef(arrdef),l,cgpara1); paramanager.freecgpara(list,cgpara1); - g_call_system_proc(list,pd,nil); + g_call_system_proc(list,pd,[@cgpara1],nil); cgpara1.done; end; @@ -4062,9 +4062,9 @@ implementation begin { initialize units } if not(current_module.islibrary) then - g_call_system_proc(list,'fpc_initializeunits',nil) + g_call_system_proc(list,'fpc_initializeunits',[],nil) else - g_call_system_proc(list,'fpc_libinitializeunits',nil); + g_call_system_proc(list,'fpc_libinitializeunits',[],nil); end; list.concat(Tai_force_line.Create); @@ -4082,7 +4082,7 @@ implementation { call __EXIT for main program } if (not DLLsource) and (current_procinfo.procdef.proctypeoption=potype_proginit) then - g_call_system_proc(list,'fpc_do_exit',nil); + g_call_system_proc(list,'fpc_do_exit',[],nil); end; procedure thlcgobj.inittempvariables(list: TAsmList); @@ -4713,26 +4713,26 @@ implementation current_asmdata.asmlists[al_procedures].concatlist(data); end; - function thlcgobj.g_call_system_proc(list: TAsmList; const procname: string; forceresdef: tdef): tcgpara; + function thlcgobj.g_call_system_proc(list: TAsmList; const procname: string; const paras: array of pcgpara; forceresdef: tdef): tcgpara; var pd: tprocdef; begin pd:=search_system_proc(procname); - result:=g_call_system_proc_intern(list,pd,forceresdef); + result:=g_call_system_proc_intern(list,pd,paras,forceresdef); end; - function thlcgobj.g_call_system_proc(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara; + function thlcgobj.g_call_system_proc(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara; begin { separate non-virtual routine to make it clear that the routine to override, if any, is g_call_system_proc_intern (and that none of the g_call_system_proc variants should be made virtual) } - result:=g_call_system_proc_intern(list,pd,forceresdef); + result:=g_call_system_proc_intern(list,pd,paras,forceresdef); end; - function thlcgobj.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara; + function thlcgobj.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara; begin allocallcpuregisters(list); - result:=a_call_name(list,pd,pd.mangledname,forceresdef,false); + result:=a_call_name(list,pd,pd.mangledname,paras,forceresdef,false); deallocallcpuregisters(list); end; diff --git a/compiler/i8086/n8086cal.pas b/compiler/i8086/n8086cal.pas index 38079cbee7..8bb55ca1f0 100644 --- a/compiler/i8086/n8086cal.pas +++ b/compiler/i8086/n8086cal.pas @@ -28,6 +28,7 @@ interface { $define AnsiStrRef} uses + parabase, nx86cal,cgutils; type @@ -36,7 +37,7 @@ interface procedure pop_parasize(pop_size:longint);override; procedure extra_interrupt_code;override; procedure extra_call_ref_code(var ref: treference);override; - procedure do_call_ref(ref: treference);override; + function do_call_ref(ref: treference): tcgpara;override; end; @@ -49,6 +50,7 @@ implementation cpubase,paramgr, aasmtai,aasmdata,aasmcpu, ncal,nbas,nmem,nld,ncnv, + hlcgobj, cga,cgobj,cgx86,cpuinfo; @@ -113,11 +115,12 @@ implementation end; - procedure ti8086callnode.do_call_ref(ref: treference); + function ti8086callnode.do_call_ref(ref: treference): tcgpara; begin if current_settings.x86memorymodel in x86_far_code_models then ref.refaddr:=addr_far_ref; current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_CALL,S_NO,ref)); + result:=hlcg.get_call_result_cgpara(procdefinition,typedef) end; diff --git a/compiler/i8086/n8086mem.pas b/compiler/i8086/n8086mem.pas index 70a6fe46fa..e292bda548 100644 --- a/compiler/i8086/n8086mem.pas +++ b/compiler/i8086/n8086mem.pas @@ -154,7 +154,7 @@ implementation paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1); paraloc1.done; hlcg.allocallcpuregisters(current_asmdata.CurrAsmList); - hlcg.a_call_name(current_asmdata.CurrAsmList,pd,'FPC_CHECKPOINTER',nil,false); + hlcg.a_call_name(current_asmdata.CurrAsmList,pd,'FPC_CHECKPOINTER',[],nil,false); hlcg.deallocallcpuregisters(current_asmdata.CurrAsmList); end; end diff --git a/compiler/jvm/hlcgcpu.pas b/compiler/jvm/hlcgcpu.pas index 0196e25ce4..a447923704 100644 --- a/compiler/jvm/hlcgcpu.pas +++ b/compiler/jvm/hlcgcpu.pas @@ -50,9 +50,9 @@ uses procedure a_load_const_cgpara(list : TAsmList;tosize : tdef;a : tcgint;const cgpara : TCGPara);override; - function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;override; - procedure a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : TSymStr);override; - procedure a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister); override; + function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;override; + function a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara): tcgpara;override; + function a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara; override; procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : tcgint;register : tregister);override; procedure a_load_const_ref(list : TAsmList;tosize : tdef;a : tcgint;const ref : treference);override; @@ -200,7 +200,7 @@ uses procedure inittempvariables(list:TAsmList);override; - function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara; override; + function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara; override; { in case of an array, the array base address and index have to be put on the evaluation stack before the stored value; similarly, for @@ -314,20 +314,21 @@ implementation inherited a_load_const_cgpara(list, tosize, a, cgpara); end; - function thlcgjvm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara; + function thlcgjvm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara; begin result:=a_call_name_intern(list,pd,s,forceresdef,false); end; - procedure thlcgjvm.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr); + function thlcgjvm.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara): tcgpara; begin - a_call_name_intern(list,pd,s,nil,true); + result:=a_call_name_intern(list,pd,s,nil,true); end; - procedure thlcgjvm.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister); + function thlcgjvm.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara; begin internalerror(2012042824); + result.init; end; @@ -705,30 +706,30 @@ implementation a_load_const_stack(list,s32inttype,initdim-1,R_INTREGISTER); case elemdef.typ of arraydef: - g_call_system_proc(list,'fpc_initialize_array_dynarr',nil); + g_call_system_proc(list,'fpc_initialize_array_dynarr',[],nil); recorddef,setdef,procvardef: begin tg.gethltemp(list,elemdef,elemdef.size,tt_persistent,recref); a_load_ref_stack(list,elemdef,recref,prepare_stack_for_ref(list,recref,false)); case elemdef.typ of recorddef: - g_call_system_proc(list,'fpc_initialize_array_record',nil); + g_call_system_proc(list,'fpc_initialize_array_record',[],nil); setdef: begin if tsetdef(elemdef).elementdef.typ=enumdef then - g_call_system_proc(list,'fpc_initialize_array_enumset',nil) + g_call_system_proc(list,'fpc_initialize_array_enumset',[],nil) else - g_call_system_proc(list,'fpc_initialize_array_bitset',nil) + g_call_system_proc(list,'fpc_initialize_array_bitset',[],nil) end; procvardef: - g_call_system_proc(list,'fpc_initialize_array_procvar',nil); + g_call_system_proc(list,'fpc_initialize_array_procvar',[],nil); end; tg.ungettemp(list,recref); end; enumdef: begin a_load_ref_stack(list,java_jlobject,enuminitref,prepare_stack_for_ref(list,enuminitref,false)); - g_call_system_proc(list,'fpc_initialize_array_object',nil); + g_call_system_proc(list,'fpc_initialize_array_object',[],nil); end; stringdef: begin @@ -736,13 +737,13 @@ implementation st_shortstring: begin a_load_const_stack_intern(list,u8inttype,tstringdef(elemdef).len,R_INTREGISTER,true); - g_call_system_proc(list,'fpc_initialize_array_shortstring',nil); + g_call_system_proc(list,'fpc_initialize_array_shortstring',[],nil); end; st_ansistring: - g_call_system_proc(list,'fpc_initialize_array_ansistring',nil); + g_call_system_proc(list,'fpc_initialize_array_ansistring',[],nil); st_unicodestring, st_widestring: - g_call_system_proc(list,'fpc_initialize_array_unicodestring',nil); + g_call_system_proc(list,'fpc_initialize_array_unicodestring',[],nil); else internalerror(2011081801); end; @@ -950,7 +951,7 @@ implementation end; - function thlcgjvm.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara; + function thlcgjvm.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara; begin result:=inherited; pd.init_paraloc_info(callerside); @@ -1413,7 +1414,7 @@ implementation a_load_const_stack(list,s32inttype,-1,R_INTREGISTER); a_load_const_stack(list,s32inttype,-1,R_INTREGISTER); end; - g_call_system_proc(list,procname,nil); + g_call_system_proc(list,procname,[],nil); if ndim<>1 then begin { pop return value, must be the same as dest } @@ -1437,7 +1438,7 @@ implementation (srsym.typ<>procsym) then Message1(cg_f_unknown_compilerproc,size.typename+'.fpcDeepCopy'); pd:=tprocdef(tprocsym(srsym).procdeflist[0]); - a_call_name(list,pd,pd.mangledname,nil,false); + a_call_name(list,pd,pd.mangledname,[],nil,false); { both parameters are removed, no function result } decstack(list,2); end; @@ -1449,9 +1450,9 @@ implementation a_load_ref_stack(list,size,dest,prepare_stack_for_ref(list,dest,false)); { call set copy helper } if tsetdef(size).elementdef.typ=enumdef then - g_call_system_proc(list,'fpc_enumset_copy',nil) + g_call_system_proc(list,'fpc_enumset_copy',[],nil) else - g_call_system_proc(list,'fpc_bitset_copy',nil); + g_call_system_proc(list,'fpc_bitset_copy',[],nil); end; @@ -1470,7 +1471,7 @@ implementation (srsym.typ<>procsym) then Message1(cg_f_unknown_compilerproc,'ShortstringClass.FpcDeepCopy'); pd:=tprocdef(tprocsym(srsym).procdeflist[0]); - a_call_name(list,pd,pd.mangledname,nil,false); + a_call_name(list,pd,pd.mangledname,[],nil,false); { both parameters are removed, no function result } decstack(list,2); end; @@ -1659,22 +1660,22 @@ implementation a_load_const_stack(list,s32inttype,normaldim,R_INTREGISTER); { highloc is invalid, the length is part of the array in Java } if is_wide_or_unicode_string(t) then - g_call_system_proc(list,'fpc_initialize_array_unicodestring',nil) + g_call_system_proc(list,'fpc_initialize_array_unicodestring',[],nil) else if is_ansistring(t) then - g_call_system_proc(list,'fpc_initialize_array_ansistring',nil) + g_call_system_proc(list,'fpc_initialize_array_ansistring',[],nil) else if is_dynamic_array(t) then - g_call_system_proc(list,'fpc_initialize_array_dynarr',nil) + g_call_system_proc(list,'fpc_initialize_array_dynarr',[],nil) else if is_record(t) or (t.typ=setdef) then begin tg.gethltemp(list,t,t.size,tt_persistent,eleref); a_load_ref_stack(list,t,eleref,prepare_stack_for_ref(list,eleref,false)); if is_record(t) then - g_call_system_proc(list,'fpc_initialize_array_record',nil) + g_call_system_proc(list,'fpc_initialize_array_record',[],nil) else if tsetdef(t).elementdef.typ=enumdef then - g_call_system_proc(list,'fpc_initialize_array_enumset',nil) + g_call_system_proc(list,'fpc_initialize_array_enumset',[],nil) else - g_call_system_proc(list,'fpc_initialize_array_bitset',nil); + g_call_system_proc(list,'fpc_initialize_array_bitset',[],nil); tg.ungettemp(list,eleref); end else if (t.typ=enumdef) then @@ -1682,7 +1683,7 @@ implementation if get_enum_init_val_ref(t,eleref) then begin a_load_ref_stack(list,java_jlobject,eleref,prepare_stack_for_ref(list,eleref,false)); - g_call_system_proc(list,'fpc_initialize_array_object',nil); + g_call_system_proc(list,'fpc_initialize_array_object',[],nil); end; end else @@ -1715,7 +1716,7 @@ implementation else internalerror(2013113008); a_load_ref_stack(list,java_jlobject,ref,prepare_stack_for_ref(list,ref,false)); - a_call_name(list,pd,pd.mangledname,nil,false); + a_call_name(list,pd,pd.mangledname,[],nil,false); { parameter removed, no result } decstack(list,1); end @@ -1742,7 +1743,7 @@ implementation exit; current_asmdata.getjumplabel(hl); a_cmp_const_loc_label(list,s32inttype,OC_EQ,0,ovloc,hl); - g_call_system_proc(list,'fpc_overflow',nil); + g_call_system_proc(list,'fpc_overflow',[],nil); a_label(list,hl); end; diff --git a/compiler/jvm/njvmmat.pas b/compiler/jvm/njvmmat.pas index faeb4c3b9f..3f5623eaf5 100644 --- a/compiler/jvm/njvmmat.pas +++ b/compiler/jvm/njvmmat.pas @@ -158,7 +158,7 @@ implementation hlcg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_AND,resultdef,left.location.register,tmpreg); current_asmdata.getjumplabel(lab); hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,resultdef,OC_NE,-1,tmpreg,lab); - hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_overflow',nil); + hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_overflow',[],nil); hlcg.a_label(current_asmdata.CurrAsmList,lab); end; end; diff --git a/compiler/jvm/njvmmem.pas b/compiler/jvm/njvmmem.pas index 6330fd8c5f..df77af9005 100644 --- a/compiler/jvm/njvmmem.pas +++ b/compiler/jvm/njvmmem.pas @@ -442,7 +442,7 @@ implementation (tprocsym(psym).ProcdefList.count<>1) then internalerror(2011062607); thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,right.resultdef,right.location); - hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(tprocsym(psym).procdeflist[0]),tprocdef(tprocsym(psym).procdeflist[0]).mangledname,nil,false); + hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(tprocsym(psym).procdeflist[0]),tprocdef(tprocsym(psym).procdeflist[0]).mangledname,[],nil,false); { call replaces self parameter with longint result -> no stack height change } location_reset(right.location,LOC_REGISTER,OS_S32); diff --git a/compiler/jvm/tgcpu.pas b/compiler/jvm/tgcpu.pas index fe7d8e8cfc..28f7b03518 100644 --- a/compiler/jvm/tgcpu.pas +++ b/compiler/jvm/tgcpu.pas @@ -85,7 +85,7 @@ unit tgcpu; end else internalerror(2011060301); - hlcg.a_call_name(list,pd,pd.mangledname,nil,false); + hlcg.a_call_name(list,pd,pd.mangledname,[],nil,false); thlcgjvm(hlcg).decstack(list,1); { store reference to instance } thlcgjvm(hlcg).a_load_stack_ref(list,java_jlobject,ref,0); @@ -146,7 +146,7 @@ unit tgcpu; internalerror(2011062801); pd:=tprocdef(tprocsym(sym).procdeflist[0]); end; - hlcg.a_call_name(list,pd,pd.mangledname,nil,false); + hlcg.a_call_name(list,pd,pd.mangledname,[],nil,false); { static calls method replaces parameter with set instance -> no change in stack height } end @@ -169,7 +169,7 @@ unit tgcpu; end else internalerror(2011062803); - hlcg.a_call_name(list,pd,pd.mangledname,nil,false); + hlcg.a_call_name(list,pd,pd.mangledname,[],nil,false); { duplicate self pointer is removed } thlcgjvm(hlcg).decstack(list,1); end; @@ -203,7 +203,7 @@ unit tgcpu; internalerror(2011052404); pd:=tprocdef(tprocsym(sym).procdeflist[0]); end; - hlcg.a_call_name(list,pd,pd.mangledname,nil,false); + hlcg.a_call_name(list,pd,pd.mangledname,[],nil,false); { static calls method replaces parameter with string instance -> no change in stack height } { store reference to instance } diff --git a/compiler/mips/hlcgcpu.pas b/compiler/mips/hlcgcpu.pas index 7d494d9428..93edbf4cac 100644 --- a/compiler/mips/hlcgcpu.pas +++ b/compiler/mips/hlcgcpu.pas @@ -37,7 +37,7 @@ uses type thlcgmips = class(thlcg2ll) - function a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara; override; + function a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara; override; procedure a_load_subsetreg_reg(list: TAsmList; subsetsize, tosize: tdef; const sreg: tsubsetregister; destreg: tregister);override; protected procedure a_load_regconst_subsetreg_intern(list: TAsmList; fromsize, subsetsize: tdef; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt); override; @@ -59,7 +59,7 @@ implementation cpuinfo, cgcpu; - function thlcgmips.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara; + function thlcgmips.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara; var ref: treference; sym: tasmsymbol; diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas index 7700d87db3..d81e764269 100644 --- a/compiler/ncgcal.pas +++ b/compiler/ncgcal.pas @@ -34,12 +34,13 @@ interface type tcgcallparanode = class(tcallparanode) protected - tempcgpara : tcgpara; procedure push_addr_para; procedure push_value_para;virtual; procedure push_formal_para;virtual; procedure push_copyout_para;virtual;abstract; public + tempcgpara : tcgpara; + constructor create(expr,next : tnode);override; destructor destroy;override; procedure secondcallparan;override; @@ -55,10 +56,10 @@ interface procedure copy_back_paras; procedure release_para_temps; procedure reorder_parameters; - procedure pushparas; procedure freeparas; protected retloc: tcgpara; + paralocs: array of pcgpara; framepointer_paraloc : tcgpara; {# This routine is used to push the current frame pointer @@ -94,7 +95,12 @@ interface on ref. } function can_call_ref(var ref: treference):boolean;virtual; procedure extra_call_ref_code(var ref: treference);virtual; - procedure do_call_ref(ref: treference);virtual; + function do_call_ref(ref: treference): tcgpara;virtual; + + { store all the parameters in the temporary paralocs in their final + location, and create the paralocs array that will be passed to + hlcg.a_call_* } + procedure pushparas;virtual; public procedure pass_generate_code;override; destructor destroy;override; @@ -107,7 +113,7 @@ implementation systems, cutils,verbose,globals, cpuinfo, - symconst,symtable,symtype,defutil,paramgr, + symconst,symtable,symtype,symsym,defutil,paramgr, cgbase,pass_2, aasmbase,aasmtai,aasmdata, nbas,nmem,nld,ncnv,nutils, @@ -434,9 +440,11 @@ implementation end; - procedure tcgcallnode.do_call_ref(ref: treference); + function tcgcallnode.do_call_ref(ref: treference): tcgpara; begin InternalError(2014012901); + { silence warning } + result.init; end; @@ -629,6 +637,7 @@ implementation end; ppn:=tcallparanode(ppn.right); end; + setlength(paralocs,0); end; @@ -641,7 +650,7 @@ implementation htempref, href : treference; calleralignment, - tmpalignment: longint; + tmpalignment, i: longint; skipiffinalloc: boolean; begin { copy all resources to the allocated registers } @@ -743,6 +752,9 @@ implementation end; ppn:=tcgcallparanode(ppn.right); end; + setlength(paralocs,procdefinition.paras.count); + for i:=0 to procdefinition.paras.count-1 do + paralocs[i]:=@tparavarsym(procdefinition.paras[i]).paraloc[callerside]; end; @@ -812,16 +824,12 @@ implementation begin { The forced returntype may have a different size than the one declared for the procdef } - if not assigned(typedef) then - retloc:=procdefinition.funcretloc[callerside] - else - retloc:=paramanager.get_funcretloc(procdefinition,callerside,typedef); + retloc:=hlcg.get_call_result_cgpara(procdefinition,typedef); retlocitem:=retloc.location; while assigned(retlocitem) do begin case retlocitem^.loc of LOC_REGISTER: - include(regs_to_save_int,getsupreg(retlocitem^.register)); LOC_FPUREGISTER: include(regs_to_save_fpu,getsupreg(retlocitem^.register)); @@ -942,11 +950,11 @@ implementation { call method } extra_call_code; + retloc.resetiftemp; if callref then - do_call_ref(href) + retloc:=do_call_ref(href) else - hlcg.a_call_reg(current_asmdata.CurrAsmList,tabstractprocdef(procdefinition),pvreg); - + retloc:=hlcg.a_call_reg(current_asmdata.CurrAsmList,tabstractprocdef(procdefinition),pvreg,paralocs); extra_post_call_code; end else @@ -979,13 +987,14 @@ implementation if (po_interrupt in procdefinition.procoptions) then extra_interrupt_code; extra_call_code; + retloc.resetiftemp; if (name_to_call='') then if cnf_inherited in callnodeflags then - hlcg.a_call_name_inherited(current_asmdata.CurrAsmList,tprocdef(procdefinition),tprocdef(procdefinition).mangledname) + retloc:=hlcg.a_call_name_inherited(current_asmdata.CurrAsmList,tprocdef(procdefinition),tprocdef(procdefinition).mangledname,paralocs) else - hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),tprocdef(procdefinition).mangledname,typedef,po_weakexternal in procdefinition.procoptions).resetiftemp + retloc:=hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),tprocdef(procdefinition).mangledname,paralocs,typedef,po_weakexternal in procdefinition.procoptions) else - hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call,typedef,po_weakexternal in procdefinition.procoptions).resetiftemp; + retloc:=hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call,paralocs,typedef,po_weakexternal in procdefinition.procoptions); extra_post_call_code; end; end; @@ -1045,10 +1054,11 @@ implementation extra_interrupt_code; extra_call_code; + retloc.resetiftemp; if callref then - do_call_ref(href) + retloc:=do_call_ref(href) else - hlcg.a_call_reg(current_asmdata.CurrAsmList,procdefinition,pvreg); + retloc:=hlcg.a_call_reg(current_asmdata.CurrAsmList,tabstractprocdef(procdefinition),pvreg,paralocs); extra_post_call_code; end; diff --git a/compiler/ncgmat.pas b/compiler/ncgmat.pas index e78faed50d..d87c5722c6 100644 --- a/compiler/ncgmat.pas +++ b/compiler/ncgmat.pas @@ -257,7 +257,7 @@ implementation begin current_asmdata.getjumplabel(hl); hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,OC_NE,torddef(opsize).low.svalue,location.register,hl); - hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_overflow',nil); + hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_overflow',[],nil); hlcg.a_label(current_asmdata.CurrAsmList,hl); end; end; diff --git a/compiler/ncgmem.pas b/compiler/ncgmem.pas index f0245e1800..1fdbd529b5 100644 --- a/compiler/ncgmem.pas +++ b/compiler/ncgmem.pas @@ -309,7 +309,7 @@ implementation paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1); paraloc1.done; hlcg.allocallcpuregisters(current_asmdata.CurrAsmList); - hlcg.a_call_name(current_asmdata.CurrAsmList,pd,'FPC_CHECKPOINTER',nil,false); + hlcg.a_call_name(current_asmdata.CurrAsmList,pd,'FPC_CHECKPOINTER',[@paraloc1],nil,false); hlcg.deallocallcpuregisters(current_asmdata.CurrAsmList); end; end; @@ -395,7 +395,7 @@ implementation hlcg.a_load_reg_cgpara(current_asmdata.CurrAsmList,resultdef,location.reference.base,paraloc1); paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1); hlcg.allocallcpuregisters(current_asmdata.CurrAsmList); - hlcg.a_call_name(current_asmdata.CurrAsmList,pd,'FPC_CHECKPOINTER',nil,false); + hlcg.a_call_name(current_asmdata.CurrAsmList,pd,'FPC_CHECKPOINTER',[@paraloc1],nil,false); hlcg.deallocallcpuregisters(current_asmdata.CurrAsmList); end; end diff --git a/compiler/parabase.pas b/compiler/parabase.pas index aef8453d1d..d4728abd59 100644 --- a/compiler/parabase.pas +++ b/compiler/parabase.pas @@ -110,6 +110,7 @@ unit parabase; procedure ppuwrite(ppufile:tcompilerppufile); procedure ppuload(ppufile:tcompilerppufile); end; + PCGPara = ^TCGPara; tvarargsinfo = ( va_uses_float_reg @@ -195,6 +196,7 @@ implementation result.alignment:=alignment; result.size:=size; result.intsize:=intsize; + result.def:=def; end; diff --git a/compiler/x86/nx86cal.pas b/compiler/x86/nx86cal.pas index 3fd6350ec1..ed2a324b43 100644 --- a/compiler/x86/nx86cal.pas +++ b/compiler/x86/nx86cal.pas @@ -30,7 +30,7 @@ interface uses symdef, cgutils, - ncgcal; + ncgcal,parabase; type @@ -41,7 +41,7 @@ interface procedure do_release_unused_return_value;override; procedure set_result_location(realresdef: tstoreddef);override; function can_call_ref(var ref: treference):boolean;override; - procedure do_call_ref(ref: treference);override; + function do_call_ref(ref: treference): tcgpara;override; end; @@ -49,7 +49,8 @@ implementation uses cgobj, - cgbase,cpubase,cgx86,cga,aasmdata,aasmcpu; + cgbase,cpubase,cgx86,cga,aasmdata,aasmcpu, + hlcgobj; {***************************************************************************** @@ -91,9 +92,10 @@ implementation end; - procedure tx86callnode.do_call_ref(ref: treference); + function tx86callnode.do_call_ref(ref: treference): tcgpara; begin current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_CALL,S_NO,ref)); + result:=hlcg.get_call_result_cgpara(procdefinition,typedef) end; end.