From 5a322034ee35efa664576f4c21e0ef0387722cb0 Mon Sep 17 00:00:00 2001 From: PARTH J ROHIT Date: Thu, 20 Aug 2026 19:52:42 +0100 Subject: [PATCH] Show call sources in call stacks Resolves the caller's return address through the existing debug-info table (Elf.Addr_table) and attaches it as call_site_line/col/symbol/file args on the duration_begin event, alongside the callee's own location info already resolved there. Best-effort: call sites into From_perf_map (JIT'd/dlopen'd) code won't have debug info, so no call_site_* args are emitted in that case. Tested via a new expect-test in test/test.ml since this repo's C stubs are Linux-only and can't be built/verified on macOS. Fixes #212 Signed-off-by: PARTH J ROHIT --- src/trace_writer.ml | 29 +++++++++++++--- test/test.ml | 81 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 105 insertions(+), 5 deletions(-) diff --git a/src/trace_writer.ml b/src/trace_writer.ml index cb90cba03..cc1f8c182 100644 --- a/src/trace_writer.ml +++ b/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 ;; diff --git a/test/test.ml b/test/test.ml index 5bd30ca0d..bc8811973 100644 --- a/test/test.ml +++ b/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 =