Add a minimalist Unix IO benchmark

polytypic · polytypic · commit b79ac0364ac9 · 2024-04-09T10:27:16.000+03:00
diff --git a/bench/bench_unix.ml b/bench/bench_unix.ml
@@ -0,0 +1,32 @@
+open Multicore_bench
+
+let run_one ~budgetf ~n_domains () =
+  let n_bytes = 65536 in
+
+  let init _ =
+    let inn, out = Unix.pipe ~cloexec:true () in
+    (inn, out, Bytes.create 1)
+  in
+  let work _ (inn, out, byte) =
+    let n = Unix.write out (Bytes.create n_bytes) 0 n_bytes in
+    assert (n = n_bytes);
+    for _ = 1 to n_bytes do
+      let n : int = Unix.read inn byte 0 1 in
+      assert (n = 1)
+    done;
+    Unix.close inn;
+    Unix.close out
+  in
+
+  let config =
+    Printf.sprintf "%d worker%s" n_domains (if n_domains = 1 then "" else "s")
+  in
+  Times.record ~budgetf ~n_domains ~n_warmups:1 ~n_runs_min:1 ~init ~work ()
+  |> Times.to_thruput_metrics ~n:(n_bytes * n_domains) ~singular:"blocking read"
+       ~config
+
+let run_suite ~budgetf =
+  [ 1; 2; 4 ]
+  |> List.concat_map @@ fun n_domains ->
+     if Sys.win32 || Domain.recommended_domain_count () < n_domains then []
+     else run_one ~budgetf ~n_domains ()
diff --git a/bench/dune b/bench/dune
@@ -15,6 +15,7 @@ let () =
  (libraries
   multicore-bench
   backoff
+  unix
   multicore-magic |}
   ^ maybe_domain_shims_and_threads ^ {| ))
 |}
diff --git a/bench/main.ml b/bench/main.ml
@@ -5,6 +5,7 @@ let benchmarks =
     ("Atomic", Bench_atomic.run_suite);
     ("Queue", Bench_queue.run_suite);
     ("Stack", Bench_stack.run_suite);
+    ("Unix", Bench_unix.run_suite);
   ]
 
 let () = Multicore_bench.Cmd.run ~benchmarks ()

Original file line number	Diff line number	Diff line change
`@@ -5,6 +5,7 @@ let benchmarks =`
`5`	`5`	`("Atomic", Bench_atomic.run_suite);`
`6`	`6`	`("Queue", Bench_queue.run_suite);`
`7`	`7`	`("Stack", Bench_stack.run_suite);`
	`8`	`+ ("Unix", Bench_unix.run_suite);`
`8`	`9`	`]`
`9`	`10`
`10`	`11`	`let () = Multicore_bench.Cmd.run ~benchmarks ()`