start work

backend/cmm_helpers.ml

@@ -47,6 +47,7 @@ let caml_black = Nativeint.shift_left (Nativeint.of_int 3) 8
 
 let caml_local =
   Nativeint.shift_left (Nativeint.of_int (if Config.runtime5 then 3 else 2)) 8
+
 (* cf. runtime/caml/gc.h *)
 
 (* Loads *)
@@ -1527,14 +1528,15 @@ let make_mixed_alloc ~mode dbg tag shape args =
       | Float | Float64 -> float_array_set arr ofs newval dbg
   in
   let size =
-    let values, floats = Lambda.count_mixed_block_values_and_floats shape in
-    if size_float <> size_addr
-    then
-      Misc.fatal_error
-        "Unable to compile mixed blocks on a platform where a float is not the \
-         same width as a value.";
-    values + floats
+    (* CR layouts 5.1: When we pack int32s more efficiently, this code will need
+       to change. *)
+    value_prefix_len + List.length flat_suffix
   in
+  if size_float <> size_addr
+  then
+    Misc.fatal_error
+      "Unable to compile mixed blocks on a platform where a float is not the \
+       same width as a value.";
   make_alloc_generic ~scannable_prefix:(Scan_prefix value_prefix_len) ~mode
     set_fn dbg tag size args
 
@@ -2404,7 +2406,7 @@ let send kind met obj args args_type result akind dbg =
       | _ -> bind "met" (lookup_tag obj met dbg) (call_met obj args args_type))
 
 (*
- * CAMLprim value caml_cache_public_method (value meths, value tag,
+   * CAMLprim value caml_cache_public_method (value meths, value tag,
  *                                          value *cache)
  * {
  *   int li = 3, hi = Field(meths,0), mi;

ocaml/lambda/lambda.ml

@@ -342,7 +342,8 @@ and layout =
 and block_shape =
   value_kind list option
 
-and flat_element = Types.flat_element = Imm | Float | Float64
+and flat_element = Types.flat_element =
+    Imm | Float | Float64 | Bits32 | Bits64 | Word
 and flat_element_read =
   | Flat_read_imm
   | Flat_read_float of alloc_mode
@@ -472,13 +473,6 @@ let join_boxed_vector_layout v1 v2 =
   match v1, v2 with
   | Pvec128 v1, Pvec128 v2 -> Punboxed_vector (Pvec128 (join_vec128_types v1 v2))
 
-let equal_flat_element e1 e2 =
-  match e1, e2 with
-  | Imm, Imm -> true
-  | Float, Float -> true
-  | Float64, Float64 -> true
-  | (Imm | Float | Float64), _ -> false
-
 let rec equal_value_kind x y =
   match x, y with
   | Pgenval, Pgenval -> true
@@ -513,7 +507,7 @@ and equal_constructor_shape x y =
       List.length p1 = List.length p2
       && List.for_all2 equal_value_kind p1 p2
       && List.length s1 = List.length s2
-      && List.for_all2 equal_flat_element s1 s2
+      && List.for_all2 Types.equal_flat_element s1 s2
   | (Constructor_uniform _ | Constructor_mixed _), _ -> false
 
 let equal_layout x y =
@@ -1246,9 +1240,6 @@ let transl_prim mod_name name =
 let transl_mixed_product_shape : Types.mixed_product_shape -> mixed_block_shape =
   fun x -> x
 
-let count_mixed_block_values_and_floats =
-  Types.count_mixed_record_values_and_floats
-
 type mixed_block_element = Types.mixed_product_element =
   | Value_prefix
   | Flat_suffix of flat_element

ocaml/lambda/lambda.mli

@@ -350,7 +350,8 @@ and layout =
 and block_shape =
   value_kind list option
 
-and flat_element = Types.flat_element = Imm | Float | Float64
+and flat_element = Types.flat_element =
+    Imm | Float | Float64 | Bits32 | Bits64 | Word
 and flat_element_read =
   | Flat_read_imm
   | Flat_read_float of alloc_mode
@@ -790,7 +791,6 @@ val transl_extension_path: scoped_location -> Env.t -> Path.t -> lambda
 val transl_class_path: scoped_location -> Env.t -> Path.t -> lambda
 
 val transl_mixed_product_shape: Types.mixed_product_shape -> mixed_block_shape
-val count_mixed_block_values_and_floats : mixed_block_shape -> int * int
 
 type mixed_block_element =
   | Value_prefix

ocaml/typing/printtyped.ml

@@ -193,10 +193,8 @@ let variant_representation i ppf = let open Types in function
       cstrs
   | Variant_extensible -> line i ppf "Variant_inlined\n"
 
-let flat_element i ppf = let open Types in function
-  | Imm -> line i ppf "Immediate\n"
-  | Float -> line i ppf "Float\n"
-  | Float64 -> line i ppf "Float64\n"
+let flat_element i ppf flat_element =
+  line i ppf "%s\n" (Types.flat_element_to_string flat_element)
 
 let record_representation i ppf = let open Types in function
   | Record_unboxed ->

ocaml/typing/types.ml

@@ -275,7 +275,7 @@ and abstract_reason =
     Abstract_def
   | Abstract_rec_check_regularity
 
-and flat_element = Imm | Float | Float64
+and flat_element = Imm | Float | Float64 | Bits32 | Bits64 | Word
 and mixed_product_shape =
   { value_prefix_len : int;
     flat_suffix : flat_element array;
@@ -571,8 +571,10 @@ let equal_tag t1 t2 =
 
 let equal_flat_element e1 e2 =
   match e1, e2 with
-  | Imm, Imm | Float64, Float64 | Float, Float -> true
-  | (Imm | Float64 | Float), _ -> false
+  | Imm, Imm | Float64, Float64 | Float, Float
+  | Word, Word | Bits32, Bits32 | Bits64, Bits64
+    -> true
+  | (Imm | Float64 | Float | Word | Bits32 | Bits64), _ -> false
 
 let equal_mixed_product_shape r1 r2 = r1 == r2 ||
   (* Warning 9 alerts us if we add another field *)
@@ -690,15 +692,6 @@ let signature_item_id = function
   | Sig_class_type (id, _, _, _)
     -> id
 
-let count_mixed_record_values_and_floats { value_prefix_len; flat_suffix } =
-  Array.fold_left
-    (fun (values, floats) elem ->
-      match elem with
-      | Imm -> (values+1, floats)
-      | Float | Float64 -> (values, floats+1))
-    (value_prefix_len, 0)
-    flat_suffix
-
 type mixed_product_element =
   | Value_prefix
   | Flat_suffix of flat_element
@@ -708,6 +701,14 @@ let get_mixed_product_element { value_prefix_len; flat_suffix } i =
   if i < value_prefix_len then Value_prefix
   else Flat_suffix flat_suffix.(i - value_prefix_len)
 
+let flat_element_to_string = function
+  | Imm -> "Imm"
+  | Float -> "Float"
+  | Float64 -> "Float64"
+  | Bits32 -> "Bits32"
+  | Bits64 -> "Bits64"
+  | Word -> "Word"
+
 (**** Definitions for backtracking ****)
 
 type change =

ocaml/typing/types.mli

@@ -558,7 +558,7 @@ and abstract_reason =
    non-empty suffix of "flat" elements. Intuitively, a flat element is one that
    need not be scanned by the garbage collector.
 *)
-and flat_element = Imm | Float | Float64
+and flat_element = Imm | Float | Float64 | Bits32 | Bits64 | Word
 and mixed_product_shape =
   { value_prefix_len : int;
     (* We use an array just so we can index into the middle. *)
@@ -873,8 +873,6 @@ val bound_value_identifiers: signature -> Ident.t list
 
 val signature_item_id : signature_item -> Ident.t
 
-val count_mixed_record_values_and_floats : mixed_product_shape -> int * int
-
 type mixed_product_element =
   | Value_prefix
   | Flat_suffix of flat_element
@@ -883,6 +881,8 @@ type mixed_product_element =
 val get_mixed_product_element :
   mixed_product_shape -> int -> mixed_product_element
 
+val flat_element_to_string : flat_element -> string
+
 (**** Utilities for backtracking ****)
 
 type snapshot