refactor: split some parts of trace-tef into trace.private.util

This commit is contained in:
Simon Cruanes 2023-12-25 16:51:52 -05:00
parent 14f9a2ea94
commit 7f9370e842
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
10 changed files with 16 additions and 18 deletions

View file

@ -3,7 +3,4 @@
(name trace_tef) (name trace_tef)
(public_name trace-tef) (public_name trace-tef)
(synopsis "Simple and lightweight tracing using TEF/Catapult format, in-process") (synopsis "Simple and lightweight tracing using TEF/Catapult format, in-process")
(libraries trace.core mtime mtime.clock.os atomic unix threads (libraries trace.core trace.private.util mtime mtime.clock.os atomic unix threads))
(select relax_.ml from
(base-domain -> relax_.real.ml)
( -> relax_.dummy.ml))))

View file

@ -1,4 +1,5 @@
open Trace_core open Trace_core
open Trace_private_util
module A = Trace_core.Internal_.Atomic_ module A = Trace_core.Internal_.Atomic_
module Mock_ = struct module Mock_ = struct
@ -14,7 +15,7 @@ end
let counter = Mtime_clock.counter () let counter = Mtime_clock.counter ()
(** Now, in microseconds *) (** Now, in microseconds *)
let now_us () : float = let[@inline] now_us () : float =
if !Mock_.enabled then if !Mock_.enabled then
Mock_.now_us () Mock_.now_us ()
else ( else (
@ -22,16 +23,6 @@ let now_us () : float =
Mtime.Span.to_float_ns t /. 1e3 Mtime.Span.to_float_ns t /. 1e3
) )
let protect ~finally f =
try
let x = f () in
finally ();
x
with exn ->
let bt = Printexc.get_raw_backtrace () in
finally ();
Printexc.raise_with_backtrace exn bt
let on_tracing_error = ref (fun s -> Printf.eprintf "trace-tef error: %s\n%!" s) let on_tracing_error = ref (fun s -> Printf.eprintf "trace-tef error: %s\n%!" s)
type event = type event =
@ -144,7 +135,7 @@ module Writer = struct
let with_ ~out f = let with_ ~out f =
let writer = create ~out () in let writer = create ~out () in
protect ~finally:(fun () -> close writer) (fun () -> f writer) Fun.protect ~finally:(fun () -> close writer) (fun () -> f writer)
let[@inline] flush (self : t) : unit = flush self.oc let[@inline] flush (self : t) : unit = flush self.oc
@ -499,7 +490,7 @@ let setup ?(out = `Env) () =
let with_setup ?out () f = let with_setup ?out () f =
setup ?out (); setup ?out ();
protect ~finally:Trace_core.shutdown f Fun.protect ~finally:Trace_core.shutdown f
module Internal_ = struct module Internal_ = struct
let mock_all_ () = Mock_.enabled := true let mock_all_ () = Mock_.enabled := true

1
src/util/cpu_relax.mli Normal file
View file

@ -0,0 +1 @@
val cpu_relax : unit -> unit

9
src/util/dune Normal file
View file

@ -0,0 +1,9 @@
(library
(public_name trace.private.util)
(synopsis "internal utilities for trace. No guarantees of stability.")
(name trace_private_util)
(libraries trace.core mtime mtime.clock.os atomic unix threads
(select cpu_relax.ml from
(base-domain -> cpu_relax.real.ml)
( -> cpu_relax.dummy.ml))))

View file

@ -11,7 +11,7 @@ module Backoff = struct
let once (b : t) : t = let once (b : t) : t =
for _i = 1 to b do for _i = 1 to b do
Relax_.cpu_relax () Cpu_relax.cpu_relax ()
done; done;
min (b * 2) 256 min (b * 2) 256
end end