Allow magic-trace with run perf with sampling if Intel PT is unavaila…

…ble.

Signed-off-by: Aaron Lamoreaux <alamoreaux@janestreet.com>

core/backend_intf.ml

@@ -19,9 +19,11 @@ module type S = sig
       -> debug_print_perf_commands:bool
       -> subcommand:Subcommand.t
       -> when_to_snapshot:When_to_snapshot.t
+      -> multi_snapshot:bool
       -> trace_mode:Trace_mode.t
       -> timer_resolution:Timer_resolution.t
       -> record_dir:string
+      -> intel_pt:bool (** Select whether to use Intel PT or sampling. *)
       -> Pid.t list
       -> t Deferred.Or_error.t
 
@@ -39,6 +41,7 @@ module type S = sig
     :  ?perf_maps:Perf_map.Table.t
     -> debug_print_perf_commands:bool
     -> record_dir:string
+    -> intel_pt:bool
     -> Decode_opts.t
     -> Decode_result.t Deferred.Or_error.t
 end

core/decode_result.ml

@@ -2,6 +2,6 @@ open Core
 open Async
 
 type t =
-  { events : Event.t Pipe.Reader.t
+  { events : Event.t Pipe.Reader.t list
   ; close_result : unit Or_error.t Deferred.t
   }

core/decode_result.mli

@@ -1,9 +1,11 @@
 open Core
 open Async
 
-(* The result of decoding events is a pipe of those events, and a deferred reason why the
-   decoder exited. *)
+(* The result of decoding events are pipe(s) of those events, and a deferred
+   reason why the decoder exited. Multiple pipes will be returned if multiple
+   snapshots were captured and processed, but they are returned in chronological
+   order. Waiting on [close_result] will wait on pipes in sequential order. *)
 type t =
-  { events : Event.t Pipe.Reader.t
+  { events : Event.t Pipe.Reader.t list
   ; close_result : unit Or_error.t Deferred.t
   }

core/event.ml

@@ -38,30 +38,24 @@ module Location = struct
 end
 
 module Ok = struct
-  module Trace = struct
+  module Data = struct
     type t =
-      { thread : Thread.t
-      ; time : Time_ns.Span.t
-      ; trace_state_change : Trace_state_change.t option [@sexp.option]
-      ; kind : Kind.t option [@sexp.option]
-      ; src : Location.t
-      ; dst : Location.t
-      }
-    [@@deriving sexp]
-  end
-
-  module Power = struct
-    type t =
-      { thread : Thread.t
-      ; time : Time_ns.Span.t
-      ; freq : int
-      }
+      | Trace of
+          { trace_state_change : Trace_state_change.t option [@sexp.option]
+          ; kind : Kind.t option [@sexp.option]
+          ; src : Location.t
+          ; dst : Location.t
+          }
+      | Sample of { callstack : Location.t list }
+      | Power of { freq : int }
     [@@deriving sexp]
   end
 
   type t =
-    | Trace of Trace.t
-    | Power of Power.t
+    { thread : Thread.t
+    ; time : Time_ns.Span.t
+    ; data : Data.t
+    }
   [@@deriving sexp]
 end
 
@@ -82,19 +76,18 @@ type t = (Ok.t, Decode_error.t) Result.t [@@deriving sexp]
 
 let thread (t : t) =
   match t with
-  | Ok (Trace { thread; _ }) | Ok (Power { thread; _ }) | Error { thread; _ } -> thread
+  | Ok { thread; _ } | Error { thread; _ } -> thread
 ;;
 
 let time (t : t) =
   match t with
-  | Ok (Trace { time; _ }) | Ok (Power { time; _ }) -> Time_ns_unix.Span.Option.some time
+  | Ok { time; _ } -> Time_ns_unix.Span.Option.some time
   | Error { time; _ } -> time
 ;;
 
 let change_time (t : t) ~f : t =
   match t with
-  | Ok (Trace ({ time; _ } as t)) -> Ok (Trace { t with time = f time })
-  | Ok (Power ({ time; _ } as t)) -> Ok (Power { t with time = f time })
+  | Ok ({ time; _ } as t) -> Ok { t with time = f time }
   | Error ({ time; _ } as u) ->
     (match%optional.Time_ns_unix.Span.Option time with
     | None -> t

core/event.mli

@@ -35,30 +35,25 @@ module Location : sig
 end
 
 module Ok : sig
-  module Trace : sig
+  module Data : sig
     type t =
-      { thread : Thread.t
-      ; time : Time_ns.Span.t
-      ; trace_state_change : Trace_state_change.t option
-      ; kind : Kind.t option
-      ; src : Location.t
-      ; dst : Location.t
-      }
-    [@@deriving sexp]
-  end
-
-  module Power : sig
-    type t =
-      { thread : Thread.t
-      ; time : Time_ns.Span.t
-      ; freq : int
-      }
+      | Trace of
+          { trace_state_change : Trace_state_change.t option
+          ; kind : Kind.t option
+          ; src : Location.t
+          ; dst : Location.t
+          } (** Represents an event collected from Intel PT. *)
+      | Sample of { callstack : Location.t list }
+          (** Represents event collected through sampling. *)
+      | Power of { freq : int } (** Power event collected by Intel PT. *)
     [@@deriving sexp]
   end
 
   type t =
-    | Trace of Trace.t
-    | Power of Power.t
+    { thread : Thread.t
+    ; time : Time_ns.Span.t
+    ; data : Data.t
+    }
   [@@deriving sexp]
 end
 

core/timer_resolution.ml

@@ -4,6 +4,7 @@ type t =
   | Low
   | Normal
   | High
+  | Sample of { freq : int }
   | Custom of
       { cyc : bool option [@sexp.option]
       ; cyc_thresh : int option [@sexp.option]
@@ -23,5 +24,5 @@ let param =
        (Command.Arg_type.create (fun str -> t_of_sexp (Sexp.of_string str))))
     ~doc:
       "RESOLUTION How granular timing information should be, one of Low, Normal, High, \
-       or Custom (default: Normal). For more info visit https://magic-trace.org/w/t"
+       Sample or Custom (default: Normal). For more info: https://magic-trace.org/w/t"
 ;;

core/timer_resolution.mli

@@ -6,14 +6,15 @@ type t =
   | Low
   | Normal
   | High
+  | Sample of { freq : int } (** Used when sampling *)
   | Custom of
       { cyc : bool option
       ; cyc_thresh : int option
       ; mtc : bool option
       ; mtc_period : int option
       ; noretcomp : bool option
       ; psb_period : int option
-      }
+      } (** Used when running with Intel PT. *)
 [@@deriving sexp]
 
 val param : t Command.Param.t

src/perf_capabilities.ml

@@ -41,10 +41,13 @@ module Version = struct
 end
 
 let supports_configurable_psb_period () =
-  let cyc_cap =
-    In_channel.read_all "/sys/bus/event_source/devices/intel_pt/caps/psb_cyc"
-  in
-  String.( = ) cyc_cap "1\n"
+  try
+    let cyc_cap =
+      In_channel.read_all "/sys/bus/event_source/devices/intel_pt/caps/psb_cyc"
+    in
+    String.( = ) cyc_cap "1\n"
+  with
+  | _ -> false
 ;;
 
 let supports_tracing_kernel () =