perf: reduce overhead in trace-tef

we call onto the channel functions less, because they
involve locking. Instead we do all writes into a (reused) buffer
and write it all at once at the end.

src/tef/trace_tef.ml

@@ -114,6 +114,7 @@ module Writer = struct
   type t = {
     oc: out_channel;
     mutable first: bool;  (** first event? *)
+    buf: Buffer.t;  (** Buffer to write into *)
     must_close: bool;  (** Do we have to close the underlying channel [oc]? *)
     pid: int;
   }
@@ -134,7 +135,7 @@ module Writer = struct
         Unix.getpid ()
     in
     output_char oc '[';
-    { oc; first = true; pid; must_close }
+    { oc; first = true; pid; must_close; buf = Buffer.create 2_048 }
 
   let close (self : t) : unit =
     output_char self.oc ']';
@@ -147,66 +148,70 @@ module Writer = struct
 
   let[@inline] flush (self : t) : unit = flush self.oc
 
-  let emit_sep_ (self : t) =
+  (** Emit "," if we need, and get the buffer ready *)
+  let emit_sep_and_start_ (self : t) =
+    Buffer.reset self.buf;
     if self.first then
       self.first <- false
     else
-      output_string self.oc ",\n"
+      Buffer.add_string self.buf ",\n"
 
-  let char = output_char
+  let char = Buffer.add_char
-  let raw_string = output_string
+  let raw_string = Buffer.add_string
 
-  let str_val oc (s : string) =
+  let str_val (buf : Buffer.t) (s : string) =
-    char oc '"';
+    char buf '"';
     let encode_char c =
       match c with
-      | '"' -> raw_string oc {|\"|}
+      | '"' -> raw_string buf {|\"|}
-      | '\\' -> raw_string oc {|\\|}
+      | '\\' -> raw_string buf {|\\|}
-      | '\n' -> raw_string oc {|\n|}
+      | '\n' -> raw_string buf {|\n|}
-      | '\b' -> raw_string oc {|\b|}
+      | '\b' -> raw_string buf {|\b|}
-      | '\r' -> raw_string oc {|\r|}
+      | '\r' -> raw_string buf {|\r|}
-      | '\t' -> raw_string oc {|\t|}
+      | '\t' -> raw_string buf {|\t|}
       | _ when Char.code c <= 0x1f ->
-        raw_string oc {|\u00|};
+        raw_string buf {|\u00|};
-        Printf.fprintf oc "%02x" (Char.code c)
+        Printf.bprintf buf "%02x" (Char.code c)
-      | c -> char oc c
+      | c -> char buf c
     in
     String.iter encode_char s;
-    char oc '"'
+    char buf '"'
 
-  let pp_user_data_ out : [< user_data ] -> unit = function
+  let pp_user_data_ (out : Buffer.t) : [< user_data ] -> unit = function
-    | `None -> Printf.fprintf out "null"
+    | `None -> raw_string out "null"
-    | `Int i -> Printf.fprintf out "%d" i
+    | `Int i -> Printf.bprintf out "%d" i
-    | `Bool b -> Printf.fprintf out "%b" b
+    | `Bool b -> Printf.bprintf out "%b" b
     | `String s -> str_val out s
-    | `Float f -> Printf.fprintf out "%g" f
+    | `Float f -> Printf.bprintf out "%g" f
 
   (* emit args, if not empty. [ppv] is used to print values. *)
-  let emit_args_o_ ppv oc args : unit =
+  let emit_args_o_ ppv (out : Buffer.t) args : unit =
     if args <> [] then (
-      Printf.fprintf oc {json|,"args": {|json};
+      Printf.bprintf out {json|,"args": {|json};
       List.iteri
         (fun i (n, value) ->
-          if i > 0 then Printf.fprintf oc ",";
+          if i > 0 then raw_string out ",";
-          Printf.fprintf oc {json|"%s":%a|json} n ppv value)
+          Printf.bprintf out {json|"%s":%a|json} n ppv value)
         args;
-      char oc '}'
+      char out '}'
     )
 
   let emit_duration_event ~tid ~name ~start ~end_ ~args (self : t) : unit =
     let dur = end_ -. start in
     let ts = start in
-    emit_sep_ self;
+
-    Printf.fprintf self.oc
+    emit_sep_and_start_ self;
+
+    Printf.bprintf self.buf
       {json|{"pid":%d,"cat":"","tid": %d,"dur": %.2f,"ts": %.2f,"name":%a,"ph":"X"%a}|json}
       self.pid tid dur ts str_val name
       (emit_args_o_ pp_user_data_)
       args;
-    ()
+    Buffer.output_buffer self.oc self.buf
 
   let emit_manual_begin ~tid ~name ~id ~ts ~args ~flavor (self : t) : unit =
-    emit_sep_ self;
+    emit_sep_and_start_ self;
-    Printf.fprintf self.oc
+    Printf.bprintf self.buf
       {json|{"pid":%d,"cat":"trace","id":%d,"tid": %d,"ts": %.2f,"name":%a,"ph":"%c"%a}|json}
       self.pid id tid ts str_val name
       (match flavor with
@@ -214,11 +219,11 @@ module Writer = struct
       | Some `Sync -> 'B')
       (emit_args_o_ pp_user_data_)
       args;
-    ()
+    Buffer.output_buffer self.oc self.buf
 
   let emit_manual_end ~tid ~name ~id ~ts ~flavor ~args (self : t) : unit =
-    emit_sep_ self;
+    emit_sep_and_start_ self;
-    Printf.fprintf self.oc
+    Printf.bprintf self.buf
       {json|{"pid":%d,"cat":"trace","id":%d,"tid": %d,"ts": %.2f,"name":%a,"ph":"%c"%a}|json}
       self.pid id tid ts str_val name
       (match flavor with
@@ -226,43 +231,42 @@ module Writer = struct
       | Some `Sync -> 'E')
       (emit_args_o_ pp_user_data_)
       args;
-
+    Buffer.output_buffer self.oc self.buf
-    ()
 
   let emit_instant_event ~tid ~name ~ts ~args (self : t) : unit =
-    emit_sep_ self;
+    emit_sep_and_start_ self;
-    Printf.fprintf self.oc
+    Printf.bprintf self.buf
       {json|{"pid":%d,"cat":"","tid": %d,"ts": %.2f,"name":%a,"ph":"I"%a}|json}
       self.pid tid ts str_val name
       (emit_args_o_ pp_user_data_)
       args;
-    ()
+    Buffer.output_buffer self.oc self.buf
 
   let emit_name_thread ~tid ~name (self : t) : unit =
-    emit_sep_ self;
+    emit_sep_and_start_ self;
-    Printf.fprintf self.oc
+    Printf.bprintf self.buf
       {json|{"pid":%d,"tid": %d,"name":"thread_name","ph":"M"%a}|json} self.pid
       tid
       (emit_args_o_ pp_user_data_)
       [ "name", `String name ];
-    ()
+    Buffer.output_buffer self.oc self.buf
 
   let emit_name_process ~name (self : t) : unit =
-    emit_sep_ self;
+    emit_sep_and_start_ self;
-    Printf.fprintf self.oc
+    Printf.bprintf self.buf
       {json|{"pid":%d,"name":"process_name","ph":"M"%a}|json} self.pid
       (emit_args_o_ pp_user_data_)
       [ "name", `String name ];
-    ()
+    Buffer.output_buffer self.oc self.buf
 
   let emit_counter ~name ~tid ~ts (self : t) f : unit =
-    emit_sep_ self;
+    emit_sep_and_start_ self;
-    Printf.fprintf self.oc
+    Printf.bprintf self.buf
       {json|{"pid":%d,"tid":%d,"ts":%.2f,"name":"c","ph":"C"%a}|json} self.pid
       tid ts
       (emit_args_o_ pp_user_data_)
       [ name, `Float f ];
-    ()
+    Buffer.output_buffer self.oc self.buf
 end
 
 (** Background thread, takes events from the queue, puts them