From 44b899355379bb7cd444a15b836ec36407b83e6f Mon Sep 17 00:00:00 2001 From: Ali Caglayan Date: Tue, 27 Jun 2023 17:58:22 +0200 Subject: [PATCH] bench: add GC stats to bench Signed-off-by: Ali Caglayan --- bench/bench.ml | 66 ++++++++++++++++++------ bench/bench.mli | 0 bench/dune | 2 +- bench/metrics.ml | 125 ++++++++++++++++++++++++++++++++++++++++++++++ bench/metrics.mli | 72 ++++++++++++++++++++++++++ 5 files changed, 248 insertions(+), 17 deletions(-) create mode 100644 bench/bench.mli create mode 100644 bench/metrics.ml create mode 100644 bench/metrics.mli diff --git a/bench/bench.ml b/bench/bench.ml index 6dd9c727d9ad..89ad9377fbac 100644 --- a/bench/bench.ml +++ b/bench/bench.ml @@ -95,17 +95,20 @@ let dune_build () = let stdout_to = Process.Io.make_stdout Swallow in let stderr_to = Process.Io.make_stderr Swallow in let open Fiber.O in + (* Build with timings *) let+ times = Process.run_with_times dune ~display:Quiet ~stdin_from ~stdout_to ~stderr_to [ "build"; "@install"; "--release" ] in - times.elapsed_time + (* Run GC and compactify before querying GC stats *) + Gc.full_major (); + Gc.compact (); + Metrics.make times (Gc.stat ()) let run_bench () = let open Fiber.O in let* clean = dune_build () in let+ zero = - let open Fiber.O in let rec zero acc n = if n = 0 then Fiber.return (List.rev acc) else @@ -116,6 +119,49 @@ let run_bench () = in (clean, zero) +let display what units clean zero = + { Output.name = what + ; metrics = + [ ("[Clean] " ^ what, clean, units); ("[Null] " ^ what, zero, units) ] + } + +let results clean zero size = + (* tagging data for json conversion *) + let tag data = Metrics.map ~f:(fun t -> `Float t) ~g:(fun t -> `Int t) data in + let clean = tag clean in + let zero = + List.map zero ~f:tag |> Metrics.unzip + |> Metrics.map ~f:(fun x -> `List x) ~g:(fun x -> `List x) + in + (* bench results *) + [ display "Build Time" "Seconds" clean.elapsed_time zero.elapsed_time + ; { Output.name = "Misc" + ; metrics = [ ("Size of _boot/dune.exe", `Int size, "Bytes") ] + } + ; display "User CPU Time" "Seconds" clean.user_cpu_time zero.user_cpu_time + ; display "System CPU Time" "Seconds" clean.system_cpu_time + zero.system_cpu_time + ; display "Minor Words" "Approx. Words" clean.minor_words zero.minor_words + ; display "Major Words" "Approx. Words" clean.major_words zero.major_words + ; display "Minor Collections" "Collections" clean.minor_collections + zero.minor_collections + ; display "Major Collections" "Collections" clean.major_collections + zero.major_collections + ; display "Heap Words" "Words" clean.heap_words zero.heap_words + ; display "Heap Chunks" "Chunks" clean.heap_chunks zero.heap_chunks + ; display "Live Words" "Words" clean.live_words zero.live_words + ; display "Live Blocks" "Blocks" clean.live_blocks zero.live_blocks + ; display "Free Words" "Words" clean.free_words zero.free_words + ; display "Free Blocks" "Blocks" clean.free_blocks zero.free_blocks + ; display "Largest Free" "Words" clean.largest_free zero.largest_free + ; display "Fragments" "Fragments" clean.fragments zero.fragments + ; display "Compactions" "Compactions" clean.compactions zero.compactions + ; display "Top Heap Words" "Words" clean.top_heap_words zero.top_heap_words + ; display "Stack Size" "Words" clean.stack_size zero.stack_size + ; display "Forced Major Collections" "Collections" + clean.forced_major_collections zero.forced_major_collections + ] + let () = Dune_util.Log.init ~file:No_log_file (); let dir = Temp.create Dir ~prefix:"dune" ~suffix:"bench" in @@ -140,24 +186,12 @@ let () = let* () = prepare_workspace () in run_bench ()) in - let zero = List.map zero ~f:(fun t -> `Float t) in let size = let stat : Unix.stats = Path.stat_exn dune in stat.st_size in - let results = - [ { Output.name = "Build times" - ; metrics = - [ ("Clean build time", `Float clean, "secs") - ; ("Null build time", `List zero, "secs") - ] - } - ; { Output.name = "Misc" - ; metrics = [ ("Size of _boot/dune.exe", `Int size, "bytes") ] - } - ] - in - let version = 2 in + let results = results clean zero size in + let version = 3 in let output = { Output.config = []; version; results } in print_string (Json.to_string (Output.to_json output)); flush stdout diff --git a/bench/bench.mli b/bench/bench.mli new file mode 100644 index 000000000000..e69de29bb2d1 diff --git a/bench/dune b/bench/dune index 9bc62180b18b..c447822bce3d 100644 --- a/bench/dune +++ b/bench/dune @@ -1,6 +1,6 @@ (executable (name bench) - (modules bench) + (modules bench metrics) (libraries dune_stats chrome_trace stdune fiber dune_engine dune_util)) (rule diff --git a/bench/metrics.ml b/bench/metrics.ml new file mode 100644 index 000000000000..42d5aef2b730 --- /dev/null +++ b/bench/metrics.ml @@ -0,0 +1,125 @@ +open Stdune + +type ('float, 'int) t = + { elapsed_time : 'float + ; user_cpu_time : 'float + ; system_cpu_time : 'float + ; minor_words : 'float + ; promoted_words : 'float + ; major_words : 'float + ; minor_collections : 'int + ; major_collections : 'int + ; heap_words : 'int + ; heap_chunks : 'int + ; live_words : 'int + ; live_blocks : 'int + ; free_words : 'int + ; free_blocks : 'int + ; largest_free : 'int + ; fragments : 'int + ; compactions : 'int + ; top_heap_words : 'int + ; stack_size : 'int + ; forced_major_collections : 'int + } + +let make (times : Proc.Times.t) (gc : Gc.stat) = + (* We default to 0 for the other processor times since they are rarely None in + pracice. *) + let { Proc.Resource_usage.user_cpu_time; system_cpu_time } = + Option.value times.resource_usage + ~default:{ user_cpu_time = 0.; system_cpu_time = 0. } + in + { elapsed_time = times.elapsed_time + ; user_cpu_time + ; system_cpu_time + ; minor_words = gc.minor_words + ; promoted_words = gc.promoted_words + ; major_words = gc.major_words + ; minor_collections = gc.minor_collections + ; major_collections = gc.major_collections + ; heap_words = gc.heap_words + ; heap_chunks = gc.heap_chunks + ; live_words = gc.live_words + ; live_blocks = gc.live_blocks + ; free_words = gc.free_words + ; free_blocks = gc.free_blocks + ; largest_free = gc.largest_free + ; fragments = gc.fragments + ; compactions = gc.compactions + ; top_heap_words = gc.top_heap_words + ; stack_size = gc.stack_size + ; forced_major_collections = gc.forced_major_collections + } + +let map ~f ~g (metrics : ('float, 'int) t) : ('float_, 'int_) t = + { elapsed_time = f metrics.elapsed_time + ; user_cpu_time = f metrics.user_cpu_time + ; system_cpu_time = f metrics.system_cpu_time + ; minor_words = f metrics.minor_words + ; promoted_words = f metrics.promoted_words + ; major_words = f metrics.major_words + ; minor_collections = g metrics.minor_collections + ; major_collections = g metrics.major_collections + ; heap_words = g metrics.heap_words + ; heap_chunks = g metrics.heap_chunks + ; live_words = g metrics.live_words + ; live_blocks = g metrics.live_blocks + ; free_words = g metrics.free_words + ; free_blocks = g metrics.free_blocks + ; largest_free = g metrics.largest_free + ; fragments = g metrics.fragments + ; compactions = g metrics.compactions + ; top_heap_words = g metrics.top_heap_words + ; stack_size = g metrics.stack_size + ; forced_major_collections = g metrics.forced_major_collections + } + +(** Turns a list of records into a record of lists. *) +let unzip (metrics : ('float, 'int) t list) : ('float list, 'int list) t = + List.fold_left metrics + ~init: + { elapsed_time = [] + ; user_cpu_time = [] + ; system_cpu_time = [] + ; minor_words = [] + ; promoted_words = [] + ; major_words = [] + ; minor_collections = [] + ; major_collections = [] + ; heap_words = [] + ; heap_chunks = [] + ; live_words = [] + ; live_blocks = [] + ; free_words = [] + ; free_blocks = [] + ; largest_free = [] + ; fragments = [] + ; compactions = [] + ; top_heap_words = [] + ; stack_size = [] + ; forced_major_collections = [] + } ~f:(fun acc x -> + { elapsed_time = x.elapsed_time :: acc.elapsed_time + ; user_cpu_time = x.user_cpu_time :: acc.user_cpu_time + ; system_cpu_time = x.system_cpu_time :: acc.system_cpu_time + ; minor_words = x.minor_words :: acc.minor_words + ; promoted_words = x.promoted_words :: acc.promoted_words + ; major_words = x.major_words :: acc.major_words + ; minor_collections = x.minor_collections :: acc.minor_collections + ; major_collections = x.major_collections :: acc.major_collections + ; heap_words = x.heap_words :: acc.heap_words + ; heap_chunks = x.heap_chunks :: acc.heap_chunks + ; live_words = x.live_words :: acc.live_words + ; live_blocks = x.live_blocks :: acc.live_blocks + ; free_words = x.free_words :: acc.free_words + ; free_blocks = x.free_blocks :: acc.free_blocks + ; largest_free = x.largest_free :: acc.largest_free + ; fragments = x.fragments :: acc.fragments + ; compactions = x.compactions :: acc.compactions + ; top_heap_words = x.top_heap_words :: acc.top_heap_words + ; stack_size = x.stack_size :: acc.stack_size + ; forced_major_collections = + x.forced_major_collections :: acc.forced_major_collections + }) + |> map ~f:List.rev ~g:List.rev diff --git a/bench/metrics.mli b/bench/metrics.mli new file mode 100644 index 000000000000..99a18d70e1d9 --- /dev/null +++ b/bench/metrics.mli @@ -0,0 +1,72 @@ +open Stdune + +(** [('float, 'int) t] is a record of metrics about the current process. It + includes timing information and information available from [Gc.stat]. It is + polymorphic in the type of field values to allow for the definition of + [unzip] functions which make serialisation easier. *) +type ('float, 'int) t = + { elapsed_time : 'float + (** Real time elapsed since the process started and the process + finished. *) + ; user_cpu_time : 'float + (** The amount of CPU time spent in user mode during the process. Other + processes and blocked time are not included. *) + ; system_cpu_time : 'float + (** The amount of CPU time spent in kernel mode during the process. + Similar to user time, other processes and time spent blocked by + other processes are not counted. *) + ; minor_words : 'float + (** Number of words allocated in the minor heap since the program was + started. *) + ; promoted_words : 'float + (** Number of words that have been promoted from the minor to the major + heap since the program was started. *) + ; major_words : 'float + (** Number of words allocated in the major heap since the program was + started. *) + ; minor_collections : 'int + (** Number of minor collections since the program was started. *) + ; major_collections : 'int + (** Number of major collection cycles completed since the program was + started. *) + ; heap_words : 'int (** Total size of the major heap, in words. *) + ; heap_chunks : 'int + (** Number of contiguous pieces of memory that make up the major heap. *) + ; live_words : 'int + (** Number of words of live data in the major heap, including the header + words. *) + ; live_blocks : 'int (** Number of live blocks in the major heap. *) + ; free_words : 'int (** Number of words in the free list. *) + ; free_blocks : 'int (** Number of blocks in the free list. *) + ; largest_free : 'int + (** Size (in words) of the largest block in the free list. *) + ; fragments : 'int + (** Number of wasted words due to fragmentation. These are 1-words free + blocks placed between two live blocks. They are not available for + allocation. *) + ; compactions : 'int + (** Number of heap compactions since the program was started. *) + ; top_heap_words : 'int + (** Maximum size reached by the major heap, in words. *) + ; stack_size : 'int (** Current size of the stack, in words. *) + ; forced_major_collections : 'int + (** Number of forced full major collections completed since the program + was started. *) + } + +(** [make t gc] creates a new metrics record from the given [t] and [gc] + information. *) +val make : Proc.Times.t -> Gc.stat -> (float, int) t + +(** [map ~f ~g m] applies [f] to the float fields and [g] to the int fields of + [m]. *) +val map : + f:('float -> 'float_) + -> g:('int -> 'int_) + -> ('float, 'int) t + -> ('float_, 'int_) t + +(** [unzip m] takes a list of metrics [m] and returns a records with the lists + of values for each field. This is particularly convenient when serialising + to json. *) +val unzip : ('float, 'int) t list -> ('float list, 'int list) t