Fix bad interaction of deadcode elimination and unboxed float records

When one of the fields is not used, we fill it with the float value 0.
rather than using the generic placeholder `(ref.i31 (i32.const 0))`,
which does not make sense.

Author: vouillon

compiler/bin-wasm_of_ocaml/compile.ml

@@ -146,7 +146,9 @@ let generate_prelude ~out_file =
     | Some p -> p
     | None -> assert false
   in
-  let Driver.{ program; variable_uses; in_cps; _ } = Driver.optimize ~profile code in
+  let Driver.{ program; variable_uses; in_cps; deadcode_sentinal; _ } =
+    Driver.optimize ~profile code
+  in
   let context = Wa_generate.start () in
   let debug = Parse_bytecode.Debug.create ~include_cmis:false false in
   let _ =
@@ -155,6 +157,7 @@ let generate_prelude ~out_file =
       ~unit_name:(Some "prelude")
       ~live_vars:variable_uses
       ~in_cps
+      ~deadcode_sentinal
       ~debug
       program
   in
@@ -305,11 +308,20 @@ let run
       | None, Some p -> p
       | None, None -> assert false
     in
-    let Driver.{ program; variable_uses; in_cps; _ } = Driver.optimize ~profile code in
+    let Driver.{ program; variable_uses; in_cps; deadcode_sentinal; _ } =
+      Driver.optimize ~profile code
+    in
     let context = Wa_generate.start () in
     let debug = one.debug in
     let toplevel_name, generated_js =
-      Wa_generate.f ~context ~unit_name ~live_vars:variable_uses ~in_cps ~debug program
+      Wa_generate.f
+        ~context
+        ~unit_name
+        ~live_vars:variable_uses
+        ~in_cps
+        ~deadcode_sentinal
+        ~debug
+        program
     in
     if standalone then Wa_generate.add_start_function ~context toplevel_name;
     Wa_generate.output ch ~context ~debug;

compiler/lib/wasm/wa_curry.ml

@@ -257,7 +257,13 @@ module Make (Target : Wa_target_sig.S) = struct
         (fun ~typ closure ->
           let* l = expression_list load l in
           call ?typ ~cps:true ~arity closure l)
-        (let* args = Memory.allocate ~tag:0 (List.map ~f:(fun x -> `Var x) (List.tl l)) in
+        (let* args =
+           (* We don't need the deadcode sentinal when the tag is 0 *)
+           Memory.allocate
+             ~tag:0
+             ~deadcode_sentinal:(Code.Var.fresh ())
+             (List.map ~f:(fun x -> `Var x) (List.tl l))
+         in
          let* make_iterator =
            register_import ~name:"caml_apply_continuation" (Fun (func_type 0))
          in

compiler/lib/wasm/wa_gc_target.ml

@@ -656,16 +656,18 @@ module Memory = struct
     let* ty = Type.float_type in
     wasm_struct_get ty (wasm_cast ty e) 0
 
-  let allocate ~tag l =
+  let allocate ~tag ~deadcode_sentinal l =
     if tag = 254
     then
       let* l =
         expression_list
           (fun v ->
-            unbox_float
-              (match v with
-              | `Var y -> load y
-              | `Expr e -> return e))
+            match v with
+            | `Var y ->
+                if Code.Var.equal y deadcode_sentinal
+                then return (W.Const (F64 0.))
+                else unbox_float (load y)
+            | `Expr e -> unbox_float (return e))
           l
       in
       let* ty = Type.float_array_type in

compiler/lib/wasm/wa_generate.ml

@@ -32,6 +32,7 @@ module Generate (Target : Wa_target_sig.S) = struct
   type ctx =
     { live : int array
     ; in_cps : Effects.in_cps
+    ; deadcode_sentinal : Var.t
     ; blocks : block Addr.Map.t
     ; closures : Wa_closure_conversion.closure Var.Map.t
     ; global_context : Wa_code_generation.context
@@ -209,7 +210,10 @@ module Generate (Target : Wa_target_sig.S) = struct
         let* closure = load f in
         return (W.Call (apply, args @ [ closure ]))
     | Block (tag, a, _, _) ->
-        Memory.allocate ~tag (List.map ~f:(fun x -> `Var x) (Array.to_list a))
+        Memory.allocate
+          ~deadcode_sentinal:ctx.deadcode_sentinal
+          ~tag
+          (List.map ~f:(fun x -> `Var x) (Array.to_list a))
     | Field (x, n, Non_float) -> Memory.field (load x) n
     | Field (x, n, Float) ->
         Memory.float_array_get
@@ -633,7 +637,7 @@ module Generate (Target : Wa_target_sig.S) = struct
                     l
                     ~init:(return [])
                 in
-                Memory.allocate ~tag:0 l
+                Memory.allocate ~tag:0 ~deadcode_sentinal:ctx.deadcode_sentinal l
             | Extern name, l -> (
                 let name = Primitive.resolve name in
                 try
@@ -1088,14 +1092,22 @@ module Generate (Target : Wa_target_sig.S) = struct
     ~should_export
     ~warn_on_unhandled_effect
 *)
+      ~deadcode_sentinal
       ~debug =
     global_context.unit_name <- unit_name;
     let p, closures = Wa_closure_conversion.f p in
     (*
   Code.Print.program (fun _ _ -> "") p;
 *)
     let ctx =
-      { live = live_vars; in_cps; blocks = p.blocks; closures; global_context; debug }
+      { live = live_vars
+      ; in_cps
+      ; deadcode_sentinal
+      ; blocks = p.blocks
+      ; closures
+      ; global_context
+      ; debug
+      }
     in
     let toplevel_name = Var.fresh_n "toplevel" in
     let functions =
@@ -1198,10 +1210,10 @@ let fix_switch_branches p =
 
 let start () = make_context ~value_type:Wa_gc_target.Value.value
 
-let f ~context ~unit_name p ~live_vars ~in_cps ~debug =
+let f ~context ~unit_name p ~live_vars ~in_cps ~deadcode_sentinal ~debug =
   let p = if Config.Flag.effects () then fix_switch_branches p else p in
   let module G = Generate (Wa_gc_target) in
-  G.f ~context ~unit_name ~live_vars ~in_cps ~debug p
+  G.f ~context ~unit_name ~live_vars ~in_cps ~deadcode_sentinal ~debug p
 
 let add_start_function =
   let module G = Generate (Wa_gc_target) in

compiler/lib/wasm/wa_generate.mli

@@ -26,6 +26,7 @@ val f :
   -> Code.program
   -> live_vars:int array
   -> in_cps:Effects.in_cps
+  -> deadcode_sentinal:Code.Var.t
   -> debug:Parse_bytecode.Debug.t
   -> Wa_ast.var * (string list * (string * Javascript.expression) list)
 

compiler/lib/wasm/wa_target_sig.ml

@@ -21,7 +21,10 @@ module type S = sig
 
   module Memory : sig
     val allocate :
-      tag:int -> [ `Expr of Wa_ast.expression | `Var of Wa_ast.var ] list -> expression
+         tag:int
+      -> deadcode_sentinal:Code.Var.t
+      -> [ `Expr of Wa_ast.expression | `Var of Wa_ast.var ] list
+      -> expression
 
     val load_function_pointer :
          cps:bool