Show call sources in call stacks

src/trace_writer.ml

@@ -39,6 +39,7 @@ module Pending_event = struct
           { addr : Int64.Hex.t
           ; offset : Int.Hex.t
           ; from_untraced : bool
+          ; call_site : Event.Location.t option
           }
       | Ret
       | Ret_from_untraced of { reset_time : Mapped_time.t }
@@ -51,12 +52,12 @@ module Pending_event = struct
     }
   [@@deriving sexp]
 
-  let create_call location ~from_untraced =
+  let create_call ?(call_site = None) location ~from_untraced =
     let { Event.Location.instruction_pointer; symbol; symbol_offset; dso = _ } =
       location
     in
     { symbol
-    ; kind = Call { addr = instruction_pointer; offset = symbol_offset; from_untraced }
+    ; kind = Call { addr = instruction_pointer; offset = symbol_offset; from_untraced; call_site }
     }
   ;;
 end
@@ -359,7 +360,7 @@ let write_pending_event'
   =
   let display_name = Symbol.display_name symbol in
   match kind with
-  | Call { addr; offset; from_untraced } ->
+  | Call { addr; offset; from_untraced; call_site } ->
     (* Adding a call is always the result of seeing something new on the top of the
        stack, so the base address is just the current base address. *)
     let base_address = Int64.(addr - of_int offset) in
@@ -399,7 +400,24 @@ let write_pending_event'
     let inferred_start_time_arg =
       if from_untraced then [ "inferred_start_time", Interned "true" ] else []
     in
-    let args = symbol_args @ inferred_start_time_arg in
+    let call_site_args =
+      match call_site with
+      | None -> []
+      | Some { instruction_pointer; symbol; symbol_offset; dso = _ } ->
+        let base_address = Int64.(instruction_pointer - of_int symbol_offset) in
+        (match Option.bind (Int64.to_int base_address) ~f:(Hashtbl.find t.debug_info) with
+         | None -> []
+         | Some (info : Elf.Location.t) ->
+           [ "call_site_line", Int info.line
+           ; "call_site_col", Int info.col
+           ; "call_site_symbol", Interned (Symbol.display_name symbol)
+           ]
+           @
+             (match info.filename with
+             | Some x -> [ "call_site_file", Interned x ]
+             | None -> []))
+    in
+    let args = symbol_args @ inferred_start_time_arg @ call_site_args in
     let name =
       if t.annotate_inferred_start_times && from_untraced
       then display_name ^ " [inferred start time]"
@@ -561,7 +579,8 @@ let create_thread t event =
 ;;
 
 let call t thread_info ~time ~location =
-  let ev = Pending_event.create_call location ~from_untraced:false in
+  let call_site = Callstack.top thread_info.callstack in
+  let ev = Pending_event.create_call ?call_site location ~from_untraced:false in
   add_event t thread_info time ev;
   Callstack.push thread_info.callstack location
 ;;

test/test.ml

@@ -16,6 +16,12 @@ module Trace_helpers : sig
   val start_recording : unit -> unit
   val call : unit -> unit
   val add : Event.Kind.t -> int -> string -> unit
+  val add_with_locations
+    :  Event.Kind.t
+    -> int
+    -> src:Event.Location.t
+    -> dst:Event.Location.t
+    -> unit
   val ret : unit -> unit
   val jmp : unit -> unit
 end = struct
@@ -122,6 +128,17 @@ end = struct
          })
   ;;
 
+  let add_with_locations kind ns ~src ~dst =
+    Queue.enqueue
+      events
+      (Ok
+         { thread
+         ; time = Time_ns.Span.of_int_ns ns
+         ; data = Trace { trace_state_change = None; kind = Some kind; src; dst }
+         ; in_transaction = false
+         })
+  ;;
+
   let ret () =
     let symbol =
       match Stack.pop stack with
@@ -196,6 +213,40 @@ let dump_using_file ?range_symbols events =
   return ()
 ;;
 
+let dump_duration_begin_arg_names ~debug_info events =
+  let module Trace = struct
+    type thread = unit
+
+    let allocate_pid ~name:_ = 0
+    let allocate_thread ~pid:_ ~name:_ = ()
+
+    let write_duration_begin ?category:_ () ~args ~thread:_ ~name ~time:_ =
+      print_s [%sexp (name : string), (List.map args ~f:fst : string list)]
+    ;;
+
+    let write_duration_end ?category:_ () ~args:_ ~thread:_ ~name:_ ~time:_ = ()
+    let write_duration_complete ~args:_ ~thread:_ ~name:_ ~time:_ ~time_end:_ = ()
+    let write_duration_instant ~args:_ ~thread:_ ~name:_ ~time:_ = ()
+    let write_counter ~args:_ ~thread:_ ~name:_ ~time:_ = ()
+  end
+  in
+  let trace_writer =
+    Magic_trace_lib.Trace_writer.create_expert
+      ~trace_scope:Userspace
+      ~debug_info:(Some debug_info)
+      ~ocaml_exception_info:None
+      ~earliest_time:Time_ns.Span.zero
+      ~hits:[]
+      ~annotate_inferred_start_times:true
+      (module Trace)
+  in
+  List.iter events ~f:(fun event ->
+    Magic_trace_lib.Trace_writer.write_event
+      trace_writer
+      (Event.With_write_info.create ~should_write:true event));
+  Magic_trace_lib.Trace_writer.finalize trace_writer
+;;
+
 let%expect_test "random perfs" =
   let open Trace_helpers in
   let%bind.With _dirname = Expect_test_helpers_async.within_temp_dir in
@@ -825,6 +876,36 @@ let%expect_test "filtered trace" =
   return ()
 ;;
 
+let%expect_test "call sources include debug information" =
+  let location instruction_pointer symbol symbol_offset =
+    { Event.Location.instruction_pointer; symbol; symbol_offset; dso = Null }
+  in
+  let caller = location 0x1008L (From_perf "caller") 8 in
+  let callee = location 0x2004L (From_perf "callee") 4 in
+  let unknown = location 0L (From_perf "unknown") 0 in
+  let debug_info =
+    Hashtbl.of_alist_exn
+      (module Int)
+      [ 0x1000, { Elf.Location.filename = Some "caller.ml"; line = 12; col = 3 }
+      ; 0x2000, { Elf.Location.filename = Some "callee.ml"; line = 34; col = 5 }
+      ]
+  in
+  let events =
+    Trace_helpers.(
+      add_with_locations Event.Kind.Call 0 ~src:unknown ~dst:caller;
+      add_with_locations Event.Kind.Call 1 ~src:caller ~dst:callee;
+      events ())
+  in
+  dump_duration_begin_arg_names ~debug_info events;
+  [%expect
+    {|
+    (caller (address line col symbol file))
+    (callee
+     (address line col symbol file call_site_line call_site_col call_site_symbol call_site_file))
+    |}];
+  return ()
+;;
+
 let%expect_test "get debug information from ELF" =
   let elf = Magic_trace_lib.Elf.create "sample-targets/ocaml-raise/sample.exe" in
   let debug_table =