Float32/Int64 cast intrinsics

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

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]

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]

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

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. *)
 

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;

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;

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

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

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