diff --git a/bench/barrier.ml b/bench/barrier.ml deleted file mode 100644 index 6bfe7a88..00000000 --- a/bench/barrier.ml +++ /dev/null @@ -1,13 +0,0 @@ -type t = { counter : int Atomic.t; total : int } - -let make total = - { counter = Atomic.make 0 |> Multicore_magic.copy_as_padded; total } - |> Multicore_magic.copy_as_padded - -let await { counter; total } = - if Atomic.get counter = total then - Atomic.compare_and_set counter total 0 |> ignore; - Atomic.incr counter; - while Atomic.get counter < total do - Domain.cpu_relax () - done diff --git a/bench/barrier.mli b/bench/barrier.mli deleted file mode 100644 index 44b0eb33..00000000 --- a/bench/barrier.mli +++ /dev/null @@ -1,4 +0,0 @@ -type t - -val make : int -> t -val await : t -> unit diff --git a/bench/bench.ml b/bench/bench.ml deleted file mode 100644 index e54a2c1b..00000000 --- a/bench/bench.ml +++ /dev/null @@ -1,174 +0,0 @@ -module Times = struct - type t = { inverted : bool; times : float array; runs : int } - - let record ~n_domains ~budgetf ?(n_warmups = 3) ?(n_runs_min = 7) - ?(before = Fun.id) ~init ~work ?(after = Fun.id) () = - let barrier_init = Barrier.make n_domains in - let barrier_before = Barrier.make n_domains in - let barrier_after = Barrier.make n_domains in - let results = - Array.init n_domains @@ fun _ -> - Stack.create () |> Multicore_magic.copy_as_padded - in - let budget_used = ref false |> Multicore_magic.copy_as_padded in - let runs = ref 0 |> Multicore_magic.copy_as_padded in - Gc.full_major (); - let budget_start = Mtime_clock.elapsed () in - let prepare_for_await () = - let open struct - type state = Init | Released | Awaiting of { mutable released : bool } - end in - let state = Atomic.make Init in - let release () = - if Multicore_magic.fenceless_get state != Released then - match Atomic.exchange state Released with - | Awaiting r -> r.released <- true - | _ -> () - in - let await () = - if Multicore_magic.fenceless_get state != Released then - let awaiting = Awaiting { released = false } in - if Atomic.compare_and_set state Init awaiting then - match awaiting with - | Awaiting r -> - (* Avoid sleeping *) - while not r.released do - Domain.cpu_relax () - done - | _ -> () - in - Domain_local_await.{ release; await } - in - let main domain_i = - Domain_local_await.using ~prepare_for_await ~while_running:(fun () -> - for _ = 1 to n_warmups do - if domain_i = 0 then begin - before (); - Gc.major () - end; - let state = init domain_i in - Barrier.await barrier_before; - work domain_i state; - Barrier.await barrier_after; - if domain_i = 0 then after () - done; - while !runs < n_runs_min || not !budget_used do - Barrier.await barrier_init; - if domain_i = 0 then begin - before (); - if - let budget_stop = Mtime_clock.elapsed () in - let elapsedf = - Mtime.Span.to_float_ns - (Mtime.Span.abs_diff budget_stop budget_start) - *. (1. /. 1_000_000_000.0) - in - budgetf < elapsedf - then budget_used := true; - incr runs; - Gc.major () - end; - let state = init domain_i in - Barrier.await barrier_before; - let start = Mtime_clock.elapsed () in - work domain_i state; - let stop = Mtime_clock.elapsed () in - Barrier.await barrier_after; - if domain_i = 0 then after (); - Stack.push - (Mtime.Span.to_float_ns (Mtime.Span.abs_diff stop start) - *. (1. /. 1_000_000_000.0)) - results.(domain_i) - done) - in - let domains = - Array.init n_domains @@ fun domain_i -> - Domain.spawn @@ fun () -> main domain_i - in - Array.iter Domain.join domains; - let n = Stack.length results.(0) in - let times = Array.create_float n in - for run_i = 0 to n - 1 do - times.(run_i) <- 0.0; - for domain_i = 0 to n_domains - 1 do - times.(run_i) <- times.(run_i) +. Stack.pop results.(domain_i) - done - done; - { inverted = false; times; runs = !runs } - - let invert { inverted; times; runs } = - { - inverted = not inverted; - times = Array.map (fun v -> 1.0 /. v) times; - runs; - } -end - -module Stats = struct - type t = { - mean : float; - median : float; - sd : float; - inverted : bool; - best : float; - runs : int; - } - - let scale factor { mean; median; sd; inverted; best; runs } = - { - mean = mean *. factor; - median = median *. factor; - sd = sd *. factor; - inverted; - best = best *. factor; - runs; - } - - let mean_of times = - Array.fold_left ( +. ) 0.0 times /. Float.of_int (Array.length times) - - let sd_of times mean = - Float.sqrt - (mean_of (Array.map (fun v -> Float.abs (v -. mean) ** 2.) times)) - - let median_of times = - Array.sort Float.compare times; - let n = Array.length times in - if n land 1 = 0 then (times.((n asr 1) - 1) +. times.(n asr 1)) /. 2.0 - else times.(n asr 1) - - let of_times Times.{ inverted; times; runs } = - let mean = mean_of times in - let sd = sd_of times mean in - let median = median_of times in - let best = - if inverted then Array.fold_left Float.max Float.min_float times - else Array.fold_left Float.min Float.max_float times - in - { mean; sd; median; inverted; best; runs } - - let to_nonbreaking s = - s |> String.split_on_char ' ' - |> String.concat " " (* a non-breaking space *) - - let to_json ~name ~description ~units t = - let trend = - if t.inverted then `String "higher-is-better" - else `String "lower-is-better" - in - [ - `Assoc - [ - ("name", `String (to_nonbreaking name)); - ("value", `Float t.median); - ("units", `String units); - ("trend", trend); - ("description", `String description); - ("#best", `Float t.best); - ("#mean", `Float t.mean); - ("#median", `Float t.median); - ("#sd", `Float t.sd); - ("#runs", `Int t.runs); - ]; - ] -end diff --git a/bench/bench.mli b/bench/bench.mli deleted file mode 100644 index 5d8e2bf5..00000000 --- a/bench/bench.mli +++ /dev/null @@ -1,27 +0,0 @@ -module Times : sig - type t - - val record : - n_domains:int -> - budgetf:float -> - ?n_warmups:int -> - ?n_runs_min:int -> - ?before:(unit -> unit) -> - init:(int -> 's) -> - work:(int -> 's -> unit) -> - ?after:(unit -> unit) -> - unit -> - t - - val invert : t -> t -end - -module Stats : sig - type t - - val of_times : Times.t -> t - val scale : float -> t -> t - - val to_json : - name:string -> description:string -> units:string -> t -> Yojson.Safe.t list -end diff --git a/bench/bench_accumulator.ml b/bench/bench_accumulator.ml index 708c8776..488ab256 100644 --- a/bench/bench_accumulator.ml +++ b/bench/bench_accumulator.ml @@ -1,5 +1,5 @@ open Kcas_data -open Bench +open Multicore_bench let run_one ~budgetf ~n_domains ?(n_ops = 180 * Util.iter_factor) () = let n_ops = n_ops * n_domains in @@ -29,28 +29,13 @@ let run_one ~budgetf ~n_domains ?(n_ops = 180 * Util.iter_factor) () = let after () = Atomic.set n_ops_todo n_ops in - let times = Times.record ~n_domains ~budgetf ~init ~work ~after () in - - let name metric = - Printf.sprintf "%s/%d worker%s, 0%% reads" metric n_domains + let config = + Printf.sprintf "%d worker%s, 0%% reads" 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_ops) - |> Stats.to_json - ~name:(name "time per operation") - ~description:"Average time to increment accumulator" ~units:"ns"; - Times.invert times |> Stats.of_times - |> Stats.scale (Float.of_int (n_ops * n_domains) /. 1_000_000.0) - |> Stats.to_json - ~name:(name "operations over time") - ~description: - "Number of operations performed over time using all domains" - ~units:"M/s"; - ] + Times.record ~budgetf ~n_domains ~init ~work ~after () + |> Util.thruput_metrics ~n:n_ops ~config ~singular:"operation" let run_suite ~budgetf = [ 1; 2; 4 ] diff --git a/bench/bench_atomic.ml b/bench/bench_atomic.ml index 907c8cb8..32e9dc51 100644 --- a/bench/bench_atomic.ml +++ b/bench/bench_atomic.ml @@ -1,4 +1,4 @@ -open Bench +open Multicore_bench module Atomic = struct include Stdlib.Atomic @@ -31,21 +31,8 @@ let run_one ~budgetf ?(n_iter = 500 * Util.iter_factor) loop n_iter in - let times = Times.record ~n_domains:1 ~budgetf ~init ~work () in - - List.concat - [ - Stats.of_times times - |> Stats.scale (1_000_000_000.0 /. Float.of_int n_iter) - |> Stats.to_json - ~name:(Printf.sprintf "time per op/%s" name) - ~description:"Time to perform a single op" ~units:"ns"; - Times.invert times |> Stats.of_times - |> Stats.scale (Float.of_int n_iter /. 1_000_000.0) - |> Stats.to_json - ~name:(Printf.sprintf "ops over time/%s" name) - ~description:"Number of operations performed over time" ~units:"M/s"; - ] + Times.record ~budgetf ~n_domains:1 ~init ~work () + |> Util.thruput_metrics ~n:n_iter ~singular:"op" ~config:name let run_suite ~budgetf = [ diff --git a/bench/bench_dllist.ml b/bench/bench_dllist.ml index 8fe43831..1a3d8084 100644 --- a/bench/bench_dllist.ml +++ b/bench/bench_dllist.ml @@ -1,37 +1,21 @@ open Kcas_data -open Bench +open Multicore_bench let run_single ~budgetf ?(n_msgs = 15 * Util.iter_factor) () = let t = Dllist.create () in - let init _ = () in - let work _ () = - for i = 1 to n_msgs do - Dllist.add_l i t |> ignore; - Dllist.take_r t |> ignore - done + let op push = + if push then Dllist.add_l 101 t |> ignore else Dllist.take_opt_r t |> ignore in - let times = Times.record ~n_domains:1 ~budgetf ~init ~work () in - - let name metric = Printf.sprintf "%s/one domain" metric in + let init _ = + assert (Dllist.is_empty t); + Util.generate_push_and_pop_sequence n_msgs + in + let work _ bits = Util.Bits.iter op bits in - List.concat - [ - Stats.of_times times - |> Stats.scale (1_000_000_000.0 /. Float.of_int n_msgs) - |> Stats.to_json ~name:(name "time per message") - ~description: - "Time to transmit one message from one domain to another" - ~units:"ns"; - Times.invert times |> Stats.of_times - |> Stats.scale (Float.of_int n_msgs /. 1_000_000.0) - |> Stats.to_json - ~name:(name "messages over time") - ~description: - "Number of messages transmitted over time using all domains" - ~units:"M/s"; - ] + Times.record ~budgetf ~n_domains:1 ~init ~work () + |> Util.thruput_metrics ~n:n_msgs ~singular:"message" ~config:"one domain" let run_one ~budgetf ?(n_adders = 2) ?(n_takers = 2) ?(factor = 1) ?(n_msgs = 20 * factor * Util.iter_factor) () = @@ -39,10 +23,14 @@ let run_one ~budgetf ?(n_adders = 2) ?(n_takers = 2) ?(factor = 1) let t = Dllist.create () in - let n_msgs_to_take = Atomic.make n_msgs |> Multicore_magic.copy_as_padded in - let n_msgs_to_add = Atomic.make n_msgs |> Multicore_magic.copy_as_padded in + let n_msgs_to_take = Atomic.make 0 |> Multicore_magic.copy_as_padded in + let n_msgs_to_add = Atomic.make 0 |> Multicore_magic.copy_as_padded in - let init _ = () in + let init _ = + assert (Dllist.is_empty t); + Atomic.set n_msgs_to_take n_msgs; + Atomic.set n_msgs_to_add n_msgs + in let work i () = if i < n_adders then let rec work () = @@ -69,41 +57,21 @@ let run_one ~budgetf ?(n_adders = 2) ?(n_takers = 2) ?(factor = 1) in work () in - let after () = - Atomic.set n_msgs_to_take n_msgs; - Atomic.set n_msgs_to_add n_msgs - in - - let times = Times.record ~n_domains ~budgetf ~init ~work ~after () in - let name metric = + let config = let format role blocking n = Printf.sprintf "%d %s%s%s" n (if blocking then "" else "nb ") role (if n = 1 then "" else "s") in - Printf.sprintf "%s/%s, %s" metric + Printf.sprintf "%s, %s" (format "adder" false n_adders) (format "taker" false n_takers) in - List.concat - [ - Stats.of_times times - |> Stats.scale (1_000_000_000.0 /. Float.of_int n_msgs) - |> Stats.to_json ~name:(name "time per message") - ~description: - "Time to transmit one message from one domain to another" - ~units:"ns"; - Times.invert times |> Stats.of_times - |> Stats.scale (Float.of_int (n_msgs * n_domains) /. 1_000_000.0) - |> Stats.to_json - ~name:(name "messages over time") - ~description: - "Number of messages transmitted over time using all domains" - ~units:"M/s"; - ] + Times.record ~budgetf ~n_domains ~init ~work () + |> Util.thruput_metrics ~n:n_msgs ~singular:"message" ~config let run_suite ~budgetf = run_single ~budgetf () diff --git a/bench/bench_hashtbl.ml b/bench/bench_hashtbl.ml index cf7685e5..5b80a822 100644 --- a/bench/bench_hashtbl.ml +++ b/bench/bench_hashtbl.ml @@ -1,5 +1,5 @@ open Kcas_data -open Bench +open Multicore_bench module Int = struct include Int @@ -48,30 +48,14 @@ let run_one ~budgetf ~n_domains ?(n_ops = 40 * Util.iter_factor) in let after () = Atomic.set n_ops_todo n_ops in - let times = Times.record ~n_domains ~budgetf ~init ~work ~after () in - - let name metric = - Printf.sprintf "%s/%d worker%s, %d%% reads" metric n_domains + let config = + Printf.sprintf "%d worker%s, %d%% reads" n_domains (if n_domains = 1 then "" else "s") percent_read in - List.concat - [ - Stats.of_times times - |> Stats.scale (1_000_000_000.0 /. Float.of_int n_ops) - |> Stats.to_json - ~name:(name "time per operation") - ~description:"Average time to find, remove, or add a binding" - ~units:"ns"; - Times.invert times |> Stats.of_times - |> Stats.scale (Float.of_int (n_ops * n_domains) /. 1_000_000.0) - |> Stats.to_json - ~name:(name "operations over time") - ~description: - "Number of operations performed over time using all domains" - ~units:"M/s"; - ] + Times.record ~budgetf ~n_domains ~init ~work ~after () + |> Util.thruput_metrics ~n:n_ops ~singular:"operation" ~config let run_suite ~budgetf = Util.cross [ 90; 50; 10 ] [ 1; 2; 4 ] diff --git a/bench/bench_loc.ml b/bench/bench_loc.ml index 674a1904..f9a531d6 100644 --- a/bench/bench_loc.ml +++ b/bench/bench_loc.ml @@ -1,5 +1,5 @@ open Kcas -open Bench +open Multicore_bench type t = Op : string * int * 'a * ('a Loc.t -> unit) * ('a Loc.t -> unit) -> t @@ -21,21 +21,8 @@ let run_one ~budgetf ?(n_iter = 250 * Util.iter_factor) loop n_iter in - let times = Times.record ~n_domains:1 ~budgetf ~init ~work () in - - List.concat - [ - Stats.of_times times - |> Stats.scale (1_000_000_000.0 /. Float.of_int n_iter) - |> Stats.to_json - ~name:(Printf.sprintf "time per op/%s" name) - ~description:"Time to perform a single op" ~units:"ns"; - Times.invert times |> Stats.of_times - |> Stats.scale (Float.of_int n_iter /. 1_000_000.0) - |> Stats.to_json - ~name:(Printf.sprintf "ops over time/%s" name) - ~description:"Number of operations performed over time" ~units:"M/s"; - ] + Times.record ~budgetf ~n_domains:1 ~init ~work () + |> Util.thruput_metrics ~n:n_iter ~singular:"op" ~config:name let run_suite ~budgetf = [ diff --git a/bench/bench_mvar.ml b/bench/bench_mvar.ml index e448ea0d..93eab205 100644 --- a/bench/bench_mvar.ml +++ b/bench/bench_mvar.ml @@ -1,5 +1,5 @@ open Kcas_data -open Bench +open Multicore_bench let run_one ~budgetf ?(n_adders = 2) ?(blocking_add = false) ?(n_takers = 2) ?(blocking_take = false) ?(n_msgs = 2 * Util.iter_factor) () = @@ -67,36 +67,20 @@ let run_one ~budgetf ?(n_adders = 2) ?(blocking_add = false) ?(n_takers = 2) Atomic.set n_msgs_to_add n_msgs in - let times = Times.record ~n_domains ~budgetf ~init ~work ~after () in - - let name metric = + let config = let format role blocking n = Printf.sprintf "%d %s%s%s" n (if blocking then "" else "nb ") role (if n = 1 then "" else "s") in - Printf.sprintf "%s/%s, %s" metric + Printf.sprintf "%s, %s" (format "adder" blocking_add n_adders) (format "taker" blocking_take n_takers) in - List.concat - [ - Stats.of_times times - |> Stats.scale (1_000_000_000.0 /. Float.of_int n_msgs) - |> Stats.to_json ~name:(name "time per message") - ~description: - "Time to transmit one message from one domain to another" - ~units:"ns"; - Times.invert times |> Stats.of_times - |> Stats.scale (Float.of_int (n_msgs * n_domains) /. 1_000_000.0) - |> Stats.to_json - ~name:(name "messages over time") - ~description: - "Number of messages transmitted over time using all domains" - ~units:"M/s"; - ] + Times.record ~budgetf ~n_domains ~init ~work ~after () + |> Util.thruput_metrics ~n:n_msgs ~singular:"message" ~config let run_suite ~budgetf = Util.cross diff --git a/bench/bench_parallel_cmp.ml b/bench/bench_parallel_cmp.ml index f2137816..072be81a 100644 --- a/bench/bench_parallel_cmp.ml +++ b/bench/bench_parallel_cmp.ml @@ -1,5 +1,5 @@ open Kcas -open Bench +open Multicore_bench let run_one ~budgetf ~n_domains ?(n_ops = 50 * Util.iter_factor) () = let n_ops = n_ops * n_domains in @@ -37,28 +37,12 @@ let run_one ~budgetf ~n_domains ?(n_ops = 50 * Util.iter_factor) () = let after () = Atomic.set n_ops_todo n_ops in - let times = Times.record ~n_domains ~budgetf ~init ~work ~after () in - - let name metric = - Printf.sprintf "%s/%d worker%s" metric n_domains - (if n_domains = 1 then "" else "s") + let config = + Printf.sprintf "%d worker%s" 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_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_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"; - ] + Times.record ~budgetf ~n_domains ~init ~work ~after () + |> Util.thruput_metrics ~n:n_ops ~singular:"transaction" ~config let run_suite ~budgetf = [ 1; 2; 4 ] diff --git a/bench/bench_queue.ml b/bench/bench_queue.ml index 571859b0..04850106 100644 --- a/bench/bench_queue.ml +++ b/bench/bench_queue.ml @@ -1,5 +1,19 @@ open Kcas_data -open Bench +open Multicore_bench + +let run_one_domain ~budgetf ?(n_msgs = 50 * Util.iter_factor) () = + let t = Queue.create () in + + let op push = if push then Queue.push 101 t else Queue.take_opt t |> ignore in + + let init _ = + assert (Queue.is_empty t); + Util.generate_push_and_pop_sequence n_msgs + in + let work _ bits = Util.Bits.iter op bits in + + Times.record ~budgetf ~n_domains:1 ~init ~work () + |> Util.thruput_metrics ~n:n_msgs ~singular:"message" ~config:"one domain" let run_one ~budgetf ?(n_adders = 2) ?(blocking_add = false) ?(n_takers = 2) ?(blocking_take = false) ?(n_msgs = 50 * Util.iter_factor) () = @@ -7,10 +21,14 @@ let run_one ~budgetf ?(n_adders = 2) ?(blocking_add = false) ?(n_takers = 2) let t = Queue.create () in - let n_msgs_to_take = Atomic.make n_msgs |> Multicore_magic.copy_as_padded in - let n_msgs_to_add = Atomic.make n_msgs |> Multicore_magic.copy_as_padded in + let n_msgs_to_take = Atomic.make 0 |> Multicore_magic.copy_as_padded in + let n_msgs_to_add = Atomic.make 0 |> Multicore_magic.copy_as_padded in - let init _ = () in + let init _ = + assert (Queue.is_empty t); + Atomic.set n_msgs_to_take n_msgs; + Atomic.set n_msgs_to_add n_msgs + in let work i () = if i < n_adders then let rec work () = @@ -48,46 +66,27 @@ let run_one ~budgetf ?(n_adders = 2) ?(blocking_add = false) ?(n_takers = 2) in work () in - let after () = - Atomic.set n_msgs_to_take n_msgs; - Atomic.set n_msgs_to_add n_msgs - in - - let times = Times.record ~n_domains ~budgetf ~init ~work ~after () in - let name metric = + let config = let format role blocking n = Printf.sprintf "%d %s%s%s" n (if blocking then "" else "nb ") role (if n = 1 then "" else "s") in - Printf.sprintf "%s/%s, %s" metric + Printf.sprintf "%s, %s" (format "adder" blocking_add n_adders) (format "taker" blocking_take n_takers) in - List.concat - [ - Stats.of_times times - |> Stats.scale (1_000_000_000.0 /. Float.of_int n_msgs) - |> Stats.to_json ~name:(name "time per message") - ~description: - "Time to transmit one message from one domain to another" - ~units:"ns"; - Times.invert times |> Stats.of_times - |> Stats.scale (Float.of_int (n_msgs * n_domains) /. 1_000_000.0) - |> Stats.to_json - ~name:(name "messages over time") - ~description: - "Number of messages transmitted over time using all domains" - ~units:"M/s"; - ] + Times.record ~budgetf ~n_domains ~init ~work () + |> Util.thruput_metrics ~n:n_msgs ~singular:"message" ~config let run_suite ~budgetf = - Util.cross - (Util.cross [ 1; 2 ] [ false ]) - (Util.cross [ 1; 2 ] [ false; true ]) - |> List.concat_map - @@ fun ((n_adders, blocking_add), (n_takers, blocking_take)) -> - run_one ~budgetf ~n_adders ~blocking_add ~n_takers ~blocking_take () + run_one_domain ~budgetf () + @ (Util.cross + (Util.cross [ 1; 2 ] [ false ]) + (Util.cross [ 1; 2 ] [ false; true ]) + |> List.concat_map + @@ fun ((n_adders, blocking_add), (n_takers, blocking_take)) -> + run_one ~budgetf ~n_adders ~blocking_add ~n_takers ~blocking_take ()) diff --git a/bench/bench_ref.ml b/bench/bench_ref.ml index f0777881..57d0b30a 100644 --- a/bench/bench_ref.ml +++ b/bench/bench_ref.ml @@ -1,4 +1,4 @@ -open Bench +open Multicore_bench module Ref = struct type 'a t = 'a ref @@ -46,21 +46,8 @@ let run_one ~budgetf ?(n_iter = 500 * Util.iter_factor) loop n_iter in - let times = Times.record ~n_domains:1 ~budgetf ~init ~work () in - - List.concat - [ - Stats.of_times times - |> Stats.scale (1_000_000_000.0 /. Float.of_int n_iter) - |> Stats.to_json - ~name:(Printf.sprintf "time per op/%s" name) - ~description:"Time to perform a single op" ~units:"ns"; - Times.invert times |> Stats.of_times - |> Stats.scale (Float.of_int n_iter /. 1_000_000.0) - |> Stats.to_json - ~name:(Printf.sprintf "ops over time/%s" name) - ~description:"Number of operations performed over time" ~units:"M/s"; - ] + Times.record ~budgetf ~n_domains:1 ~init ~work () + |> Util.thruput_metrics ~n:n_iter ~singular:"op" ~config:name let run_suite ~budgetf = [ diff --git a/bench/bench_stack.ml b/bench/bench_stack.ml index 1610f22b..37dd8591 100644 --- a/bench/bench_stack.ml +++ b/bench/bench_stack.ml @@ -1,5 +1,19 @@ open Kcas_data -open Bench +open Multicore_bench + +let run_one_domain ~budgetf ?(n_msgs = 50 * Util.iter_factor) () = + let t = Stack.create () in + + let op push = if push then Stack.push 101 t else Stack.pop_opt t |> ignore in + + let init _ = + assert (Stack.is_empty t); + Util.generate_push_and_pop_sequence n_msgs + in + let work _ bits = Util.Bits.iter op bits in + + Times.record ~budgetf ~n_domains:1 ~init ~work () + |> Util.thruput_metrics ~n:n_msgs ~singular:"message" ~config:"one domain" let run_one ~budgetf ?(n_adders = 2) ?(blocking_add = false) ?(n_takers = 2) ?(blocking_take = false) ?(n_msgs = 50 * Util.iter_factor) () = @@ -7,10 +21,14 @@ let run_one ~budgetf ?(n_adders = 2) ?(blocking_add = false) ?(n_takers = 2) let t = Stack.create () in - let n_msgs_to_take = Atomic.make n_msgs |> Multicore_magic.copy_as_padded in - let n_msgs_to_add = Atomic.make n_msgs |> Multicore_magic.copy_as_padded in + let n_msgs_to_take = Atomic.make 0 |> Multicore_magic.copy_as_padded in + let n_msgs_to_add = Atomic.make 0 |> Multicore_magic.copy_as_padded in - let init _ = () in + let init _ = + assert (Stack.is_empty t); + Atomic.set n_msgs_to_take n_msgs; + Atomic.set n_msgs_to_add n_msgs + in let work i () = if i < n_adders then let rec work () = @@ -48,46 +66,27 @@ let run_one ~budgetf ?(n_adders = 2) ?(blocking_add = false) ?(n_takers = 2) in work () in - let after () = - Atomic.set n_msgs_to_take n_msgs; - Atomic.set n_msgs_to_add n_msgs - in - - let times = Times.record ~n_domains ~budgetf ~init ~work ~after () in - let name metric = + let config = let format role blocking n = Printf.sprintf "%d %s%s%s" n (if blocking then "" else "nb ") role (if n = 1 then "" else "s") in - Printf.sprintf "%s/%s, %s" metric + Printf.sprintf "%s, %s" (format "adder" blocking_add n_adders) (format "taker" blocking_take n_takers) in - List.concat - [ - Stats.of_times times - |> Stats.scale (1_000_000_000.0 /. Float.of_int n_msgs) - |> Stats.to_json ~name:(name "time per message") - ~description: - "Time to transmit one message from one domain to another" - ~units:"ns"; - Times.invert times |> Stats.of_times - |> Stats.scale (Float.of_int (n_msgs * n_domains) /. 1_000_000.0) - |> Stats.to_json - ~name:(name "messages over time") - ~description: - "Number of messages transmitted over time using all domains" - ~units:"M/s"; - ] + Times.record ~budgetf ~n_domains ~init ~work () + |> Util.thruput_metrics ~n:n_msgs ~singular:"message" ~config let run_suite ~budgetf = - Util.cross - (Util.cross [ 1; 2 ] [ false ]) - (Util.cross [ 1; 2 ] [ false; true ]) - |> List.concat_map - @@ fun ((n_adders, blocking_add), (n_takers, blocking_take)) -> - run_one ~budgetf ~n_adders ~blocking_add ~n_takers ~blocking_take () + run_one_domain ~budgetf () + @ (Util.cross + (Util.cross [ 1; 2 ] [ false ]) + (Util.cross [ 1; 2 ] [ false; true ]) + |> List.concat_map + @@ fun ((n_adders, blocking_add), (n_takers, blocking_take)) -> + run_one ~budgetf ~n_adders ~blocking_add ~n_takers ~blocking_take ()) diff --git a/bench/bench_xt.ml b/bench/bench_xt.ml index 15b8bd53..589330e2 100644 --- a/bench/bench_xt.ml +++ b/bench/bench_xt.ml @@ -1,5 +1,5 @@ open Kcas -open Bench +open Multicore_bench let run_one ~budgetf ?(n_locs = 2) ?(n_iter = 15 * (9 - n_locs) * Util.iter_factor) () = @@ -25,24 +25,10 @@ let run_one ~budgetf ?(n_locs = 2) loop n_iter in - let times = Times.record ~n_domains:1 ~budgetf ~init ~work () in + let config = Printf.sprintf "%d loc tx" n_locs in - let name metric = Printf.sprintf "%s/%d loc tx" metric n_locs in - - List.concat - [ - Stats.of_times times - |> Stats.scale (1_000_000_000.0 /. Float.of_int n_iter) - |> 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 /. 1_000_000.0) - |> Stats.to_json - ~name:(name "transactions over time") - ~description:"Number of transactions performed over time" - ~units:"M/s"; - ] + Times.record ~budgetf ~n_domains:1 ~init ~work () + |> Util.thruput_metrics ~n:n_iter ~singular:"transaction" ~config let run_suite ~budgetf = [ 0; 1; 2; 4; 8 ] diff --git a/bench/bench_xt_ro.ml b/bench/bench_xt_ro.ml index 7d03c9cf..2b68e50b 100644 --- a/bench/bench_xt_ro.ml +++ b/bench/bench_xt_ro.ml @@ -1,5 +1,5 @@ open Kcas -open Bench +open Multicore_bench let run_one ~budgetf ?(n_locs = 2) ?(n_iter = 20 * (9 - n_locs) * Util.iter_factor) () = @@ -25,24 +25,10 @@ let run_one ~budgetf ?(n_locs = 2) loop n_iter in - let times = Times.record ~n_domains:1 ~budgetf ~init ~work () in + let config = Printf.sprintf "%d loc tx" n_locs in - let name metric = Printf.sprintf "%s/%d loc tx" metric n_locs in - - List.concat - [ - Stats.of_times times - |> Stats.scale (1_000_000_000.0 /. Float.of_int n_iter) - |> 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 /. 1_000_000.0) - |> Stats.to_json - ~name:(name "transactions over time") - ~description:"Number of transactions performed over time" - ~units:"M/s"; - ] + Times.record ~budgetf ~n_domains:1 ~init ~work () + |> Util.thruput_metrics ~n:n_iter ~singular:"transaction" ~config let run_suite ~budgetf = [ 0; 1; 2; 4; 8 ] diff --git a/bench/dune b/bench/dune index 21fa5bce..aafb0dab 100644 --- a/bench/dune +++ b/bench/dune @@ -1,13 +1,4 @@ (test (name main) (package kcas_data) - (libraries - kcas_data - backoff - domain-local-await - multicore-magic - yojson - domain_shims - str - mtime - mtime.clock.os)) + (libraries kcas_data multicore-bench backoff multicore-magic domain_shims)) diff --git a/bench/main.ml b/bench/main.ml index e270cbb9..ff7fcb4a 100644 --- a/bench/main.ml +++ b/bench/main.ml @@ -14,62 +14,4 @@ let benchmarks = ("Kcas_data Stack", Bench_stack.run_suite); ] -let rec replace_inf : Yojson.Safe.t -> Yojson.Safe.t = function - | `Float x as lit -> if Float.is_finite x then lit else `Float 0.0 - | (`Null | `Bool _ | `Int _ | `Intlit _ | `String _) as lit -> lit - | `Assoc kvs -> `Assoc (List.map (fun (k, v) -> (k, replace_inf v)) kvs) - | `List vs -> `List (List.map replace_inf vs) - | `Tuple vs -> `Tuple (List.map replace_inf vs) - | `Variant (k, vo) -> `Variant (k, Option.map replace_inf vo) - -let () = - let budgetf = ref 0.025 in - let filters = ref [] in - - let rec specs = - [ - ("-budget", Arg.Set_float budgetf, "seconds\t Budget for a benchmark"); - ("-help", Unit help, "\t Show this help message"); - ("--help", Unit help, "\t Show this help message"); - ] - and help () = - Arg.usage (Arg.align specs) - (Printf.sprintf - "\n\ - Usage: %s