Source file event.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
open! Core

module Kind = struct
  type t =
    | Call
    | Return
    | Syscall
    | Sysret
    | Hardware_interrupt
    | Iret
    | Jump
  [@@deriving sexp, compare]
end

module Thread = struct
  type t =
    { pid : Pid.t option
    ; tid : Pid.t option
    }
  [@@deriving sexp, compare, hash]
end

module Location = struct
  type t =
    { instruction_pointer : Int64.Hex.t
    ; symbol : Symbol.t
    ; symbol_offset : Int.Hex.t
    }
  [@@deriving sexp]

  (* magic-trace has some things that aren't functions but look like they are in the trace
     (like "[untraced]" and "[syscall]") *)
  let locationless symbol = { instruction_pointer = 0L; symbol; symbol_offset = 0 }
  let unknown = locationless Unknown
  let untraced = locationless Untraced
  let returned = locationless Returned
  let syscall = locationless Syscall
end

module Ok = 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 Decode_error = struct
  type t =
    { thread : Thread.t
          (* The time is only present sometimes. I haven't figured out when, exactly, but my
       Skylake test machine has it while my Tiger Lake test machine doesn't. It could
       easily be a difference between different versions of perf... *)
    ; time : Time_ns_unix.Span.Option.t
    ; instruction_pointer : Int64.Hex.t option
    ; message : string
    }
  [@@deriving sexp]
end

type t = (Ok.t, Decode_error.t) Result.t [@@deriving sexp]

let thread (t : t) =
  match t with
  | Ok { thread; _ } | Error { thread; _ } -> thread
;;

let time (t : t) =
  match t with
  | Ok { time; _ } -> Time_ns_unix.Span.Option.some time
  | Error { time; _ } -> time
;;

let change_time (t : t) ~f : t =
  match t with
  | 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
    | Some time -> Error { u with time = Time_ns_unix.Span.Option.some (f time) })
;;