Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Avoid checking twice if divisor is zero (#702) 

* Avoid checking twice if divisor is zero

The flambda branch before merging assumed that Pdivint and Pmodint where
already checked when entering Cmmgen. This was not the case anymore
after merging and this change was lost. This fix this overlook by adding
an annotation to the Pdivint and Pmodint primitive telling whether the
division by zero was already checked.

The reason to move the test generation to Closure_conversion in the
flambda branch was to allow the division primitive to be considered as
pure without needing to check for the effective value of the
divisor. This simplified Semantics_of_primitives a lot.

* Bigarray div and mod also carry safety information

* Handle bigint div and mod like int div and mod in closure_conversion

* Update Changes

* Test for divisions by zero

* Turn Pdivbint and Pmodbint argument into an inline record
master
Pierre Chambart 2016-10-05 23:42:40 +09:00 committed by Damien Doligez
parent 928a7a9659
commit 575f20368d
14 changed files with 200 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Changes
View File

@ -182,6 +182,10 @@ OCaml 4.04.0:
- GPR#602: Do not generate dummy code to force module linking
(Pierre Chambart, reviewed by Jacques Garrigue)
- PR#7328, GPR#702: Do not eliminate boxed int divisions by zero and
avoid checking twice if divisor is zero with flambda.
(Pierre Chambart, report by Jeremy Yallop)
- GPR#703: Optimize some constant string operations when the "-safe-string"
configure time option is enabled.
(Pierre Chambart)

20
asmcomp/closure.ml
View File

@ -265,8 +265,8 @@ let simplif_arith_prim_pure fpc p (args, approxs) dbg =
| Paddint -> make_const_int (n1 + n2)
| Psubint -> make_const_int (n1 - n2)
| Pmulint -> make_const_int (n1 * n2)
| Pdivint when n2 <> 0 -> make_const_int (n1 / n2)
| Pmodint when n2 <> 0 -> make_const_int (n1 mod n2)
| Pdivint _ when n2 <> 0 -> make_const_int (n1 / n2)
| Pmodint _ when n2 <> 0 -> make_const_int (n1 mod n2)
| Pandint -> make_const_int (n1 land n2)
| Porint -> make_const_int (n1 lor n2)
| Pxorint -> make_const_int (n1 lxor n2)
@ -314,9 +314,9 @@ let simplif_arith_prim_pure fpc p (args, approxs) dbg =
| Paddbint Pnativeint -> make_const_natint (Nativeint.add n1 n2)
| Psubbint Pnativeint -> make_const_natint (Nativeint.sub n1 n2)
| Pmulbint Pnativeint -> make_const_natint (Nativeint.mul n1 n2)
| Pdivbint Pnativeint when n2 <> 0n ->
| Pdivbint {size=Pnativeint} when n2 <> 0n ->
make_const_natint (Nativeint.div n1 n2)
| Pmodbint Pnativeint when n2 <> 0n ->
| Pmodbint {size=Pnativeint} when n2 <> 0n ->
make_const_natint (Nativeint.rem n1 n2)
| Pandbint Pnativeint -> make_const_natint (Nativeint.logand n1 n2)
| Porbint Pnativeint -> make_const_natint (Nativeint.logor n1 n2)
@ -352,8 +352,10 @@ let simplif_arith_prim_pure fpc p (args, approxs) dbg =
| Paddbint Pint32 -> make_const_int32 (Int32.add n1 n2)
| Psubbint Pint32 -> make_const_int32 (Int32.sub n1 n2)
| Pmulbint Pint32 -> make_const_int32 (Int32.mul n1 n2)
| Pdivbint Pint32 when n2 <> 0l -> make_const_int32 (Int32.div n1 n2)
| Pmodbint Pint32 when n2 <> 0l -> make_const_int32 (Int32.rem n1 n2)
| Pdivbint {size=Pint32} when n2 <> 0l ->
make_const_int32 (Int32.div n1 n2)
| Pmodbint {size=Pint32} when n2 <> 0l ->
make_const_int32 (Int32.rem n1 n2)
| Pandbint Pint32 -> make_const_int32 (Int32.logand n1 n2)
| Porbint Pint32 -> make_const_int32 (Int32.logor n1 n2)
| Pxorbint Pint32 -> make_const_int32 (Int32.logxor n1 n2)
@ -388,8 +390,10 @@ let simplif_arith_prim_pure fpc p (args, approxs) dbg =
| Paddbint Pint64 -> make_const_int64 (Int64.add n1 n2)
| Psubbint Pint64 -> make_const_int64 (Int64.sub n1 n2)
| Pmulbint Pint64 -> make_const_int64 (Int64.mul n1 n2)
| Pdivbint Pint64 when n2 <> 0L -> make_const_int64 (Int64.div n1 n2)
| Pmodbint Pint64 when n2 <> 0L -> make_const_int64 (Int64.rem n1 n2)
| Pdivbint {size=Pint64} when n2 <> 0L ->
make_const_int64 (Int64.div n1 n2)
| Pmodbint {size=Pint64} when n2 <> 0L ->
make_const_int64 (Int64.rem n1 n2)
| Pandbint Pint64 -> make_const_int64 (Int64.logand n1 n2)
| Porbint Pint64 -> make_const_int64 (Int64.logor n1 n2)
| Pxorbint Pint64 -> make_const_int64 (Int64.logxor n1 n2)

49
asmcomp/cmmgen.ml
View File

@ -329,7 +329,7 @@ let raise_regular dbg exc =
let raise_symbol dbg symb =
raise_regular dbg (Cconst_symbol symb)
let rec div_int c1 c2 dbg =
let rec div_int c1 c2 is_safe dbg =
match (c1, c2) with
(c1, Cconst_int 0) ->
Csequence(c1, raise_symbol dbg "caml_exn_Division_by_zero")
@ -354,7 +354,7 @@ let rec div_int c1 c2 dbg =
add_int c1 t);
Cconst_int l])
else if n < 0 then
sub_int (Cconst_int 0) (div_int c1 (Cconst_int (-n)) dbg)
sub_int (Cconst_int 0) (div_int c1 (Cconst_int (-n)) is_safe dbg)
else begin
let (m, p) = divimm_parameters (Nativeint.of_int n) in
(* Algorithm:
@ -369,7 +369,7 @@ let rec div_int c1 c2 dbg =
let t = if p > 0 then Cop(Casr, [t; Cconst_int p]) else t in
add_int t (lsr_int c1 (Cconst_int (Nativeint.size - 1))))
end
| (c1, c2) when !Clflags.fast ->
| (c1, c2) when !Clflags.fast || is_safe = Lambda.Unsafe ->
Cop(Cdivi, [c1; c2])
| (c1, c2) ->
bind "divisor" c2 (fun c2 ->
@ -377,7 +377,7 @@ let rec div_int c1 c2 dbg =
Cop(Cdivi, [c1; c2]),
raise_symbol dbg "caml_exn_Division_by_zero"))
let mod_int c1 c2 dbg =
let mod_int c1 c2 is_safe dbg =
match (c1, c2) with
(c1, Cconst_int 0) ->
Csequence(c1, raise_symbol dbg "caml_exn_Division_by_zero")
@ -405,8 +405,9 @@ let mod_int c1 c2 dbg =
sub_int c1 t)
else
bind "dividend" c1 (fun c1 ->
sub_int c1 (mul_int (div_int c1 c2 dbg) c2))
| (c1, c2) when !Clflags.fast ->
sub_int c1 (mul_int (div_int c1 c2 is_safe dbg) c2))
| (c1, c2) when !Clflags.fast || is_safe = Lambda.Unsafe ->
(* Flambda already generates that test *)
Cop(Cmodi, [c1; c2])
| (c1, c2) ->
bind "divisor" c2 (fun c2 ->
@ -422,21 +423,21 @@ let is_different_from x = function
| Cconst_natint n -> n <> Nativeint.of_int x
| _ -> false
let safe_divmod_bi mkop mkm1 c1 c2 bi dbg =
let safe_divmod_bi mkop is_safe mkm1 c1 c2 bi dbg =
bind "dividend" c1 (fun c1 ->
bind "divisor" c2 (fun c2 ->
let c = mkop c1 c2 dbg in
let c = mkop c1 c2 is_safe dbg in
if Arch.division_crashes_on_overflow
&& (size_int = 4 || bi <> Pint32)
&& not (is_different_from (-1) c2)
then Cifthenelse(Cop(Ccmpi Cne, [c2; Cconst_int(-1)]), c, mkm1 c1)
else c))
let safe_div_bi =
safe_divmod_bi div_int (fun c1 -> Cop(Csubi, [Cconst_int 0; c1]))
let safe_div_bi is_safe =
safe_divmod_bi div_int is_safe (fun c1 -> Cop(Csubi, [Cconst_int 0; c1]))
let safe_mod_bi =
safe_divmod_bi mod_int (fun _ -> Cconst_int 0)
let safe_mod_bi is_safe =
safe_divmod_bi mod_int is_safe (fun _ -> Cconst_int 0)
(* Bool *)
@ -1192,8 +1193,8 @@ let simplif_primitive_32bits = function
| Paddbint Pint64 -> Pccall (default_prim "caml_int64_add")
| Psubbint Pint64 -> Pccall (default_prim "caml_int64_sub")
| Pmulbint Pint64 -> Pccall (default_prim "caml_int64_mul")
| Pdivbint Pint64 -> Pccall (default_prim "caml_int64_div")
| Pmodbint Pint64 -> Pccall (default_prim "caml_int64_mod")
| Pdivbint {size=Pint64} -> Pccall (default_prim "caml_int64_div")
| Pmodbint {size=Pint64} -> Pccall (default_prim "caml_int64_mod")
| Pandbint Pint64 -> Pccall (default_prim "caml_int64_and")
| Porbint Pint64 -> Pccall (default_prim "caml_int64_or")
| Pxorbint Pint64 -> Pccall (default_prim "caml_int64_xor")
@ -1412,8 +1413,8 @@ let rec is_unboxed_number ~strict env e =
| Paddbint bi
| Psubbint bi
| Pmulbint bi
| Pdivbint bi
| Pmodbint bi
| Pdivbint {size=bi}
| Pmodbint {size=bi}
| Pandbint bi
| Porbint bi
| Pxorbint bi
@ -1937,12 +1938,12 @@ and transl_prim_2 env p arg1 arg2 dbg =
incr_int (mul_int (untag_int c1) (decr_int c2))
| c1, c2 -> incr_int (mul_int (decr_int c1) (untag_int c2))
end
| Pdivint ->
| Pdivint is_safe ->
tag_int(div_int (untag_int(transl env arg1))
(untag_int(transl env arg2)) dbg)
| Pmodint ->
(untag_int(transl env arg2)) is_safe dbg)
| Pmodint is_safe ->
tag_int(mod_int (untag_int(transl env arg1))
(untag_int(transl env arg2)) dbg)
(untag_int(transl env arg2)) is_safe dbg)
| Pandint ->
Cop(Cand, [transl env arg1; transl env arg2])
| Porint ->
@ -2125,13 +2126,13 @@ and transl_prim_2 env p arg1 arg2 dbg =
box_int dbg bi (Cop(Cmuli,
[transl_unbox_int env bi arg1;
transl_unbox_int env bi arg2]))
| Pdivbint bi ->
box_int dbg bi (safe_div_bi
| Pdivbint { size = bi; is_safe } ->
box_int dbg bi (safe_div_bi is_safe
(transl_unbox_int env bi arg1)
(transl_unbox_int env bi arg2)
bi dbg)
| Pmodbint bi ->
box_int dbg bi (safe_mod_bi
| Pmodbint { size = bi; is_safe } ->
box_int dbg bi (safe_mod_bi is_safe
(transl_unbox_int env bi arg1)
(transl_unbox_int env bi arg2)
bi dbg)

8
bytecomp/bytegen.ml
View File

@ -324,8 +324,8 @@ let comp_primitive p args =
| Paddint -> Kaddint
| Psubint -> Ksubint
| Pmulint -> Kmulint
| Pdivint -> Kdivint
| Pmodint -> Kmodint
| Pdivint _ -> Kdivint
| Pmodint _ -> Kmodint
| Pandint -> Kandint
| Porint -> Korint
| Pxorint -> Kxorint
@ -400,8 +400,8 @@ let comp_primitive p args =
| Paddbint bi -> comp_bint_primitive bi "add" args
| Psubbint bi -> comp_bint_primitive bi "sub" args
| Pmulbint bi -> comp_bint_primitive bi "mul" args
| Pdivbint bi -> comp_bint_primitive bi "div" args
| Pmodbint bi -> comp_bint_primitive bi "mod" args
| Pdivbint { size = bi } -> comp_bint_primitive bi "div" args
| Pmodbint { size = bi } -> comp_bint_primitive bi "mod" args
| Pandbint bi -> comp_bint_primitive bi "and" args
| Porbint bi -> comp_bint_primitive bi "or" args
| Pxorbint bi -> comp_bint_primitive bi "xor" args

11
bytecomp/lambda.ml
View File

@ -42,6 +42,10 @@ type initialization_or_assignment =
| Initialization
| Assignment
type is_safe =
| Safe
| Unsafe
type primitive =
| Pidentity
| Pbytes_to_string
@ -69,7 +73,8 @@ type primitive =
(* Boolean operations *)
| Psequand | Psequor | Pnot
(* Integer operations *)
| Pnegint | Paddint | Psubint | Pmulint | Pdivint | Pmodint
| Pnegint | Paddint | Psubint | Pmulint
| Pdivint of is_safe | Pmodint of is_safe
| Pandint | Porint | Pxorint
| Plslint | Plsrint | Pasrint
| Pintcomp of comparison
@ -105,8 +110,8 @@ type primitive =
| Paddbint of boxed_integer
| Psubbint of boxed_integer
| Pmulbint of boxed_integer
| Pdivbint of boxed_integer
| Pmodbint of boxed_integer
| Pdivbint of { size : boxed_integer; is_safe : is_safe }
| Pmodbint of { size : boxed_integer; is_safe : is_safe }
| Pandbint of boxed_integer
| Porbint of boxed_integer
| Pxorbint of boxed_integer

11
bytecomp/lambda.mli
View File

@ -45,6 +45,10 @@ type initialization_or_assignment =
| Initialization
| Assignment
type is_safe =
| Safe
| Unsafe
type primitive =
| Pidentity
| Pbytes_to_string
@ -72,7 +76,8 @@ type primitive =
(* Boolean operations *)
| Psequand | Psequor | Pnot
(* Integer operations *)
| Pnegint | Paddint | Psubint | Pmulint | Pdivint | Pmodint
| Pnegint | Paddint | Psubint | Pmulint
| Pdivint of is_safe | Pmodint of is_safe
| Pandint | Porint | Pxorint
| Plslint | Plsrint | Pasrint
| Pintcomp of comparison
@ -111,8 +116,8 @@ type primitive =
| Paddbint of boxed_integer
| Psubbint of boxed_integer
| Pmulbint of boxed_integer
| Pdivbint of boxed_integer
| Pmodbint of boxed_integer
| Pdivbint of { size : boxed_integer; is_safe : is_safe }
| Pmodbint of { size : boxed_integer; is_safe : is_safe }
| Pandbint of boxed_integer
| Porbint of boxed_integer
| Pxorbint of boxed_integer

20
bytecomp/printlambda.ml
View File

@ -174,8 +174,10 @@ let primitive ppf = function
| Paddint -> fprintf ppf "+"
| Psubint -> fprintf ppf "-"
| Pmulint -> fprintf ppf "*"
| Pdivint -> fprintf ppf "/"
| Pmodint -> fprintf ppf "mod"
| Pdivint Safe -> fprintf ppf "/"
| Pdivint Unsafe -> fprintf ppf "/u"
| Pmodint Safe -> fprintf ppf "mod"
| Pmodint Unsafe -> fprintf ppf "mod_unsafe"
| Pandint -> fprintf ppf "and"
| Porint -> fprintf ppf "or"
| Pxorint -> fprintf ppf "xor"
@ -243,8 +245,14 @@ let primitive ppf = function
| Paddbint bi -> print_boxed_integer "add" ppf bi
| Psubbint bi -> print_boxed_integer "sub" ppf bi
| Pmulbint bi -> print_boxed_integer "mul" ppf bi
| Pdivbint bi -> print_boxed_integer "div" ppf bi
| Pmodbint bi -> print_boxed_integer "mod" ppf bi
| Pdivbint { size = bi; is_safe = Safe } ->
print_boxed_integer "div" ppf bi
| Pdivbint { size = bi; is_safe = Unsafe } ->
print_boxed_integer "div_unsafe" ppf bi
| Pmodbint { size = bi; is_safe = Safe } ->
print_boxed_integer "mod" ppf bi
| Pmodbint { size = bi; is_safe = Unsafe } ->
print_boxed_integer "mod_unsafe" ppf bi
| Pandbint bi -> print_boxed_integer "and" ppf bi
| Porbint bi -> print_boxed_integer "or" ppf bi
| Pxorbint bi -> print_boxed_integer "xor" ppf bi
@ -329,8 +337,8 @@ let name_of_primitive = function
| Paddint -> "Paddint"
| Psubint -> "Psubint"
| Pmulint -> "Pmulint"
| Pdivint -> "Pdivint"
| Pmodint -> "Pmodint"
| Pdivint _ -> "Pdivint"
| Pmodint _ -> "Pmodint"
| Pandint -> "Pandint"
| Porint -> "Porint"
| Pxorint -> "Pxorint"

16
bytecomp/translcore.ml
View File

@ -199,8 +199,8 @@ let primitives_table = create_hashtable 57 [
"%addint", Paddint;
"%subint", Psubint;
"%mulint", Pmulint;
"%divint", Pdivint;
"%modint", Pmodint;
"%divint", Pdivint Safe;
"%modint", Pmodint Safe;
"%andint", Pandint;
"%orint", Porint;
"%xorint", Pxorint;
@ -253,8 +253,8 @@ let primitives_table = create_hashtable 57 [
"%nativeint_add", Paddbint Pnativeint;
"%nativeint_sub", Psubbint Pnativeint;
"%nativeint_mul", Pmulbint Pnativeint;
"%nativeint_div", Pdivbint Pnativeint;
"%nativeint_mod", Pmodbint Pnativeint;
"%nativeint_div", Pdivbint { size = Pnativeint; is_safe = Safe };
"%nativeint_mod", Pmodbint { size = Pnativeint; is_safe = Safe };
"%nativeint_and", Pandbint Pnativeint;
"%nativeint_or", Porbint Pnativeint;
"%nativeint_xor", Pxorbint Pnativeint;
@ -267,8 +267,8 @@ let primitives_table = create_hashtable 57 [
"%int32_add", Paddbint Pint32;
"%int32_sub", Psubbint Pint32;
"%int32_mul", Pmulbint Pint32;
"%int32_div", Pdivbint Pint32;
"%int32_mod", Pmodbint Pint32;
"%int32_div", Pdivbint { size = Pint32; is_safe = Safe };
"%int32_mod", Pmodbint { size = Pint32; is_safe = Safe };
"%int32_and", Pandbint Pint32;
"%int32_or", Porbint Pint32;
"%int32_xor", Pxorbint Pint32;
@ -281,8 +281,8 @@ let primitives_table = create_hashtable 57 [
"%int64_add", Paddbint Pint64;
"%int64_sub", Psubbint Pint64;
"%int64_mul", Pmulbint Pint64;
"%int64_div", Pdivbint Pint64;
"%int64_mod", Pmodbint Pint64;
"%int64_div", Pdivbint { size = Pint64; is_safe = Safe };
"%int64_mod", Pmodbint { size = Pint64; is_safe = Safe };
"%int64_and", Pandbint Pint64;
"%int64_or", Porbint Pint64;
"%int64_xor", Pxorbint Pint64;

38
middle_end/closure_conversion.ml
View File

@ -315,7 +315,9 @@ and close t env (lam : Lambda.lambda) : Flambda.t =
~name:"send_arg"
~create_body:(fun args ->
Send { kind; meth = meth_var; obj = obj_var; args; dbg; })))
| Lprim ((Pdivint | Pmodint) as prim, [arg1; arg2], loc)
| Lprim ((Pdivint Safe | Pmodint Safe
| Pdivbint { is_safe = Safe } | Pmodbint { is_safe = Safe }) as prim,
[arg1; arg2], loc)
when not !Clflags.fast -> (* not -unsafe *)
let arg2 = close t env arg2 in
let arg1 = close t env arg1 in
@ -328,13 +330,39 @@ and close t env (lam : Lambda.lambda) : Flambda.t =
t.symbol_for_global' Predef.ident_division_by_zero
in
let dbg = Debuginfo.from_location loc in
let zero_const : Flambda.named =
match prim with
| Pdivint _ | Pmodint _ ->
Const (Int 0)
| Pdivbint { size = Pint32 } | Pmodbint { size = Pint32 } ->
Allocated_const (Int32 0l)
| Pdivbint { size = Pint64 } | Pmodbint { size = Pint64 } ->
Allocated_const (Int64 0L)
| Pdivbint { size = Pnativeint } | Pmodbint { size = Pnativeint } ->
Allocated_const (Nativeint 0n)
| _ -> assert false
in
let prim : Lambda.primitive =
match prim with
| Pdivint _ -> Pdivint Unsafe
| Pmodint _ -> Pmodint Unsafe
| Pdivbint { size } -> Pdivbint { size; is_safe = Unsafe }
| Pmodbint { size } -> Pmodbint { size; is_safe = Unsafe }
| _ -> assert false
in
let comparison : Lambda.primitive =
match prim with
| Pdivint _ | Pmodint _ -> Pintcomp Ceq
| Pdivbint { size } | Pmodbint { size } -> Pbintcomp (size,Ceq)
| _ -> assert false
in
t.imported_symbols <- Symbol.Set.add exn_symbol t.imported_symbols;
Flambda.create_let zero (Const (Int 0))
Flambda.create_let zero zero_const
(Flambda.create_let exn (Symbol exn_symbol)
(Flambda.create_let denominator (Expr arg2)
(Flambda.create_let numerator (Expr arg1)
(Flambda.create_let is_zero
(Prim (Pintcomp Ceq, [zero; denominator], dbg))
(Prim (comparison, [zero; denominator], dbg))
(If_then_else (is_zero,
name_expr (Prim (Praise Raise_regular, [exn], dbg))
~name:"dummy",
@ -347,7 +375,9 @@ and close t env (lam : Lambda.lambda) : Flambda.t =
mshinwell: deferred CR *)
name_expr ~name:"result"
(Prim (prim, [numerator; denominator], dbg))))))))
| Lprim ((Pdivint | Pmodint), _, _) when not !Clflags.fast ->
| Lprim ((Pdivint Safe | Pmodint Safe
| Pdivbint { is_safe = Safe } | Pmodbint { is_safe = Safe }), _, _)
when not !Clflags.fast ->
Misc.fatal_error "Pdivint / Pmodint must have exactly two arguments"
| Lprim (Psequor, [arg1; arg2], _) ->
let arg1 = close t env arg1 in

13
middle_end/semantics_of_primitives.ml
View File

@ -49,9 +49,16 @@ let for_primitive (prim : Lambda.primitive) =
| Plsrint
| Pasrint
| Pintcomp _ -> No_effects, No_coeffects
| Pdivint
| Pmodint ->
| Pdivbint { is_safe = Unsafe }
| Pmodbint { is_safe = Unsafe }
| Pdivint Unsafe
| Pmodint Unsafe ->
No_effects, No_coeffects (* Will not raise [Division_by_zero]. *)
| Pdivbint { is_safe = Safe }
| Pmodbint { is_safe = Safe }
| Pdivint Safe
| Pmodint Safe ->
Arbitrary_effects, No_coeffects
| Poffsetint _ -> No_effects, No_coeffects
| Poffsetref _ -> Arbitrary_effects, Has_coeffects
| Pintoffloat
@ -76,8 +83,6 @@ let for_primitive (prim : Lambda.primitive) =
| Paddbint _
| Psubbint _
| Pmulbint _
| Pdivbint _
| Pmodbint _
| Pandbint _
| Porbint _
| Pxorbint _

4
middle_end/simplify_boxed_integer_ops.ml
View File

@ -67,8 +67,8 @@ end) : Simplify_boxed_integer_ops_intf.S with type t := I.t = struct
| Paddbint kind when kind = I.kind -> eval I.add
| Psubbint kind when kind = I.kind -> eval I.sub
| Pmulbint kind when kind = I.kind -> eval I.mul
| Pdivbint kind when kind = I.kind && non_zero n2 -> eval I.div
| Pmodbint kind when kind = I.kind && non_zero n2 -> eval I.rem
| Pdivbint {size=kind} when kind = I.kind && non_zero n2 -> eval I.div
| Pmodbint {size=kind} when kind = I.kind && non_zero n2 -> eval I.rem
| Pandbint kind when kind = I.kind -> eval I.logand
| Porbint kind when kind = I.kind -> eval I.logor
| Pxorbint kind when kind = I.kind -> eval I.logxor

4
middle_end/simplify_primitives.ml
View File

@ -116,8 +116,8 @@ let primitive (p : Lambda.primitive) (args, approxs) expr dbg ~size_int
| Paddint -> S.const_int_expr expr (x + y)
| Psubint -> S.const_int_expr expr (x - y)
| Pmulint -> S.const_int_expr expr (x * y)
| Pdivint when y <> 0 -> S.const_int_expr expr (x / y)
| Pmodint when y <> 0 -> S.const_int_expr expr (x mod y)
| Pdivint _ when y <> 0 -> S.const_int_expr expr (x / y)
| Pmodint _ when y <> 0 -> S.const_int_expr expr (x mod y)
| Pandint -> S.const_int_expr expr (x land y)
| Porint -> S.const_int_expr expr (x lor y)
| Pxorint -> S.const_int_expr expr (x lxor y)

67
testsuite/tests/basic-more/div_by_zero.ml Normal file
View File

@ -0,0 +1,67 @@
let check f n =
assert (
try ignore ((Sys.opaque_identity f) n); false with
Division_by_zero -> true
)
let div_int n = n / 0
let div_int32 n = Int32.div n 0l
let div_int64 n = Int64.div n 0L
let div_nativeint n = Nativeint.div n 0n
let mod_int n = n mod 0
let mod_int32 n = Int32.rem n 0l
let mod_int64 n = Int64.rem n 0L
let mod_nativeint n = Nativeint.rem n 0n
let div_int_opaque n = n / (Sys.opaque_identity 0)
let div_int32_opaque n = Int32.div n (Sys.opaque_identity 0l)
let div_int64_opaque n = Int64.div n (Sys.opaque_identity 0L)
let div_nativeint_opaque n = Nativeint.div n (Sys.opaque_identity 0n)
let mod_int_opaque n = n mod (Sys.opaque_identity 0)
let mod_int32_opaque n = Int32.rem n (Sys.opaque_identity 0l)
let mod_int64_opaque n = Int64.rem n (Sys.opaque_identity 0L)
let mod_nativeint_opaque n = Nativeint.rem n (Sys.opaque_identity 0n)
let () =
check div_int 33;
check div_int 0;
check div_int32 33l;
check div_int32 0l;
check div_int64 33L;
check div_int64 0L;
check div_nativeint 33n;
check div_nativeint 0n;
check mod_int 33;
check mod_int 0;
check mod_int32 33l;
check mod_int32 0l;
check mod_int64 33L;
check mod_int64 0L;
check mod_nativeint 33n;
check mod_nativeint 0n;
check div_int_opaque 33;
check div_int_opaque 0;
check div_int32_opaque 33l;
check div_int32_opaque 0l;
check div_int64_opaque 33L;
check div_int64_opaque 0L;
check div_nativeint_opaque 33n;
check div_nativeint_opaque 0n;
check mod_int_opaque 33;
check mod_int_opaque 0;
check mod_int32_opaque 33l;
check mod_int32_opaque 0l;
check mod_int64_opaque 33L;
check mod_int64_opaque 0L;
check mod_nativeint_opaque 33n;
check mod_nativeint_opaque 0n;
()
let () =
print_endline "***** OK *****"

3
testsuite/tests/basic-more/div_by_zero.reference Normal file
View File

@ -0,0 +1,3 @@
***** OK *****
All tests succeeded.