Skip to content

Commit e2822ff

Browse files
polytypicpolytypic
committed
Rewrite or refactor benchmarks using multicore-bench
1 parent 65211c5 commit e2822ff

29 files changed

+531
-469
lines changed

‎.dockerignore

+1
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
_build

‎Makefile

+1-1
Original file line numberDiff line numberDiff line change
@@ -10,4 +10,4 @@ clean:
1010
dune clean
1111

1212
bench:
13-
@dune exec --release -- ./bench/main.exe
13+
@dune exec --release -- ./bench/main.exe -budget 1

‎README.md

+2-1
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
1-
[API Reference](https://ocaml-multicore.github.io/saturn/)
1+
[API Reference](https://ocaml-multicore.github.io/saturn/) ·
2+
[Benchmarks](https://bench.ci.dev/ocaml-multicore/saturn/branch/main)
23

34
<!--
45
```ocaml

‎bench.Dockerfile

+10
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
FROM ocaml/opam:debian-ocaml-5.1
2+
RUN sudo ln -sf /usr/bin/opam-2.1 /usr/bin/opam
3+
WORKDIR bench-dir
4+
COPY *.opam ./
5+
RUN opam remote add origin https://github.com/ocaml/opam-repository.git && \
6+
opam update
7+
RUN opam pin -yn --with-version=dev .
8+
RUN opam install -y --deps-only --with-test .
9+
COPY . ./
10+
RUN opam exec -- dune build --release bench/main.exe

‎bench/README.md

+1-7
Original file line numberDiff line numberDiff line change
@@ -4,10 +4,4 @@ Benchmarks for Saturn
44

55
Execute `make bench` from root of the repository to run the standard set of
66
benchmarks. The output is in JSON, as it is intended to be consumed by
7-
ocaml-benchmark CI (in progress).
8-
9-
# Specific structures
10-
11-
Some benchmarks expose commandline interface targeting particular structures:
12-
13-
- [mpmc_queue.exe](mpmc_queue_cmd.ml)
7+
[current-bench](https://bench.ci.dev/ocaml-multicore/saturn/branch/main/benchmark/default).

‎bench/bench_queue.ml

+74
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,74 @@
1+
open Multicore_bench
2+
module Queue = Saturn_lockfree.Queue
3+
4+
let run_one_domain ~budgetf ?(n_msgs = 50 * Util.iter_factor) () =
5+
let t = Queue.create () in
6+
7+
let op push = if push then Queue.push t 101 else Queue.pop_opt t |> ignore in
8+
9+
let init _ =
10+
assert (Queue.is_empty t);
11+
Util.generate_push_and_pop_sequence n_msgs
12+
in
13+
let work _ bits = Util.Bits.iter op bits in
14+
15+
Times.record ~budgetf ~n_domains:1 ~init ~work ()
16+
|> Times.to_thruput_metrics ~n:n_msgs ~singular:"message" ~config:"one domain"
17+
18+
let run_one ~budgetf ?(n_adders = 2) ?(n_takers = 2)
19+
?(n_msgs = 50 * Util.iter_factor) () =
20+
let n_domains = n_adders + n_takers in
21+
22+
let t = Queue.create () in
23+
24+
let n_msgs_to_take = Atomic.make 0 |> Multicore_magic.copy_as_padded in
25+
let n_msgs_to_add = Atomic.make 0 |> Multicore_magic.copy_as_padded in
26+
27+
let init _ =
28+
assert (Queue.is_empty t);
29+
Atomic.set n_msgs_to_take n_msgs;
30+
Atomic.set n_msgs_to_add n_msgs
31+
in
32+
let work i () =
33+
if i < n_adders then
34+
let rec work () =
35+
let n = Util.alloc n_msgs_to_add in
36+
if 0 < n then begin
37+
for i = 1 to n do
38+
Queue.push t i
39+
done;
40+
work ()
41+
end
42+
in
43+
work ()
44+
else
45+
let rec work () =
46+
let n = Util.alloc n_msgs_to_take in
47+
if n <> 0 then
48+
let rec loop n =
49+
if 0 < n then
50+
loop (n - Bool.to_int (Option.is_some (Queue.pop_opt t)))
51+
else work ()
52+
in
53+
loop n
54+
in
55+
work ()
56+
in
57+
58+
let config =
59+
let format role n =
60+
Printf.sprintf "%d %s%s" n role (if n = 1 then "" else "s")
61+
in
62+
Printf.sprintf "%s, %s"
63+
(format "nb adder" n_adders)
64+
(format "nb taker" n_takers)
65+
in
66+
67+
Times.record ~budgetf ~n_domains ~init ~work ()
68+
|> Times.to_thruput_metrics ~n:n_msgs ~singular:"message" ~config
69+
70+
let run_suite ~budgetf =
71+
run_one_domain ~budgetf ()
72+
@ (Util.cross [ 1; 2 ] [ 1; 2 ]
73+
|> List.concat_map @@ fun (n_adders, n_takers) ->
74+
run_one ~budgetf ~n_adders ~n_takers ())

‎bench/bench_relaxed_queue.ml

+95
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,95 @@
1+
open Multicore_bench
2+
module Queue = Saturn.Relaxed_queue
3+
module Spin = Queue.Spin
4+
module Not_lockfree = Queue.Not_lockfree
5+
module CAS_interface = Queue.Not_lockfree.CAS_interface
6+
7+
let run_one ~budgetf ~n_adders ~n_takers ?(n_msgs = 50 * Util.iter_factor)
8+
?(api = `Spin) () =
9+
let n_domains = n_adders + n_takers in
10+
11+
let t = Queue.create ~size_exponent:10 () in
12+
13+
let n_msgs_to_take = Atomic.make 0 |> Multicore_magic.copy_as_padded in
14+
let n_msgs_to_add = Atomic.make 0 |> Multicore_magic.copy_as_padded in
15+
16+
let init _ =
17+
assert (Not_lockfree.pop t == None);
18+
Atomic.set n_msgs_to_take n_msgs;
19+
Atomic.set n_msgs_to_add n_msgs
20+
in
21+
let work i () =
22+
if i < n_adders then
23+
let rec work () =
24+
let n = Util.alloc n_msgs_to_add in
25+
if n <> 0 then begin
26+
match api with
27+
| `Spin ->
28+
for i = 1 to n do
29+
Spin.push t i
30+
done;
31+
work ()
32+
| `Not_lockfree ->
33+
let rec loop n =
34+
if 0 < n then loop (n - Bool.to_int (Not_lockfree.push t i))
35+
else work ()
36+
in
37+
loop n
38+
| `CAS_interface ->
39+
let rec loop n =
40+
if 0 < n then loop (n - Bool.to_int (CAS_interface.push t i))
41+
else work ()
42+
in
43+
loop n
44+
end
45+
in
46+
work ()
47+
else
48+
let rec work () =
49+
let n = Util.alloc n_msgs_to_take in
50+
if n <> 0 then
51+
match api with
52+
| `Spin ->
53+
for _ = 1 to n do
54+
Spin.pop t |> ignore
55+
done;
56+
work ()
57+
| `Not_lockfree ->
58+
let rec loop n =
59+
if 0 < n then
60+
loop (n - Bool.to_int (Option.is_some (Not_lockfree.pop t)))
61+
else work ()
62+
in
63+
loop n
64+
| `CAS_interface ->
65+
let rec loop n =
66+
if 0 < n then
67+
loop (n - Bool.to_int (Option.is_some (CAS_interface.pop t)))
68+
else work ()
69+
in
70+
loop n
71+
in
72+
work ()
73+
in
74+
75+
let config =
76+
let plural role n =
77+
Printf.sprintf "%d %s%s" n role (if n = 1 then "" else "s")
78+
in
79+
Printf.sprintf "%s, %s (%s)" (plural "adder" n_adders)
80+
(plural "taker" n_takers)
81+
(match api with
82+
| `Spin -> "spin"
83+
| `Not_lockfree -> "not lf"
84+
| `CAS_interface -> "cas")
85+
in
86+
87+
Times.record ~budgetf ~n_domains ~init ~work ()
88+
|> Times.to_thruput_metrics ~n:n_msgs ~singular:"message" ~config
89+
90+
let run_suite ~budgetf =
91+
Util.cross
92+
[ `Spin; `Not_lockfree; `CAS_interface ]
93+
(Util.cross [ 1; 2 ] [ 1; 2 ])
94+
|> List.concat_map @@ fun (api, (n_adders, n_takers)) ->
95+
run_one ~budgetf ~n_adders ~n_takers ~api ()

‎bench/bench_size.ml

+38
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,38 @@
1+
open Multicore_bench
2+
module Size = Saturn_lockfree.Size
3+
4+
let run_one ~budgetf ~n_domains ?(n_ops = 250 * n_domains * Util.iter_factor) ()
5+
=
6+
let t = Size.create () in
7+
8+
let n_ops_todo = Atomic.make 0 |> Multicore_magic.copy_as_padded in
9+
10+
let init _ = Atomic.set n_ops_todo n_ops in
11+
let work _ () =
12+
let rec work () =
13+
let n = Util.alloc n_ops_todo in
14+
if n <> 0 then
15+
let rec loop n =
16+
if 0 < n then begin
17+
let incr = Size.new_once t Size.incr in
18+
Size.update_once t incr;
19+
let decr = Size.new_once t Size.decr in
20+
Size.update_once t decr;
21+
loop (n - 2)
22+
end
23+
else work ()
24+
in
25+
loop n
26+
in
27+
work ()
28+
in
29+
30+
let config =
31+
Printf.sprintf "%d worker%s" n_domains (if n_domains = 1 then "" else "s")
32+
in
33+
Times.record ~budgetf ~n_domains ~init ~work ()
34+
|> Times.to_thruput_metrics ~n:n_ops ~config ~singular:"operation"
35+
36+
let run_suite ~budgetf =
37+
[ 1; 2; 4 ]
38+
|> List.concat_map @@ fun n_domains -> run_one ~n_domains ~budgetf ()

‎bench/bench_skiplist.ml

+67-54
Original file line numberDiff line numberDiff line change
@@ -1,57 +1,70 @@
1-
open Saturn
2-
3-
let workload num_elems num_threads add remove =
4-
let sl = Skiplist.create ~compare:Int.compare () in
5-
let elems = Array.init num_elems (fun _ -> Random.int 10000) in
6-
let push () =
7-
Domain.spawn (fun () ->
8-
let start_time = Unix.gettimeofday () in
9-
for i = 0 to (num_elems - 1) / num_threads do
10-
Domain.cpu_relax ();
11-
let prob = Random.float 1.0 in
12-
if prob < add then Skiplist.try_add sl (Random.int 10000) () |> ignore
13-
else if prob >= add && prob < add +. remove then
14-
Skiplist.try_remove sl (Random.int 10000) |> ignore
15-
else Skiplist.mem sl elems.(i) |> ignore
16-
done;
17-
start_time)
1+
open Multicore_bench
2+
module Skiplist = Saturn.Skiplist
3+
4+
let run_one ~budgetf ~n_domains ?(n_ops = 20 * Util.iter_factor)
5+
?(n_keys = 10000) ~percent_mem ?(percent_add = (100 - percent_mem + 1) / 2)
6+
?(prepopulate = true) () =
7+
let percent_rem = 100 - (percent_mem + percent_add) in
8+
9+
let limit_mem = percent_mem in
10+
let limit_add = percent_mem + percent_add in
11+
12+
assert (0 <= limit_mem && limit_mem <= 100);
13+
assert (limit_mem <= limit_add && limit_add <= 100);
14+
15+
let t = Skiplist.create ~compare:Int.compare () in
16+
if prepopulate then
17+
for _ = 1 to n_keys do
18+
let value = Random.bits () in
19+
let key = value mod n_keys in
20+
Skiplist.try_add t key value |> ignore
21+
done;
22+
23+
let n_ops = (100 + percent_mem) * n_ops / 100 in
24+
let n_ops = n_ops * n_domains in
25+
26+
let n_ops_todo = Atomic.make 0 |> Multicore_magic.copy_as_padded in
27+
28+
let init _ =
29+
Atomic.set n_ops_todo n_ops;
30+
Random.State.make_self_init ()
1831
in
19-
let threads = List.init num_threads (fun _ -> push ()) in
20-
let start_time_threads =
21-
List.map (fun domain -> Domain.join domain) threads
32+
let work _ state =
33+
let rec work () =
34+
let n = Util.alloc n_ops_todo in
35+
if n <> 0 then
36+
let rec loop n =
37+
if 0 < n then
38+
let value = Random.State.bits state in
39+
let op = (value asr 20) mod 100 in
40+
let key = value mod n_keys in
41+
if op < limit_mem then begin
42+
Skiplist.mem t key |> ignore;
43+
loop (n - 1)
44+
end
45+
else if op < limit_add then begin
46+
Skiplist.try_add t key value |> ignore;
47+
loop (n - 1)
48+
end
49+
else begin
50+
Skiplist.try_remove t key |> ignore;
51+
loop (n - 1)
52+
end
53+
else work ()
54+
in
55+
loop n
56+
in
57+
work ()
2258
in
23-
let end_time = Unix.gettimeofday () in
24-
let time_diff = end_time -. List.nth start_time_threads 0 in
25-
time_diff
26-
27-
(* A write heavy workload with threads with 50% adds and 50% removes. *)
28-
let write_heavy_workload num_elems num_threads =
29-
workload num_elems num_threads 0.5 0.5
30-
31-
(* A regular workload with 90% reads, 9% adds and 1% removes. *)
32-
let read_heavy_workload num_elems num_threads =
33-
workload num_elems num_threads 0.09 0.01
34-
35-
let moderate_heavy_workload num_elems num_threads =
36-
workload num_elems num_threads 0.2 0.1
37-
38-
let balanced_heavy_workload num_elems num_threads =
39-
workload num_elems num_threads 0.3 0.2
40-
41-
let bench ~workload_type ~num_elems ~num_threads () =
42-
let workload =
43-
if workload_type = "read_heavy" then read_heavy_workload
44-
else if workload_type = "moderate_heavy" then moderate_heavy_workload
45-
else if workload_type = "balanced_heavy" then balanced_heavy_workload
46-
else write_heavy_workload
59+
60+
let config =
61+
Printf.sprintf "%d workers, %d%% mem %d%% add %d%% rem" n_domains
62+
percent_mem percent_add percent_rem
4763
in
48-
let results = ref [] in
49-
for i = 1 to 10 do
50-
let time = workload num_elems num_threads in
51-
if i > 1 then results := time :: !results
52-
done;
53-
let results = List.sort Float.compare !results in
54-
let median_time = List.nth results 4 in
55-
let median_throughput = Float.of_int num_elems /. median_time in
56-
Benchmark_result.create_generic ~median_time ~median_throughput
57-
("atomic_skiplist_" ^ workload_type)
64+
Times.record ~budgetf ~n_domains ~init ~work ()
65+
|> Times.to_thruput_metrics ~n:n_ops ~singular:"operation" ~config
66+
67+
let run_suite ~budgetf =
68+
Util.cross [ 10; 50; 90 ] [ 1; 2; 4 ]
69+
|> List.concat_map @@ fun (percent_mem, n_domains) ->
70+
run_one ~budgetf ~n_domains ~percent_mem ()

0 commit comments

Comments
 (0)