Work around OCaml 5's Atomic issues

src_lockfree/fixed_atomic.ml

@@ -0,0 +1,24 @@
+(** This "fixes" [Atomic] of OCaml 5 in two ways:
+
+    * [Atomic.get] is incorrectly subject to CSE optimization in OCaml 5.
+
+    * OCaml 5 generates inefficient accesses of ['a Atomic.t array]s assuming
+      that the array might be a double array. *)
+
+include Atomic
+
+type 'a t = private 'a ref
+
+open struct
+  external as_atomic : 'a t -> 'a Atomic.t = "%identity"
+  external of_atomic : 'a Atomic.t -> 'a t = "%identity"
+end
+
+let[@inline] make x = of_atomic (make x)
+let[@inline] get x = get (Sys.opaque_identity (as_atomic x))
+let[@inline] compare_and_set x b a = compare_and_set (as_atomic x) b a
+let[@inline] exchange x v = exchange (as_atomic x) v
+let[@inline] set x v = set (as_atomic x) v
+let[@inline] fetch_and_add x v = fetch_and_add (as_atomic x) v
+let[@inline] incr x = incr (as_atomic x)
+let[@inline] decr x = decr (as_atomic x)

src_lockfree/size.ml

@@ -1,3 +1,5 @@
+module Atomic = Fixed_atomic
+
 module Snapshot = struct
   type t = int Atomic.t array
 
@@ -19,21 +21,23 @@ module Snapshot = struct
       ()
     done
 
-  let rec compute s sum i =
-    if i < Array.length s then
+  let rec compute s sum i n =
+    if i < n then
       compute s
         (sum
         - Atomic.get (Array.unsafe_get s i)
         + Atomic.get (Array.unsafe_get s (i + 1)))
-        (i + 2)
+        (i + 2) n
     else sum
 
+  let compute s = compute s 0 1 (Array.length s)
+
   let get s =
     let status = Array.unsafe_get s 0 in
     if Atomic.get status = collecting then
       Atomic.compare_and_set status collecting computing |> ignore;
     if Atomic.get status = computing then begin
-      let computed = compute s 0 1 in
+      let computed = compute s in
       if Atomic.get status = computing then
         Atomic.compare_and_set status computing computed |> ignore
     end;

src_lockfree/skiplist.ml

@@ -28,6 +28,8 @@
 (* TODO: Grow and possibly shrink the skiplist or e.g. adjust search and node
    generation based on the dynamic number of bindings. *)
 
+module Atomic = Fixed_atomic
+
 (* OCaml doesn't allow us to use one of the unused (always 0) bits in pointers
    for the marks and an indirection is needed.  This representation avoids the
    indirection except for marked references in nodes to be removed.  A GADT with

test/skiplist/dune

@@ -1,13 +1,14 @@
 (rule
  (progn
   (copy ../../src_lockfree/skiplist.ml skiplist.ml)
+  (copy ../../src_lockfree/fixed_atomic.ml fixed_atomic.ml)
   (copy ../../src_lockfree/bits.ml bits.ml)
   (copy ../../src_lockfree/size.ml size.ml)))
 
 (test
  (name skiplist_dscheck)
  (libraries atomic dscheck alcotest multicore-magic)
- (modules skiplist size bits skiplist_dscheck))
+ (modules skiplist size bits fixed_atomic skiplist_dscheck))
 
 (test
  (name qcheck_skiplist)