Merge pull request #368 from ocaml-multicore/asym-atomic

Switch STM_domain.agree_prop_par_asym to use Atomics
ocaml-multicore · Jun 21, 2023 · 1be22ae · 1be22ae
2 parents 79ca3de + 840a01d
commit 1be22ae
Show file tree

Hide file tree

Showing 2 changed files with 11 additions and 5 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -1,5 +1,11 @@
 # Changes
 
+## Next
+
+- #368: Switch `STM_domain.agree_prop_par_asym` from using
+  `Semaphore.Binary` to using an `int Atomic.t` which improves
+  the error rate across platforms and backends
+
 ## 0.2
 
 - #342: Add two submodules of combinators in `Util`:

diff --git a/lib/STM_domain.ml b/lib/STM_domain.ml
@@ -42,15 +42,15 @@ module Make (Spec: Spec) = struct
   let agree_prop_par_asym (seq_pref, cmds1, cmds2) =
     let sut = Spec.init_sut () in
     let pref_obs = interp_sut_res sut seq_pref in
-    let sema = Semaphore.Binary.make false in
+    let wait = Atomic.make 2 in
     let child_dom =
       Domain.spawn (fun () ->
-          Semaphore.Binary.release sema;
+          Atomic.decr wait;
+          while Atomic.get wait <> 0 do Domain.cpu_relax() done;
           try Ok (interp_sut_res sut cmds2) with exn -> Error exn)
     in
-    while not (Semaphore.Binary.try_acquire sema) do
-      Domain.cpu_relax ()
-    done;
+    Atomic.decr wait;
+    while Atomic.get wait <> 0 do Domain.cpu_relax() done;
     let parent_obs = try Ok (interp_sut_res sut cmds1) with exn -> Error exn in
     let child_obs = Domain.join child_dom in
     let () = Spec.cleanup sut in