From 969ddad3ac26dc32142f9574f3ae03cff2cfbe27 Mon Sep 17 00:00:00 2001 From: Vesa Karvonen Date: Sun, 10 Mar 2024 17:35:07 +0200 Subject: [PATCH] Upgrade to multicore-bench 0.1.2 The Stdlib benchmarks now live in multicore-bench. --- README.md | 3 +- bench/bench_atomic.ml | 55 ------------------------------ bench/bench_ref.ml | 70 -------------------------------------- bench/bench_ref_mutex.ml | 72 ---------------------------------------- bench/dune | 2 ++ bench/main.ml | 3 -- dune-project | 2 +- kcas_data.opam | 2 +- 8 files changed, 6 insertions(+), 203 deletions(-) delete mode 100644 bench/bench_atomic.ml delete mode 100644 bench/bench_ref.ml delete mode 100644 bench/bench_ref_mutex.ml diff --git a/README.md b/README.md index 5071b545..c845ec14 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,6 @@ [API reference](https://ocaml-multicore.github.io/kcas/doc/) · -[Benchmarks](https://bench.ci.dev/ocaml-multicore/kcas/branch/main/benchmark/default) +[Benchmarks](https://bench.ci.dev/ocaml-multicore/kcas/branch/main) · +[Stdlib Benchmarks](https://bench.ci.dev/ocaml-multicore/multicore-bench/branch/main)
diff --git a/bench/bench_atomic.ml b/bench/bench_atomic.ml deleted file mode 100644 index 41af3679..00000000 --- a/bench/bench_atomic.ml +++ /dev/null @@ -1,55 +0,0 @@ -open Multicore_bench - -module Atomic = struct - include Stdlib.Atomic - - let rec modify ?(backoff = Backoff.default) x f = - let before = Atomic.get x in - let after = f before in - if not (Atomic.compare_and_set x before after) then - modify ~backoff:(Backoff.once backoff) x f -end - -type t = - | Op : string * int * 'a * ('a Atomic.t -> unit) * ('a Atomic.t -> unit) -> t - -let run_one ~budgetf ?(n_iter = 500 * Util.iter_factor) - (Op (name, extra, value, op1, op2)) = - let n_iter = n_iter * extra in - - let loc = Atomic.make value in - - let init _ = () in - let work _ () = - let rec loop i = - if i > 0 then begin - op1 loc; - op2 loc; - loop (i - 2) - end - in - loop n_iter - in - - Times.record ~budgetf ~n_domains:1 ~init ~work () - |> Times.to_thruput_metrics ~n:n_iter ~singular:"op" ~config:name - -let run_suite ~budgetf = - [ - (let get x = Atomic.get x |> ignore in - Op ("get", 10, 42, get, get)); - (let incr x = Atomic.incr x in - Op ("incr", 1, 0, incr, incr)); - (let push x = Atomic.modify x (fun xs -> 101 :: xs) - and pop x = Atomic.modify x (function [] -> [] | _ :: xs -> xs) in - Op ("push & pop", 2, [], push, pop)); - (let cas01 x = Atomic.compare_and_set x 0 1 |> ignore - and cas10 x = Atomic.compare_and_set x 1 0 |> ignore in - Op ("cas int", 1, 0, cas01, cas10)); - (let xchg1 x = Atomic.exchange x 1 |> ignore - and xchg0 x = Atomic.exchange x 0 |> ignore in - Op ("xchg int", 1, 0, xchg1, xchg0)); - (let swap x = Atomic.modify x (fun (x, y) -> (y, x)) in - Op ("swap", 2, (4, 2), swap, swap)); - ] - |> List.concat_map @@ run_one ~budgetf diff --git a/bench/bench_ref.ml b/bench/bench_ref.ml deleted file mode 100644 index 93ed9281..00000000 --- a/bench/bench_ref.ml +++ /dev/null @@ -1,70 +0,0 @@ -open Multicore_bench - -module Ref = struct - type 'a t = 'a ref - - let make = ref - let get = ( ! ) - let[@poll error] [@inline never] incr x = x := !x + 1 - - let[@poll error] [@inline never] compare_and_set x before after = - !x == before - && begin - x := after; - true - end - - let[@poll error] [@inline never] exchange x after = - let before = !x in - x := after; - before - - let rec modify ?(backoff = Backoff.default) x f = - let before = get x in - let after = f before in - if not (compare_and_set x before after) then - modify ~backoff:(Backoff.once backoff) x f -end - -type t = Op : string * int * 'a * ('a Ref.t -> unit) * ('a Ref.t -> unit) -> t - -let run_one ~budgetf ?(n_iter = 500 * Util.iter_factor) - (Op (name, extra, value, op1, op2)) = - let n_iter = n_iter * extra in - - let loc = Ref.make value in - - let init _ = () in - let work _ () = - let rec loop i = - if i > 0 then begin - op1 loc; - op2 loc; - loop (i - 2) - end - in - loop n_iter - in - - Times.record ~budgetf ~n_domains:1 ~init ~work () - |> Times.to_thruput_metrics ~n:n_iter ~singular:"op" ~config:name - -let run_suite ~budgetf = - [ - (let get x = Ref.get x |> ignore in - Op ("get", 10, 42, get, get)); - (let incr x = Ref.incr x in - Op ("incr", 1, 0, incr, incr)); - (let push x = Ref.modify x (fun xs -> 101 :: xs) - and pop x = Ref.modify x (function [] -> [] | _ :: xs -> xs) in - Op ("push & pop", 2, [], push, pop)); - (let cas01 x = Ref.compare_and_set x 0 1 |> ignore - and cas10 x = Ref.compare_and_set x 1 0 |> ignore in - Op ("cas int", 1, 0, cas01, cas10)); - (let xchg1 x = Ref.exchange x 1 |> ignore - and xchg0 x = Ref.exchange x 0 |> ignore in - Op ("xchg int", 1, 0, xchg1, xchg0)); - (let swap x = Ref.modify x (fun (x, y) -> (y, x)) in - Op ("swap", 2, (4, 2), swap, swap)); - ] - |> List.concat_map @@ run_one ~budgetf diff --git a/bench/bench_ref_mutex.ml b/bench/bench_ref_mutex.ml deleted file mode 100644 index 565b715e..00000000 --- a/bench/bench_ref_mutex.ml +++ /dev/null @@ -1,72 +0,0 @@ -open Multicore_bench - -module Ref = struct - type 'a t = 'a ref - - let make = ref - - let[@inline] compare_and_set x before after = - !x == before - && begin - x := after; - true - end - - let[@inline] exchange x after = - let before = !x in - x := after; - before -end - -type t = Op : string * 'a * ('a Ref.t -> unit) * ('a Ref.t -> unit) -> t - -(** For some reason allocating the mutex inside [run_one] tends to cause - performance hiccups, i.e. some operations appear to be 10x slower than - others, which doesn't make sense. So, we allocate the mutex here. *) -let mutex = Mutex.create () - -let run_one ~budgetf ?(n_iter = 250 * Util.iter_factor) - (Op (name, value, op1, op2)) = - let loc = Ref.make value in - - let init _ = () in - let work _ () = - let rec loop i = - if i > 0 then begin - Mutex.lock mutex; - op1 loc; - Mutex.unlock mutex; - Mutex.lock mutex; - op2 loc; - Mutex.unlock mutex; - loop (i - 2) - end - in - loop n_iter - in - - Times.record ~budgetf ~n_domains:1 ~init ~work () - |> Times.to_thruput_metrics ~n:n_iter ~singular:"op" ~config:name - -let run_suite ~budgetf = - [ - (let get x = !x |> ignore in - Op ("get", 42, get, get)); - (let incr x = x := !x + 1 in - Op ("incr", 0, incr, incr)); - (let push x = x := 101 :: !x - and pop x = match !x with [] -> () | _ :: xs -> x := xs in - Op ("push & pop", [], push, pop)); - (let cas01 x = Ref.compare_and_set x 0 1 |> ignore - and cas10 x = Ref.compare_and_set x 1 0 |> ignore in - Op ("cas int", 0, cas01, cas10)); - (let xchg1 x = Ref.exchange x 1 |> ignore - and xchg0 x = Ref.exchange x 0 |> ignore in - Op ("xchg int", 0, xchg1, xchg0)); - (let swap x = - let l, r = !x in - x := (r, l) - in - Op ("swap", (4, 2), swap, swap)); - ] - |> List.concat_map @@ run_one ~budgetf diff --git a/bench/dune b/bench/dune index a83c16c3..cd97da36 100644 --- a/bench/dune +++ b/bench/dune @@ -11,6 +11,8 @@ let () = (test (name main) (package kcas_data) + (action + (run %{test} -brief)) (libraries kcas_data multicore-bench diff --git a/bench/main.ml b/bench/main.ml index 633f822e..bae69dbd 100644 --- a/bench/main.ml +++ b/bench/main.ml @@ -1,8 +1,5 @@ let benchmarks = [ - ("Ref with [@poll error]", Bench_ref.run_suite); - ("Ref with Mutex", Bench_ref_mutex.run_suite); - ("Atomic", Bench_atomic.run_suite); ("Kcas Loc", Bench_loc.run_suite); ("Kcas Xt", Bench_xt.run_suite); ("Kcas Xt read-only", Bench_xt_ro.run_suite); diff --git a/dune-project b/dune-project index 39bea0f6..fd8fed23 100644 --- a/dune-project +++ b/dune-project @@ -86,7 +86,7 @@ :with-test)) (multicore-bench (and - (>= 0.1.1) + (>= 0.1.2) :with-test)) (alcotest (and diff --git a/kcas_data.opam b/kcas_data.opam index 2745d885..0791b04d 100644 --- a/kcas_data.opam +++ b/kcas_data.opam @@ -22,7 +22,7 @@ depends: [ "backoff" {>= "0.1.0" & with-test} "domain-local-await" {>= "1.0.1" & with-test} "domain_shims" {>= "0.1.0" & with-test} - "multicore-bench" {>= "0.1.1" & with-test} + "multicore-bench" {>= "0.1.2" & with-test} "alcotest" {>= "1.7.0" & with-test} "qcheck-core" {>= "0.21.2" & with-test} "qcheck-stm" {>= "0.3" & with-test}