oxcaml · mshinwell · Apr 2, 2025 · Apr 2, 2025
diff --git a/runtime/bigarray.c b/runtime/bigarray.c
@@ -27,7 +27,7 @@
 #include "caml/memory.h"
 #include "caml/mlvalues.h"
 #include "caml/signals.h"
-#include "caml/camlatomic.h"
+#include "caml/atomic_refcount.h"
 
 #define int8 caml_ba_int8
 #define uint8 caml_ba_uint8
@@ -293,7 +293,7 @@ CAMLexport void caml_ba_finalize(value v)
       free(b->data);
       caml_free_dependent_memory(v, caml_ba_byte_size(b));
     } else {
-      if (!caml_atomic_counter_decr(&b->proxy->refcount)) {
+      if (caml_atomic_refcount_decr(&b->proxy->refcount) == 1) {
         free(b->proxy->data);
         caml_free_dependent_memory(v, b->proxy->size);
         free(b->proxy);
@@ -1133,12 +1133,12 @@ static void caml_ba_update_proxy(struct caml_ba_array * b1,
     /* If b1 is already a proxy for a larger array, increment refcount of
        proxy */
     b2->proxy = b1->proxy;
-    (void)caml_atomic_counter_incr(&b1->proxy->refcount);
+    caml_atomic_refcount_incr(&b1->proxy->refcount);
   } else {
     /* Otherwise, create proxy and attach it to both b1 and b2 */
     proxy = malloc(sizeof(struct caml_ba_proxy));
     if (proxy == NULL) caml_raise_out_of_memory();
-    caml_atomic_counter_init(&proxy->refcount, 2);
+    caml_atomic_refcount_init(&proxy->refcount, 2);
     /* initial refcount: 2 = original array + sub array */
     proxy->data = b1->data;
     proxy->size = caml_ba_byte_size(b1);

diff --git a/runtime/caml/atomic_refcount.h b/runtime/caml/atomic_refcount.h
@@ -0,0 +1,37 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*      Florian Angeletti, projet Cambium, Inria                          */
+/*                                                                        */
+/*   Copyright 2022 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_ATOMIC_REFCOUNT_H
+#define CAML_ATOMIC_REFCOUNT_H
+
+#ifdef CAML_INTERNALS
+
+#include "camlatomic.h"
+
+Caml_inline void caml_atomic_refcount_init(atomic_uintnat* refc, uintnat n){
+  atomic_store_release(refc, n);
+}
+
+Caml_inline uintnat caml_atomic_refcount_decr(atomic_uintnat* refcount){
+  return atomic_fetch_add (refcount, -1);
+}
+
+Caml_inline uintnat caml_atomic_refcount_incr(atomic_uintnat* refcount){
+  return atomic_fetch_add (refcount, 1);
+}
+
+#endif /* CAML_INTERNALS */
+
+#endif // CAML_ATOMIC_REFCOUNT_H
diff --git a/runtime/caml/camlatomic.h b/runtime/caml/camlatomic.h
@@ -17,7 +17,6 @@
 #define CAML_ATOMIC_H
 
 #include "config.h"
-#include "misc.h"
 
 /* On platforms supporting C11 atomics, this file just includes <stdatomic.h>.
 
@@ -96,29 +95,6 @@ typedef struct { intnat repr; } atomic_intnat;
 #define atomic_store_relaxed(p, v)                      \
   atomic_store_explicit((p), (v), memory_order_relaxed)
 
-Caml_inline void caml_atomic_counter_init(atomic_uintnat* counter, uintnat n)
-{
-  atomic_store_release(counter, n);
-}
-
-/* atomically decrements the counter and returns the new value */
-
-Caml_inline uintnat caml_atomic_counter_decr(atomic_uintnat* counter)
-{
-  uintnat old = atomic_fetch_sub(counter, 1);
-  CAMLassert (old > 0);
-  return old-1;
-}
-
-/* atomically increments the counter and returns the new value */
-
-Caml_inline uintnat caml_atomic_counter_incr(atomic_uintnat* counter)
-{
-  uintnat old = atomic_fetch_add(counter, 1);
-  CAMLassert(old+1 != 0);
-  return old+1;
-}
-
 #endif /* CAML_INTERNALS */
 
 #endif /* CAML_ATOMIC_H */
diff --git a/runtime/caml/dune b/runtime/caml/dune
@@ -50,6 +50,7 @@
   (address_class.h as caml/address_class.h)
   (addrmap.h as caml/addrmap.h)
   (alloc.h as caml/alloc.h)
+  (atomic_refcount.h as caml/atomic_refcount.h)
   (backtrace_prim.h as caml/backtrace_prim.h)
   (backtrace.h as caml/backtrace.h)
   (bigarray.h as caml/bigarray.h)

diff --git a/runtime/caml/misc.h b/runtime/caml/misc.h
@@ -27,6 +27,8 @@
 #include <stdarg.h>
 #include <limits.h>
 
+#include "camlatomic.h"
+
 /* Deprecation warnings */
 
 #if defined(__GNUC__) || defined(__clang__)
@@ -199,8 +201,6 @@ CAMLdeprecated_typedef(addr, char *);
    can obtain the domain id with Caml_state->id. These functions must
    be reentrant. */
 #ifndef __cplusplus
-#include <stdatomic.h>
-
 typedef void (*caml_timing_hook) (void);
 extern _Atomic caml_timing_hook caml_major_slice_begin_hook;
 extern _Atomic caml_timing_hook caml_major_slice_end_hook;
@@ -505,7 +505,7 @@ CAMLextern int caml_read_directory(char_os * dirname,
 
 /* runtime message flags. Settable with v= in OCAMLRUNPARAM */
 
-extern _Atomic uintnat caml_verb_gc;
+extern atomic_uintnat caml_verb_gc;
 
 /* Bits which may be set in caml_verb_gc. Keep in sync with the OCaml
  * manual, the ocamlrun.1 man page, and gc.mli */

diff --git a/runtime/caml/mlvalues.h b/runtime/caml/mlvalues.h
@@ -18,7 +18,6 @@
 
 #include "config.h"
 #include "misc.h"
-#include "camlatomic.h"
 #include "tsan.h"
 
 #ifdef __cplusplus

diff --git a/runtime/caml/platform.h b/runtime/caml/platform.h
@@ -54,6 +54,14 @@ Caml_inline void cpu_relax(void) {
 }
 
 
+/* Atomic read-modify-write instructions, with full fences */
+
+Caml_inline uintnat atomic_fetch_add_verify_ge0(atomic_uintnat* p, uintnat v) {
+  uintnat result = atomic_fetch_add(p,v);
+  CAMLassert ((intnat)result > 0);
+  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
 
@@ -300,7 +308,7 @@ typedef uintnat barrier_status;
    the last arrival. */
 Caml_inline barrier_status caml_plat_barrier_arrive(caml_plat_barrier* barrier)
 {
-  return caml_atomic_counter_incr(&barrier->arrived);
+  return 1 + atomic_fetch_add(&barrier->arrived, 1);
 }
 
 /* -- Single-sense --

diff --git a/runtime/domain.c b/runtime/domain.c
@@ -720,7 +720,7 @@ static void domain_create(uintnat initial_minor_heap_wsize,
   s->unique_id = fresh_domain_unique_id();
   domain_state->unique_id = s->unique_id;
   s->running = 1;
-  (void)caml_atomic_counter_incr(&caml_num_domains_running);
+  atomic_fetch_add(&caml_num_domains_running, 1);
 
   domain_state->c_stack = NULL;
   domain_state->exn_handler = NULL;
@@ -1454,7 +1454,7 @@ static void decrement_stw_domains_still_processing(void)
      if so, clear the stw_leader to allow the new stw sections to start.
    */
   intnat am_last =
-    caml_atomic_counter_decr(&stw_request.num_domains_still_processing) == 0;
+      atomic_fetch_add(&stw_request.num_domains_still_processing, -1) == 1;
 
   if( am_last ) {
     /* release the STW lock to allow new STW sections */
@@ -1672,8 +1672,8 @@ int caml_try_run_on_all_domains_with_spin_work(
   stw_request.data = data;
   stw_request.num_domains = stw_domains.participating_domains;
   /* stw_request.barrier doesn't need resetting */
-  caml_atomic_counter_init(&stw_request.num_domains_still_processing,
-                           stw_domains.participating_domains);
+  atomic_store_release(&stw_request.num_domains_still_processing,
+                       stw_domains.participating_domains);
 
   int is_alone = stw_request.num_domains == 1;
   int should_sync = sync && !is_alone;
@@ -2157,7 +2157,7 @@ static void domain_terminate (void)
   /* This is the last thing we do because we need to be able to rely
      on caml_domain_alone (which uses caml_num_domains_running) in at least
      the shared_heap lockfree fast paths */
-  (void)caml_atomic_counter_decr(&caml_num_domains_running);
+  atomic_fetch_add(&caml_num_domains_running, -1);
 }
 
 CAMLprim value caml_ml_domain_cpu_relax(value t)