From c1b13f1c7f0e465e3b27ea4cb69fbe71b0c3f520 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 8 Dec 2025 11:53:15 -0500
Subject: [PATCH] feat: add `CCAtomic.update_cas`

---
 src/core/CCAtomic.ml             | 21 +++++++++++++++++++++
 src/core/dune                    |  2 +-
 src/domain/containers_domain.mli |  7 +++++++
 src/domain/dune                  | 14 ++++++++++++++
 src/domain/gen.ml                | 28 ++++++++++++++++++++++++++++
 5 files changed, 71 insertions(+), 1 deletion(-)
 create mode 100644 src/domain/containers_domain.mli
 create mode 100644 src/domain/dune
 create mode 100644 src/domain/gen.ml

diff --git a/src/core/CCAtomic.ml b/src/core/CCAtomic.ml
index e617d06f..48707e3c 100644
--- a/src/core/CCAtomic.ml
+++ b/src/core/CCAtomic.ml
@@ -46,3 +46,24 @@ let[@inline never] decr r =
 (* atomic *)
 
 [@@@endif]
+
+(** Update loop with a compare-and-swap, and some basic backoff behavior.
+    [update_cas atomic f] is, in essence,
+    [let res, x = f !atomic in atomic := x; res]
+    done atomically. [f] might be called multiple times and must be as cheap
+    as possible.
+    @since NEXT_RELEASE *)
+let update_cas (type res) (self : 'a t) (f : 'a -> res * 'a) : res =
+  let exception Ret of res in
+  let backoff = ref 1 in
+  try
+    while true do
+      let old_val = get self in
+      let res, new_val = f old_val in
+      if compare_and_set self old_val new_val then raise_notrace (Ret res);
+
+      Containers_domain.relax_loop !backoff;
+      backoff := min 128 (2 * !backoff)
+    done;
+    assert false
+  with Ret r -> r
diff --git a/src/core/dune b/src/core/dune
index cc17ce83..bd362200 100644
--- a/src/core/dune
+++ b/src/core/dune
@@ -6,7 +6,7 @@
   (action
    (run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
  (flags :standard -nolabels -open CCMonomorphic)
- (libraries either containers.monomorphic))
+ (libraries either containers.monomorphic containers.domain))
 
 (ocamllex
  (modules CCSexp_lex))
diff --git a/src/domain/containers_domain.mli b/src/domain/containers_domain.mli
new file mode 100644
index 00000000..e3983e7b
--- /dev/null
+++ b/src/domain/containers_domain.mli
@@ -0,0 +1,7 @@
+(** A partial stub for {!Domain}. *)
+
+val is_main_domain : unit -> bool
+val cpu_relax : unit -> unit
+
+val relax_loop : int -> unit
+(** Call {!cpu_relax} n times *)
diff --git a/src/domain/dune b/src/domain/dune
new file mode 100644
index 00000000..d745b6da
--- /dev/null
+++ b/src/domain/dune
@@ -0,0 +1,14 @@
+(library
+ (name containers_domain)
+ (synopsis "Compatibility library for the Domain module")
+ (public_name containers.domain)
+ (modules containers_domain))
+
+(executable
+ (modules gen)
+ (name gen))
+
+(rule
+ (targets containers_domain.ml)
+ (action
+  (run ./gen.exe)))
diff --git a/src/domain/gen.ml b/src/domain/gen.ml
new file mode 100644
index 00000000..7fc38e5b
--- /dev/null
+++ b/src/domain/gen.ml
@@ -0,0 +1,28 @@
+let domain_4 =
+  {|
+let is_main_domain () = true
+let cpu_relax = ignore
+let relax_loop : int -> unit = ignore
+  |}
+
+let domain_5 =
+  {|
+let is_main_domain = Domain.is_main_domain
+let cpu_relax = Domain.cpu_relax
+let relax_loop i =
+  for _j = 1 to i do cpu_relax () done
+|}
+
+let write_file file s =
+  let oc = open_out file in
+  output_string oc s;
+  close_out oc
+
+let () =
+  let version = Scanf.sscanf Sys.ocaml_version "%d.%d.%s" (fun x y _ -> x, y) in
+  write_file "containers_domain.ml"
+    (if version >= (5, 0) then
+       domain_5
+     else
+       domain_4);
+  ()