diff --git a/ocaml/runtime/amd64.S b/ocaml/runtime/amd64.S index 9a9326d7d2d..f98e0432029 100644 --- 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 index 4a82484c101..604c259fc6b 100644 --- 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 index 795e8cc1c60..0b36d1a519e 100644 --- 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 index f0fa76b75c1..247ee3043e1 100644 --- 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 index bb891b940f3..2f5b2dfa7a8 100644 --- 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