float32 otherlib (#2492)

Author: TheNumbat

dune

@@ -347,6 +347,7 @@
    %{dep:middle_end/flambda2/import/flambda2_import.a}
    %{dep:middle_end/flambda2/ui/flambda2_ui.a}
    %{dep:middle_end/flambda2/algorithms/flambda2_algorithms.a}
+   %{dep:middle_end/flambda2/numbers/floats/flambda2_floats.a}
    %{dep:middle_end/flambda2/numbers/flambda2_numbers.a}
    %{dep:middle_end/flambda2/kinds/flambda2_kinds.a}
    %{dep:middle_end/flambda2/identifiers/flambda2_identifiers.a}
@@ -383,6 +384,7 @@
    %{dep:middle_end/flambda2/import/flambda2_import.cma}
    %{dep:middle_end/flambda2/ui/flambda2_ui.cma}
    %{dep:middle_end/flambda2/algorithms/flambda2_algorithms.cma}
+   %{dep:middle_end/flambda2/numbers/floats/flambda2_floats.cma}
    %{dep:middle_end/flambda2/numbers/flambda2_numbers.cma}
    %{dep:middle_end/flambda2/kinds/flambda2_kinds.cma}
    %{dep:middle_end/flambda2/identifiers/flambda2_identifiers.cma}
@@ -419,6 +421,7 @@
    %{dep:middle_end/flambda2/import/flambda2_import.cmxa}
    %{dep:middle_end/flambda2/ui/flambda2_ui.cmxa}
    %{dep:middle_end/flambda2/algorithms/flambda2_algorithms.cmxa}
+   %{dep:middle_end/flambda2/numbers/floats/flambda2_floats.cmxa}
    %{dep:middle_end/flambda2/numbers/flambda2_numbers.cmxa}
    %{dep:middle_end/flambda2/kinds/flambda2_kinds.cmxa}
    %{dep:middle_end/flambda2/identifiers/flambda2_identifiers.cmxa}
@@ -462,12 +465,12 @@
   (external/gc-timings/libgc_timings_stubs.a
    as
    compiler-libs/libgc_timings_stubs_native.a)
-  (middle_end/flambda2/numbers/libflambda2_numbers_stubs.a
+  (middle_end/flambda2/numbers/floats/libflambda2_floats_stubs.a
    as
-   compiler-libs/libflambda2_numbers_stubs.a)
-  (middle_end/flambda2/numbers/libflambda2_numbers_stubs.a
+   compiler-libs/libflambda2_floats_stubs.a)
+  (middle_end/flambda2/numbers/floats/libflambda2_floats_stubs.a
    as
-   compiler-libs/libflambda2_numbers_stubs_native.a)
+   compiler-libs/libflambda2_floats_stubs_native.a)
   ; for special_dune compat
   (ocamloptcomp_with_flambda2.cma as compiler-libs/ocamloptcomp.cma)
   (ocamloptcomp_with_flambda2.cmxa as compiler-libs/ocamloptcomp.cmxa)

middle_end/flambda2/numbers/dune

@@ -7,19 +7,6 @@
   (backend bisect_ppx))
  (flags
   (:standard -principal -open Flambda2_algorithms -open Flambda2_ui))
- (foreign_stubs
-  (language c)
-  (names float32_stubs)
-  (flags
-   ((:include %{project_root}/oc_cflags.sexp)
-    (:include %{project_root}/sharedlib_cflags.sexp)
-    (:include %{project_root}/oc_cppflags.sexp))))
  (ocamlopt_flags
   (:standard -O3 -open Int_replace_polymorphic_compare))
- (libraries ocamlcommon flambda2_algorithms flambda2_ui))
-
-(install
- (files
-  (dllflambda2_numbers_stubs.so as stublibs/dllflambda2_numbers_stubs.so))
- (section lib)
- (package ocaml))
+ (libraries ocamlcommon flambda2_algorithms flambda2_ui flambda2_floats))

middle_end/flambda2/numbers/floats/dune

@@ -0,0 +1,24 @@
+(include_subdirs unqualified)
+
+(library
+ (name flambda2_floats)
+ (wrapped true)
+ (instrumentation
+  (backend bisect_ppx))
+ (flags
+  (:standard -principal))
+ (foreign_stubs
+  (language c)
+  (names float32_stubs)
+  (flags
+   ((:include %{project_root}/oc_cflags.sexp)
+    (:include %{project_root}/sharedlib_cflags.sexp)
+    (:include %{project_root}/oc_cppflags.sexp))))
+ (ocamlopt_flags
+  (:standard -O3)))
+
+(install
+ (files
+  (dllflambda2_floats_stubs.so as stublibs/dllflambda2_floats_stubs.so))
+ (section lib)
+ (package ocaml))

middle_end/flambda2/numbers/float32.ml renamed to middle_end/flambda2/numbers/floats/float32.ml

@@ -193,7 +193,7 @@ value compiler_float32_to_float_boxed(value i)
 static int compiler_float32_of_hex(const char * s, const char * end, float * res)
 {
   /* See caml_float_of_hex */
-  int64_t m = 0;                /* the mantissa - top 24 bits at most */
+  int64_t m = 0;                /* the mantissa - top 60 bits at most */
   int n_bits = 0;               /* total number of bits read */
   int m_bits = 0;               /* number of bits in mantissa */
   int x_bits = 0;               /* number of bits after mantissa */
@@ -240,12 +240,12 @@ static int compiler_float32_of_hex(const char * s, const char * end, float * res
       else return -1;           /* bad digit */
       n_bits += 4;
       if (d == 0 && m == 0) break; /* leading zeros are skipped */
-      if (m_bits < 24) {
+      if (m_bits < 60) {
         /* There is still room in m.  Add this digit to the mantissa. */
         m = (m << 4) + d;
         m_bits += 4;
       } else {
-        /* We've already collected 24 significant bits in m.
+        /* We've already collected 60 significant bits in m.
            Now all we care about is whether there is a nonzero bit
            after. In this case, round m to odd so that the later
            rounding of m to FP produces the correct result. */
@@ -258,7 +258,7 @@ static int compiler_float32_of_hex(const char * s, const char * end, float * res
   }
   if (n_bits == 0) return -1;
   /* Convert mantissa to FP.  We use a signed conversion because we can
-     (m has 24 bits at most) and because it is faster
+     (m has 60 bits at most) and because it is faster
      on several architectures. */
   f = (float) (int64_t) m;
   /* Adjust exponent to take decimal point and extra digits into account */
@@ -334,3 +334,15 @@ CAMLprim value compiler_float32_format(value fmt, value arg)
 
   return res;
 }
+
+// These replace the OCaml runtime versions for use under ocaml/ in the dune build.
+// They must have the same name as in the runtime because building ocaml/ with the
+// upstream build system calls it by name.
+
+CAMLweakdef value caml_float32_of_string(value vs) {
+  return compiler_float32_of_string(vs);
+}
+
+CAMLweakdef value caml_format_float32(value fmt, value arg) {
+  return compiler_float32_format(fmt, arg);
+}

middle_end/flambda2/numbers/float32.mli renamed to middle_end/flambda2/numbers/floats/float32.mli

@@ -320,7 +320,7 @@ end)
 
 module Float32_by_bit_pattern = Float_by_bit_pattern_gen (struct
   include Int32
-  module F32 = Float32
+  module F32 = Flambda2_floats.Float32
 
   let of_string str = F32.to_bits (F32.of_string str)
 

middle_end/flambda2/numbers/float32_stubs.c renamed to middle_end/flambda2/numbers/floats/float32_stubs.c

@@ -868,7 +868,8 @@ let rec comp_expr stack_info env exp sz cont =
       end
   | Lprim((Popaque _ | Pobj_magic _), [arg], _) ->
       comp_expr stack_info env arg sz cont
-  | Lprim((Pbox_float (Pfloat64, _) | Punbox_float Pfloat64), [arg], _) ->
+  | Lprim((Pbox_float ((Pfloat64 | Pfloat32), _)
+  | Punbox_float (Pfloat64 | Pfloat32)), [arg], _) ->
       comp_expr stack_info env arg sz cont
   | Lprim((Pbox_int _ | Punbox_int _), [arg], _) ->
       comp_expr stack_info env arg sz cont

middle_end/flambda2/numbers/numeric_types.ml

@@ -144,11 +144,15 @@ let output_primitive_table outchan =
 
 (* Translate structured constants *)
 
+(* We cannot use the [float32] type in the compiler, so we represent it as an
+   opaque [Obj.t]. This is sufficient for interfacing with the runtime. *)
+external float32_of_string : string -> Obj.t = "caml_float32_of_string"
+
 let rec transl_const = function
     Const_base(Const_int i) -> Obj.repr i
   | Const_base(Const_char c) -> Obj.repr c
   | Const_base(Const_string (s, _, _)) -> Obj.repr s
-  | Const_base(Const_float32 f)
+  | Const_base(Const_float32 f) -> float32_of_string f
   | Const_base(Const_float f)
   | Const_base(Const_unboxed_float f) -> Obj.repr (float_of_string f)
   | Const_base(Const_int32 i)

ocaml/boot/ocamllex

@@ -67,6 +67,7 @@
           (run cat %{input-file})))
        parser)))
  (library_flags -linkall)
+ (libraries flambda2_floats)
  (modules_without_implementation
    annot asttypes cmo_format outcometree parsetree debug_event solver_intf mode_intf)
  (modules

ocaml/bytecomp/bytegen.ml

@@ -1,2 +1,4 @@
 alpha.mli
 alpha.ml
+float32.mli
+float32.ml

ocaml/bytecomp/symtable.ml

@@ -0,0 +1 @@
+module Float32 = Float32

ocaml/dune

@@ -0,0 +1 @@
+module Float32 = Float32

ocaml/otherlibs/alpha/.ocamlformat-enable

@@ -41,9 +41,14 @@
   (alpha.cmxs as alpha/alpha.cmxs)
   (alpha.cma as alpha/alpha.cma)
   (alpha.mli as alpha/alpha.mli)
+  (float32.mli as alpha/float32.mli)
   (.alpha.objs/byte/alpha.cmi as alpha/alpha.cmi)
   (.alpha.objs/byte/alpha.cmt as alpha/alpha.cmt)
   (.alpha.objs/byte/alpha.cmti as alpha/alpha.cmti)
-  (.alpha.objs/native/alpha.cmx as alpha/alpha.cmx))
+  (.alpha.objs/native/alpha.cmx as alpha/alpha.cmx)
+  (.alpha.objs/byte/float32.cmi as alpha/float32.cmi)
+  (.alpha.objs/byte/float32.cmt as alpha/float32.cmt)
+  (.alpha.objs/byte/float32.cmti as alpha/float32.cmti)
+  (.alpha.objs/native/float32.cmx as alpha/float32.cmx))
  (section lib)
  (package ocaml))