Merge pull request #12882 from gadmm/systhread_yield

gasche · web-flow · commit 572aeb5f06b7 · 2024-02-16T17:53:19.000+01:00
Execute preemptive systhread switching as a delayed pending action
diff --git a/Changes b/Changes
@@ -221,6 +221,14 @@ OCaml 5.2.0
   (Guillaume Munch-Maccagnoni, review by Anil Madhavapeddy and KC
    Sivaramakrishnan)
 
+- #12875, #12879, #12882: Execute preemptive systhread switching as a
+  delayed pending action. This ensures that one can reason within the
+  FFI that no mutation happens on the same domain when allocating on
+  the OCaml heap from C, consistently with OCaml 4. This also fixes
+  further bugs with the multicore systhreads implementation.
+  (Guillaume Munch-Maccagnoni, bug reports and suggestion by Mark
+   Shinwell, review by Nick Barnes and Stephen Dolan)
+
 - #12408: `Domain.spawn` no longer leaks its functional argument for
   the whole duration of the children domain lifetime.
   (Guillaume Munch-Maccagnoni, review by Gabriel Scherer)
@@ -247,7 +255,7 @@ OCaml 5.2.0
 
 - #11307: Finish adapting the implementation of asynchronous actions for
   multicore: soundness, liveness, and performance issues.
-  Do not crash if a signal handler is  called from an unregistered C
+  Do not crash if a signal handler is called from an unregistered C
   thread, and other possible soundness issues. Prevent issues where join
   on other domains could make the toplevel unresponsible to Ctrl-C. Avoid
   needless repeated polling in C code when callbacks cannot run
diff --git a/manual/src/cmds/intf-c.etex b/manual/src/cmds/intf-c.etex
@@ -1268,16 +1268,18 @@ has taken place since "r" was allocated.
 
 \subsection{ss:c-process-pending-actions}{Pending actions and asynchronous exceptions}
 
-Since 4.10, allocation functions are guaranteed not to call any OCaml
-callbacks from C, including finalisers and signal handlers, and delay
-their execution instead.
+Since 4.10, allocation functions are guaranteed not to run any OCaml
+code, including finalisers, signal handlers and other threads running
+on the same domain. Instead, their execution is delayed to a later
+safe point.
 
 The function \verb"caml_process_pending_actions" from
 "<caml/signals.h>" executes any pending signal handlers and
-finalisers, Memprof callbacks, and requested minor and major garbage
-collections. In particular, it can raise asynchronous exceptions. It
-is recommended to call it regularly at safe points inside long-running
-non-blocking C code.
+finalisers, Memprof callbacks, preemptive systhread switching, and
+requested minor and major garbage collections. In particular, it can
+raise asynchronous exceptions and cause mutations on the OCaml heap
+from the same domain. It is recommended to call it regularly at safe
+points inside long-running non-blocking C code.
 
 The variant \verb"caml_process_pending_actions_exn" is provided, that
 returns the exception instead of raising it directly into OCaml code.
diff --git a/otherlibs/systhreads/st_stubs.c b/otherlibs/systhreads/st_stubs.c
@@ -509,7 +509,7 @@ static void caml_thread_domain_initialize_hook(void)
   caml_memprof_enter_thread(new_thread->memprof);
 }
 
-CAMLprim value caml_thread_yield(value unit);
+static void thread_yield(void);
 
 void caml_thread_interrupt_hook(void)
 {
@@ -521,7 +521,7 @@ void caml_thread_interrupt_hook(void)
     &Caml_state->requested_external_interrupt;
 
   if (atomic_compare_exchange_strong(req_external_interrupt, &is_on, 0)) {
-    caml_thread_yield(Val_unit);
+    thread_yield();
   }
 
   return;
@@ -780,26 +780,33 @@ CAMLprim value caml_thread_uncaught_exception(value exn)
 
 /* Allow re-scheduling */
 
-CAMLprim value caml_thread_yield(value unit)
+static void thread_yield(void)
 {
   st_masterlock *m = Thread_lock(Caml_state->id);
   if (st_masterlock_waiters(m) == 0)
-    return Val_unit;
+    return;
 
   /* Do all the parts of a blocking section enter&leave except lock
      manipulation, which we will do more efficiently in
-     st_thread_yield, and asynchronous actions (since
-     [caml_thread_yield] must not raise). (Since our blocking section
-     does not contain anything interesting, do not bother saving
-     errno.)
+     st_thread_yield, and executing signal handlers (which is already
+     done at this point as part of the asynchronous actions mechanism
+     when forcing a systhread yield). (Since our blocking section does
+     not contain anything interesting, do not bother saving errno.)
   */
 
   save_runtime_state();
   st_thread_yield(m);
   restore_runtime_state(This_thread);
+
+  /* Switching threads might have unmasked some signal. */
   if (caml_check_pending_signals())
     caml_set_action_pending(Caml_state);
+}
 
+CAMLprim value caml_thread_yield(value unit)
+{
+  caml_process_pending_actions();
+  thread_yield();
   return Val_unit;
 }
 
diff --git a/runtime/caml/domain.h b/runtime/caml/domain.h
@@ -62,6 +62,7 @@ int caml_incoming_interrupts_queued(void);
 
 void caml_poll_gc_work(void);
 void caml_handle_gc_interrupt(void);
+void caml_process_external_interrupt(void);
 void caml_handle_incoming_interrupts(void);
 
 CAMLextern void caml_interrupt_self(void);
diff --git a/runtime/domain.c b/runtime/domain.c
@@ -1644,20 +1644,22 @@ void caml_reset_young_limit(caml_domain_state * dom_st)
      achieves the proper synchronisation. */
   atomic_exchange(&dom_st->young_limit, (uintnat)trigger);
 
+  /* For non-delayable asynchronous actions, we immediately interrupt
+     the domain again. */
   dom_internal * d = &all_domains[dom_st->id];
   if (atomic_load_relaxed(&d->interruptor.interrupt_pending)
       || dom_st->requested_minor_gc
       || dom_st->requested_major_slice
-      || dom_st->major_slice_epoch < atomic_load (&caml_major_slice_epoch)
-      || atomic_load_relaxed(&dom_st->requested_external_interrupt)) {
+      || dom_st->major_slice_epoch < atomic_load (&caml_major_slice_epoch)) {
     interrupt_domain_local(dom_st);
   }
-  /* We might be here due to a recently-recorded signal, so we
-     need to remember that we must run signal handlers. In
-     addition, in the case of long-running C code (that may
-     regularly poll with caml_process_pending_actions), we want to
-     force a query of all callbacks at every minor collection or
-     major slice (similarly to the OCaml behaviour). */
+  /* We might be here due to a recently-recorded signal or forced
+     systhread switching, so we need to remember that we must run
+     signal handlers or systhread's yield. In addition, in the case of
+     long-running C code (that may regularly poll with
+     caml_process_pending_actions), we want to force a query of all
+     callbacks at every minor collection or major slice (similarly to
+     the OCaml behaviour). */
   caml_set_action_pending(dom_st);
 }
 
@@ -1749,9 +1751,6 @@ void caml_poll_gc_work(void)
        caml_poll_gc_work is called. */
   }
 
-  if (atomic_load_acquire(&d->requested_external_interrupt)) {
-    caml_domain_external_interrupt_hook();
-  }
   caml_reset_young_limit(d);
 }
 
@@ -1769,6 +1768,14 @@ void caml_handle_gc_interrupt(void)
   caml_poll_gc_work();
 }
 
+/* Preemptive systhread switching */
+void caml_process_external_interrupt(void)
+{
+  if (atomic_load_acquire(&Caml_state->requested_external_interrupt)) {
+    caml_domain_external_interrupt_hook();
+  }
+}
+
 CAMLexport int caml_bt_is_in_blocking_section(void)
 {
   uintnat status = atomic_load_acquire(&domain_self->backup_thread_msg);
diff --git a/runtime/signals.c b/runtime/signals.c
@@ -277,12 +277,13 @@ void caml_request_minor_gc (void)
    There are two kinds of asynchronous actions:
 
    - Those that we execute immediately in all circumstances (STW
-     interrupts, requested minor or major GC, forced systhread yield);
-     they must never call OCaml code.
+     interrupts, requested minor or major GC); they must never call
+     OCaml code.
 
    - Those that run OCaml code and may raise OCaml exceptions
-     (asynchronous callbacks, finalisers, memprof callbacks); those
-     can be delayed, and do not run during allocations from C.
+     (asynchronous callbacks, finalisers, memprof callbacks, forced
+     systhread yield); those can be delayed, and do not run during
+     allocations from C.
 
    Queued asynchronous actions are notified to the domain by setting
    [young_limit] to a high value, thereby making the next allocation
@@ -341,7 +342,8 @@ value caml_do_pending_actions_exn(void)
   caml_handle_gc_interrupt();
   /* [young_limit] has now been reset. */
 
-  /* 2. Delayable actions that may raise OCaml exceptions.
+  /* 2. Delayable actions that may run OCaml code and raise OCaml
+     exceptions.
 
      We can now clear the action_pending flag since we are going to
      execute all actions. */
@@ -361,6 +363,12 @@ value caml_do_pending_actions_exn(void)
   exn = caml_final_do_calls_exn();
   if (Is_exception_result(exn)) goto exception;
 
+  /* Process external interrupts (e.g. preemptive systhread switching).
+     By doing this last, we do not need to set the action pending flag
+     in case a context switch happens: all actions have been processed
+     at this point. */
+  caml_process_external_interrupt();
+
   return Val_unit;
 
 exception:
