Skip to content

Unsigned comparisons #2812

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 2 commits into
base: main
Choose a base branch
from
Draft

Unsigned comparisons #2812

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
cf9ca39
Add a bool [signed] field to comparison primitives in Lambda.
gretay-js Jul 15, 2024
f94e009
Add C stubs to the runtime
gretay-js Jul 16, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Next Next commit
Add a bool [signed] field to comparison primitives in Lambda.
  • Loading branch information
@gretay-js
gretay-js committed Jul 16, 2024
commit cf9ca39346f5dd2bdadd6aa95437e75adfdd52db
2 changes: 1 addition & 1 deletion middle_end/flambda2/from_lambda/closure_conversion.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -911,7 +911,7 @@ let close_primitive acc env ~let_bound_ids_with_kinds named
| Pufloatfield _ | Psetufloatfield _ | Psequand | Psequor | Pnot | Pnegint
| Pmixedfield _ | Psetmixedfield _ | Paddint | Psubint | Pmulint
| Pdivint _ | Pmodint _ | Pandint | Porint | Pxorint | Plslint | Plsrint
| Pasrint | Pintcomp _ | Pcompare_ints | Pcompare_floats _
| Pasrint | Pintcomp _ | Pcompare_ints _ | Pcompare_floats _
| Pcompare_bints _ | Poffsetint _ | Poffsetref _ | Pintoffloat _
| Pfloatofint (_, _)
| Pfloatoffloat32 _ | Pfloat32offloat _
Expand Down
10 changes: 6 additions & 4 deletions middle_end/flambda2/from_lambda/lambda_to_flambda.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -383,12 +383,14 @@ let rec_catch_for_for_loop env loc ident start stop
let stop_ident = Ident.create_local "for_stop" in
let first_test : L.lambda =
match dir with
| Upto -> Lprim (Pintcomp Cle, [L.Lvar start_ident; L.Lvar stop_ident], loc)
| Upto -> Lprim (Pintcomp { comp = Cle; signed =true },
[L.Lvar start_ident; L.Lvar stop_ident], loc)
| Downto ->
Lprim (Pintcomp Cge, [L.Lvar start_ident; L.Lvar stop_ident], loc)
Lprim (Pintcomp { comp = Cge; signed = true },
[L.Lvar start_ident; L.Lvar stop_ident], loc)
in
let subsequent_test : L.lambda =
Lprim (Pintcomp Cne, [L.Lvar ident; L.Lvar stop_ident], loc)
Lprim (Pintcomp { comp = Cne; signed = true }, [L.Lvar ident; L.Lvar stop_ident], loc)
in
let one : L.lambda = Lconst (Const_base (Const_int 1)) in
let next_value_of_counter =
Expand Down Expand Up @@ -671,7 +673,7 @@ let primitive_can_raise (prim : Lambda.primitive) =
| Pmakeufloatblock _ | Pufloatfield _ | Psetufloatfield _ | Psequand | Psequor
| Pmixedfield _ | Psetmixedfield _ | Pmakemixedblock _ | Pnot | Pnegint
| Paddint | Psubint | Pmulint | Pandint | Porint | Pxorint | Plslint | Plsrint
| Pasrint | Pintcomp _ | Pcompare_ints | Pcompare_floats _ | Pcompare_bints _
| Pasrint | Pintcomp _ | Pcompare_ints _ | Pcompare_floats _ | Pcompare_bints _
| Poffsetint _ | Poffsetref _ | Pintoffloat _
| Pfloatofint (_, _)
| Pfloatoffloat32 _ | Pfloat32offloat _
Expand Down
67 changes: 37 additions & 30 deletions middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -21,37 +21,42 @@ module I_or_f = K.Standard_int_or_float
module L = Lambda
module P = Flambda_primitive

let convert_integer_comparison_prim (comp : L.integer_comparison) :
P.binary_primitive =
let convert_signed signed = if signed then P.Signed else P.Unsigned

let convert_integer_comparison_prim (comp : L.integer_comparison)
(signed : bool) :
P.binary_primitive =
let signed = convert_signed signed in
match comp with
| Ceq -> Phys_equal Eq
| Cne -> Phys_equal Neq
| Clt -> Int_comp (Tagged_immediate, Yielding_bool (Lt Signed))
| Cgt -> Int_comp (Tagged_immediate, Yielding_bool (Gt Signed))
| Cle -> Int_comp (Tagged_immediate, Yielding_bool (Le Signed))
| Cge -> Int_comp (Tagged_immediate, Yielding_bool (Ge Signed))
| Clt -> Int_comp (Tagged_immediate, Yielding_bool (Lt signed))
| Cgt -> Int_comp (Tagged_immediate, Yielding_bool (Gt signed))
| Cle -> Int_comp (Tagged_immediate, Yielding_bool (Le signed))
| Cge -> Int_comp (Tagged_immediate, Yielding_bool (Ge signed))

let convert_boxed_integer_comparison_prim (kind : L.boxed_integer)
(comp : L.integer_comparison) : P.binary_primitive =
(comp : L.integer_comparison) (signed : bool) : P.binary_primitive =
let signed = convert_signed signed in
match kind, comp with
| Pint32, Ceq -> Int_comp (Naked_int32, Yielding_bool Eq)
| Pint32, Cne -> Int_comp (Naked_int32, Yielding_bool Neq)
| Pint32, Clt -> Int_comp (Naked_int32, Yielding_bool (Lt Signed))
| Pint32, Cgt -> Int_comp (Naked_int32, Yielding_bool (Gt Signed))
| Pint32, Cle -> Int_comp (Naked_int32, Yielding_bool (Le Signed))
| Pint32, Cge -> Int_comp (Naked_int32, Yielding_bool (Ge Signed))
| Pint32, Clt -> Int_comp (Naked_int32, Yielding_bool (Lt signed))
| Pint32, Cgt -> Int_comp (Naked_int32, Yielding_bool (Gt signed))
| Pint32, Cle -> Int_comp (Naked_int32, Yielding_bool (Le signed))
| Pint32, Cge -> Int_comp (Naked_int32, Yielding_bool (Ge signed))
| Pint64, Ceq -> Int_comp (Naked_int64, Yielding_bool Eq)
| Pint64, Cne -> Int_comp (Naked_int64, Yielding_bool Neq)
| Pint64, Clt -> Int_comp (Naked_int64, Yielding_bool (Lt Signed))
| Pint64, Cgt -> Int_comp (Naked_int64, Yielding_bool (Gt Signed))
| Pint64, Cle -> Int_comp (Naked_int64, Yielding_bool (Le Signed))
| Pint64, Cge -> Int_comp (Naked_int64, Yielding_bool (Ge Signed))
| Pint64, Clt -> Int_comp (Naked_int64, Yielding_bool (Lt signed))
| Pint64, Cgt -> Int_comp (Naked_int64, Yielding_bool (Gt signed))
| Pint64, Cle -> Int_comp (Naked_int64, Yielding_bool (Le signed))
| Pint64, Cge -> Int_comp (Naked_int64, Yielding_bool (Ge signed))
| Pnativeint, Ceq -> Int_comp (Naked_nativeint, Yielding_bool Eq)
| Pnativeint, Cne -> Int_comp (Naked_nativeint, Yielding_bool Neq)
| Pnativeint, Clt -> Int_comp (Naked_nativeint, Yielding_bool (Lt Signed))
| Pnativeint, Cgt -> Int_comp (Naked_nativeint, Yielding_bool (Gt Signed))
| Pnativeint, Cle -> Int_comp (Naked_nativeint, Yielding_bool (Le Signed))
| Pnativeint, Cge -> Int_comp (Naked_nativeint, Yielding_bool (Ge Signed))
| Pnativeint, Clt -> Int_comp (Naked_nativeint, Yielding_bool (Lt signed))
| Pnativeint, Cgt -> Int_comp (Naked_nativeint, Yielding_bool (Gt signed))
| Pnativeint, Cle -> Int_comp (Naked_nativeint, Yielding_bool (Le signed))
| Pnativeint, Cge -> Int_comp (Naked_nativeint, Yielding_bool (Ge signed))

let convert_float_comparison (comp : L.float_comparison) : unit P.comparison =
match comp with
Expand Down Expand Up @@ -1097,17 +1102,17 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
| Pasrint, [[arg1]; [arg2]] ->
[Binary (Int_shift (I.Tagged_immediate, Asr), arg1, untag_int arg2)]
| Pnot, [[arg]] -> [Unary (Boolean_not, arg)]
| Pintcomp comp, [[arg1]; [arg2]] ->
[tag_int (Binary (convert_integer_comparison_prim comp, arg1, arg2))]
| Pbintcomp (kind, comp), [[arg1]; [arg2]] ->
| Pintcomp { comp; signed }, [[arg1]; [arg2]] ->
[tag_int (Binary (convert_integer_comparison_prim comp signed, arg1, arg2))]
| Pbintcomp { size = kind; comp; signed }, [[arg1]; [arg2]] ->
let arg1 = unbox_bint kind arg1 in
let arg2 = unbox_bint kind arg2 in
[ tag_int
(Binary (convert_boxed_integer_comparison_prim kind comp, arg1, arg2))
(Binary (convert_boxed_integer_comparison_prim kind comp signed, arg1, arg2))
]
| Punboxed_int_comp (kind, comp), [[arg1]; [arg2]] ->
| Punboxed_int_comp { size = kind; comp; signed }, [[arg1]; [arg2]] ->
[ tag_int
(Binary (convert_boxed_integer_comparison_prim kind comp, arg1, arg2))
(Binary (convert_boxed_integer_comparison_prim kind comp signed, arg1, arg2))
]
| Pfloatoffloat32 mode, [[arg]] ->
let src = K.Standard_int_or_float.Naked_float32 in
Expand Down Expand Up @@ -1896,11 +1901,12 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
| Punboxed_int32_array_set_128 { unsafe }, [[array]; [index]; [new_value]] ->
[ array_like_set_128 ~dbg ~size_int ~unsafe Naked_int32s array index
new_value ]
| Pcompare_ints, [[i1]; [i2]] ->
| Pcompare_ints { signed }, [[i1]; [i2]] ->
let signed = convert_signed signed in
[ tag_int
(Binary
( Int_comp
(Tagged_immediate, Yielding_int_like_compare_functions Signed),
(Tagged_immediate, Yielding_int_like_compare_functions signed),
i1,
i2 )) ]
| Pcompare_floats Pfloat64, [[f1]; [f2]] ->
Expand All @@ -1915,13 +1921,14 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
( Float_comp (Float32, Yielding_int_like_compare_functions ()),
Prim (Unary (Unbox_number Naked_float32, f1)),
Prim (Unary (Unbox_number Naked_float32, f2)) )) ]
| Pcompare_bints int_kind, [[i1]; [i2]] ->
| Pcompare_bints { size = int_kind; signed }, [[i1]; [i2]] ->
let unboxing_kind = boxable_number_of_boxed_integer int_kind in
let signed = convert_signed signed in
[ tag_int
(Binary
( Int_comp
( standard_int_of_boxed_integer int_kind,
Yielding_int_like_compare_functions Signed ),
Yielding_int_like_compare_functions signed ),
Prim (Unary (Unbox_number unboxing_kind, i1)),
Prim (Unary (Unbox_number unboxing_kind, i2)) )) ]
| Pprobe_is_enabled { name }, [] ->
Expand Down Expand Up @@ -2021,7 +2028,7 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
| Pfloatarray_ref _ | Punboxedfloatarray_ref _
| Punboxedintarray_ref _ ),
_ )
| Pcompare_ints | Pcompare_floats _ | Pcompare_bints _ | Patomic_exchange
| Pcompare_ints _ | Pcompare_floats _ | Pcompare_bints _ | Patomic_exchange
| Patomic_fetch_add ),
( []
| [_]
Expand Down
66 changes: 54 additions & 12 deletions ocaml/bytecomp/bytegen.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -132,7 +132,7 @@ let preserve_tailcall_for_prim = function
| Paddfloat (_, _) | Psubfloat (_, _) | Pmulfloat (_, _)
| Pdivfloat (_, _) | Pfloatcomp (_, _) | Punboxed_float_comp (_, _)
| Pstringlength | Pstringrefu | Pstringrefs
| Pcompare_ints | Pcompare_floats _ | Pcompare_bints _
| Pcompare_ints _ | Pcompare_floats _ | Pcompare_bints _
| Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
| Pmakearray _ | Pduparray _ | Parraylength _ | Parrayrefu _ | Parraysetu _
| Parrayrefs _ | Parraysets _ | Pisint _ | Pisout | Pbintofint _ | Pintofbint _
Expand Down Expand Up @@ -375,11 +375,25 @@ let comp_primitive stack_info p sz args =
| Psetglobal cu ->
Ksetglobal (cu |> Compilation_unit.to_global_ident_for_bytecode)
| Pgetpredef id -> Kgetglobal id
| Pintcomp cmp -> Kintcomp cmp
| Pcompare_ints -> Kccall("caml_int_compare", 2)
| Pintcomp { comp = cmp; signed = true } -> Kintcomp cmp
| Pintcomp { comp = (Ceq|Cne); signed = false } ->
Misc.fatal_error "Pintcomp: unsigned equal and not_equal are not supported."
| Pintcomp { comp = Clt; signed = false } ->
Kccall("caml_int_lessthan_unsigned", 2)
| Pintcomp { comp = Cgt; signed = false } ->
Kccall("caml_int_greaterthan_unsigned", 2)
| Pintcomp { comp = Cle; signed = false } ->
Kccall("caml_int_lessequal_unsigned", 2)
| Pintcomp { comp = Cge; signed = false } ->
Kccall("caml_int_greaterequal_unsigned", 2)
| Pcompare_ints { signed = true } -> Kccall("caml_int_compare", 2)
| Pcompare_ints { signed = false } -> Kccall("caml_int_compare_unsigned", 2)
| Pcompare_floats Pfloat64 -> Kccall("caml_float_compare", 2)
| Pcompare_floats Pfloat32 -> Kccall("caml_float32_compare", 2)
| Pcompare_bints bi -> comp_bint_primitive bi "compare" args
| Pcompare_bints { size = bi; signed = true } ->
comp_bint_primitive bi "compare" args
| Pcompare_bints { size = bi; signed = false } ->
comp_bint_primitive bi "compare_unsigned" args
| Pfield (n, _ptr, _sem) -> Kgetfield n
| Pfield_computed _sem -> Kgetvectitem
| Psetfield(n, _ptr, _init) -> Ksetfield n
Expand Down Expand Up @@ -540,12 +554,40 @@ let comp_primitive stack_info p sz args =
| Plslbint(bi,_) -> comp_bint_primitive bi "shift_left" args
| Plsrbint(bi,_) -> comp_bint_primitive bi "shift_right_unsigned" args
| Pasrbint(bi,_) -> comp_bint_primitive bi "shift_right" args
| Pbintcomp(_, Ceq) | Punboxed_int_comp(_, Ceq) -> Kccall("caml_equal", 2)
| Pbintcomp(_, Cne) | Punboxed_int_comp(_, Cne) -> Kccall("caml_notequal", 2)
| Pbintcomp(_, Clt) | Punboxed_int_comp(_, Clt) -> Kccall("caml_lessthan", 2)
| Pbintcomp(_, Cgt) | Punboxed_int_comp(_, Cgt) -> Kccall("caml_greaterthan", 2)
| Pbintcomp(_, Cle) | Punboxed_int_comp(_, Cle) -> Kccall("caml_lessequal", 2)
| Pbintcomp(_, Cge) | Punboxed_int_comp(_, Cge) -> Kccall("caml_greaterequal", 2)
| Pbintcomp { size =_; signed = _; comp = Ceq }
| Punboxed_int_comp { size =_; signed = _; comp = Ceq} ->
Kccall("caml_equal", 2)
| Pbintcomp { size = _; signed = _; comp = Cne }
| Punboxed_int_comp { size = _; signed = _; comp = Cne } ->
Kccall("caml_notequal", 2)
| Pbintcomp { size = _; signed = true; comp = Clt }
| Punboxed_int_comp { size = _; signed = true; comp = Clt } ->
Kccall("caml_lessthan", 2)
| Pbintcomp { size = _; signed = true; comp = Cgt }
| Punboxed_int_comp { size = _; signed = true; comp = Cgt } ->
Kccall("caml_greaterthan", 2)
| Pbintcomp { size = _; signed = true; comp = Cle }
| Punboxed_int_comp { size = _; signed = true; comp = Cle } ->
Kccall("caml_lessequal", 2)
| Pbintcomp { size = _; signed = true; comp = Cge }
| Punboxed_int_comp { size = _; signed = true; comp = Cge } ->
Kccall("caml_greaterequal", 2)
| Pbintcomp { size = bi; signed = false; comp = Clt } ->
comp_bint_primitive bi "lessthan_unsigned" args
| Punboxed_int_comp { size = bi; signed = false; comp = Clt } ->
comp_bint_primitive bi "lessthan_unsigned_unboxed" args
| Pbintcomp { size = bi; signed = false; comp = Cgt } ->
comp_bint_primitive bi "greaterthan_unsigned" args
| Punboxed_int_comp { size = bi; signed = false; comp = Cgt } ->
comp_bint_primitive bi "greaterthan_unsigned_unboxed" args
| Pbintcomp { size = bi; signed = false; comp = Cle } ->
comp_bint_primitive bi "lessequal_unsigned" args
| Punboxed_int_comp { size = bi; signed = false; comp = Cle } ->
comp_bint_primitive bi "lessequal_unsigned_unboxed" args
| Pbintcomp { size = bi; signed = false; comp = Cge } ->
comp_bint_primitive bi "greaterqual_unsigned" args
| Punboxed_int_comp { size = bi; signed = false; comp = Cge } ->
comp_bint_primitive bi "greaterequal_unsigned_unboxed" args
| Pbigarrayref(_, n, Pbigarray_float32_t, _) -> Kccall("caml_ba_float32_get_" ^ Int.to_string n, n + 1)
| Pbigarrayset(_, n, Pbigarray_float32_t, _) -> Kccall("caml_ba_float32_set_" ^ Int.to_string n, n + 2)
| Pbigarrayref(_, n, _, _) -> Kccall("caml_ba_get_" ^ Int.to_string n, n + 1)
Expand Down Expand Up @@ -860,8 +902,8 @@ let rec comp_expr stack_info env exp sz cont =
| Lprim (Pduparray _, _, _) ->
Misc.fatal_error "Bytegen.comp_expr: Pduparray takes exactly one arg"
(* Integer first for enabling further optimization (cf. emitcode.ml) *)
| Lprim (Pintcomp c, [arg ; (Lconst _ as k)], _) ->
let p = Pintcomp (swap_integer_comparison c)
| Lprim (Pintcomp { comp=c; signed }, [arg ; (Lconst _ as k)], _) ->
let p = Pintcomp { comp = (swap_integer_comparison c); signed }
and args = [k ; arg] in
let nargs = List.length args - 1 in
comp_args stack_info env args sz
Expand Down
16 changes: 9 additions & 7 deletions ocaml/lambda/lambda.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -178,10 +178,10 @@ type primitive =
| Pdivint of is_safe | Pmodint of is_safe
| Pandint | Porint | Pxorint
| Plslint | Plsrint | Pasrint
| Pintcomp of integer_comparison
| Pcompare_ints
| Pintcomp of { comp : integer_comparison; signed : bool }
| Pcompare_ints of { signed : bool }
| Pcompare_floats of boxed_float
| Pcompare_bints of boxed_integer
| Pcompare_bints of { size : boxed_integer ; signed : bool }
| Poffsetint of int
| Poffsetref of int
(* Float operations *)
Expand Down Expand Up @@ -229,8 +229,10 @@ type primitive =
| Plslbint of boxed_integer * alloc_mode
| Plsrbint of boxed_integer * alloc_mode
| Pasrbint of boxed_integer * alloc_mode
| Pbintcomp of boxed_integer * integer_comparison
| Punboxed_int_comp of unboxed_integer * integer_comparison
| Pbintcomp of { size : boxed_integer; comp : integer_comparison;
signed : bool }
| Punboxed_int_comp of { size : unboxed_integer; comp : integer_comparison;
signed : bool }
(* Operations on Bigarrays: (unsafe, #dimensions, kind, layout) *)
| Pbigarrayref of bool * int * bigarray_kind * bigarray_layout
| Pbigarrayset of bool * int * bigarray_kind * bigarray_layout
Expand Down Expand Up @@ -1715,7 +1717,7 @@ let primitive_may_allocate : primitive -> alloc_mode option = function
| Pandint | Porint | Pxorint
| Plslint | Plsrint | Pasrint
| Pintcomp _
| Pcompare_ints | Pcompare_floats _ | Pcompare_bints _
| Pcompare_ints _ | Pcompare_floats _ | Pcompare_bints _
| Poffsetint _
| Poffsetref _ -> None
| Pintoffloat _ -> None
Expand Down Expand Up @@ -1917,7 +1919,7 @@ let primitive_result_layout (p : primitive) =
| Pandint | Porint | Pxorint
| Plslint | Plsrint | Pasrint
| Pintcomp _
| Pcompare_ints | Pcompare_floats _ | Pcompare_bints _
| Pcompare_ints _ | Pcompare_floats _ | Pcompare_bints _
| Poffsetint _ | Pintoffloat _
| Pfloatcomp (_, _) | Punboxed_float_comp (_, _)
| Pstringlength | Pstringrefu | Pstringrefs
Expand Down
12 changes: 7 additions & 5 deletions ocaml/lambda/lambda.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -159,11 +159,11 @@ type primitive =
| Pdivint of is_safe | Pmodint of is_safe
| Pandint | Porint | Pxorint
| Plslint | Plsrint | Pasrint
| Pintcomp of integer_comparison
| Pintcomp of { comp : integer_comparison; signed : bool }
(* Comparisons that return int (not bool like above) for ordering *)
| Pcompare_ints
| Pcompare_ints of { signed : bool }
| Pcompare_floats of boxed_float
| Pcompare_bints of boxed_integer
| Pcompare_bints of { size : boxed_integer; signed : bool }
| Poffsetint of int
| Poffsetref of int
(* Float operations *)
Expand Down Expand Up @@ -214,8 +214,10 @@ type primitive =
| Plslbint of boxed_integer * alloc_mode
| Plsrbint of boxed_integer * alloc_mode
| Pasrbint of boxed_integer * alloc_mode
| Pbintcomp of boxed_integer * integer_comparison
| Punboxed_int_comp of unboxed_integer * integer_comparison
| Pbintcomp of { size : boxed_integer; comp : integer_comparison;
signed : bool }
| Punboxed_int_comp of { size : unboxed_integer; comp : integer_comparison;
signed : bool }
(* Operations on Bigarrays: (unsafe, #dimensions, kind, layout) *)
| Pbigarrayref of bool * int * bigarray_kind * bigarray_layout
| Pbigarrayset of bool * int * bigarray_kind * bigarray_layout
Expand Down
Loading