tracing: remove counters

raphael-proust · raphael-proust · commit 8a2a718ece6d · 2025-10-21T11:28:47.000+02:00
diff --git a/src/core/lwt.ml b/src/core/lwt.ml
@@ -1672,8 +1672,6 @@ include Pending_promises
 
 
 let tracing_context = new_key ()
-let tracing_counter = ref 0
-let tracing_counter () = incr tracing_counter; !tracing_counter
 
 module Sequential_composition :
 sig
@@ -1908,7 +1906,6 @@ struct
 
   let backtrace_bind loc_f loc_l add_loc p f =
     let trace_context = Sequence_associated_storage.get tracing_context in
-    let trace_counter = tracing_counter () in
     let Internal p = to_internal_promise p in
     let p = underlying p in
 
@@ -1918,7 +1915,7 @@ struct
       let saved_storage = !current_storage in
 
       let callback p_result =
-        if trace then Lwt_rte.emit_trace End trace_context trace_counter loc_f loc_l;
+        if trace then Lwt_rte.emit_trace End trace_context loc_f loc_l;
         match p_result with
         | Fulfilled v ->
           current_storage := saved_storage;
@@ -1962,7 +1959,7 @@ struct
       to_public_promise {state = Rejected (add_loc exn)}
 
     | Pending p_callbacks ->
-      Lwt_rte.emit_trace Begin trace_context trace_counter loc_f loc_l;
+      Lwt_rte.emit_trace Begin trace_context loc_f loc_l;
       let (p'', callback) = create_result_promise_and_callback_if_deferred true () in
       add_implicitly_removed_callback p_callbacks callback;
       p''
@@ -2092,7 +2089,6 @@ struct
 
   let backtrace_catch loc_f loc_l add_loc f h =
     let trace_context = Sequence_associated_storage.get tracing_context in
-    let trace_counter = tracing_counter () in
     let p =
       try f ()
       with exn when Exception_filter.run exn -> fail exn
@@ -2106,7 +2102,7 @@ struct
       let saved_storage = !current_storage in
 
       let callback p_result =
-        if traced then Lwt_rte.emit_trace End trace_context trace_counter loc_f loc_l;
+        if traced then Lwt_rte.emit_trace End trace_context loc_f loc_l;
         match p_result with
         | Fulfilled _ as p_result ->
           let State_may_now_be_pending_proxy p'' = may_now_be_proxy p'' in
@@ -2151,7 +2147,7 @@ struct
           (p'', callback, p.state))
 
     | Pending p_callbacks ->
-      Lwt_rte.emit_trace Begin trace_context trace_counter loc_f loc_l;
+      Lwt_rte.emit_trace Begin trace_context loc_f loc_l;
       let (p'', callback) = create_result_promise_and_callback_if_deferred true () in
       add_implicitly_removed_callback p_callbacks callback;
       p''
@@ -2233,7 +2229,6 @@ struct
 
   let backtrace_try_bind loc_f loc_l add_loc f f' h =
     let trace_context = Sequence_associated_storage.get tracing_context in
-    let trace_counter = tracing_counter () in
     let p =
       try f ()
       with exn when Exception_filter.run exn -> fail exn
@@ -2247,7 +2242,7 @@ struct
       let saved_storage = !current_storage in
 
       let callback p_result =
-        if traced then Lwt_rte.emit_trace End trace_context trace_counter loc_f loc_l;
+        if traced then Lwt_rte.emit_trace End trace_context loc_f loc_l;
         match p_result with
         | Fulfilled v ->
           current_storage := saved_storage;
@@ -2307,7 +2302,7 @@ struct
           (p'', callback, p.state))
 
     | Pending p_callbacks ->
-      Lwt_rte.emit_trace Begin trace_context trace_counter loc_f loc_l;
+      Lwt_rte.emit_trace Begin trace_context loc_f loc_l;
       let (p'', callback) = create_result_promise_and_callback_if_deferred true () in
       add_implicitly_removed_callback p_callbacks callback;
       p''
diff --git a/src/core/lwt_rte.mli b/src/core/lwt_rte.mli
@@ -4,4 +4,4 @@ val emit_sch_call_end : unit -> unit
 val emit_sch_lap : unit -> unit
 val emit_job_count : int -> unit
 type span = Begin | End
-val emit_trace : span -> string option -> int -> string -> int -> unit
+val emit_trace : span -> string option -> string -> int -> unit
diff --git a/src/core/lwt_rte.with.ml b/src/core/lwt_rte.with.ml
@@ -4,4 +4,4 @@ let emit_sch_call_end () = Lwt_runtime_events.emit_sch_call_end ()
 let emit_sch_lap v = Lwt_runtime_events.emit_sch_lap v
 let emit_job_count v = Lwt_runtime_events.emit_job_count v
 type span = Runtime_events.Type.span = Begin | End
-let emit_trace kind context count filename line = Lwt_runtime_events.Trace.emit {kind; context; count; filename; line}
+let emit_trace kind context filename line = Lwt_runtime_events.Trace.emit {kind; context; filename; line}
diff --git a/src/core/lwt_rte.without.ml b/src/core/lwt_rte.without.ml
@@ -4,4 +4,4 @@ let emit_sch_call_end () = ()
 let emit_sch_lap _v = ()
 let emit_job_count _v = ()
 type span = Begin | End
-let emit_trace _ _ _ _ _ = ()
+let emit_trace _ _ _ _ = ()
diff --git a/src/runtime_events/lwt_runtime_events.ml b/src/runtime_events/lwt_runtime_events.ml
@@ -20,7 +20,6 @@ module Trace = struct
   type t =
     { kind: Runtime_events.Type.span;
       context: string option;
-      count: int;
       filename: string;
       line: int; }
 
@@ -38,9 +37,6 @@ module Trace = struct
     let offset = offset + 1 in
     let context = if context_size = 0 then None else Some (Bytes.sub_string b offset context_size) in
     let offset = offset + context_size in
-    (* count *)
-    let count = BytesLabels.get_uint16_be b offset in
-    let offset = offset + 2 in
     (* line *)
     let line = Bytes.get_uint16_be b offset in
     let offset = offset + 2 in
@@ -50,9 +46,9 @@ module Trace = struct
     let filename = Bytes.sub_string b offset filename_size in
     let offset = offset + filename_size in
     assert (offset = i);
-    { kind; context; count; filename; line }
+    { kind; context; filename; line }
 
-  let encode b { kind; context; count; filename; line } =
+  let encode b { kind; context; filename; line } =
     let offset = 0 in
     (* BEGIN|END *)
     Bytes.set b offset (match kind with Begin -> 'B' | End -> 'E');
@@ -67,9 +63,6 @@ module Trace = struct
           Bytes.blit_string context 0 b offset (String.length context);
           offset + String.length context
     in
-    (* count *)
-    Bytes.set_uint16_be b offset count;
-    let offset = offset + 2 in
     (* line *)
     Bytes.set_uint16_be b offset line;
     let offset = offset + 2 in
diff --git a/src/runtime_events/lwt_runtime_events.mli b/src/runtime_events/lwt_runtime_events.mli
@@ -16,7 +16,7 @@ val unix_job_count : int Runtime_events.User.t
 val emit_job_count : int -> unit
 
 module Trace : sig
-  type t = { kind: Runtime_events.Type.span; context: string option; count: int; filename: string; line: int; }
+  type t = { kind: Runtime_events.Type.span; context: string option; filename: string; line: int; }
   val t : t Runtime_events.Type.t
 
   type Runtime_events.User.tag += T
diff --git a/test/tracing/tailgate.ml b/test/tracing/tailgate.ml
@@ -33,10 +33,11 @@ let simplify_fname fname =
     |> List.rev
     |> String.concat ""
 
-let name_of { Lwt_runtime_events.Trace.context; count; filename; line; kind=_ } =
+let name_of { Lwt_runtime_events.Trace.context; filename; line; kind=_ } =
+  let shortloc = simplify_fname filename ^ ":" ^ string_of_int line in
   match context with
-  | Some c -> c ^ "#" ^ string_of_int count
-  | None -> simplify_fname filename ^ ":" ^ string_of_int line ^ "#" ^ string_of_int count
+  | Some c -> c ^ "@" ^ shortloc
+  | None -> shortloc
 
 let ts_to_us ts = Int64.(div ts (of_int 1000))
 
@@ -50,7 +51,7 @@ let () =
         (fun rid t u x ->
           match Runtime_events.User.tag u with
             | Lwt_runtime_events.Trace.T -> begin
-                let { Lwt_runtime_events.Trace.kind; context=_; count=_; filename; line } = x in
+                let { Lwt_runtime_events.Trace.kind; context=_; filename; line } = x in
                     Printf.fprintf oc
                       "{\"name\": \"%s\", \"cat\": \"PERF\", \"ph\":\"%s\", \"ts\":%Ld, \"pid\": %d, \"tid\": %d, \"args\": {\"location\": \"%s:%d\"}},\n"
 
