jon.recoil.org
this repo has no description
1let instrument = false
2
3open Bos
4
5let instrument_dir =
6 lazy
7 (let dir = Fpath.v "landmarks" in
8 OS.Dir.delete dir |> Result.get_ok;
9 OS.Dir.create dir |> Result.get_ok |> ignore;
10 dir)
11
12type t = {
13 cmd : string list;
14 time : float; (** Running time in seconds. *)
15 output_file : Fpath.t option;
16 output : string;
17 errors : string;
18 status : [ `Exited of int | `Signaled of int ];
19}
20
21(* Environment variables passed to commands. *)
22
23(* Record the commands executed, their running time and optionally the path to
24 the produced file. *)
25let commands = ref []
26
27let n = Atomic.make 0
28
29(** Return the list of executed commands where the first argument was [cmd]. *)
30let run env cmd output_file =
31 let cmd = Bos.Cmd.to_list cmd in
32 let myn = Atomic.fetch_and_add n 1 in
33 Logs.debug (fun m -> m "%d - Executing: %s" myn (String.concat " " cmd));
34 let proc_mgr = Eio.Stdenv.process_mgr env in
35 let t_start = Unix.gettimeofday () in
36 let env =
37 let env = OS.Env.current () |> Result.get_ok in
38 env
39 in
40 let env =
41 Astring.String.Map.fold
42 (fun k v env -> Astring.String.concat [ k; "="; v ] :: env)
43 env []
44 |> Array.of_list
45 in
46 (* Logs.debug (fun m -> m "Running cmd %a" Fmt.(list ~sep:sp string) cmd); *)
47 let output, errors, status =
48 Eio.Switch.run ~name:"Process.parse_out" @@ fun sw ->
49 let r, w = Eio.Process.pipe proc_mgr ~sw in
50 let re, we = Eio.Process.pipe proc_mgr ~sw in
51 try
52 let child =
53 Eio.Process.spawn ~sw proc_mgr ~stdout:w ~stderr:we ~env cmd
54 in
55 Eio.Flow.close w;
56 Eio.Flow.close we;
57 let output, err =
58 Eio.Fiber.pair
59 (fun () ->
60 Eio.Buf_read.parse_exn Eio.Buf_read.take_all r ~max_size:max_int)
61 (fun () ->
62 Eio.Buf_read.parse_exn Eio.Buf_read.take_all re ~max_size:max_int)
63 in
64 Eio.Flow.close r;
65 Eio.Flow.close re;
66 let status = Eio.Process.await child in
67 (output, err, status)
68 with Eio.Exn.Io _ as ex ->
69 let bt = Printexc.get_raw_backtrace () in
70 Eio.Exn.reraise_with_context ex bt "%d - running command: %a" myn
71 Eio.Process.pp_args cmd
72 in
73 (* Logs.debug (fun m ->
74 m "Finished running cmd %a" Fmt.(list ~sep:sp string) cmd); *)
75 let t_end = Unix.gettimeofday () in
76 let time = t_end -. t_start in
77 let result = { cmd; time; output_file; output; errors; status } in
78 commands := result :: !commands;
79 (match result.status with
80 | `Exited 0 -> ()
81 | _ ->
82 let verb, n =
83 match result.status with
84 | `Exited n -> ("exited", n)
85 | `Signaled n -> ("signaled", n)
86 in
87 Logs.err (fun m ->
88 m
89 "@[<2>Process %s with %d:@ '@[%a'@]@]@\n\n\
90 Stdout:\n\
91 %s\n\n\
92 Stderr:\n\
93 %s"
94 verb n
95 Fmt.(list ~sep:sp string)
96 result.cmd result.output result.errors));
97 result
98
99(** Print an executed command and its time. *)
100
101let filter_commands cmd =
102 match
103 List.filter
104 (fun c -> match c.cmd with _ :: cmd' :: _ -> cmd = cmd' | _ -> false)
105 !commands
106 with
107 | [] -> []
108 | _ :: _ as cmds -> cmds
109
110let print_cmd c =
111 Printf.printf "[%4.2f] $ %s\n" c.time (String.concat " " c.cmd)
112
113(** Returns the [k] commands that took the most time for a given subcommand. *)
114let k_longest_commands cmd k =
115 filter_commands cmd
116 |> List.sort (fun a b -> Float.compare b.time a.time)
117 |> List.filteri (fun i _ -> i < k)