PR13063 (Add caml_plat_lock_non_blocking & compatiblity between sync.…

…h and platform.h)

.vscode/settings.json

@@ -8,6 +8,7 @@
                 "smmintrin.h": "c",
                 "tmmintrin.h": "c",
                 "pmmintrin.h": "c",
-                "*.tbl": "c"
+                "*.tbl": "c",
+                "platform.h": "c"
         }
 }

ocaml/runtime/afl.c

@@ -16,6 +16,7 @@
 
 #define CAML_INTERNALS
 
+#include <string.h>
 #include "caml/config.h"
 #include "caml/memory.h"
 #include "caml/mlvalues.h"

ocaml/runtime/callback.c

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

ocaml/runtime/caml/camlatomic.h

@@ -82,4 +82,19 @@ typedef struct { intnat repr; } atomic_intnat;
 #error "C11 atomics are unavailable on this platform. See camlatomic.h"
 #endif
 
+#ifdef CAML_INTERNALS
+
+/* Loads and stores with acquire, release and relaxed semantics */
+
+#define atomic_load_acquire(p)                    \
+  atomic_load_explicit((p), memory_order_acquire)
+#define atomic_load_relaxed(p)                    \
+  atomic_load_explicit((p), memory_order_relaxed)
+#define atomic_store_release(p, v)                      \
+  atomic_store_explicit((p), (v), memory_order_release)
+#define atomic_store_relaxed(p, v)                      \
+  atomic_store_explicit((p), (v), memory_order_relaxed)
+
+#endif /* CAML_INTERNALS */
+
 #endif /* CAML_ATOMIC_H */

ocaml/runtime/caml/domain.h

@@ -27,7 +27,6 @@ extern "C" {
 #include "config.h"
 #include "mlvalues.h"
 #include "domain_state.h"
-#include "platform.h"
 
 /* The runtime currently has a hard limit on the number of domains.
    This hard limit may go away in the future. */

ocaml/runtime/caml/platform.h

@@ -25,7 +25,6 @@
 #include <string.h>
 #include "config.h"
 #include "mlvalues.h"
-#include "sync.h"
 #include "sys.h"
 
 #if defined(MAP_ANON) && !defined(MAP_ANONYMOUS)
@@ -54,17 +53,6 @@ Caml_inline void cpu_relax(void) {
 #endif
 }
 
-/* Loads and stores with acquire, release and relaxed semantics */
-
-#define atomic_load_acquire(p)                    \
-  atomic_load_explicit((p), memory_order_acquire)
-#define atomic_load_relaxed(p)                    \
-  atomic_load_explicit((p), memory_order_relaxed)
-#define atomic_store_release(p, v)                      \
-  atomic_store_explicit((p), (v), memory_order_release)
-#define atomic_store_relaxed(p, v)                      \
-  atomic_store_explicit((p), (v), memory_order_relaxed)
-
 /* Spin-wait loops */
 
 #define Max_spins 1000
@@ -101,22 +89,64 @@ Caml_inline uintnat atomic_fetch_add_verify_ge0(atomic_uintnat* p, uintnat v) {
   return result;
 }
 
+/* If we're using glibc, use a custom condition variable implementation to
+   avoid this bug: https://sourceware.org/bugzilla/show_bug.cgi?id=25847
+
+   For now we only have this on linux because it directly uses the linux futex
+   syscalls. */
+#if defined(__linux__) && defined(__GNU_LIBRARY__) && defined(__GLIBC__) && defined(__GLIBC_MINOR__)
+typedef struct {
+  volatile unsigned counter;
+} custom_condvar;
+#define CUSTOM_COND_INITIALIZER {0}
+#else
+typedef pthread_cond_t custom_condvar;
+#define CUSTOM_COND_INITIALIZER PTHREAD_COND_INITIALIZER
+#endif
+
+/* Warning: blocking functions.
+
+   Blocking functions are for use in the runtime outside of the
+   mutator, or when the domain lock is not held.
+
+   In order to use them inside the mutator and while holding the
+   domain lock, one must make sure that the wait is very short, and
+   that no deadlock can arise from the interaction with the domain
+   locks and the stop-the-world sections.
+
+   In particular one must not call [caml_plat_lock_blocking] on a
+   mutex while the domain lock is held:
+    - if any critical section of the mutex crosses an allocation, a
+      blocking section releasing the domain lock, or any other
+      potential STW section, nor
+    - if the same lock is acquired at any point using [Mutex.lock] or
+      [caml_plat_lock_non_blocking] on the same domain (circular
+      deadlock with the domain lock).
+
+   Hence, as a general rule, prefer [caml_plat_lock_non_blocking] to
+   lock a mutex when inside the mutator and holding the domain lock.
+   The domain lock must be held in order to call
+   [caml_plat_lock_non_blocking].
+
+   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.
+*/
 
 typedef pthread_mutex_t caml_plat_mutex;
 #define CAML_PLAT_MUTEX_INITIALIZER PTHREAD_MUTEX_INITIALIZER
 CAMLextern void caml_plat_mutex_init(caml_plat_mutex*);
-Caml_inline void caml_plat_lock(caml_plat_mutex*);
+Caml_inline void caml_plat_lock_blocking(caml_plat_mutex*);
+Caml_inline void caml_plat_lock_non_blocking(caml_plat_mutex*);
 Caml_inline int caml_plat_try_lock(caml_plat_mutex*);
 void caml_plat_assert_locked(caml_plat_mutex*);
 void caml_plat_assert_all_locks_unlocked(void);
 Caml_inline void caml_plat_unlock(caml_plat_mutex*);
 void caml_plat_mutex_free(caml_plat_mutex*);
-typedef struct { custom_condvar cond; caml_plat_mutex* mutex; } caml_plat_cond;
-#define CAML_PLAT_COND_INITIALIZER(m) { CUSTOM_COND_INITIALIZER, m }
-void caml_plat_cond_init(caml_plat_cond*, caml_plat_mutex*);
-void caml_plat_wait(caml_plat_cond*);
-/* like caml_plat_wait, but if nanoseconds surpasses the second parameter
-   without a signal, then this function returns 1. */
+typedef custom_condvar caml_plat_cond;
+#define CAML_PLAT_COND_INITIALIZER PTHREAD_COND_INITIALIZER
+void caml_plat_cond_init(caml_plat_cond*);
+void caml_plat_wait(caml_plat_cond*, caml_plat_mutex*); /* blocking */
 void caml_plat_broadcast(caml_plat_cond*);
 void caml_plat_signal(caml_plat_cond*);
 void caml_plat_cond_free(caml_plat_cond*);
@@ -142,15 +172,15 @@ Caml_inline void check_err(const char* action, int err)
 }
 
 #ifdef DEBUG
-static CAMLthread_local int lockdepth;
-#define DEBUG_LOCK(m) (lockdepth++)
-#define DEBUG_UNLOCK(m) (lockdepth--)
+CAMLextern CAMLthread_local int caml_lockdepth;
+#define DEBUG_LOCK(m) (caml_lockdepth++)
+#define DEBUG_UNLOCK(m) (caml_lockdepth--)
 #else
 #define DEBUG_LOCK(m)
 #define DEBUG_UNLOCK(m)
 #endif
 
-Caml_inline void caml_plat_lock(caml_plat_mutex* m)
+Caml_inline void caml_plat_lock_blocking(caml_plat_mutex* m)
 {
   check_err("lock", pthread_mutex_lock(m));
   DEBUG_LOCK(m);
@@ -168,6 +198,15 @@ Caml_inline int caml_plat_try_lock(caml_plat_mutex* m)
   }
 }
 
+CAMLextern void caml_plat_lock_non_blocking_actual(caml_plat_mutex* m);
+
+Caml_inline void caml_plat_lock_non_blocking(caml_plat_mutex* m)
+{
+  if (!caml_plat_try_lock(m)) {
+    caml_plat_lock_non_blocking_actual(m);
+  }
+}
+
 Caml_inline void caml_plat_unlock(caml_plat_mutex* m)
 {
   DEBUG_UNLOCK(m);

ocaml/runtime/caml/sync.h

@@ -21,29 +21,22 @@
 #ifdef CAML_INTERNALS
 
 #include "mlvalues.h"
+#include "platform.h"
 
-typedef pthread_mutex_t * sync_mutex;
+/* OCaml mutexes and condition variables can also be manipulated from
+   C code with non-raising primitives from caml/platform.h. In this
+   case, pairs of lock/unlock for a critical section must come from
+   the same header (sync.h or platform.h). */
+
+typedef caml_plat_mutex * sync_mutex;
+typedef caml_plat_cond * sync_condvar;
 
 #define Mutex_val(v) (* ((sync_mutex *) Data_custom_val(v)))
+#define Condition_val(v) (* (sync_condvar *) Data_custom_val(v))
 
 CAMLextern int caml_mutex_lock(sync_mutex mut);
 CAMLextern int caml_mutex_unlock(sync_mutex mut);
 
-/* If we're using glibc, use a custom condition variable implementation to
-   avoid this bug: https://sourceware.org/bugzilla/show_bug.cgi?id=25847
-
-   For now we only have this on linux because it directly uses the linux futex
-   syscalls. */
-#if defined(__linux__) && defined(__GNU_LIBRARY__) && defined(__GLIBC__) && defined(__GLIBC_MINOR__)
-typedef struct {
-  volatile unsigned counter;
-} custom_condvar;
-#define CUSTOM_COND_INITIALIZER {0}
-#else
-typedef pthread_cond_t custom_condvar;
-#define CUSTOM_COND_INITIALIZER PTHREAD_COND_INITIALIZER
-#endif
-
 value caml_ml_mutex_lock(value wrapper);
 value caml_ml_mutex_unlock(value wrapper);
 value caml_ml_condition_broadcast(value wrapper);

ocaml/runtime/codefrag.c

@@ -131,7 +131,7 @@ unsigned char *caml_digest_of_code_fragment(struct code_fragment *cf) {
      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. */
-  caml_plat_lock(&cf->mutex);
+  caml_plat_lock_blocking(&cf->mutex);
   {
     if (cf->digest_status == DIGEST_IGNORE) {
       digest = NULL;