feat: add CCAtomic.update_cas

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 Atomic.t) (f : 'a -> res * 'a) : res =
+  let exception Ret of res in
+  let backoff = ref 1 in
+  try
+    while true do
+      let old_val = Atomic.get self in
+      let res, new_val = f old_val in
+      if Atomic.compare_and_set self old_val new_val then
+        raise_notrace (Ret res);
+
+      Containers_domain.relax_loop !backoff;
+      backoff := min 128 (2 * !backoff)
+    done
+  with Ret r -> r

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))

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 *)

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)))

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);
+  ()