Revise benchmarks

ocaml-multicore · Nov 10, 2024 · 57a82f1 · 57a82f1
1 parent 6c53ef1
commit 57a82f1
Show file tree

Hide file tree

Showing 10 changed files with 138 additions and 137 deletions.
diff --git a/bench/bench_accumulator.ml b/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 =

diff --git a/bench/bench_dllist.ml b/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:1000 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:1000 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 ()

diff --git a/bench/bench_hashtbl.ml b/bench/bench_hashtbl.ml
@@ -18,16 +18,16 @@ let run_one ~budgetf ~n_domains ?(n_ops = 40 * Util.iter_factor)
     Hashtbl.replace t i i
   done;
 
-  let n_ops_todo = Atomic.make 0 |> Multicore_magic.copy_as_padded in
+  let n_ops_todo = Countdown.create ~n_domains () in
 
   let init _ =
-    Atomic.set n_ops_todo n_ops;
+    Countdown.non_atomic_set n_ops_todo n_ops;
     Random.State.make_self_init ()
   in
 
-  let work _ state =
+  let work domain_index state =
     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

diff --git a/bench/bench_mvar.ml b/bench/bench_mvar.ml
@@ -7,15 +7,19 @@ let run_one ~budgetf ?(n_adders = 2) ?(blocking_add = false) ?(n_takers = 2)
 
   let t = Mvar.create None in
 
-  let n_msgs_to_take = Atomic.make n_msgs |> Multicore_magic.copy_as_padded in
-  let n_msgs_to_add = Atomic.make n_msgs |> 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 _ = () in
+  let init _ =
+    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
       if blocking_add then
         let rec work () =
-          let n = Util.alloc n_msgs_to_add in
+          let n = Countdown.alloc n_msgs_to_add ~domain_index ~batch:1000 in
           if 0 < n then begin
             for i = 1 to n do
               Mvar.put t i
@@ -26,45 +30,43 @@ let run_one ~budgetf ?(n_adders = 2) ?(blocking_add = false) ?(n_takers = 2)
         work ()
       else
         let rec work () =
-          let n = Util.alloc n_msgs_to_add in
+          let n = Countdown.alloc n_msgs_to_add ~domain_index ~batch:1000 in
           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 ()
           end
         in
         work ()
-    else if blocking_take then
-      let rec work () =
-        let n = Util.alloc n_msgs_to_take in
-        if n <> 0 then begin
-          for _ = 1 to n do
-            ignore (Mvar.take t)
-          done;
-          work ()
-        end
-      in
-      work ()
     else
-      let rec work () =
-        let n = Util.alloc n_msgs_to_take in
-        if n <> 0 then begin
-          for _ = 1 to n do
-            while Option.is_none (Mvar.take_opt t) do
-              Domain.cpu_relax ()
-            done
-          done;
-          work ()
-        end
-      in
-      work ()
-  in
-  let after () =
-    Atomic.set n_msgs_to_take n_msgs;
-    Atomic.set n_msgs_to_add n_msgs
+      let domain_index = i - n_adders in
+      if blocking_take then
+        let rec work () =
+          let n = Countdown.alloc n_msgs_to_take ~domain_index ~batch:1000 in
+          if n <> 0 then begin
+            for _ = 1 to n do
+              ignore (Mvar.take t)
+            done;
+            work ()
+          end
+        in
+        work ()
+      else
+        let rec work () =
+          let n = Countdown.alloc n_msgs_to_take ~domain_index ~batch:1000 in
+          if n <> 0 then begin
+            for _ = 1 to n do
+              while Option.is_none (Mvar.take_opt t) do
+                Backoff.once Backoff.default |> ignore
+              done
+            done;
+            work ()
+          end
+        in
+        work ()
   in
 
   let config =
@@ -79,7 +81,7 @@ let run_one ~budgetf ?(n_adders = 2) ?(blocking_add = false) ?(n_takers = 2)
       (format "taker" blocking_take n_takers)
   in
 
-  Times.record ~budgetf ~n_domains ~init ~work ~after ()
+  Times.record ~budgetf ~n_domains ~init ~work ()
   |> Times.to_thruput_metrics ~n:n_msgs ~singular:"message" ~config
 
 let run_suite ~budgetf =

diff --git a/bench/bench_parallel_cmp.ml b/bench/bench_parallel_cmp.ml
@@ -8,11 +8,13 @@ let run_one ~budgetf ~n_domains ?(n_ops = 50 * Util.iter_factor) () =
   let b = Loc.make ~padded:true 52 in
   let xs = Loc.make_array ~padded:true n_domains 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 i = Array.unsafe_get xs i in
-
-  let work _ x =
+  let init i =
+    Countdown.non_atomic_set n_ops_todo n_ops;
+    Array.unsafe_get xs i
+  in
+  let work domain_index x =
     let tx1 ~xt =
       let a = Xt.get ~xt a in
       let b = Xt.get ~xt b in
@@ -23,7 +25,7 @@ let run_one ~budgetf ~n_domains ?(n_ops = 50 * Util.iter_factor) () =
       Xt.set ~xt x (a + b)
     in
     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 begin
         for _ = 1 to n asr 1 do
           Xt.commit { tx = tx1 };
@@ -35,13 +37,11 @@ let run_one ~budgetf ~n_domains ?(n_ops = 50 * Util.iter_factor) () =
     work ()
   in
 
-  let after () = Atomic.set n_ops_todo n_ops in
-
   let config =
     Printf.sprintf "%d worker%s" 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 ~singular:"transaction" ~config
 
 let run_suite ~budgetf =

diff --git a/bench/bench_queue.ml b/bench/bench_queue.ml
@@ -21,18 +21,19 @@ let run_one ~budgetf ?(n_adders = 2) ?(blocking_add = false) ?(n_takers = 2)
 
   let t = Queue.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 (Queue.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:1000 in
         if 0 < n then begin
           for i = 1 to n do
             Queue.add i t
@@ -41,30 +42,32 @@ let run_one ~budgetf ?(n_adders = 2) ?(blocking_add = false) ?(n_takers = 2)
         end
       in
       work ()
-    else if blocking_take then
-      let rec work () =
-        let n = Util.alloc n_msgs_to_take in
-        if n <> 0 then begin
-          for _ = 1 to n do
-            ignore (Queue.take_blocking t)
-          done;
-          work ()
-        end
-      in
-      work ()
     else
-      let rec work () =
-        let n = Util.alloc n_msgs_to_take in
-        if n <> 0 then begin
-          for _ = 1 to n do
-            while Option.is_none (Queue.take_opt t) do
-              Domain.cpu_relax ()
-            done
-          done;
-          work ()
-        end
-      in
-      work ()
+      let domain_index = i - n_adders in
+      if blocking_take then
+        let rec work () =
+          let n = Countdown.alloc n_msgs_to_take ~domain_index ~batch:1000 in
+          if n <> 0 then begin
+            for _ = 1 to n do
+              ignore (Queue.take_blocking t)
+            done;
+            work ()
+          end
+        in
+        work ()
+      else
+        let rec work () =
+          let n = Countdown.alloc n_msgs_to_take ~domain_index ~batch:1000 in
+          if n <> 0 then begin
+            for _ = 1 to n do
+              while Option.is_none (Queue.take_opt t) do
+                Backoff.once Backoff.default |> ignore
+              done
+            done;
+            work ()
+          end
+        in
+        work ()
   in
 
   let config =