From 3a7ff18107b86cfe3ad3603f73a6472a36cc6d25 Mon Sep 17 00:00:00 2001 From: Nikos Gkorogiannis Date: Thu, 11 Jun 2026 15:01:19 +0200 Subject: [PATCH 1/4] Extract common code between 5.0 and 5.3 implementations --- lib/olly_gc_stats/olly_gc_stats.5.0.ml | 154 +--------------------- lib/olly_gc_stats/olly_gc_stats.5.3.ml | 154 +--------------------- lib/olly_gc_stats/olly_gc_stats_common.ml | 153 +++++++++++++++++++++ 3 files changed, 155 insertions(+), 306 deletions(-) create mode 100644 lib/olly_gc_stats/olly_gc_stats_common.ml diff --git a/lib/olly_gc_stats/olly_gc_stats.5.0.ml b/lib/olly_gc_stats/olly_gc_stats.5.0.ml index 87a6f66..2bc9563 100644 --- a/lib/olly_gc_stats/olly_gc_stats.5.0.ml +++ b/lib/olly_gc_stats/olly_gc_stats.5.0.ml @@ -1,54 +1,4 @@ -module H = Hdr_histogram -module Ts = Runtime_events.Timestamp - -type ts = { mutable start_time : float; mutable end_time : float } - -(* Maximum number of domains that can be active concurrently. - Defaults to 128 on 64-bit platforms and 16 on 32-bit platforms. - - This can be user configurable with OCAMLRUNPARAM=d=XXX -*) -let number_domains = 128 -let wall_time = { start_time = 0.; end_time = 0. } -let rss_collector = Olly_common.Max_rss.create () -let domain_elapsed_times = Array.make number_domains 0. -let domain_gc_times = Array.make number_domains 0 -let domain_minor_words = Array.make number_domains 0 -let domain_promoted_words = Array.make number_domains 0 -let minor_collections = ref 0 -let major_collections = ref 0 -let forced_major_collections = ref 0 -let compactions = ref 0 - -let lifecycle domain_id ts lifecycle_event _data = - let ts = float_of_int Int64.(to_int @@ Ts.to_int64 ts) /. 1_000_000_000. in - match lifecycle_event with - | Runtime_events.EV_RING_START -> - wall_time.start_time <- ts; - domain_elapsed_times.(domain_id) <- ts - | Runtime_events.EV_RING_STOP -> - wall_time.end_time <- ts; - domain_elapsed_times.(domain_id) <- ts -. domain_elapsed_times.(domain_id) - | Runtime_events.EV_DOMAIN_SPAWN -> domain_elapsed_times.(domain_id) <- ts - | Runtime_events.EV_DOMAIN_TERMINATE -> - domain_elapsed_times.(domain_id) <- ts -. domain_elapsed_times.(domain_id) - | _ -> () - -let print_table oc (data : string list list) = - let column_widths = - List.fold_left - (fun widths row -> List.map2 max widths (List.map String.length row)) - (List.map String.length (List.hd data)) - (List.tl data) - in - let print_row row = - let formatted_row = - List.map2 (fun s w -> Printf.sprintf "%-*s" w s) row column_widths - in - Printf.fprintf oc "%s \n" (String.concat " " formatted_row) - in - - List.iter print_row data +include Olly_gc_stats_common let print_percentiles json output hist = let to_sec x = float_of_int x /. 1_000_000_000. in @@ -189,108 +139,6 @@ let print_percentiles json output hist = !major_collections !forced_major_collections; Printf.fprintf oc "Compactions: %i\n" !compactions) -let print_latency_only json output hist = - let ms ns = ns /. 1_000_000. in - - let mean_latency = H.mean hist |> ms - and max_latency = float_of_int (H.max hist) |> ms in - let percentiles = - [| - 25.0; - 50.0; - 60.0; - 70.0; - 75.0; - 80.0; - 85.0; - 90.0; - 95.0; - 96.0; - 97.0; - 98.0; - 99.0; - 99.9; - 99.99; - 99.999; - 99.9999; - 100.0; - |] - in - let oc = match output with Some s -> open_out s | None -> stderr in - - if json then - let distribs = - List.init (Array.length percentiles) (fun i -> - let percentile = percentiles.(i) in - let value = - H.value_at_percentile hist percentiles.(i) - |> float_of_int |> ms |> string_of_float - in - Printf.sprintf "\"%.4f\": %s" percentile value) - |> String.concat "," - in - Printf.fprintf oc - {|{"mean_latency": %f, "max_latency": %f, "distr_latency": {%s}}|} - mean_latency max_latency distribs - else ( - Printf.fprintf oc "\n"; - Printf.fprintf oc "GC latency profile:\n"; - Printf.fprintf oc "#[Mean (ms):\t%.2f,\t Stddev (ms):\t%.2f]\n" mean_latency - (H.stddev hist |> ms); - Printf.fprintf oc "#[Min (ms):\t%.2f,\t max (ms):\t%.2f]\n" - (float_of_int (H.min hist) |> ms) - max_latency; - Printf.fprintf oc "\n"; - Printf.fprintf oc "Percentile \t Latency (ms)\n"; - Fun.flip Array.iter percentiles (fun p -> - Printf.fprintf oc "%.4f \t %.2f\n" p - (float_of_int (H.value_at_percentile hist p) |> ms))) - -let latency poll_sleep json output runtime_events_dir exec_args = - let current_event = Hashtbl.create 13 in - let hist = - H.init ~lowest_discernible_value:10 ~highest_trackable_value:10_000_000_000 - ~significant_figures:3 - in - let is_gc_phase phase = - match phase with - | Runtime_events.EV_MAJOR | Runtime_events.EV_STW_LEADER - | Runtime_events.EV_INTERRUPT_REMOTE -> - true - | _ -> false - in - let runtime_begin ring_id ts phase = - if is_gc_phase phase then - match Hashtbl.find_opt current_event ring_id with - | None -> Hashtbl.add current_event ring_id (phase, Ts.to_int64 ts) - | _ -> () - in - let runtime_end ring_id ts phase = - match Hashtbl.find_opt current_event ring_id with - | Some (saved_phase, saved_ts) when saved_phase = phase -> - Hashtbl.remove current_event ring_id; - let latency = Int64.to_int (Int64.sub (Ts.to_int64 ts) saved_ts) in - assert (H.record_value hist latency) - | _ -> () - in - let init = Fun.id in - let cleanup () = print_latency_only json output hist in - let open Olly_common.Launch in - try - `Ok - (olly - { - empty_config with - runtime_begin; - runtime_end; - init; - cleanup; - poll_sleep; - runtime_events_dir; - } - exec_args) - with Fail msg -> `Error (false, msg) - let gc_stats poll_sleep json output runtime_events_dir runtime_events_log_wsize exec_args = let current_event = Hashtbl.create 13 in diff --git a/lib/olly_gc_stats/olly_gc_stats.5.3.ml b/lib/olly_gc_stats/olly_gc_stats.5.3.ml index 6bf5bcf..81a3a9a 100644 --- a/lib/olly_gc_stats/olly_gc_stats.5.3.ml +++ b/lib/olly_gc_stats/olly_gc_stats.5.3.ml @@ -1,56 +1,6 @@ -module H = Hdr_histogram -module Ts = Runtime_events.Timestamp +include Olly_gc_stats_common -type ts = { mutable start_time : float; mutable end_time : float } - -(* Maximum number of domains that can be active concurrently. - Defaults to 128 on 64-bit platforms and 16 on 32-bit platforms. - - This can be user configurable with OCAMLRUNPARAM=d=XXX -*) - -let number_domains = 128 -let wall_time = { start_time = 0.; end_time = 0. } -let rss_collector = Olly_common.Max_rss.create () -let domain_elapsed_times = Array.make number_domains 0. -let domain_gc_times = Array.make number_domains 0 -let domain_minor_words = Array.make number_domains 0 -let domain_promoted_words = Array.make number_domains 0 let domain_major_words = Array.make number_domains 0 -let minor_collections = ref 0 -let major_collections = ref 0 -let forced_major_collections = ref 0 -let compactions = ref 0 - -let lifecycle domain_id ts lifecycle_event _data = - let ts = float_of_int Int64.(to_int @@ Ts.to_int64 ts) /. 1_000_000_000. in - match lifecycle_event with - | Runtime_events.EV_RING_START -> - wall_time.start_time <- ts; - domain_elapsed_times.(domain_id) <- ts - | Runtime_events.EV_RING_STOP -> - wall_time.end_time <- ts; - domain_elapsed_times.(domain_id) <- ts -. domain_elapsed_times.(domain_id) - | Runtime_events.EV_DOMAIN_SPAWN -> domain_elapsed_times.(domain_id) <- ts - | Runtime_events.EV_DOMAIN_TERMINATE -> - domain_elapsed_times.(domain_id) <- ts -. domain_elapsed_times.(domain_id) - | _ -> () - -let print_table oc (data : string list list) = - let column_widths = - List.fold_left - (fun widths row -> List.map2 max widths (List.map String.length row)) - (List.map String.length (List.hd data)) - (List.tl data) - in - let print_row row = - let formatted_row = - List.map2 (fun s w -> Printf.sprintf "%-*s" w s) row column_widths - in - Printf.fprintf oc "%s \n" (String.concat " " formatted_row) - in - - List.iter print_row data let print_global_allocation_stats oc = Printf.fprintf oc "GC allocations (in words): \n"; @@ -259,108 +209,6 @@ let print_percentiles json output hist = !major_collections !forced_major_collections; Printf.fprintf oc "Compactions: %i\n" !compactions) -let print_latency_only json output hist = - let ms ns = ns /. 1_000_000. in - - let mean_latency = H.mean hist |> ms - and max_latency = float_of_int (H.max hist) |> ms in - let percentiles = - [| - 25.0; - 50.0; - 60.0; - 70.0; - 75.0; - 80.0; - 85.0; - 90.0; - 95.0; - 96.0; - 97.0; - 98.0; - 99.0; - 99.9; - 99.99; - 99.999; - 99.9999; - 100.0; - |] - in - let oc = match output with Some s -> open_out s | None -> stderr in - - if json then - let distribs = - List.init (Array.length percentiles) (fun i -> - let percentile = percentiles.(i) in - let value = - H.value_at_percentile hist percentiles.(i) - |> float_of_int |> ms |> string_of_float - in - Printf.sprintf "\"%.4f\": %s" percentile value) - |> String.concat "," - in - Printf.fprintf oc - {|{"mean_latency": %f, "max_latency": %f, "distr_latency": {%s}}|} - mean_latency max_latency distribs - else ( - Printf.fprintf oc "\n"; - Printf.fprintf oc "GC latency profile:\n"; - Printf.fprintf oc "#[Mean (ms):\t%.2f,\t Stddev (ms):\t%.2f]\n" mean_latency - (H.stddev hist |> ms); - Printf.fprintf oc "#[Min (ms):\t%.2f,\t max (ms):\t%.2f]\n" - (float_of_int (H.min hist) |> ms) - max_latency; - Printf.fprintf oc "\n"; - Printf.fprintf oc "Percentile \t Latency (ms)\n"; - Fun.flip Array.iter percentiles (fun p -> - Printf.fprintf oc "%.4f \t %.2f\n" p - (float_of_int (H.value_at_percentile hist p) |> ms))) - -let latency poll_sleep json output runtime_events_dir exec_args = - let current_event = Hashtbl.create 13 in - let hist = - H.init ~lowest_discernible_value:10 ~highest_trackable_value:10_000_000_000 - ~significant_figures:3 - in - let is_gc_phase phase = - match phase with - | Runtime_events.EV_MAJOR | Runtime_events.EV_STW_LEADER - | Runtime_events.EV_INTERRUPT_REMOTE -> - true - | _ -> false - in - let runtime_begin ring_id ts phase = - if is_gc_phase phase then - match Hashtbl.find_opt current_event ring_id with - | None -> Hashtbl.add current_event ring_id (phase, Ts.to_int64 ts) - | _ -> () - in - let runtime_end ring_id ts phase = - match Hashtbl.find_opt current_event ring_id with - | Some (saved_phase, saved_ts) when saved_phase = phase -> - Hashtbl.remove current_event ring_id; - let latency = Int64.to_int (Int64.sub (Ts.to_int64 ts) saved_ts) in - assert (H.record_value hist latency) - | _ -> () - in - let init = Fun.id in - let cleanup () = print_latency_only json output hist in - let open Olly_common.Launch in - try - `Ok - (olly - { - empty_config with - runtime_begin; - runtime_end; - init; - cleanup; - poll_sleep; - runtime_events_dir; - } - exec_args) - with Fail msg -> `Error (false, msg) - let gc_stats poll_sleep json output runtime_events_dir runtime_events_log_wsize exec_args = let current_event = Hashtbl.create 13 in diff --git a/lib/olly_gc_stats/olly_gc_stats_common.ml b/lib/olly_gc_stats/olly_gc_stats_common.ml new file mode 100644 index 0000000..f32759d --- /dev/null +++ b/lib/olly_gc_stats/olly_gc_stats_common.ml @@ -0,0 +1,153 @@ +module H = Hdr_histogram +module Ts = Runtime_events.Timestamp + +type ts = { mutable start_time : float; mutable end_time : float } + +(* Maximum number of domains that can be active concurrently. + Defaults to 128 on 64-bit platforms and 16 on 32-bit platforms. + + This can be user configurable with OCAMLRUNPARAM=d=XXX +*) +let number_domains = 128 +let wall_time = { start_time = 0.; end_time = 0. } +let rss_collector = Olly_common.Max_rss.create () +let domain_elapsed_times = Array.make number_domains 0. +let domain_gc_times = Array.make number_domains 0 +let domain_minor_words = Array.make number_domains 0 +let domain_promoted_words = Array.make number_domains 0 +let minor_collections = ref 0 +let major_collections = ref 0 +let forced_major_collections = ref 0 +let compactions = ref 0 + +let lifecycle domain_id ts lifecycle_event _data = + let ts = float_of_int Int64.(to_int @@ Ts.to_int64 ts) /. 1_000_000_000. in + match lifecycle_event with + | Runtime_events.EV_RING_START -> + wall_time.start_time <- ts; + domain_elapsed_times.(domain_id) <- ts + | Runtime_events.EV_RING_STOP -> + wall_time.end_time <- ts; + domain_elapsed_times.(domain_id) <- ts -. domain_elapsed_times.(domain_id) + | Runtime_events.EV_DOMAIN_SPAWN -> domain_elapsed_times.(domain_id) <- ts + | Runtime_events.EV_DOMAIN_TERMINATE -> + domain_elapsed_times.(domain_id) <- ts -. domain_elapsed_times.(domain_id) + | _ -> () + +let print_table oc (data : string list list) = + let column_widths = + List.fold_left + (fun widths row -> List.map2 max widths (List.map String.length row)) + (List.map String.length (List.hd data)) + (List.tl data) + in + let print_row row = + let formatted_row = + List.map2 (fun s w -> Printf.sprintf "%-*s" w s) row column_widths + in + Printf.fprintf oc "%s \n" (String.concat " " formatted_row) + in + + List.iter print_row data + +let print_latency_only json output hist = + let ms ns = ns /. 1_000_000. in + + let mean_latency = H.mean hist |> ms + and max_latency = float_of_int (H.max hist) |> ms in + let percentiles = + [| + 25.0; + 50.0; + 60.0; + 70.0; + 75.0; + 80.0; + 85.0; + 90.0; + 95.0; + 96.0; + 97.0; + 98.0; + 99.0; + 99.9; + 99.99; + 99.999; + 99.9999; + 100.0; + |] + in + let oc = match output with Some s -> open_out s | None -> stderr in + + if json then + let distribs = + List.init (Array.length percentiles) (fun i -> + let percentile = percentiles.(i) in + let value = + H.value_at_percentile hist percentiles.(i) + |> float_of_int |> ms |> string_of_float + in + Printf.sprintf "\"%.4f\": %s" percentile value) + |> String.concat "," + in + Printf.fprintf oc + {|{"mean_latency": %f, "max_latency": %f, "distr_latency": {%s}}|} + mean_latency max_latency distribs + else ( + Printf.fprintf oc "\n"; + Printf.fprintf oc "GC latency profile:\n"; + Printf.fprintf oc "#[Mean (ms):\t%.2f,\t Stddev (ms):\t%.2f]\n" mean_latency + (H.stddev hist |> ms); + Printf.fprintf oc "#[Min (ms):\t%.2f,\t max (ms):\t%.2f]\n" + (float_of_int (H.min hist) |> ms) + max_latency; + Printf.fprintf oc "\n"; + Printf.fprintf oc "Percentile \t Latency (ms)\n"; + Fun.flip Array.iter percentiles (fun p -> + Printf.fprintf oc "%.4f \t %.2f\n" p + (float_of_int (H.value_at_percentile hist p) |> ms))) + +let latency poll_sleep json output runtime_events_dir exec_args = + let current_event = Hashtbl.create 13 in + let hist = + H.init ~lowest_discernible_value:10 ~highest_trackable_value:10_000_000_000 + ~significant_figures:3 + in + let is_gc_phase phase = + match phase with + | Runtime_events.EV_MAJOR | Runtime_events.EV_STW_LEADER + | Runtime_events.EV_INTERRUPT_REMOTE -> + true + | _ -> false + in + let runtime_begin ring_id ts phase = + if is_gc_phase phase then + match Hashtbl.find_opt current_event ring_id with + | None -> Hashtbl.add current_event ring_id (phase, Ts.to_int64 ts) + | _ -> () + in + let runtime_end ring_id ts phase = + match Hashtbl.find_opt current_event ring_id with + | Some (saved_phase, saved_ts) when saved_phase = phase -> + Hashtbl.remove current_event ring_id; + let latency = Int64.to_int (Int64.sub (Ts.to_int64 ts) saved_ts) in + assert (H.record_value hist latency) + | _ -> () + in + let init = Fun.id in + let cleanup () = print_latency_only json output hist in + let open Olly_common.Launch in + try + `Ok + (olly + { + empty_config with + runtime_begin; + runtime_end; + init; + cleanup; + poll_sleep; + runtime_events_dir; + } + exec_args) + with Fail msg -> `Error (false, msg) From 7bf3c73c6e7ce77822fa2f7b0bbdc6d48cb3c2bb Mon Sep 17 00:00:00 2001 From: Nikos Gkorogiannis Date: Thu, 11 Jun 2026 15:12:00 +0200 Subject: [PATCH 2/4] Don't crash on pauses greater than 10sec --- lib/olly_gc_stats/olly_gc_stats.5.0.ml | 24 ++++++++++++++++++----- lib/olly_gc_stats/olly_gc_stats.5.3.ml | 24 ++++++++++++++++++----- lib/olly_gc_stats/olly_gc_stats_common.ml | 19 ++++++++++++++++++ 3 files changed, 57 insertions(+), 10 deletions(-) diff --git a/lib/olly_gc_stats/olly_gc_stats.5.0.ml b/lib/olly_gc_stats/olly_gc_stats.5.0.ml index 2bc9563..16d5b01 100644 --- a/lib/olly_gc_stats/olly_gc_stats.5.0.ml +++ b/lib/olly_gc_stats/olly_gc_stats.5.0.ml @@ -1,8 +1,12 @@ include Olly_gc_stats_common -let print_percentiles json output hist = +let print_percentiles json output hist outliers = let to_sec x = float_of_int x /. 1_000_000_000. in let ms ns = ns /. 1_000_000. in + let outlier_mean_ms = + if outliers.count = 0 then 0. + else float_of_int outliers.total /. float_of_int outliers.count |> ms + in let mean_latency = H.mean hist |> ms and max_latency = float_of_int (H.max hist) |> ms in @@ -82,10 +86,12 @@ let print_percentiles json output hist = Buffer.contents buf in Printf.fprintf oc - {|{"version": 1, "wall_time": %.2f, "cpu_time": %.2f, "gc_time": %.2f, "gc_overhead": %.2f, "max_rss_kb": %d, "domain_stats": {%s}, "mean_latency": %f, "stddev_latency": %f, "min_latency": %.2f, "max_latency": %f, "distr_latency": {%s}, "allocations": {"total_heap": %.0f, "minor_heap": %.0f, "promoted_words": %.0f, "promoted_pct": %.2f}, "collections": {"minor": %i, "major": %i, "forced_major": %i, "compactions": %i}}|} + {|{"version": 2, "wall_time": %.2f, "cpu_time": %.2f, "gc_time": %.2f, "gc_overhead": %.2f, "max_rss_kb": %d, "domain_stats": {%s}, "mean_latency": %f, "stddev_latency": %f, "min_latency": %.2f, "max_latency": %f, "distr_latency": {%s}, "outliers": {"count": %d, "mean_latency": %f, "max_latency": %f}, "allocations": {"total_heap": %.0f, "minor_heap": %.0f, "promoted_words": %.0f, "promoted_pct": %.2f}, "collections": {"minor": %i, "major": %i, "forced_major": %i, "compactions": %i}}|} real_time !total_cpu_time total_gc_time gc_overhead (Olly_common.Max_rss.max_rss_kb rss_collector) domain_stats mean_latency stddev_latency min_latency max_latency distribs + outliers.count outlier_mean_ms + (float_of_int outliers.max |> ms) total_heap !minor_words !promoted_words promoted_pct !minor_collections !major_collections !forced_major_collections !compactions else ( @@ -127,6 +133,13 @@ let print_percentiles json output hist = Fun.flip Array.iter percentiles (fun p -> Printf.fprintf oc "%.4f \t %.2f\n" p (float_of_int (H.value_at_percentile hist p) |> ms)); + if outliers.count > 0 then + Printf.fprintf oc + "#[Beyond histogram (> %.0f ms):\t%d events,\t mean (ms):\t%.2f,\t max \ + (ms):\t%.2f]\n" + (float_of_int highest_trackable_value |> ms) + outliers.count outlier_mean_ms + (float_of_int outliers.max |> ms); Printf.fprintf oc "\n"; Printf.fprintf oc "GC allocations (in words): \n"; Printf.fprintf oc "Total heap:\t %.0f\n" total_heap; @@ -143,9 +156,10 @@ let gc_stats poll_sleep json output runtime_events_dir runtime_events_log_wsize exec_args = let current_event = Hashtbl.create 13 in let hist = - H.init ~lowest_discernible_value:10 ~highest_trackable_value:10_000_000_000 + H.init ~lowest_discernible_value:10 ~highest_trackable_value ~significant_figures:3 in + let outliers = make_outliers () in let is_gc_phase phase = match phase with | Runtime_events.EV_MAJOR | Runtime_events.EV_STW_LEADER @@ -182,7 +196,7 @@ let gc_stats poll_sleep json output runtime_events_dir runtime_events_log_wsize | Some (saved_phase, saved_ts) when saved_phase = phase -> Hashtbl.remove current_event ring_id; let latency = Int64.to_int (Int64.sub (Ts.to_int64 ts) saved_ts) in - assert (H.record_value hist latency); + record_latency hist outliers latency; domain_gc_times.(ring_id) <- domain_gc_times.(ring_id) + latency | _ -> () in @@ -204,7 +218,7 @@ let gc_stats poll_sleep json output runtime_events_dir runtime_events_log_wsize in let init = Fun.id in - let cleanup () = print_percentiles json output hist in + let cleanup () = print_percentiles json output hist outliers in let on_poll = Olly_common.Max_rss.sample rss_collector in let open Olly_common.Launch in try diff --git a/lib/olly_gc_stats/olly_gc_stats.5.3.ml b/lib/olly_gc_stats/olly_gc_stats.5.3.ml index 81a3a9a..a085150 100644 --- a/lib/olly_gc_stats/olly_gc_stats.5.3.ml +++ b/lib/olly_gc_stats/olly_gc_stats.5.3.ml @@ -52,9 +52,13 @@ let print_per_domain_stats oc = |> Array.combine domain_major_words); print_table oc !data -let print_percentiles json output hist = +let print_percentiles json output hist outliers = let to_sec x = float_of_int x /. 1_000_000_000. in let ms ns = ns /. 1_000_000. in + let outlier_mean_ms = + if outliers.count = 0 then 0. + else float_of_int outliers.total /. float_of_int outliers.count |> ms + in let mean_latency = H.mean hist |> ms and max_latency = float_of_int (H.max hist) |> ms in @@ -155,10 +159,12 @@ let print_percentiles json output hist = Buffer.contents buf in Printf.fprintf oc - {|{"version": 1, "wall_time": %.2f, "cpu_time": %.2f, "gc_time": %.2f, "gc_overhead": %.2f, "max_rss_kb": %d, "domain_stats": {%s}, "mean_latency": %f, "stddev_latency": %f, "min_latency": %.2f, "max_latency": %f, "distr_latency": {%s}, "allocations": {"total_heap": %.0f, "minor_heap": %.0f, "major_heap": %.0f, "promoted_words": %.0f, "promoted_pct": %.2f}, "domain_alloc_stats": {%s}, "collections": {"minor": %i, "major": %i, "forced_major": %i, "compactions": %i}}|} + {|{"version": 2, "wall_time": %.2f, "cpu_time": %.2f, "gc_time": %.2f, "gc_overhead": %.2f, "max_rss_kb": %d, "domain_stats": {%s}, "mean_latency": %f, "stddev_latency": %f, "min_latency": %.2f, "max_latency": %f, "distr_latency": {%s}, "outliers": {"count": %d, "mean_latency": %f, "max_latency": %f}, "allocations": {"total_heap": %.0f, "minor_heap": %.0f, "major_heap": %.0f, "promoted_words": %.0f, "promoted_pct": %.2f}, "domain_alloc_stats": {%s}, "collections": {"minor": %i, "major": %i, "forced_major": %i, "compactions": %i}}|} real_time !total_cpu_time total_gc_time gc_overhead (Olly_common.Max_rss.max_rss_kb rss_collector) domain_stats mean_latency stddev_latency min_latency max_latency distribs + outliers.count outlier_mean_ms + (float_of_int outliers.max |> ms) total_heap !minor_words !major_words !promoted_words promoted_pct domain_alloc_stats !minor_collections !major_collections !forced_major_collections !compactions @@ -201,6 +207,13 @@ let print_percentiles json output hist = Fun.flip Array.iter percentiles (fun p -> Printf.fprintf oc "%.4f \t %.2f\n" p (float_of_int (H.value_at_percentile hist p) |> ms)); + if outliers.count > 0 then + Printf.fprintf oc + "#[Beyond histogram (> %.0f ms):\t%d events,\t mean (ms):\t%.2f,\t max \ + (ms):\t%.2f]\n" + (float_of_int highest_trackable_value |> ms) + outliers.count outlier_mean_ms + (float_of_int outliers.max |> ms); Printf.fprintf oc "\n"; print_global_allocation_stats oc; print_per_domain_stats oc; @@ -213,9 +226,10 @@ let gc_stats poll_sleep json output runtime_events_dir runtime_events_log_wsize exec_args = let current_event = Hashtbl.create 13 in let hist = - H.init ~lowest_discernible_value:10 ~highest_trackable_value:10_000_000_000 + H.init ~lowest_discernible_value:10 ~highest_trackable_value ~significant_figures:3 in + let outliers = make_outliers () in let is_gc_phase phase = match phase with | Runtime_events.EV_MAJOR | Runtime_events.EV_STW_LEADER @@ -252,7 +266,7 @@ let gc_stats poll_sleep json output runtime_events_dir runtime_events_log_wsize | Some (saved_phase, saved_ts) when saved_phase = phase -> Hashtbl.remove current_event ring_id; let latency = Int64.to_int (Int64.sub (Ts.to_int64 ts) saved_ts) in - assert (H.record_value hist latency); + record_latency hist outliers latency; domain_gc_times.(ring_id) <- domain_gc_times.(ring_id) + latency | _ -> () in @@ -278,7 +292,7 @@ let gc_stats poll_sleep json output runtime_events_dir runtime_events_log_wsize in let init = Fun.id in - let cleanup () = print_percentiles json output hist in + let cleanup () = print_percentiles json output hist outliers in let on_poll = Olly_common.Max_rss.sample rss_collector in let open Olly_common.Launch in try diff --git a/lib/olly_gc_stats/olly_gc_stats_common.ml b/lib/olly_gc_stats/olly_gc_stats_common.ml index f32759d..8fcf930 100644 --- a/lib/olly_gc_stats/olly_gc_stats_common.ml +++ b/lib/olly_gc_stats/olly_gc_stats_common.ml @@ -9,6 +9,10 @@ type ts = { mutable start_time : float; mutable end_time : float } This can be user configurable with OCAMLRUNPARAM=d=XXX *) let number_domains = 128 + +(* Largest GC pause (in nanoseconds) the latency histogram can track. Pauses + beyond this are summarised separately. *) +let highest_trackable_value = 10_000_000_000 let wall_time = { start_time = 0.; end_time = 0. } let rss_collector = Olly_common.Max_rss.create () let domain_elapsed_times = Array.make number_domains 0. @@ -20,6 +24,21 @@ let major_collections = ref 0 let forced_major_collections = ref 0 let compactions = ref 0 +(* Running summary of GC pauses that fall outside the histogram's range. *) +type outliers = { mutable count : int; mutable total : int; mutable max : int } + +let make_outliers () = { count = 0; total = 0; max = 0 } + +(* Record [latency] into [hist], or, if it is too large for the histogram, + fold it into [outliers]. [H.record_value] returns [false] for out-of-range + values; a non-positive latency is a spurious measurement and is dropped. *) +let record_latency hist outliers latency = + if (not (H.record_value hist latency)) && latency > highest_trackable_value + then ( + outliers.count <- outliers.count + 1; + outliers.total <- outliers.total + latency; + if latency > outliers.max then outliers.max <- latency) + let lifecycle domain_id ts lifecycle_event _data = let ts = float_of_int Int64.(to_int @@ Ts.to_int64 ts) /. 1_000_000_000. in match lifecycle_event with From 5bae0561ef61657b9db33fad03a440ab2f66c060 Mon Sep 17 00:00:00 2001 From: Nikos Gkorogiannis Date: Thu, 25 Jun 2026 11:46:48 +0200 Subject: [PATCH 3/4] [gc-stats] poll rss usage from a dedicated domain --- lib/olly_common/cli.ml | 11 +++++++++++ lib/olly_common/launch.ml | 11 +++++------ lib/olly_common/max_rss.ml | 8 +------- lib/olly_common/rss_poller.ml | 25 +++++++++++++++++++++++++ lib/olly_common/rss_poller.mli | 11 +++++++++++ lib/olly_gc_stats/olly_gc_stats.5.0.ml | 20 +++++++++++++++----- lib/olly_gc_stats/olly_gc_stats.5.3.ml | 20 +++++++++++++++----- lib/olly_gc_stats/olly_gc_stats.ml | 7 ++++--- lib/olly_trace/olly_trace.ml | 4 ++-- test/cram/olly.t | 9 ++++++++- 10 files changed, 97 insertions(+), 29 deletions(-) create mode 100644 lib/olly_common/rss_poller.ml create mode 100644 lib/olly_common/rss_poller.mli diff --git a/lib/olly_common/cli.ml b/lib/olly_common/cli.ml index fd89234..9785d65 100644 --- a/lib/olly_common/cli.ml +++ b/lib/olly_common/cli.ml @@ -26,6 +26,17 @@ let freq_option = & opt float 0.1 (* Poll at 10Hz by default. *) & info [ "freq" ] ~docv:"freq" ~doc) +let rss_freq_option = + let doc = + "Set the interval, in seconds, at which the peak RSS of the monitored \ + process is sampled. Sampling runs on a dedicated domain, independently of \ + $(b,--freq). A value of 0.0 samples as fast as possible." + in + Arg.( + value + & opt float 0.1 (* Sample at 10Hz by default. *) + & info [ "rss-freq" ] ~docv:"rss-freq" ~doc) + let runtime_events_dir = let doc = "Sets the directory where the .events files containing the runtime event \ diff --git a/lib/olly_common/launch.ml b/lib/olly_common/launch.ml index 7509512..8e37222 100644 --- a/lib/olly_common/launch.ml +++ b/lib/olly_common/launch.ml @@ -140,7 +140,7 @@ let launch_process config (exec_args : exec_config) : subprocess = let interrupted = Atomic.make false -let collect_events poll_sleep ~on_poll child callbacks = +let collect_events poll_sleep child callbacks = let old_handler = Sys.signal Sys.sigint (Sys.Signal_handle (fun _ -> Atomic.set interrupted true)) @@ -150,7 +150,6 @@ let collect_events poll_sleep ~on_poll child callbacks = (fun () -> (* Read from the child process *) while child.alive () && not (Atomic.get interrupted) do - on_poll child.pid; Runtime_events.read_poll child.cursor callbacks None |> ignore; if poll_sleep > 0.0 then try Unix.sleepf poll_sleep @@ -169,7 +168,7 @@ type consumer_config = { extra : Runtime_events.Callbacks.t -> Runtime_events.Callbacks.t; init : unit -> unit; cleanup : unit -> unit; - on_poll : int -> unit; + on_launch : subprocess -> unit; poll_sleep : float; runtime_events_dir : string option; runtime_events_log_wsize : int option; @@ -184,7 +183,7 @@ let empty_config = extra = Fun.id; init = (fun () -> ()); cleanup = (fun () -> ()); - on_poll = (fun _ -> ()); + on_launch = (fun _ -> ()); poll_sleep = 0.1 (* Poll at 10Hz *); runtime_events_dir = None; (* Use default tmp directory *) @@ -202,6 +201,7 @@ let olly config exec_args = } in let child = launch_process runtime_config exec_args in + config.on_launch child; Fun.protect ~finally:child.close (fun () -> let callbacks = let { @@ -218,5 +218,4 @@ let olly config exec_args = ~runtime_counter ~lifecycle ~lost_events () |> extra in - collect_events config.poll_sleep ~on_poll:config.on_poll child - callbacks)) + collect_events config.poll_sleep child callbacks)) diff --git a/lib/olly_common/max_rss.ml b/lib/olly_common/max_rss.ml index b647d23..35736b6 100644 --- a/lib/olly_common/max_rss.ml +++ b/lib/olly_common/max_rss.ml @@ -1,11 +1,5 @@ -external get_rss_kb : int -> int = "olly_get_rss_kb" - type t = { mutable max_rss_kb : int } let create () = { max_rss_kb = 0 } - -let sample t pid = - let rss = get_rss_kb pid in - if rss > t.max_rss_kb then t.max_rss_kb <- rss - +let set t kb = if kb > t.max_rss_kb then t.max_rss_kb <- kb let max_rss_kb t = t.max_rss_kb diff --git a/lib/olly_common/rss_poller.ml b/lib/olly_common/rss_poller.ml new file mode 100644 index 0000000..e23fab7 --- /dev/null +++ b/lib/olly_common/rss_poller.ml @@ -0,0 +1,25 @@ +external get_rss_kb : int -> int = "olly_get_rss_kb" + +type t = { stop_flag : bool Atomic.t; domain : int Domain.t } + +let start ~pid ~interval = + let stop_flag = Atomic.make false in + let domain = + Domain.spawn (fun () -> + let rec loop peak = + if Atomic.get stop_flag then peak + else begin + (* sample before waiting so that we get a reading at launch *) + let rss = get_rss_kb pid in + (try Unix.sleepf interval + with Unix.Unix_error (Unix.EINTR, _, _) -> ()); + loop (max rss peak) + end + in + loop 0) + in + { stop_flag; domain } + +let stop t = + Atomic.set t.stop_flag true; + Domain.join t.domain diff --git a/lib/olly_common/rss_poller.mli b/lib/olly_common/rss_poller.mli new file mode 100644 index 0000000..4ef281b --- /dev/null +++ b/lib/olly_common/rss_poller.mli @@ -0,0 +1,11 @@ +(** Sample a process's peak resident set size from a dedicated domain. *) + +type t + +val start : pid:int -> interval:float -> t +(** [start ~pid ~interval] spawns a domain that samples the RSS of [pid] every + [interval] seconds, tracking the peak. *) + +val stop : t -> int +(** [stop t] signals the poller to stop, waits for it to finish, and returns the + peak RSS observed, in kB. *) diff --git a/lib/olly_gc_stats/olly_gc_stats.5.0.ml b/lib/olly_gc_stats/olly_gc_stats.5.0.ml index 16d5b01..82fe585 100644 --- a/lib/olly_gc_stats/olly_gc_stats.5.0.ml +++ b/lib/olly_gc_stats/olly_gc_stats.5.0.ml @@ -152,8 +152,8 @@ let print_percentiles json output hist outliers = !major_collections !forced_major_collections; Printf.fprintf oc "Compactions: %i\n" !compactions) -let gc_stats poll_sleep json output runtime_events_dir runtime_events_log_wsize - exec_args = +let gc_stats poll_sleep rss_freq json output runtime_events_dir + runtime_events_log_wsize exec_args = let current_event = Hashtbl.create 13 in let hist = H.init ~lowest_discernible_value:10 ~highest_trackable_value @@ -218,9 +218,19 @@ let gc_stats poll_sleep json output runtime_events_dir runtime_events_log_wsize in let init = Fun.id in - let cleanup () = print_percentiles json output hist outliers in - let on_poll = Olly_common.Max_rss.sample rss_collector in let open Olly_common.Launch in + let rss_poller = ref None in + let on_launch child = + rss_poller := + Some (Olly_common.Rss_poller.start ~pid:child.pid ~interval:rss_freq) + in + let cleanup () = + Option.iter + (fun p -> + Olly_common.Max_rss.set rss_collector (Olly_common.Rss_poller.stop p)) + !rss_poller; + print_percentiles json output hist outliers + in try `Ok (olly @@ -232,7 +242,7 @@ let gc_stats poll_sleep json output runtime_events_dir runtime_events_log_wsize lifecycle; init; cleanup; - on_poll; + on_launch; poll_sleep; runtime_events_dir; runtime_events_log_wsize; diff --git a/lib/olly_gc_stats/olly_gc_stats.5.3.ml b/lib/olly_gc_stats/olly_gc_stats.5.3.ml index a085150..21db94b 100644 --- a/lib/olly_gc_stats/olly_gc_stats.5.3.ml +++ b/lib/olly_gc_stats/olly_gc_stats.5.3.ml @@ -222,8 +222,8 @@ let print_percentiles json output hist outliers = !major_collections !forced_major_collections; Printf.fprintf oc "Compactions: %i\n" !compactions) -let gc_stats poll_sleep json output runtime_events_dir runtime_events_log_wsize - exec_args = +let gc_stats poll_sleep rss_freq json output runtime_events_dir + runtime_events_log_wsize exec_args = let current_event = Hashtbl.create 13 in let hist = H.init ~lowest_discernible_value:10 ~highest_trackable_value @@ -292,9 +292,19 @@ let gc_stats poll_sleep json output runtime_events_dir runtime_events_log_wsize in let init = Fun.id in - let cleanup () = print_percentiles json output hist outliers in - let on_poll = Olly_common.Max_rss.sample rss_collector in let open Olly_common.Launch in + let rss_poller = ref None in + let on_launch child = + rss_poller := + Some (Olly_common.Rss_poller.start ~pid:child.pid ~interval:rss_freq) + in + let cleanup () = + Option.iter + (fun p -> + Olly_common.Max_rss.set rss_collector (Olly_common.Rss_poller.stop p)) + !rss_poller; + print_percentiles json output hist outliers + in try `Ok (olly @@ -306,7 +316,7 @@ let gc_stats poll_sleep json output runtime_events_dir runtime_events_log_wsize lifecycle; init; cleanup; - on_poll; + on_launch; poll_sleep; runtime_events_dir; runtime_events_log_wsize; diff --git a/lib/olly_gc_stats/olly_gc_stats.ml b/lib/olly_gc_stats/olly_gc_stats.ml index a3dc0eb..8c6e274 100644 --- a/lib/olly_gc_stats/olly_gc_stats.ml +++ b/lib/olly_gc_stats/olly_gc_stats.ml @@ -48,7 +48,8 @@ let gc_stats_cmd = `I ( "Max RSS", "Peak resident set size (in kB) of the child process, sampled during \ - execution." ); + execution. The sampling interval is controlled by $(b,--rss-freq) \ + and is independent of $(b,--freq)." ); `Blocks help_secs; ] in @@ -59,8 +60,8 @@ let gc_stats_cmd = Term.( ret (const Olly_gc_impl.gc_stats - $ freq_option $ json_option $ output_option $ runtime_events_dir - $ runtime_events_log_wsize $ exec_args 0)) + $ freq_option $ rss_freq_option $ json_option $ output_option + $ runtime_events_dir $ runtime_events_log_wsize $ exec_args 0)) let latency_cmd = let open Cmdliner in diff --git a/lib/olly_trace/olly_trace.ml b/lib/olly_trace/olly_trace.ml index 4f8c60b..71d0188 100644 --- a/lib/olly_trace/olly_trace.ml +++ b/lib/olly_trace/olly_trace.ml @@ -28,7 +28,7 @@ let trace poll_sleep fmt trace_filename emit_counter runtime_events_dir and runtime_end = runtime_phase SpanEnd and init () = () and cleanup () = Format.close tracer - and on_poll = fun _ -> () + and on_launch = fun _ -> () and extra = Olly_custom_events.v tracer and lifecycle _ _ _ _ = () in let open Olly_common.Launch in @@ -41,7 +41,7 @@ let trace poll_sleep fmt trace_filename emit_counter runtime_events_dir lifecycle; init; cleanup; - on_poll; + on_launch; poll_sleep; runtime_events_dir; runtime_events_log_wsize; diff --git a/test/cram/olly.t b/test/cram/olly.t index 3b97d84..2b039e4 100644 --- a/test/cram/olly.t +++ b/test/cram/olly.t @@ -147,7 +147,8 @@ GC stats subcommand help: Max RSS Peak resident set size (in kB) of the child process, sampled - during execution. + during execution. The sampling interval is controlled by + --rss-freq and is independent of --freq. ARGUMENTS EXECUTABLE @@ -180,6 +181,12 @@ GC stats subcommand help: Redirect the output of `olly` to specified file. The output of the command is not redirected. + --rss-freq=rss-freq (absent=0.1) + Set the interval, in seconds, at which the peak RSS of the + monitored process is sampled. Sampling runs on a dedicated domain, + independently of --freq. A value of 0.0 samples as fast as + possible. + COMMON OPTIONS These options are common to all commands. From 29a46b08a1ceabfeeb50062cf325c992878c56bd Mon Sep 17 00:00:00 2001 From: Nikos Gkorogiannis Date: Thu, 25 Jun 2026 18:23:33 +0200 Subject: [PATCH 4/4] [gc-stats] only report event drop at end --- lib/olly_common/launch.ml | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/lib/olly_common/launch.ml b/lib/olly_common/launch.ml index 8e37222..2b9cf3e 100644 --- a/lib/olly_common/launch.ml +++ b/lib/olly_common/launch.ml @@ -1,7 +1,11 @@ external is_process_alive : int -> bool = "olly_is_process_alive" -let lost_events ring_id num = - Printf.eprintf "[ring_id=%d] Lost %d events\n%!" ring_id num +let lost_events_count = ref 0 + +let lost_events _ring_id num = + let sum = !lost_events_count + num in + (* detect overflow and stay at [max_int] *) + lost_events_count := if sum < 0 then max_int else sum type subprocess = { alive : unit -> bool; @@ -193,7 +197,17 @@ let empty_config = let olly config exec_args = config.init (); - Fun.protect ~finally:config.cleanup (fun () -> + let finally () = + config.cleanup (); + if !lost_events_count > 0 then begin + Printf.eprintf "Lost %d events, stats not reliable%s\n%!" + !lost_events_count + (if !lost_events_count = max_int then + " (possible counter overflow detected)\n%!" + else "") + end + in + Fun.protect ~finally (fun () -> let runtime_config = { dir = config.runtime_events_dir;