Allow saving raw IPT data to .sexp format, bypassing .fxt generation

Closes #54.
janestreet · May 18, 2022 · 7e457f9 · 7e457f9
1 parent baf350b
commit 7e457f9
Show file tree

Hide file tree

Showing 3 changed files with 57 additions and 68 deletions.
diff --git a/src/trace.ml b/src/trace.ml
@@ -115,14 +115,14 @@ let write_trace_from_events
   close_result
 ;;
 
-let write_event_sexps_to_stdout decode_result =
+let write_event_sexps writer decode_result =
   let { Decode_result.events; close_result } = decode_result in
-  Core.print_endline "(V1 (";
+  Writer.write_line writer "(V1 (";
   let%bind () =
     Pipe.iter_without_pushback events ~f:(fun (event : Event.t) ->
-        Core.print_s ~mach:() (Event.sexp_of_t event))
+        Writer.write_sexp ~terminate_with:Newline writer (Event.sexp_of_t event))
   in
-  Core.print_endline "))";
+  Writer.write_line writer "))";
   close_result
 ;;
 
@@ -150,7 +150,20 @@ module Make_commands (Backend : Backend_intf.S) = struct
       { Decode_opts.output_config; decode_opts; print_events }
     =
     Core.eprintf "[ Decoding, this takes a while... ]\n%!";
-    Tracing_tool_output.write_and_maybe_view output_config ~f:(fun writer ->
+    Tracing_tool_output.write_and_maybe_view
+      output_config
+      ~f_sexp:(fun writer ->
+        let open Deferred.Or_error.Let_syntax in
+        let%bind decode_result =
+          Backend.decode_events
+            decode_opts
+            ~debug_print_perf_commands
+            ~record_dir
+            ~perf_map
+        in
+        let%bind () = write_event_sexps writer decode_result in
+        return ())
+      ~f_fuchsia:(fun writer ->
         let open Deferred.Or_error.Let_syntax in
         let hits =
           In_channel.read_all (Hits_file.filename ~record_dir)
@@ -192,18 +205,6 @@ module Make_commands (Backend : Backend_intf.S) = struct
         return ())
   ;;
 
-  let decode_to_sexp ~debug_print_perf_commands ~record_dir ~perf_map backend_decode_opts =
-    let open Deferred.Or_error.Let_syntax in
-    let%bind decode_result =
-      Backend.decode_events
-        backend_decode_opts
-        ~debug_print_perf_commands
-        ~record_dir
-        ~perf_map
-    in
-    write_event_sexps_to_stdout decode_result
-  ;;
-
   module Record_opts = struct
     type t =
       { backend_opts : Backend.Record_opts.t
@@ -613,36 +614,8 @@ module Make_commands (Backend : Backend_intf.S) = struct
            decode_opts)
   ;;
 
-  let export_commands =
-    Command.group
-      ~summary:"Export raw Intel Processor Trace data to other formats"
-      [ ( "sexp"
-        , Command.async_or_error
-            ~summary:"Export to s-expressions"
-            (let%map_open.Command record_dir = record_dir_flag required
-             and backend_decode_opts = Backend.Decode_opts.param
-             and perf_map_file =
-               flag
-                 "-perf-map-file"
-                 (optional Filename_unix.arg_type)
-                 ~doc:"FILE for JITs, path to a perf map file, in /tmp/perf-PID.map"
-             and debug_print_perf_commands = debug_print_perf_commands in
-             fun () ->
-               let%bind perf_map = maybe_load_perf_map perf_map_file in
-               decode_to_sexp
-                 ~debug_print_perf_commands
-                 ~record_dir
-                 ~perf_map
-                 backend_decode_opts) )
-      ]
-  ;;
-
   let commands =
-    [ "run", run_command
-    ; "attach", attach_command
-    ; "decode", decode_command
-    ; "export", export_commands
-    ]
+    [ "run", run_command; "attach", attach_command; "decode", decode_command ]
   ;;
 end
 

diff --git a/src/tracing_tool_output.ml b/src/tracing_tool_output.ml
@@ -114,9 +114,13 @@ end
 
 type t =
   { serve : Serve.t
-  ; store_path : string
+  ; output : [ `Fuchsia of string | `Sexp of string ]
   }
 
+let store_path = function
+  | `Fuchsia store_path | `Sexp store_path -> store_path
+;;
+
 let param =
   let%map_open.Command store_path =
     let default = "trace.fxt" in
@@ -126,7 +130,15 @@ let param =
       ~aliases:[ "o" ]
       ~doc:[%string "FILE Where to output the trace. (default: '%{default}')"]
   and serve = Serve.param in
-  { serve; store_path }
+  let output =
+    match String.is_suffix ~suffix:".sexp" store_path with
+    | true -> `Sexp store_path
+    | false -> `Fuchsia store_path
+  in
+  (match serve, output with
+  | Enabled _, `Sexp _ -> raise_s [%message "cannot serve .sexp output"]
+  | _ -> ());
+  { serve; output }
 ;;
 
 let notify_trace ~store_path =
@@ -140,31 +152,34 @@ let maybe_stash_old_trace ~filename =
   | Core_unix.Unix_error (ENOENT, (_ : string), (_ : string)) -> ()
 ;;
 
-let write_and_maybe_serve ?num_temp_strs t ~filename ~f =
+let write_and_maybe_serve ?num_temp_strs t ~filename ~f_sexp ~f_fuchsia =
   let open Deferred.Or_error.Let_syntax in
   maybe_stash_old_trace ~filename;
-  let fd = Core_unix.openfile t.store_path ~mode:[ O_RDWR; O_CREAT; O_CLOEXEC ] in
-  (* Write to and serve from an indirect reference to [t.store_path], through our process'
+  match t.output with
+  | `Sexp store_path -> Writer.with_file_atomic store_path ~f:f_sexp
+  | `Fuchsia store_path ->
+    let fd = Core_unix.openfile store_path ~mode:[ O_RDWR; O_CREAT; O_CLOEXEC ] in
+    (* Write to and serve from an indirect reference to [store_path], through our process'
      fd table. This is a little grotesque, but avoids a race where the user runs
      magic-trace twice with the same [-output], such that the filename changes under
      [-serve] -- without this hack, the earlier magic-trace serving instance would start
      serving the new trace, which is unlikely to be what the user expected. *)
-  let indirect_store_path = [%string "/proc/self/fd/%{fd#Core_unix.File_descr}"] in
-  let w =
-    Tracing_zero.Writer.create_for_file ?num_temp_strs ~filename:indirect_store_path ()
-  in
-  let%bind res = f w in
-  let%map () =
-    match t.serve with
-    | Disabled -> notify_trace ~store_path:t.store_path
-    | Enabled serve ->
-      Serve.serve_trace_file serve ~filename ~store_path:indirect_store_path
-  in
-  Core_unix.close fd;
-  res
+    let indirect_store_path = [%string "/proc/self/fd/%{fd#Core_unix.File_descr}"] in
+    let w =
+      Tracing_zero.Writer.create_for_file ?num_temp_strs ~filename:indirect_store_path ()
+    in
+    let%bind res = f_fuchsia w in
+    let%map () =
+      match t.serve with
+      | Disabled -> notify_trace ~store_path
+      | Enabled serve ->
+        Serve.serve_trace_file serve ~filename ~store_path:indirect_store_path
+    in
+    Core_unix.close fd;
+    res
 ;;
 
-let write_and_maybe_view ?num_temp_strs t ~f =
-  let filename = Filename.basename t.store_path in
-  write_and_maybe_serve ?num_temp_strs t ~filename ~f
+let write_and_maybe_view ?num_temp_strs t ~f_sexp ~f_fuchsia =
+  let filename = Filename.basename (store_path t.output) in
+  write_and_maybe_serve ?num_temp_strs t ~filename ~f_sexp ~f_fuchsia
 ;;
diff --git a/src/tracing_tool_output.mli b/src/tracing_tool_output.mli
@@ -14,5 +14,6 @@ val param : t Command.Param.t
 val write_and_maybe_view
   :  ?num_temp_strs:int
   -> t
-  -> f:(Tracing_zero.Writer.t -> 'a Deferred.Or_error.t)
+  -> f_sexp:(Writer.t -> 'a Deferred.Or_error.t)
+  -> f_fuchsia:(Tracing_zero.Writer.t -> 'a Deferred.Or_error.t)
   -> 'a Deferred.Or_error.t