Benchmark parallel CMP using various number of domains

Author: polytypic

bench/bench_parallel_cmp.ml

@@ -1,60 +1,66 @@
 open Kcas
 open Bench
 
-let run_one ?(factor = 1) ?(n_iter = 10 * factor * Util.iter_factor) () =
+let run_one ~n_domains ?(factor = 1) ?(n_ops = 50 * factor * Util.iter_factor)
+    () =
+  let n_ops = n_ops * n_domains in
+
   let a = Loc.make ~padded:true 10 in
   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 init i = Array.unsafe_get xs i in
 
-  let init _ = Loc.make ~padded:true 0 in
-  let work i x =
-    if i land 1 = 0 then begin
-      let tx1 ~xt =
-        let a = Xt.get ~xt a in
-        let b = Xt.get ~xt b in
-        Xt.set ~xt x (b - a)
-      and tx2 ~xt =
-        let a = Xt.get ~xt a in
-        let b = Xt.get ~xt b in
-        Xt.set ~xt x (a + b)
-      in
-      let tx1 = { Xt.tx = tx1 } and tx2 = { Xt.tx = tx2 } in
-      for _ = 1 to n_iter asr 1 do
-        Xt.commit tx1;
-        Xt.commit tx2
-      done
-    end
-    else begin
-      let tx1 ~xt =
-        let a = Xt.get ~xt a in
-        let b = Xt.get ~xt b in
-        Xt.set ~xt x (b - a)
-      and tx2 ~xt =
-        let a = Xt.get ~xt a in
-        let b = Xt.get ~xt b in
-        Xt.set ~xt x (a + b)
-      in
-      let tx1 = { Xt.tx = tx1 } and tx2 = { Xt.tx = tx2 } in
-      for _ = 1 to n_iter asr 1 do
-        Xt.commit tx1;
-        Xt.commit tx2
-      done
-    end
+  let work _ x =
+    let tx1 ~xt =
+      let a = Xt.get ~xt a in
+      let b = Xt.get ~xt b in
+      Xt.set ~xt x (b - a)
+    and tx2 ~xt =
+      let a = Xt.get ~xt a in
+      let b = Xt.get ~xt b in
+      Xt.set ~xt x (a + b)
+    in
+    let rec work () =
+      let n = Util.alloc n_ops_todo in
+      if n <> 0 then begin
+        for _ = 1 to n asr 1 do
+          Xt.commit { tx = tx1 };
+          Xt.commit { tx = tx2 }
+        done;
+        work ()
+      end
+    in
+    work ()
   in
 
-  let times = Times.record ~n_domains:2 ~init ~work () in
+  let after () = Atomic.set n_ops_todo n_ops in
+
+  let times = Times.record ~n_domains ~init ~work ~after () in
+
+  let name metric =
+    Printf.sprintf "%s/%d worker%s" metric n_domains
+      (if n_domains = 1 then "" else "s")
+  in
 
   List.concat
     [
       Stats.of_times times
-      |> Stats.scale (1_000_000_000.0 /. Float.of_int n_iter)
-      |> Stats.to_json ~name:"time per transaction"
+      |> Stats.scale (1_000_000_000.0 /. Float.of_int n_ops)
+      |> Stats.to_json
+           ~name:(name "time per transaction")
            ~description:"Time to perform a single transaction" ~units:"ns";
       Times.invert times |> Stats.of_times
-      |> Stats.scale (Float.of_int (n_iter * 2) /. 1_000_000.0)
-      |> Stats.to_json ~name:"transactions over time"
+      |> Stats.scale (Float.of_int (n_ops * n_domains) /. 1_000_000.0)
+      |> Stats.to_json
+           ~name:(name "transactions over time")
            ~description:
              "Number of transactions performed over time using 2 domains"
            ~units:"M/s";
     ]
 
-let run_suite ~factor = run_one ~factor ()
+let run_suite ~factor =
+  [ 1; 2; 4 ]
+  |> List.concat_map @@ fun n_domains -> run_one ~n_domains ~factor ()