Merge pull request ocaml#13227 from gadmm/caml_plat_lock_non_blocking2

Audit and fix caml_plat_lock_blocking usage

Author: gasche

Diff for: Changes

@@ -64,6 +64,10 @@ Working version
 - #13701: optimize `caml_continuation_use` based on #12735
   (Hugo Heuzard, review by KC Sivaramakrishnan)
 
+- #13227: Review of locking in the multicore runtime. Fix deadlocks in
+  runtime events and potential deadlocks with named values.
+  (Guillaume Munch-Maccagnoni, review by Gabriel Scherer)
+
 ### Code generation and optimizations:
 
 * #13050: Use '$' instead of '.' to separate module names in symbol names.

Diff for: runtime/callback.c

@@ -390,7 +390,7 @@ CAMLprim value caml_register_named_value(value vname, value val)
   unsigned int h = hash_value_name(name);
   int found = 0;
 
-  caml_plat_lock_blocking(&named_value_lock);
+  caml_plat_lock_non_blocking(&named_value_lock);
   for (struct named_value *nv = named_value_table[h];
        nv != NULL;
        nv = nv->next) {
@@ -416,7 +416,7 @@ CAMLprim value caml_register_named_value(value vname, value val)
 
 CAMLexport const value* caml_named_value(char const *name)
 {
-  caml_plat_lock_blocking(&named_value_lock);
+  caml_plat_lock_non_blocking(&named_value_lock);
   for (struct named_value *nv = named_value_table[hash_value_name(name)];
        nv != NULL;
        nv = nv->next) {
@@ -431,7 +431,7 @@ CAMLexport const value* caml_named_value(char const *name)
 
 CAMLexport void caml_iterate_named_values(caml_named_action f)
 {
-  caml_plat_lock_blocking(&named_value_lock);
+  caml_plat_lock_non_blocking(&named_value_lock);
   for (int i = 0; i < Named_value_size; i++){
     for (struct named_value *nv = named_value_table[i];
          nv != NULL;

Diff for: runtime/caml/frame_descriptors.h

@@ -119,7 +119,8 @@ void* caml_copy_and_register_frametable(void *table, int size);
 
 /* The unregistered frametables can still be in use after calling
    this function. Thus, you should not free their memory.
-   Note: it may reorder the content of the array 'tables' */
+   Note: it may reorder the content of the array 'tables'.
+   This can be called from a custom block finalizer. */
 void caml_unregister_frametables(void **tables, int ntables);
 void caml_unregister_frametable(void *table);
 

Diff for: runtime/caml/io.h

@@ -63,8 +63,12 @@ struct channel {
 
 enum {
   CHANNEL_FLAG_FROM_SOCKET = 1,  /* For Windows */
-  CHANNEL_FLAG_MANAGED_BY_GC = 4,  /* Free and close using GC finalization */
-  CHANNEL_TEXT_MODE = 8,           /* "Text mode" for Windows and Cygwin */
+  CHANNEL_FLAG_MANAGED_BY_GC = 4,  /* Free and close using GC finalization. */
+  /* Note: For backwards-compatibility, channels without the flag
+     CHANNEL_FLAG_MANAGED_BY_GC can be used inside single-threaded
+     programs without locking. As a consequence, using such a channel
+     from an asynchronous callback can result in deadlocks. */
+  CHANNEL_TEXT_MODE = 8, /* "Text mode" for Windows and Cygwin */
   CHANNEL_FLAG_UNBUFFERED = 16     /* Unbuffered (for output channels only) */
 };
 

Diff for: runtime/caml/platform.h

@@ -90,6 +90,10 @@ Caml_inline void cpu_relax(void) {
    The domain lock must be held in order to call
    [caml_plat_lock_non_blocking].
 
+   It is possible to combine calls to [caml_plat_lock_non_blocking] on
+   a mutex from the mutator with calls to [caml_plat_lock_blocking] on
+   the same mutex from a STW section.
+
    These functions never raise exceptions; errors are fatal. Thus, for
    usages where bugs are susceptible to be introduced by users, the
    functions from caml/sync.h should be used instead.

Diff for: runtime/codefrag.c

@@ -130,7 +130,14 @@ unsigned char *caml_digest_of_code_fragment(struct code_fragment *cf) {
   /* Note: this approach is a bit heavy-handed as we take a lock in
      all cases. It would be possible to take a lock only in the
      DIGEST_LATER case, which occurs at most once per fragment, by
-     using double-checked locking -- see #11791. */
+     using double-checked locking -- see #11791.
+
+     Note: we use [caml_plat_lock_blocking] despite holding the domain
+     lock because this is called by intern.c and extern.c, both of
+     which share state between threads of the same domain. The
+     critical section must therefore remain short and not allocate
+     (nor cause other potential STW).
+  */
   caml_plat_lock_blocking(&cf->mutex);
   {
     if (cf->digest_status == DIGEST_IGNORE) {

Diff for: runtime/frame_descriptors.c

@@ -326,6 +326,7 @@ static void remove_frame_descriptors(
   void *frametable;
   caml_frametable_list ** previous;
 
+  /* cannot release the domain lock here (e.g. custom block finaliser) */
   caml_plat_lock_blocking(&table->mutex);
 
   previous = &table->frametables;

Diff for: runtime/gc_stats.c

@@ -83,7 +83,9 @@ void caml_reset_domain_alloc_stats(caml_domain_state *local)
 static caml_plat_mutex orphan_lock = CAML_PLAT_MUTEX_INITIALIZER;
 static struct alloc_stats orphaned_alloc_stats = {0,};
 
-void caml_accum_orphan_alloc_stats(struct alloc_stats *acc) {
+void caml_accum_orphan_alloc_stats(struct alloc_stats *acc)
+{
+  /* This is called from the collector as well as from the mutator. */
   caml_plat_lock_blocking(&orphan_lock);
   caml_accum_alloc_stats(acc, &orphaned_alloc_stats);
   caml_plat_unlock(&orphan_lock);
@@ -97,6 +99,7 @@ void caml_orphan_alloc_stats(caml_domain_state *domain) {
   caml_reset_domain_alloc_stats(domain);
 
   /* push them into the orphan stats */
+  /* This is called from the collector as well as from the mutator. */
   caml_plat_lock_blocking(&orphan_lock);
   caml_accum_alloc_stats(&orphaned_alloc_stats, &alloc_stats);
   caml_plat_unlock(&orphan_lock);

Diff for: runtime/globroots.c

@@ -25,6 +25,10 @@
 #include "caml/skiplist.h"
 #include "caml/stack.h"
 
+/* This mutex must be locked with [caml_plat_lock_blocking] from the
+   mutator, because caml_{register,remove}_{generational_}roots can be
+   called in places where the domain lock is not safe to be
+   released. */
 static caml_plat_mutex roots_mutex = CAML_PLAT_MUTEX_INITIALIZER;
 
 /* Greater than zero when the current thread is scanning the roots */

Diff for: runtime/io.c

@@ -559,7 +559,7 @@ void caml_finalize_channel(value vchan)
   }
   /* Don't run concurrently with caml_ml_out_channels_list that may resurrect
      a dead channel . */
-  caml_plat_lock_blocking(&caml_all_opened_channels_mutex);
+  caml_plat_lock_non_blocking(&caml_all_opened_channels_mutex);
   chan->refcount --;
   if (chan->refcount > 0 || notflushed) {
     /* We need to keep the channel around, either because it is being
@@ -612,7 +612,7 @@ CAMLprim value caml_ml_open_descriptor_in_with_flags(int fd, int flags)
   struct channel * chan = caml_open_descriptor_in(fd);
   chan->flags |= flags | CHANNEL_FLAG_MANAGED_BY_GC;
   chan->refcount = 1;
-  caml_plat_lock_blocking(&caml_all_opened_channels_mutex);
+  caml_plat_lock_non_blocking(&caml_all_opened_channels_mutex);
   link_channel (chan);
   caml_plat_unlock (&caml_all_opened_channels_mutex);
   return caml_alloc_channel(chan);
@@ -627,7 +627,7 @@ CAMLprim value caml_ml_open_descriptor_out_with_flags(int fd, int flags)
   struct channel * chan = caml_open_descriptor_out(fd);
   chan->flags |= flags | CHANNEL_FLAG_MANAGED_BY_GC;
   chan->refcount = 1;
-  caml_plat_lock_blocking(&caml_all_opened_channels_mutex);
+  caml_plat_lock_non_blocking(&caml_all_opened_channels_mutex);
   link_channel (chan);
   caml_plat_unlock (&caml_all_opened_channels_mutex);
   return caml_alloc_channel(chan);
@@ -663,7 +663,7 @@ CAMLprim value caml_ml_out_channels_list (value unit)
   struct channel_list *channel_list = NULL, *cl_tmp;
   mlsize_t num_channels = 0;
 
-  caml_plat_lock_blocking(&caml_all_opened_channels_mutex);
+  caml_plat_lock_non_blocking(&caml_all_opened_channels_mutex);
   for (struct channel *channel = caml_all_opened_channels;
        channel != NULL;
        channel = channel->next) {

Diff for: runtime/runtime_events.c

@@ -376,6 +376,7 @@ static void runtime_events_create_from_stw_single(void) {
 
     // at the same instant: snapshot user_events list and set
     // runtime_events_enabled to 1
+    /* calling from STW */
     caml_plat_lock_blocking(&user_events_lock);
     value current_user_event = user_events;
     atomic_store_release(&runtime_events_enabled, 1);
@@ -716,7 +717,7 @@ CAMLprim value caml_runtime_events_user_register(value event_name,
   Field(event, 3) = event_tag;
 
 
-  caml_plat_lock_blocking(&user_events_lock);
+  caml_plat_lock_non_blocking(&user_events_lock);
   // critical section: when we update the user_events list we need to make sure
   // it is not updated while we construct the pointer to the next element
 
@@ -832,7 +833,7 @@ CAMLexport value caml_runtime_events_user_resolve(
   CAMLlocal3(event, cur_event_name, ml_event_name);
 
   // TODO: it might be possible to atomic load instead
-  caml_plat_lock_blocking(&user_events_lock);
+  caml_plat_lock_non_blocking(&user_events_lock);
   value current_user_event = user_events;
   caml_plat_unlock(&user_events_lock);
 

Diff for: runtime/signals.c

@@ -687,6 +687,8 @@ CAMLprim value caml_install_signal_handler(value signal_number, value action)
     act = 2;
     break;
   }
+  caml_plat_lock_non_blocking(&signal_install_mutex);
+  /* Note: no safepoint for calling signals in this critical section */
   oldact = caml_set_signal_action(sig, act);
   switch (oldact) {
   case 0:                       /* was Signal_default */
@@ -700,24 +702,19 @@ CAMLprim value caml_install_signal_handler(value signal_number, value action)
     Field(res, 0) = Field(caml_signal_handlers, sig);
     break;
   default:                      /* error in caml_set_signal_action */
-    caml_sys_error(NO_ARG);
+    goto err;
   }
   if (Is_block(action)) {
-    /* Speculatively allocate this so we don't hold the lock for
-       a GC */
     if (caml_signal_handlers == 0) {
-      tmp_signal_handlers = caml_alloc(NSIG, 0);
-    }
-    caml_plat_lock_blocking(&signal_install_mutex);
-    if (caml_signal_handlers == 0) {
-      /* caml_alloc cannot raise asynchronous exceptions from signals
-         so this is safe */
-      caml_signal_handlers = tmp_signal_handlers;
+      caml_signal_handlers = caml_alloc(NSIG, 0);
       caml_register_global_root(&caml_signal_handlers);
     }
     caml_modify(&Field(caml_signal_handlers, sig), Field(action, 0));
-    caml_plat_unlock(&signal_install_mutex);
   }
+  caml_plat_unlock(&signal_install_mutex);
   caml_get_value_or_raise(caml_process_pending_signals_res());
   CAMLreturn (res);
+ err:
+  caml_plat_unlock(&signal_install_mutex);
+  caml_sys_error(NO_ARG);
 }