From e60a0199ffa228cd84a68c83e3d9a1e660328dc7 Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Fri, 16 Aug 2024 12:19:25 +0100 Subject: [PATCH] PR13063 (Add caml_plat_lock_non_blocking & compatiblity between sync.h and platform.h) --- .vscode/settings.json | 3 +- ocaml/runtime/afl.c | 1 + ocaml/runtime/callback.c | 6 +-- ocaml/runtime/caml/camlatomic.h | 15 ++++++ ocaml/runtime/caml/domain.h | 1 - ocaml/runtime/caml/platform.h | 85 ++++++++++++++++++++++++--------- ocaml/runtime/caml/sync.h | 25 ++++------ ocaml/runtime/codefrag.c | 2 +- ocaml/runtime/domain.c | 51 ++++++++++---------- ocaml/runtime/gc_stats.c | 5 +- ocaml/runtime/globroots.c | 13 ++--- ocaml/runtime/io.c | 18 ++----- ocaml/runtime/major_gc.c | 12 ++--- ocaml/runtime/memory.c | 6 +-- ocaml/runtime/memprof.c | 5 +- ocaml/runtime/misc.c | 3 +- ocaml/runtime/platform.c | 35 +++++++++----- ocaml/runtime/runtime_events.c | 7 +-- ocaml/runtime/shared_heap.c | 16 +++---- ocaml/runtime/signals.c | 3 +- ocaml/runtime/sync_posix.h | 10 +--- 21 files changed, 184 insertions(+), 138 deletions(-) diff --git a/.vscode/settings.json b/.vscode/settings.json index 1714a18b848..7e5f6ca3fe4 100644 --- a/.vscode/settings.json +++ b/.vscode/settings.json @@ -8,6 +8,7 @@ "smmintrin.h": "c", "tmmintrin.h": "c", "pmmintrin.h": "c", - "*.tbl": "c" + "*.tbl": "c", + "platform.h": "c" } } diff --git a/ocaml/runtime/afl.c b/ocaml/runtime/afl.c index 9548de6e38e..d5673f28fce 100644 --- a/ocaml/runtime/afl.c +++ b/ocaml/runtime/afl.c @@ -16,6 +16,7 @@ #define CAML_INTERNALS +#include #include "caml/config.h" #include "caml/memory.h" #include "caml/mlvalues.h" diff --git a/ocaml/runtime/callback.c b/ocaml/runtime/callback.c index 7a29f44de23..8940137e573 100644 --- a/ocaml/runtime/callback.c +++ b/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) { diff --git a/ocaml/runtime/caml/camlatomic.h b/ocaml/runtime/caml/camlatomic.h index 7206f0579ac..f9fd36d936a 100644 --- a/ocaml/runtime/caml/camlatomic.h +++ b/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 */ diff --git a/ocaml/runtime/caml/domain.h b/ocaml/runtime/caml/domain.h index 4b9be80b41b..ac0358c8b13 100644 --- a/ocaml/runtime/caml/domain.h +++ b/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. */ diff --git a/ocaml/runtime/caml/platform.h b/ocaml/runtime/caml/platform.h index 3bb6cb4e2f6..9462baf3cbf 100644 --- a/ocaml/runtime/caml/platform.h +++ b/ocaml/runtime/caml/platform.h @@ -25,7 +25,6 @@ #include #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); diff --git a/ocaml/runtime/caml/sync.h b/ocaml/runtime/caml/sync.h index 8bc03351b51..75712eabf98 100644 --- a/ocaml/runtime/caml/sync.h +++ b/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); diff --git a/ocaml/runtime/codefrag.c b/ocaml/runtime/codefrag.c index 27e1459c04a..6014fb49faa 100644 --- a/ocaml/runtime/codefrag.c +++ b/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; diff --git a/ocaml/runtime/domain.c b/ocaml/runtime/domain.c index badee20e99e..6295f2c1d4c 100644 --- a/ocaml/runtime/domain.c +++ b/ocaml/runtime/domain.c @@ -219,8 +219,7 @@ static struct { }; static caml_plat_mutex all_domains_lock = CAML_PLAT_MUTEX_INITIALIZER; -static caml_plat_cond all_domains_cond = - CAML_PLAT_COND_INITIALIZER(&all_domains_lock); +static caml_plat_cond all_domains_cond = CAML_PLAT_COND_INITIALIZER; static atomic_uintnat /* dom_internal* */ stw_leader = 0; static dom_internal all_domains[Max_domains]; @@ -360,7 +359,7 @@ int caml_send_interrupt(struct interruptor* target) /* Signal the condition variable, in case the target is itself waiting for an interrupt to be processed elsewhere */ - caml_plat_lock(&target->lock); + caml_plat_lock_blocking(&target->lock); caml_plat_broadcast(&target->cond); // OPT before/after unlock? elide? caml_plat_unlock(&target->lock); @@ -572,13 +571,13 @@ static void domain_create(uintnat initial_minor_heap_wsize, /* take the all_domains_lock so that we can alter the STW participant set atomically */ - caml_plat_lock(&all_domains_lock); + caml_plat_lock_blocking(&all_domains_lock); /* Wait until any in-progress STW sections end. */ while (atomic_load_acquire(&stw_leader)) { /* [caml_plat_wait] releases [all_domains_lock] until the current STW section ends, and then takes the lock again. */ - caml_plat_wait(&all_domains_cond); + caml_plat_wait(&all_domains_cond, &all_domains_lock); } d = next_free_domain(); @@ -615,7 +614,7 @@ static void domain_create(uintnat initial_minor_heap_wsize, * shared with a domain which is terminating (see * domain_terminate). */ - caml_plat_lock(&d->domain_lock); + caml_plat_lock_blocking(&d->domain_lock); /* Set domain_self if we have successfully allocated the * caml_domain_state. Otherwise domain_self will be NULL and it's up @@ -798,7 +797,7 @@ CAMLexport void caml_reset_domain_lock(void) prior to calling fork and then init afterwards in both parent and child. */ caml_plat_mutex_init(&self->domain_lock); - caml_plat_cond_init(&self->domain_cond, &self->domain_lock); + caml_plat_cond_init(&self->domain_cond); return; } @@ -950,15 +949,14 @@ void caml_init_domains(uintnat minor_heap_wsz) { dom->interruptor.interrupt_word = NULL; caml_plat_mutex_init(&dom->interruptor.lock); - caml_plat_cond_init(&dom->interruptor.cond, - &dom->interruptor.lock); + caml_plat_cond_init(&dom->interruptor.cond); dom->interruptor.running = 0; dom->interruptor.terminating = 0; dom->interruptor.unique_id = 0; dom->interruptor.interrupt_pending = 0; caml_plat_mutex_init(&dom->domain_lock); - caml_plat_cond_init(&dom->domain_cond, &dom->domain_lock); + caml_plat_cond_init(&dom->domain_cond); dom->backup_thread_running = 0; dom->backup_thread_msg = BT_INIT; } @@ -1048,11 +1046,11 @@ static void* backup_thread_func(void* v) /* Wait safely if there is nothing to do. * Will be woken from caml_leave_blocking_section */ - caml_plat_lock(&s->lock); + caml_plat_lock_blocking(&s->lock); msg = atomic_load_acquire (&di->backup_thread_msg); if (msg == BT_IN_BLOCKING_SECTION && !caml_incoming_interrupts_queued()) - caml_plat_wait(&s->cond); + caml_plat_wait(&s->cond, &s->lock); caml_plat_unlock(&s->lock); break; case BT_ENTERING_OCAML: @@ -1060,10 +1058,10 @@ static void* backup_thread_func(void* v) * Will be woken from caml_bt_exit_ocaml * or domain_terminate */ - caml_plat_lock(&di->domain_lock); + caml_plat_lock_blocking(&di->domain_lock); msg = atomic_load_acquire (&di->backup_thread_msg); if (msg == BT_ENTERING_OCAML) - caml_plat_wait(&di->domain_cond); + caml_plat_wait(&di->domain_cond, &di->domain_lock); caml_plat_unlock(&di->domain_lock); break; default: @@ -1096,7 +1094,7 @@ static void install_backup_thread (dom_internal* di) /* Give a chance for backup thread on this domain to terminate */ caml_plat_unlock (&di->domain_lock); cpu_relax (); - caml_plat_lock (&di->domain_lock); + caml_plat_lock_blocking(&di->domain_lock); msg = atomic_load_acquire(&di->backup_thread_msg); } @@ -1210,7 +1208,7 @@ static void* domain_thread_func(void* v) p->newdom = domain_self; /* handshake with the parent domain */ - caml_plat_lock(&p->parent->interruptor.lock); + caml_plat_lock_blocking(&p->parent->interruptor.lock); if (domain_self) { p->status = Dom_started; p->unique_id = domain_self->interruptor.unique_id; @@ -1293,17 +1291,18 @@ CAMLprim value caml_domain_spawn(value callback, value term_sync) /* While waiting for the child thread to start up, we need to service any stop-the-world requests as they come in. */ - caml_plat_lock(&domain_self->interruptor.lock); + struct interruptor *interruptor = &domain_self->interruptor; + caml_plat_lock_blocking(&interruptor->lock); while (p.status == Dom_starting) { if (caml_incoming_interrupts_queued()) { - caml_plat_unlock(&domain_self->interruptor.lock); - handle_incoming(&domain_self->interruptor); - caml_plat_lock(&domain_self->interruptor.lock); + caml_plat_unlock(&interruptor->lock); + handle_incoming(interruptor); + caml_plat_lock_blocking(&interruptor->lock); } else { - caml_plat_wait(&domain_self->interruptor.cond); + caml_plat_wait(&interruptor->cond, &interruptor->lock); } } - caml_plat_unlock(&domain_self->interruptor.lock); + caml_plat_unlock(&interruptor->lock); if (p.status == Dom_started) { /* successfully created a domain. @@ -1379,7 +1378,7 @@ static void decrement_stw_domains_still_processing(void) if( am_last ) { /* release the STW lock to allow new STW sections */ - caml_plat_lock(&all_domains_lock); + caml_plat_lock_blocking(&all_domains_lock); atomic_store_release(&stw_leader, 0); caml_plat_broadcast(&all_domains_cond); caml_gc_log("clearing stw leader"); @@ -1829,7 +1828,7 @@ CAMLexport intnat caml_domain_is_multicore (void) CAMLexport void caml_acquire_domain_lock(void) { dom_internal* self = domain_self; - caml_plat_lock(&self->domain_lock); + caml_plat_lock_blocking(&self->domain_lock); caml_state = self->state; } @@ -1919,7 +1918,7 @@ static void domain_terminate (void) /* take the all_domains_lock to try and exit the STW participant set without racing with a STW section being triggered */ - caml_plat_lock(&all_domains_lock); + caml_plat_lock_blocking(&all_domains_lock); /* The interaction of termination and major GC is quite subtle. @@ -1945,7 +1944,7 @@ static void domain_terminate (void) /* signal the interruptor condition variable * because the backup thread may be waiting on it */ - caml_plat_lock(&s->lock); + caml_plat_lock_blocking(&s->lock); caml_plat_broadcast(&s->cond); caml_plat_unlock(&s->lock); diff --git a/ocaml/runtime/gc_stats.c b/ocaml/runtime/gc_stats.c index 1b35976d331..fc809305815 100644 --- a/ocaml/runtime/gc_stats.c +++ b/ocaml/runtime/gc_stats.c @@ -17,6 +17,7 @@ #include "caml/gc_stats.h" #include "caml/minor_gc.h" +#include "caml/platform.h" #include "caml/shared_heap.h" Caml_inline intnat intnat_max(intnat a, intnat b) { @@ -82,7 +83,7 @@ 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) { - caml_plat_lock(&orphan_lock); + caml_plat_lock_blocking(&orphan_lock); caml_accum_alloc_stats(acc, &orphaned_alloc_stats); caml_plat_unlock(&orphan_lock); } @@ -95,7 +96,7 @@ void caml_orphan_alloc_stats(caml_domain_state *domain) { caml_reset_domain_alloc_stats(domain); /* push them into the orphan stats */ - caml_plat_lock(&orphan_lock); + caml_plat_lock_blocking(&orphan_lock); caml_accum_alloc_stats(&orphaned_alloc_stats, &alloc_stats); caml_plat_unlock(&orphan_lock); } diff --git a/ocaml/runtime/globroots.c b/ocaml/runtime/globroots.c index 0360092d93e..f7ca82d31f5 100644 --- a/ocaml/runtime/globroots.c +++ b/ocaml/runtime/globroots.c @@ -19,6 +19,7 @@ #include "caml/mlvalues.h" #include "caml/memory.h" +#include "caml/platform.h" #include "caml/roots.h" #include "caml/globroots.h" #include "caml/skiplist.h" @@ -52,14 +53,14 @@ struct skiplist caml_global_roots_old = SKIPLIST_STATIC_INITIALIZER; Caml_inline void caml_insert_global_root(struct skiplist * list, value * r) { - caml_plat_lock(&roots_mutex); + caml_plat_lock_blocking(&roots_mutex); caml_skiplist_insert(list, (uintnat) r, 0); caml_plat_unlock(&roots_mutex); } Caml_inline void caml_delete_global_root(struct skiplist * list, value * r) { - caml_plat_lock(&roots_mutex); + caml_plat_lock_blocking(&roots_mutex); caml_skiplist_remove(list, (uintnat) r); caml_plat_unlock(&roots_mutex); } @@ -201,7 +202,7 @@ static void caml_register_dyn_global(void *v) { void caml_register_dyn_globals(void **globals, int nglobals) { int i; - caml_plat_lock(&roots_mutex); + caml_plat_lock_blocking(&roots_mutex); for (i = 0; i < nglobals; i++) caml_register_dyn_global(globals[i]); caml_plat_unlock(&roots_mutex); @@ -254,7 +255,7 @@ static void scan_native_globals(scanning_action f, void* fdata) int start, stop; link* lnk; - caml_plat_lock(&roots_mutex); + caml_plat_lock_blocking(&roots_mutex); dyn_globals = caml_dyn_globals; caml_plat_unlock(&roots_mutex); @@ -295,7 +296,7 @@ Caml_inline void caml_iterate_global_roots(scanning_action f, /* Scan all global roots */ void caml_scan_global_roots(scanning_action f, void* fdata) { - caml_plat_lock(&roots_mutex); + caml_plat_lock_blocking(&roots_mutex); caml_iterate_global_roots(f, &caml_global_roots, fdata); caml_iterate_global_roots(f, &caml_global_roots_young, fdata); caml_iterate_global_roots(f, &caml_global_roots_old, fdata); @@ -309,7 +310,7 @@ void caml_scan_global_roots(scanning_action f, void* fdata) { /* Scan global roots for a minor collection */ void caml_scan_global_young_roots(scanning_action f, void* fdata) { - caml_plat_lock(&roots_mutex); + caml_plat_lock_blocking(&roots_mutex); caml_iterate_global_roots(f, &caml_global_roots, fdata); caml_iterate_global_roots(f, &caml_global_roots_young, fdata); diff --git a/ocaml/runtime/io.c b/ocaml/runtime/io.c index debf9221320..ac495f8e2c3 100644 --- a/ocaml/runtime/io.c +++ b/ocaml/runtime/io.c @@ -86,16 +86,8 @@ static CAMLthread_local struct channel* last_channel_locked = NULL; CAMLexport void caml_channel_lock(struct channel *chan) { - if( caml_plat_try_lock(&chan->mutex) ) { - last_channel_locked = chan; - return; - } - - /* If unsuccessful, block on mutex */ - caml_enter_blocking_section(); - caml_plat_lock(&chan->mutex); + caml_plat_lock_non_blocking(&chan->mutex); last_channel_locked = chan; - caml_leave_blocking_section(); } CAMLexport void caml_channel_unlock(struct channel *chan) @@ -568,7 +560,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 (&caml_all_opened_channels_mutex); + caml_plat_lock_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 @@ -621,7 +613,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 (&caml_all_opened_channels_mutex); + caml_plat_lock_blocking(&caml_all_opened_channels_mutex); link_channel (chan); caml_plat_unlock (&caml_all_opened_channels_mutex); return caml_alloc_channel(chan); @@ -636,7 +628,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 (&caml_all_opened_channels_mutex); + caml_plat_lock_blocking(&caml_all_opened_channels_mutex); link_channel (chan); caml_plat_unlock (&caml_all_opened_channels_mutex); return caml_alloc_channel(chan); @@ -673,7 +665,7 @@ CAMLprim value caml_ml_out_channels_list (value unit) struct channel_list *channel_list = NULL, *cl_tmp; mlsize_t i, num_channels = 0; - caml_plat_lock (&caml_all_opened_channels_mutex); + caml_plat_lock_blocking(&caml_all_opened_channels_mutex); for (channel = caml_all_opened_channels; channel != NULL; channel = channel->next) { diff --git a/ocaml/runtime/major_gc.c b/ocaml/runtime/major_gc.c index 944aea167bc..54e0d3221eb 100644 --- a/ocaml/runtime/major_gc.c +++ b/ocaml/runtime/major_gc.c @@ -294,7 +294,7 @@ Caml_inline void prefetch_block(value v) static void ephe_next_cycle (void) { - caml_plat_lock(&ephe_lock); + caml_plat_lock_blocking(&ephe_lock); atomic_fetch_add(&ephe_cycle_info.ephe_cycle, +1); CAMLassert(atomic_load_acquire(&ephe_cycle_info.num_domains_done) <= @@ -309,7 +309,7 @@ static void ephe_todo_list_emptied (void) /* If we haven't started marking, the todo list can grow (during ephemeron allocation), so we should not yet announce that it has emptied */ CAMLassert (caml_marking_started()); - caml_plat_lock(&ephe_lock); + caml_plat_lock_blocking(&ephe_lock); /* Force next ephemeron marking cycle in order to avoid reasoning about * whether the domain has already incremented @@ -335,7 +335,7 @@ static void record_ephe_marking_done (uintnat ephe_cycle) if (ephe_cycle < atomic_load_acquire(&ephe_cycle_info.ephe_cycle)) return; - caml_plat_lock(&ephe_lock); + caml_plat_lock_blocking(&ephe_lock); if (ephe_cycle == atomic_load(&ephe_cycle_info.ephe_cycle)) { Caml_state->ephe_info->cycle = ephe_cycle; atomic_fetch_add(&ephe_cycle_info.num_domains_done, +1); @@ -418,7 +418,7 @@ void caml_orphan_ephemerons (caml_domain_state* domain_state) value live_tail = ephe_list_tail(ephe_info->live); CAMLassert(Ephe_link(live_tail) == 0); - caml_plat_lock(&orphaned_lock); + caml_plat_lock_blocking(&orphaned_lock); Ephe_link(live_tail) = orph_structs.ephe_list_live; orph_structs.ephe_list_live = ephe_info->live; ephe_info->live = 0; @@ -452,7 +452,7 @@ void caml_orphan_finalisers (caml_domain_state* domain_state) CAMLassert (!f->updated_last); /* Add the finalisers to [orph_structs] */ - caml_plat_lock(&orphaned_lock); + caml_plat_lock_blocking(&orphaned_lock); f->next = orph_structs.final_info; orph_structs.final_info = f; caml_plat_unlock(&orphaned_lock); @@ -491,7 +491,7 @@ static void adopt_orphaned_work (void) if (no_orphaned_work() || caml_domain_is_terminating()) return; - caml_plat_lock(&orphaned_lock); + caml_plat_lock_blocking(&orphaned_lock); orph_ephe_list_live = orph_structs.ephe_list_live; orph_structs.ephe_list_live = 0; diff --git a/ocaml/runtime/memory.c b/ocaml/runtime/memory.c index 062fae9fd18..6cf49f0a921 100644 --- a/ocaml/runtime/memory.c +++ b/ocaml/runtime/memory.c @@ -676,7 +676,7 @@ static struct pool_block* get_pool_block(caml_stat_block b) /* Linking a pool block into the ring */ static void link_pool_block(struct pool_block *pb) { - caml_plat_lock(&pool_mutex); + caml_plat_lock_blocking(&pool_mutex); pb->next = pool->next; pb->prev = pool; pool->next->prev = pb; @@ -687,7 +687,7 @@ static void link_pool_block(struct pool_block *pb) /* Unlinking a pool block from the ring */ static void unlink_pool_block(struct pool_block *pb) { - caml_plat_lock(&pool_mutex); + caml_plat_lock_blocking(&pool_mutex); pb->prev->next = pb->next; pb->next->prev = pb->prev; caml_plat_unlock(&pool_mutex); @@ -709,7 +709,7 @@ CAMLexport void caml_stat_create_pool(void) CAMLexport void caml_stat_destroy_pool(void) { - caml_plat_lock(&pool_mutex); + caml_plat_lock_blocking(&pool_mutex); if (pool != NULL) { pool->prev->next = NULL; while (pool != NULL) { diff --git a/ocaml/runtime/memprof.c b/ocaml/runtime/memprof.c index 9a825653837..f6e849d2095 100644 --- a/ocaml/runtime/memprof.c +++ b/ocaml/runtime/memprof.c @@ -965,7 +965,7 @@ static void orphans_abandon(memprof_domain_t domain) ot = ot->next; } - caml_plat_lock(&orphans_lock); + caml_plat_lock_blocking(&orphans_lock); ot->next = orphans; orphans = domain->orphans; atomic_store_release(&orphans_present, 1); @@ -986,8 +986,7 @@ static void orphans_adopt(memprof_domain_t domain) p = &(*p)->next; } - // XXX mshinwell: was caml_plat_lock_blocking in PR13299 - caml_plat_lock(&orphans_lock); + caml_plat_lock_blocking(&orphans_lock); if (orphans) { *p = orphans; orphans = NULL; diff --git a/ocaml/runtime/misc.c b/ocaml/runtime/misc.c index 4234f2b9850..3c4e57c68be 100644 --- a/ocaml/runtime/misc.c +++ b/ocaml/runtime/misc.c @@ -309,7 +309,8 @@ void caml_flambda2_invalid (value message) un-instruments function, this simply silences reports when the call stack contains a frame matching one of the lines starting with "race:". */ const char * __tsan_default_suppressions(void) { - return "deadlock:caml_plat_lock\n" /* Avoids deadlock inversion messages */ + return "deadlock:caml_plat_lock_blocking\n" /* Avoids deadlock inversion + messages */ "deadlock:pthread_mutex_lock\n"; /* idem */ } #endif /* WITH_THREAD_SANITIZER */ diff --git a/ocaml/runtime/platform.c b/ocaml/runtime/platform.c index bc2d4b7b052..1c5f76f77ea 100644 --- a/ocaml/runtime/platform.c +++ b/ocaml/runtime/platform.c @@ -24,6 +24,7 @@ #include "caml/osdeps.h" #include "caml/platform.h" #include "caml/fail.h" +#include "caml/signals.h" #ifdef HAS_SYS_MMAN_H #include #endif @@ -98,13 +99,25 @@ void caml_plat_assert_locked(caml_plat_mutex* m) #endif } +CAMLexport CAMLthread_local int caml_lockdepth = 0; + void caml_plat_assert_all_locks_unlocked(void) { #ifdef DEBUG - if (lockdepth) caml_fatal_error("Locks still locked at termination"); + if (caml_lockdepth) caml_fatal_error("Locks still locked at termination"); #endif } +CAMLexport void caml_plat_lock_non_blocking_actual(caml_plat_mutex* m) +{ + /* Avoid exceptions */ + caml_enter_blocking_section_no_pending(); + int rc = pthread_mutex_lock(m); + caml_leave_blocking_section(); + check_err("lock_non_blocking", rc); + DEBUG_LOCK(m); +} + void caml_plat_mutex_free(caml_plat_mutex* m) { check_err("mutex_free", pthread_mutex_destroy(m)); @@ -112,38 +125,34 @@ void caml_plat_mutex_free(caml_plat_mutex* m) static void caml_plat_cond_init_aux(caml_plat_cond *cond) { - custom_condvar_init(&cond->cond); + custom_condvar_init(cond); } /* Condition variables */ -void caml_plat_cond_init(caml_plat_cond* cond, caml_plat_mutex* m) +void caml_plat_cond_init(caml_plat_cond* cond) { caml_plat_cond_init_aux(cond); - cond->mutex = m; } -void caml_plat_wait(caml_plat_cond* cond) +void caml_plat_wait(caml_plat_cond* cond, caml_plat_mutex* mut) { - caml_plat_assert_locked(cond->mutex); - check_err("wait", custom_condvar_wait(&cond->cond, cond->mutex)); + caml_plat_assert_locked(mut); + check_err("wait", custom_condvar_wait(cond, mut)); } void caml_plat_broadcast(caml_plat_cond* cond) { - caml_plat_assert_locked(cond->mutex); - check_err("cond_broadcast", custom_condvar_broadcast(&cond->cond)); + check_err("cond_broadcast", custom_condvar_broadcast(cond)); } void caml_plat_signal(caml_plat_cond* cond) { - caml_plat_assert_locked(cond->mutex); - check_err("cond_signal", custom_condvar_signal(&cond->cond)); + check_err("cond_signal", custom_condvar_signal(cond)); } void caml_plat_cond_free(caml_plat_cond* cond) { - check_err("cond_free", custom_condvar_destroy(&cond->cond)); - cond->mutex=0; + check_err("cond_free", custom_condvar_destroy(cond)); } diff --git a/ocaml/runtime/runtime_events.c b/ocaml/runtime/runtime_events.c index aa7de6938a1..9501af54d4b 100644 --- a/ocaml/runtime/runtime_events.c +++ b/ocaml/runtime/runtime_events.c @@ -22,6 +22,7 @@ #include "caml/memory.h" #include "caml/mlvalues.h" #include "caml/osdeps.h" +#include "caml/platform.h" #include "caml/startup_aux.h" #include @@ -381,7 +382,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 - caml_plat_lock(&user_events_lock); + caml_plat_lock_blocking(&user_events_lock); value current_user_event = user_events; atomic_store_release(&runtime_events_enabled, 1); caml_plat_unlock(&user_events_lock); @@ -684,7 +685,7 @@ CAMLprim value caml_runtime_events_user_register(value event_name, Field(event, 3) = event_tag; - caml_plat_lock(&user_events_lock); + caml_plat_lock_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 @@ -800,7 +801,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(&user_events_lock); + caml_plat_lock_blocking(&user_events_lock); value current_user_event = user_events; caml_plat_unlock(&user_events_lock); diff --git a/ocaml/runtime/shared_heap.c b/ocaml/runtime/shared_heap.c index f567ec467ec..66712991b1e 100644 --- a/ocaml/runtime/shared_heap.c +++ b/ocaml/runtime/shared_heap.c @@ -163,7 +163,7 @@ static int move_all_pools(pool** src, _Atomic(pool*)* dst, void caml_teardown_shared_heap(struct caml_heap_state* heap) { int i; int released = 0, released_large = 0; - caml_plat_lock(&pool_freelist.lock); + caml_plat_lock_blocking(&pool_freelist.lock); for (i = 0; i < NUM_SIZECLASSES; i++) { released += move_all_pools(&heap->avail_pools[i], @@ -198,7 +198,7 @@ void caml_teardown_shared_heap(struct caml_heap_state* heap) { static pool* pool_acquire(struct caml_heap_state* local) { pool* r; - caml_plat_lock(&pool_freelist.lock); + caml_plat_lock_blocking(&pool_freelist.lock); r = pool_freelist.free; if (r) { pool_freelist.free = r->next; @@ -239,7 +239,7 @@ static void pool_release(struct caml_heap_state* local, CAMLassert(pool->sz == sz); local->stats.pool_words -= POOL_WSIZE; local->stats.pool_frag_words -= POOL_HEADER_WSIZE + wastage_sizeclass[sz]; - caml_plat_lock(&pool_freelist.lock); + caml_plat_lock_blocking(&pool_freelist.lock); pool->next = pool_freelist.free; pool_freelist.free = pool; pool_freelist.active_pools--; @@ -331,7 +331,7 @@ static pool* pool_global_adopt(struct caml_heap_state* local, sizeclass sz) return NULL; /* Haven't managed to find a pool locally, try the global ones */ - caml_plat_lock(&pool_freelist.lock); + caml_plat_lock_blocking(&pool_freelist.lock); if( atomic_load_relaxed(&pool_freelist.global_avail_pools[sz]) ) { r = atomic_load_relaxed(&pool_freelist.global_avail_pools[sz]); @@ -699,7 +699,7 @@ void caml_collect_heap_stats_sample( /* Add the orphan pool stats to a stats accumulator. */ void caml_accum_orphan_heap_stats(struct heap_stats* acc) { - caml_plat_lock(&pool_freelist.lock); + caml_plat_lock_blocking(&pool_freelist.lock); caml_accum_heap_stats(acc, &pool_freelist.stats); caml_plat_unlock(&pool_freelist.lock); } @@ -1303,7 +1303,7 @@ void caml_compact_heap(caml_domain_state* domain_state, cur_pool = next_pool; freed_pools++; } - caml_plat_lock(&pool_freelist.lock); + caml_plat_lock_blocking(&pool_freelist.lock); pool_freelist.active_pools -= freed_pools; caml_plat_unlock(&pool_freelist.lock); @@ -1315,7 +1315,7 @@ void caml_compact_heap(caml_domain_state* domain_state, pool* cur_pool; pool* next_pool; - caml_plat_lock(&pool_freelist.lock); + caml_plat_lock_blocking(&pool_freelist.lock); cur_pool = pool_freelist.free; while( cur_pool ) { @@ -1461,7 +1461,7 @@ void caml_cycle_heap(struct caml_heap_state* local) { local->unswept_large = local->swept_large; local->swept_large = NULL; - caml_plat_lock(&pool_freelist.lock); + caml_plat_lock_blocking(&pool_freelist.lock); for (i = 0; i < NUM_SIZECLASSES; i++) { received_p += move_all_pools( (pool**)&pool_freelist.global_avail_pools[i], diff --git a/ocaml/runtime/signals.c b/ocaml/runtime/signals.c index 91054a300d7..f505ff302c1 100644 --- a/ocaml/runtime/signals.c +++ b/ocaml/runtime/signals.c @@ -30,6 +30,7 @@ #include "caml/memory.h" #include "caml/misc.h" #include "caml/mlvalues.h" +#include "caml/platform.h" #include "caml/roots.h" #include "caml/signals.h" #include "caml/sys.h" @@ -737,7 +738,7 @@ CAMLprim value caml_install_signal_handler(value signal_number, value action) if (caml_signal_handlers == 0) { tmp_signal_handlers = caml_alloc(NSIG, 0); } - caml_plat_lock(&signal_install_mutex); + caml_plat_lock_blocking(&signal_install_mutex); if (caml_signal_handlers == 0) { /* caml_alloc cannot raise asynchronous exceptions from signals so this is safe */ diff --git a/ocaml/runtime/sync_posix.h b/ocaml/runtime/sync_posix.h index 558f7a94e09..fad2b032353 100644 --- a/ocaml/runtime/sync_posix.h +++ b/ocaml/runtime/sync_posix.h @@ -23,6 +23,8 @@ #include #include +#include "caml/sync.h" + #ifdef __linux__ #include #include @@ -35,10 +37,6 @@ typedef int sync_retcode; /* Mutexes */ -/* Already defined in */ -/* typedef pthread_mutex_t * sync_mutex; */ -/* #define Mutex_val(v) (* ((sync_mutex *) Data_custom_val(v))) */ - Caml_inline int sync_mutex_create(sync_mutex * res) { int rc; @@ -166,10 +164,6 @@ static int custom_condvar_broadcast(custom_condvar * cv) /* Condition variables */ -typedef custom_condvar * sync_condvar; - -#define Condition_val(v) (* (sync_condvar *) Data_custom_val(v)) - Caml_inline int sync_condvar_create(sync_condvar * res) { int rc;