Used procfs to give traced threads more helpful names

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

Author: Aaron Lamoreaux

src/process_info.ml

@@ -0,0 +1,30 @@
+open! Core
+open! Import
+
+module Entry = struct
+  module Cmdline = struct
+    type t = string list
+  end
+end
+
+let state = Hashtbl.create (module Pid)
+
+let read_proc_info pid =
+  let line = In_channel.read_lines [%string "/proc/%{pid#Pid}/cmdline"] |> List.hd in
+  match line with
+  | None -> ()
+  | Some args ->
+    let cmdline =
+      String.split ~on:(Char.of_int_exn 0) args |> List.filter ~f:(Fn.non String.is_empty)
+    in
+    Hashtbl.set state ~key:pid ~data:cmdline
+;;
+
+let read_all_proc_info () =
+  Sys_unix.readdir "/proc"
+  |> Array.iter ~f:(fun filename ->
+         try Pid.of_string filename |> read_proc_info with
+         | _ -> ())
+;;
+
+let cmdline_of_pid pid = Hashtbl.find state pid

src/process_info.mli

@@ -0,0 +1,12 @@
+open! Core
+open! Import
+
+module Entry : sig
+  module Cmdline : sig
+    type t = string list
+  end
+end
+
+val read_proc_info : Pid.t -> unit
+val read_all_proc_info : unit -> unit
+val cmdline_of_pid : Pid.t -> Entry.Cmdline.t option

src/trace.ml

@@ -227,6 +227,7 @@ module Make_commands (Backend : Backend_intf.S) = struct
   end
 
   let attach (opts : Record_opts.t) ~elf ~debug_print_perf_commands ~subcommand pid =
+    Process_info.read_all_proc_info ();
     let%bind.Deferred.Or_error snap_loc =
       match elf with
       | None -> return (Ok None)

src/trace_writer.ml

@@ -464,11 +464,24 @@ let create_thread t event =
     | None -> Mapped_time.start_of_trace
     | Some time -> map_time t time
   in
-  let trace_pid =
-    allocate_pid
-      t
-      ~name:[%string "%{opt_pid_to_string thread.pid}/%{opt_pid_to_string thread.tid}"]
+  let pid = opt_pid_to_string thread.pid in
+  let tid = opt_pid_to_string thread.tid in
+  let default_name =
+    if String.(pid = tid)
+    then [%string "[(p|t)id=%{pid}]"]
+    else [%string "[pid=%{pid}] [tid=%{tid}]"]
+  in
+  let name =
+    match thread.pid with
+    | None -> default_name
+    | Some pid ->
+      (match Process_info.cmdline_of_pid pid with
+      | None -> default_name
+      | Some cmdline ->
+        let concat_cmdline = String.concat ~sep:" " cmdline in
+        [%string "%{concat_cmdline} %{default_name}"])
   in
+  let trace_pid = allocate_pid t ~name in
   let thread = allocate_thread t ~pid:trace_pid ~name:"main" in
   { Thread_info.thread
   ; callstack = Callstack.create ~create_time:effective_time

test/test.ml

@@ -175,12 +175,14 @@ let%expect_test "random perfs" =
     {|
     (Interned_string (index 1) (value process))
     (Tick_initialization (ticks_per_second 1000000000))
-    (Interned_string (index 102) (value 1234/456))
+    (Interned_string (index 102) (value "[pid=1234] [tid=456]"))
     (Process_name_change (name 102) (pid 1))
     (Interned_string (index 103) (value main))
     (Thread_name_change (name 103) (pid 1) (tid 2))
     (Interned_thread (index 1)
-     (value ((pid 1) (tid 2) (process_name (1234/456)) (thread_name (main)))))
+     (value
+      ((pid 1) (tid 2) (process_name ("[pid=1234] [tid=456]"))
+       (thread_name (main)))))
     (Interned_string (index 104) (value address))
     (Interned_string (index 105) (value S))
     (Interned_string (index 106) (value symbol))
@@ -229,12 +231,14 @@ let%expect_test "random perfs" =
     {|
 (Interned_string (index 1) (value process))
 (Tick_initialization (ticks_per_second 1000000000))
-(Interned_string (index 102) (value 1234/456))
+(Interned_string (index 102) (value "[pid=1234] [tid=456]"))
 (Process_name_change (name 102) (pid 1))
 (Interned_string (index 103) (value main))
 (Thread_name_change (name 103) (pid 1) (tid 2))
 (Interned_thread (index 1)
- (value ((pid 1) (tid 2) (process_name (1234/456)) (thread_name (main)))))
+ (value
+  ((pid 1) (tid 2) (process_name ("[pid=1234] [tid=456]"))
+   (thread_name (main)))))
 (Interned_string (index 104) (value address))
 (Interned_string (index 105) (value "\025J\015\018\023\018"))
 (Interned_string (index 106) (value symbol))
@@ -255,12 +259,14 @@ let%expect_test "random perfs" =
     {|
     (Interned_string (index 1) (value process))
     (Tick_initialization (ticks_per_second 1000000000))
-    (Interned_string (index 102) (value 1234/456))
+    (Interned_string (index 102) (value "[pid=1234] [tid=456]"))
     (Process_name_change (name 102) (pid 1))
     (Interned_string (index 103) (value main))
     (Thread_name_change (name 103) (pid 1) (tid 2))
     (Interned_thread (index 1)
-     (value ((pid 1) (tid 2) (process_name (1234/456)) (thread_name (main)))))
+     (value
+      ((pid 1) (tid 2) (process_name ("[pid=1234] [tid=456]"))
+       (thread_name (main)))))
     (Interned_string (index 104) (value "\025J\015\018\023\018"))
     (Interned_string (index 105) (value ""))
     (Event
@@ -301,12 +307,14 @@ let%expect_test "random perfs" =
     {|
 (Interned_string (index 1) (value process))
 (Tick_initialization (ticks_per_second 1000000000))
-(Interned_string (index 102) (value 1234/456))
+(Interned_string (index 102) (value "[pid=1234] [tid=456]"))
 (Process_name_change (name 102) (pid 1))
 (Interned_string (index 103) (value main))
 (Thread_name_change (name 103) (pid 1) (tid 2))
 (Interned_thread (index 1)
- (value ((pid 1) (tid 2) (process_name (1234/456)) (thread_name (main)))))
+ (value
+  ((pid 1) (tid 2) (process_name ("[pid=1234] [tid=456]"))
+   (thread_name (main)))))
 (Interned_string (index 104) (value address))
 (Interned_string (index 105) (value S))
 (Interned_string (index 106) (value symbol))
@@ -385,12 +393,14 @@ let%expect_test "with initial returns" =
     {|
     (Interned_string (index 1) (value process))
     (Tick_initialization (ticks_per_second 1000000000))
-    (Interned_string (index 102) (value 1234/456))
+    (Interned_string (index 102) (value "[pid=1234] [tid=456]"))
     (Process_name_change (name 102) (pid 1))
     (Interned_string (index 103) (value main))
     (Thread_name_change (name 103) (pid 1) (tid 2))
     (Interned_thread (index 1)
-     (value ((pid 1) (tid 2) (process_name (1234/456)) (thread_name (main)))))
+     (value
+      ((pid 1) (tid 2) (process_name ("[pid=1234] [tid=456]"))
+       (thread_name (main)))))
     (Interned_string (index 104) (value "\025J\015\018\023\018"))
     (Interned_string (index 105) (value ""))
     (Event
@@ -520,12 +530,14 @@ let%expect_test "time batch spreading" =
     {|
     (Interned_string (index 1) (value process))
     (Tick_initialization (ticks_per_second 1000000000))
-    (Interned_string (index 102) (value 1234/456))
+    (Interned_string (index 102) (value "[pid=1234] [tid=456]"))
     (Process_name_change (name 102) (pid 1))
     (Interned_string (index 103) (value main))
     (Thread_name_change (name 103) (pid 1) (tid 2))
     (Interned_thread (index 1)
-     (value ((pid 1) (tid 2) (process_name (1234/456)) (thread_name (main)))))
+     (value
+      ((pid 1) (tid 2) (process_name ("[pid=1234] [tid=456]"))
+       (thread_name (main)))))
     (Interned_string (index 104) (value address))
     (Interned_string (index 105) (value sub))
     (Interned_string (index 106) (value symbol))
@@ -610,12 +622,14 @@ let%expect_test "enqueing events at start" =
     {|
     (Interned_string (index 1) (value process))
     (Tick_initialization (ticks_per_second 1000000000))
-    (Interned_string (index 102) (value 1234/456))
+    (Interned_string (index 102) (value "[pid=1234] [tid=456]"))
     (Process_name_change (name 102) (pid 1))
     (Interned_string (index 103) (value main))
     (Thread_name_change (name 103) (pid 1) (tid 2))
     (Interned_thread (index 1)
-     (value ((pid 1) (tid 2) (process_name (1234/456)) (thread_name (main)))))
+     (value
+      ((pid 1) (tid 2) (process_name ("[pid=1234] [tid=456]"))
+       (thread_name (main)))))
     (Interned_string (index 104) (value fn3))
     (Interned_string (index 105) (value ""))
     (Event