paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-24 07:01:44 +02:00
Code Issues Packages Projects Releases Wiki Activity

* let thlcg.a_call_name() return the tcgpara representing the function

Browse Source 
result location (NR_FUNCTION_RESULT_REG is not valid on all platforms)
   o this requires passing the forced function result type (if any) to this
     method
   o a generic, basic thlcg.a_call_name() is now available that sets the
     function result location; can be called by descendants
  * the availability under all circumstances of the correct function return
    type enables g_call_system_proc() on the JVM platform to now determine
    by itself how many stack slots are removed by the call -> do so, instead
    of manually counting them (or forgetting to do so and messing up the
    maximum evaluation stack height calculations)

git-svn-id: trunk@21862 -
This commit is contained in:
Jonas Maebe 2012-07-11 08:25:58 +00:00
parent aba6923187
commit 1955255dda
8 changed files with 146 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
compiler/hlcg2ll.pas
View File

@ -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);

67
compiler/hlcgobj.pas
View File

@ -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;

113
compiler/jvm/hlcgcpu.pas
View File

@ -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;

30
compiler/jvm/njvmcal.pas
View File

@ -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 }

2
compiler/jvm/njvmmem.pas
View File

@ -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);

8
compiler/jvm/tgcpu.pas
View File

@ -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 }

18
compiler/mips/hlcgcpu.pas
View File

@ -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;

4
compiler/ncgcal.pas
View File

@ -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;