From bd8b483e813e694fc7dbdf189d18e4663866b770 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 20 Dec 2023 15:46:39 -0500 Subject: [PATCH] feat: use AList for tick callbacks; emit GC events on tick it's cleaner to emit GC events on ticks rather than on GC, because it avoids both spamming if the GC is very active, and emitting nothing when there are few allocations. --- .../opentelemetry_client_cohttp_lwt.ml | 6 +++--- src/client-ocurl/opentelemetry_client_ocurl.ml | 5 ++--- src/core/opentelemetry.ml | 15 ++++++++------- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml b/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml index 5b4f0453..b078c5b2 100644 --- a/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml +++ b/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml @@ -257,7 +257,7 @@ module type EMITTER = sig val push_logs : Logs.resource_logs list -> unit - val set_on_tick_callbacks : (unit -> unit) list ref -> unit + val set_on_tick_callbacks : (unit -> unit) AList.t -> unit val tick : unit -> unit @@ -288,7 +288,7 @@ let mk_emitter ~stop ~(config : Config.t) () : (module EMITTER) = let batch_logs : Logs.resource_logs list Batch.t = Batch.make ?batch:config.batch_logs ?timeout () - let on_tick_cbs_ = Atomic.make (ref []) + let on_tick_cbs_ = Atomic.make (AList.make ()) let set_on_tick_callbacks = Atomic.set on_tick_cbs_ @@ -384,7 +384,7 @@ let mk_emitter ~stop ~(config : Config.t) () : (module EMITTER) = with e -> Printf.eprintf "on tick callback raised: %s\n" (Printexc.to_string e)) - !(Atomic.get on_tick_cbs_); + (AList.get @@ Atomic.get on_tick_cbs_); () (* thread that calls [tick()] regularly, to help enforce timeouts *) diff --git a/src/client-ocurl/opentelemetry_client_ocurl.ml b/src/client-ocurl/opentelemetry_client_ocurl.ml index 70a8fa22..41029e8b 100644 --- a/src/client-ocurl/opentelemetry_client_ocurl.ml +++ b/src/client-ocurl/opentelemetry_client_ocurl.ml @@ -431,15 +431,14 @@ let create_backend ?(stop = Atomic.make false) ret ()); } - let on_tick_cbs_ = Atomic.make (ref []) + let on_tick_cbs_ = Atomic.make (AList.make ()) let set_on_tick_callbacks = Atomic.set on_tick_cbs_ let tick () = sample_gc_metrics_if_needed (); Backend_impl.send_event backend Event.E_tick; - let l = Atomic.get on_tick_cbs_ in - List.iter (fun f -> f ()) !l + List.iter (fun f -> f ()) (AList.get @@ Atomic.get on_tick_cbs_) let cleanup () = Backend_impl.shutdown backend end in diff --git a/src/core/opentelemetry.ml b/src/core/opentelemetry.ml index 964d0183..bd83b63d 100644 --- a/src/core/opentelemetry.ml +++ b/src/core/opentelemetry.ml @@ -86,7 +86,7 @@ module Collector = struct (** Should be called regularly for background processing, timeout checks, etc. *) - val set_on_tick_callbacks : (unit -> unit) list ref -> unit + val set_on_tick_callbacks : (unit -> unit) AList.t -> unit (** Give the collector the list of callbacks to be executed when [tick()] is called. Each such callback should be short and reentrant. Depending on the collector's implementation, it might be @@ -162,7 +162,7 @@ module Collector = struct (* hidden *) open struct - let on_tick_cbs_ = ref [] + let on_tick_cbs_ = AList.make () let backend : backend option ref = ref None end @@ -198,7 +198,7 @@ module Collector = struct let[@inline] rand_bytes_8 () = !Rand_bytes.rand_bytes_8 () - let on_tick f = on_tick_cbs_ := f :: !on_tick_cbs_ + let[@inline] on_tick f = AList.add on_tick_cbs_ f (** Do background work. Call this regularly if the collector doesn't already have a ticker thread or internal timer. *) @@ -1138,7 +1138,8 @@ end These metrics are emitted after each GC collection. *) module GC_metrics : sig val basic_setup : unit -> unit - (** Setup a hook that will emit GC statistics regularly *) + (** Setup a hook that will emit GC statistics on every tick (assuming + a ticker thread) *) val get_runtime_attributes : unit -> Span.key_value list (** Get OCaml name and version runtime attributes *) @@ -1158,13 +1159,13 @@ end = struct let get_runtime_attributes () = Lazy.force runtime_attributes let basic_setup () = - (* emit metrics when GC is called *) - let on_gc () = + let on_tick () = match Collector.get_backend () with | None -> () | Some (module C) -> C.signal_emit_gc_metrics () in - ignore (Gc.create_alarm on_gc : Gc.alarm) + + Collector.on_tick on_tick let bytes_per_word = Sys.word_size / 8