Revise benchmarks

bench/bench_accumulator.ml

@@ -6,13 +6,12 @@ let run_one ~budgetf ~n_domains ?(n_ops = 180 * Util.iter_factor) () =
 
   let t = Accumulator.make 0 in
 
-  let n_ops_todo = Atomic.make n_ops |> Multicore_magic.copy_as_padded in
+  let n_ops_todo = Countdown.create ~n_domains () in
 
-  let init _ = () in
-
-  let work _ () =
+  let init _ = Countdown.non_atomic_set n_ops_todo n_ops in
+  let work domain_index () =
     let rec work () =
-      let n = Util.alloc n_ops_todo in
+      let n = Countdown.alloc n_ops_todo ~domain_index ~batch:1000 in
       if n <> 0 then
         let rec loop n =
           if 0 < n then begin
@@ -27,14 +26,12 @@ let run_one ~budgetf ~n_domains ?(n_ops = 180 * Util.iter_factor) () =
     work ()
   in
 
-  let after () = Atomic.set n_ops_todo n_ops in
-
   let config =
     Printf.sprintf "%d worker%s, 0%% reads" n_domains
       (if n_domains = 1 then "" else "s")
   in
 
-  Times.record ~budgetf ~n_domains ~init ~work ~after ()
+  Times.record ~budgetf ~n_domains ~init ~work ()
   |> Times.to_thruput_metrics ~n:n_ops ~config ~singular:"operation"
 
 let run_suite ~budgetf =

bench/bench_dllist.ml

@@ -23,18 +23,19 @@ let run_one ~budgetf ?(n_adders = 2) ?(n_takers = 2) ?(factor = 1)
 
   let t = Dllist.create () in
 
-  let n_msgs_to_take = Atomic.make 0 |> Multicore_magic.copy_as_padded in
-  let n_msgs_to_add = Atomic.make 0 |> Multicore_magic.copy_as_padded in
+  let n_msgs_to_take = Countdown.create ~n_domains:n_takers () in
+  let n_msgs_to_add = Countdown.create ~n_domains:n_adders () in
 
   let init _ =
     assert (Dllist.is_empty t);
-    Atomic.set n_msgs_to_take n_msgs;
-    Atomic.set n_msgs_to_add n_msgs
+    Countdown.non_atomic_set n_msgs_to_take n_msgs;
+    Countdown.non_atomic_set n_msgs_to_add n_msgs
   in
   let work i () =
     if i < n_adders then
+      let domain_index = i in
       let rec work () =
-        let n = Util.alloc n_msgs_to_add in
+        let n = Countdown.alloc n_msgs_to_add ~domain_index ~batch:100 in
         if 0 < n then begin
           for i = 1 to n do
             Dllist.add_r i t |> ignore
@@ -44,12 +45,13 @@ let run_one ~budgetf ?(n_adders = 2) ?(n_takers = 2) ?(factor = 1)
       in
       work ()
     else
+      let domain_index = i - n_adders in
       let rec work () =
-        let n = Util.alloc n_msgs_to_take in
+        let n = Countdown.alloc n_msgs_to_take ~domain_index ~batch:100 in
         if n <> 0 then begin
           for _ = 1 to n do
             while Option.is_none (Dllist.take_opt_l t) do
-              Domain.cpu_relax ()
+              Backoff.once Backoff.default |> ignore
             done
           done;
           work ()

bench/bench_mvar.ml

@@ -30,7 +30,7 @@ let run_one ~budgetf ?(n_adders = 2) ?(blocking_add = false) ?(n_takers = 2)
           if 0 < n then begin
             for i = 1 to n do
               while not (Mvar.try_put t i) do
-                Domain.cpu_relax ()
+                Backoff.once Backoff.default |> ignore
               done
             done;
             work ()
@@ -54,7 +54,7 @@ let run_one ~budgetf ?(n_adders = 2) ?(blocking_add = false) ?(n_takers = 2)
         if n <> 0 then begin
           for _ = 1 to n do
             while Option.is_none (Mvar.take_opt t) do
-              Domain.cpu_relax ()
+              Backoff.once Backoff.default |> ignore
             done
           done;
           work ()

bench/bench_queue.ml

@@ -58,7 +58,7 @@ let run_one ~budgetf ?(n_adders = 2) ?(blocking_add = false) ?(n_takers = 2)
         if n <> 0 then begin
           for _ = 1 to n do
             while Option.is_none (Queue.take_opt t) do
-              Domain.cpu_relax ()
+              Backoff.once Backoff.default |> ignore
             done
           done;
           work ()

bench/bench_stack.ml

@@ -58,7 +58,7 @@ let run_one ~budgetf ?(n_adders = 2) ?(blocking_add = false) ?(n_takers = 2)
         if n <> 0 then begin
           for _ = 1 to n do
             while Option.is_none (Stack.pop_opt t) do
-              Domain.cpu_relax ()
+              Backoff.once Backoff.default |> ignore
             done
           done;
           work ()

bench/dune

@@ -1,22 +1,16 @@
-(* -*- tuareg -*- *)
-
-let maybe_domain_shims_and_threads =
-  if Jbuild_plugin.V1.ocaml_version < "5" then "domain_shims threads.posix"
-  else ""
-
-let () =
-  Jbuild_plugin.V1.send
-  @@ {|
-
 (test
  (name main)
  (package kcas_data)
  (action
-  (run %{test} -brief))
- (libraries
-  kcas_data
-  multicore-bench
-  backoff
-  multicore-magic |}
-  ^ maybe_domain_shims_and_threads ^ {| ))
-|}
+  (progn
+   (run %{test} -brief "Kcas Loc")
+   (run %{test} -brief "Kcas Xt")
+   (run %{test} -brief "Kcas Xt read-only")
+   (run %{test} -brief "Kcas parallel CMP")
+   (run %{test} -brief "Kcas_data Accumulator")
+   (run %{test} -brief "Kcas_data Dllist")
+   (run %{test} -brief "Kcas_data Hashtbl")
+   (run %{test} -brief "Kcas_data Mvar")
+   (run %{test} -brief "Kcas_data Queue")
+   (run %{test} -brief "Kcas_data Stack")))
+ (libraries kcas_data multicore-bench backoff multicore-magic))

dune-project

@@ -94,7 +94,7 @@
     :with-test))
   (multicore-bench
    (and
-    (>= 0.1.5)
+    (>= 0.1.7)
     :with-test))
   (alcotest
    (and

kcas_data.opam

@@ -22,7 +22,7 @@ depends: [
   "backoff" {>= "0.1.0" & with-test}
   "domain-local-await" {>= "1.0.1" & with-test}
   "domain_shims" {>= "0.1.0" & with-test}
-  "multicore-bench" {>= "0.1.5" & with-test}
+  "multicore-bench" {>= "0.1.7" & with-test}
   "alcotest" {>= "1.8.0" & with-test}
   "qcheck-core" {>= "0.21.2" & with-test}
   "qcheck-stm" {>= "0.3" & with-test}