Add a benchmark of atomic increments

Author: polytypic

bench/bench_incr.ml

@@ -0,0 +1,75 @@
+open Multicore_bench
+
+let run_one ~budgetf ~n_domains ~approach () =
+  let counter = Atomic.make 0 |> Multicore_magic.copy_as_padded in
+
+  let n_ops = 100 * Util.iter_factor in
+
+  let n_ops_todo = Atomic.make 0 |> Multicore_magic.copy_as_padded in
+
+  let init _ = Atomic.set n_ops_todo n_ops in
+  let work _ () =
+    match approach with
+    | `Incr ->
+        let rec work () =
+          let n = Util.alloc n_ops_todo in
+          if n <> 0 then
+            let rec loop n =
+              if 0 < n then begin
+                Atomic.incr counter;
+                loop (n - 1)
+              end
+              else work ()
+            in
+            loop n
+        in
+        work ()
+    | `Cas ->
+        let rec work () =
+          let n = Util.alloc n_ops_todo in
+          if n <> 0 then
+            let rec loop n =
+              if 0 < n then begin
+                let v = Atomic.get counter in
+                let success = Atomic.compare_and_set counter v (v + 1) in
+                loop (n - Bool.to_int success)
+              end
+              else work ()
+            in
+            loop n
+        in
+        work ()
+    | `Cas_backoff ->
+        let rec work () =
+          let n = Util.alloc n_ops_todo in
+          if n <> 0 then
+            let rec loop n backoff =
+              if 0 < n then begin
+                let v = Atomic.get counter in
+                if Atomic.compare_and_set counter v (v + 1) then
+                  loop (n - 1) Backoff.default
+                else loop n (Backoff.once backoff)
+              end
+              else work ()
+            in
+            loop n Backoff.default
+        in
+        work ()
+  in
+
+  let config =
+    Printf.sprintf "%s, %d domains"
+      (match approach with
+      | `Incr -> "Incr"
+      | `Cas -> "CAS"
+      | `Cas_backoff -> "CAS with backoff")
+      n_domains
+  in
+  Times.record ~budgetf ~n_domains ~init ~work ()
+  |> Times.to_thruput_metrics ~n:n_ops ~singular:"op" ~config
+
+let run_suite ~budgetf =
+  Util.cross [ `Incr; `Cas; `Cas_backoff ] [ 1; 2; 4; 8 ]
+  |> List.concat_map @@ fun (approach, n_domains) ->
+     if Domain.recommended_domain_count () < n_domains then []
+     else run_one ~budgetf ~n_domains ~approach ()

bench/main.ml

@@ -7,6 +7,7 @@ let benchmarks =
     ("Queue", Bench_queue.run_suite);
     ("Stack", Bench_stack.run_suite);
     ("Unix", Bench_unix.run_suite);
+    ("Atomic incr", Bench_incr.run_suite);
   ]
 
 let () = Multicore_bench.Cmd.run ~benchmarks ()