Port runtime of #1682 (#2050)

ocaml-flambda · Nov 21, 2023 · fb9a9f4 · fb9a9f4
1 parent 42db003
commit fb9a9f4
Show file tree

Hide file tree

Showing 5 changed files with 53 additions and 1 deletion.
diff --git a/ocaml/runtime/amd64.S b/ocaml/runtime/amd64.S
@@ -1032,6 +1032,14 @@ CFI_STARTPROC
 CFI_ENDPROC
 ENDFUNCTION(G(caml_ml_array_bound_error))
 
+FUNCTION(G(caml_ml_array_align_error))
+CFI_STARTPROC
+        ENTER_FUNCTION
+        LEA_VAR(caml_array_align_error_asm, %rax)
+        jmp     LBL(caml_c_call)
+CFI_ENDPROC
+ENDFUNCTION(G(caml_ml_array_align_error))
+
 FUNCTION(G(caml_assert_stack_invariants))
 CFI_STARTPROC
 /*      CHECK_STACK_ALIGNMENT */

diff --git a/ocaml/runtime/amd64nt.asm b/ocaml/runtime/amd64nt.asm
@@ -25,7 +25,8 @@
         EXTRN  caml_apply3: NEAR
         EXTRN  caml_program: NEAR
         EXTRN  caml_array_bound_error_asm: NEAR
-       EXTRN  caml_stash_backtrace: NEAR
+        EXTRN  caml_array_align_error: NEAR
+        EXTRN  caml_stash_backtrace: NEAR
 
 INCLUDE domain_state64.inc
 
@@ -423,6 +424,12 @@ caml_ml_array_bound_error:
         lea     rax, caml_array_bound_error_asm
         jmp     caml_c_call
 
+        PUBLIC  caml_ml_array_align_error
+        ALIGN   16
+caml_ml_array_align_error:
+        lea     rax, caml_array_align_error_asm
+        jmp     caml_c_call
+
         PUBLIC caml_system__code_end
 caml_system__code_end:
 

diff --git a/ocaml/runtime/caml/fail.h b/ocaml/runtime/caml/fail.h
@@ -145,6 +145,10 @@ CAMLnoreturn_start
 CAMLextern void caml_array_bound_error (void)
 CAMLnoreturn_end;
 
+CAMLnoreturn_start
+CAMLextern void caml_array_align_error (void)
+CAMLnoreturn_end;
+
 CAMLnoreturn_start
 CAMLextern void caml_raise_sys_blocked_io (void)
 CAMLnoreturn_end;

diff --git a/ocaml/runtime/fail_byt.c b/ocaml/runtime/fail_byt.c
@@ -163,6 +163,11 @@ CAMLexport void caml_array_bound_error(void)
   caml_invalid_argument("index out of bounds");
 }
 
+CAMLexport void caml_array_align_error(void)
+{
+  caml_invalid_argument("address was misaligned");
+}
+
 CAMLexport void caml_raise_out_of_memory(void)
 {
   check_global_data("Out_of_memory");

diff --git a/ocaml/runtime/fail_nat.c b/ocaml/runtime/fail_nat.c
@@ -222,6 +222,34 @@ void caml_array_bound_error_asm(void)
   caml_raise_exception(Caml_state, array_bound_exn());
 }
 
+static value array_align_exn(void)
+{
+  static atomic_uintnat exn_cache = ATOMIC_UINTNAT_INIT(0);
+  const value* exn = (const value*)atomic_load_acquire(&exn_cache);
+  if (!exn) {
+    exn = caml_named_value("Pervasives.array_align_error");
+    if (!exn) {
+      fprintf(stderr, "Fatal error: exception "
+        "Invalid_argument(\"address was misaligned\")\n");
+      exit(2);
+    }
+    atomic_store_release(&exn_cache, (uintnat)exn);
+  }
+  return *exn;
+}
+
+void caml_array_align_error(void)
+{
+  caml_raise(array_align_exn());
+}
+
+void caml_array_align_error_asm(void)
+{
+  /* This exception is raised directly from ocamlopt-compiled OCaml,
+     not C, so we jump directly to the OCaml handler (and avoid GC) */
+  caml_raise_exception(Caml_state, array_align_exn());
+}
+
 int caml_is_special_exception(value exn) {
   return exn == (value) caml_exn_Match_failure
     || exn == (value) caml_exn_Assert_failure