diff --git a/backend/cmm_builtins.ml b/backend/cmm_builtins.ml index 03e769d1ba5..dc2105f7ef3 100644 --- a/backend/cmm_builtins.ml +++ b/backend/cmm_builtins.ml @@ -413,6 +413,10 @@ let transl_builtin name args dbg typ_res = Some (Cop (Creinterpret_cast Float32_of_int32, args, dbg)) | "caml_float32_to_bits" -> Some (Cop (Creinterpret_cast Int32_of_float32, args, dbg)) + | "caml_float32_to_int64" -> + Some (Cop (Cstatic_cast (Int_of_float Float32), args, dbg)) + | "caml_float32_of_int64" -> + Some (Cop (Cstatic_cast (Float_of_int Float32), args, dbg)) | "caml_int_clz_tagged_to_untagged" -> (* The tag does not change the number of leading zeros. The advantage of keeping the tag is it guarantees that, on x86-64, the input to the BSR diff --git a/ocaml/otherlibs/stdlib_beta/float32.ml b/ocaml/otherlibs/stdlib_beta/float32.ml index bd505ed275f..949a17ef321 100644 --- a/ocaml/otherlibs/stdlib_beta/float32.ml +++ b/ocaml/otherlibs/stdlib_beta/float32.ml @@ -87,6 +87,14 @@ external to_int : (t[@local_opt]) -> int = "%intoffloat32" external of_float : (float[@local_opt]) -> t = "%float32offloat" external to_float : (t[@local_opt]) -> float = "%floatoffloat32" +external of_int64 : (int64[@local_opt]) -> t + = "caml_float32_of_int64_bytecode" "caml_float32_of_int64" + [@@unboxed] [@@noalloc] [@@builtin] + +external to_int64 : (t[@local_opt]) -> int64 + = "caml_float32_to_int64_bytecode" "caml_float32_to_int64" + [@@unboxed] [@@noalloc] [@@builtin] + external of_bits : (int32[@local_opt]) -> t = "caml_float32_of_bits_bytecode" "caml_float32_of_bits" [@@unboxed] [@@noalloc] [@@builtin] diff --git a/ocaml/otherlibs/stdlib_beta/float32.mli b/ocaml/otherlibs/stdlib_beta/float32.mli index f6f5ead2fa1..3f90464182b 100644 --- a/ocaml/otherlibs/stdlib_beta/float32.mli +++ b/ocaml/otherlibs/stdlib_beta/float32.mli @@ -180,6 +180,22 @@ external to_int : (t[@local_opt]) -> int = "%intoffloat32" The result is unspecified if the argument is [nan] or falls outside the range of representable integers. *) +external of_int64 : (int64[@local_opt]) -> t + = "caml_float32_of_int64_bytecode" "caml_float32_of_int64" + [@@unboxed] [@@noalloc] [@@builtin] +(** Convert the given 64-bit integer to the nearest representable 32-bit float. + The amd64 flambda-backend compiler translates this call to CVTSI2SS. *) + +external to_int64 : (t[@local_opt]) -> int64 + = "caml_float32_to_int64_bytecode" "caml_float32_to_int64" + [@@unboxed] [@@noalloc] [@@builtin] +(** Convert the given 32-bit float to a 64-bit integer, + discarding the fractional part (truncate towards 0). + If the truncated floating-point number is outside the range + \[{!Int64.min_int}, {!Int64.max_int}\], no exception is raised, and + an unspecified, platform-dependent integer is returned. + The amd64 flambda-backend compiler translates this call to CVTTSS2SI. *) + external of_bits : (int32[@local_opt]) -> t = "caml_float32_of_bits_bytecode" "caml_float32_of_bits" [@@unboxed] [@@noalloc] [@@builtin] diff --git a/ocaml/otherlibs/stdlib_beta/float32_u.ml b/ocaml/otherlibs/stdlib_beta/float32_u.ml index 3d8ee6e632a..5fc35f491c6 100644 --- a/ocaml/otherlibs/stdlib_beta/float32_u.ml +++ b/ocaml/otherlibs/stdlib_beta/float32_u.ml @@ -26,6 +26,10 @@ external box_int32 : int32# -> (int32[@local_opt]) = "%box_int32" external unbox_int32 : (int32[@local_opt]) -> int32# = "%unbox_int32" +external box_int64 : int64# -> (int64[@local_opt]) = "%box_int64" + +external unbox_int64 : (int64[@local_opt]) -> int64# = "%unbox_int64" + external to_float32 : t -> (float32[@local_opt]) = "%box_float32" external of_float32 : (float32[@local_opt]) -> t = "%unbox_float32" @@ -82,6 +86,9 @@ let[@inline always] of_int x = of_float32 (Float32.of_int x) let[@inline always] to_int x = Float32.to_int (to_float32 x) +let[@inline always] of_int64 x = of_float32 (Float32.of_int64 (box_int64 x)) + +let[@inline always] to_int64 x = unbox_int64 (Float32.to_int64 (to_float32 x)) let[@inline always] of_float x = of_float32 (Float32.of_float (box_float x)) let[@inline always] to_float x = unbox_float (Float32.to_float (to_float32 x)) diff --git a/ocaml/otherlibs/stdlib_beta/float32_u.mli b/ocaml/otherlibs/stdlib_beta/float32_u.mli index 26d591c2b22..154755ee386 100644 --- a/ocaml/otherlibs/stdlib_beta/float32_u.mli +++ b/ocaml/otherlibs/stdlib_beta/float32_u.mli @@ -134,6 +134,16 @@ val to_int : t -> int The result is unspecified if the argument is [nan] or falls outside the range of representable integers. *) +val of_int64 : int64# -> t +(** Convert the given 64-bit integer to the nearest representable 32-bit float. *) + +val to_int64 : t -> int64# +(** Convert the given 32-bit float to a 64-bit integer, + discarding the fractional part (truncate towards 0). + If the truncated floating-point number is outside the range + \[{!Int64.min_int}, {!Int64.max_int}\], no exception is raised, and + an unspecified, platform-dependent integer is returned. *) + val of_float : float# -> t (** Convert a 64-bit float to the nearest 32-bit float. *) diff --git a/ocaml/runtime/float32.c b/ocaml/runtime/float32.c index 6d1c2e86a5a..58e029f9364 100644 --- a/ocaml/runtime/float32.c +++ b/ocaml/runtime/float32.c @@ -259,6 +259,22 @@ CAMLprim value caml_fma_float32_bytecode(value f, value g, value h) return caml_copy_float32(fmaf(Float32_val(f), Float32_val(g), Float32_val(h))); } +float caml_float32_of_int64(int64_t i) { + return (float)i; +} + +CAMLprim value caml_float32_of_int64_bytecode(value i) { + return caml_copy_float32(caml_float32_of_int64(Int64_val(i))); +} + +int64_t caml_float32_to_int64(float f) { + return (int64_t)f; +} + +CAMLprim value caml_float32_to_int64_bytecode(value f) { + return caml_copy_int64(caml_float32_to_int64(Float32_val(f))); +} + float caml_float32_of_bits(int32_t bits) { union { float f; int32_t i; } u; diff --git a/ocaml/runtime4/float32.c b/ocaml/runtime4/float32.c index aa4bbbb0fa3..931dd960978 100644 --- a/ocaml/runtime4/float32.c +++ b/ocaml/runtime4/float32.c @@ -259,6 +259,22 @@ CAMLprim value caml_fma_float32_bytecode(value f, value g, value h) return caml_copy_float32(fmaf(Float32_val(f), Float32_val(g), Float32_val(h))); } +float caml_float32_of_int64(int64_t i) { + return (float)i; +} + +CAMLprim value caml_float32_of_int64_bytecode(value i) { + return caml_copy_float32(caml_float32_of_int64(Int64_val(i))); +} + +int64_t caml_float32_to_int64(float f) { + return (int64_t)f; +} + +CAMLprim value caml_float32_to_int64_bytecode(value f) { + return caml_copy_int64(caml_float32_to_int64(Float32_val(f))); +} + float caml_float32_of_bits(int32_t bits) { union { float f; int32_t i; } u; diff --git a/tests/small_numbers/float32_lib.ml b/tests/small_numbers/float32_lib.ml index 1be9db1b5b6..327e0c98f93 100644 --- a/tests/small_numbers/float32_lib.ml +++ b/tests/small_numbers/float32_lib.ml @@ -11,9 +11,11 @@ module CF32 = struct external to_bits : (t [@unboxed]) -> (int32 [@unboxed]) = "float32_bits_to_int_boxed" "float32_bits_to_int" [@@noalloc] external of_int : (int [@untagged]) -> (t [@unboxed]) = "float32_of_int_boxed" "float32_of_int" [@@noalloc] + external of_int64 : (int64 [@unboxed]) -> (t [@unboxed]) = "float32_of_int64_boxed" "float32_of_int64" [@@noalloc] external of_float : (float [@unboxed]) -> (t [@unboxed]) = "float32_of_float_boxed" "float32_of_float" [@@noalloc] external to_int : (t [@unboxed]) -> (int [@untagged]) = "float32_to_int_boxed" "float32_to_int" [@@noalloc] + external to_int64 : (t [@unboxed]) -> (int64 [@unboxed]) = "float32_to_int64_boxed" "float32_to_int64" [@@noalloc] external to_float : (t [@unboxed]) -> (float [@unboxed]) = "float32_to_float_boxed" "float32_to_float" [@@noalloc] external zero : unit -> (t [@unboxed]) = "float32_zero_boxed" "float32_zero" [@@noalloc] @@ -339,13 +341,16 @@ let () = ); CF32.check_float32s (fun f _ -> assert (F32.to_int f = CF32.to_int f); + assert (F32.to_int64 f = CF32.to_int64 f); if CF32.is_nan f then assert (Float.is_nan (F32.to_float f)) else assert (F32.to_float f = CF32.to_float f) ); for _ = 0 to 100_000 do let i = if Random.bool () then Random.full_int Int.max_int else Int.neg (Random.full_int Int.max_int) in let f = if Random.bool () then Random.float Float.max_float else Float.neg (Random.float Float.max_float) in + let i64 = if Random.bool () then Random.int64 Int64.max_int else Int64.neg (Random.int64 Int64.max_int) in bit_eq (F32.of_int i) (CF32.of_int i); + bit_eq (F32.of_int64 i64) (CF32.of_int64 i64); bit_eq (F32.of_float f) (CF32.of_float f); done ;; diff --git a/tests/small_numbers/float32_u_lib.ml b/tests/small_numbers/float32_u_lib.ml index f9ca11958db..787a5fadd30 100644 --- a/tests/small_numbers/float32_u_lib.ml +++ b/tests/small_numbers/float32_u_lib.ml @@ -7,6 +7,8 @@ module F32 = Beta.Float32_u external box_int32 : int32# -> (int32[@local_opt]) = "%box_int32" external unbox_int32 : (int32[@local_opt]) -> int32# = "%unbox_int32" +external box_int64 : int64# -> (int64[@local_opt]) = "%box_int64" +external unbox_int64 : (int64[@local_opt]) -> int64# = "%unbox_int64" external box_float : float# -> (float[@local_opt]) = "%box_float" external unbox_float : (float[@local_opt]) -> float# = "%unbox_float" @@ -16,9 +18,11 @@ module CF32 = struct external to_bits : (t [@unboxed]) -> (int32 [@unboxed]) = "float32_bits_to_int_boxed" "float32_bits_to_int" [@@noalloc] external of_int : (int [@untagged]) -> (t [@unboxed]) = "float32_of_int_boxed" "float32_of_int" [@@noalloc] + external of_int64 : (int64 [@unboxed]) -> (t [@unboxed]) = "float32_of_int64_boxed" "float32_of_int64" [@@noalloc] external of_float : (float [@unboxed]) -> (t [@unboxed]) = "float32_of_float_boxed" "float32_of_float" [@@noalloc] external to_int : (t [@unboxed]) -> (int [@untagged]) = "float32_to_int_boxed" "float32_to_int" [@@noalloc] + external to_int64 : (t [@unboxed]) -> (int64 [@unboxed]) = "float32_to_int64_boxed" "float32_to_int64" [@@noalloc] external to_float : (t [@unboxed]) -> (float [@unboxed]) = "float32_to_float_boxed" "float32_to_float" [@@noalloc] external zero : unit -> (t [@unboxed]) = "float32_zero_boxed" "float32_zero" [@@noalloc] @@ -267,13 +271,16 @@ let () = CF32.check_float32s (fun f _ -> let u = F32.of_float32 f in assert (F32.to_int u = CF32.to_int f); + assert (box_int64 (F32.to_int64 u) = CF32.to_int64 f); if CF32.is_nan f then assert (Float.is_nan (box_float (F32.to_float u))) else assert (box_float (F32.to_float u) = CF32.to_float f) ); for _ = 0 to 100_000 do let i = if Random.bool () then Random.full_int Int.max_int else Int.neg (Random.full_int Int.max_int) in + let i64 = if Random.bool () then Random.int64 Int64.max_int else Int64.neg (Random.int64 Int64.max_int) in let f = if Random.bool () then Random.float Float.max_float else Float.neg (Random.float Float.max_float) in bit_eq (F32.of_int i) (CF32.of_int i); + bit_eq (F32.of_int64 (unbox_int64 i64)) (CF32.of_int64 i64); bit_eq (F32.of_float (unbox_float f)) (CF32.of_float f); done ;; diff --git a/tests/small_numbers/stubs.c b/tests/small_numbers/stubs.c index b77b5b49207..be933a47efb 100644 --- a/tests/small_numbers/stubs.c +++ b/tests/small_numbers/stubs.c @@ -7,8 +7,10 @@ int32_t float32_bits_to_int(float f) { return *(int32_t *)&f; } float float32_of_int(intnat i) { return (float)i; } +float float32_of_int64(int64_t i) { return (float)i; } float float32_of_float(double d) { return (float)d; } intnat float32_to_int(float f) { return (intnat)f; } +int64_t float32_to_int64(float f) { return (int64_t)f; } double float32_to_float(float f) { return (double)f; } float float32_zero(value unit) { return 0.0f; } float float32_neg_zero(value unit) { return -0.0f; }