wip

Author: mshinwell

ocaml/runtime/amd64.S

@@ -727,6 +727,9 @@ CFI_STARTPROC
         movq    C_ARG_2, %rbx      /* closure */
         movq    0(C_ARG_3), %rax   /* argument */
         movq    0(%rbx), %r12      /* code pointer */
+LBL(120):
+        cmp     $1, C_ARG_4
+        je      LBL(caml_start_program_async_exn)
         jmp     LBL(caml_start_program)
 CFI_ENDPROC
 ENDFUNCTION(G(caml_callback_asm))
@@ -741,7 +744,7 @@ CFI_STARTPROC
         movq    0(C_ARG_3), %rax   /* first argument */
         movq    8(C_ARG_3), %rbx   /* second argument */
         LEA_VAR(caml_apply2, %r12) /* code pointer */
-        jmp     LBL(caml_start_program)
+        jmp     LBL(120)
 CFI_ENDPROC
 ENDFUNCTION(G(caml_callback2_asm))
 
@@ -756,24 +759,10 @@ CFI_STARTPROC
         movq    C_ARG_2, %rsi      /* closure */
         movq    16(C_ARG_3), %rdi  /* third argument */
         LEA_VAR(caml_apply3, %r12) /* code pointer */
-        jmp     LBL(caml_start_program)
+        jmp     LBL(120)
 CFI_ENDPROC
 ENDFUNCTION(G(caml_callback3_asm))
 
-/* Variant of caml_callback_asm that installs an async exn trap frame. */
-FUNCTION(G(caml_callback_asm_async_exn))
-CFI_STARTPROC
-    /* Save callee-save registers */
-        PUSH_CALLEE_SAVE_REGS
-    /* Initial loading of arguments */
-        movq    C_ARG_1, %r14      /* Caml_state */
-        movq    C_ARG_2, %rbx      /* closure */
-        movq    0(C_ARG_3), %rax   /* argument */
-        movq    0(%rbx), %r12      /* code pointer */
-        jmp     LBL(caml_start_program_async_exn)
-CFI_ENDPROC
-ENDFUNCTION(G(caml_callback_asm_async_exn))
-
 FUNCTION(G(caml_ml_array_bound_error))
 CFI_STARTPROC
         LEA_VAR(caml_array_bound_error, %rax)

ocaml/runtime/callback.c

@@ -51,26 +51,11 @@ static void init_callback_code(void)
   callback_code_inited = 1;
 }
 
-static int is_async_exn(value exn)
-{
-  const value *break_exn;
-
-  if (caml_global_data == 0) return 0;
-
-  if (exn == Field(caml_global_data, STACK_OVERFLOW_EXN)) return 1;
-
-  /* "Sys.Break" must match stdlib/sys.mlp. */
-  break_exn = caml_named_value("Sys.Break");
-  if (break_exn != NULL && exn == *break_exn) return 1;
-
-  return 0;
-}
-
 static value caml_callbackN_exn0(value closure, int narg, value args[],
-                                 int catch_async_exns)
+                                 int *returning_async_exn)
 {
-  int i;
-  value res, exn;
+  int i, returning_async_exn;
+  value res;
 
   CAMLassert(narg + 4 <= 256);
 
@@ -83,26 +68,16 @@ static value caml_callbackN_exn0(value closure, int narg, value args[],
   if (!callback_code_inited) init_callback_code();
   callback_code[1] = narg + 3;
   callback_code[3] = narg;
-  res = caml_interprete(callback_code, sizeof(callback_code));
+  res = caml_interprete(callback_code, sizeof(callback_code),
+    returning_async_exn);
   if (Is_exception_result(res)) Caml_state->extern_sp += narg + 4; /* PR#3419 */
 
-  if (!Is_exception_result(res)) return res;
-
-  exn = Extract_exception(res);
-
-  /* When not called from [Sys.with_async_exns], any asynchronous exceptions
-     must be reraised here, rather than being returned as the result of one
-     of the [caml_callback*] functions.  This will cause them to arrive only
-     at any [Sys.with_async_exns] and toplevel uncaught exception handler
-     sites. */
-  if (!catch_async_exns && is_async_exn(exn)) caml_raise_async(exn);
-
   return res;
 }
 
 CAMLexport value caml_callbackN_exn(value closure, int narg, value args[])
 {
-  return caml_callbackN_exn0(closure, narg, args, 0);
+  return caml_callbackN_exn0(closure, narg, args, NULL);
 }
 
 CAMLexport value caml_callback_exn(value closure, value arg1)
@@ -117,25 +92,59 @@ CAMLexport value caml_callback2_exn(value closure, value arg1, value arg2)
   value arg[2];
   arg[0] = arg1;
   arg[1] = arg2;
-  return caml_callbackN_exn(closure, 2, arg);
+  return caml_callbackN_exn0(closure, 2, arg);
 }
 
 CAMLexport value caml_callback3_exn(value closure,
-                               value arg1, value arg2, value arg3)
+                                    value arg1, value arg2, value arg3)
 {
   value arg[3];
   arg[0] = arg1;
   arg[1] = arg2;
   arg[2] = arg3;
-  return caml_callbackN_exn(closure, 3, arg);
+  return caml_callbackN_exn0(closure, 3, arg);
 }
 
-CAMLexport value caml_callback_async_exn(value closure, value arg1)
+/* Exception-propagating variants of the above */
+
+CAMLexport value caml_callbackN(value closure, int narg, value args[])
+{
+  value res;
+  int returning_async_exn;
+
+  res = caml_callbackN_exn0(closure, narg, args, &returning_async_exn);
+  if (Is_exception_result(res)) {
+    value exn = Extract_exception(res);
+    if (returning_async_exn) caml_raise_async(exn);
+    else caml_raise(exn);
+  }
+
+  return res;
+}
+
+CAMLexport value caml_callback_exn(value closure, value arg1)
 {
   value arg[1];
   arg[0] = arg1;
+  return caml_callbackN(closure, 1, arg);
+}
 
-  return caml_callbackN_exn0(closure, 1, arg, 1);
+CAMLexport value caml_callback2_exn(value closure, value arg1, value arg2)
+{
+  value arg[2];
+  arg[0] = arg1;
+  arg[1] = arg2;
+  return caml_callbackN(closure, 2, arg);
+}
+
+CAMLexport value caml_callback3_exn(value closure,
+                                    value arg1, value arg2, value arg3)
+{
+  value arg[3];
+  arg[0] = arg1;
+  arg[1] = arg2;
+  arg[2] = arg3;
+  return caml_callbackN(closure, 3, arg);
 }
 
 #else
@@ -165,7 +174,6 @@ CAMLexport value caml_callback3_exn(value closure,
   return caml_callback3_asm(Caml_state, closure, args);
 }
 
-
 CAMLexport value caml_callbackN_exn(value closure, int narg, value args[])
 {
   CAMLparam1 (closure);
@@ -197,16 +205,6 @@ CAMLexport value caml_callbackN_exn(value closure, int narg, value args[])
   CAMLreturn (res);
 }
 
-extern value (caml_callback_asm_async_exn)
-  (caml_domain_state* state, value closure, value* args);
-
-CAMLexport value caml_callback_async_exn(value closure, value arg)
-{
-  return caml_callback_asm_async_exn(Caml_state, closure, &arg);
-}
-
-#endif
-
 /* Exception-propagating variants of the above */
 
 CAMLexport value caml_callback (value closure, value arg)
@@ -230,6 +228,8 @@ CAMLexport value caml_callbackN (value closure, int narg, value args[])
   return caml_raise_if_exception(caml_callbackN_exn(closure, narg, args));
 }
 
+#endif
+
 /* Naming of OCaml values */
 
 struct named_value {

ocaml/runtime/caml/callback.h

@@ -39,8 +39,6 @@ CAMLextern value caml_callback3_exn (value closure,
                                      value arg1, value arg2, value arg3);
 CAMLextern value caml_callbackN_exn (value closure, int narg, value args[]);
 
-CAMLextern value caml_callback_async_exn (value closure, value arg);
-
 CAMLextern const value * caml_named_value (char const * name);
 typedef void (*caml_named_action) (const value*, char *);
 CAMLextern void caml_iterate_named_values(caml_named_action f);

ocaml/runtime/caml/interp.h

@@ -24,7 +24,8 @@
 #include "mlvalues.h"
 
 /* interpret a bytecode */
-value caml_interprete (code_t prog, asize_t prog_size);
+value caml_interprete (code_t prog, asize_t prog_size,
+  int *returning_async_exn);
 
 #endif /* CAML_INTERNALS */
 

ocaml/runtime/fail_byt.c

@@ -248,7 +248,7 @@ CAMLexport value caml_check_async_exn(value res, const char *msg)
 CAMLprim value caml_with_async_exns(value body_callback)
 {
   value exn;
-  value result = caml_callback_async_exn(body_callback, Val_unit);
+  value result = caml_callback_exn(body_callback, Val_unit);
 
   if (!Is_exception_result(result))
     return result;

ocaml/runtime/fail_nat.c

@@ -260,7 +260,7 @@ CAMLexport value caml_check_async_exn(value res, const char *msg)
 CAMLprim value caml_with_async_exns(value body_callback)
 {
   value exn;
-  value result = caml_callback_async_exn(body_callback, Val_unit);
+  value result = caml_callback_exn(body_callback, Val_unit);
 
   if (!Is_exception_result(result))
     return result;

ocaml/runtime/interp.c

@@ -211,7 +211,7 @@ static intnat caml_bcodcount;
 
 /* The interpreter itself */
 
-value caml_interprete(code_t prog, asize_t prog_size)
+value caml_interprete(code_t prog, asize_t prog_size, int *returning_async_exn)
 {
 #ifdef PC_REG
   register code_t pc PC_REG;
@@ -250,6 +250,8 @@ value caml_interprete(code_t prog, asize_t prog_size)
   };
 #endif
 
+  if (returning_async_exn != NULL) *returning_async_exn = 0;
+
   if (prog == NULL) {           /* Interpreter is initializing */
 #ifdef THREADED_CODE
     caml_instr_table = (char **) jumptable;
@@ -306,6 +308,8 @@ value caml_interprete(code_t prog, asize_t prog_size)
     Caml_state->trapsp = (value *) ((char *) Caml_state->stack_high
                                       - initial_trapsp_offset);
 
+    if (returning_async_exn != NULL) *returning_async_exn = 1;
+
     goto raise_notrace;
   }
   Caml_state->external_raise_async = &raise_async_buf;

ocaml/runtime/printexc.c

@@ -122,9 +122,9 @@ static void default_fatal_uncaught_exception(value exn, const char *msg2)
   saved_backtrace_pos = Caml_state->backtrace_pos;
   Caml_state->backtrace_active = 0;
   at_exit = caml_named_value("Pervasives.do_at_exit");
-  /* We use [caml_callback_async_exn] to ensure that, in the event of an
-     asynchronous exception occurring, it still gets caught here. */
-  if (at_exit != NULL) caml_callback_async_exn(*at_exit, Val_unit);
+  /* In the event of an asynchronous exception occurring, it will still get
+     caught here, because of the semantics of [caml_callback_exn]. */
+  if (at_exit != NULL) caml_callback_exn(*at_exit, Val_unit);
   Caml_state->backtrace_active = saved_backtrace_active;
   Caml_state->backtrace_pos = saved_backtrace_pos;
   /* Display the uncaught exception */

ocaml/runtime/startup_byt.c

@@ -466,7 +466,7 @@ CAMLexport void caml_main(char_os **argv)
 #endif
   /* Execute the program */
   caml_debugger(PROGRAM_START, Val_unit);
-  res = caml_interprete(caml_start_code, caml_code_size);
+  res = caml_interprete(caml_start_code, caml_code_size, NULL);
   if (Is_exception_result(res)) {
     Caml_state->exn_bucket = Extract_exception(res);
     if (caml_debugger_in_use) {
@@ -527,7 +527,7 @@ CAMLexport value caml_startup_code_exn(
   caml_init_atom_table();
   caml_init_backtrace();
   /* Initialize the interpreter */
-  caml_interprete(NULL, 0);
+  caml_interprete(NULL, 0, NULL);
   /* Initialize the debugger, if needed */
   caml_debugger_init();
   /* Load the code */
@@ -557,7 +557,7 @@ CAMLexport value caml_startup_code_exn(
   caml_load_main_debug_info();
   /* Execute the program */
   caml_debugger(PROGRAM_START, Val_unit);
-  return caml_interprete(caml_start_code, caml_code_size);
+  return caml_interprete(caml_start_code, caml_code_size, NULL);
 }
 
 CAMLexport void caml_startup_code(