add -no-flat-float-array configure option

52 files changed, 899 insertions, 96 deletions

diff --git a/.gitignore b/.gitignore
index 39fc7569f2..d07bd88379 100644
--- a/.gitignore
+++ b/.gitignore
@@ -309,6 +309,10 @@
 /testsuite/tests/tool-lexyacc/grammar.mli
 /testsuite/tests/tool-lexyacc/grammar.ml
 
+/testsuite/tests/typing-misc/false.flat-float
+/testsuite/tests/typing-misc/true.flat-float
+/testsuite/tests/typing-misc/pr6939.ml
+
 /testsuite/tests/typing-multifile/a.ml
 /testsuite/tests/typing-multifile/b.ml
 /testsuite/tests/typing-multifile/c.ml
@@ -318,6 +322,15 @@
 /testsuite/tests/typing-multifile/g.ml
 /testsuite/tests/typing-multifile/test
 
+/testsuite/tests/typing-unboxed-types/false.flat-float
+/testsuite/tests/typing-unboxed-types/true.flat-float
+/testsuite/tests/typing-unboxed-types/test.ml.reference
+
+/testsuite/tests/translprim/false.flat-float
+/testsuite/tests/translprim/true.flat-float
+/testsuite/tests/translprim/array_spec.ml.reference
+/testsuite/tests/translprim/module_coercion.ml.reference
+
 /testsuite/tests/unboxed-primitive-args/main.ml
 /testsuite/tests/unboxed-primitive-args/stubs.c
 
diff --git a/Changes b/Changes
index d3f4e7b15f..4dacd16dd8 100644
--- a/Changes
+++ b/Changes
@@ -106,6 +106,12 @@ Working version
   to GPR#1250.)
   (Mark Shinwell)
 
+- GPR#1294: Add a configure-time option to remove the dynamic float array
+  optimization and add a floatarray type to let the user choose when to
+  flatten float arrays. Note that float-only records are unchanged: they
+  are still optimized by unboxing their fields.
+  (Damien Doligez, review by Alain Frisch and Mark Shinwell)
+
 - GPR#1304: Mark registers clobbered by PLT stubs as destroyed across
   allocations.
   (Mark Shinwell, Xavier Clerc, report and initial debugging by
diff --git a/Makefile b/Makefile
index 6aea091331..470a3ca48c 100644
--- a/Makefile
+++ b/Makefile
@@ -355,6 +355,7 @@ utils/config.ml: utils/config.mlp config/Makefile
 	    -e 's|%%WITH_PROFINFO%%|$(WITH_PROFINFO)|' \
 	    -e 's|%%WITH_SPACETIME%%|$(WITH_SPACETIME)|' \
 	    -e 's|%%WITH_SPACETIME_CALL_COUNTS%%|$(WITH_SPACETIME_CALL_COUNTS)|' \
+	    -e 's|%%FLAT_FLOAT_ARRAY%%|$(FLAT_FLOAT_ARRAY)|' \
 	    $< > $@
 
 ifeq "$(UNIX_OR_WIN32)" "unix"
diff --git a/asmrun/spacetime_snapshot.c b/asmrun/spacetime_snapshot.c
index ac2890cbfd..ff4dcdca63 100644
--- a/asmrun/spacetime_snapshot.c
+++ b/asmrun/spacetime_snapshot.c
@@ -258,7 +258,7 @@ static value take_snapshot(double time_override, int use_time_override)
 
   CAMLassert(sizeof(double) == sizeof(value));
   v_time = allocate_outside_heap_with_tag(sizeof(double), Double_tag);
-  Double_field(v_time, 0) = time;
+  Store_double_val(v_time, time);
 
   v_snapshot = allocate_outside_heap(sizeof(snapshot));
   heap_snapshot = (snapshot*) v_snapshot;
@@ -394,7 +394,7 @@ value caml_spacetime_timestamp(double time_override, int use_time_override)
   }
 
   v_time = allocate_outside_heap_with_tag(sizeof(double), Double_tag);
-  Double_field(v_time, 0) = time;
+  Store_double_val(v_time, time);
 
   return v_time;
 }
diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml
index 55b4b05b9b..6368cdcaf7 100644
--- a/bytecomp/bytegen.ml
+++ b/bytecomp/bytegen.ml
@@ -376,16 +376,16 @@ let comp_primitive p args =
   | Pstring_set_64(_) -> Kccall("caml_string_set64", 3)
   | Parraylength _ -> Kvectlength
   | Parrayrefs Pgenarray -> Kccall("caml_array_get", 2)
-  | Parrayrefs Pfloatarray -> Kccall("caml_array_get_float", 2)
+  | Parrayrefs Pfloatarray -> Kccall("caml_floatarray_get", 2)
   | Parrayrefs _ -> Kccall("caml_array_get_addr", 2)
   | Parraysets Pgenarray -> Kccall("caml_array_set", 3)
-  | Parraysets Pfloatarray -> Kccall("caml_array_set_float", 3)
+  | Parraysets Pfloatarray -> Kccall("caml_floatarray_set", 3)
   | Parraysets _ -> Kccall("caml_array_set_addr", 3)
   | Parrayrefu Pgenarray -> Kccall("caml_array_unsafe_get", 2)
-  | Parrayrefu Pfloatarray -> Kccall("caml_array_unsafe_get_float", 2)
+  | Parrayrefu Pfloatarray -> Kccall("caml_floatarray_unsafe_get", 2)
   | Parrayrefu _ -> Kgetvectitem
   | Parraysetu Pgenarray -> Kccall("caml_array_unsafe_set", 3)
-  | Parraysetu Pfloatarray -> Kccall("caml_array_unsafe_set_float", 3)
+  | Parraysetu Pfloatarray -> Kccall("caml_floatarray_unsafe_set", 3)
   | Parraysetu _ -> Ksetvectitem
   | Pctconst c ->
      let const_name = match c with
diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml
index d2936f4162..3af60fb043 100644
--- a/bytecomp/symtable.ml
+++ b/bytecomp/symtable.ml
@@ -220,7 +220,10 @@ let rec transl_const = function
         fields;
       block
   | Const_float_array fields ->
-      Obj.repr(Array.of_list(List.map (fun f -> float_of_string f) fields))
+      let res = Array.Floatarray.create (List.length fields) in
+      List.iteri (fun i f -> Array.Floatarray.set res i (float_of_string f))
+        fields;
+      Obj.repr res
 
 (* Build the initial table of globals *)
 
diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml
index af123b9cc4..f52d615950 100644
--- a/bytecomp/translcore.ml
+++ b/bytecomp/translcore.ml
@@ -162,6 +162,9 @@ let comparisons_table = create_hashtable 11 [
        false)
 ]
 
+let gen_array_kind =
+  if Config.flat_float_array then Pgenarray else Paddrarray
+
 let primitives_table = create_hashtable 57 [
   "%identity", Pidentity;
   "%bytes_to_string", Pbytes_to_string;
@@ -239,14 +242,14 @@ let primitives_table = create_hashtable 57 [
   "%bytes_safe_set", Pbytessets;
   "%bytes_unsafe_get", Pbytesrefu;
   "%bytes_unsafe_set", Pbytessetu;
-  "%array_length", Parraylength Pgenarray;
-  "%array_safe_get", Parrayrefs Pgenarray;
-  "%array_safe_set", Parraysets Pgenarray;
-  "%array_unsafe_get", Parrayrefu Pgenarray;
-  "%array_unsafe_set", Parraysetu Pgenarray;
-  "%obj_size", Parraylength Pgenarray;
-  "%obj_field", Parrayrefu Pgenarray;
-  "%obj_set_field", Parraysetu Pgenarray;
+  "%array_length", Parraylength gen_array_kind;
+  "%array_safe_get", Parrayrefs gen_array_kind;
+  "%array_safe_set", Parraysets gen_array_kind;
+  "%array_unsafe_get", Parrayrefu gen_array_kind;
+  "%array_unsafe_set", Parraysetu gen_array_kind;
+  "%obj_size", Parraylength gen_array_kind;
+  "%obj_field", Parrayrefu gen_array_kind;
+  "%obj_set_field", Parraysetu gen_array_kind;
   "%floatarray_length", Parraylength Pfloatarray;
   "%floatarray_safe_get", Parrayrefs Pfloatarray;
   "%floatarray_safe_set", Parraysets Pfloatarray;
@@ -382,6 +385,28 @@ let specialize_comparison table env ty =
   | () when is_base_type env ty Predef.path_int64     -> int64comp
   | () -> gencomp
 
+(* The following function computes the greatest lower bound in the
+   semilattice of array kinds:
+          gen
+         /   \
+      addr   float
+       |
+      int
+   Note that the GLB is not guaranteed to exist, in which case we return
+   our first argument instead of raising a fatal error because, although
+   it cannot happen in a well-typed program, (ab)use of Obj.magic can
+   probably trigger it.
+*)
+let glb_array_type t1 t2 =
+  match t1, t2 with
+  | Pfloatarray, (Paddrarray | Pintarray)
+  | (Paddrarray | Pintarray), Pfloatarray -> t1
+
+  | Pgenarray, x | x, Pgenarray -> x
+  | Paddrarray, x | x, Paddrarray -> x
+  | Pintarray, Pintarray -> Pintarray
+  | Pfloatarray, Pfloatarray -> Pfloatarray
+
 (* Specialize a primitive from available type information,
    raise Not_found if primitive is unknown  *)
 
@@ -408,11 +433,16 @@ let specialize_primitive p env ty ~has_constant_constructor =
     match (p, params) with
       (Psetfield(n, _, init), [_p1; p2]) ->
         Psetfield(n, maybe_pointer_type env p2, init)
-    | (Parraylength Pgenarray, [p])   -> Parraylength(array_type_kind env p)
-    | (Parrayrefu Pgenarray, p1 :: _) -> Parrayrefu(array_type_kind env p1)
-    | (Parraysetu Pgenarray, p1 :: _) -> Parraysetu(array_type_kind env p1)
-    | (Parrayrefs Pgenarray, p1 :: _) -> Parrayrefs(array_type_kind env p1)
-    | (Parraysets Pgenarray, p1 :: _) -> Parraysets(array_type_kind env p1)
+    | (Parraylength t, [p])   ->
+        Parraylength(glb_array_type t (array_type_kind env p))
+    | (Parrayrefu t, p1 :: _) ->
+        Parrayrefu(glb_array_type t (array_type_kind env p1))
+    | (Parraysetu t, p1 :: _) ->
+        Parraysetu(glb_array_type t (array_type_kind env p1))
+    | (Parrayrefs t, p1 :: _) ->
+        Parrayrefs(glb_array_type t (array_type_kind env p1))
+    | (Parraysets t, p1 :: _) ->
+        Parraysets(glb_array_type t (array_type_kind env p1))
     | (Pbigarrayref(unsafe, n, Pbigarray_unknown, Pbigarray_unknown_layout),
        p1 :: _) ->
         let (k, l) = bigarray_type_kind_and_layout env p1 in
diff --git a/bytecomp/typeopt.ml b/bytecomp/typeopt.ml
index 4416cf92b6..cf76a9538d 100644
--- a/bytecomp/typeopt.ml
+++ b/bytecomp/typeopt.ml
@@ -101,12 +101,14 @@ let array_type_kind env ty =
   | Tconstr(p, [elt_ty], _) | Tpoly({desc = Tconstr(p, [elt_ty], _)}, _)
     when Path.same p Predef.path_array ->
       begin match classify env elt_ty with
-      | Any -> Pgenarray
-      | Float -> Pfloatarray
+      | Any -> if Config.flat_float_array then Pgenarray else Paddrarray
+      | Float -> if Config.flat_float_array then Pfloatarray else Paddrarray
       | Addr | Lazy -> Paddrarray
       | Int -> Pintarray
       end
-
+  | Tconstr(p, [], _) | Tpoly({desc = Tconstr(p, [], _)}, _)
+    when Path.same p Predef.path_floatarray ->
+      Pfloatarray
   | _ ->
       (* This can happen with e.g. Obj.field *)
       Pgenarray
@@ -170,5 +172,6 @@ let value_kind env ty =
 
 let lazy_val_requires_forward env ty =
   match classify env ty with
-  | Any | Float | Lazy -> true
+  | Any | Lazy -> true
+  | Float -> Config.flat_float_array
   | Addr | Int -> false
diff --git a/byterun/alloc.c b/byterun/alloc.c
index d664bd9419..e49fabd017 100644
--- a/byterun/alloc.c
+++ b/byterun/alloc.c
@@ -161,6 +161,7 @@ CAMLexport value caml_alloc_array(value (*funct)(char const *),
 /* [len] is a number of floats */
 CAMLprim value caml_alloc_float_array(mlsize_t len)
 {
+#ifdef FLAT_FLOAT_ARRAY
   mlsize_t wosize = len * Double_wosize;
   value result;
   /* For consistency with [caml_make_vect], which can't tell whether it should
@@ -176,6 +177,9 @@ CAMLprim value caml_alloc_float_array(mlsize_t len)
     result = caml_check_urgent_gc (result);
   }
   return result;
+#else
+  return caml_alloc (len, 0);
+#endif
 }
 
 
@@ -232,7 +236,7 @@ CAMLprim value caml_update_dummy(value dummy, value newval)
   if (tag == Double_array_tag){
     size = Wosize_val (newval) / Double_wosize;
     for (i = 0; i < size; i++){
-      Store_double_field (dummy, i, Double_field (newval, i));
+      Store_double_flat_field (dummy, i, Double_flat_field (newval, i));
     }
   }else{
     for (i = 0; i < size; i++){
diff --git a/byterun/array.c b/byterun/array.c
index a2e3908946..5367532bb1 100644
--- a/byterun/array.c
+++ b/byterun/array.c
@@ -29,11 +29,14 @@
 static const mlsize_t mlsize_t_max = -1;
 
 /* returns number of elements (either fields or floats) */
+/* [ 'a array -> int ] */
 CAMLexport mlsize_t caml_array_length(value array)
 {
+#ifdef FLAT_FLOAT_ARRAY
   if (Tag_val(array) == Double_array_tag)
     return Wosize_val(array) / Double_wosize;
   else
+#endif
     return Wosize_val(array);
 }
 
@@ -42,6 +45,12 @@ CAMLexport int caml_is_double_array(value array)
   return (Tag_val(array) == Double_array_tag);
 }
 
+/* Note: the OCaml types on the following primitives will work both with
+   and without the -no-flat-float-array configure-time option. If you
+   respect them, your C code should work in both configurations.
+*/
+
+/* [ 'a array -> int -> 'a ] where 'a != float */
 CAMLprim value caml_array_get_addr(value array, value index)
 {
   intnat idx = Long_val(index);
@@ -49,15 +58,17 @@ CAMLprim value caml_array_get_addr(value array, value index)
   return Field(array, idx);
 }
 
+/* [ float array -> int -> float ] */
 CAMLprim value caml_array_get_float(value array, value index)
 {
   intnat idx = Long_val(index);
+#ifdef FLAT_FLOAT_ARRAY
   double d;
   value res;
 
   if (idx < 0 || idx >= Wosize_val(array) / Double_wosize)
     caml_array_bound_error();
-  d = Double_field(array, idx);
+  d = Double_flat_field(array, idx);
 #define Setup_for_gc
 #define Restore_after_gc
   Alloc_small(res, Double_wosize, Double_tag);
@@ -65,16 +76,46 @@ CAMLprim value caml_array_get_float(value array, value index)
 #undef Restore_after_gc
   Store_double_val(res, d);
   return res;
+#else
+  CAMLassert (Tag_val (array) != Double_array_tag);
+  if (idx < 0 || idx >= Wosize_val(array)) caml_array_bound_error();
+  return Field(array, idx);
+#endif /* FLAT_FLOAT_ARRAY */
 }
 
+/* [ 'a array -> int -> 'a ] */
 CAMLprim value caml_array_get(value array, value index)
 {
+#ifdef FLAT_FLOAT_ARRAY
   if (Tag_val(array) == Double_array_tag)
     return caml_array_get_float(array, index);
-  else
-    return caml_array_get_addr(array, index);
+#else
+  CAMLassert (Tag_val(array) != Double_array_tag);
+#endif
+  return caml_array_get_addr(array, index);
 }
 
+/* [ floatarray -> int -> float ] */
+CAMLprim value caml_floatarray_get(value array, value index)
+{
+  intnat idx = Long_val(index);
+  double d;
+  value res;
+
+  CAMLassert (Tag_val(array) == Double_array_tag);
+  if (idx < 0 || idx >= Wosize_val(array) / Double_wosize)
+    caml_array_bound_error();
+  d = Double_flat_field(array, idx);
+#define Setup_for_gc
+#define Restore_after_gc
+  Alloc_small(res, Double_wosize, Double_tag);
+#undef Setup_for_gc
+#undef Restore_after_gc
+  Store_double_val(res, d);
+  return res;
+}
+
+/* [ 'a array -> int -> 'a -> unit ] where 'a != float */
 CAMLprim value caml_array_set_addr(value array, value index, value newval)
 {
   intnat idx = Long_val(index);
@@ -83,29 +124,56 @@ CAMLprim value caml_array_set_addr(value array, value index, value newval)
   return Val_unit;
 }
 
+/* [ float array -> int -> float -> unit ] */
 CAMLprim value caml_array_set_float(value array, value index, value newval)
 {
   intnat idx = Long_val(index);
+#ifdef FLAT_FLOAT_ARRAY
+  double d = Double_val (newval);
   if (idx < 0 || idx >= Wosize_val(array) / Double_wosize)
     caml_array_bound_error();
-  Store_double_field(array, idx, Double_val(newval));
+  Store_double_flat_field(array, idx, d);
+#else
+  CAMLassert (Tag_val (array) != Double_array_tag);
+  if (idx < 0 || idx >= Wosize_val(array)) caml_array_bound_error();
+  Modify(&Field(array, idx), newval);
+#endif
   return Val_unit;
 }
 
+/* [ 'a array -> int -> 'a -> unit ] */
 CAMLprim value caml_array_set(value array, value index, value newval)
 {
+#ifdef FLAT_FLOAT_ARRAY
   if (Tag_val(array) == Double_array_tag)
     return caml_array_set_float(array, index, newval);
-  else
-    return caml_array_set_addr(array, index, newval);
+#else
+  CAMLassert (Tag_val(array) != Double_array_tag);
+#endif
+  return caml_array_set_addr(array, index, newval);
 }
 
+/* [ floatarray -> int -> float -> unit ] */
+CAMLprim value caml_floatarray_set(value array, value index, value newval)
+{
+  intnat idx = Long_val(index);
+  double d = Double_val (newval);
+  CAMLassert (Tag_val(array) == Double_array_tag);
+  if (idx < 0 || idx >= Wosize_val(array) / Double_wosize)
+    caml_array_bound_error();
+  Store_double_flat_field(array, idx, d);
+  return Val_unit;
+}
+
+/* [ float array -> int -> float ] */
 CAMLprim value caml_array_unsafe_get_float(value array, value index)
 {
+  intnat idx = Long_val (index);
+#ifdef FLAT_FLOAT_ARRAY
   double d;
   value res;
 
-  d = Double_field(array, Long_val(index));
+  d = Double_flat_field(array, idx);
 #define Setup_for_gc
 #define Restore_after_gc
   Alloc_small(res, Double_wosize, Double_tag);
@@ -113,14 +181,22 @@ CAMLprim value caml_array_unsafe_get_float(value array, value index)
 #undef Restore_after_gc
   Store_double_val(res, d);
   return res;
+#else /* FLAT_FLOAT_ARRAY */
+  CAMLassert (Tag_val(array) != Double_array_tag);
+  return Field(array, idx);
+#endif /* FLAT_FLOAT_ARRAY */
 }
 
+/* [ 'a array -> int -> 'a ] */
 CAMLprim value caml_array_unsafe_get(value array, value index)
 {
+#ifdef FLAT_FLOAT_ARRAY
   if (Tag_val(array) == Double_array_tag)
     return caml_array_unsafe_get_float(array, index);
-  else
-    return Field(array, Long_val(index));
+#else
+  CAMLassert (Tag_val(array) != Double_array_tag);
+#endif
+  return Field(array, Long_val(index));
 }
 
 /* [ floatarray -> int -> float ] */
@@ -141,6 +217,7 @@ CAMLprim value caml_floatarray_unsafe_get(value array, value index)
   return res;
 }
 
+/* [ 'a array -> int -> 'a -> unit ] where 'a != float */
 CAMLprim value caml_array_unsafe_set_addr(value array, value index,value newval)
 {
   intnat idx = Long_val(index);
@@ -148,18 +225,29 @@ CAMLprim value caml_array_unsafe_set_addr(value array, value index,value newval)
   return Val_unit;
 }
 
+/* [ float array -> int -> float -> unit ] */
 CAMLprim value caml_array_unsafe_set_float(value array,value index,value newval)
 {
-  Store_double_field(array, Long_val(index), Double_val(newval));
+  intnat idx = Long_val(index);
+#ifdef FLAT_FLOAT_ARRAY
+  double d = Double_val (newval);
+  Store_double_flat_field(array, idx, d);
+#else
+  Modify(&Field(array, idx), newval);
+#endif
   return Val_unit;
 }
 
+/* [ 'a array -> int -> 'a -> unit ] */
 CAMLprim value caml_array_unsafe_set(value array, value index, value newval)
 {
+#ifdef FLAT_FLOAT_ARRAY
   if (Tag_val(array) == Double_array_tag)
     return caml_array_unsafe_set_float(array, index, newval);
-  else
-    return caml_array_unsafe_set_addr(array, index, newval);
+#else
+  CAMLassert (Tag_val(array) != Double_array_tag);
+#endif
+  return caml_array_unsafe_set_addr(array, index, newval);
 }
 
 /* [ floatarray -> int -> float -> unit ] */
@@ -187,7 +275,7 @@ CAMLprim value caml_floatarray_create(value len)
 #undef Setup_for_gc
 #undef Restore_after_gc
   }else if (wosize > Max_wosize)
-    caml_invalid_argument("Array.create_float");
+    caml_invalid_argument("Array.Floatarray.create");
   else {
     result = caml_alloc_shr (wosize, Double_array_tag);
     result = caml_check_urgent_gc (result);
@@ -196,9 +284,14 @@ CAMLprim value caml_floatarray_create(value len)
 }
 
 /* [len] is a [value] representing number of floats */
+/* [ int -> float array ] */
 CAMLprim value caml_make_float_vect(value len)
 {
+#ifdef FLAT_FLOAT_ARRAY
   return caml_floatarray_create (len);
+#else
+  return caml_alloc (Long_val (len), 0);
+#endif
 }
 
 /* [len] is a [value] representing number of words or floats */
@@ -207,23 +300,25 @@ CAMLprim value caml_make_vect(value len, value init)
 {
   CAMLparam2 (len, init);
   CAMLlocal1 (res);
-  mlsize_t size, wsize, i;
-  double d;
+  mlsize_t size, i;
 
   size = Long_val(len);
   if (size == 0) {
     res = Atom(0);
-  }
-  else if (Is_block(init)
+#ifdef FLAT_FLOAT_ARRAY
+  } else if (Is_block(init)
            && Is_in_value_area(init)
            && Tag_val(init) == Double_tag) {
+    mlsize_t wsize;
+    double d;
     d = Double_val(init);
     wsize = size * Double_wosize;
     if (wsize > Max_wosize) caml_invalid_argument("Array.make");
     res = caml_alloc(wsize, Double_array_tag);
     for (i = 0; i < size; i++) {
-      Store_double_field(res, i, d);
+      Store_double_flat_field(res, i, d);
     }
+#endif
   } else {
     if (size <= Max_young_wosize) {
       uintnat profinfo;
@@ -251,8 +346,15 @@ CAMLprim value caml_make_vect(value len, value init)
   CAMLreturn (res);
 }
 
+/* This primitive is used internally by the compiler to compile
+   explicit array expressions.
+   For float arrays when FLAT_FLOAT_ARRAY is true, it takes an array of
+   boxed floats and returns the corresponding flat-allocated [float array].
+   In all other cases, it just returns its argument unchanged.
+*/
 CAMLprim value caml_make_array(value init)
 {
+#ifdef FLAT_FLOAT_ARRAY
   CAMLparam1 (init);
   mlsize_t wsize, size, i;
   CAMLlocal2 (v, res);
@@ -275,11 +377,15 @@ CAMLprim value caml_make_array(value init)
         res = caml_check_urgent_gc(res);
       }
       for (i = 0; i < size; i++) {
-        Store_double_field(res, i, Double_val(Field(init, i)));
+        double d = Double_val(Field(init, i));
+        Store_double_flat_field(res, i, d);
       }
       CAMLreturn (res);
     }
   }
+#else
+  return init;
+#endif
 }
 
 /* Blitting */
@@ -290,6 +396,7 @@ CAMLprim value caml_array_blit(value a1, value ofs1, value a2, value ofs2,
   value * src, * dst;
   intnat count;
 
+#ifdef FLAT_FLOAT_ARRAY
   if (Tag_val(a2) == Double_array_tag) {
     /* Arrays of floats.  The values being copied are floats, not
        pointer, so we can do a direct copy.  memmove takes care of
@@ -299,6 +406,8 @@ CAMLprim value caml_array_blit(value a1, value ofs1, value a2, value ofs2,
             Long_val(n) * sizeof(double));
     return Val_unit;
   }
+#endif
+  CAMLassert (Tag_val(a2) != Double_array_tag);
   if (Is_young(a2)) {
     /* Arrays of values, destination is in young generation.
        Here too we can do a direct copy since this cannot create
@@ -343,22 +452,27 @@ static value caml_array_gather(intnat num_arrays,
 {
   CAMLparamN(arrays, num_arrays);
   value res;                    /* no need to register it as a root */
-  int isfloat;
-  mlsize_t i, size, wsize, count, pos;
+#ifdef FLAT_FLOAT_ARRAY
+  int isfloat = 0;
+  mlsize_t wsize;
+#endif
+  mlsize_t i, size, count, pos;
   value * src;
 
   /* Determine total size and whether result array is an array of floats */
   size = 0;
-  isfloat = 0;
   for (i = 0; i < num_arrays; i++) {
     if (mlsize_t_max - lengths[i] < size) caml_invalid_argument("Array.concat");
     size += lengths[i];
+#ifdef FLAT_FLOAT_ARRAY
     if (Tag_val(arrays[i]) == Double_array_tag) isfloat = 1;
+#endif
   }
   if (size == 0) {
     /* If total size = 0, just return empty array */
     res = Atom(0);
   }
+#ifdef FLAT_FLOAT_ARRAY
   else if (isfloat) {
     /* This is an array of floats.  We can use memcpy directly. */
     if (size > Max_wosize/Double_wosize) caml_invalid_argument("Array.concat");
@@ -372,6 +486,7 @@ static value caml_array_gather(intnat num_arrays,
     }
     CAMLassert(pos == size);
   }
+#endif
   else if (size <= Max_young_wosize) {
     /* Array of values, small enough to fit in young generation.
        We can use memcpy directly. */
diff --git a/byterun/caml/mlvalues.h b/byterun/caml/mlvalues.h
index 3e0600c0f6..c3c3a835af 100644
--- a/byterun/caml/mlvalues.h
+++ b/byterun/caml/mlvalues.h
@@ -277,16 +277,47 @@ CAMLextern void caml_Store_double_val (value,double);
 
 /* Arrays of floating-point numbers. */
 #define Double_array_tag 254
-#define Double_field(v,i) Double_val((value)((double *)(v) + (i)))
-#define Store_double_field(v,i,d) do{ \
+
+/* The [_flat_field] macros are for [floatarray] values and float-only records.
+*/
+#define Double_flat_field(v,i) Double_val((value)((double *)(v) + (i)))
+#define Store_double_flat_field(v,i,d) do{ \
   mlsize_t caml__temp_i = (i); \
   double caml__temp_d = (d); \
   Store_double_val((value)((double *) (v) + caml__temp_i), caml__temp_d); \
 }while(0)
 
-/* temporary definitions for bootstrapping */
-#define Double_flat_field Double_field
-#define Store_double_flat_field Store_double_field
+/* The [_array_field] macros are for [float array]. */
+#ifdef FLAT_FLOAT_ARRAY
+  #define Double_array_field(v,i) Double_flat_field(v,i)
+  #define Store_double_array_field(v,i,d) Store_double_flat_field(v,i,d)
+#else
+  #define Double_array_field(v,i) Double_val (Field(v,i))
+  CAMLextern void caml_Store_double_array_field (value, mlsize_t, double);
+  #define Store_double_array_field(v,i,d) caml_Store_double_array_field (v,i,d)
+#endif
+
+/* The old [_field] macros are for backward compatibility only.
+   They work with [floatarray], float-only records, and [float array]. */
+#ifdef FLAT_FLOAT_ARRAY
+  #define Double_field(v,i) Double_flat_field(v,i)
+  #define Store_double_field(v,i,d) Store_double_flat_field(v,i,d)
+#else
+  static inline double Double_field (value v, mlsize_t i) {
+    if (Tag_val (v) == Double_array_tag){
+      return Double_flat_field (v, i);
+    }else{
+      return Double_array_field (v, i);
+    }
+  }
+  static inline void Store_double_field (value v, mlsize_t i, double d) {
+    if (Tag_val (v) == Double_array_tag){
+      Store_double_flat_field (v, i, d);
+    }else{
+      Store_double_array_field (v, i, d);
+    }
+  }
+#endif /* FLAT_FLOAT_ARRAY */
 
 CAMLextern mlsize_t caml_array_length (value);   /* size in items */
 CAMLextern int caml_is_double_array (value);   /* 0 is false, 1 is true */
diff --git a/byterun/compare.c b/byterun/compare.c
index a6582f02c1..382c9dfffa 100644
--- a/byterun/compare.c
+++ b/byterun/compare.c
@@ -228,9 +228,9 @@ static intnat do_compare_val(struct compare_stack* stk,
       mlsize_t i;
       if (sz1 != sz2) return sz1 - sz2;
       for (i = 0; i < sz1; i++) {
-        double d1 = Double_field(v1, i);
-        double d2 = Double_field(v2, i);
-#ifdef LACKS_SANE_NAN
+        double d1 = Double_flat_field(v1, i);
+        double d2 = Double_flat_field(v2, i);
+  #ifdef LACKS_SANE_NAN
         if (isnan(d2)) {
           if (! total) return UNORDERED;
           if (isnan(d1)) break;
@@ -239,17 +239,17 @@ static intnat do_compare_val(struct compare_stack* stk,
           if (! total) return UNORDERED;
           return LESS;
         }
-#endif
+  #endif
         if (d1 < d2) return LESS;
         if (d1 > d2) return GREATER;
-#ifndef LACKS_SANE_NAN
+  #ifndef LACKS_SANE_NAN
         if (d1 != d2) {
           if (! total) return UNORDERED;
           /* See comment for Double_tag case */
           if (d1 == d1) return GREATER;
           if (d2 == d2) return LESS;
         }
-#endif
+  #endif
       }
       break;
     }
diff --git a/byterun/debugger.c b/byterun/debugger.c
index 8cf3025855..a11939b31c 100644
--- a/byterun/debugger.c
+++ b/byterun/debugger.c
@@ -411,7 +411,7 @@ void caml_debugger(enum event_kind event)
         caml_putch(dbg_out, 0);
         putval(dbg_out, Field(val, i));
       } else {
-        double d = Double_field(val, i);
+        double d = Double_flat_field(val, i);
         caml_putch(dbg_out, 1);
         caml_really_putblock(dbg_out, (char *) &d, 8);
       }
diff --git a/byterun/extern.c b/byterun/extern.c
index d550d8b13f..adebc910b8 100644
--- a/byterun/extern.c
+++ b/byterun/extern.c
@@ -421,7 +421,11 @@ static void extern_rec(value v)
       value f = Forward_val (v);
       if (Is_block (f)
           && (!Is_in_value_area(f) || Tag_val (f) == Forward_tag
-              || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag)){
+              || Tag_val (f) == Lazy_tag
+#ifdef FLAT_FLOAT_ARRAY
+              || Tag_val (f) == Double_tag
+#endif
+              )){
         /* Do not short-circuit the pointer. */
       }else{
         v = f;
diff --git a/byterun/finalise.c b/byterun/finalise.c
index 12fe92b494..9a41ff784e 100644
--- a/byterun/finalise.c
+++ b/byterun/finalise.c
@@ -375,7 +375,9 @@ static void generic_final_register (struct finalisable *final, value f, value v)
   if (!Is_block (v)
       || !Is_in_heap_or_young(v)
       || Tag_val (v) == Lazy_tag
+#ifdef FLAT_FLOAT_ARRAY
       || Tag_val (v) == Double_tag
+#endif
       || Tag_val (v) == Forward_tag) {
     caml_invalid_argument ("Gc.finalise");
   }
diff --git a/byterun/floats.c b/byterun/floats.c
index 5d65dd0be6..fe313c59f0 100644
--- a/byterun/floats.c
+++ b/byterun/floats.c
@@ -79,6 +79,18 @@ CAMLexport value caml_copy_double(double d)
   return res;
 }
 
+#ifndef FLAT_FLOAT_ARRAY
+CAMLexport void caml_Store_double_array_field(value val, mlsize_t i, double dbl)
+{
+  CAMLparam1 (val);
+  value d = caml_copy_double (dbl);
+
+  CAMLassert (Tag_val (val) != Double_array_tag);
+  caml_modify (&Field(val, i), d);
+  CAMLreturn0;
+}
+#endif /* ! FLAT_FLOAT_ARRAY */
+
 CAMLprim value caml_format_float(value fmt, value arg)
 {
   value res;
diff --git a/byterun/hash.c b/byterun/hash.c
index ddbe25e1e5..f7d0d22233 100644
--- a/byterun/hash.c
+++ b/byterun/hash.c
@@ -217,7 +217,7 @@ CAMLprim value caml_hash(value count, value limit, value seed, value obj)
         break;
       case Double_array_tag:
         for (i = 0, len = Wosize_val(v) / Double_wosize; i < len; i++) {
-          h = caml_hash_mix_double(h, Double_field(v, i));
+          h = caml_hash_mix_double(h, Double_flat_field(v, i));
           num--;
           if (num <= 0) break;
         }
diff --git a/byterun/instrtrace.c b/byterun/instrtrace.c
index fe99f6867a..824562e197 100644
--- a/byterun/instrtrace.c
+++ b/byterun/instrtrace.c
@@ -219,7 +219,7 @@ caml_trace_value_file (value v, code_t prog, int proglen, FILE * f)
     case Double_array_tag:
       fprintf (f, "=floatarray[s%d]", s);
       for (i = 0; i < ((s>0xf)?0xf:s); i++)
-        fprintf (f, " %g", Double_field (v, i));
+        fprintf (f, " %g", Double_flat_field (v, i));
       goto displayfields;
     case Abstract_tag:
       fprintf (f, "=abstract[s%d]", s);
diff --git a/byterun/interp.c b/byterun/interp.c
index 2af27ccdbe..76e600c97e 100644
--- a/byterun/interp.c
+++ b/byterun/interp.c
@@ -700,9 +700,9 @@ value caml_interprete(code_t prog, asize_t prog_size)
       } else {
         block = caml_alloc_shr(size * Double_wosize, Double_array_tag);
       }
-      Store_double_field(block, 0, Double_val(accu));
+      Store_double_flat_field(block, 0, Double_val(accu));
       for (i = 1; i < size; i++){
-        Store_double_field(block, i, Double_val(*sp));
+        Store_double_flat_field(block, i, Double_val(*sp));
         ++ sp;
       }
       accu = block;
@@ -722,7 +722,7 @@ value caml_interprete(code_t prog, asize_t prog_size)
     Instruct(GETFIELD):
       accu = Field(accu, *pc); pc++; Next;
     Instruct(GETFLOATFIELD): {
-      double d = Double_field(accu, *pc);
+      double d = Double_flat_field(accu, *pc);
       Alloc_small(accu, Double_wosize, Double_tag);
       Store_double_val(accu, d);
       pc++;
@@ -751,7 +751,7 @@ value caml_interprete(code_t prog, asize_t prog_size)
       pc++;
       Next;
     Instruct(SETFLOATFIELD):
-      Store_double_field(accu, *pc, Double_val(*sp));
+      Store_double_flat_field(accu, *pc, Double_val(*sp));
       accu = Val_unit;
       sp++;
       pc++;
@@ -760,6 +760,9 @@ value caml_interprete(code_t prog, asize_t prog_size)
 /* Array operations */
 
     Instruct(VECTLENGTH): {
+      /* Todo: when FLAT_FLOAT_ARRAY is false, this instruction should
+         be split into VECTLENGTH and FLOATVECTLENGTH because we know
+         statically which one it is. */
       mlsize_t size = Wosize_val(accu);
       if (Tag_val(accu) == Double_array_tag) size = size / Double_wosize;
       accu = Val_long(size);
diff --git a/byterun/major_gc.c b/byterun/major_gc.c
index cc82b7e228..bfac0e4456 100644
--- a/byterun/major_gc.c
+++ b/byterun/major_gc.c
@@ -258,7 +258,11 @@ static inline value* mark_slice_darken(value *gray_vals_ptr, value v, int i,
       if ((in_ephemeron && Is_long(f)) ||
           (Is_block (f)
            && (!Is_in_value_area(f) || Tag_val (f) == Forward_tag
-               || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag))){
+               || Tag_val (f) == Lazy_tag
+#ifdef FLAT_FLOAT_ARRAY
+               || Tag_val (f) == Double_tag
+#endif
+               ))){
         /* Do not short-circuit the pointer. */
       }else{
         /* The variable child is not changed because it must be mark alive */
@@ -326,7 +330,11 @@ static value* mark_ephe_aux (value *gray_vals_ptr, intnat *work,
           if (Is_long (f) ||
               (Is_block (f) &&
                (!Is_in_value_area(f) || Tag_val (f) == Forward_tag
-                || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag))){
+                || Tag_val (f) == Lazy_tag
+#ifdef FLAT_FLOAT_ARRAY
+                || Tag_val (f) == Double_tag
+#endif
+                ))){
             /* Do not short-circuit the pointer. */
           }else{
             Field (v, i) = key = f;
diff --git a/byterun/minor_gc.c b/byterun/minor_gc.c
index 9e366da176..b59b055db8 100644
--- a/byterun/minor_gc.c
+++ b/byterun/minor_gc.c
@@ -237,7 +237,11 @@ void caml_oldify_one (value v, value *p)
             }
           }
         }
-        if (!vv || ft == Forward_tag || ft == Lazy_tag || ft == Double_tag){
+        if (!vv || ft == Forward_tag || ft == Lazy_tag
+#ifdef FLAT_FLOAT_ARRAY
+            || ft == Double_tag
+#endif
+            ){
           /* Do not short-circuit the pointer.  Copy as a normal block. */
           CAMLassert (Wosize_hd (hd) == 1);
           result = caml_alloc_shr_preserving_profinfo (1, Forward_tag, hd);
diff --git a/byterun/obj.c b/byterun/obj.c
index b0f764fd14..4567b8aefc 100644
--- a/byterun/obj.c
+++ b/byterun/obj.c
@@ -128,7 +128,8 @@ CAMLprim value caml_obj_dup(value arg)
    before the block is reallocated (since there must be a minor
    collection within each major cycle).
 
-   [newsize] is a value encoding a number of words.
+   [newsize] is a value encoding a number of fields (words, except
+   for float arrays on 32-bit architectures).
 */
 CAMLprim value caml_obj_truncate (value v, value newsize)
 {
diff --git a/configure b/configure
index 01b05d3c37..b1c8b383b5 100755
--- a/configure
+++ b/configure
@@ -67,6 +67,7 @@ afl_instrument=false
 max_testsuite_dir_retries=0
 with_cplugins=false
 with_fpic=false
+flat_float_array=true
 
 # Try to turn internationalization off, can cause config.guess to malfunction!
 unset LANG
@@ -214,6 +215,10 @@ while : ; do
         with_fpic=true;;
     -safe-string|--safe-string)
         safe_string=true;;
+    -flat-float-array|--flat-float-array)
+        flat_float_array=true;;
+    -no-flat-float-array|--no-flat-float-array)
+        flat_float_array=false;;
     -afl-instrument)
         afl_instrument=true;;
     *) if echo "$1" | grep -q -e '^--\?[a-zA-Z0-9-]\+='; then
@@ -2009,6 +2014,10 @@ if $safe_string; then
   echo "#define CAML_SAFE_STRING" >> m.h
 fi
 
+if $flat_float_array; then
+  echo "#define FLAT_FLOAT_ARRAY" >> m.h
+fi
+
 # Finish generated files
 
 cclibs="$cclibs $mathlib"
@@ -2097,6 +2106,7 @@ config FLAMBDA "$flambda"
 config SAFE_STRING "$safe_string"
 config AFL_INSTRUMENT "$afl_instrument"
 config MAX_TESTSUITE_DIR_RETRIES "$max_testsuite_dir_retries"
+config FLAT_FLOAT_ARRAY "$flat_float_array"
 
 
 rm -f tst hasgot.c
@@ -2218,6 +2228,11 @@ else
   else
   inf "        safe strings ............. no"
   fi
+  if $flat_float_array; then
+  inf "        flat float arrays ........ yes"
+  else
+  inf "        flat float arrays ........ no"
+  fi
   if test "$afl_instrument" = "true"; then
   inf "        afl-fuzz always enabled .. yes"
   else
diff --git a/debugger/debugcom.ml b/debugger/debugcom.ml
index b70eedd1e6..e828ec4e2b 100644
--- a/debugger/debugcom.ml
+++ b/debugger/debugcom.ml
@@ -201,6 +201,8 @@ module Remote_value =
   struct
     type t = Remote of string | Local of Obj.t
 
+    let repr x = Local (Obj.repr x)
+
     let obj = function
     | Local obj -> Obj.obj obj
     | Remote v ->
@@ -255,6 +257,25 @@ module Remote_value =
             Local(Obj.repr floatbuf)
           end
 
+    let double_field v n =
+      match v with
+      | Local obj -> Obj.double_field obj n
+      | Remote v ->
+          output_char !conn.io_out 'F';
+          output_remote_value !conn.io_out v;
+          output_binary_int !conn.io_out n;
+          flush !conn.io_out;
+          if input_byte !conn.io_in = 0 then
+            raise Marshalling_error
+          else begin
+            let buf = really_input_string !conn.io_in 8 in
+            let floatbuf = float n (* force allocation of a new float *) in
+            String.unsafe_blit buf 0 (Obj.magic floatbuf) 0 8;
+            floatbuf
+          end
+
+    let double_array_tag = Obj.double_array_tag
+
     let of_int n =
       Local(Obj.repr n)
 
diff --git a/debugger/debugcom.mli b/debugger/debugcom.mli
index 6f94df5c3b..4091362613 100644
--- a/debugger/debugcom.mli
+++ b/debugger/debugcom.mli
@@ -93,11 +93,14 @@ module Remote_value :
   sig
     type t
 
+    val repr : 'a -> t
     val obj : t -> 'a
     val is_block : t -> bool
     val tag : t -> int
     val size : t -> int
     val field : t -> int -> t
+    val double_field : t -> int -> float
+    val double_array_tag : int
     val same : t -> t -> bool
 
     val of_int : int -> t
diff --git a/middle_end/inline_and_simplify.ml b/middle_end/inline_and_simplify.ml
index 8c01a88af6..3c3ea48fb4 100755
--- a/middle_end/inline_and_simplify.ml
+++ b/middle_end/inline_and_simplify.ml
@@ -1027,18 +1027,20 @@ and simplify_named env r (tree : Flambda.named) : Flambda.named * R.t =
           Location.prerr_warning (Debuginfo.to_location dbg)
             Warnings.Assignment_to_non_mutable_value
         end;
-        let kind = match A.descr block_approx, A.descr value_approx with
-          | (Value_float_array _, _)
-          | (_, Value_float _) ->
-            begin match kind with
+        let kind =
+          let check () =
+            match kind with
             | Pfloatarray | Pgenarray -> ()
             | Paddrarray | Pintarray ->
               (* CR pchambart: Do a proper warning here *)
               Misc.fatal_errorf "Assignment of a float to a specialised \
                                  non-float array: %a"
                 Flambda.print_named tree
-            end;
-            Lambda.Pfloatarray
+          in
+          match A.descr block_approx, A.descr value_approx with
+          | (Value_float_array _, _) -> check (); Lambda.Pfloatarray
+          | (_, Value_float _) when Config.flat_float_array ->
+            check (); Lambda.Pfloatarray
             (* CR pchambart: This should be accounted by the benefit *)
           | _ ->
             kind
diff --git a/stdlib/array.ml b/stdlib/array.ml
index a4270f278a..9b54587847 100644
--- a/stdlib/array.ml
+++ b/stdlib/array.ml
@@ -30,6 +30,16 @@ external unsafe_blit :
 external create_float: int -> float array = "caml_make_float_vect"
 let make_float = create_float
 
+module Floatarray = struct
+  external create : int -> floatarray = "caml_floatarray_create"
+  external length : floatarray -> int = "%floatarray_length"
+  external get : floatarray -> int -> float = "%floatarray_safe_get"
+  external set : floatarray -> int -> float -> unit = "%floatarray_safe_set"
+  external unsafe_get : floatarray -> int -> float = "%floatarray_unsafe_get"
+  external unsafe_set : floatarray -> int -> float -> unit
+      = "%floatarray_unsafe_set"
+end
+
 let init l f =
   if l = 0 then [||] else
   if l < 0 then invalid_arg "Array.init"
diff --git a/stdlib/array.mli b/stdlib/array.mli
index b89cd6b638..f2cdea34fe 100644
--- a/stdlib/array.mli
+++ b/stdlib/array.mli
@@ -263,3 +263,13 @@ val fast_sort : ('a -> 'a -> int) -> 'a array -> unit
 
 external unsafe_get : 'a array -> int -> 'a = "%array_unsafe_get"
 external unsafe_set : 'a array -> int -> 'a -> unit = "%array_unsafe_set"
+
+module Floatarray : sig
+  external create : int -> floatarray = "caml_floatarray_create"
+  external length : floatarray -> int = "%floatarray_length"
+  external get : floatarray -> int -> float = "%floatarray_safe_get"
+  external set : floatarray -> int -> float -> unit = "%floatarray_safe_set"
+  external unsafe_get : floatarray -> int -> float = "%floatarray_unsafe_get"
+  external unsafe_set : floatarray -> int -> float -> unit
+      = "%floatarray_unsafe_set"
+end
diff --git a/stdlib/arrayLabels.mli b/stdlib/arrayLabels.mli
index 868f73a57e..7abab477d0 100644
--- a/stdlib/arrayLabels.mli
+++ b/stdlib/arrayLabels.mli
@@ -264,3 +264,13 @@ val fast_sort : cmp:('a -> 'a -> int) -> 'a array -> unit
 
 external unsafe_get : 'a array -> int -> 'a = "%array_unsafe_get"
 external unsafe_set : 'a array -> int -> 'a -> unit = "%array_unsafe_set"
+
+module Floatarray : sig
+  external create : int -> floatarray = "caml_floatarray_create"
+  external length : floatarray -> int = "%floatarray_length"
+  external get : floatarray -> int -> float = "%floatarray_safe_get"
+  external set : floatarray -> int -> float -> unit = "%floatarray_safe_set"
+  external unsafe_get : floatarray -> int -> float = "%floatarray_unsafe_get"
+  external unsafe_set : floatarray -> int -> float -> unit
+      = "%floatarray_unsafe_set"
+end
diff --git a/stdlib/lazy.ml b/stdlib/lazy.ml
index 6526961300..7dc1e9ddfe 100644
--- a/stdlib/lazy.ml
+++ b/stdlib/lazy.ml
@@ -36,6 +36,8 @@
    The GC will magically change things from (2) to (3) according to its
    fancy.
 
+   If OCaml was configured with the -flat-float-array option (which is
+   currently the default), the following is also true:
    We cannot use representation (3) for a [float Lazy.t] because
    [caml_make_array] assumes that only a [float] value can have tag
    [Double_tag].
diff --git a/stdlib/obj.ml b/stdlib/obj.ml
index 35b3925ae4..6c5f4f9e01 100644
--- a/stdlib/obj.ml
+++ b/stdlib/obj.ml
@@ -28,11 +28,12 @@ external size : t -> int = "%obj_size"
 external reachable_words : t -> int = "caml_obj_reachable_words"
 external field : t -> int -> t = "%obj_field"
 external set_field : t -> int -> t -> unit = "%obj_set_field"
-external array_get: 'a array -> int -> 'a = "%array_safe_get"
-external array_set: 'a array -> int -> 'a -> unit = "%array_safe_set"
-let [@inline always] double_field x i = array_get (obj x : float array) i
+external floatarray_get : floatarray -> int -> float = "caml_floatarray_get"
+external floatarray_set :
+    floatarray -> int -> float -> unit = "caml_floatarray_set"
+let [@inline always] double_field x i = floatarray_get (obj x : floatarray) i
 let [@inline always] set_double_field x i v =
-  array_set (obj x : float array) i v
+  floatarray_set (obj x : floatarray) i v
 external new_block : int -> int -> t = "caml_obj_block"
 external dup : t -> t = "caml_obj_dup"
 external truncate : t -> int -> unit = "caml_obj_truncate"
diff --git a/testsuite/tests/array-functions/Makefile b/testsuite/tests/array-functions/Makefile
index c11a415f74..e148df25c0 100644
--- a/testsuite/tests/array-functions/Makefile
+++ b/testsuite/tests/array-functions/Makefile
@@ -13,6 +13,9 @@
 #*                                                                        *
 #**************************************************************************
 
+ADD_COMPFLAGS = -I $(OTOPDIR)/utils
+MODULES = config
+
 BASEDIR=../..
 include $(BASEDIR)/makefiles/Makefile.several
 include $(BASEDIR)/makefiles/Makefile.common
diff --git a/testsuite/tests/array-functions/test.ml b/testsuite/tests/array-functions/test.ml
index e325724cce..29f0061607 100644
--- a/testsuite/tests/array-functions/test.ml
+++ b/testsuite/tests/array-functions/test.ml
@@ -176,7 +176,7 @@ let () =
   assert (not (Array.memq (ref 1) (Array.make 100 (ref 1))));
   let f = Array.create_float 10 in
   Array.fill f 0 10 1.0;
-  assert (not (Array.memq 1.0 f));
+  if Config.flat_float_array then assert (not (Array.memq 1.0 f));
 ;;
 
 let () = print_endline "OK"
diff --git a/testsuite/tests/asmcomp/Makefile b/testsuite/tests/asmcomp/Makefile
index c627fe4ae0..08921d12f0 100644
--- a/testsuite/tests/asmcomp/Makefile
+++ b/testsuite/tests/asmcomp/Makefile
@@ -15,6 +15,8 @@
 
 BASEDIR=../..
 
+include $(BASEDIR)/../config/Makefile
+
 INCLUDES=\
   -I $(OTOPDIR)/parsing \
   -I $(OTOPDIR)/utils \
@@ -55,8 +57,9 @@ MLCASES=optargs staticalloc bind_tuples is_static register_typing \
   register_typing_switch
 ARGS_optargs=-g
 ARGS_is_static=-I $(OTOPDIR)/byterun is_in_static_data.c
-MLCASES_FLAMBDA=is_static_flambda unrolling_flambda unrolling_flambda2 \
-  static_float_array_flambda static_float_array_flambda_opaque
+MLCASES_FLAMBDA=is_static_flambda unrolling_flambda unrolling_flambda2
+MLCASES_FLAMBDA_FLOAT=static_float_array_flambda \
+                      static_float_array_flambda_opaque
 ARGS_is_static_flambda=\
   -I $(OTOPDIR)/byterun is_in_static_data.c is_static_flambda_dep.ml
 ARGS_static_float_array_flambda=\
@@ -87,7 +90,8 @@ ARGS_even-odd-spill=-DINT_INT -DFUN=is_even main.c
 ARGS_pgcd=-DINT_INT -DFUN=pgcd_30030 main.c
 
 skips:
-	@for c in $(CASES) $(MLCASES) $(MLCASES_FLAMBDA); do \
+	@for c in $(CASES) $(MLCASES) $(MLCASES_FLAMBDA) \
+                  $(MLCASES_FLAMBDA_FLOAT); do \
 	  echo " ... testing '$$c': => skipped"; \
 	done
 
@@ -95,8 +99,8 @@ one_ml:
 	@$(OCAMLOPT) $(ARGS_$(NAME)) -o $(NAME).exe $(NAME).ml && \
 	./$(NAME).exe && echo " => passed" || echo " => failed"
 
-one_ml_flambda:
-	@if $(FLAMBDA); then \
+one_ml_cond:
+	@if $(COND); then \
 	   $(OCAMLOPT) $(ARGS_$(NAME)) -o $(NAME).exe $(NAME).ml && \
 	   ./$(NAME).exe && echo " => passed" || echo " => failed"; \
 	 else \
@@ -142,7 +146,12 @@ tests: $(CASES:=.$(O))
         done
 	@for c in $(MLCASES_FLAMBDA); do \
 	  printf " ... testing '$$c':"; \
-          $(MAKE) one_ml_flambda NAME=$$c; \
+          $(MAKE) one_ml_cond NAME=$$c COND=$(FLAMBDA); \
+        done
+	@for c in $(MLCASES_FLAMBDA_FLOAT); do \
+	  printf " ... testing '$$c':"; \
+	  $(MAKE) one_ml_cond NAME=$$c \
+                  COND='$(FLAMBDA) && $(FLAT_FLOAT_ARRAY)'; \
         done
 
 promote:
diff --git a/testsuite/tests/misc/gcwords.ml b/testsuite/tests/misc/gcwords.ml
index 80ecd34e54..61cb849537 100644
--- a/testsuite/tests/misc/gcwords.ml
+++ b/testsuite/tests/misc/gcwords.ml
@@ -1,6 +1,8 @@
 type t = Leaf of int | Branch of t * t
 
-let a = [| 0.0 |]
+type floatref = { mutable f : float }
+
+let a = { f = 0.0 }
 
 let rec allocate_lots m = function
   | 0 -> Leaf m
@@ -13,7 +15,7 @@ let measure f =
   c -. a
 
 let () =
-  let n = measure (fun () -> a.(0) <- Gc.minor_words ()) in
+  let n = measure (fun () -> a.f <- Gc.minor_words ()) in
   (* Gc.minor_words should not allocate, although bytecode
      generally boxes the floats *)
   assert (n < 10.);
diff --git a/testsuite/tests/translprim/Makefile b/testsuite/tests/translprim/Makefile
index c4223d4522..cdfef9a21c 100644
--- a/testsuite/tests/translprim/Makefile
+++ b/testsuite/tests/translprim/Makefile
@@ -1,4 +1,28 @@
+newdefault: array_spec.ml.reference module_coercion.ml.reference
+	$(MAKE) default
+
 BASEDIR=../..
 TOPFLAGS+=-dlambda
 include $(BASEDIR)/makefiles/Makefile.dlambda
 include $(BASEDIR)/makefiles/Makefile.common
+
+GENERATED_SOURCES = array_spec.ml.reference module_coercion.ml.reference \
+                    *.flat-float
+
+ifeq "$(FLAT_FLOAT_ARRAY)" "true"
+suffix = -flat
+else
+suffix = -noflat
+endif
+
+array_spec.ml.reference: array_spec.ml.reference$(suffix) \
+                         $(FLAT_FLOAT_ARRAY).flat-float
+	cp $< $@
+
+module_coercion.ml.reference: module_coercion.ml.reference$(suffix) \
+                              $(FLAT_FLOAT_ARRAY).flat-float
+	cp $< $@
+
+%.flat-float:
+	@rm -f $(GENERATED_SOURCES)
+	@touch $@
diff --git a/testsuite/tests/translprim/array_spec.ml.reference b/testsuite/tests/translprim/array_spec.ml.reference-flat
index 83fe0c4cdc..83fe0c4cdc 100644
--- a/testsuite/tests/translprim/array_spec.ml.reference
+++ b/testsuite/tests/translprim/array_spec.ml.reference-flat
diff --git a/testsuite/tests/translprim/array_spec.ml.reference-noflat b/testsuite/tests/translprim/array_spec.ml.reference-noflat
new file mode 100644
index 0000000000..ba90062d41
--- /dev/null
+++ b/testsuite/tests/translprim/array_spec.ml.reference-noflat
@@ -0,0 +1,88 @@
+(setglobal Array_spec!
+  (let
+    (int_a = (makearray[int] 1 2 3)
+     float_a = (makearray[addr] 1. 2. 3.)
+     addr_a = (makearray[addr] "a" "b" "c"))
+    (seq (array.length[int] int_a) (array.length[addr] float_a)
+      (array.length[addr] addr_a)
+      (function a (array.length[addr] a))
+      (array.get[int] int_a 0) (array.get[addr] float_a 0)
+      (array.get[addr] addr_a 0)
+      (function a (array.get[addr] a 0))
+      (array.unsafe_get[int] int_a 0)
+      (array.unsafe_get[addr] float_a 0)
+      (array.unsafe_get[addr] addr_a 0)
+      (function a (array.unsafe_get[addr] a 0))
+      (array.set[int] int_a 0 1) (array.set[addr] float_a 0 1.)
+      (array.set[addr] addr_a 0 "a")
+      (function a x (array.set[addr] a 0 x))
+      (array.unsafe_set[int] int_a 0 1)
+      (array.unsafe_set[addr] float_a 0 1.)
+      (array.unsafe_set[addr] addr_a 0 "a")
+      (function a x (array.unsafe_set[addr] a 0 x))
+      (let
+        (eta_gen_len =
+           (function prim stub (array.length[addr] prim))
+         eta_gen_safe_get =
+           (function prim prim stub
+             (array.get[addr] prim prim))
+         eta_gen_unsafe_get =
+           (function prim prim stub
+             (array.unsafe_get[addr] prim prim))
+         eta_gen_safe_set =
+           (function prim prim prim stub
+             (array.set[addr] prim prim prim))
+         eta_gen_unsafe_set =
+           (function prim prim prim stub
+             (array.unsafe_set[addr] prim prim prim))
+         eta_int_len =
+           (function prim stub (array.length[int] prim))
+         eta_int_safe_get =
+           (function prim prim stub
+             (array.get[int] prim prim))
+         eta_int_unsafe_get =
+           (function prim prim stub
+             (array.unsafe_get[int] prim prim))
+         eta_int_safe_set =
+           (function prim prim prim stub
+             (array.set[int] prim prim prim))
+         eta_int_unsafe_set =
+           (function prim prim prim stub
+             (array.unsafe_set[int] prim prim prim))
+         eta_float_len =
+           (function prim stub (array.length[addr] prim))
+         eta_float_safe_get =
+           (function prim prim stub
+             (array.get[addr] prim prim))
+         eta_float_unsafe_get =
+           (function prim prim stub
+             (array.unsafe_get[addr] prim prim))
+         eta_float_safe_set =
+           (function prim prim prim stub
+             (array.set[addr] prim prim prim))
+         eta_float_unsafe_set =
+           (function prim prim prim stub
+             (array.unsafe_set[addr] prim prim prim))
+         eta_addr_len =
+           (function prim stub (array.length[addr] prim))
+         eta_addr_safe_get =
+           (function prim prim stub
+             (array.get[addr] prim prim))
+         eta_addr_unsafe_get =
+           (function prim prim stub
+             (array.unsafe_get[addr] prim prim))
+         eta_addr_safe_set =
+           (function prim prim prim stub
+             (array.set[addr] prim prim prim))
+         eta_addr_unsafe_set =
+           (function prim prim prim stub
+             (array.unsafe_set[addr] prim prim prim)))
+        (makeblock 0 int_a float_a addr_a eta_gen_len
+          eta_gen_safe_get eta_gen_unsafe_get eta_gen_safe_set
+          eta_gen_unsafe_set eta_int_len eta_int_safe_get
+          eta_int_unsafe_get eta_int_safe_set
+          eta_int_unsafe_set eta_float_len eta_float_safe_get
+          eta_float_unsafe_get eta_float_safe_set
+          eta_float_unsafe_set eta_addr_len eta_addr_safe_get
+          eta_addr_unsafe_get eta_addr_safe_set
+          eta_addr_unsafe_set)))))
diff --git a/testsuite/tests/translprim/module_coercion.ml.reference b/testsuite/tests/translprim/module_coercion.ml.reference-flat
index 27cd3f7329..27cd3f7329 100644
--- a/testsuite/tests/translprim/module_coercion.ml.reference
+++ b/testsuite/tests/translprim/module_coercion.ml.reference-flat
diff --git a/testsuite/tests/translprim/module_coercion.ml.reference-noflat b/testsuite/tests/translprim/module_coercion.ml.reference-noflat
new file mode 100644
index 0000000000..b3cc51bc0d
--- /dev/null
+++ b/testsuite/tests/translprim/module_coercion.ml.reference-noflat
@@ -0,0 +1,124 @@
+(setglobal Module_coercion!
+  (let
+    (M = (module-defn(M) module_coercion.ml(1):0-699 (makeblock 0)))
+    (makeblock 0 M
+      (module-defn(M_int) module_coercion.ml(32):1116-1155
+        (makeblock 0 (function prim stub (array.length[int] prim))
+          (function prim prim stub
+            (array.get[int] prim prim))
+          (function prim prim stub
+            (array.unsafe_get[int] prim prim))
+          (function prim prim prim stub
+            (array.set[int] prim prim prim))
+          (function prim prim prim stub
+            (array.unsafe_set[int] prim prim prim))
+          (function prim prim stub
+            (caml_int_compare prim prim))
+          (function prim prim stub (== prim prim))
+          (function prim prim stub (!= prim prim))
+          (function prim prim stub (< prim prim))
+          (function prim prim stub (> prim prim))
+          (function prim prim stub (<= prim prim))
+          (function prim prim stub (>= prim prim))))
+      (module-defn(M_float) module_coercion.ml(33):1158-1201
+        (makeblock 0 (function prim stub (array.length[addr] prim))
+          (function prim prim stub
+            (array.get[addr] prim prim))
+          (function prim prim stub
+            (array.unsafe_get[addr] prim prim))
+          (function prim prim prim stub
+            (array.set[addr] prim prim prim))
+          (function prim prim prim stub
+            (array.unsafe_set[addr] prim prim prim))
+          (function prim prim stub
+            (caml_float_compare prim prim))
+          (function prim prim stub (==. prim prim))
+          (function prim prim stub (!=. prim prim))
+          (function prim prim stub (<. prim prim))
+          (function prim prim stub (>. prim prim))
+          (function prim prim stub (<=. prim prim))
+          (function prim prim stub (>=. prim prim))))
+      (module-defn(M_string) module_coercion.ml(34):1204-1249
+        (makeblock 0 (function prim stub (array.length[addr] prim))
+          (function prim prim stub
+            (array.get[addr] prim prim))
+          (function prim prim stub
+            (array.unsafe_get[addr] prim prim))
+          (function prim prim prim stub
+            (array.set[addr] prim prim prim))
+          (function prim prim prim stub
+            (array.unsafe_set[addr] prim prim prim))
+          (function prim prim stub
+            (caml_string_compare prim prim))
+          (function prim prim stub
+            (caml_string_equal prim prim))
+          (function prim prim stub
+            (caml_string_notequal prim prim))
+          (function prim prim stub
+            (caml_string_lessthan prim prim))
+          (function prim prim stub
+            (caml_string_greaterthan prim prim))
+          (function prim prim stub
+            (caml_string_lessequal prim prim))
+          (function prim prim stub
+            (caml_string_greaterequal prim prim))))
+      (module-defn(M_int32/1104) module_coercion.ml(35):1252-1295
+        (makeblock 0 (function prim stub (array.length[addr] prim))
+          (function prim prim stub
+            (array.get[addr] prim prim))
+          (function prim prim stub
+            (array.unsafe_get[addr] prim prim))
+          (function prim prim prim stub
+            (array.set[addr] prim prim prim))
+          (function prim prim prim stub
+            (array.unsafe_set[addr] prim prim prim))
+          (function prim prim stub
+            (caml_int32_compare prim prim))
+          (function prim prim stub (Int32.== prim prim))
+          (function prim prim stub (Int32.!= prim prim))
+          (function prim prim stub (Int32.< prim prim))
+          (function prim prim stub (Int32.> prim prim))
+          (function prim prim stub (Int32.<= prim prim))
+          (function prim prim stub (Int32.>= prim prim))))
+      (module-defn(M_int64/1129) module_coercion.ml(36):1298-1341
+        (makeblock 0 (function prim stub (array.length[addr] prim))
+          (function prim prim stub
+            (array.get[addr] prim prim))
+          (function prim prim stub
+            (array.unsafe_get[addr] prim prim))
+          (function prim prim prim stub
+            (array.set[addr] prim prim prim))
+          (function prim prim prim stub
+            (array.unsafe_set[addr] prim prim prim))
+          (function prim prim stub
+            (caml_int64_compare prim prim))
+          (function prim prim stub (Int64.== prim prim))
+          (function prim prim stub (Int64.!= prim prim))
+          (function prim prim stub (Int64.< prim prim))
+          (function prim prim stub (Int64.> prim prim))
+          (function prim prim stub (Int64.<= prim prim))
+          (function prim prim stub (Int64.>= prim prim))))
+      (module-defn(M_nativeint) module_coercion.ml(37):1344-1395
+        (makeblock 0 (function prim stub (array.length[addr] prim))
+          (function prim prim stub
+            (array.get[addr] prim prim))
+          (function prim prim stub
+            (array.unsafe_get[addr] prim prim))
+          (function prim prim prim stub
+            (array.set[addr] prim prim prim))
+          (function prim prim prim stub
+            (array.unsafe_set[addr] prim prim prim))
+          (function prim prim stub
+            (caml_nativeint_compare prim prim))
+          (function prim prim stub
+            (Nativeint.== prim prim))
+          (function prim prim stub
+            (Nativeint.!= prim prim))
+          (function prim prim stub
+            (Nativeint.< prim prim))
+          (function prim prim stub
+            (Nativeint.> prim prim))
+          (function prim prim stub
+            (Nativeint.<= prim prim))
+          (function prim prim stub
+            (Nativeint.>= prim prim)))))))
diff --git a/testsuite/tests/typing-misc/Makefile b/testsuite/tests/typing-misc/Makefile
index 0b15e777de..4184695d38 100644
--- a/testsuite/tests/typing-misc/Makefile
+++ b/testsuite/tests/typing-misc/Makefile
@@ -13,6 +13,24 @@
 #*                                                                        *
 #**************************************************************************
 
+all: pr6939.ml
+	$(MAKE) default
+
 BASEDIR=../..
 include $(BASEDIR)/makefiles/Makefile.expect
 include $(BASEDIR)/makefiles/Makefile.common
+
+GENERATED_SOURCES = pr6939.ml *.flat-float
+
+ifeq "$(FLAT_FLOAT_ARRAY)" "true"
+suffix = -flat
+else
+suffix = -noflat
+endif
+
+pr6939.ml: pr6939.ml$(suffix) $(FLAT_FLOAT_ARRAY).flat-float
+	cp $< $@
+
+%.flat-float:
+	@rm -f $(GENERATED_SOURCES)
+	@touch $@
diff --git a/testsuite/tests/typing-misc/pr6939.ml b/testsuite/tests/typing-misc/pr6939.ml-flat
index 2acdd12ea7..2acdd12ea7 100755..100644
--- a/testsuite/tests/typing-misc/pr6939.ml
+++ b/testsuite/tests/typing-misc/pr6939.ml-flat
diff --git a/testsuite/tests/typing-misc/pr6939.ml-noflat b/testsuite/tests/typing-misc/pr6939.ml-noflat
new file mode 100644
index 0000000000..86f2ffd20b
--- /dev/null
+++ b/testsuite/tests/typing-misc/pr6939.ml-noflat
@@ -0,0 +1,14 @@
+let rec x = [| x |]; 1.;;
+[%%expect{|
+Line _, characters 12-19:
+Warning 10: this expression should have type unit.
+val x : float = 1.
+|}];;
+
+let rec x = let u = [|y|] in 10. and y = 1.;;
+[%%expect{|
+Line _, characters 16-17:
+Warning 26: unused variable u.
+val x : float = 10.
+val y : float = 1.
+|}];;
diff --git a/testsuite/tests/typing-unboxed-types/Makefile b/testsuite/tests/typing-unboxed-types/Makefile
index 9625a3fbc3..e0a77e8430 100644
--- a/testsuite/tests/typing-unboxed-types/Makefile
+++ b/testsuite/tests/typing-unboxed-types/Makefile
@@ -1,3 +1,21 @@
+newdefault: test.ml.reference
+	@$(MAKE) default
+
 BASEDIR=../..
 include $(BASEDIR)/makefiles/Makefile.toplevel
 include $(BASEDIR)/makefiles/Makefile.common
+
+GENERATED_SOURCES = test.ml.reference *.flat-float
+
+ifeq "$(FLAT_FLOAT_ARRAY)" "true"
+suffix = -flat
+else
+suffix = -noflat
+endif
+
+test.ml.reference: test.ml.reference$(suffix) $(FLAT_FLOAT_ARRAY).flat-float
+	@cp $< $@
+
+%.flat-float:
+	@rm -f $(GENERATED_SOURCES)
+	@touch $@
diff --git a/testsuite/tests/typing-unboxed-types/test.ml.reference b/testsuite/tests/typing-unboxed-types/test.ml.reference-flat
index 10a118d86f..10a118d86f 100644
--- a/testsuite/tests/typing-unboxed-types/test.ml.reference
+++ b/testsuite/tests/typing-unboxed-types/test.ml.reference-flat
diff --git a/testsuite/tests/typing-unboxed-types/test.ml.reference-noflat b/testsuite/tests/typing-unboxed-types/test.ml.reference-noflat
new file mode 100644
index 0000000000..ca52fed5d6
--- /dev/null
+++ b/testsuite/tests/typing-unboxed-types/test.ml.reference-noflat
@@ -0,0 +1,169 @@
+
+#       type t1 = A of string [@@unboxed]
+#       - : bool = true
+#     type t2 = { f : string; } [@@unboxed]
+#       - : bool = true
+#     type t3 = B of { g : string; } [@@unboxed]
+#       - : bool = true
+#     Characters 29-58:
+  type t4 = C [@@ocaml.unboxed];;  (* no argument *)
+  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because its constructor has no argument.
+# Characters 0-45:
+  type t5 = D of int * string [@@ocaml.unboxed];; (* more than one argument *)
+  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because
+       its constructor has more than one argument.
+# Characters 0-33:
+  type t5 = E | F [@@ocaml.unboxed];;          (* more than one constructor *)
+  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because it has more than one constructor.
+# Characters 0-40:
+  type t6 = G of int | H [@@ocaml.unboxed];;
+  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because it has more than one constructor.
+# Characters 0-51:
+  type t7 = I of string | J of bool [@@ocaml.unboxed];;
+  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because it has more than one constructor.
+#   Characters 1-50:
+  type t8 = { h : bool; i : int } [@@ocaml.unboxed];;  (* more than one field *)
+  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because it has more than one field.
+# Characters 0-56:
+  type t9 = K of { j : string; l : int } [@@ocaml.unboxed];;
+  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because
+       its constructor has more than one argument.
+#     type t10 = A of t10 [@@unboxed]
+# Characters 12-15:
+  let rec x = A x;;
+              ^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#             Characters 121-172:
+  ......struct
+    type t = A of string [@@ocaml.unboxed]
+  end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = A of string [@@unboxed] end
+       is not included in
+         sig type t = A of string end
+       Type declarations do not match:
+         type t = A of string [@@unboxed]
+       is not included in
+         type t = A of string
+       Their internal representations differ:
+       the first declaration uses unboxed representation.
+#           Characters 63-96:
+  ......struct
+    type t = A of string
+  end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = A of string end
+       is not included in
+         sig type t = A of string [@@unboxed] end
+       Type declarations do not match:
+         type t = A of string
+       is not included in
+         type t = A of string [@@unboxed]
+       Their internal representations differ:
+       the second declaration uses unboxed representation.
+#           Characters 48-102:
+  ......struct
+    type t = { f : string } [@@ocaml.unboxed]
+  end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = { f : string; } [@@unboxed] end
+       is not included in
+         sig type t = { f : string; } end
+       Type declarations do not match:
+         type t = { f : string; } [@@unboxed]
+       is not included in
+         type t = { f : string; }
+       Their internal representations differ:
+       the first declaration uses unboxed representation.
+#           Characters 66-102:
+  ......struct
+    type t = { f : string }
+  end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = { f : string; } end
+       is not included in
+         sig type t = { f : string; } [@@unboxed] end
+       Type declarations do not match:
+         type t = { f : string; }
+       is not included in
+         type t = { f : string; } [@@unboxed]
+       Their internal representations differ:
+       the second declaration uses unboxed representation.
+#           Characters 53-112:
+  ......struct
+    type t = A of { f : string } [@@ocaml.unboxed]
+  end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = A of { f : string; } [@@unboxed] end
+       is not included in
+         sig type t = A of { f : string; } end
+       Type declarations do not match:
+         type t = A of { f : string; } [@@unboxed]
+       is not included in
+         type t = A of { f : string; }
+       Their internal representations differ:
+       the first declaration uses unboxed representation.
+#           Characters 71-112:
+  ......struct
+    type t = A of { f : string }
+  end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = A of { f : string; } end
+       is not included in
+         sig type t = A of { f : string; } [@@unboxed] end
+       Type declarations do not match:
+         type t = A of { f : string; }
+       is not included in
+         type t = A of { f : string; } [@@unboxed]
+       Their internal representations differ:
+       the second declaration uses unboxed representation.
+#       type t11 = L of float [@@unboxed]
+#     - : unit = ()
+#       type 'a t12 = M of 'a t12 [@@unboxed]
+# val f : int t12 array -> int t12 = <fun>
+#     type t13 = A : 'a t12 -> t13 [@@unboxed]
+#         type t14
+# type t15 = A of t14 [@@unboxed]
+#     type 'a abs
+# type t16 = A : 'a abs -> t16 [@@unboxed]
+#     type t18 = A : 'a list abs -> t18 [@@unboxed]
+#   *               Characters 176-256:
+  ......struct
+    type t = A of float [@@ocaml.unboxed]
+    type u = { f1 : t; f2 : t }
+  end..
+Error: Signature mismatch:
+       ...
+       Type declarations do not match:
+         type u = { f1 : t; f2 : t; }
+       is not included in
+         type u = { f1 : t; f2 : t; }
+       Their internal representations differ:
+       the first declaration uses unboxed float representation.
+#     * *           module T : sig type t [@@immediate] end
+#   *   type 'a s = S : 'a -> 'a s [@@unboxed]
+# type t = T : 'a s -> t [@@unboxed]
+#     type 'a s = S : 'a -> 'a option s [@@unboxed]
+# type t = T : 'a s -> t [@@unboxed]
+#                 module M :
+  sig type 'a r constraint 'a = unit -> 'b val inj : 'b -> (unit -> 'b) r end
+#     type t = T : (unit -> 'a) M.r -> t [@@unboxed]
+#   type 'a s = S : (unit -> 'a) M.r -> 'a option s [@@unboxed]
+#     type t = T : 'a s -> t [@@unboxed]
+#     type 'a t = T : 'a s -> 'a t [@@unboxed]
+#           type _ s = S : 'a t -> 'b s [@@unboxed]
+and _ t = T : 'a -> 'a s t
+# 
diff --git a/tools/dumpobj.ml b/tools/dumpobj.ml
index c3d60bff0f..4945051183 100644
--- a/tools/dumpobj.ml
+++ b/tools/dumpobj.ml
@@ -122,11 +122,11 @@ let rec print_obj x =
     else if tag = Obj.double_tag then
         printf "%.12g" (Obj.magic x : float)
     else if tag = Obj.double_array_tag then begin
-        let a = (Obj.magic x : float array) in
+        let a = (Obj.magic x : floatarray) in
         printf "[|";
-        for i = 0 to Array.length a - 1 do
+        for i = 0 to Array.Floatarray.length a - 1 do
           if i > 0 then printf ", ";
-          printf "%.12g" a.(i)
+          printf "%.12g" (Array.Floatarray.get a i)
         done;
         printf "|]"
     end else if tag = Obj.custom_tag && same_custom x 0l then
diff --git a/toplevel/genprintval.ml b/toplevel/genprintval.ml
index a8c6437088..09b8fbeb5d 100644
--- a/toplevel/genprintval.ml
+++ b/toplevel/genprintval.ml
@@ -25,11 +25,14 @@ open Outcometree
 module type OBJ =
   sig
     type t
+    val repr : 'a -> t
     val obj : t -> 'a
     val is_block : t -> bool
     val tag : t -> int
     val size : t -> int
     val field : t -> int -> t
+    val double_array_tag : int
+    val double_field : t -> int -> float
   end
 
 module type EVALPATH =
@@ -493,9 +496,17 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
                 if pos = 0 then tree_of_label env path name
                 else Oide_ident name
               and v =
-                if unboxed
-                then tree_of_val (depth - 1) obj ty_arg
-                else nest tree_of_val (depth - 1) (O.field obj pos) ty_arg
+                if unboxed then
+                  tree_of_val (depth - 1) obj ty_arg
+                else begin
+                  let fld =
+                    if O.tag obj = O.double_array_tag then
+                      O.repr (O.double_field obj pos)
+                    else
+                      O.field obj pos
+                  in
+                  nest tree_of_val (depth - 1) fld ty_arg
+                end
               in
               (lid, v) :: tree_of_fields (pos + 1) remainder
         in
diff --git a/toplevel/genprintval.mli b/toplevel/genprintval.mli
index 744aaaea90..e45050e902 100644
--- a/toplevel/genprintval.mli
+++ b/toplevel/genprintval.mli
@@ -21,11 +21,14 @@ open Format
 module type OBJ =
   sig
     type t
+    val repr : 'a -> t
     val obj : t -> 'a
     val is_block : t -> bool
     val tag : t -> int
     val size : t -> int
     val field : t -> int -> t
+    val double_array_tag : int
+    val double_field : t -> int -> float
   end
 
 module type EVALPATH =
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index ec012388c3..63cc2b5b1a 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -448,7 +448,7 @@ let transl_declaration env sdecl id =
             make_constructor env (Path.Pident id) params
                              scstr.pcd_args scstr.pcd_res
           in
-          if unbox then begin
+          if Config.flat_float_array && unbox then begin
             (* Cannot unbox a type when the argument can be both float and
                non-float because it interferes with the dynamic float array
                optimization. This can only happen when the type is a GADT
diff --git a/utils/config.mli b/utils/config.mli
index aed5471489..f2d32f2eb2 100644
--- a/utils/config.mli
+++ b/utils/config.mli
@@ -165,5 +165,8 @@ val libunwind_link_flags : string
 
 val safe_string: bool
         (* Whether the compiler was configured with -safe-string *)
+val flat_float_array : bool
+        (* Whether the compiler and runtime automagically flatten float
+           arrays *)
 val afl_instrument : bool
         (* Whether afl-fuzz instrumentation is generated by default *)
diff --git a/utils/config.mlp b/utils/config.mlp
index 59da8e5e7c..158b76edeb 100644
--- a/utils/config.mlp
+++ b/utils/config.mlp
@@ -64,6 +64,8 @@ let profiling = %%PROFILING%%
 let flambda = %%FLAMBDA%%
 let safe_string = %%SAFE_STRING%%
 
+let flat_float_array = %%FLAT_FLOAT_ARRAY%%
+
 let afl_instrument = %%AFL_INSTRUMENT%%
 
 let exec_magic_number = "Caml1999X011"
@@ -171,6 +173,7 @@ let print_config oc =
   p_bool "flambda" flambda;
   p_bool "spacetime" spacetime;
   p_bool "safe_string" safe_string;
+  p_bool "flat_float_array" flat_float_array;
 
   (* print the magic number *)
   p "exec_magic_number" exec_magic_number;