From a2d678c002b4c2bfac9526ed762f776e327dfac5 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 28 Nov 2023 15:41:41 -0500 Subject: [PATCH 1/2] add frame API --- src/bindings/tracy_client.ml | 17 +++++++++++++++++ src/bindings/tracy_client.mli | 12 ++++++++++++ src/bindings/tracy_stubs.cc | 15 +++++++++++++++ 3 files changed, 44 insertions(+) diff --git a/src/bindings/tracy_client.ml b/src/bindings/tracy_client.ml index 702a5c1..d9a6caa 100644 --- a/src/bindings/tracy_client.ml +++ b/src/bindings/tracy_client.ml @@ -24,6 +24,11 @@ external _tracy_span_value : span -> int64 -> unit = "ml_tracy_span_value" external _tracy_span_color : span -> int -> unit = "ml_tracy_span_color" [@@noalloc] +external _tracy_frame_enter : string -> unit = "ml_tracy_frame_enter" + [@@noalloc] + +external _tracy_frame_exit : string -> unit = "ml_tracy_frame_exit" [@@noalloc] + let enter ?cs_depth ~__FILE__:file ~__LINE__:line ?(__FUNCTION__ = "") name : span = let depth = @@ -46,6 +51,18 @@ let add_text = _tracy_span_text let set_app_info = _tracy_app_info let message_f k = k (fun fmt -> Format.kasprintf message fmt) let add_text_f sp k = k (fun fmt -> Format.kasprintf (add_text sp) fmt) +let enter_frame = _tracy_frame_enter +let exit_frame = _tracy_frame_exit + +let[@inline] with_frame name f = + enter_frame name; + try + let x = f () in + exit_frame name; + x + with e -> + exit_frame name; + raise e let[@inline] with_ ?cs_depth ~__FILE__ ~__LINE__ ?__FUNCTION__ name f = let _sp = enter ?cs_depth ~__FILE__ ~__LINE__ ?__FUNCTION__ name in diff --git a/src/bindings/tracy_client.mli b/src/bindings/tracy_client.mli index a9d4051..cbde36e 100644 --- a/src/bindings/tracy_client.mli +++ b/src/bindings/tracy_client.mli @@ -68,4 +68,16 @@ val message_f : (** Send a formatted message. Usage: [message_f (fun k -> k "hello %s %d" "world" 42)] *) +val enter_frame : string -> unit +(** Enter named frame. + @since NEXT_RELEASE *) + +val exit_frame : string -> unit +(** Exit named frame. + @since NEXT_RELEASE *) + +val with_frame : string -> (unit -> 'a) -> 'a +(** Protected enter+exit frame + @since NEXT_RELEASE *) + val plot : string -> float -> unit diff --git a/src/bindings/tracy_stubs.cc b/src/bindings/tracy_stubs.cc index 9d168e7..0b2bce7 100644 --- a/src/bindings/tracy_stubs.cc +++ b/src/bindings/tracy_stubs.cc @@ -156,4 +156,19 @@ CAMLprim value ml_tracy_plot(value name, value x) { CAMLreturn(Val_unit); } + +CAMLprim value ml_tracy_frame_enter(value name) { + char const *c_name = String_val(name); + TracyCFrameMarkStart(c_name); + return Val_unit; +} + +CAMLprim value ml_tracy_frame_exit(value name) { + char const *c_name = String_val(name); + TracyCFrameMarkEnd(c_name); + return Val_unit; } + + +} // extern "C" + From 8f069c9226362e61a1b5cc8f101eb4a75c6c981e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 28 Nov 2023 15:44:32 -0500 Subject: [PATCH 2/2] compat with trace --- src/trace/tracy_client_trace.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/trace/tracy_client_trace.ml b/src/trace/tracy_client_trace.ml index dc1d492..70d19c6 100644 --- a/src/trace/tracy_client_trace.ml +++ b/src/trace/tracy_client_trace.ml @@ -39,6 +39,8 @@ module C () : Trace.Collector.S = struct let shutdown () = () let add_data_to_span _ _ = () let add_data_to_manual_span _ _ = () + let enter_context name = Tracy_client.enter_frame name + let exit_context name = Tracy_client.exit_frame name let enter_manual_span ~parent:_ ~flavor:_ ~__FUNCTION__:_ ~__FILE__:_ ~__LINE__:_ ~data:_ _name : explicit_span =