Fix emit_stores (#3992)

Author: gretay-js

backend/cfg_selectgen.ml

@@ -606,10 +606,10 @@ module Make (Target : Cfg_selectgen_target_intf.S) = struct
     Ok (Array.concat (Array.to_list locs), stack_ofs)
 
   and emit_stores env sub_cfg dbg (args : Cmm.expression list) regs_addr =
+    let byte_offset = ref (-Arch.size_int) in
     let addressing_mode =
-      ref (Arch.offset_addressing Arch.identity_addressing (-Arch.size_int))
+      ref (Arch.offset_addressing Arch.identity_addressing !byte_offset)
     in
-    let byte_offset = ref 0 in
     let base =
       assert (Array.length regs_addr = 1);
       ref regs_addr
@@ -654,32 +654,35 @@ module Make (Target : Cfg_selectgen_target_intf.S) = struct
               | Maybe_out_of_range ->
                 Target.is_store_out_of_range chunk ~byte_offset:!byte_offset
             in
-            let new_addressing_mode =
-              match is_out_of_range with
-              | Within_range -> !addressing_mode
-              | Out_of_range ->
-                (* Use a temporary to store the address [!base + offset]. *)
-                let tmp = Reg.createv Cmm.typ_int in
-                (* CR-someday xclerc: Now that this code in the "generic" part,
-                   it is maybe a bit unexpected to assume there is no better
-                   sequence to emit x += k. That being said, it is a corner
-                   case. *)
-                insert_debug env sub_cfg
-                  (Op (SU.make_const_int (Nativeint.of_int !byte_offset)))
-                  dbg [||] tmp;
-                insert_debug env sub_cfg (Op (Operation.Intop Iadd)) dbg
-                  (Array.append !base tmp) tmp;
-                (* Use the temporary as the new base address. *)
-                base := tmp;
-                Arch.identity_addressing
+            let reset_addressing () =
+              (* Use a temporary to store the address [!base + !byte_offset]. *)
+              let tmp = Reg.createv Cmm.typ_int in
+              (* CR-someday xclerc: Now that this code in the "generic" part, it
+                 is maybe a bit unexpected to assume there is no better sequence
+                 to emit x += k. That being said, it is a corner case. *)
+              insert_debug env sub_cfg
+                (Op (SU.make_const_int (Nativeint.of_int !byte_offset)))
+                dbg [||] tmp;
+              (* The new base is a pointer into the middle of an ocaml value. *)
+              assert (!byte_offset > 0);
+              let new_base = Reg.createv Cmm.typ_addr in
+              insert_debug env sub_cfg (Op (Operation.Intop Iadd)) dbg
+                (Array.append !base tmp) new_base;
+              (* Use the temporary as the new base address. *)
+              base := new_base;
+              byte_offset := 0;
+              addressing_mode := Arch.identity_addressing
             in
+            (match is_out_of_range with
+            | Within_range -> ()
+            | Out_of_range -> reset_addressing ());
             insert_debug env sub_cfg
-              (Op (Store (chunk, new_addressing_mode, false)))
+              (Op (Store (chunk, !addressing_mode, false)))
               dbg
-              (Array.append [| r |] regs_addr)
+              (Array.append [| r |] !base)
               [||];
             let size = SU.size_component r.Reg.typ in
-            addressing_mode := Arch.offset_addressing new_addressing_mode size;
+            addressing_mode := Arch.offset_addressing !addressing_mode size;
             byte_offset := !byte_offset + size
           done
         | Some op ->

testsuite/tests/typing-layouts-arrays/test_vec128_u_array.ml

@@ -2,7 +2,6 @@
  readonly_files = "gen_u_array.ml test_gen_u_array.ml";
  modules = "${readonly_files} stubs.c";
  include stdlib_upstream_compatible;
- arch_amd64;
  flambda2;
  {
    flags = "-extension layouts_beta -extension simd_beta";