observe: short `obs run` triage + span-precise locations · gazagnaire.org/ocaml-observe@afdfc78

+7 -4

bin/obs/cmd_common.ml

··· 2 2 let json_enabled () = !current_json 3 3 let err_usage fmt = Fmt.kstr (fun s -> Error (`Msg s)) fmt 4 4 5 - (* Render a computed report to stdout, JSON under [--json] else the text report 6 - with colour decided by whether stdout is a tty. *) 7 - let render_report opts report = 5 + (* Render a computed report to stdout with [text], JSON under [--json] else the 6 + text report with colour decided by whether stdout is a tty. *) 7 + let render ~text opts report = 8 8 let out = 9 9 if json_enabled () then Observer_model.Memtrace_eio.Render.to_json report 10 10 else ··· 14 14 Observer_model.Memtrace_eio.Render.color = Unix.isatty Unix.stdout; 15 15 } 16 16 in 17 - Observer_model.Memtrace_eio.Render.to_string opts report 17 + text opts report 18 18 in 19 19 print_string out 20 + 21 + let render_report = render ~text:Observer_model.Memtrace_eio.Render.to_string 22 + let render_summary = render ~text:Observer_model.Memtrace_eio.Render.to_summary 20 23 21 24 open Cmdliner 22 25

+11 -2

bin/obs/cmd_common.mli

View file

··· 13 13 Observer_model.Memtrace_eio.Render.opts -> 14 14 Observer_model.Memtrace_eio.Report.t -> 15 15 unit 16 - (** [render_report opts report] prints [report] to stdout: JSON under [--json], 17 - otherwise the text report coloured when stdout is a tty. *) 16 + (** [render_report opts report] prints the full [report] to stdout: JSON under 17 + [--json], otherwise the text report coloured when stdout is a tty. *) 18 + 19 + val render_summary : 20 + Observer_model.Memtrace_eio.Render.opts -> 21 + Observer_model.Memtrace_eio.Report.t -> 22 + unit 23 + (** [render_summary opts report] prints only the triage (budget, verdict, 24 + findings) to stdout: JSON under [--json], otherwise the short text report 25 + coloured when stdout is a tty. Used by [obs run]; [obs report] prints the 26 + full {!render_report}. *) 18 27 19 28 val opts_term : Observer_model.Memtrace_eio.Render.opts Cmdliner.Term.t 20 29 (** [opts_term] parses [--top], [--min], [--all] and [--sort] into render

+10 -3

bin/obs/cmd_run.ml

View file

··· 214 214 (* Collection ended: write the bundle from the collector's sinks, then build the 215 215 model and render the report -- the same path obs report takes offline. *) 216 216 let finalize ~server ~sink ~sqlite ~sqlite_file ~catapult ~memtrace_dir ~fxt 217 - ~base ~start ~stop ~cpu opts = 217 + ~base ~run_id ~start ~stop ~cpu opts = 218 218 Fxt_adapter.Sink.to_file sink fxt; 219 219 prerr_endline ("obs: wrote scheduler/GC trace " ^ fxt); 220 220 Option.iter ··· 255 255 must use Observe.setup). Allocation findings omitted; the GC budget \ 256 256 is still measured.") 257 257 else List.iter (fun ctf -> Ctf_input.feed model ctf) ctfs; 258 - Cmd_common.render_report opts (Model.report model); 258 + Cmd_common.render_summary opts (Model.report model); 259 + (* The summary is the triage; the detail tables (spans, fibers, GC, 260 + allocations) are one command away on the saved bundle. [obs report] takes 261 + the bundle id under .obs, or the explicit --out base. *) 262 + let report_ref = Option.value run_id ~default:base in 263 + prerr_endline 264 + ("obs: full report (spans, fibers, GC, allocations): obs report " 265 + ^ report_ref); 259 266 render_cpu_profile cpu 260 267 261 268 (* One capture path: bind a collector socket; with a CMD, spawn it as a producer ··· 341 348 status := st; 342 349 let stop = Unix.gettimeofday () in 343 350 finalize ~server ~sink ~sqlite ~sqlite_file ~catapult ~memtrace_dir ~fxt 344 - ~base ~start ~stop ~cpu opts); 351 + ~base ~run_id ~start ~stop ~cpu opts); 345 352 (* The Eio listener removes the socket on switch close; tolerate that it may 346 353 already be gone. *) 347 354 (try Unix.unlink sock with Unix.Unix_error _ -> ());

+217 -44

lib/obs/memtrace_eio.ml

View file

··· 66 66 alloc_words : int; 67 67 } 68 68 69 - type suspend = { reason : string; total : float; sus_count : int } 69 + type suspend = { 70 + reason : string; 71 + total : float; 72 + sus_count : int; 73 + where : string option; 74 + (** the span most of this reason's suspended time was charged under, 75 + when the fiber blocked inside a traced span; [None] when it blocked 76 + outside any span. *) 77 + } 70 78 71 79 type fiber = { 72 80 id : int; ··· 75 83 resumes : int; 76 84 spawn : string; 77 85 lifetime : float option; 86 + location : string option; 87 + (** the span this fiber spent most of its running time in, when it ran 88 + inside a span it opened; [None] when it ran outside any span. *) 78 89 } 79 90 80 91 type idle_gap = { start_ns : int64; duration : float } ··· 153 164 type ring_state = { 154 165 mutable cur_fiber : int option; 155 166 mutable fiber_since : int64; (* when cur_fiber started running *) 156 - mutable span_stack : (string * int64 * float ref) list; 157 - (* name, enter ts, accumulated child-inclusive time to subtract *) 167 + mutable span_stack : (string * int64 * float ref * int option) list; 168 + (* name, enter ts, accumulated child-inclusive time to subtract, and 169 + the fiber that opened the span (so a fiber's running time is charged 170 + only to spans it opened, not to a span left open across a suspend 171 + while a different fiber runs) *) 158 172 mutable domain_suspended_since : int64 option; 159 173 mutable last_ts : int64; 160 174 mutable first_ts : int64 option; ··· 174 188 mutable spawn : string; 175 189 mutable created_ts : int64 option; 176 190 mutable exit_ts : int64 option; 191 + span_time : (string, float) Hashtbl.t; 192 + (* running seconds per span the fiber opened; its dominant span is its 193 + reported location *) 177 194 } 178 195 179 196 type cc_acc = { kind : Eio_runtime_events.cc_ty } ··· 193 210 (* ring -> object name a blocked Try_get is waiting on, consumed by the 194 211 next Suspend_fiber on that ring *) 195 212 suspend_total : (string, float * int) Hashtbl.t; 196 - mutable suspend_open : (int * string * int64 * string option) list; 213 + suspend_where : (string, (string, float) Hashtbl.t) Hashtbl.t; 214 + (* reason -> span -> blocked secs: where each suspend reason was waiting, 215 + by the span active when it suspended *) 216 + fiber_block : (int, (string, float) Hashtbl.t) Hashtbl.t; 217 + (* fiber -> block label -> blocked secs: what each fiber spent its 218 + suspended time waiting on (reason, with the active span when known) *) 219 + fiber_block_in_span : (int, float) Hashtbl.t; 220 + (* fiber -> blocked secs that elapsed inside a traced span: when this is 221 + most of a fiber's blocked time, its wait is already accounted for in 222 + the span hotspots, so the waiting-fiber finding is redundant *) 223 + mutable suspend_open : 224 + (int * string * int64 * string option * int option * string option) list; 197 225 (* ring, reason, ts, object blocked on (if a Try_get preceded the 198 - suspend) for fibers currently suspended *) 226 + suspend), the suspending fiber, and the span active at suspend time, 227 + for fibers currently suspended *) 199 228 mutable lost : int; 200 229 mutable n_events : int; 201 230 (* GC *) ··· 253 282 contention_wait = Hashtbl.create 16; 254 283 pending_block = Hashtbl.create 16; 255 284 suspend_total = Hashtbl.create 32; 285 + suspend_where = Hashtbl.create 32; 286 + fiber_block = Hashtbl.create 64; 287 + fiber_block_in_span = Hashtbl.create 64; 256 288 suspend_open = []; 257 289 lost = 0; 258 290 n_events = 0; ··· 336 368 spawn = "?"; 337 369 created_ts = None; 338 370 exit_ts = None; 371 + span_time = Hashtbl.create 4; 339 372 } 340 373 in 341 374 Hashtbl.add t.fibers id a; ··· 357 390 | Some _ -> ()); 358 391 if Int64.compare ts_ns t.mono_last > 0 then t.mono_last <- ts_ns 359 392 360 - (* Stop running [cur_fiber] on [rs], crediting elapsed time to it. *) 393 + (* The innermost span open on [rs] (the location active when a fiber suspends), 394 + or [None] when no span is open. *) 395 + let innermost_span rs = 396 + match rs.span_stack with (name, _, _, _) :: _ -> Some name | [] -> None 397 + 398 + (* The innermost span on [rs] that fiber [fid] itself opened, so a fiber's 399 + running time is attributed only to its own spans -- not to one an ancestor 400 + left open across a suspend while [fid] ran underneath it. *) 401 + let fiber_span rs fid = 402 + let rec find = function 403 + | (name, _, _, opener) :: rest -> 404 + if opener = Some fid then Some name else find rest 405 + | [] -> None 406 + in 407 + find rs.span_stack 408 + 409 + (* Add [dt] seconds to [h] under [key]. *) 410 + let bump h key dt = 411 + let cur = Option.value (Hashtbl.find_opt h key) ~default:0. in 412 + Hashtbl.replace h key (cur +. dt) 413 + 414 + (* Add [dt] to the inner [k2] bucket of the nested table [outer.(k1)], creating 415 + the inner table on first use. *) 416 + let bump2 outer k1 k2 dt = 417 + let inner = 418 + match Hashtbl.find_opt outer k1 with 419 + | Some inner -> inner 420 + | None -> 421 + let inner = Hashtbl.create 4 in 422 + Hashtbl.add outer k1 inner; 423 + inner 424 + in 425 + bump inner k2 dt 426 + 427 + (* The key holding the largest value in [h], or [None] when empty. Ties break 428 + on the lexicographically smaller key so the label is deterministic. *) 429 + let argmax h = 430 + Hashtbl.fold 431 + (fun k v acc -> 432 + match acc with 433 + | Some (bk, bv) when bv > v || (bv = v && bk <= k) -> acc 434 + | _ -> Some (k, v)) 435 + h None 436 + |> Option.map fst 437 + 438 + (* Stop running [cur_fiber] on [rs], crediting elapsed time to it and to the 439 + fiber's own innermost span (its location). *) 361 440 let stop_fiber t rs ~ts_ns = 362 441 match rs.cur_fiber with 363 442 | None -> () 364 443 | Some fid -> 365 444 let dt = s_of_ns (Int64.sub ts_ns rs.fiber_since) in 366 - if dt > 0. then 367 - (fiber_acc t fid).run_time <- (fiber_acc t fid).run_time +. dt 445 + if dt > 0. then begin 446 + let fa = fiber_acc t fid in 447 + fa.run_time <- fa.run_time +. dt; 448 + match fiber_span rs fid with 449 + | Some name -> bump fa.span_time name dt 450 + | None -> () 451 + end 368 452 369 453 let start_fiber rs ~fid ~ts_ns = 370 454 rs.cur_fiber <- Some fid; ··· 399 483 else Hashtbl.replace t.objs id n 400 484 | `Log _ -> () 401 485 | `Enter_span name -> 402 - rs.span_stack <- (name, ts_ns, ref 0.) :: rs.span_stack 486 + rs.span_stack <- (name, ts_ns, ref 0., rs.cur_fiber) :: rs.span_stack 403 487 | `Exit_span -> ( 404 488 match rs.span_stack with 405 489 | [] -> () 406 - | (name, enter, child) :: rest -> 490 + | (name, enter, child, _) :: rest -> 407 491 let incl = s_of_ns (Int64.sub ts_ns enter) in 408 492 let self = incl -. !child in 409 493 let a = span_acc t name in ··· 412 496 Quantile.add a.durations incl; 413 497 t.span_intervals <- (name, enter, ts_ns) :: t.span_intervals; 414 498 (match rest with 415 - | (_, _, parent_child) :: _ -> parent_child := !parent_child +. incl 499 + | (_, _, parent_child, _) :: _ -> 500 + parent_child := !parent_child +. incl 416 501 | [] -> ()); 417 502 rs.span_stack <- rest) 418 503 | `Get id -> ··· 451 536 { start_ns = since; duration = dt } :: t.idle_gaps.gaps; 452 537 rs.domain_suspended_since <- None) 453 538 | `Suspend_fiber reason -> 539 + (* Snapshot who is suspending and where: [cur_fiber] still holds the 540 + suspending fiber and [span_stack] its active span, both lost once the 541 + fiber is cleared below. *) 542 + let fiber = rs.cur_fiber in 543 + let span = innermost_span rs in 454 544 (match rs.cur_fiber with 455 545 | Some _ -> 456 546 stop_fiber t rs ~ts_ns; ··· 458 548 | None -> ()); 459 549 let obj = Hashtbl.find_opt t.pending_block ring in 460 550 Hashtbl.remove t.pending_block ring; 461 - t.suspend_open <- (ring, reason, ts_ns, obj) :: t.suspend_open 551 + t.suspend_open <- 552 + (ring, reason, ts_ns, obj, fiber, span) :: t.suspend_open 462 553 | `Domain_spawn id -> (fiber_acc t id).spawn <- "domain_spawn" 463 554 464 - (* Charge one closing suspend to its reason and, when a blocked Try_get 465 - preceded it, to the object it was waiting on. *) 466 - let charge_suspend t ~ts_ns (_, reason, since, obj) = 555 + (* What a fiber was waiting on: the suspend reason, qualified by the span it 556 + blocked under when one is open. An empty reason inside a span is named by 557 + the span; outside any span it stays "(unspecified)". *) 558 + let block_label reason span = 559 + match (reason, span) with 560 + | "", Some s -> s 561 + | "", None -> "(unspecified)" 562 + | r, Some s -> Fmt.str "%s @ %s" r s 563 + | r, None -> r 564 + 565 + (* Charge one closing suspend to its reason, to the span it blocked under, to 566 + the fiber that blocked, and -- when a blocked Try_get preceded it -- to the 567 + object it was waiting on. *) 568 + let charge_suspend t ~ts_ns (_, reason, since, obj, fiber, span) = 467 569 let dt = s_of_ns (Int64.sub ts_ns since) in 468 570 let tot, n = 469 571 Option.value (Hashtbl.find_opt t.suspend_total reason) ~default:(0., 0) 470 572 in 471 573 Hashtbl.replace t.suspend_total reason (tot +. dt, n + 1); 472 - match obj with 473 - | None -> () 474 - | Some name -> 475 - let cur = 476 - Option.value (Hashtbl.find_opt t.contention_wait name) ~default:0. 477 - in 478 - Hashtbl.replace t.contention_wait name (cur +. dt) 574 + (match span with Some s -> bump2 t.suspend_where reason s dt | None -> ()); 575 + (match fiber with 576 + | Some f -> 577 + bump2 t.fiber_block f (block_label reason span) dt; 578 + if span <> None then bump t.fiber_block_in_span f dt 579 + | None -> ()); 580 + match obj with None -> () | Some name -> bump t.contention_wait name dt 479 581 480 582 let close_suspends t ~ts_ns = 481 583 List.iter (charge_suspend t ~ts_ns) t.suspend_open; ··· 491 593 | `Fiber _ -> 492 594 (* close suspends on this ring *) 493 595 let to_close, keep = 494 - List.partition (fun (r, _, _, _) -> r = ring) t.suspend_open 596 + List.partition (fun (r, _, _, _, _, _) -> r = ring) t.suspend_open 495 597 in 496 598 List.iter (charge_suspend t ~ts_ns) to_close; 497 599 t.suspend_open <- keep ··· 732 834 (fun (a, x) (b, y) -> match compare y x with 0 -> compare a b | c -> c) 733 835 merged 734 836 735 - (* 1. dominant wait cause (I/O / scheduler idle). *) 837 + (* A timer/poll wait (Eio names a sleep "sleep"): the fix is to find the 838 + polling or backoff loop, not to batch syscalls. *) 839 + let is_timer_cause cause = 840 + let p = "sleep" in 841 + String.length cause >= String.length p && String.sub cause 0 5 = p 842 + 843 + (* 1. dominant wait cause (I/O / scheduler idle). The dominant span the cause 844 + waited under, when known, names where to look and switches the fix from 845 + "batch the syscalls" to "inspect the polling loop" for timer waits. *) 736 846 let detect_wait ~add ~frac ~dur_s ~pct_s t ~waiting ~waiting_by_cause = 737 847 match waiting_by_cause with 738 848 | (cause, secs) :: _ when frac waiting >= 0.2 -> ··· 747 857 (dur_s (secs /. float_of_int count)) 748 858 else "domain idle" 749 859 in 860 + let where = 861 + Option.bind (Hashtbl.find_opt t.suspend_where cause) argmax 862 + in 863 + let in_span = 864 + match where with Some s -> Fmt.str " in %s" s | None -> "" 865 + in 866 + let fix = 867 + if is_timer_cause cause then 868 + match where with 869 + | Some s -> Fmt.str "inspect the polling or backoff loop in %s" s 870 + | None -> "identify the polling or backoff loop driving the sleeps" 871 + else "batch or buffer the blocking calls to amortise the wait" 872 + in 750 873 add "syscall" 751 874 ~diagnosis: 752 - (Fmt.str "I/O-bound: %s of wall is blocked, dominated by %s" 875 + (Fmt.str "I/O-bound: %s of wall is blocked, dominated by %s%s" 753 876 (pct_s (frac waiting)) 754 - cause) 755 - ~evidence:(Fmt.str "%s blocked on %s (%s)" (dur_s secs) cause rate) 756 - ~fix:"batch or buffer the blocking calls to amortise the wait" 757 - ~payoff:secs ~certainty:Report.Measured 877 + cause in_span) 878 + ~evidence: 879 + (Fmt.str "%s blocked on %s%s (%s)" (dur_s secs) cause in_span rate) 880 + ~fix ~payoff:secs ~certainty:Report.Measured 758 881 | _ -> () 759 882 760 883 (* 2. lock / sync contention on a named object. *) ··· 861 984 | _ -> acc) 862 985 t.fibers None 863 986 864 - (* 4. a non-root fiber that spends almost all its life suspended. *) 987 + (* 4. a non-root fiber that spends almost all its life suspended. The fiber's 988 + own spans name where it runs and its dominant block label names what it 989 + waits on, so the finding points at a real location instead of a generic 990 + "check its dependency". *) 991 + (* The fraction of a fiber's charged block time that elapsed inside a traced 992 + span. When most of it did, the wait already shows up in the span hotspots, 993 + so flagging the fiber would just restate that lower-ranked evidence. *) 994 + let span_explained_block t id = 995 + let total = 996 + match Hashtbl.find_opt t.fiber_block id with 997 + | Some h -> Hashtbl.fold (fun _ v a -> a +. v) h 0. 998 + | None -> 0. 999 + in 1000 + let in_span = 1001 + Option.value (Hashtbl.find_opt t.fiber_block_in_span id) ~default:0. 1002 + in 1003 + total > 0. && in_span /. total >= 0.5 1004 + 865 1005 let detect_waiting_fiber ~add ~dur_s t ~n_fibers = 866 1006 let is_root = root_predicate t ~n_fibers in 867 1007 match most_suspended_fiber t ~is_root with 868 - | Some (id, (f : fiber_acc), suspended) -> 869 - let label = Option.value f.name ~default:(string_of_int id) in 1008 + | Some (id, (f : fiber_acc), suspended) when not (span_explained_block t id) 1009 + -> 1010 + let name = Option.value f.name ~default:(string_of_int id) in 1011 + let runs_in = 1012 + match argmax f.span_time with 1013 + | Some s -> Fmt.str " (runs in %s)" s 1014 + | None -> "" 1015 + in 1016 + let blocked_on = 1017 + match Option.bind (Hashtbl.find_opt t.fiber_block id) argmax with 1018 + | Some label -> label 1019 + | None -> "its dependency" 1020 + in 870 1021 add "fiber" 871 1022 ~diagnosis: 872 - (Fmt.str "fiber %s is almost always waiting, not running" label) 1023 + (Fmt.str "fiber %s%s is almost always waiting, not running" name 1024 + runs_in) 873 1025 ~evidence: 874 - (Fmt.str "%s suspended vs %s running" (dur_s suspended) 875 - (dur_s f.run_time)) 876 - ~fix:"check whether this fiber's dependency is the real bottleneck" 1026 + (Fmt.str "%s suspended (mostly on %s) vs %s running" 1027 + (dur_s suspended) blocked_on (dur_s f.run_time)) 1028 + ~fix:(Fmt.str "check whether %s is the real bottleneck" blocked_on) 877 1029 ~payoff:suspended ~certainty:Report.Estimate 878 - | None -> () 1030 + | _ -> () 879 1031 880 1032 (* 5. GC-tail latency: a long stop-the-world straggler. *) 881 1033 let detect_gc_tail ~add ~frac ~dur_s t = ··· 1010 1162 let suspends = 1011 1163 Hashtbl.fold 1012 1164 (fun reason (total, n) acc -> 1013 - { Report.reason; total; sus_count = n } :: acc) 1165 + let where = 1166 + Option.bind (Hashtbl.find_opt t.suspend_where reason) argmax 1167 + in 1168 + { Report.reason; total; sus_count = n; where } :: acc) 1014 1169 t.suspend_total [] 1015 1170 in 1016 1171 let fibers = ··· 1028 1183 resumes = f.resumes; 1029 1184 spawn = f.spawn; 1030 1185 lifetime; 1186 + location = argmax f.span_time; 1031 1187 } 1032 1188 :: acc) 1033 1189 t.fibers [] ··· 1526 1682 in 1527 1683 if by_time = [] then line "(no fiber suspends recorded)" 1528 1684 else begin 1529 - line " %-32s %10s %8s" "Reason" "Total" "Count"; 1685 + line " %-24s %10s %8s %s" "Reason" "Total" "Count" "Where"; 1530 1686 List.iter 1531 1687 (fun (s : Report.suspend) -> 1532 1688 let reason = if s.reason = "" then "(unspecified)" else s.reason in 1533 - line " %-32s %10s %8s" reason (dur s.total) (group s.sus_count)) 1689 + let where = Option.value s.where ~default:"-" in 1690 + line " %-24s %10s %8s %s" reason (dur s.total) (group s.sus_count) 1691 + where) 1534 1692 by_time 1535 1693 end; 1536 1694 blank () ··· 1554 1712 in 1555 1713 if rows = [] then line "(no fibers recorded)" 1556 1714 else begin 1557 - line " %-6s %10s %8s %-16s %-16s %10s" "Fiber" "Run" "Resumes" "Spawn" 1558 - "Name" "Lifetime"; 1715 + line " %-6s %10s %8s %-14s %-12s %10s %s" "Fiber" "Run" "Resumes" 1716 + "Spawn" "Name" "Lifetime" "Where"; 1559 1717 List.iter 1560 1718 (fun (f : Report.fiber) -> 1561 - line " %-6d %10s %8s %-16s %-16s %10s" f.id (dur f.run_time) 1719 + line " %-6d %10s %8s %-14s %-12s %10s %s" f.id (dur f.run_time) 1562 1720 (group f.resumes) f.spawn 1563 1721 (Option.value f.fib_name ~default:"-") 1564 - (match f.lifetime with Some l -> dur l | None -> "-")) 1722 + (match f.lifetime with Some l -> dur l | None -> "-") 1723 + (Option.value f.location ~default:"-")) 1565 1724 rows 1566 1725 end; 1567 1726 blank () ··· 1733 1892 contention_section b r; 1734 1893 error_section b r; 1735 1894 alloc_section b opts r 1895 + end; 1896 + Buffer.contents b 1897 + 1898 + (* The triage only: budget, verdict and ranked findings, the same three 1899 + sections [to_string] leads with. [obs run] prints this and points at [obs 1900 + report] for the detail tables. *) 1901 + let to_summary opts (r : Report.t) = 1902 + let b = Buffer.create 1024 in 1903 + let min_frac = Float.max opts.min_share 0.01 in 1904 + if r.allocation_only then allocation_only_section b r 1905 + else begin 1906 + budget_section b ~color:opts.color ~min_frac r; 1907 + verdict_section b r; 1908 + findings_section b r 1736 1909 end; 1737 1910 Buffer.contents b 1738 1911

+19 -2

lib/obs/memtrace_eio.mli

View file

··· 120 120 (** allocation words attributed to this span (best-effort). *) 121 121 } 122 122 123 - type suspend = { reason : string; total : float; sus_count : int } 123 + type suspend = { 124 + reason : string; 125 + total : float; 126 + sus_count : int; 127 + where : string option; 128 + (** the span most of this reason's suspended time was charged under, 129 + when the fiber blocked inside a traced span; [None] when it blocked 130 + outside any span. *) 131 + } 124 132 125 133 type fiber = { 126 134 id : int; ··· 128 136 run_time : float; (** total seconds the fiber was the running fiber. *) 129 137 resumes : int; (** number of [`Fiber] (resume) events. *) 130 138 spawn : string; (** spawn site: parent CC kind or domain spawn. *) 131 - lifetime : float option; (** Create -> Exit_fiber, seconds, if both seen. *) 139 + lifetime : float option; 140 + (** Create -> Exit_fiber, seconds, if both seen. *) 141 + location : string option; 142 + (** the span this fiber spent most of its running time in, when it ran 143 + inside a span it opened; [None] when it ran outside any span. *) 132 144 } 133 145 134 146 type idle_gap = { start_ns : int64; duration : float } ··· 296 308 (** [to_string opts r] renders the full report as deterministic plain text: 297 309 [== BUDGET ==], [== VERDICT ==] and [== FINDINGS ==] first, then the 298 310 detailed evidence tables. *) 311 + 312 + val to_summary : opts -> Report.t -> string 313 + (** [to_summary opts r] renders only the triage -- [== BUDGET ==], 314 + [== VERDICT ==] and [== FINDINGS ==] -- without the detail tables. 315 + [obs run] prints this and points at [obs report] for the rest. *) 299 316 300 317 val to_json : Report.t -> string 301 318 (** [to_json r] renders the budget, verdict and findings as a JSON object

+13

test/cram/cli.t/run.t

View file

··· 118 118 $ find obs-run.memtrace -name '*.ctf' | wc -l | tr -d ' ' 119 119 1 120 120 121 + obs run prints the short triage (budget/verdict/findings) on stdout and drops 122 + the detail tables, pointing at obs report for them on stderr. 123 + $ grep -q "== FINDINGS ==" obs-run-report.txt && echo "triage printed" 124 + triage printed 125 + $ grep -q "Span hotspots" obs-run-report.txt && echo "has detail" || echo "short" 126 + short 127 + $ grep -q "full report.*obs report obs-run" obs-run-stderr.txt && echo "points at report" 128 + points at report 129 + 121 130 obs run --sqlite writes a queryable database; obs query lists the canonical 122 131 queries and runs canonical or ad-hoc SQL over it. 123 132 $ obs run --out obs-sql --sqlite obs-sql.db -- test_cli.exe >/dev/null 2>&1 ··· 171 180 172 181 $ grep -m 1 '== BUDGET ==' obs-spawn-report2.txt 173 182 == BUDGET == 183 + 184 + obs report keeps the full detail tables that obs run's triage omits. 185 + $ grep -q "Span hotspots" obs-spawn-report2.txt && echo "report is full" 186 + report is full 174 187 175 188 obs run observes an Eio program through the same single path: the forwarder 176 189 drains its Eio scheduler events (category "eio" in the fxt), not just GC.

+203

test/obs_eio/test_memtrace_eio.ml

View file

··· 501 501 (contains f.diagnosis "fiber 2 is"); 502 502 Alcotest.(check bool) "no doubling" false (contains f.diagnosis "fiber fiber") 503 503 504 + (* --- Precise locations: spans name where fibers run and suspends block --- *) 505 + 506 + (* A fiber's location is the span it opened and ran inside. Fiber 2 enters 507 + "compute.inner" and runs there for 20ms before yielding, so the report 508 + attributes its running time to that span. *) 509 + let test_fiber_location () = 510 + let m = M.v () in 511 + M.set_wall_clock m ~start:0. ~stop:0.1; 512 + M.eio_event m ~ring:0 ~ts_ns:(ms 0.) (`Create (11, `Cc Switch)); 513 + M.eio_event m ~ring:0 ~ts_ns:(ms 0.) (`Create (2, `Fiber_in 11)); 514 + M.eio_event m ~ring:0 ~ts_ns:(ms 0.) (`Fiber 2); 515 + M.eio_event m ~ring:0 ~ts_ns:(ms 0.) (`Enter_span "compute.inner"); 516 + (* runs 0..20ms inside compute.inner, then yields with the span still open *) 517 + M.eio_event m ~ring:0 ~ts_ns:(ms 20.) (`Suspend_fiber "io"); 518 + M.eio_event m ~ring:0 ~ts_ns:(ms 30.) (`Fiber 2); 519 + M.eio_event m ~ring:0 ~ts_ns:(ms 31.) `Exit_span; 520 + M.eio_event m ~ring:0 ~ts_ns:(ms 31.) (`Exit_fiber 2); 521 + let r = M.report m in 522 + let f = List.find (fun (f : Rep.fiber) -> f.id = 2) r.fibers in 523 + Alcotest.(check (option string)) 524 + "location is its own span" (Some "compute.inner") f.location 525 + 526 + (* Running time is charged only to a span the fiber itself opened. Fiber 1 opens 527 + "outer" and yields with it still on the ring; fiber 2 then runs entirely 528 + inside that open span but did not open it, so its time is not mis-attributed 529 + to "outer" -- only fiber 1 is located there. *) 530 + let test_fiber_location_opener () = 531 + let m = M.v () in 532 + M.set_wall_clock m ~start:0. ~stop:0.1; 533 + M.eio_event m ~ring:0 ~ts_ns:(ms 0.) (`Create (1, `Fiber_in 0)); 534 + M.eio_event m ~ring:0 ~ts_ns:(ms 0.) (`Fiber 1); 535 + M.eio_event m ~ring:0 ~ts_ns:(ms 0.) (`Enter_span "outer"); 536 + M.eio_event m ~ring:0 ~ts_ns:(ms 5.) (`Suspend_fiber "io"); 537 + (* fiber 2 runs 10..40ms while fiber 1's "outer" span is still open *) 538 + M.eio_event m ~ring:0 ~ts_ns:(ms 10.) (`Create (2, `Fiber_in 0)); 539 + M.eio_event m ~ring:0 ~ts_ns:(ms 10.) (`Fiber 2); 540 + M.eio_event m ~ring:0 ~ts_ns:(ms 40.) (`Suspend_fiber "io"); 541 + let r = M.report m in 542 + let f1 = List.find (fun (f : Rep.fiber) -> f.id = 1) r.fibers in 543 + let f2 = List.find (fun (f : Rep.fiber) -> f.id = 2) r.fibers in 544 + Alcotest.(check (option string)) "opener located" (Some "outer") f1.location; 545 + Alcotest.(check (option string)) "no foreign span" None f2.location 546 + 547 + (* A suspend reason's [where] is the span dominating its blocked time. "io" 548 + blocks 15ms inside "fetch" and 5ms outside any span, so its location is 549 + "fetch"; "poll" blocks only outside spans and has no location. *) 550 + let test_suspend_where () = 551 + let m = M.v () in 552 + M.set_wall_clock m ~start:0. ~stop:0.1; 553 + M.eio_event m ~ring:0 ~ts_ns:(ms 0.) (`Fiber 1); 554 + M.eio_event m ~ring:0 ~ts_ns:(ms 0.) (`Enter_span "fetch"); 555 + M.eio_event m ~ring:0 ~ts_ns:(ms 5.) (`Suspend_fiber "io"); 556 + M.eio_event m ~ring:0 ~ts_ns:(ms 20.) (`Fiber 1); 557 + M.eio_event m ~ring:0 ~ts_ns:(ms 20.) `Exit_span; 558 + M.eio_event m ~ring:0 ~ts_ns:(ms 25.) (`Suspend_fiber "io"); 559 + M.eio_event m ~ring:0 ~ts_ns:(ms 30.) (`Fiber 1); 560 + M.eio_event m ~ring:0 ~ts_ns:(ms 30.) (`Suspend_fiber "poll"); 561 + M.eio_event m ~ring:0 ~ts_ns:(ms 35.) (`Fiber 1); 562 + let r = M.report m in 563 + let io = List.find (fun (s : Rep.suspend) -> s.reason = "io") r.suspends in 564 + let poll = 565 + List.find (fun (s : Rep.suspend) -> s.reason = "poll") r.suspends 566 + in 567 + Alcotest.(check (option string)) 568 + "in-span suspend located" (Some "fetch") io.where; 569 + Alcotest.(check (option string)) "out-of-span suspend" None poll.where 570 + 571 + (* The waiting-fiber finding names where the fiber ran and what it blocked on. 572 + Fiber 2 runs briefly in "worker.loop", then blocks outside any span on "db" 573 + for the rest of its life, so the finding cites both. *) 574 + let test_waiting_fiber_location () = 575 + let m = M.v () in 576 + M.set_wall_clock m ~start:0. ~stop:0.1; 577 + M.eio_event m ~ring:0 ~ts_ns:(ms 0.) (`Create (2, `Fiber_in 0)); 578 + M.eio_event m ~ring:0 ~ts_ns:(ms 0.) (`Fiber 2); 579 + M.eio_event m ~ring:0 ~ts_ns:(ms 0.) (`Enter_span "worker.loop"); 580 + (* runs 0..5ms in worker.loop, ticks once in-span, then blocks outside on db *) 581 + M.eio_event m ~ring:0 ~ts_ns:(ms 5.) (`Suspend_fiber "tick"); 582 + M.eio_event m ~ring:0 ~ts_ns:(ms 6.) (`Fiber 2); 583 + M.eio_event m ~ring:0 ~ts_ns:(ms 6.) `Exit_span; 584 + M.eio_event m ~ring:0 ~ts_ns:(ms 6.) (`Suspend_fiber "db"); 585 + M.eio_event m ~ring:0 ~ts_ns:(ms 100.) (`Exit_fiber 2); 586 + let r = M.report m in 587 + let f = List.find (fun (f : Rep.finding) -> f.kind = "fiber") r.findings in 588 + Alcotest.(check bool) 589 + "diagnosis names run location" true 590 + (contains f.diagnosis "worker.loop"); 591 + Alcotest.(check bool) 592 + "evidence names block cause" true (contains f.evidence "db"); 593 + Alcotest.(check bool) "fix names block cause" true (contains f.fix "db") 594 + 595 + (* When a fiber spends its blocked time inside a traced span, the wait is already 596 + visible in the span hotspots, so the redundant waiting-fiber finding is 597 + suppressed. Fiber 2 blocks on "net" entirely inside "io.read". *) 598 + let test_waiting_fiber_span_suppressed () = 599 + let m = M.v () in 600 + M.set_wall_clock m ~start:0. ~stop:0.1; 601 + M.eio_event m ~ring:0 ~ts_ns:(ms 0.) (`Create (2, `Fiber_in 0)); 602 + M.eio_event m ~ring:0 ~ts_ns:(ms 0.) (`Fiber 2); 603 + M.eio_event m ~ring:0 ~ts_ns:(ms 0.) (`Enter_span "io.read"); 604 + M.eio_event m ~ring:0 ~ts_ns:(ms 1.) (`Suspend_fiber "net"); 605 + M.eio_event m ~ring:0 ~ts_ns:(ms 90.) (`Fiber 2); 606 + M.eio_event m ~ring:0 ~ts_ns:(ms 90.) `Exit_span; 607 + M.eio_event m ~ring:0 ~ts_ns:(ms 100.) (`Exit_fiber 2); 608 + let r = M.report m in 609 + let fiber_findings = 610 + List.filter (fun (f : Rep.finding) -> f.kind = "fiber") r.findings 611 + in 612 + Alcotest.(check int) 613 + "span-explained wait suppressed" 0 614 + (List.length fiber_findings) 615 + 616 + (* A sleep-dominated wait is named by its span and gets a polling-loop fix, not 617 + the generic "batch the blocking calls" advice. Fiber 1 sleeps 799ms inside 618 + "poll.loop" while the domain is suspended. *) 619 + let test_wait_sleep_fix () = 620 + let m = M.v () in 621 + M.set_wall_clock m ~start:0. ~stop:1.; 622 + M.eio_event m ~ring:0 ~ts_ns:(ms 0.) (`Fiber 1); 623 + M.eio_event m ~ring:0 ~ts_ns:(ms 0.) (`Enter_span "poll.loop"); 624 + M.eio_event m ~ring:0 ~ts_ns:(ms 1.) (`Suspend_fiber "sleep"); 625 + M.eio_event m ~ring:0 ~ts_ns:(ms 1.) (`Suspend_domain Begin); 626 + M.eio_event m ~ring:0 ~ts_ns:(ms 800.) (`Suspend_domain End); 627 + M.eio_event m ~ring:0 ~ts_ns:(ms 800.) (`Fiber 1); 628 + M.eio_event m ~ring:0 ~ts_ns:(ms 800.) `Exit_span; 629 + let r = M.report m in 630 + let f = List.find (fun (f : Rep.finding) -> f.kind = "syscall") r.findings in 631 + Alcotest.(check bool) 632 + "diagnosis names the span" true 633 + (contains f.diagnosis "poll.loop"); 634 + Alcotest.(check bool) "polling-loop fix" true (contains f.fix "polling"); 635 + Alcotest.(check bool) "not batch advice" false (contains f.fix "batch") 636 + 637 + (* obs run prints the triage; obs report prints the detail tables. to_summary 638 + keeps BUDGET/VERDICT/FINDINGS and drops the spans/fibers/GC tables that 639 + to_string still renders. *) 640 + let test_summary_vs_full () = 641 + let m = M.v () in 642 + M.set_wall_clock m ~start:0. ~stop:0.1; 643 + M.eio_event m ~ring:0 ~ts_ns:(ms 0.) (`Fiber 1); 644 + M.eio_event m ~ring:0 ~ts_ns:(ms 0.) (`Enter_span "render_span"); 645 + M.eio_event m ~ring:0 ~ts_ns:(ms 50.) (`Suspend_fiber "io"); 646 + M.eio_event m ~ring:0 ~ts_ns:(ms 50.) `Exit_span; 647 + let r = M.report m in 648 + let opts = Observer_model.Memtrace_eio.Render.default_opts in 649 + let summary = Observer_model.Memtrace_eio.Render.to_summary opts r in 650 + let full = Observer_model.Memtrace_eio.Render.to_string opts r in 651 + Alcotest.(check bool) "summary budget" true (contains summary "== BUDGET =="); 652 + Alcotest.(check bool) 653 + "summary verdict" true 654 + (contains summary "== VERDICT =="); 655 + Alcotest.(check bool) 656 + "summary findings" true 657 + (contains summary "== FINDINGS =="); 658 + Alcotest.(check bool) 659 + "summary drops spans" false 660 + (contains summary "Span hotspots"); 661 + Alcotest.(check bool) 662 + "summary drops fibers" false 663 + (contains summary "Fibers (by"); 664 + Alcotest.(check bool) 665 + "summary drops gc" false 666 + (contains summary "GC overhead"); 667 + Alcotest.(check bool) "full has spans" true (contains full "Span hotspots"); 668 + Alcotest.(check bool) "full has fibers" true (contains full "Fibers (by"); 669 + Alcotest.(check bool) "full has where column" true (contains full "Where") 670 + 504 671 (* Defect 4: with GC at only 5% of wall and no allocation .ctf set, the gc 505 672 finding must not fire -- there is no trace to drill and 5% is below the 506 673 significance floor. *) ··· 883 1050 Alcotest.(check bool) "fsync row present" true (List.mem_assoc "fsync" causes); 884 1051 Alcotest.(check bool) "no idle catch-all" false (List.mem_assoc "idle" causes) 885 1052 1053 + (* The span locations survive the real obs run -> obs report path: the writer 1054 + serialises a fiber blocking inside a span, the reader replays it, and the 1055 + recomputed report still names where the fiber ran and where it blocked. This 1056 + is the path the CLI takes via the .fxt bundle. *) 1057 + let build_fiber_in_span s = 1058 + let ms n = Int64.of_float (n *. 1e6) in 1059 + let ev ~ts e = Fa.Sink.eio_event s ~ts_ns:(ms ts) e in 1060 + ev ~ts:0. (`Create (101, `Cc Switch)); 1061 + ev ~ts:0. (`Create (2, `Fiber_in 101)); 1062 + ev ~ts:0. (`Fiber 2); 1063 + ev ~ts:0. (`Enter_span "db.query"); 1064 + ev ~ts:5. (`Suspend_fiber "io"); 1065 + ev ~ts:20. (`Fiber 2); 1066 + ev ~ts:20. `Exit_span; 1067 + ev ~ts:21. (`Exit_fiber 2) 1068 + 1069 + let test_fxt_location () = 1070 + let r = fxt_roundtrip build_fiber_in_span in 1071 + let f = List.find (fun (f : Rep.fiber) -> f.id = 2) r.fibers in 1072 + Alcotest.(check (option string)) 1073 + "fiber location through fxt" (Some "db.query") f.location; 1074 + let s = List.find (fun (s : Rep.suspend) -> s.reason = "io") r.suspends in 1075 + Alcotest.(check (option string)) 1076 + "suspend where through fxt" (Some "db.query") s.where 1077 + 886 1078 (* --- ctf offline: feed a hand-written .ctf and check the allocation 887 1079 section. *) 888 1080 ··· 1157 1349 test_root_fiber_not_flagged; 1158 1350 Alcotest.test_case "fiber label not doubled" `Quick 1159 1351 test_fiber_label_not_doubled; 1352 + Alcotest.test_case "fiber location" `Quick test_fiber_location; 1353 + Alcotest.test_case "fiber location opener" `Quick 1354 + test_fiber_location_opener; 1355 + Alcotest.test_case "suspend where" `Quick test_suspend_where; 1356 + Alcotest.test_case "waiting fiber location" `Quick 1357 + test_waiting_fiber_location; 1358 + Alcotest.test_case "waiting fiber span suppressed" `Quick 1359 + test_waiting_fiber_span_suppressed; 1360 + Alcotest.test_case "wait sleep fix" `Quick test_wait_sleep_fix; 1361 + Alcotest.test_case "summary vs full" `Quick test_summary_vs_full; 1160 1362 Alcotest.test_case "gc finding requires ctf" `Quick test_gc_finding_no_ctf; 1161 1363 Alcotest.test_case "gc finding routes to ctf" `Quick 1162 1364 test_gc_finding_with_ctf; ··· 1178 1380 Alcotest.test_case "fxt foreign root not flagged" `Quick 1179 1381 test_fxt_foreign_root_not_flagged; 1180 1382 Alcotest.test_case "fxt named suspends" `Quick test_fxt_named_suspends; 1383 + Alcotest.test_case "fxt location" `Quick test_fxt_location; 1181 1384 Alcotest.test_case "fxt counters" `Quick test_fxt_counters; 1182 1385 Alcotest.test_case "ctf offline" `Quick test_ctf_offline; 1183 1386 Alcotest.test_case "ctf-only report" `Quick test_ctf_only_report;

Configure Feed

Configure Feed