mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-15 21:19:26 +02:00
+ full support for overflow checking on the JVM target (note: significantly
increases code size, because not natively supported by the JVM) git-svn-id: trunk@22808 -
This commit is contained in:
Jonas Maebe
parent
1adeec6212
commit
29263eb343
@ -69,6 +69,8 @@ uses
|
||||
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_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: aint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); override;
|
||||
procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation); 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;
|
||||
@ -97,6 +99,9 @@ uses
|
||||
procedure g_initialize(list : TAsmList;t : tdef;const ref : treference);override;
|
||||
procedure g_finalize(list : TAsmList;t : tdef;const ref : treference);override;
|
||||
|
||||
procedure g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); override;
|
||||
procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation); override;
|
||||
|
||||
procedure location_get_data_ref(list:TAsmList;def: tdef; const l:tlocation;var ref:treference;loadref:boolean; alignment: longint);override;
|
||||
procedure g_copyvaluepara_openarray(list: TAsmList; const ref: treference; const lenloc: tlocation; arrdef: tarraydef; destreg: tregister); override;
|
||||
procedure g_releasevaluepara_openarray(list: TAsmList; arrdef: tarraydef; const l: tlocation); override;
|
||||
@ -170,7 +175,6 @@ uses
|
||||
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;
|
||||
|
||||
procedure gen_initialize_fields_code(list:TAsmList);
|
||||
@ -1164,6 +1168,105 @@ implementation
|
||||
a_op_reg_reg_reg(list,op,size,reg1,reg2,reg2);
|
||||
end;
|
||||
|
||||
procedure thlcgjvm.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: aint; src, dst: tregister; setflags: boolean; var ovloc: tlocation);
|
||||
var
|
||||
tmpreg: tregister;
|
||||
begin
|
||||
if not setflags then
|
||||
begin
|
||||
inherited;
|
||||
exit;
|
||||
end;
|
||||
tmpreg:=getintregister(list,size);
|
||||
a_load_const_reg(list,size,a,tmpreg);
|
||||
a_op_reg_reg_reg_checkoverflow(list,op,size,tmpreg,src,dst,true,ovloc);
|
||||
end;
|
||||
|
||||
procedure thlcgjvm.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation);
|
||||
var
|
||||
orgsrc1, orgsrc2: tregister;
|
||||
docheck: boolean;
|
||||
lab: tasmlabel;
|
||||
begin
|
||||
if not setflags then
|
||||
begin
|
||||
inherited;
|
||||
exit;
|
||||
end;
|
||||
{ anything else cannot overflow }
|
||||
docheck:=size.size in [4,8];
|
||||
if docheck then
|
||||
begin
|
||||
orgsrc1:=src1;
|
||||
orgsrc2:=src2;
|
||||
if src1=dst then
|
||||
begin
|
||||
orgsrc1:=getintregister(list,size);
|
||||
a_load_reg_reg(list,size,size,src1,orgsrc1);
|
||||
end;
|
||||
if src2=dst then
|
||||
begin
|
||||
orgsrc2:=getintregister(list,size);
|
||||
a_load_reg_reg(list,size,size,src2,orgsrc2);
|
||||
end;
|
||||
end;
|
||||
a_op_reg_reg_reg(list,op,size,src1,src2,dst);
|
||||
if docheck then
|
||||
begin
|
||||
{ * signed overflow for addition iff
|
||||
- src1 and src2 are negative and result is positive (excep in case of
|
||||
subtraction, then sign of src1 has to be inverted)
|
||||
- src1 and src2 are positive and result is negative
|
||||
-> Simplified boolean equivalent (in terms of sign bits):
|
||||
not(src1 xor src2) and (src1 xor dst)
|
||||
|
||||
for subtraction, multiplication: invert src1 sign bit
|
||||
for division: handle separately (div by zero, low(inttype) div -1),
|
||||
not supported by this code
|
||||
|
||||
* unsigned overflow iff carry out, aka dst < src1 or dst < src2
|
||||
}
|
||||
location_reset(ovloc,LOC_REGISTER,OS_S32);
|
||||
{ not pasbool8, because then we'd still have to convert the integer to
|
||||
a boolean via branches for Dalvik}
|
||||
ovloc.register:=getintregister(list,s32inttype);
|
||||
if not ((size.typ=pointerdef) or
|
||||
((size.typ=orddef) and
|
||||
(torddef(size).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
|
||||
pasbool8,pasbool16,pasbool32,pasbool64]))) then
|
||||
begin
|
||||
a_load_reg_stack(list,size,src1);
|
||||
if op in [OP_SUB,OP_IMUL] then
|
||||
a_op_stack(list,OP_NOT,size,false);
|
||||
a_op_reg_stack(list,OP_XOR,size,src2);
|
||||
a_op_stack(list,OP_NOT,size,false);
|
||||
a_load_reg_stack(list,size,src1);
|
||||
a_op_reg_stack(list,OP_XOR,size,dst);
|
||||
a_op_stack(list,OP_AND,size,false);
|
||||
a_op_const_stack(list,OP_SHR,size,(size.size*8)-1);
|
||||
if size.size=8 then
|
||||
begin
|
||||
list.concat(taicpu.op_none(a_l2i));
|
||||
decstack(list,1);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
a_load_const_stack(list,s32inttype,0,R_INTREGISTER);
|
||||
current_asmdata.getjumplabel(lab);
|
||||
{ can be optimized by removing duplicate xor'ing to convert dst from
|
||||
signed to unsigned quadrant }
|
||||
a_cmp_reg_reg_label(list,size,OC_B,dst,src1,lab);
|
||||
a_cmp_reg_reg_label(list,size,OC_B,dst,src2,lab);
|
||||
a_op_const_stack(list,OP_XOR,s32inttype,1);
|
||||
a_label(list,lab);
|
||||
end;
|
||||
a_load_stack_reg(list,s32inttype,ovloc.register);
|
||||
end
|
||||
else
|
||||
ovloc.loc:=LOC_VOID;
|
||||
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
|
||||
@ -1619,6 +1722,24 @@ implementation
|
||||
// do nothing
|
||||
end;
|
||||
|
||||
procedure thlcgjvm.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef);
|
||||
begin
|
||||
{ not possible, need the original operands }
|
||||
internalerror(2012102101);
|
||||
end;
|
||||
|
||||
procedure thlcgjvm.g_overflowCheck_loc(List: TAsmList; const Loc: TLocation; def: TDef; var ovloc: tlocation);
|
||||
var
|
||||
hl : tasmlabel;
|
||||
begin
|
||||
if not(cs_check_overflow in current_settings.localswitches) then
|
||||
exit;
|
||||
current_asmdata.getjumplabel(hl);
|
||||
a_cmp_const_loc_label(list,s32inttype,OC_EQ,0,ovloc,hl);
|
||||
g_call_system_proc(list,'fpc_overflow',nil);
|
||||
a_label(list,hl);
|
||||
end;
|
||||
|
||||
procedure thlcgjvm.location_get_data_ref(list: TAsmList; def: tdef; const l: tlocation; var ref: treference; loadref: boolean; alignment: longint);
|
||||
var
|
||||
tmploc: tlocation;
|
||||
|
||||
@ -78,6 +78,9 @@ implementation
|
||||
|
||||
procedure tjvmmoddivnode.pass_generate_code;
|
||||
var
|
||||
tmpreg: tregister;
|
||||
lab: tasmlabel;
|
||||
ovloc: tlocation;
|
||||
op: topcg;
|
||||
isu32int: boolean;
|
||||
begin
|
||||
@ -89,7 +92,6 @@ implementation
|
||||
|
||||
if nodetype=divn then
|
||||
begin
|
||||
{ TODO: overflow checking in case of high(longint) or high(int64) div -1 }
|
||||
thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location);
|
||||
if is_signed(resultdef) then
|
||||
op:=OP_IDIV
|
||||
@ -141,6 +143,24 @@ implementation
|
||||
thlcgjvm(hlcg).resize_stack_int_val(current_asmdata.CurrAsmList,s64inttype,u32inttype,false);
|
||||
end;
|
||||
thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
|
||||
if (cs_check_overflow in current_settings.localswitches) and
|
||||
is_signed(resultdef) then
|
||||
begin
|
||||
{ the JVM raises an exception for integer div-iby-zero -> only
|
||||
overflow in case left is low(inttype) and right is -1 ->
|
||||
check by adding high(inttype) to left and and'ing with right
|
||||
-> result is -1 only in case above conditions are fulfilled)
|
||||
}
|
||||
tmpreg:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
|
||||
hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,resultdef,true);
|
||||
hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_ADD,resultdef,torddef(resultdef).high,right.location.register,tmpreg);
|
||||
hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef,true);
|
||||
hlcg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_AND,resultdef,left.location.register,tmpreg);
|
||||
current_asmdata.getjumplabel(lab);
|
||||
hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,resultdef,OC_NE,-1,tmpreg,lab);
|
||||
hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_overflow',nil);
|
||||
hlcg.a_label(current_asmdata.CurrAsmList,lab);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user