Ensure allocations are initialised, even dead ones

stedolan · stedolan · commit ce62e451d5b2 · 2021-11-30T11:43:35.000Z
(See oxcaml#405)
diff --git a/asmcomp/comballoc.ml b/asmcomp/comballoc.ml
@@ -70,7 +70,8 @@ let rec combine i allocstate =
           i.arg i.res i.dbg next, allocstate)
       end
   | Iop(Icall_ind | Icall_imm _ | Iextcall _ |
-        Itailcall_ind | Itailcall_imm _) ->
+        Itailcall_ind | Itailcall_imm _ |
+        Iintop Icheckbound | Iintop_imm (Icheckbound, _)) ->
       let newnext = combine_restart i.next in
       (instr_cons_debug i.desc i.arg i.res i.dbg newnext,
        allocstate)
diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml
@@ -343,12 +343,13 @@ method is_simple_expr = function
   | Cop(op, args, _) ->
       begin match op with
         (* The following may have side effects *)
-      | Capply _ | Cextcall _ | Calloc _ | Cstore _ | Craise _ -> false
+      | Capply _ | Cextcall _ | Calloc _ | Cstore _
+      | Craise _ | Ccheckbound -> false
         (* The remaining operations are simple if their args are *)
       | Cload _ | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi | Cand | Cor
       | Cxor | Clsl | Clsr | Casr | Ccmpi _ | Caddv | Cadda | Ccmpa _ | Cnegf
       | Cabsf | Caddf | Csubf | Cmulf | Cdivf | Cfloatofint | Cintoffloat
-      | Ccmpf _ | Ccheckbound -> List.for_all self#is_simple_expr args
+      | Ccmpf _ -> List.for_all self#is_simple_expr args
       end
   | Cassign _ | Cifthenelse _ | Cswitch _ | Ccatch _ | Cexit _
   | Ctrywith _ | Cregion _ | Ctail _ -> false
diff --git a/testsuite/tests/basic/combine_checkbound.ml b/testsuite/tests/basic/combine_checkbound.ml
@@ -0,0 +1,36 @@
+(* TEST
+   * native *)
+
+let glob = ref (1, 2)
+let[@inline never] combine1 x a =
+  begin try
+    glob := (2, x);
+    glob := (3, a.(4));
+  with
+  | Invalid_argument _ -> ()
+  end;
+  !glob
+
+let[@inline never] combine2 x a =
+  let loc = ref (1, 2) in
+  begin try
+    loc := (2, x);
+    loc := (3, a.(4));
+  with
+  | Invalid_argument _ -> ()
+  end;
+  !loc
+
+let[@inline never] measure f =
+  let empty_array = [| |] in
+  let prebefore = Gc.minor_words () in
+  let before = Gc.minor_words () in
+  let r = f 42 empty_array in
+  assert (r = (2, 42));
+  let after = Gc.minor_words () in
+  ((after -. before) -. (before -. prebefore))
+
+
+let () =
+  Printf.printf "%10s: %.0f\n" "combine1" (measure combine1);
+  Printf.printf "%10s: %.0f\n" "combine2" (measure combine2)
diff --git a/testsuite/tests/basic/combine_checkbound.reference b/testsuite/tests/basic/combine_checkbound.reference
@@ -0,0 +1,2 @@
+  combine1: 3
+  combine2: 3
