mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-31 22:11:12 +01:00
71b348757b
that's how these operations also work on other architectures * fixed tjvmaddnode.second_generic_compare() for this new order git-svn-id: branches/jvmbackend@18338 -
1232 lines
46 KiB
ObjectPascal
1232 lines
46 KiB
ObjectPascal
{
|
|
Copyright (c) 1998-2010 by Florian Klaempfl and Jonas Maebe
|
|
Member of the Free Pascal development team
|
|
|
|
This unit implements the jvm high level code generator
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
|
****************************************************************************
|
|
}
|
|
unit hlcgcpu;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
globtype,
|
|
aasmbase,aasmdata,
|
|
symtype,symdef,
|
|
cpubase, hlcgobj, cgbase, cgutils, parabase;
|
|
|
|
type
|
|
|
|
{ thlcgjvm }
|
|
|
|
thlcgjvm = class(thlcgobj)
|
|
private
|
|
fevalstackheight,
|
|
fmaxevalstackheight: longint;
|
|
public
|
|
constructor create;
|
|
|
|
procedure incstack(list : TAsmList;slots: longint);
|
|
procedure decstack(list : TAsmList;slots: longint);
|
|
|
|
procedure a_call_name(list : TAsmList;pd : tprocdef;const s : string; weak: boolean);override;
|
|
procedure a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : string);override;
|
|
|
|
procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : aint;register : tregister);override;
|
|
procedure a_load_const_ref(list : TAsmList;tosize : tdef;a : aint;const ref : treference);override;
|
|
procedure a_load_reg_ref(list : TAsmList;fromsize, tosize : tdef;register : tregister;const ref : treference);override;
|
|
procedure a_load_reg_reg(list : TAsmList;fromsize, tosize : tdef;reg1,reg2 : tregister);override;
|
|
procedure a_load_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;register : tregister);override;
|
|
procedure a_load_ref_ref(list : TAsmList;fromsize, tosize : tdef;const sref : treference;const dref : treference);override;
|
|
procedure a_loadaddr_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister);override;
|
|
|
|
procedure a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: Aint; reg: TRegister); override;
|
|
procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: aint; src, dst: tregister); override;
|
|
procedure a_op_const_ref(list: TAsmList; Op: TOpCG; size: tdef; a: Aint; const ref: TReference); override;
|
|
|
|
procedure a_op_ref_reg(list: TAsmList; Op: TOpCG; size: tdef; const ref: TReference; reg: TRegister); override;
|
|
procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister); override;
|
|
procedure a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister); override;
|
|
|
|
procedure a_cmp_const_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: aint; const ref: treference; l: tasmlabel); override;
|
|
procedure a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: aint; reg: tregister; l: tasmlabel); override;
|
|
procedure a_cmp_ref_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister; l: tasmlabel); override;
|
|
procedure a_cmp_reg_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference; l: tasmlabel); override;
|
|
procedure a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel); override;
|
|
|
|
procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
|
|
|
|
procedure a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1, ref2: treference); override;
|
|
procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister); override;
|
|
procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference); override;
|
|
procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister); override;
|
|
|
|
procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); override;
|
|
procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); override;
|
|
|
|
procedure gen_load_return_value(list:TAsmList);override;
|
|
procedure record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList); override;
|
|
|
|
{ JVM-specific routines }
|
|
|
|
procedure a_load_stack_reg(list : TAsmList;size: tdef;reg: tregister);
|
|
{ extra_slots are the slots that are used by the reference, and that
|
|
will be removed by the store operation }
|
|
procedure a_load_stack_ref(list : TAsmList;size: tdef;const ref: treference;extra_slots: longint);
|
|
procedure a_load_reg_stack(list : TAsmList;size: tdef;reg: tregister);
|
|
{ extra_slots are the slots that are used by the reference, and that
|
|
will be removed by the load operation }
|
|
procedure a_load_ref_stack(list : TAsmList;size: tdef;const ref: treference;extra_slots: longint);
|
|
procedure a_load_const_stack(list : TAsmList;size: tdef;a :aint; typ: TRegisterType);
|
|
|
|
procedure a_load_loc_stack(list : TAsmList;size: tdef;const loc: tlocation);
|
|
|
|
procedure a_loadfpu_const_stack(list : TAsmList;size: tdef;a :double);
|
|
|
|
procedure a_op_stack(list : TAsmList;op: topcg; size: tdef; trunc32: boolean);
|
|
procedure a_op_const_stack(list : TAsmList;op: topcg; size: tdef;a : aint);
|
|
procedure a_op_reg_stack(list : TAsmList;op: topcg; size: tdef;reg: tregister);
|
|
procedure a_op_ref_stack(list : TAsmList;op: topcg; size: tdef;const ref: treference);
|
|
procedure a_op_loc_stack(list : TAsmList;op: topcg; size: tdef;const loc: tlocation);
|
|
|
|
{ this routine expects that all values are already massaged into the
|
|
required form (sign bits xor'ed for gt/lt comparisons for OS_32/OS_64,
|
|
see http://stackoverflow.com/questions/4068973/c-performing-signed-comparison-in-unsigned-variables-without-casting ) }
|
|
procedure a_cmp_stack_label(list : TAsmlist; size: tdef; cmp_op: topcmp; lab: tasmlabel);
|
|
{ these 2 routines perform the massaging expected by the previous one }
|
|
procedure maybe_adjust_cmp_stackval(list : TAsmlist; size: tdef; cmp_op: topcmp);
|
|
function maybe_adjust_cmp_constval(size: tdef; cmp_op: topcmp; a: aint): aint;
|
|
{ truncate/sign extend after performing operations on values < 32 bit
|
|
that may have overflowed outside the range }
|
|
procedure maybe_adjust_op_result(list: TAsmList; op: TOpCg; size: tdef);
|
|
|
|
{ performs sign/zero extension as required }
|
|
procedure resize_stack_int_val(list: TAsmList;fromsize,tosize: tcgsize; forarraystore: boolean);
|
|
|
|
property maxevalstackheight: longint read fmaxevalstackheight;
|
|
|
|
protected
|
|
procedure gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: 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
|
|
fields the self pointer has to be loaded first. Also checks whether
|
|
the reference is valid. If dup is true, the necessary values are stored
|
|
twice. Returns how many stack slots have been consumed, disregarding
|
|
the "dup". }
|
|
function prepare_stack_for_ref(list: TAsmList; const ref: treference; dup: boolean): longint;
|
|
{ return the load/store opcode to load/store from/to ref; if the result
|
|
has to be and'ed after a load to get the final value, that constant
|
|
is returned in finishandval (otherwise that value is set to -1) }
|
|
function loadstoreopcref(def: tdef; isload: boolean; const ref: treference; out finishandval: aint): tasmop;
|
|
{ return the load/store opcode to load/store from/to reg; if the result
|
|
has to be and'ed after a load to get the final value, that constant
|
|
is returned in finishandval (otherwise that value is set to -1) }
|
|
function loadstoreopc(def: tdef; isload, isarray: boolean; out finishandval: aint): tasmop;
|
|
procedure resizestackfpuval(list: TAsmList; fromsize, tosize: tcgsize);
|
|
{ in case of an OS_32 OP_DIV, we have to use an OS_S64 OP_IDIV because the
|
|
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 : string; inheritedcall: boolean);
|
|
end;
|
|
|
|
procedure create_hlcodegen;
|
|
|
|
|
|
const
|
|
opcmp2if: array[topcmp] of tasmop = (A_None,
|
|
a_ifeq,a_ifgt,a_iflt,a_ifge,a_ifle,
|
|
a_ifne,a_ifle,a_iflt,a_ifge,a_ifgt);
|
|
|
|
implementation
|
|
|
|
uses
|
|
verbose,cutils,globals,
|
|
defutil,
|
|
aasmtai,aasmcpu,
|
|
symconst,
|
|
procinfo,cgcpu;
|
|
|
|
const
|
|
TOpCG2IAsmOp : array[topcg] of TAsmOp=( { not = xor -1 }
|
|
A_None,A_None,a_iadd,a_iand,A_none,a_idiv,a_imul,a_imul,a_ineg,A_None,a_ior,a_ishr,a_ishl,a_iushr,a_isub,a_ixor,A_None,A_None
|
|
);
|
|
TOpCG2LAsmOp : array[topcg] of TAsmOp=( { not = xor -1 }
|
|
A_None,A_None,a_ladd,a_land,A_none,a_ldiv,a_lmul,a_lmul,a_lneg,A_None,a_lor,a_lshr,a_lshl,a_lushr,a_lsub,a_lxor,A_None,A_None
|
|
);
|
|
|
|
constructor thlcgjvm.create;
|
|
begin
|
|
fevalstackheight:=0;
|
|
fmaxevalstackheight:=0;
|
|
end;
|
|
|
|
procedure thlcgjvm.incstack(list: TasmList;slots: longint);
|
|
begin
|
|
if slots=0 then
|
|
exit;
|
|
inc(fevalstackheight,slots);
|
|
if (fevalstackheight>fmaxevalstackheight) then
|
|
fmaxevalstackheight:=fevalstackheight;
|
|
if cs_asm_regalloc in current_settings.globalswitches then
|
|
list.concat(tai_comment.Create(strpnew('allocated '+tostr(slots)+', stack height = '+tostr(fevalstackheight))));
|
|
end;
|
|
|
|
procedure thlcgjvm.decstack(list: TAsmList;slots: longint);
|
|
begin
|
|
if slots=0 then
|
|
exit;
|
|
dec(fevalstackheight,slots);
|
|
if (fevalstackheight<0) then
|
|
internalerror(2010120501);
|
|
if cs_asm_regalloc in current_settings.globalswitches then
|
|
list.concat(tai_comment.Create(strpnew(' freed '+tostr(slots)+', stack height = '+tostr(fevalstackheight))));
|
|
end;
|
|
|
|
procedure thlcgjvm.a_call_name(list: TAsmList; pd: tprocdef; const s: string; weak: boolean);
|
|
begin
|
|
a_call_name_intern(list,pd,s,false);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: string);
|
|
begin
|
|
a_call_name_intern(list,pd,s,true);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_load_const_stack(list : TAsmList;size : tdef;a : aint; typ: TRegisterType);
|
|
const
|
|
int2opc: array[-1..5] of tasmop = (a_iconst_m1,a_iconst_0,a_iconst_1,
|
|
a_iconst_2,a_iconst_3,a_iconst_4,a_iconst_5);
|
|
begin
|
|
case typ of
|
|
R_INTREGISTER:
|
|
begin
|
|
case def_cgsize(size) of
|
|
OS_8,OS_16,OS_32,
|
|
OS_S8,OS_S16,OS_S32:
|
|
begin
|
|
{ convert cardinals to longints }
|
|
a:=longint(a);
|
|
if (a>=-1) and
|
|
(a<=5) then
|
|
list.concat(taicpu.op_none(int2opc[a]))
|
|
else if (a>=low(shortint)) and
|
|
(a<=high(shortint)) then
|
|
list.concat(taicpu.op_const(a_bipush,a))
|
|
else if (a>=low(smallint)) and
|
|
(a<=high(smallint)) then
|
|
list.concat(taicpu.op_const(a_sipush,a))
|
|
else
|
|
list.concat(taicpu.op_const(a_ldc,a));
|
|
end;
|
|
OS_64,OS_S64:
|
|
begin
|
|
case a of
|
|
0:
|
|
list.concat(taicpu.op_none(a_lconst_0));
|
|
1:
|
|
list.concat(taicpu.op_none(a_lconst_1));
|
|
else
|
|
list.concat(taicpu.op_const(a_ldc2_w,a));
|
|
end;
|
|
incstack(list,1);
|
|
end;
|
|
else
|
|
internalerror(2010110702);
|
|
end;
|
|
end;
|
|
R_ADDRESSREGISTER:
|
|
begin
|
|
if a<>0 then
|
|
internalerror(2010110701);
|
|
list.concat(taicpu.op_none(a_aconst_null));
|
|
end;
|
|
else
|
|
internalerror(2010110703);
|
|
end;
|
|
incstack(list,1);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_load_loc_stack(list: TAsmList;size: tdef;const loc: tlocation);
|
|
begin
|
|
case loc.loc of
|
|
LOC_REGISTER,LOC_CREGISTER,
|
|
LOC_FPUREGISTER,LOC_CFPUREGISTER:
|
|
a_load_reg_stack(list,size,loc.register);
|
|
LOC_REFERENCE,LOC_CREFERENCE:
|
|
a_load_ref_stack(list,size,loc.reference,prepare_stack_for_ref(list,loc.reference,false));
|
|
LOC_CONSTANT:
|
|
a_load_const_stack(list,size,loc.value,def2regtyp(size));
|
|
else
|
|
internalerror(2011010401);
|
|
end;
|
|
end;
|
|
|
|
procedure thlcgjvm.a_loadfpu_const_stack(list: TAsmList; size: tdef; a: double);
|
|
begin
|
|
case tfloatdef(size).floattype of
|
|
s32real:
|
|
begin
|
|
if a=0.0 then
|
|
list.concat(taicpu.op_none(a_fconst_0))
|
|
else if a=1.0 then
|
|
list.concat(taicpu.op_none(a_fconst_1))
|
|
else if a=2.0 then
|
|
list.concat(taicpu.op_none(a_fconst_2))
|
|
else
|
|
list.concat(taicpu.op_single(a_ldc,a));
|
|
incstack(list,1);
|
|
end;
|
|
s64real:
|
|
begin
|
|
if a=0.0 then
|
|
list.concat(taicpu.op_none(a_dconst_0))
|
|
else if a=1.0 then
|
|
list.concat(taicpu.op_none(a_dconst_1))
|
|
else
|
|
list.concat(taicpu.op_double(a_ldc2_w,a));
|
|
incstack(list,2);
|
|
end
|
|
else
|
|
internalerror(2011010501);
|
|
end;
|
|
end;
|
|
|
|
procedure thlcgjvm.a_op_stack(list: TAsmList; op: topcg; size: tdef; trunc32: boolean);
|
|
var
|
|
cgsize: tcgsize;
|
|
begin
|
|
if not trunc32 then
|
|
cgsize:=def_cgsize(size)
|
|
else
|
|
begin
|
|
resize_stack_int_val(list,OS_32,OS_S64,false);
|
|
cgsize:=OS_S64;
|
|
end;
|
|
case cgsize of
|
|
OS_8,OS_S8,
|
|
OS_16,OS_S16,
|
|
OS_32,OS_S32:
|
|
begin
|
|
{ not = xor 1 for boolean, xor -1 for the rest}
|
|
if op=OP_NOT then
|
|
begin
|
|
if not is_pasbool(size) then
|
|
a_load_const_stack(list,s32inttype,high(cardinal),R_INTREGISTER)
|
|
else
|
|
a_load_const_stack(list,size,1,R_INTREGISTER);
|
|
op:=OP_XOR;
|
|
end;
|
|
if TOpCG2IAsmOp[op]=A_None then
|
|
internalerror(2010120532);
|
|
list.concat(taicpu.op_none(TOpCG2IAsmOp[op]));
|
|
maybe_adjust_op_result(list,op,size);
|
|
if op<>OP_NEG then
|
|
decstack(list,1);
|
|
end;
|
|
OS_64,OS_S64:
|
|
begin
|
|
{ unsigned 64 bit division must be done via a helper }
|
|
if op=OP_DIV then
|
|
internalerror(2010120530);
|
|
{ not = xor -1 }
|
|
if op=OP_NOT then
|
|
begin
|
|
a_load_const_stack(list,s64inttype,-1,R_INTREGISTER);
|
|
op:=OP_XOR;
|
|
end;
|
|
if TOpCG2LAsmOp[op]=A_None then
|
|
internalerror(2010120533);
|
|
list.concat(taicpu.op_none(TOpCG2LAsmOp[op]));
|
|
case op of
|
|
OP_NOT:
|
|
;
|
|
{ the second argument here is an int rather than a long }
|
|
OP_SHL,OP_SHR,OP_SAR:
|
|
decstack(list,1);
|
|
else
|
|
decstack(list,2);
|
|
end;
|
|
end;
|
|
else
|
|
internalerror(2010120531);
|
|
end;
|
|
if trunc32 then
|
|
begin
|
|
list.concat(taicpu.op_none(a_l2i));
|
|
decstack(list,1);
|
|
end;
|
|
end;
|
|
|
|
procedure thlcgjvm.a_op_const_stack(list: TAsmList;op: topcg;size: tdef;a: aint);
|
|
var
|
|
trunc32: boolean;
|
|
begin
|
|
{ use "integer to (wide)char" narrowing opcode for "and 65535" }
|
|
if (op=OP_AND) and
|
|
(def_cgsize(size) in [OS_16,OS_S16,OS_32,OS_S32]) and
|
|
(a=65535) then
|
|
list.concat(taicpu.op_none(a_i2c))
|
|
else
|
|
begin
|
|
maybepreparedivu32(list,op,size,trunc32);
|
|
case op of
|
|
OP_NEG,OP_NOT:
|
|
internalerror(2011010801);
|
|
OP_SHL,OP_SHR,OP_SAR:
|
|
{ the second argument here is an int rather than a long }
|
|
a_load_const_stack(list,s32inttype,a,R_INTREGISTER);
|
|
else
|
|
a_load_const_stack(list,size,a,R_INTREGISTER);
|
|
end;
|
|
a_op_stack(list,op,size,trunc32);
|
|
end;
|
|
end;
|
|
|
|
procedure thlcgjvm.a_op_reg_stack(list: TAsmList; op: topcg; size: tdef; reg: tregister);
|
|
var
|
|
trunc32: boolean;
|
|
begin
|
|
maybepreparedivu32(list,op,size,trunc32);
|
|
case op of
|
|
OP_NEG,OP_NOT:
|
|
;
|
|
OP_SHL,OP_SHR,OP_SAR:
|
|
if not is_64bitint(size) then
|
|
a_load_reg_stack(list,size,reg)
|
|
else
|
|
begin
|
|
{ the second argument here is an int rather than a long }
|
|
if getsubreg(reg)=R_SUBQ then
|
|
internalerror(2011010802);
|
|
a_load_reg_stack(list,s32inttype,reg)
|
|
end
|
|
else
|
|
a_load_reg_stack(list,size,reg);
|
|
end;
|
|
a_op_stack(list,op,size,trunc32);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_op_ref_stack(list: TAsmList; op: topcg; size: tdef; const ref: treference);
|
|
var
|
|
trunc32: boolean;
|
|
begin
|
|
{ ref must not be the stack top, because that may indicate an error
|
|
(it means that we will perform an operation of the stack top onto
|
|
itself, so that means the two values have been loaded manually prior
|
|
to calling this routine, instead of letting this routine load one of
|
|
them; if something like that is needed, call a_op_stack() directly) }
|
|
if ref.base=NR_EVAL_STACK_BASE then
|
|
internalerror(2010121102);
|
|
maybepreparedivu32(list,op,size,trunc32);
|
|
if not(op in [OP_NEG,OP_NOT]) then
|
|
a_load_ref_stack(list,size,ref,prepare_stack_for_ref(list,ref,false));
|
|
a_op_stack(list,op,size,trunc32);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_op_loc_stack(list: TAsmList; op: topcg; size: tdef; const loc: tlocation);
|
|
begin
|
|
case loc.loc of
|
|
LOC_REGISTER,LOC_CREGISTER:
|
|
a_op_reg_stack(list,op,size,loc.register);
|
|
LOC_REFERENCE,LOC_CREFERENCE:
|
|
a_op_ref_stack(list,op,size,loc.reference);
|
|
LOC_CONSTANT:
|
|
a_op_const_stack(list,op,size,loc.value);
|
|
else
|
|
internalerror(2011011415)
|
|
end;
|
|
end;
|
|
|
|
procedure thlcgjvm.a_cmp_stack_label(list: TAsmlist; size: tdef; cmp_op: topcmp; lab: tasmlabel);
|
|
const
|
|
opcmp2icmp: array[topcmp] of tasmop = (A_None,
|
|
a_if_icmpeq,a_if_icmpgt,a_if_icmplt,a_if_icmpge,a_if_icmple,
|
|
a_if_icmpne,a_if_icmple,a_if_icmplt,a_if_icmpge,a_if_icmpgt);
|
|
var
|
|
cgsize: tcgsize;
|
|
begin
|
|
case def2regtyp(size) of
|
|
R_INTREGISTER:
|
|
begin
|
|
cgsize:=def_cgsize(size);
|
|
case cgsize of
|
|
OS_S8,OS_8,
|
|
OS_16,OS_S16,
|
|
OS_S32,OS_32:
|
|
begin
|
|
list.concat(taicpu.op_sym(opcmp2icmp[cmp_op],lab));
|
|
decstack(list,2);
|
|
end;
|
|
OS_64,OS_S64:
|
|
begin
|
|
list.concat(taicpu.op_none(a_lcmp));
|
|
decstack(list,3);
|
|
list.concat(taicpu.op_sym(opcmp2if[cmp_op],lab));
|
|
decstack(list,1);
|
|
end;
|
|
else
|
|
internalerror(2010120538);
|
|
end;
|
|
end;
|
|
R_ADDRESSREGISTER:
|
|
begin
|
|
case cmp_op of
|
|
OC_EQ:
|
|
list.concat(taicpu.op_sym(a_if_acmpeq,lab));
|
|
OC_NE:
|
|
list.concat(taicpu.op_sym(a_if_acmpne,lab));
|
|
else
|
|
internalerror(2010120537);
|
|
end;
|
|
decstack(list,2);
|
|
end;
|
|
else
|
|
internalerror(2010120538);
|
|
end;
|
|
end;
|
|
|
|
procedure thlcgjvm.maybe_adjust_cmp_stackval(list: TAsmlist; size: tdef; cmp_op: topcmp);
|
|
begin
|
|
if (cmp_op in [OC_EQ,OC_NE]) or
|
|
(def2regtyp(size)<>R_INTREGISTER) then
|
|
exit;
|
|
{ http://stackoverflow.com/questions/4068973/c-performing-signed-comparison-in-unsigned-variables-without-casting }
|
|
case def_cgsize(size) of
|
|
OS_32:
|
|
a_op_const_stack(list,OP_XOR,size,cardinal($80000000));
|
|
OS_64:
|
|
a_op_const_stack(list,OP_XOR,size,aint($8000000000000000));
|
|
end;
|
|
end;
|
|
|
|
function thlcgjvm.maybe_adjust_cmp_constval(size: tdef; cmp_op: topcmp; a: aint): aint;
|
|
begin
|
|
result:=a;
|
|
if (cmp_op in [OC_EQ,OC_NE]) or
|
|
(def2regtyp(size)<>R_INTREGISTER) then
|
|
exit;
|
|
case def_cgsize(size) of
|
|
OS_32:
|
|
result:=a xor cardinal($80000000);
|
|
OS_64:
|
|
result:=a xor aint($8000000000000000);
|
|
end;
|
|
end;
|
|
|
|
procedure thlcgjvm.maybe_adjust_op_result(list: TAsmList; op: TOpCg; size: tdef);
|
|
const
|
|
overflowops = [OP_MUL,OP_SHL,OP_ADD,OP_SUB,OP_NOT,OP_NEG];
|
|
begin
|
|
if (op in overflowops) and
|
|
(def_cgsize(size) in [OS_8,OS_S8,OS_16,OS_S16]) then
|
|
resize_stack_int_val(list,OS_S32,def_cgsize(size),false);
|
|
end;
|
|
|
|
procedure thlcgjvm.gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara);
|
|
begin
|
|
{ constructors don't return anything in Java }
|
|
if pd.proctypeoption=potype_constructor then
|
|
exit;
|
|
{ must return a value of the correct type on the evaluation stack }
|
|
case def2regtyp(resdef) of
|
|
R_INTREGISTER,
|
|
R_ADDRESSREGISTER:
|
|
a_load_const_cgpara(list,resdef,0,resloc);
|
|
R_FPUREGISTER:
|
|
case tfloatdef(resdef).floattype of
|
|
s32real:
|
|
list.concat(taicpu.op_none(a_fconst_0));
|
|
s64real:
|
|
list.concat(taicpu.op_none(a_dconst_0));
|
|
else
|
|
internalerror(2011010302);
|
|
end
|
|
else
|
|
internalerror(2011010301);
|
|
end;
|
|
end;
|
|
|
|
function thlcgjvm.prepare_stack_for_ref(list: TAsmList; const ref: treference; dup: boolean): longint;
|
|
var
|
|
href: treference;
|
|
begin
|
|
result:=0;
|
|
{ fake location that indicates the value is already on the stack? }
|
|
if (ref.base=NR_EVAL_STACK_BASE) then
|
|
exit;
|
|
if ref.arrayreftype=art_none then
|
|
begin
|
|
{ non-array accesses cannot have an index reg }
|
|
if ref.index<>NR_NO then
|
|
internalerror(2010120509);
|
|
if (ref.base<>NR_NO) then
|
|
begin
|
|
if (ref.base<>NR_STACK_POINTER_REG) then
|
|
begin
|
|
{ regular field -> load self on the stack }
|
|
a_load_reg_stack(list,voidpointertype,ref.base);
|
|
if dup then
|
|
begin
|
|
list.concat(taicpu.op_none(a_dup));
|
|
incstack(list,1);
|
|
end;
|
|
{ field name/type encoded in symbol, no index/offset }
|
|
if not assigned(ref.symbol) or
|
|
(ref.offset<>0) then
|
|
internalerror(2010120524);
|
|
result:=1;
|
|
end
|
|
else
|
|
begin
|
|
{ local variable -> offset encoded in opcode and nothing to
|
|
do here, except for checking that it's a valid reference }
|
|
if assigned(ref.symbol) then
|
|
internalerror(2010120523);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ static field -> nothing to do here, except for validity check }
|
|
if not assigned(ref.symbol) or
|
|
(ref.offset<>0) then
|
|
internalerror(2010120525);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ arrays have implicit dereference -> pointer to array must have been
|
|
loaded into base reg }
|
|
if (ref.base=NR_NO) or
|
|
(ref.base=NR_STACK_POINTER_REG) then
|
|
internalerror(2010120511);
|
|
if assigned(ref.symbol) then
|
|
internalerror(2010120512);
|
|
|
|
{ stack: ... -> ..., arrayref, index }
|
|
{ load array base address }
|
|
a_load_reg_stack(list,voidpointertype,ref.base);
|
|
{ index can either be in a register, or located in a simple memory
|
|
location (since we have to load it anyway) }
|
|
if ref.arrayreftype=art_indexreg then
|
|
begin
|
|
if ref.index=NR_NO then
|
|
internalerror(2010120513);
|
|
{ all array indices in Java are 32 bit ints }
|
|
a_load_reg_stack(list,s32inttype,ref.index);
|
|
end
|
|
else
|
|
begin
|
|
reference_reset_base(href,ref.indexbase,ref.indexoffset,4);
|
|
href.symbol:=href.indexsymbol;
|
|
a_load_ref_stack(list,s32inttype,href,prepare_stack_for_ref(list,href,false));
|
|
end;
|
|
{ adjustment of the index }
|
|
if ref.offset<>0 then
|
|
a_op_const_stack(list,OP_ADD,s32inttype,ref.offset);
|
|
if dup then
|
|
begin
|
|
list.concat(taicpu.op_none(a_dup2));
|
|
incstack(list,2);
|
|
end;
|
|
result:=2;
|
|
end;
|
|
end;
|
|
|
|
procedure thlcgjvm.a_load_const_reg(list: TAsmList; tosize: tdef; a: aint; register: tregister);
|
|
begin
|
|
a_load_const_stack(list,tosize,a,def2regtyp(tosize));
|
|
a_load_stack_reg(list,tosize,register);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_load_const_ref(list: TAsmList; tosize: tdef; a: aint; const ref: treference);
|
|
var
|
|
extra_slots: longint;
|
|
begin
|
|
extra_slots:=prepare_stack_for_ref(list,ref,false);
|
|
a_load_const_stack(list,tosize,a,def2regtyp(tosize));
|
|
a_load_stack_ref(list,tosize,ref,extra_slots);
|
|
decstack(list,extra_slots);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_load_reg_ref(list: TAsmList; fromsize, tosize: tdef; register: tregister; const ref: treference);
|
|
var
|
|
extra_slots: longint;
|
|
begin
|
|
extra_slots:=prepare_stack_for_ref(list,ref,false);
|
|
a_load_reg_stack(list,fromsize,register);
|
|
a_load_stack_ref(list,tosize,ref,extra_slots);
|
|
decstack(list,extra_slots);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_load_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
|
|
begin
|
|
a_load_reg_stack(list,fromsize,reg1);
|
|
if def2regtyp(fromsize)=R_INTREGISTER then
|
|
resize_stack_int_val(list,def_cgsize(fromsize),def_cgsize(tosize),false);
|
|
a_load_stack_reg(list,tosize,reg2);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_load_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; register: tregister);
|
|
var
|
|
extra_slots: longint;
|
|
begin
|
|
extra_slots:=prepare_stack_for_ref(list,ref,false);
|
|
a_load_ref_stack(list,fromsize,ref,extra_slots);
|
|
|
|
if def2regtyp(fromsize)=R_INTREGISTER then
|
|
resize_stack_int_val(list,def_cgsize(fromsize),def_cgsize(tosize),false);
|
|
a_load_stack_reg(list,tosize,register);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_load_ref_ref(list: TAsmList; fromsize, tosize: tdef; const sref: treference; const dref: treference);
|
|
var
|
|
extra_sslots,
|
|
extra_dslots: longint;
|
|
begin
|
|
{ make sure the destination reference is on top, since in the end the
|
|
order has to be "destref, value" -> first create "destref, sourceref" }
|
|
extra_dslots:=prepare_stack_for_ref(list,dref,false);
|
|
extra_sslots:=prepare_stack_for_ref(list,sref,false);
|
|
a_load_ref_stack(list,fromsize,sref,extra_sslots);
|
|
if def2regtyp(fromsize)=R_INTREGISTER then
|
|
resize_stack_int_val(list,def_cgsize(fromsize),def_cgsize(tosize),dref.arrayreftype<>art_none);
|
|
a_load_stack_ref(list,tosize,dref,extra_dslots);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_loadaddr_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; r: tregister);
|
|
begin
|
|
internalerror(2010120534);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: Aint; reg: TRegister);
|
|
begin
|
|
a_op_const_reg_reg(list,op,size,a,reg,reg);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: aint; src, dst: tregister);
|
|
begin
|
|
a_load_reg_stack(list,size,src);
|
|
a_op_const_stack(list,op,size,a);
|
|
a_load_stack_reg(list,size,dst);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_op_const_ref(list: TAsmList; Op: TOpCG; size: tdef; a: Aint; const ref: TReference);
|
|
var
|
|
extra_slots: longint;
|
|
begin
|
|
extra_slots:=prepare_stack_for_ref(list,ref,true);
|
|
{ TODO, here or in peepholeopt: use iinc when possible }
|
|
a_load_ref_stack(list,size,ref,extra_slots);
|
|
a_op_const_stack(list,op,size,a);
|
|
a_load_stack_ref(list,size,ref,extra_slots);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_op_ref_reg(list: TAsmList; Op: TOpCG; size: tdef; const ref: TReference; reg: TRegister);
|
|
begin
|
|
a_load_reg_stack(list,size,reg);
|
|
a_op_ref_stack(list,op,size,ref);
|
|
a_load_stack_reg(list,size,reg);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister);
|
|
begin
|
|
a_load_reg_stack(list,size,src2);
|
|
a_op_reg_stack(list,op,size,src1);
|
|
a_load_stack_reg(list,size,dst);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister);
|
|
begin
|
|
a_op_reg_reg_reg(list,op,size,reg1,reg2,reg2);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_cmp_const_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: aint; const ref: treference; l: tasmlabel);
|
|
begin
|
|
if ref.base<>NR_EVAL_STACK_BASE then
|
|
a_load_ref_stack(list,size,ref,prepare_stack_for_ref(list,ref,false));
|
|
maybe_adjust_cmp_stackval(list,size,cmp_op);
|
|
a_load_const_stack(list,size,maybe_adjust_cmp_constval(size,cmp_op,a),R_INTREGISTER);
|
|
a_cmp_stack_label(list,size,cmp_op,l);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: aint; reg: tregister; l: tasmlabel);
|
|
begin
|
|
a_load_reg_stack(list,size,reg);
|
|
maybe_adjust_cmp_stackval(list,size,cmp_op);
|
|
a_load_const_stack(list,size,maybe_adjust_cmp_constval(size,cmp_op,a),R_INTREGISTER);
|
|
a_cmp_stack_label(list,size,cmp_op,l);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_cmp_ref_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister; l: tasmlabel);
|
|
begin
|
|
a_load_reg_stack(list,size,reg);
|
|
maybe_adjust_cmp_stackval(list,size,cmp_op);
|
|
if ref.base<>NR_EVAL_STACK_BASE then
|
|
a_load_ref_stack(list,size,ref,prepare_stack_for_ref(list,ref,false))
|
|
else
|
|
list.concat(taicpu.op_none(a_swap));
|
|
maybe_adjust_cmp_stackval(list,size,cmp_op);
|
|
a_cmp_stack_label(list,size,cmp_op,l);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_cmp_reg_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference; l: tasmlabel);
|
|
begin
|
|
if ref.base<>NR_EVAL_STACK_BASE then
|
|
a_load_ref_stack(list,size,ref,prepare_stack_for_ref(list,ref,false));
|
|
maybe_adjust_cmp_stackval(list,size,cmp_op);
|
|
a_load_reg_stack(list,size,reg);
|
|
maybe_adjust_cmp_stackval(list,size,cmp_op);
|
|
a_cmp_stack_label(list,size,cmp_op,l);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel);
|
|
begin
|
|
a_load_reg_stack(list,size,reg2);
|
|
maybe_adjust_cmp_stackval(list,size,cmp_op);
|
|
a_load_reg_stack(list,size,reg1);
|
|
maybe_adjust_cmp_stackval(list,size,cmp_op);
|
|
a_cmp_stack_label(list,size,cmp_op,l);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_jmp_always(list: TAsmList; l: tasmlabel);
|
|
begin
|
|
list.concat(taicpu.op_sym(a_goto,current_asmdata.RefAsmSymbol(l.name)));
|
|
end;
|
|
|
|
procedure thlcgjvm.a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1, ref2: treference);
|
|
var
|
|
dstack_slots: longint;
|
|
begin
|
|
dstack_slots:=prepare_stack_for_ref(list,ref2,false);
|
|
a_load_ref_stack(list,fromsize,ref1,prepare_stack_for_ref(list,ref1,false));
|
|
resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
|
|
a_load_stack_ref(list,tosize,ref2,dstack_slots);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister);
|
|
begin
|
|
a_load_ref_stack(list,fromsize,ref,prepare_stack_for_ref(list,ref,false));
|
|
resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
|
|
a_load_stack_reg(list,tosize,reg);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference);
|
|
var
|
|
dstack_slots: longint;
|
|
begin
|
|
dstack_slots:=prepare_stack_for_ref(list,ref,false);
|
|
a_load_reg_stack(list,fromsize,reg);
|
|
resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
|
|
a_load_stack_ref(list,tosize,ref,dstack_slots);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
|
|
begin
|
|
a_load_reg_stack(list,fromsize,reg1);
|
|
resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
|
|
a_load_stack_reg(list,tosize,reg2);
|
|
end;
|
|
|
|
procedure thlcgjvm.g_proc_entry(list: TAsmList; localsize: longint; nostackframe: boolean);
|
|
begin
|
|
{ the localsize is based on tg.lasttemp -> already in terms of stack
|
|
slots rather than bytes }
|
|
list.concat(tai_directive.Create(asd_jlimit,'locals '+tostr(localsize)));
|
|
list.concat(tai_directive.Create(asd_jlimit,'stack '+tostr(fmaxevalstackheight)));
|
|
end;
|
|
|
|
procedure thlcgjvm.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean);
|
|
var
|
|
retdef: tdef;
|
|
opc: tasmop;
|
|
begin
|
|
if current_procinfo.procdef.proctypeoption=potype_constructor then
|
|
retdef:=voidtype
|
|
else
|
|
retdef:=current_procinfo.procdef.returndef;
|
|
case retdef.typ of
|
|
orddef:
|
|
case torddef(retdef).ordtype of
|
|
uvoid:
|
|
opc:=a_return;
|
|
s64bit,
|
|
u64bit,
|
|
scurrency:
|
|
opc:=a_lreturn;
|
|
else
|
|
opc:=a_ireturn;
|
|
end;
|
|
floatdef:
|
|
case tfloatdef(retdef).floattype of
|
|
s32real:
|
|
opc:=a_freturn;
|
|
s64real:
|
|
opc:=a_dreturn;
|
|
else
|
|
internalerror(2011010213);
|
|
end;
|
|
else
|
|
opc:=a_areturn;
|
|
end;
|
|
list.concat(taicpu.op_none(opc));
|
|
end;
|
|
|
|
procedure thlcgjvm.gen_load_return_value(list: TAsmList);
|
|
begin
|
|
{ constructors don't return anything in the jvm }
|
|
if current_procinfo.procdef.proctypeoption=potype_constructor then
|
|
exit;
|
|
inherited gen_load_return_value(list);
|
|
end;
|
|
|
|
procedure thlcgjvm.record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList);
|
|
begin
|
|
{ add something to the al_procedures list as well, because if all al_*
|
|
lists are empty, the assembler writer isn't called }
|
|
if not code.empty and
|
|
current_asmdata.asmlists[al_procedures].empty then
|
|
current_asmdata.asmlists[al_procedures].concat(tai_align.Create(4));
|
|
pd.exprasmlist:=TAsmList.create;
|
|
pd.exprasmlist.concatlist(code);
|
|
if assigned(data) and
|
|
not data.empty then
|
|
internalerror(2010122801);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_load_stack_reg(list: TAsmList; size: tdef; reg: tregister);
|
|
var
|
|
opc: tasmop;
|
|
finishandval: aint;
|
|
begin
|
|
opc:=loadstoreopc(size,false,false,finishandval);
|
|
list.concat(taicpu.op_reg(opc,reg));
|
|
decstack(list,1+ord(size.size>4));
|
|
end;
|
|
|
|
procedure thlcgjvm.a_load_stack_ref(list: TAsmList; size: tdef; const ref: treference; extra_slots: longint);
|
|
var
|
|
opc: tasmop;
|
|
finishandval: aint;
|
|
begin
|
|
{ fake location that indicates the value has to remain on the stack }
|
|
if ref.base=NR_EVAL_STACK_BASE then
|
|
exit;
|
|
opc:=loadstoreopcref(size,false,ref,finishandval);
|
|
if ref.arrayreftype=art_none then
|
|
list.concat(taicpu.op_ref(opc,ref))
|
|
else
|
|
list.concat(taicpu.op_none(opc));
|
|
decstack(list,1+ord(size.size>4)+extra_slots);
|
|
end;
|
|
|
|
procedure thlcgjvm.a_load_reg_stack(list: TAsmList; size: tdef; reg: tregister);
|
|
var
|
|
opc: tasmop;
|
|
finishandval: aint;
|
|
begin
|
|
opc:=loadstoreopc(size,true,false,finishandval);
|
|
list.concat(taicpu.op_reg(opc,reg));
|
|
if finishandval<>-1 then
|
|
a_op_const_stack(list,OP_AND,size,finishandval);
|
|
incstack(list,1+ord(size.size>4));
|
|
end;
|
|
|
|
procedure thlcgjvm.a_load_ref_stack(list: TAsmList; size: tdef; const ref: treference; extra_slots: longint);
|
|
var
|
|
opc: tasmop;
|
|
finishandval: aint;
|
|
begin
|
|
{ fake location that indicates the value is already on the stack? }
|
|
if (ref.base=NR_EVAL_STACK_BASE) then
|
|
exit;
|
|
opc:=loadstoreopcref(size,true,ref,finishandval);
|
|
if ref.arrayreftype=art_none then
|
|
list.concat(taicpu.op_ref(opc,ref))
|
|
else
|
|
list.concat(taicpu.op_none(opc));
|
|
if finishandval<>-1 then
|
|
a_op_const_stack(list,OP_AND,size,finishandval);
|
|
incstack(list,1+ord(size.size>4)-extra_slots);
|
|
end;
|
|
|
|
function thlcgjvm.loadstoreopcref(def: tdef; isload: boolean; const ref: treference; out finishandval: aint): tasmop;
|
|
const
|
|
{ isload static }
|
|
getputopc: array[boolean,boolean] of tasmop =
|
|
((a_putfield,a_putstatic),
|
|
(a_getfield,a_getstatic));
|
|
var
|
|
size: aint;
|
|
begin
|
|
if assigned(ref.symbol) then
|
|
begin
|
|
finishandval:=-1;
|
|
{ -> either a global (static) field, or a regular field. If a regular
|
|
field, then ref.base contains the self pointer, otherwise
|
|
ref.base=NR_NO. In both cases, the symbol contains all other
|
|
information (combined field name and type descriptor) }
|
|
result:=getputopc[isload,ref.base=NR_NO];
|
|
end
|
|
else
|
|
result:=loadstoreopc(def,isload,ref.arrayreftype<>art_none,finishandval);
|
|
end;
|
|
|
|
function thlcgjvm.loadstoreopc(def: tdef; isload, isarray: boolean; out finishandval: aint): tasmop;
|
|
var
|
|
size: longint;
|
|
begin
|
|
finishandval:=-1;
|
|
case def2regtyp(def) of
|
|
R_INTREGISTER:
|
|
begin
|
|
size:=def.size;
|
|
if not isarray then
|
|
begin
|
|
case size of
|
|
1,2,3,4:
|
|
if isload then
|
|
result:=a_iload
|
|
else
|
|
result:=a_istore;
|
|
8:
|
|
if isload then
|
|
result:=a_lload
|
|
else
|
|
result:=a_lstore;
|
|
end;
|
|
end
|
|
{ array }
|
|
else if isload then
|
|
begin
|
|
case size of
|
|
1:
|
|
begin
|
|
result:=a_baload;
|
|
if not is_signed(def) then
|
|
finishandval:=255;
|
|
end;
|
|
2:
|
|
begin
|
|
if is_widechar(def) then
|
|
result:=a_caload
|
|
else
|
|
begin
|
|
result:=a_saload;
|
|
{ if we'd treat arrays of word as "array of widechar" we
|
|
could use a_caload, but that would make for even more
|
|
awkward interfacing with external Java code }
|
|
if not is_signed(def) then
|
|
finishandval:=65535;
|
|
end;
|
|
end;
|
|
4: result:=a_iaload;
|
|
8: result:=a_laload;
|
|
else
|
|
internalerror(2010120503);
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
case size of
|
|
1: result:=a_bastore;
|
|
2: if not is_widechar(def) then
|
|
result:=a_sastore
|
|
else
|
|
result:=a_castore;
|
|
4: result:=a_iastore;
|
|
8: result:=a_lastore;
|
|
else
|
|
internalerror(2010120508);
|
|
end
|
|
end
|
|
end;
|
|
R_ADDRESSREGISTER:
|
|
if not isarray then
|
|
if isload then
|
|
result:=a_aload
|
|
else
|
|
result:=a_astore
|
|
else if isload then
|
|
result:=a_aaload
|
|
else
|
|
result:=a_aastore;
|
|
R_FPUREGISTER:
|
|
begin
|
|
case tfloatdef(def).floattype of
|
|
s32real:
|
|
if not isarray then
|
|
if isload then
|
|
result:=a_fload
|
|
else
|
|
result:=a_fstore
|
|
else if isload then
|
|
result:=a_faload
|
|
else
|
|
result:=a_fastore;
|
|
s64real:
|
|
if not isarray then
|
|
if isload then
|
|
result:=a_dload
|
|
else
|
|
result:=a_dstore
|
|
else if isload then
|
|
result:=a_daload
|
|
else
|
|
result:=a_dastore;
|
|
else
|
|
internalerror(2010120504);
|
|
end
|
|
end
|
|
else
|
|
internalerror(2010120502);
|
|
end;
|
|
end;
|
|
|
|
procedure thlcgjvm.resize_stack_int_val(list: TAsmList; fromsize, tosize: tcgsize; forarraystore: boolean);
|
|
begin
|
|
if fromsize in [OS_S64,OS_64] then
|
|
begin
|
|
if not(tosize in [OS_S64,OS_64]) then
|
|
begin
|
|
{ truncate }
|
|
list.concat(taicpu.op_none(a_l2i));
|
|
decstack(list,1);
|
|
end;
|
|
end
|
|
else if tosize in [OS_S64,OS_64] then
|
|
begin
|
|
{ extend }
|
|
list.concat(taicpu.op_none(a_i2l));
|
|
incstack(list,1);
|
|
{ if it was an unsigned 32 bit value, remove sign extension }
|
|
if fromsize=OS_32 then
|
|
a_op_const_stack(list,OP_AND,s64inttype,cardinal($ffffffff));
|
|
end;
|
|
{ if the value is immediately stored to an array afterwards, the store
|
|
instruction will properly truncate the value; otherwise we may need
|
|
additional truncation, except for 64/32 bit conversions, which are
|
|
already handled above }
|
|
if not forarraystore and
|
|
(not(fromsize in [OS_S64,OS_64,OS_32,OS_S32]) or
|
|
not(tosize in [OS_S64,OS_64,OS_32,OS_S32])) and
|
|
(tcgsize2size[fromsize]>tcgsize2size[tosize]) or
|
|
((tcgsize2size[fromsize]=tcgsize2size[tosize]) and
|
|
(fromsize<>tosize)) or
|
|
{ needs to mask out the sign in the top 16 bits }
|
|
((fromsize=OS_S8) and
|
|
(tosize=OS_16)) then
|
|
case tosize of
|
|
OS_8:
|
|
a_op_const_stack(list,OP_AND,s32inttype,255);
|
|
OS_S8:
|
|
list.concat(taicpu.op_none(a_i2b));
|
|
OS_16:
|
|
list.concat(taicpu.op_none(a_i2c));
|
|
OS_S16:
|
|
list.concat(taicpu.op_none(a_i2s));
|
|
end;
|
|
end;
|
|
|
|
procedure thlcgjvm.resizestackfpuval(list: TAsmList; fromsize, tosize: tcgsize);
|
|
begin
|
|
if (fromsize=OS_F32) and
|
|
(tosize=OS_F64) then
|
|
begin
|
|
list.concat(taicpu.op_none(a_f2d));
|
|
incstack(list,1);
|
|
end
|
|
else if (fromsize=OS_F64) and
|
|
(tosize=OS_F32) then
|
|
begin
|
|
list.concat(taicpu.op_none(a_d2f));
|
|
decstack(list,1);
|
|
end;
|
|
end;
|
|
|
|
procedure thlcgjvm.maybepreparedivu32(list: TAsmList; var op: topcg; size: tdef; out isdivu32: boolean);
|
|
begin
|
|
if (op=OP_DIV) and
|
|
(def_cgsize(size)=OS_32) then
|
|
begin
|
|
{ needs zero-extension to 64 bit, because the JVM only supports
|
|
signed divisions }
|
|
resize_stack_int_val(list,OS_32,OS_S64,false);
|
|
op:=OP_IDIV;
|
|
isdivu32:=true;
|
|
end
|
|
else
|
|
isdivu32:=false;
|
|
end;
|
|
|
|
procedure thlcgjvm.a_call_name_intern(list: TAsmList; pd: tprocdef; const s: string; inheritedcall: boolean);
|
|
var
|
|
opc: tasmop;
|
|
begin
|
|
{
|
|
invoke types:
|
|
* invokeinterface: call method from an interface
|
|
* invokespecial: invoke a constructor, method in a superclass,
|
|
or private instance method
|
|
* invokestatic: invoke a class method (private or not)
|
|
* invokevirtual: invoke a regular method
|
|
}
|
|
case pd.owner.symtabletype of
|
|
globalsymtable,
|
|
staticsymtable,
|
|
localsymtable:
|
|
{ regular and nested procedures are turned into static methods }
|
|
opc:=a_invokestatic;
|
|
objectsymtable:
|
|
begin
|
|
case tobjectdef(pd.owner.defowner).objecttype of
|
|
odt_javaclass:
|
|
begin
|
|
if (po_staticmethod in pd.procoptions) then
|
|
opc:=a_invokestatic
|
|
else if (pd.visibility=vis_private) or
|
|
(pd.proctypeoption=potype_constructor) or
|
|
inheritedcall then
|
|
opc:=a_invokespecial
|
|
else
|
|
opc:=a_invokevirtual;
|
|
end;
|
|
odt_interfacejava:
|
|
{ static interface methods are not allowed }
|
|
opc:=a_invokeinterface;
|
|
else
|
|
internalerror(2010122601);
|
|
end;
|
|
end;
|
|
else
|
|
internalerror(2010122602);
|
|
end;
|
|
list.concat(taicpu.op_sym(opc,current_asmdata.RefAsmSymbol(s)));
|
|
end;
|
|
|
|
procedure create_hlcodegen;
|
|
begin
|
|
hlcg:=thlcgjvm.create;
|
|
create_codegen;
|
|
end;
|
|
|
|
end.
|