Optimal polling in C code based on masking

gadmm · gadmm · commit 93dd8f28db02 · 2022-06-09T15:32:40.000+02:00
- Do not slow down allocations when an asynchronous callback cannot be
  handled immediately.

- Do not wait that other threads have processed signals not for us in
  [caml_enter_blocking_section].

Before this commit, if a pending action cannot be processed
immediately then all the allocations go through the slow path until it
is processed. It is also possible that we are looping at the start of
blocking sections because a signal is pending but not for us.

This commit introduces a simpler design whereby [action_pending] alone
is used to remember that an asynchronous callback should be run, and
[young_limit] is only used to interrupt running code. The key is to
modify going from C to OCaml code so that [young_limit] is set
appropriately according to [action_pending]. This avoids situations
where we have to repeatedly increase [young_limit] immediately despite
the corresponding action not being processed.

The intuition is that OCaml behaves as if asynchronous actions are
"masked" inside C code (where an "unmasking" action is responsible for
setting [young_limit] according to [action_pending] when the mask
ends).
diff --git a/otherlibs/systhreads/st_stubs.c b/otherlibs/systhreads/st_stubs.c
@@ -674,7 +674,7 @@ CAMLprim value caml_thread_yield(value unit)
   st_thread_yield(&Thread_main_lock);
   Current_thread = st_tls_get(caml_thread_key);
   caml_thread_restore_runtime_state();
-  if (Caml_state->action_pending || caml_check_pending_signals())
+  if (caml_check_pending_signals())
     caml_set_action_pending(Caml_state);
 
   return Val_unit;
diff --git a/runtime/amd64.S b/runtime/amd64.S
@@ -535,6 +535,15 @@ ENDFUNCTION(G(caml_allocN))
 /* Call a C function from OCaml */
 /******************************************************************************/
 
+/* Update [young_limit] when returning from C calls */
+#define RET_FROM_C_CALL                         \
+        cmpq    $0, Caml_state(action_pending); \
+        jne     1f;                             \
+        ret;                                    \
+1:                                              \
+        movq    $-1, Caml_state(young_limit);   \
+        ret
+
 FUNCTION(G(caml_c_call))
 CFI_STARTPROC
         CFI_SIGNAL_FRAME
@@ -553,7 +562,7 @@ LBL(caml_c_call):
     /* Load ocaml stack and restore global variables */
         SWITCH_C_TO_OCAML
     /* Return to OCaml caller */
-        ret
+        RET_FROM_C_CALL
 CFI_ENDPROC
 ENDFUNCTION(G(caml_c_call))
 
@@ -593,7 +602,7 @@ LBL(106):
     /* Load ocaml stack and restore global variables */
         SWITCH_C_TO_OCAML
     /* Return to OCaml caller */
-        ret
+        RET_FROM_C_CALL
 CFI_ENDPROC
 ENDFUNCTION(G(caml_c_call_stack_args))
 
diff --git a/runtime/arm64.S b/runtime/arm64.S
@@ -417,6 +417,17 @@ FUNCTION(caml_allocN)
 /* Call a C function from OCaml */
 /* Function to call is in ADDITIONAL_ARG */
 
+/* Update [young_limit] when returning from C calls. */
+.macro RET_FROM_C_CALL
+        ldr     TMP, Caml_state(action_pending)
+        cbnz    TMP, 1f
+        ret
+1:
+        mov     TMP, #-1
+        str     TMP, Caml_state(young_limit)
+        ret
+.endm
+
 FUNCTION(caml_c_call)
         CFI_STARTPROC
         CFI_OFFSET(29, -16)
@@ -437,9 +448,9 @@ FUNCTION(caml_c_call)
         SWITCH_C_TO_OCAML
     /* Return */
         ldp     x29, x30, [sp], 16
-        ret
+        RET_FROM_C_CALL
         CFI_ENDPROC
-        END_FUNCTION(caml_c_call)
+END_FUNCTION(caml_c_call)
 
 FUNCTION(caml_c_call_stack_args)
         CFI_STARTPROC
@@ -478,8 +489,9 @@ FUNCTION(caml_c_call_stack_args)
         SWITCH_C_TO_OCAML
     /* Return */
         ldp     x29, x30, [sp], 16
-        ret
-CFI_ENDPROC
+        RET_FROM_C_CALL
+        CFI_ENDPROC
+END_FUNCTION(caml_c_call_stack_args)
 
 /* Start the OCaml program */
 
diff --git a/runtime/callback.c b/runtime/callback.c
@@ -102,6 +102,7 @@ CAMLexport value caml_callbackN_exn(value closure, int narg, value args[])
 
   cont = save_and_clear_stack_parent(domain_state);
 
+  caml_update_young_limit_after_c_call(domain_state);
   res = caml_interprete(callback_code, sizeof(callback_code));
   if (Is_exception_result(res))
     domain_state->current_stack->sp += narg + 4; /* PR#3419 */
@@ -159,6 +160,7 @@ CAMLexport value caml_callback_exn(value closure, value arg)
     value res;
 
     cont = save_and_clear_stack_parent(domain_state);
+    caml_update_young_limit_after_c_call(domain_state);
     res = caml_callback_asm(domain_state, closure, &arg);
     restore_stack_parent(domain_state, cont);
 
@@ -180,6 +182,7 @@ CAMLexport value caml_callback2_exn(value closure, value arg1, value arg2)
     value res;
 
     cont = save_and_clear_stack_parent(domain_state);
+    caml_update_young_limit_after_c_call(domain_state);
     res = caml_callback2_asm(domain_state, closure, args);
     restore_stack_parent(domain_state, cont);
 
@@ -202,6 +205,7 @@ CAMLexport value caml_callback3_exn(value closure,
     value res;
 
     cont = save_and_clear_stack_parent(domain_state);
+    caml_update_young_limit_after_c_call(domain_state);
     res = caml_callback3_asm(domain_state, closure, args);
     restore_stack_parent(domain_state, cont);
 
diff --git a/runtime/caml/domain.h b/runtime/caml/domain.h
@@ -68,6 +68,7 @@ void caml_handle_incoming_interrupts(void);
 CAMLextern void caml_interrupt_self(void);
 void caml_interrupt_all_for_signal(void);
 void caml_reset_young_limit(caml_domain_state *);
+void caml_update_young_limit_after_c_call(caml_domain_state *);
 
 CAMLextern void caml_reset_domain_lock(void);
 CAMLextern int caml_bt_is_in_blocking_section(void);
diff --git a/runtime/domain.c b/runtime/domain.c
@@ -291,7 +291,12 @@ Caml_inline void interrupt_domain(struct interruptor* s)
 {
   atomic_uintnat * interrupt_word =
     atomic_load_explicit(&s->interrupt_word, memory_order_relaxed);
-  atomic_store_rel(interrupt_word, (uintnat)(-1));
+  atomic_store_rel(interrupt_word, UINTNAT_MAX);
+}
+
+Caml_inline void interrupt_domain_local(caml_domain_state* dom_st)
+{
+  atomic_store_relaxed(&dom_st->young_limit, UINTNAT_MAX);
 }
 
 int caml_incoming_interrupts_queued(void)
@@ -1462,20 +1467,37 @@ void caml_interrupt_all_for_signal(void)
   }
 }
 
+/* To avoid any risk of forgetting an action, [caml_reset_young_limit]
+   is the only way (together with [interrupt_domain*]) through which
+   [young_limit] can be modified. We take care here of all possible
+   races. */
 void caml_reset_young_limit(caml_domain_state * dom_st)
 {
-  /* An interrupt might have been queued in the meanwhile; this
-     achieves the proper synchronisation. */
+  /* An interrupt might have been queued in the meanwhile; the
+     atomic_exchange achieves the proper synchronisation with the
+     reads that follow (unlike an atomic_store). */
   atomic_exchange(&dom_st->young_limit, (uintnat)dom_st->young_start);
-  dom_internal * d = &all_domains[dom_st->id];
-  if (atomic_load_relaxed(&d->interruptor.interrupt_pending)
+  /* We might be here due to a recently-recorded signal (or a signal
+     might just have arrived), so we need to remember that we must run
+     signal handlers. In addition, in the case of long-running C code
+     that regularly polls with caml_process_pending_actions, we want
+     to force a query of all callbacks at every minor collection or
+     major slice (similarly to OCaml behaviour). */
+  caml_set_action_pending(dom_st);
+  /* In case of actions that we never delay, interrupt the domain
+     again immediately. */
+  atomic_uintnat * interrupt_pending =
+    &all_domains[dom_st->id].interruptor.interrupt_pending;
+  if (atomic_load_relaxed(interrupt_pending)
       || dom_st->requested_minor_gc
       || dom_st->requested_major_slice
-      || atomic_load_relaxed(&dom_st->requested_external_interrupt)
-      || dom_st->action_pending) {
-    atomic_store_rel(&dom_st->young_limit, (uintnat)-1);
-    CAMLassert(caml_check_gc_interrupt(dom_st));
-  }
+      || atomic_load_relaxed(&dom_st->requested_external_interrupt))
+    interrupt_domain_local(dom_st);
+}
+
+void caml_update_young_limit_after_c_call(caml_domain_state * dom_st)
+{
+  if (dom_st->action_pending) interrupt_domain_local(dom_st);
 }
 
 void caml_poll_gc_work(void)
diff --git a/runtime/interp.c b/runtime/interp.c
@@ -91,7 +91,9 @@ sp is a local copy of the global variable Caml_state->extern_sp. */
   { sp -= 2; sp[0] = env; sp[1] = (value)(pc + 1); \
     domain_state->current_stack->sp = sp; }
 #define Restore_after_c_call \
-  { sp = domain_state->current_stack->sp; env = *sp; sp += 2; }
+  { sp = domain_state->current_stack->sp; env = *sp; sp += 2; \
+    caml_update_young_limit_after_c_call(domain_state);       \
+  }
 
 /* For VM threads purposes, an event frame must look like accu + a
    C_CALL frame + a RETURN 1 frame.
diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c
@@ -802,16 +802,8 @@ void caml_alloc_small_dispatch (caml_domain_state * dom_st,
       /* In the case of allocations performed from OCaml, execute
          asynchronous callbacks. */
       caml_raise_if_exception(caml_do_pending_actions_exn());
-    else {
+    else
       caml_handle_gc_interrupt();
-      /* 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 regularly
-         polls with caml_process_pending_actions, we want to force a
-         query of all callbacks at every minor collection or major
-         slice (similarly to OCaml behaviour). */
-      dom_st->action_pending = 1;
-    }
 
     /* Now, there might be enough room in the minor heap to do our
        allocation. */
diff --git a/runtime/signals.c b/runtime/signals.c
@@ -163,16 +163,17 @@ CAMLexport void (*caml_leave_blocking_section_hook)(void) =
 
 CAMLexport void caml_enter_blocking_section(void)
 {
-  while (1){
+  caml_domain_state * domain = Caml_state;
+  while (1) {
     /* Process all pending signals now */
-    caml_raise_if_exception(caml_process_pending_signals_exn());
+    if (Caml_check_gc_interrupt(domain)) {
+      caml_handle_gc_interrupt();
+      caml_raise_if_exception(caml_process_pending_signals_exn());
+    }
     caml_enter_blocking_section_hook ();
-    /* Check again for pending signals.
-       If none, done; otherwise, try again */
-    // FIXME: does this become very slow if a signal is recorded but
-    // is masked for everybody in capacity of running signals at this
-    // point?
-    if (!caml_check_pending_signals()) break;
+    /* Check again if a signal arrived in the meanwhile. If none,
+       done; otherwise, try again. */
+    if (!Caml_check_gc_interrupt(domain)) break;
     caml_leave_blocking_section_hook ();
   }
 }
@@ -202,7 +203,7 @@ CAMLexport void caml_leave_blocking_section(void)
 
      So we force the examination of signals as soon as possible.
   */
-  if (Caml_state->action_pending || caml_check_pending_signals())
+  if (caml_check_pending_signals())
     caml_set_action_pending(Caml_state);
 
   errno = saved_errno;
@@ -270,22 +271,30 @@ void caml_request_minor_gc (void)
 
    There are two kinds of asynchronous actions:
 
-   - Those that cannot be delayed but never call OCaml code (STW
+   - Those that we do not delay but which never call OCaml code (STW
      interrupts, requested minor or major GC, forced systhread yield).
 
-   - Those that may raise OCaml exceptions but can be delayed
-     (asynchronous callbacks, finalisers, memprof callbacks).
+   - Those that may run OCaml code and raise OCaml exceptions, but can
+     be delayed (asynchronous callbacks, finalisers, memprof
+     callbacks).
 
-   [Caml_state->action_pending] records whether an action of the
-   second kind is currently pending, and is reset _at the beginning_
-   of processing all actions.
+   Asynchronous actions are notified to the domain by playing with the
+   allocation limit. Non-delayable actions are performed immediately,
+   then [Caml_state->action_pending] is set in order to record that an
+   action of the second kind might be pending. Then those actions are
+   processed immediately if possible (e.g. allocation from OCaml), or
+   remain delayed (e.g. allocation from C) until the program calls
+   [caml_process_pending_actions].
 
-   Hence, when a delayable action is pending, either
-   [Caml_state->action_pending] is 1, or there is a function currently
-   running which is executing all actions.
+   [Caml_state->action_pending] then reset _at the beginning_ of
+   processing all actions. Hence, when a delayable action is pending,
+   either [Caml_state->action_pending] is 1, or there is a function
+   running which is in process of executing all actions.
 
-   This is used to ensure that [Caml_state->young_limit] is always set
-   appropriately.
+   When going from C to OCaml code, we set again
+   [Caml_state->young_limit] to a high value if
+   [Caml_state->action_pending] is set, in order to process actions as
+   soon as possible.
 
    In case there are two different callbacks (say, a signal and a
    finaliser) arriving at the same time, then the processing of one
@@ -301,7 +310,6 @@ void caml_request_minor_gc (void)
 void caml_set_action_pending(caml_domain_state * dom_st)
 {
   dom_st->action_pending = 1;
-  atomic_store_rel(&dom_st->young_limit, (uintnat)-1);
 }
 
 CAMLexport int caml_check_pending_actions(void)
@@ -311,15 +319,17 @@ CAMLexport int caml_check_pending_actions(void)
 
 value caml_do_pending_actions_exn(void)
 {
-  Caml_state->action_pending = 0;
-
-  /* 1. Non-delayable actions that do not run OCaml code. */
+  /* 1. Non-delayable actions that do not run OCaml code.
 
-  /* Do any pending STW interrupt, minor collection or major slice */
+     Do any pending STW interrupt, minor collection or major slice. */
   caml_handle_gc_interrupt();
   /* [young_limit] has now been reset. */
 
-  /* 2. Delayable actions that may raise OCaml exceptions. */
+  /* 2. Delayable actions that may raise OCaml exceptions.
+
+     We can now clear the action_pending flag since we are going to
+     execute all actions. */
+  Caml_state->action_pending = 0;
 
   /* Call signal handlers first */
   value exn = caml_process_pending_signals_exn();
