diff --git a/compiler/hlcg2ll.pas b/compiler/hlcg2ll.pas index c28e6928ff..b127d7ff40 100644 --- a/compiler/hlcg2ll.pas +++ b/compiler/hlcg2ll.pas @@ -152,12 +152,12 @@ unit hlcg2ll; } procedure a_loadaddr_ref_cgpara(list : TAsmList;fromsize : tdef;const r : treference;const cgpara : TCGPara);override; - procedure a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; weak: boolean);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; procedure a_call_ref(list : TAsmList;pd : tabstractprocdef;const ref : treference);override; { same as a_call_name, might be overridden on certain architectures to emit static calls without usage of a got trampoline } - procedure a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr);override; + function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef): tcgpara;override; { move instructions } procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : aint;register : tregister);override; @@ -459,9 +459,10 @@ implementation cg.a_loadaddr_ref_cgpara(list,r,cgpara); end; - procedure thlcg2ll.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; weak: boolean); + function thlcg2ll.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara; begin cg.a_call_name(list,s,weak); + result:=inherited; end; procedure thlcg2ll.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister); @@ -474,9 +475,10 @@ implementation cg.a_call_ref(list,ref); end; - procedure thlcg2ll.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr); + function thlcg2ll.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef): tcgpara; begin cg.a_call_name_static(list,s); + result:=inherited a_call_name(list,pd,s,forceresdef,false); end; procedure thlcg2ll.a_load_const_reg(list: TAsmList; tosize: tdef; a: aint; register: tregister); diff --git a/compiler/hlcgobj.pas b/compiler/hlcgobj.pas index e04f785f08..9f3a051a87 100644 --- a/compiler/hlcgobj.pas +++ b/compiler/hlcgobj.pas @@ -191,14 +191,15 @@ unit hlcgobj; } {# Emits instruction to call the method specified by symbol name. + Returns the function result location. This routine must be overridden for each new target cpu. } - procedure a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; weak: boolean);virtual;abstract; + function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;virtual; procedure a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister);virtual;abstract; procedure a_call_ref(list : TAsmList;pd : tabstractprocdef;const ref : treference);virtual; { same as a_call_name, might be overridden on certain architectures to emit static calls without usage of a got trampoline } - procedure a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr);virtual; + function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; 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; @@ -533,7 +534,11 @@ unit hlcgobj; procedure record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList); virtual; { generate a call to a routine in the system unit } - procedure g_call_system_proc(list: TAsmList; const procname: string); + function g_call_system_proc(list: TAsmList; const procname: string; forceresdef: tdef): tcgpara; + protected + function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara; virtual; + public + { Generate code to exit an unwind-protected region. The default implementation produces a simple jump to destination label. } @@ -868,6 +873,19 @@ implementation end; end; + function thlcgobj.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara; + begin + { this is incomplete, it only sets the default function result location; + for use by descendants } + if not assigned(forceresdef) then + begin + pd.init_paraloc_info(callerside); + result:=pd.funcretloc[callerside]; + end + else + result:=paramanager.get_funcretloc(pd,callerside,forceresdef); + end; + procedure thlcgobj.a_call_ref(list: TAsmList; pd: tabstractprocdef; const ref: treference); var reg: tregister; @@ -884,14 +902,14 @@ implementation a_call_reg(list,pd,reg); end; - procedure thlcgobj.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr); + function thlcgobj.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef): tcgpara; begin - a_call_name(list,pd,s,false); + result:=a_call_name(list,pd,s,forceresdef,false); end; procedure thlcgobj.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr); begin - a_call_name(list,pd,s,false); + a_call_name(list,pd,s,nil,false); end; procedure thlcgobj.a_load_const_ref(list: TAsmList; tosize: tdef; a: aint; const ref: treference); @@ -2770,7 +2788,7 @@ implementation paramanager.getintparaloc(pocall_default,1,s32inttype,cgpara1); a_load_const_cgpara(list,s32inttype,aint(210),cgpara1); paramanager.freecgpara(list,cgpara1); - g_call_system_proc(list,'fpc_handleerror'); + g_call_system_proc(list,'fpc_handleerror',nil); cgpara1.done; a_label(list,oklabel); end; @@ -2810,7 +2828,7 @@ implementation paramanager.freecgpara(list,cgpara3); paramanager.freecgpara(list,cgpara2); paramanager.freecgpara(list,cgpara1); - g_call_system_proc(list,'fpc_shortstr_assign'); + g_call_system_proc(list,'fpc_shortstr_assign',nil); cgpara3.done; cgpara2.done; cgpara1.done; @@ -2830,7 +2848,7 @@ implementation a_loadaddr_ref_cgpara(list,vardef,source,cgpara1); paramanager.freecgpara(list,cgpara2); paramanager.freecgpara(list,cgpara1); - g_call_system_proc(list,'fpc_variant_copy_overwrite'); + g_call_system_proc(list,'fpc_variant_copy_overwrite',nil); cgpara2.done; cgpara1.done; end; @@ -2868,7 +2886,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,incrfunc); + g_call_system_proc(list,incrfunc,nil); end else begin @@ -2879,7 +2897,7 @@ implementation a_loadaddr_ref_cgpara(list,t,ref,cgpara1); paramanager.freecgpara(list,cgpara1); paramanager.freecgpara(list,cgpara2); - g_call_system_proc(list,'fpc_addref'); + g_call_system_proc(list,'fpc_addref',nil); end; cgpara2.done; cgpara1.done; @@ -2905,7 +2923,7 @@ implementation paramanager.getintparaloc(pocall_default,1,pvardata,cgpara1); a_loadaddr_ref_cgpara(list,t,ref,cgpara1); paramanager.freecgpara(list,cgpara1); - g_call_system_proc(list,'fpc_variant_init'); + g_call_system_proc(list,'fpc_variant_init',nil); end else begin @@ -2918,7 +2936,7 @@ implementation a_loadaddr_ref_cgpara(list,t,ref,cgpara1); paramanager.freecgpara(list,cgpara1); paramanager.freecgpara(list,cgpara2); - g_call_system_proc(list,'fpc_initialize'); + g_call_system_proc(list,'fpc_initialize',nil); end; cgpara1.done; cgpara2.done; @@ -2965,9 +2983,9 @@ implementation paramanager.freecgpara(list,cgpara1); paramanager.freecgpara(list,cgpara2); if dynarr then - g_call_system_proc(list,'fpc_dynarray_clear') + g_call_system_proc(list,'fpc_dynarray_clear',nil) else - g_call_system_proc(list,'fpc_finalize'); + g_call_system_proc(list,'fpc_finalize',nil); cgpara1.done; cgpara2.done; exit; @@ -2976,7 +2994,7 @@ implementation paramanager.getintparaloc(pocall_default,1,paratype,cgpara1); a_loadaddr_ref_cgpara(list,t,ref,cgpara1); paramanager.freecgpara(list,cgpara1); - g_call_system_proc(list,decrfunc); + g_call_system_proc(list,decrfunc,nil); cgpara1.done; end; @@ -3016,7 +3034,7 @@ implementation paramanager.freecgpara(list,cgpara1); paramanager.freecgpara(list,cgpara2); paramanager.freecgpara(list,cgpara3); - g_call_system_proc(list,name); + g_call_system_proc(list,name,nil); cgpara3.done; cgpara2.done; @@ -3187,7 +3205,7 @@ implementation { if low(to) > maxlongint also range error } (lto > aintmax) then begin - g_call_system_proc(list,'fpc_rangeerror'); + g_call_system_proc(list,'fpc_rangeerror',nil); exit end; { from is signed and to is unsigned -> when looking at to } @@ -3202,7 +3220,7 @@ implementation if (lfrom > aintmax) or (hto < 0) then begin - g_call_system_proc(list,'fpc_rangeerror'); + g_call_system_proc(list,'fpc_rangeerror',nil); exit end; { from is unsigned and to is signed -> when looking at to } @@ -3225,7 +3243,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'); + g_call_system_proc(list,'fpc_rangeerror',nil); a_label(list,neglabel); end; @@ -4319,7 +4337,7 @@ implementation current_asmdata.asmlists[al_procedures].concatlist(data); end; - procedure thlcgobj.g_call_system_proc(list: TAsmList; const procname: string); + function thlcgobj.g_call_system_proc(list: TAsmList; const procname: string; forceresdef: tdef): tcgpara; var srsym: tsym; pd: tprocdef; @@ -4332,8 +4350,13 @@ implementation (srsym.typ<>procsym) then Message1(cg_f_unknown_compilerproc,procname); pd:=tprocdef(tprocsym(srsym).procdeflist[0]); + result:=g_call_system_proc_intern(list,pd,forceresdef); + end; + + function thlcgobj.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara; + begin allocallcpuregisters(list); - a_call_name(list,pd,pd.mangledname,false); + result:=a_call_name(list,pd,pd.mangledname,forceresdef,false); deallocallcpuregisters(list); end; diff --git a/compiler/jvm/hlcgcpu.pas b/compiler/jvm/hlcgcpu.pas index 7e317ae5bc..99e0633413 100644 --- a/compiler/jvm/hlcgcpu.pas +++ b/compiler/jvm/hlcgcpu.pas @@ -50,7 +50,7 @@ uses procedure a_load_const_cgpara(list : TAsmList;tosize : tdef;a : aint;const cgpara : TCGPara);override; - procedure a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; weak: boolean);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; @@ -158,6 +158,10 @@ uses then they have to be zero-extended again on the consumer side } procedure maybe_resize_stack_para_val(list: TAsmList; retdef: tdef; callside: boolean); + { adjust the stack height after a call based on the specified number of + slots used for parameters and the provided resultdef } + procedure g_adjust_stack_after_call(list: TAsmList; pd: tabstractprocdef; paraheight: longint; forceresdef: tdef); + property maxevalstackheight: longint read fmaxevalstackheight; @@ -178,6 +182,7 @@ uses procedure inittempvariables(list:TAsmList);override; + function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; 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 @@ -199,7 +204,7 @@ uses JVM does not support unsigned divisions } procedure maybepreparedivu32(list: TAsmList; var op: topcg; size: tdef; out isdivu32: boolean); { common implementation of a_call_* } - procedure a_call_name_intern(list : TAsmList;pd : tprocdef;const s : TSymStr; inheritedcall: boolean); + function a_call_name_intern(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; inheritedcall: boolean): tcgpara; { concatcopy helpers } procedure concatcopy_normal_array(list: TAsmList; size: tdef; const source, dest: treference); @@ -291,14 +296,14 @@ implementation inherited a_load_const_cgpara(list, tosize, a, cgpara); end; - procedure thlcgjvm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; weak: boolean); + function thlcgjvm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara; begin - a_call_name_intern(list,pd,s,false); + result:=a_call_name_intern(list,pd,s,forceresdef,false); end; procedure thlcgjvm.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr); begin - a_call_name_intern(list,pd,s,true); + a_call_name_intern(list,pd,s,nil,true); end; @@ -632,7 +637,6 @@ implementation i: longint; mangledname: string; opc: tasmop; - parasize: longint; primitivetype: boolean; begin elemdef:=arrdef; @@ -682,50 +686,46 @@ implementation list.concat(taicpu.op_none(a_dup)); incstack(list,1); a_load_const_stack(list,s32inttype,initdim-1,R_INTREGISTER); - parasize:=2; case elemdef.typ of arraydef: - g_call_system_proc(list,'fpc_initialize_array_dynarr'); + 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)); - inc(parasize); case elemdef.typ of recorddef: - g_call_system_proc(list,'fpc_initialize_array_record'); + 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') + g_call_system_proc(list,'fpc_initialize_array_enumset',nil) else - g_call_system_proc(list,'fpc_initialize_array_bitset') + g_call_system_proc(list,'fpc_initialize_array_bitset',nil) end; procvardef: - g_call_system_proc(list,'fpc_initialize_array_procvar'); + g_call_system_proc(list,'fpc_initialize_array_procvar',nil); end; tg.ungettemp(list,recref); end; enumdef: begin - inc(parasize); a_load_ref_stack(list,java_jlobject,enuminitref,prepare_stack_for_ref(list,enuminitref,false)); - g_call_system_proc(list,'fpc_initialize_array_object'); + g_call_system_proc(list,'fpc_initialize_array_object',nil); end; stringdef: begin case tstringdef(elemdef).stringtype of st_shortstring: begin - inc(parasize); a_load_const_stack_intern(list,u8inttype,tstringdef(elemdef).len,R_INTREGISTER,true); - g_call_system_proc(list,'fpc_initialize_array_shortstring'); + g_call_system_proc(list,'fpc_initialize_array_shortstring',nil); end; st_ansistring: - g_call_system_proc(list,'fpc_initialize_array_ansistring'); + g_call_system_proc(list,'fpc_initialize_array_ansistring',nil); st_unicodestring, st_widestring: - g_call_system_proc(list,'fpc_initialize_array_unicodestring'); + g_call_system_proc(list,'fpc_initialize_array_unicodestring',nil); else internalerror(2011081801); end; @@ -733,7 +733,6 @@ implementation else internalerror(2011081801); end; - decstack(list,parasize); end; end; @@ -933,6 +932,15 @@ implementation { these are automatically initialised when allocated if necessary } end; + + function thlcgjvm.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara; + begin + result:=inherited; + pd.init_paraloc_info(callerside); + g_adjust_stack_after_call(list,pd,pd.callerargareasize,forceresdef); + end; + + function thlcgjvm.prepare_stack_for_ref(list: TAsmList; const ref: treference; dup: boolean): longint; var href: treference; @@ -1287,16 +1295,9 @@ 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); - if ndim=1 then + g_call_system_proc(list,procname,nil); + if ndim<>1 then begin - decstack(list,2); - if adddefaultlenparas then - decstack(list,2); - end - else - begin - decstack(list,4); { pop return value, must be the same as dest } list.concat(taicpu.op_none(a_pop)); decstack(list,1); @@ -1318,7 +1319,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,false); + a_call_name(list,pd,pd.mangledname,nil,false); { both parameters are removed, no function result } decstack(list,2); end; @@ -1330,11 +1331,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') + g_call_system_proc(list,'fpc_enumset_copy',nil) else - g_call_system_proc(list,'fpc_bitset_copy'); - { both parameters are removed, no function result } - decstack(list,2); + g_call_system_proc(list,'fpc_bitset_copy',nil); end; @@ -1353,7 +1352,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,false); + a_call_name(list,pd,pd.mangledname,nil,false); { both parameters are removed, no function result } decstack(list,2); end; @@ -1543,22 +1542,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') + 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') + 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') + 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') + 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') + g_call_system_proc(list,'fpc_initialize_array_enumset',nil) else - g_call_system_proc(list,'fpc_initialize_array_bitset'); + g_call_system_proc(list,'fpc_initialize_array_bitset',nil); tg.ungettemp(list,eleref); end else if (t.typ=enumdef) then @@ -1566,7 +1565,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'); + g_call_system_proc(list,'fpc_initialize_array_object',nil); end; end else @@ -1597,7 +1596,7 @@ implementation pd:=tprocdef(tprocsym(sym).procdeflist[0]); end; a_load_ref_stack(list,java_jlobject,ref,prepare_stack_for_ref(list,ref,false)); - a_call_name(list,pd,pd.mangledname,false); + a_call_name(list,pd,pd.mangledname,nil,false); { parameter removed, no result } decstack(list,1); end @@ -2060,6 +2059,31 @@ implementation end; end; + + procedure thlcgjvm.g_adjust_stack_after_call(list: TAsmList; pd: tabstractprocdef; paraheight: longint; forceresdef: tdef); + var + totalremovesize: longint; + realresdef: tdef; + begin + if not assigned(forceresdef) then + realresdef:=pd.returndef + else + realresdef:=forceresdef; + { a constructor doesn't actually return a value in the jvm } + if (tabstractprocdef(pd).proctypeoption=potype_constructor) then + totalremovesize:=paraheight + else + { even a byte takes up a full stackslot -> align size to multiple of 4 } + totalremovesize:=paraheight-(align(realresdef.size,4) shr 2); + { remove parameters from internal evaluation stack counter (in case of + e.g. no parameters and a result, it can also increase) } + if totalremovesize>0 then + decstack(list,totalremovesize) + else if totalremovesize<0 then + incstack(list,-totalremovesize); + end; + + procedure thlcgjvm.allocate_implicit_struct_with_base_ref(list: TAsmList; vs: tabstractvarsym; ref: treference); var tmpref: treference; @@ -2256,7 +2280,7 @@ implementation isdivu32:=false; end; - procedure thlcgjvm.a_call_name_intern(list: TAsmList; pd: tprocdef; const s: TSymStr; inheritedcall: boolean); + function thlcgjvm.a_call_name_intern(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; inheritedcall: boolean): tcgpara; var opc: tasmop; begin @@ -2319,6 +2343,7 @@ implementation pd.init_paraloc_info(calleeside); list.concat(taicpu.op_sym_const(opc,current_asmdata.RefAsmSymbol(s),pd.calleeargareasize)); end; + result:=inherited a_call_name(list,pd,s,forceresdef,false); end; procedure create_hlcodegen; diff --git a/compiler/jvm/njvmcal.pas b/compiler/jvm/njvmcal.pas index e36e5c2c1a..8622dec47b 100644 --- a/compiler/jvm/njvmcal.pas +++ b/compiler/jvm/njvmcal.pas @@ -439,33 +439,21 @@ implementation procedure tjvmcallnode.extra_post_call_code; var - totalremovesize: longint; realresdef: tdef; begin - if not assigned(typedef) then - realresdef:=tstoreddef(resultdef) - else - realresdef:=tstoreddef(typedef); + thlcgjvm(hlcg).g_adjust_stack_after_call(current_asmdata.CurrAsmList,procdefinition,pushedparasize,typedef); { a constructor doesn't actually return a value in the jvm } - if (tabstractprocdef(procdefinition).proctypeoption=potype_constructor) then - totalremovesize:=pushedparasize - else + if (tabstractprocdef(procdefinition).proctypeoption<>potype_constructor) then begin - { zero-extend unsigned 8/16 bit returns (we have to return them - sign-extended to keep the Android verifier happy, and even if that - one did not exist a plain Java routine could return a - sign-extended value) } if cnf_return_value_used in callnodeflags then - thlcgjvm(hlcg).maybe_resize_stack_para_val(current_asmdata.CurrAsmList,realresdef,false); - { even a byte takes up a full stackslot -> align size to multiple of 4 } - totalremovesize:=pushedparasize-(align(realresdef.size,4) shr 2); + begin + if not assigned(typedef) then + realresdef:=tstoreddef(resultdef) + else + realresdef:=tstoreddef(typedef); + thlcgjvm(hlcg).maybe_resize_stack_para_val(current_asmdata.CurrAsmList,realresdef,false); + end; end; - { remove parameters from internal evaluation stack counter (in case of - e.g. no parameters and a result, it can also increase) } - if totalremovesize>0 then - thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,totalremovesize) - else if totalremovesize<0 then - thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,-totalremovesize); { if this was an inherited constructor call, initialise all fields that are wrapped types following it } diff --git a/compiler/jvm/njvmmem.pas b/compiler/jvm/njvmmem.pas index ebb64c4df7..75ac07f0a9 100644 --- a/compiler/jvm/njvmmem.pas +++ b/compiler/jvm/njvmmem.pas @@ -415,7 +415,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,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 484a363cd7..b422ec00eb 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,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,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,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,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 ad03bee126..a0f243538c 100644 --- a/compiler/mips/hlcgcpu.pas +++ b/compiler/mips/hlcgcpu.pas @@ -32,12 +32,12 @@ uses globtype, aasmbase, aasmdata, cgbase, cgutils, - symdef, - hlcgobj, hlcg2ll; + symtype,symdef, + parabase, hlcgobj, hlcg2ll; type - thlcg2mips = class(thlcg2ll) - procedure a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; weak: boolean);override; + thlcgmips = class(thlcg2ll) + 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; procedure a_call_ref(list : TAsmList;pd : tabstractprocdef;const ref : treference);override; end; @@ -53,7 +53,7 @@ implementation cpubase, cgcpu; - procedure thlcg2mips.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; weak: boolean); + function thlcgmips.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara; var ref : treference; begin @@ -73,9 +73,11 @@ implementation end else cg.a_call_name(list,s,weak); + { the default implementation only determines the result location } + result:=inherited; end; - procedure thlcg2mips.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister); + procedure thlcgmips.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister); begin if (pd.proccalloption=pocall_cdecl) and (reg<>NR_PIC_FUNC) then begin @@ -88,7 +90,7 @@ implementation cg.a_call_reg(list,reg); end; - procedure thlcg2mips.a_call_ref(list: TAsmList; pd: tabstractprocdef; const ref: treference); + procedure thlcgmips.a_call_ref(list: TAsmList; pd: tabstractprocdef; const ref: treference); begin if pd.proccalloption =pocall_cdecl then begin @@ -103,7 +105,7 @@ implementation procedure create_hlcodegen; begin - hlcg:=thlcg2mips.create; + hlcg:=thlcgmips.create; create_codegen; end; diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas index 03c34eea16..e759c2911d 100644 --- a/compiler/ncgcal.pas +++ b/compiler/ncgcal.pas @@ -872,9 +872,9 @@ implementation if cnf_inherited in callnodeflags then hlcg.a_call_name_inherited(current_asmdata.CurrAsmList,tprocdef(procdefinition),tprocdef(procdefinition).mangledname) else - hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),tprocdef(procdefinition).mangledname,po_weakexternal in procdefinition.procoptions) + hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),tprocdef(procdefinition).mangledname,typedef,po_weakexternal in procdefinition.procoptions) else - hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call,po_weakexternal in procdefinition.procoptions); + hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call,typedef,po_weakexternal in procdefinition.procoptions); extra_post_call_code; end; end;