+ 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 -

compiler/jvm/hlcgcpu.pas

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

compiler/jvm/njvmmat.pas

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