···147147 still measured."
148148 ctf)
149149150150+let read_traces model traces =
151151+ List.iter
152152+ (fun path ->
153153+ match trace_kind path with
154154+ | `Fxt ->
155155+ Log.info (fun m -> m "reading scheduler/GC trace %s" path);
156156+ Fxt_adapter.feed_file model path
157157+ | `Ctf ->
158158+ Log.info (fun m -> m "reading allocation trace %s" path);
159159+ read_memtrace model path)
160160+ traces
161161+162162+let existing_cpu input =
163163+ Option.bind input.cpu (fun path ->
164164+ if Sys.file_exists path then Some path else None)
165165+166166+let render_native_profile inputs native =
167167+ match (List.find_map existing_cpu inputs, native) with
168168+ | Some cpu, Some (backend, target_pid) ->
169169+ let frames = Cpu_sampler.parse_saved cpu in
170170+ if frames <> [] then
171171+ Fmt.pr "%a" (Cpu_sampler.pp_profile ~backend ~target_pid) frames
172172+ | _ -> ()
173173+150174(* Offline analysis of saved traces. Each TRACE is fed into one shared model: a
151175 [.fxt] supplies scheduler and GC events, a [.ctf] supplies allocation
152176 samples. Feeding both produces the unified report; the alloc->span join stays
···173197 let model = Observer_model.Model.v () in
174198 (* Each fxt record is routed to the (process, ring) carried by its
175199 thread, so multiple producers in one trace stay isolated. *)
176176- List.iter
177177- (fun path ->
178178- match trace_kind path with
179179- | `Fxt ->
180180- Log.info (fun m -> m "reading scheduler/GC trace %s" path);
181181- Fxt_adapter.feed_file model path
182182- | `Ctf ->
183183- Log.info (fun m -> m "reading allocation trace %s" path);
184184- read_memtrace model path)
185185- traces;
200200+ read_traces model traces;
186201 Option.iter
187202 (fun (start, stop) ->
188203 Observer_model.Model.set_wall_clock model ~start ~stop)
···192207 Observer_model.Model.set_process_context model ~process ~parent_span)
193208 meta.ctx;
194209 Cmd_common.render_report opts (Observer_model.Model.report model);
195195- (if not (Cmd_common.json_enabled ()) then
196196- match
197197- ( List.find_map
198198- (fun input ->
199199- Option.bind input.cpu (fun path ->
200200- if Sys.file_exists path then Some path else None))
201201- inputs,
202202- meta.native )
203203- with
204204- | Some cpu, Some (backend, target_pid) ->
205205- let frames = Cpu_sampler.parse_saved cpu in
206206- if frames <> [] then
207207- Fmt.pr "%a"
208208- (Cpu_sampler.pp_profile ~backend ~target_pid)
209209- frames
210210- | _ -> ());
210210+ if not (Cmd_common.json_enabled ()) then
211211+ render_native_profile inputs meta.native;
211212 Ok ()
212213 end
213214
···3535 mutable child : int option;
3636}
37373838-(* Spawn the sampler on [pid] without blocking; it stops itself when the child
3939- dies ([-mayDie] / the [sleep] bound) or after [max_secs]. *)
3838+(* Spawn the sampler on [pid] without blocking. Both native profilers attach to
3939+ that process: a default observation must profile the command it was asked to
4040+ run, not every unrelated process on the machine. [stop] interrupts xctrace
4141+ at the observed child's end; [max_secs] remains a safety ceiling. *)
4042let start ~backend ~pid ~max_secs ~raw =
4143 (try Unix.unlink raw with Unix.Unix_error (ENOENT, _, _) -> ());
4244 let secs = Fmt.str "%g" max_secs in
···6971 "--no-prompt";
7072 "--template";
7173 "Time Profiler";
7272- "--all-processes";
7474+ "--attach";
7575+ string_of_int pid;
7376 "--time-limit";
7477 secs ^ "s";
7578 "--notify-tracing-started";
···103106 in
104107 { backend; raw; trace; ready; child }
105108106106-let wait = function
107107- | None -> ()
108108- | Some pid -> (
109109- try ignore (Unix.waitpid [] pid) with Unix.Unix_error _ -> ())
109109+let rec waitpid pid =
110110+ try Some (snd (Unix.waitpid [] pid)) with
111111+ | Unix.Unix_error (EINTR, _, _) -> waitpid pid
112112+ | Unix.Unix_error (ECHILD, _, _) -> None
113113+114114+let wait = function None -> () | Some pid -> ignore (waitpid pid)
110115111116let await_ready t =
112117 wait t.ready;
···138143 |]
139144 Unix.stdin out Unix.stderr
140145 in
141141- ignore (Unix.waitpid [] pid)
146146+ ignore (waitpid pid)
142147 with Unix.Unix_error _ -> ())
143148144149let xctrace_export t =
···167172 let pid =
168173 Unix.create_process argv.(0) argv Unix.stdin Unix.stderr Unix.stderr
169174 in
170170- let status = snd (Unix.waitpid [] pid) in
171171- status = WEXITED 0 && Sys.file_exists tmp
175175+ let status = waitpid pid in
176176+ status = Some (WEXITED 0) && Sys.file_exists tmp
172177 && (Unix.stat tmp).st_size > 0
173178 with Unix.Unix_error _ -> false
174179 in
175175- if
176176- run ()
177177- ||
178178- (Unix.sleepf 0.25;
179179- run ())
180180- then Unix.rename tmp t.raw
180180+ (* [xctrace record] can exit before its trace service has made the final
181181+ table exportable. A fixed 250 ms retry lost valid captures in real VZ
182182+ runs. Retry only this sidecar operation, with a short bounded backoff;
183183+ the runtime and allocation traces are already durable at this point. *)
184184+ let deadline = Unix.gettimeofday () +. 8. in
185185+ let rec export delay =
186186+ if run () then true
187187+ else if Unix.gettimeofday () >= deadline then false
188188+ else begin
189189+ Unix.sleepf delay;
190190+ export (Float.min 2. (delay *. 2.))
191191+ end
192192+ in
193193+ if export 0.25 then Unix.rename tmp t.raw
181194 else begin
182195 (try Unix.unlink tmp with Unix.Unix_error (ENOENT, _, _) -> ());
183196 Fmt.epr
184184- "obs: xctrace export failed twice; retained native capture %s for \
185185- recovery@."
197197+ "obs: xctrace export did not become ready within 8s; retained native \
198198+ capture %s for recovery@."
186199 trace
187200 end
188201189202let stop t =
190203 await_ready t;
204204+ (match (t.backend, t.child) with
205205+ | Xctrace, Some pid -> (
206206+ try Unix.kill pid Sys.sigint with Unix.Unix_error (ESRCH, _, _) -> ())
207207+ | Perf, _ | Xctrace, None -> ());
191208 wait t.child;
192209 t.child <- None;
193210 (match t.backend with Perf -> perf_report t | Xctrace -> xctrace_export t);
···23232424val start : backend:backend -> pid:int -> max_secs:float -> raw:string -> t
2525(** [start ~backend ~pid ~max_secs ~raw] spawns the sampler on [pid] without
2626- blocking, writing its own output under [raw]. It stops itself when the child
2727- exits or after [max_secs]. *)
2626+ blocking, writing its own output under [raw]. {!stop} ends an xctrace
2727+ recording when the observed child exits; [max_secs] is the safety ceiling.
2828+ Perf attaches to [pid] and keeps the same ceiling. *)
28292930val await_ready : t -> unit
3031(** Wait until capture is active. This is meaningful for [xctrace], whose