feat: add an optional imandrakit.magic-trace lib

.gitignore

@@ -1,3 +1,5 @@
 _build
 _opam
 *.exe
+*.fxt
+*.fxt.old

src/magic-trace/dune

@@ -0,0 +1,10 @@
+
+(library
+  (name imandrakit_magic_trace)
+  (public_name imandrakit.magic-trace)
+  (optional)
+  (libraries ocaml_intrinsics atomic)
+  (foreign_stubs
+    (language c)
+    (names imandrakit_magic_stubs))
+  (synopsis "Simple stub to trigger https://github.com/janestreet/magic-trace"))

src/magic-trace/imandrakit_magic_stubs.c

@@ -0,0 +1,6 @@
+
+#include <caml/mlvalues.h>
+
+CAMLprim value magic_trace_stop_indicator(value v1, value v2) {
+  return Val_unit;
+}

src/magic-trace/imandrakit_magic_trace.ml

@@ -0,0 +1,32 @@
+module A = Atomic
+
+external stop_indicator_ : int -> int -> unit = "magic_trace_stop_indicator"
+  [@@noalloc]
+(** Symbol used to tell magic-trace to take a snapshot *)
+
+let[@inline] now_ts () : int = Ocaml_intrinsics.Perfmon.rdtsc () |> Int64.to_int
+
+(** Start of snapshot *)
+let start : int A.t = A.make 0
+
+let mark_start () =
+  let now = now_ts () in
+  while
+    let old = A.get start in
+    not (A.compare_and_set start old now)
+  do
+    ()
+  done
+
+let[@inline] trigger_snapshot () = stop_indicator_ (A.get start) 3
+
+let with_snapshot f =
+  mark_start ();
+  try
+    let x = f () in
+    trigger_snapshot ();
+    x
+  with e ->
+    let bt = Printexc.get_raw_backtrace () in
+    trigger_snapshot ();
+    Printexc.raise_with_backtrace e bt

src/magic-trace/imandrakit_magic_trace.mli

@@ -0,0 +1,20 @@
+(** Magic trace stop indicator.
+
+    This magic function will, {b IF} magic-trace is attached to
+    the current process, trigger a snapshot of the last few milliseconds.
+
+    See https://github.com/janestreet/magic-trace for more details.
+    Typical use:
+
+    - [magic-trace run -multi-snapshot -trigger . -- foo.exe] (use this special symbol)
+    - [magic-trace run -multi-snapshot -trigger '?' -- foo.exe] (to pick the symbol to stop)
+    - [magic-trace attach <pid>]
+
+    then use [trace-processor trace.fxt --httpd] to process the trace if it's too
+    big to be processed in perfetto's web UI
+
+ *)
+
+val mark_start : unit -> unit
+val trigger_snapshot : unit -> unit
+val with_snapshot : (unit -> 'a) -> 'a

test/magic-trace/dune

@@ -0,0 +1,4 @@
+
+(test
+  (name test_magic_trace)
+  (libraries unix imandrakit.magic-trace))

test/magic-trace/test_magic_trace.ml

@@ -0,0 +1,27 @@
+(* run this with magic-trace to see *)
+
+let ( let@ ) = ( @@ )
+
+let rec fib i =
+  if i <= 2 then
+    1
+  else
+    fib (i - 1) + fib (i - 2)
+
+let[@inline never] run n = Printf.printf "fib %d = %d\n%!" n (fib n)
+
+let[@inline never] loop_iter () =
+  let@ () = Imandrakit_magic_trace.with_snapshot in
+  run 2;
+  run 44;
+  run 8;
+  run 26
+
+let () =
+  for _i = 1 to 4 do
+    loop_iter ();
+    Unix.sleepf 0.02
+  done;
+  run 40;
+  Unix.sleepf 0.5;
+  ()