Skip to content

Commit

Permalink
Squashed commit of the following:
Browse files Browse the repository at this point in the history 
commit c9d7aa6
Author: Jacob Van Buren <jvanburen@janestreet.com>
Date:   Thu Jan 2 14:49:45 2025 -0500

    cleaned up div/mod

commit 4d9f427
Author: Jacob Van Buren <jvanburen@janestreet.com>
Date:   Thu Jan 2 14:45:42 2025 -0500

    address feedback and simplify division interface
  • Loading branch information
@jvanburen
jvanburen committed Jan 2, 2025
1 parent 625a416 commit d1acc48
Show file tree
Hide file tree
Showing 5 changed files with 162 additions and 150 deletions.
215 changes: 110 additions & 105 deletions backend/cmm_helpers.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -635,16 +635,54 @@ let raise_symbol dbg symb =
Cop
(Craise Lambda.Raise_regular, [Cconst_symbol (global_symbol symb, dbg)], 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")
| c1, Cconst_int (1, _) -> c1
| Cconst_int (n1, _), Cconst_int (n2, _) -> Cconst_int (n1 / n2, dbg)
| c1, Cconst_int (n, _) when n <> min_int ->
let l = Misc.log2 n in
if n = 1 lsl l
let[@inline] get_const = function
| Cconst_int (i, _) -> Some (Nativeint.of_int i)
| Cconst_natint (i, _) -> Some i
| _ -> None

(** Division or modulo on registers. The overflow case min_int / -1 can
occur, in which case we force x / -1 = -x and x mod -1 = 0. (PR#5513).
In typical cases, [operator] is used to compute the result.
However, if division crashes on overflow, we will insert a runtime check for a divisor
of -1, and fall back to [if_divisor_is_minus_one]. *)
let make_safe_divmod operator ~if_divisor_is_negative_one
?(dividend_cannot_be_min_int = false) c1 c2 ~dbg =
if dividend_cannot_be_min_int || not Arch.division_crashes_on_overflow
then Cop (operator, [c1; c2], dbg)
else
bind "divisor" c2 (fun c2 ->
bind "dividend" c1 (fun c1 ->
Cifthenelse
( Cop (Ccmpi Cne, [c2; Cconst_int (-1, dbg)], dbg),
dbg,
Cop (operator, [c1; c2], dbg),
dbg,
if_divisor_is_negative_one ~dividend:c1 ~dbg,
dbg,
Any )))

let rec div_int ?dividend_cannot_be_min_int c1 c2 dbg =
let if_divisor_is_negative_one ~dividend ~dbg = neg_int dividend dbg in
match get_const c1, get_const c2 with
| _, Some 0n -> Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero")
| _, Some 1n -> c1
| Some n1, Some n2 -> natint_const_untagged dbg (Nativeint.div n1 n2)
| _, Some -1n -> if_divisor_is_negative_one ~dividend:c1 ~dbg
| _, Some n ->
if n < 0n
then
if n = Nativeint.min_int
then Cop (Ccmpi Ceq, [c1; Cconst_natint (Nativeint.min_int, dbg)], dbg)
else
neg_int
(div_int ?dividend_cannot_be_min_int c1
(Cconst_natint (Nativeint.neg n, dbg))
dbg)
dbg
else if Nativeint.logand n (Nativeint.pred n) = 0n
then
let l = Misc.log2_nativeint n in
(* Algorithm:
t = shift-right-signed(c1, l - 1)
Expand All @@ -661,14 +699,8 @@ let rec div_int c1 c2 is_safe dbg =
add_int c1 t dbg);
Cconst_int (l, dbg) ],
dbg )
else if n < 0
then
sub_int
(Cconst_int (0, dbg))
(div_int c1 (Cconst_int (-n, dbg)) is_safe dbg)
dbg
else
let m, p = divimm_parameters (Nativeint.of_int n) in
let m, p = divimm_parameters n in
(* Algorithm:
t = multiply-high-signed(c1, m) if m < 0,
Expand All @@ -688,30 +720,36 @@ let rec div_int c1 c2 is_safe dbg =
if p > 0 then Cop (Casr, [t; Cconst_int (p, dbg)], dbg) else t
in
add_int t (lsr_int c1 (Cconst_int (Nativeint.size - 1, dbg)) dbg) dbg)
| c1, c2 when !Clflags.unsafe || is_safe = Lambda.Unsafe ->
Cop (Cdivi, [c1; c2], dbg)
| c1, c2 ->
bind "divisor" c2 (fun c2 ->
bind "dividend" c1 (fun c1 ->
Cifthenelse
( c2,
dbg,
Cop (Cdivi, [c1; c2], dbg),
dbg,
raise_symbol dbg "caml_exn_Division_by_zero",
dbg,
Any )))

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")
| c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg))
| Cconst_int (n1, _), Cconst_int (n2, _) -> Cconst_int (n1 mod n2, dbg)
| c1, (Cconst_int (n, _) as c2) when n <> min_int ->
let l = Misc.log2 n in
if n = 1 lsl l
| _, _ ->
make_safe_divmod ?dividend_cannot_be_min_int ~if_divisor_is_negative_one
Cdivi c1 c2 ~dbg

let mod_int ?dividend_cannot_be_min_int c1 c2 dbg =
let if_divisor_is_positive_or_negative_one ~dividend ~dbg =
match dividend with
| Cvar _ -> Cconst_int (0, dbg)
| dividend -> Csequence (dividend, Cconst_int (0, dbg))
in
match get_const c1, get_const c2 with
| _, Some 0n -> Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero")
| _, Some (1n | -1n) ->
if_divisor_is_positive_or_negative_one ~dividend:c1 ~dbg
| Some n1, Some n2 -> natint_const_untagged dbg (Nativeint.rem n1 n2)
| _, Some n ->
if n = Nativeint.min_int
then
bind "dividend" c1 (fun c1 ->
Cifthenelse
( Cop (Ccmpi Ceq, [c1; neg_int c1 dbg], dbg),
dbg,
Cconst_int (0, dbg),
dbg,
Cop (Cor, [c1; Cconst_natint (Nativeint.min_int, dbg)], dbg),
dbg,
Any ))
else if Nativeint.logand n (Nativeint.pred n) = 0n
then
let l = Misc.log2_nativeint n in
(* Algorithm:
t = shift-right-signed(c1, l - 1)
Expand All @@ -728,69 +766,25 @@ let mod_int c1 c2 is_safe dbg =
let t = asr_int c1 (Cconst_int (l - 1, dbg)) dbg in
let t = lsr_int t (Cconst_int (Nativeint.size - l, dbg)) dbg in
let t = add_int c1 t dbg in
let t = Cop (Cand, [t; Cconst_int (-n, dbg)], dbg) in
let t = Cop (Cand, [t; Cconst_natint (Nativeint.neg n, dbg)], dbg) in
sub_int c1 t dbg)
else
bind "dividend" c1 (fun c1 ->
sub_int c1 (mul_int (div_int c1 c2 is_safe dbg) c2 dbg) dbg)
| c1, c2 when !Clflags.unsafe || is_safe = Lambda.Unsafe ->
(* Flambda already generates that test *)
Cop (Cmodi, [c1; c2], dbg)
| c1, c2 ->
bind "divisor" c2 (fun c2 ->
bind "dividend" c1 (fun c1 ->
Cifthenelse
( c2,
dbg,
Cop (Cmodi, [c1; c2], dbg),
dbg,
raise_symbol dbg "caml_exn_Division_by_zero",
dbg,
Any )))

(* Division or modulo on boxed integers. The overflow case min_int / -1 can
occur, in which case we force x / -1 = -x and x mod -1 = 0. (PR#5513). *)

(* Division or modulo on boxed integers. The overflow case min_int / -1 can
occur, in which case we force x / -1 = -x and x mod -1 = 0. (PR#5513). *)

let safe_divmod_bi mkop mkm1 ?(dividend_cannot_be_min_int = false) is_safe
dividend divisor dbg =
let is_different_from x = function
| Cconst_int (n, _) -> Nativeint.of_int n <> x
| Cconst_natint (n, _) -> n <> x
| _ -> false
in
bind "divisor" divisor (fun divisor ->
bind "dividend" dividend (fun dividend ->
let c = mkop dividend divisor is_safe dbg in
if not Arch.division_crashes_on_overflow
then c
else
let dividend_cannot_be_min_int =
dividend_cannot_be_min_int
|| is_different_from Nativeint.min_int dividend
in
let divisor_cannot_be_negative_one =
is_different_from (-1n) divisor
in
if dividend_cannot_be_min_int || divisor_cannot_be_negative_one
then c
else
Cifthenelse
( Cop (Ccmpi Cne, [divisor; Cconst_int (-1, dbg)], dbg),
dbg,
c,
dbg,
mkm1 dividend dbg,
dbg,
Any )))

let safe_div_bi =
safe_divmod_bi div_int (fun c1 dbg ->
Cop (Csubi, [Cconst_int (0, dbg); c1], dbg))
sub_int c1 (mul_int (div_int c1 c2 dbg) c2 dbg) dbg)
| _, _ ->
make_safe_divmod ?dividend_cannot_be_min_int
~if_divisor_is_negative_one:if_divisor_is_positive_or_negative_one Cmodi
c1 c2 ~dbg

let div_int ?dividend_cannot_be_min_int c1 c2 dbg =
bind "divisor" c2 (fun c2 ->
bind "dividend" c1 (fun c1 ->
div_int ?dividend_cannot_be_min_int c1 c2 dbg))

let safe_mod_bi = safe_divmod_bi mod_int (fun _ dbg -> Cconst_int (0, dbg))
let mod_int ?dividend_cannot_be_min_int c1 c2 dbg =
bind "divisor" c2 (fun c2 ->
bind "dividend" c1 (fun c1 ->
mod_int ?dividend_cannot_be_min_int c1 c2 dbg))

(* Bool *)

Expand Down Expand Up @@ -1985,8 +1979,9 @@ let low_bits ~bits ~(dbg : Debuginfo.t) e =
| bits -> Misc.fatal_errorf "low_bits not implemented for %d bits" bits

let ignore_low_bits ~bits ~dbg:(_ : Debuginfo.t) e =
assert (0 <= bits && bits <= arch_bits);
if bits = 0 then e else ignore_low_bit_int e
if bits = 1
then ignore_low_bit_int e
else Misc.fatal_error "ignore_low_bits expected bits=1 for now"

let and_int e1 e2 dbg =
let is_mask32 = function
Expand Down Expand Up @@ -3465,11 +3460,21 @@ let mul_int_caml arg1 arg2 dbg =
incr_int (mul_int (untag_int c1 dbg) (decr_int c2 dbg) dbg) dbg
| c1, c2 -> incr_int (mul_int (decr_int c1 dbg) (untag_int c2 dbg) dbg) dbg

let div_int_caml is_safe arg1 arg2 dbg =
tag_int (div_int (untag_int arg1 dbg) (untag_int arg2 dbg) is_safe dbg) dbg

let mod_int_caml is_safe arg1 arg2 dbg =
tag_int (mod_int (untag_int arg1 dbg) (untag_int arg2 dbg) is_safe dbg) dbg
(* Since caml integers are tagged, we know that they when they're untagged, they
can't be [Nativeint.min_int] *)
let caml_integers_are_tagged = true

let div_int_caml arg1 arg2 dbg =
tag_int
(div_int ~dividend_cannot_be_min_int:caml_integers_are_tagged
(untag_int arg1 dbg) (untag_int arg2 dbg) dbg)
dbg

let mod_int_caml arg1 arg2 dbg =
tag_int
(mod_int ~dividend_cannot_be_min_int:caml_integers_are_tagged
(untag_int arg1 dbg) (untag_int arg2 dbg) dbg)
dbg

let and_int_caml arg1 arg2 dbg = and_int arg1 arg2 dbg

Expand Down
35 changes: 18 additions & 17 deletions backend/cmm_helpers.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -82,12 +82,6 @@ val lsr_int : expression -> expression -> Debuginfo.t -> expression

val asr_int : expression -> expression -> Debuginfo.t -> expression

val div_int :
expression -> expression -> Lambda.is_safe -> Debuginfo.t -> expression

val mod_int :
expression -> expression -> Lambda.is_safe -> Debuginfo.t -> expression

val and_int : expression -> expression -> Debuginfo.t -> expression

val or_int : expression -> expression -> Debuginfo.t -> expression
Expand All @@ -101,17 +95,15 @@ val tag_int : expression -> Debuginfo.t -> expression
val untag_int : expression -> Debuginfo.t -> expression

(** Specific division operations for boxed integers *)
val safe_div_bi :
val div_int :
?dividend_cannot_be_min_int:bool ->
Lambda.is_safe ->
expression ->
expression ->
Debuginfo.t ->
expression

val safe_mod_bi :
val mod_int :
?dividend_cannot_be_min_int:bool ->
Lambda.is_safe ->
expression ->
expression ->
Debuginfo.t ->
Expand Down Expand Up @@ -389,8 +381,10 @@ val ignore_low_bits : bits:int -> dbg:Debuginfo.t -> expression -> expression
irrelevant *)
val low_bits : bits:int -> dbg:Debuginfo.t -> expression -> expression

(** sign-extend a given integer expression from [bits] bits to an entire register *)
val sign_extend : bits:int -> dbg:Debuginfo.t -> expression -> expression

(** zero-extend a given integer expression from [bits] bits to an entire register *)
val zero_extend : bits:int -> dbg:Debuginfo.t -> expression -> expression

(** Box a given integer, without sharing of constants *)
Expand Down Expand Up @@ -477,9 +471,9 @@ val sub_int_caml : binary_primitive

val mul_int_caml : binary_primitive

val div_int_caml : Lambda.is_safe -> binary_primitive
val div_int_caml : binary_primitive

val mod_int_caml : Lambda.is_safe -> binary_primitive
val mod_int_caml : binary_primitive

val and_int_caml : binary_primitive

Expand Down Expand Up @@ -702,7 +696,10 @@ val create_ccatch :
body:Cmm.expression ->
Cmm.expression

(** Shift operations. take as first argument a tagged caml integer, and as
(** Shift operations.
Inputs: a tagged caml integer and an untagged machine integer.
Outputs: a tagged caml integer.
ake as first argument a tagged caml integer, and as
second argument an untagged machine intger which is the amount to shift the
first argument by. *)

Expand Down Expand Up @@ -1181,10 +1178,14 @@ val unboxed_int64_or_nativeint_array_set :
Debuginfo.t ->
expression

(** {2 Getters and setters for unboxed int and float32 fields of mixed
blocks} [immediate_or_pointer] is not needed as the layout is implied from the name,
and [initialization_or_assignment] is not needed as unboxed ints can always be
assigned without caml_modify (etc.). *)
(** {2 Getters and setters for unboxed fields of mixed blocks}
The first argument is the heap block to modify a field of.
The [index_in_words] should be an untagged integer.
In constrast to [setfield] and [setfield_computed], [immediate_or_pointer] is not
needed as the layout is implied from the name, and [initialization_or_assignment] is
not needed as unboxed ints can always be assigned without caml_modify (etc.). *)

val get_field_unboxed :
dbg:Debuginfo.t ->
Expand Down
Loading

0 comments on commit d1acc48

Please sign in to comment.