Introduce new, experimental trace-writing backend

The existing `Trace_writer` module works well enough (albeit not perfectly) most of the
time. However, it is difficult to reason about, in large part because it writes the
trace in a streaming fashion. That introduces significant additional complexity and
bookkeeping, and limits the ability of the trace-writer to make use of information
discovered later in the trace (I believe the latter is why traces produced today often
have the few frames closest to the root wrong). Because we want to extend the trace-writer
with new functionality, we're starting fresh with a different design that's easier to reason about.
The new implementation currently exists alongside the original, but the goal is to eventually
replace it entirely.

Instead of writing the trace in a streaming fashion, we construct an internal
representation of the trace in memory, and write out the trace in a separate, final pass
once all of the events have been consumed. The module responsible for doing most of the
heavy lifting is the new `Trace_segment`, which represents a continuous, lossless, and
error-free segment of the trace; we create a new trace-segment whenever we encounter an
error.

The other major addition is that the new implementation includes inlined function calls,
using LLVM for symbolization, dramatically increasing the fidelity of the trace.

**This PR is effectively an alpha of the new implementation.** The code here does indeed work,
and produces better traces than the existing backend in many cases, but there are a couple
critical issues:
1. **Error recovery**: We create a new trace-segment whenever we encounter an error,
   **but at present we naively treat each trace-segment as disjoint**. We need to add an additional
   "stitching" pass before the trace is written out, making a heuristic, best-effort attempt to
   join together adjacent trace-segments in a way that preserves control-flow continuity.
   All of this is a long way of saying that if you encounter *any* error while using the new
   implementation, your trace is likely to be horribly broken.
2. **Performance**: Including inlined frames makes the traces significantly larger, and the supporting
   code for this new functionality is written pretty naively from a performance standpoint. As a result,
   the new implementation is roughly 2x slower than the old implementation.

It should also go without saying that while this code appears to work well on the traces I've
tried it on, I would not at all be surprised if there are still bugs/edge-cases.

We will address these shortcomings over time, but in the meantime the new implementation is opt-in;
setting the environment variable `MAGIC_TRACE_USE_NEW_TRACE_WRITER=1` will enable it.

Signed-off-by: Kevin Svetlitski <ksvetlitski@janestreet.com>

.github/workflows/build.yml

@@ -16,70 +16,31 @@ jobs:
           - '231c88c2e564fdca40e15e750aacad5fb0887435'
 
     runs-on: ${{ matrix.os }}
+    container:
+      image: alpine:latest
     steps:
+      # This has to come first because the `actions/*` GitHub Actions require `node`,
+      # which isn't installed by default on this container image.
+      - name: "Install apk packages"
+        run: |
+          apk add autoconf bash bubblewrap build-base clang coreutils git libstdc++ \
+            libstdc++-dev libunwind-static linux-headers lld llvm20 llvm20-dev llvm20-static \
+            nodejs opam rsync upx zlib-static zstd-static
+          echo "PATH=/usr/lib/llvm20/bin:$PATH" >> "$GITHUB_ENV"
+
       - name: Checkout code
         uses: actions/checkout@v6
 
+      # This is necessary to avoid an error of the form 'fatal: detected dubious ownership in repository ...'
+      - run: git config --global --add safe.directory $(pwd)
+
       - uses: actions/cache@v5
         with:
           path: ~/.opam
-          key: ${{ matrix.os }}-opam-${{ matrix.ocaml-version }}-${{ matrix.oxcaml-opam-commit }}-1
-
-      - name: Install musl-compatible kernel headers
-        run: |
-          mkdir musl-kernel
-          filename='v4.19.88-1.tar.gz'
-          wget "https://github.com/sabotage-linux/kernel-headers/archive/refs/tags/$filename"
-          shasum --check <(echo "44a07e9f18033cff7840dbb112fff2862c0fb8fc  $filename")
-          tar -xzf "$filename" -C musl-kernel --strip-components=1
-          echo "C_INCLUDE_PATH=$(pwd)/musl-kernel/x86/include" >> "$GITHUB_ENV"
-          echo "CC=musl-gcc" >> "$GITHUB_ENV"
-
-      - name: "Install apt packages"
-        run: |
-          sudo apt-get update
-          sudo apt-get install -y bubblewrap musl musl-tools libucl1 rsync
-
-      - name: Install upx
-        run: |
-          # The version that comes with focal is broken for musl binaries, so we have to download
-          # from another location.
-          filename='upx-ucl_3.96-2_amd64.deb'
-          wget "http://ftp.debian.org/debian/pool/main/u/upx-ucl/$filename"
-          shasum --check <(echo "0b3c901a6ae8db264a0e58aad9bbed4ef3e925b9  $filename")
-          sudo dpkg -i upx-ucl_3.96-2_amd64.deb
-
-      - name: Build zlib with musl
-        run: |
-          mkdir musl-zlib
-          filename='zlib-1.3.2.tar.gz'
-          wget "https://zlib.net/$filename"
-          shasum -a 256 --check <(echo "bb329a0a2cd0274d05519d61c667c062e06990d72e125ee2dfa8de64f0119d16  $filename")
-          tar -xzf "$filename" -C musl-zlib --strip-components=1
-          cd musl-zlib
-          CC=musl-gcc ./configure --libdir=/usr/lib/x86_64-linux-musl --includedir=/usr/include/x86_64-linux-musl
-          make -j$(nproc)
-          sudo make install
-
-      - name: Build zstd with musl
-        run: |
-          mkdir musl-zstd
-          filename='zstd-1.5.5.tar.gz'
-          wget "https://github.com/facebook/zstd/releases/download/v1.5.5/$filename"
-          shasum --check <(echo "4479ecc74300d23391d99fbebf2fddd47aed9b28  $filename")
-          tar -xzf "$filename" -C musl-zstd --strip-components=1
-          cd musl-zstd
-          CC=musl-gcc make -j$(nproc)
-          sudo make INCLUDEDIR=/usr/include/x86_64-linux-musl LIBDIR=/usr/lib/x86_64-linux-musl install
+          key: ${{ matrix.os }}-opam-${{ matrix.ocaml-version }}-${{ matrix.oxcaml-opam-commit }}-2
 
       - name: Use OCaml ${{ matrix.ocaml-version }}
         run: |
-          filename='opam-2.5.0-x86_64-linux'
-          wget "https://github.com/ocaml/opam/releases/download/2.5.0/$filename"
-          shasum --check <(echo "67fb680a785f0bc7ceb57155f21786c0680ef5fe  $filename")
-          sudo mv "$filename" /usr/local/bin/opam
-          sudo chmod a+x /usr/local/bin/opam
-
           export OPAMYES=1
           export OPAMJOBS=$(($(nproc) + 2))
           export OPAMROOTISOK=1
@@ -97,11 +58,12 @@ jobs:
 
       - run: opam exec -- make PROFILE=static
 
-      - run: opam exec -- dune runtest
+      - run: opam exec -- dune runtest --profile=static
 
       - name: Compress magic-trace executable
         run: |
           cp _build/install/default/bin/magic-trace .
+          chmod u+w magic-trace
           ls -l magic-trace
           strip magic-trace
           upx -9 magic-trace

direct_backend/cinaps/dune

@@ -1,5 +1,6 @@
 (library
  (name magic_trace_lib_cinaps_helpers)
+ (no_dynlink)
  (libraries core)
  (preprocess
   (pps ppx_jane)))

dune

@@ -1,6 +1,8 @@
 (env
  (static
   (flags
-   (:standard -cclib -static))))
+   (:standard -cclib -static -cclib -no-pie))
+  (link_flags
+   (:standard -cclib -static -cclib -no-pie))))
 
 (vendored_dirs vendor)

dune-project

@@ -1 +1 @@
-(lang dune 2.0)
+(lang dune 3.0)

lib/magic_trace/src/dune

@@ -1,6 +1,7 @@
 (library
  (name magic_trace)
  (public_name magic-trace.magic_trace)
+ (no_dynlink)
  (foreign_stubs
   (language c)
   (names stop_stubs))

lib/magic_trace/test/dune

@@ -1,5 +1,6 @@
 (library
  (name magic_trace_test)
+ (no_dynlink)
  (libraries core expect_test_helpers_core magic_trace)
  (preprocess
   (pps ppx_jane)))

magic-trace.opam

@@ -27,6 +27,7 @@ depends: [
   "owee"         {>= "0.8"}
   "re"           {>= "1.8.0"}
   "zstandard"
+  "vec"
 ]
 synopsis: "Collects and displays high-resolution traces of what a process is doing"
 description: "https://github.com/janestreet/magic-trace"

magic-trace.opam.locked

@@ -65,6 +65,7 @@ depends: [
   "fieldslib" {= "v0.18~preview.130.91+190"}
   "fix" {= "20250919"}
   "flexible_sexp" {= "v0.18~preview.130.91+190"}
+  "float_array" {= "v0.18~preview.130.91+190"}
   "fmt" {= "0.11.0"}
   "fpath" {= "0.7.3"}
   "int_repr" {= "v0.18~preview.130.91+190"}
@@ -180,6 +181,7 @@ depends: [
   "ppx_base" {= "v0.18~preview.130.91+190"}
   "ppx_bench" {= "v0.18~preview.130.91+190"}
   "ppx_bin_prot" {= "v0.18~preview.130.91+190"}
+  "ppx_box" {= "v0.18~preview.130.91+190"}
   "ppx_builtin" {= "v0.18~preview.130.91+190"}
   "ppx_cold" {= "v0.18~preview.130.91+190"}
   "ppx_compare" {= "v0.18~preview.130.91+190"}
@@ -192,6 +194,7 @@ depends: [
   "ppx_expect" {= "v0.18~preview.130.91+190"}
   "ppx_fields_conv" {= "v0.18~preview.130.91+190"}
   "ppx_fixed_literal" {= "v0.18~preview.130.91+190"}
+  "ppx_for_loop" {= "v0.18~preview.130.91+190"}
   "ppx_fuelproof" {= "v0.18~preview.130.91+190"}
   "ppx_globalize" {= "v0.18~preview.130.91+190"}
   "ppx_hash" {= "v0.18~preview.130.91+190"}
@@ -247,6 +250,7 @@ depends: [
   "time_now" {= "v0.18~preview.130.91+190"}
   "topkg" {= "1.1.1+ox"}
   "typerep" {= "v0.18~preview.130.91+190"}
+  "unboxed" {= "v0.18~preview.130.91+190"}
   "unique" {= "v0.18~preview.130.91+190"}
   "univ_map" {= "v0.18~preview.130.91+190"}
   "uopt" {= "v0.18~preview.130.91+190"}
@@ -256,7 +260,8 @@ depends: [
   "uuseg" {= "17.0.0"}
   "uutf" {= "1.0.4+ox"}
   "variantslib" {= "v0.18~preview.130.91+190"}
+  "vec" {= "v0.18~preview.130.91+190"}
   "zstandard" {= "v0.18~preview.130.91+190"}
 ]
 build: ["dune" "build" "-p" name "-j" jobs]
-dev-repo: "git+https://github.com/janestreet/magic-trace.git"
+dev-repo: "git+https://github.com/janestreet/magic-trace.git"

src/dune

@@ -9,15 +9,45 @@
    (run %{bin:gcc} -shared -o dlfilter/perf_dlfilter.so perf_dlfilter.o)
    (run %{bin:ocaml-crunch} -m plain dlfilter -o perf_dlfilter.ml))))
 
+(rule
+ (target libLLVM.a)
+ (deps llvm_symbolizer_stubs.cpp)
+ (action
+  (progn
+   (bash
+    "clang++ -std=c++20 -Wall -Wextra -Werror -Wno-unused-parameter -DCAML_NAME_SPACE -I %{ocaml_where} $(llvm-config --cxxflags) -O3 -march=broadwell -mtune=skylake -ffunction-sections -c llvm_symbolizer_stubs.cpp")
+   (bash
+    "ld.lld --gc-sections -static -r -plugin-opt=mcpu=broadwell -plugin-opt=O3 --hash-style=gnu --build-id --start-lib $(llvm-config --link-static --libfiles Symbolize) --end-lib llvm_symbolizer_stubs.o -o libLLVM.o")
+   (run llvm-strip --strip-debug libLLVM.o)
+   (run llvm-ar Drcs %{target} libLLVM.o))))
+
 (library
  (name magic_trace_lib)
  (public_name magic-trace.magic_trace_lib)
+ (no_dynlink)
+ (flags
+  (:standard -cclib -lstdc++))
+ (foreign_archives LLVM)
  (foreign_stubs
   (language c)
   (names breakpoint_stubs boot_time_stubs ptrace_stubs))
- (libraries core async core_unix.filename_unix fzf re shell
-   core_unix.sys_unix cohttp cohttp_static_handler core_unix.signal_unix
-   tracing magic_trace owee angstrom expect_test_helpers_core)
+ (libraries
+  core
+  async
+  core_unix.filename_unix
+  fzf
+  re
+  shell
+  core_unix.sys_unix
+  cohttp
+  cohttp_static_handler
+  core_unix.signal_unix
+  tracing
+  magic_trace
+  owee
+  angstrom
+  expect_test_helpers_core
+  vec)
  (inline_tests)
  (preprocess
   (pps ppx_jane)))

src/env_vars.ml

@@ -54,3 +54,7 @@ let no_ocaml_exception_debug_info =
 let skip_transaction_handling =
   Option.is_some (Unix.getenv "MAGIC_TRACE_SKIP_TX_HANDLING")
 ;;
+
+(* Use [New_trace_writer] instead of [Trace_writer]. *)
+let use_new_trace_writer = Option.is_some (Unix.getenv "MAGIC_TRACE_USE_NEW_TRACE_WRITER")
+let check_invariants = Option.is_some (Unix.getenv "MAGIC_TRACE_CHECK_INVARIANTS")

src/env_vars.mli

@@ -12,3 +12,5 @@ val no_dlfilter : bool
 val fzf_demangle_symbols : bool
 val no_ocaml_exception_debug_info : bool
 val skip_transaction_handling : bool
+val use_new_trace_writer : bool
+val check_invariants : bool

src/event.ml

@@ -25,11 +25,13 @@ end
 
 module Location = struct
   type t =
-    { instruction_pointer : Int64.Hex.t
+    { (* TODO Use [i64] everywhere. *)
+      instruction_pointer : Int64.Hex.t
     ; symbol : Symbol.t
     ; symbol_offset : Int.Hex.t
+    ; dso : Interned_string.t or_null
     }
-  [@@deriving sexp, fields, bin_io]
+  [@@deriving sexp, fields ~getters, bin_io]
 
   module Ignore_symbol = struct
     (* Ignoring symbol strings when serializing to save space. This reduces the size of events file
@@ -41,13 +43,13 @@ module Location = struct
     let to_sexpable { instruction_pointer; _ } = instruction_pointer
 
     let of_sexpable instruction_pointer =
-      { instruction_pointer; symbol = Symbol.Unknown; symbol_offset = 0 }
+      { instruction_pointer; symbol = Symbol.Unknown; symbol_offset = 0; dso = Null }
     ;;
 
     let to_binable { instruction_pointer; _ } = instruction_pointer
 
     let of_binable instruction_pointer =
-      { instruction_pointer; symbol = Symbol.Unknown; symbol_offset = 0 }
+      { instruction_pointer; symbol = Symbol.Unknown; symbol_offset = 0; dso = Null }
     ;;
 
     let caller_identity =
@@ -60,7 +62,10 @@ module Location = struct
 
   (* magic-trace has some things that aren't functions but look like they are in the trace
      (like "[untraced]" and "[syscall]") *)
-  let locationless symbol = { instruction_pointer = 0L; symbol; symbol_offset = 0 }
+  let locationless symbol =
+    { instruction_pointer = 0L; symbol; symbol_offset = 0; dso = Null }
+  ;;
+
   let unknown = locationless Unknown
   let untraced = locationless Untraced
   let returned = locationless Returned

src/event.mli

@@ -28,8 +28,9 @@ module Location : sig
     { instruction_pointer : int64
     ; symbol : Symbol.t
     ; symbol_offset : int
+    ; dso : Interned_string.t or_null
     }
-  [@@deriving sexp, fields, bin_io]
+  [@@deriving sexp, fields ~getters, bin_io]
 
   val unknown : t
   val untraced : t

src/interned_string.ml

@@ -0,0 +1,22 @@
+open! Core
+
+type t = string [@@deriving sexp_of]
+
+let equal = phys_equal
+let compare t1 t2 = Int.compare (Obj.magic t1) (Obj.magic t2)
+let hash t = Int.hash (Obj.magic t)
+let hash_fold_t hash_state t = Int.hash_fold_t hash_state (Obj.magic t)
+let cache = String.Hash_set.create ()
+let intern t = Hash_set.get_or_add cache t
+
+let t_of_sexp = function
+  | Sexp.Atom string -> intern string
+  | _ -> assert false
+;;
+
+let of_string = intern
+let to_string t = t
+let uuid = "6c0bf9f4-3378-11f1-ae24-c84bd6ab9c33"
+let caller_identity = Bin_prot.Shape.Uuid.of_string uuid
+
+include functor Binable.Of_stringable_with_uuid

src/interned_string.mli

@@ -0,0 +1,5 @@
+open! Core
+
+type t = private string [@@deriving equal, hash, compare, sexp, bin_io]
+
+val intern : string -> t

src/llvm_symbolizer_stubs.cpp

@@ -0,0 +1,62 @@
+#include <cstdint>
+#include <cstring>
+
+#include "caml/alloc.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
+#include "llvm/DebugInfo/Symbolize/Symbolize.h"
+
+namespace {
+value ocaml_string_of_cpp_string(std::string_view string) {
+  return caml_alloc_initialized_string(string.length(), string.data());
+}
+} // namespace
+
+extern "C" {
+CAMLprim llvm::symbolize::LLVMSymbolizer *__attribute__((used, retain))
+magic_trace_llvm_symbolizer_create() {
+  llvm::symbolize::LLVMSymbolizer::Options options{};
+  // We need this for now to work around the fact the OCaml compiler inverts
+  // `DW_AT_name` and `DW_AT_linkage_name`, which breaks LLVM's assumptions when
+  // it tries to use the symbol table.
+  options.UseSymbolTable = false;
+  return new llvm::symbolize::LLVMSymbolizer(options);
+}
+
+CAMLprim void __attribute__((used, retain))
+magic_trace_llvm_symbolizer_destroy(llvm::symbolize::LLVMSymbolizer *symbolizer) {
+  delete symbolizer;
+}
+
+CAMLprim value __attribute__((used, retain))
+magic_trace_llvm_symbolize_address(llvm::symbolize::LLVMSymbolizer *symbolizer,
+                                   value v_executable_file, uintptr_t address) {
+  CAMLparam1(v_executable_file);
+  CAMLlocal2(inlined_frames, demangled_name);
+  std::string_view executable_file{String_val(v_executable_file),
+                                   caml_string_length(v_executable_file)};
+  llvm::object::SectionedAddress sectioned_address{
+      address, llvm::object::SectionedAddress::UndefSection};
+  auto result = symbolizer->symbolizeInlinedCode(executable_file, sectioned_address);
+  if (auto _ = result.takeError()) {
+    CAMLreturn((value)NULL);
+  }
+  const auto &frames = result.get();
+  const uint32_t num_frames = frames.getNumberOfFrames();
+  if (num_frames == 0) {
+    CAMLreturn((value)NULL);
+  }
+  if (num_frames <= Max_young_wosize) [[likely]] {
+    inlined_frames = caml_alloc_small(/*wosize=*/num_frames, /*tag=*/0);
+  } else {
+    inlined_frames = caml_alloc_shr(/*wosize=*/num_frames, /*tag=*/0);
+  }
+  memset((uint8_t *)inlined_frames, 0xFF, Bsize_wsize(num_frames));
+  for (uint32_t i = 0; i < num_frames; i++) {
+    const auto &frame = frames.getFrame(i);
+    demangled_name = ocaml_string_of_cpp_string(frame.FunctionName);
+    caml_modify(&Field(inlined_frames, num_frames - 1 - i), demangled_name);
+  }
+  CAMLreturn(inlined_frames);
+}
+}

src/new_trace_writer.ml

@@ -1,7 +1,7 @@
 open! Core
+module Nonempty_vec = Nonempty_vec.Valuex2
 
 let debug = ref false
-let is_kernel_address addr = Int64.(addr < 0L)
 
 (* Time spans from perf start whenever the machine booted. Perfetto uses floats to represent time
    spans, which struggles with large spans when we care about small differences in them. To
@@ -32,61 +32,6 @@ end = struct
   include Comparable.Make (T)
 end
 
-module Pending_event = struct
-  module Kind = struct
-    type t =
-      | Call of
-          { addr : Int64.Hex.t
-          ; offset : Int.Hex.t
-          ; from_untraced : bool
-          }
-      | Ret
-      | Ret_from_untraced of { reset_time : Mapped_time.t }
-    [@@deriving sexp]
-  end
-
-  type t =
-    { symbol : Symbol.t
-    ; kind : Kind.t
-    }
-  [@@deriving sexp]
-
-  let create_call location ~from_untraced =
-    let { Event.Location.instruction_pointer; symbol; symbol_offset } = location in
-    { symbol
-    ; kind = Call { addr = instruction_pointer; offset = symbol_offset; from_untraced }
-    }
-  ;;
-end
-
-module Callstack = struct
-  type t =
-    { stack : Event.Location.t Stack.t
-    ; mutable create_time : Mapped_time.t
-    }
-  [@@deriving sexp, bin_io]
-
-  let create ~create_time = { stack = Stack.create (); create_time }
-  let push t v = Stack.push t.stack v
-  let pop t = Stack.pop t.stack
-  let top t = Stack.top t.stack
-  let is_empty t = Stack.is_empty t.stack
-  let depth t = Stack.length t.stack
-
-  let how_many_match { stack; create_time = _ } (future_callstack : Event.Location.t list)
-    =
-    let zipped_stacks, _ =
-      List.zip_with_remainder (Stack.to_list stack |> List.rev) future_callstack
-    in
-    let ans =
-      List.take_while zipped_stacks ~f:(fun (current_location, future_location) ->
-        Int64.(current_location.instruction_pointer = future_location.instruction_pointer))
-      |> List.length
-    in
-    ans
-  ;;
-end
-
 module Event_and_callstack = struct
   type t =
     { event : Event.t
@@ -96,40 +41,39 @@ module Event_and_callstack = struct
 end
 
 module Thread_info = struct
-  type ocaml_exception_state =
-    | Without_exception_info of { frames_to_unwind : int ref }
-    | With_exception_info of
-        { ocaml_exception_info : (Ocaml_exception_info.t[@sexp.opaque])
-        ; last_known_instruction_pointer : int64 option ref
-        }
-  [@@deriving sexp_of]
-
   type 'thread t =
     { thread : ('thread[@sexp.opaque])
-    ; (* This isn't a canonical callstack, but represents all of the information that we
-         know about the callstack at the point in the events up to the current event being
-         processed, and is reflected in the trace at that point. *)
-      mutable callstack : Callstack.t
-    ; inactive_callstacks : Callstack.t Stack.t
     ; mutable last_decode_error_time : Mapped_time.t
-    ; ocaml_exception_state : ocaml_exception_state
-    ; mutable pending_events : Pending_event.t list
-    ; mutable pending_time : Mapped_time.t
-    ; start_events : (Mapped_time.t * Pending_event.t) Deque.t
+    ; ocaml_exception_info : (Ocaml_exception_info.t[@sexp.opaque]) option
         (* When the last event arrived. Used to give timestamps to events lacking them. *)
     ; mutable last_event_time : Mapped_time.t
     ; track_group_id : int
     ; extra_event_tracks : ('thread[@sexp.opaque]) Hashtbl.M(Collection_mode.Event.Name).t
+    ; trace_segments :
+        (#(Trace_segment.t * in_filtered_region:bool) Nonempty_vec.t[@sexp.opaque])
     }
   [@@deriving sexp_of]
 
-  let set_callstack t ~is_kernel_address ~time =
-    let create_time = if is_kernel_address then time else t.last_decode_error_time in
-    t.callstack <- Callstack.create ~create_time
+  let add_event_to_trace_segment t event_data time =
+    let #(trace_segment, ~in_filtered_region:_) = Nonempty_vec.last t.trace_segments in
+    Trace_segment.add_event trace_segment event_data (Timestamp.create time)
   ;;
 
-  let set_callstack_from_addr t ~addr ~time =
-    set_callstack t ~is_kernel_address:(is_kernel_address addr) ~time
+  module New_trace_segment_kind = struct
+    type t =
+      | Independent
+      | Continuing_from_current
+  end
+
+  let start_new_trace_segment t ~in_filtered_region ~(kind : New_trace_segment_kind.t) =
+    let new_trace_segment =
+      match kind with
+      | Independent -> Trace_segment.create t.ocaml_exception_info
+      | Continuing_from_current ->
+        let #(current, ~in_filtered_region:_) = Nonempty_vec.last t.trace_segments in
+        Trace_segment.create_continuing_from current
+    in
+    Nonempty_vec.push_back t.trace_segments #(new_trace_segment, ~in_filtered_region)
   ;;
 end
 
@@ -144,7 +88,6 @@ type 'thread inner =
   ; trace : (module Trace with type thread = 'thread)
   ; annotate_inferred_start_times : bool
   ; mutable in_filtered_region : bool
-  ; suppressed_errors : Hash_set.M(Source_code_position).t
   ; mutable transaction_events : Event.With_write_info.t Deque.t
   }
 
@@ -156,13 +99,6 @@ let sexp_of_inner inner =
 
 let sexp_of_t (T inner) = sexp_of_inner inner
 
-let eprint_s_once t here sexp =
-  if not (Hash_set.mem t.suppressed_errors here)
-  then (
-    Hash_set.add t.suppressed_errors here;
-    eprint_s sexp)
-;;
-
 let allocate_pid (type thread) (t : thread inner) ~name : int =
   let module T = (val t.trace) in
   T.allocate_pid ~name
@@ -173,34 +109,6 @@ let allocate_thread (type thread) (t : thread inner) ~pid ~name : thread =
   T.allocate_thread ~pid ~name
 ;;
 
-let write_duration_begin
-  (type thread)
-  (t : thread inner)
-  ~args
-  ~thread
-  ~name
-  ~(time : Mapped_time.t)
-  : unit
-  =
-  let module T = (val t.trace) in
-  if t.in_filtered_region
-  then T.write_duration_begin ~args ~thread ~name ~time:(time :> Time_ns.Span.t)
-;;
-
-let write_duration_end
-  (type thread)
-  (t : thread inner)
-  ~args
-  ~thread
-  ~name
-  ~(time : Mapped_time.t)
-  : unit
-  =
-  let module T = (val t.trace) in
-  if t.in_filtered_region
-  then T.write_duration_end ~args ~thread ~name ~time:(time :> Time_ns.Span.t)
-;;
-
 let write_duration_complete
   (type thread)
   (t : thread inner)
@@ -321,7 +229,6 @@ let create_expert
       ; trace
       ; annotate_inferred_start_times
       ; in_filtered_region = true
-      ; suppressed_errors = Hash_set.create (module Source_code_position)
       ; transaction_events = Deque.create ()
       }
   in
@@ -348,124 +255,6 @@ let create
     (Real_trace.create trace)
 ;;
 
-let write_pending_event'
-  (type thread)
-  (t : thread inner)
-  (thread : thread Thread_info.t)
-  time
-  { Pending_event.symbol; kind }
-  =
-  let display_name = Symbol.display_name symbol in
-  match kind with
-  | Call { addr; offset; from_untraced } ->
-    (* Adding a call is always the result of seeing something new on the top of the
-       stack, so the base address is just the current base address. *)
-    let base_address = Int64.(addr - of_int offset) in
-    let open Tracing.Trace.Arg in
-    let symbol_args =
-      (* Using [Interned] may cause some issues with the 32k interned string limit, on
-         sufficiently large programs if the trace goes through a lot of different code,
-         but that'll also be a problem with the span names. This will just make it
-         happen around twice as fast. It does make the traces noticeably smaller.
-
-         The real solution is to get around to improving the interning table management
-         in the trace writer library.
-
-         ---
-
-         [base_address] might be lie in the kernel, in which case [to_int] will fail (but
-         that's alright, because we wouldn't have a symbol for it in the executable's
-         [debug_info] anyway). *)
-      let address = [ "address", Pointer addr ] in
-      match symbol with
-      | From_perf_map { start_addr = _; size = _; function_ = _ } ->
-        address @ [ "symbol", Interned display_name ]
-      | _ ->
-        (match Option.bind (Int64.to_int base_address) ~f:(Hashtbl.find t.debug_info) with
-         | None -> address @ [ "symbol", Interned display_name ]
-         | Some (info : Elf.Location.t) ->
-           address
-           @ [ "line", Int info.line
-             ; "col", Int info.col
-             ; "symbol", Interned display_name
-             ]
-           @
-             (match info.filename with
-             | Some x -> [ "file", Interned x ]
-             | None -> []))
-    in
-    let inferred_start_time_arg =
-      if from_untraced then [ "inferred_start_time", Interned "true" ] else []
-    in
-    let args = symbol_args @ inferred_start_time_arg in
-    let name =
-      if t.annotate_inferred_start_times && from_untraced
-      then display_name ^ " [inferred start time]"
-      else display_name
-    in
-    write_duration_begin t ~thread:thread.thread ~name ~time ~args
-  | Ret -> write_duration_end t ~name:display_name ~time ~thread:thread.thread ~args:[]
-  | Ret_from_untraced { reset_time } ->
-    write_duration_complete
-      t
-      ~time:reset_time
-      ~time_end:time
-      ~name:(Symbol.display_name Unknown)
-      ~thread:thread.thread
-      ~args:[]
-;;
-
-(* It would be reasonable to also have returns consume time, but making them not
-   consume time substantially reduces the frequency where we need to use zero-duration
-   events. In general the traces are easier to read if returns aren't counted as consuming
-   time. *)
-let consumes_time { Pending_event.symbol = _; kind } =
-  match kind with
-  | Call _ -> true
-  | Ret | Ret_from_untraced _ -> false
-;;
-
-let write_pending_event
-  (t : _ inner)
-  (thread : _ Thread_info.t)
-  time
-  (ev : Pending_event.t)
-  =
-  match ev.kind with
-  | Ret_from_untraced _ | Call { from_untraced = true; _ } ->
-    Deque.enqueue_front thread.start_events (time, ev)
-  | Call _ when Mapped_time.is_base_time time ->
-    Deque.enqueue_back thread.start_events (time, ev)
-  | _ -> write_pending_event' t thread time ev
-;;
-
-let flush (t : _ inner) ~to_time (thread : _ Thread_info.t) =
-  (* Try to evenly distribute the time between timestamp updates between all the
-     time-consuming events in the batch. *)
-  let count = List.count thread.pending_events ~f:consumes_time in
-  let total_ns = Mapped_time.diff to_time thread.pending_time |> Time_ns.Span.to_int_ns in
-  let ns_offset = ref 0 in
-  let shares_consumed = ref 0 in
-  List.iter (List.rev thread.pending_events) ~f:(fun ev ->
-    let ns_share =
-      if consumes_time ev
-      then (
-        incr shares_consumed;
-        (total_ns - !ns_offset) / (count - !shares_consumed + 1))
-      else 0
-    in
-    let time = Mapped_time.add thread.pending_time (Time_ns.Span.of_int_ns !ns_offset) in
-    ns_offset := !ns_offset + ns_share;
-    write_pending_event t thread time ev);
-  thread.pending_time <- to_time;
-  thread.pending_events <- []
-;;
-
-let add_event (t : _ inner) (thread : _ Thread_info.t) time ev =
-  if Mapped_time.( <> ) time thread.pending_time then flush t ~to_time:time thread;
-  thread.pending_events <- ev :: thread.pending_events
-;;
-
 let opt_pid_to_string opt_pid =
   match opt_pid with
   | None -> "?"
@@ -540,422 +329,76 @@ let create_thread t event =
   let track_group_id = allocate_pid t ~name in
   let thread = allocate_thread t ~pid:track_group_id ~name:"main" in
   { Thread_info.thread
-  ; callstack = Callstack.create ~create_time:effective_time
-  ; inactive_callstacks = Stack.create ()
   ; last_decode_error_time = effective_time
-  ; ocaml_exception_state =
-      (match t.ocaml_exception_info with
-       | None -> Without_exception_info { frames_to_unwind = ref 0 }
-       | Some ocaml_exception_info ->
-         With_exception_info
-           { ocaml_exception_info; last_known_instruction_pointer = ref None })
-  ; pending_events = []
-  ; pending_time = Mapped_time.start_of_trace
-  ; start_events = Deque.create ()
+  ; ocaml_exception_info = t.ocaml_exception_info
   ; last_event_time = effective_time
   ; track_group_id
   ; extra_event_tracks = Hashtbl.create (module Collection_mode.Event.Name)
+  ; trace_segments =
+      Nonempty_vec.create
+        #( Trace_segment.create t.ocaml_exception_info
+         , ~in_filtered_region:t.in_filtered_region )
   }
 ;;
 
-let call t thread_info ~time ~location =
-  let ev = Pending_event.create_call location ~from_untraced:false in
-  add_event t thread_info time ev;
-  Callstack.push thread_info.callstack location
+let end_of_thread _ (thread_info : _ Thread_info.t) ~time : unit =
+  thread_info.last_decode_error_time <- time
 ;;
 
-let ret_without_checking_for_go_hacks t (thread_info : _ Thread_info.t) ~time =
-  match Callstack.pop thread_info.callstack with
-  | Some { symbol; _ } -> add_event t thread_info time { symbol; kind = Ret }
-  | None ->
-    (* No known stackframe was popped --- could occur if the start of the snapshot
-       started in the middle of a tracing region *)
-    add_event
-      t
-      thread_info
-      time
-      { symbol = From_perf "[unknown]"
-      ; kind = Ret_from_untraced { reset_time = thread_info.callstack.create_time }
-      }
-;;
-
-let rec clear_callstack t (thread_info : _ Thread_info.t) ~time =
-  let ret = ret_without_checking_for_go_hacks in
-  match Callstack.top thread_info.callstack with
-  | None -> ()
-  | Some _ ->
-    ret t thread_info ~time;
-    clear_callstack t thread_info ~time
-;;
-
-(* Unlike [clear_callstack], [clear_all_callstacks] also returns from all inactive
-   callstacks. *)
-let rec clear_all_callstacks t thread_info ~time =
-  clear_callstack t thread_info ~time;
-  match Stack.pop thread_info.inactive_callstacks with
-  | None -> ()
-  | Some callstack ->
-    thread_info.callstack <- callstack;
-    clear_all_callstacks t thread_info ~time
-;;
-
-let end_of_thread t (thread_info : _ Thread_info.t) ~time ~is_kernel_address : unit =
-  let to_time = thread_info.pending_time in
-  Deque.iter' thread_info.start_events `front_to_back ~f:(fun (time, ev) ->
-    write_pending_event' t thread_info time ev);
-  Deque.clear thread_info.start_events;
-  clear_all_callstacks t thread_info ~time;
-  flush t ~to_time thread_info;
-  thread_info.last_decode_error_time <- time;
-  Thread_info.set_callstack thread_info ~is_kernel_address ~time
-;;
-
-(* Go (the programming language) has coroutines known as goroutines. The function [gogo] jumps
-   from one goroutine to the next. Since [gogo] can jump anywhere, it's a shining example of what
-   magic-trace can't handle out of the box. So, we hack it.
-
-   Most of the time, control flow returns parallel to (i.e. as if jumped from) the previous caller
-   of [runtime.mcall] or [runtime.morestack.abi0].
-
-   At startup (and maybe other situations?), gogo clears all callstacks and executes [main]. *)
-module Go_hacks : sig
-  val ret_track_gogo
-    :  'a inner
-    -> 'a Thread_info.t
-    -> time:Mapped_time.t
-    -> returned_from:Symbol.t option
-    -> unit
-end = struct
-  let is_gogo (symbol : Symbol.t) =
-    match symbol with
-    | From_perf "gogo" -> true
-    | _ -> false
-  ;;
-
-  let is_known_gogo_destination (location : Event.Location.t) =
-    match location with
-    | { symbol = From_perf ("runtime.mcall" | "runtime.morestack.abi0"); _ } -> true
-    | _ -> false
-  ;;
-
-  let current_stack_contains_known_gogo_destination (thread_info : _ Thread_info.t) =
-    Stack.find thread_info.callstack.stack ~f:(fun location ->
-      is_known_gogo_destination location)
-    |> Option.is_some
-  ;;
-
-  let rec pop_until_gogo_destination t (thread_info : _ Thread_info.t) ~time =
-    let ret = ret_without_checking_for_go_hacks in
-    match Callstack.top thread_info.callstack with
-    | None -> ()
-    | Some location ->
-      ret t thread_info ~time;
-      (* Return one past the known gogo destination. This hack is necessary because:
-
-         - all gogo-destination functions are jumped into and out of
-         - magic-trace translates the jump returning from gogo-destination into a ret/call pair
-         - this runs on the ret, but the call is to gogo-destination's caller and we don't
-           want a second stack frame for that.
-
-         This is a little janky because you see a stack frame momentarily end then start back
-         up again on every [gogo]. I think that's a small price to pay to keep all the Go hacks
-         in one place. *)
-      if is_known_gogo_destination location
-      then ret t thread_info ~time
-      else pop_until_gogo_destination t thread_info ~time
-  ;;
-
-  let ret_track_gogo t thread_info ~time ~returned_from =
-    let is_ret_from_gogo = Option.value_map ~f:is_gogo returned_from ~default:false in
-    if is_ret_from_gogo
-    then
-      if current_stack_contains_known_gogo_destination thread_info
-      then pop_until_gogo_destination t thread_info ~time
-      else end_of_thread t thread_info ~time ~is_kernel_address:false
-  ;;
-end
-
-let ret t (thread_info : _ Thread_info.t) ~time : unit =
-  let returned_from =
-    Callstack.top thread_info.callstack |> Option.map ~f:Event.Location.symbol
-  in
-  ret_without_checking_for_go_hacks t thread_info ~time;
-  Go_hacks.ret_track_gogo t thread_info ~time ~returned_from
-;;
-
-let check_current_symbol
-  t
-  (thread_info : _ Thread_info.t)
-  ~time
-  (location : Event.Location.t)
-  =
-  (* After every operation, we should be in a situation where the current symbol under
-     the pc matches the symbol at the top of the callstack. This can go out-of-sync
-     with jumps between functions (e.g. tailcalls, PLT) or returns out of the highest
-     known function, so we have to correct the top of the stack here. *)
-  match Callstack.top thread_info.callstack with
-  | Some { symbol; _ } when not ([%compare.equal: Symbol.t] symbol location.symbol) ->
-    ret t thread_info ~time;
-    call t thread_info ~time ~location
-  | Some _ -> ()
-  | None ->
-    (* If we have no callstack left, then we just returned out of something we didn't
-       see the call for. Since we're in snapshot mode, this happens with functions
-       called before the perf events started, so add in a call that begins at the
-       start of the trace for that pid.
-
-       These shouldn't be buffered for spreading since we want them exactly at the reset
-       time. *)
-    let ev = Pending_event.create_call location ~from_untraced:true in
-    write_pending_event t thread_info thread_info.callstack.create_time ev;
-    Callstack.push thread_info.callstack location
-;;
-
-(* OCaml-specific hacks around tracking exception control flow. Supports two
-   modes.
-
-   With exception info provided by the compiler: read
-   [core/ocaml_exception_info.mli] for details.
-
-   Without exception info provided by the compiler: the way this works is that
-   it counts the number of [caml_next_frame_descriptor] calls while an
-   exception is unwinding, and knows to unwind the stack that many times (+/- a
-   constant) when the next [caml_raise_exn] or [caml_raise_exception] return.
-
-   This mode fails to account for [raise_notrace] exceptions. *)
-
-module Ocaml_hacks : sig
-  val ret_track_exn_data : 'a inner -> 'a Thread_info.t -> time:Mapped_time.t -> unit
-
-  val track_executed_pushtraps_and_poptraps_in_range
-    :  'a inner
-    -> 'a Thread_info.t
-    -> src:Event.Location.t
-    -> dst:Event.Location.t
-    -> time:Mapped_time.t
-    -> unit
-
-  val check_current_symbol_track_entertraps
-    :  'a inner
-    -> 'a Thread_info.t
-    -> time:Mapped_time.t
-    -> Event.Location.t
-    -> unit
-end = struct
-  (* It's ocaml, not go. *)
-  let ret = ret_without_checking_for_go_hacks
-
-  let unwind_stack t (thread_info : _ Thread_info.t) ~time ~frames_to_unwind diff =
-    for _ = 0 to !frames_to_unwind + diff do
-      ret t thread_info ~time
-    done;
-    frames_to_unwind := 0
-  ;;
-
-  let ret_track_exn_data t thread_info ~time =
-    let { Thread_info.callstack; ocaml_exception_state; _ } = thread_info in
-    (match ocaml_exception_state with
-     | With_exception_info _ -> ()
-     | Without_exception_info { frames_to_unwind } ->
-       (match Callstack.top callstack with
-        | Some { symbol = From_perf symbol; _ } ->
-          (match symbol with
-           | "caml_next_frame_descriptor" -> incr frames_to_unwind
-           | "caml_raise_exn" -> unwind_stack t thread_info ~time ~frames_to_unwind (-2)
-           | "caml_stash_backtrace" -> incr frames_to_unwind
-           | "caml_raise_exception" ->
-             unwind_stack t thread_info ~time ~frames_to_unwind 1
-           | _ -> ())
-        | _ -> ()));
-    ret t thread_info ~time
-  ;;
-
-  let clear_trap_stack t thread_info ~time =
-    clear_callstack t thread_info ~time;
-    match Stack.pop thread_info.inactive_callstacks with
-    | Some callstack -> thread_info.callstack <- callstack
-    | None -> thread_info.callstack <- Callstack.create ~create_time:time
-  ;;
-
-  let check_current_symbol_track_entertraps
-    t
-    (thread_info : 'a Thread_info.t)
-    ~time
-    (dst : Event.Location.t)
-    =
-    match thread_info.ocaml_exception_state with
-    | With_exception_info { ocaml_exception_info; _ }
-      when Ocaml_exception_info.is_entertrap
-             ocaml_exception_info
-             ~addr:dst.instruction_pointer ->
-      (* CR-someday tbrindus: unwind this hack. This recreates the callstack but with the
-         first (synthetic) frame missing. A more principled approach would be the one
-         outlined in another CR-someday below, where we teach [Callstack] about traps
-         directly. *)
-      let s = thread_info.callstack.stack |> Stack.to_list in
-      let s = List.take s (List.length s - 1) in
-      Stack.clear thread_info.callstack.stack;
-      List.iter (List.rev s) ~f:(fun x -> Stack.push thread_info.callstack.stack x);
-      clear_trap_stack t thread_info ~time
-    | _ -> check_current_symbol t thread_info ~time dst
-  ;;
-
-  let track_executed_pushtraps_and_poptraps_in_range
-    t
-    (thread_info : _ Thread_info.t)
-    ~(src : Event.Location.t)
-    ~(dst : Event.Location.t)
-    ~time
-    =
-    match thread_info.ocaml_exception_state with
-    | Without_exception_info _ -> ()
-    | With_exception_info { ocaml_exception_info; last_known_instruction_pointer } ->
-      (match !last_known_instruction_pointer with
-       | None -> ()
-       | Some last_known_instruction_pointer ->
-         Ocaml_exception_info.iter_pushtraps_and_poptraps_in_range
-           ocaml_exception_info
-           ~from:last_known_instruction_pointer
-           ~to_:src.instruction_pointer
-           ~f:(fun (_addr, kind) ->
-             match kind with
-             | Pushtrap ->
-               (* CR-someday tbrindus: maybe we should have [Callstack.t] know about the
-                  concept of trap handlers, and have e.g. [Callstack.{pushtrap,poptrap}]
-                  insert markers into an auxiliary data structure.
-
-                  Then we could have operations like "close all frames until the last
-                  trap", and enforce invariants like "you can't [ret] past a trap without
-                  calling [poptrap] first" there rather than here. *)
-               (* Push a synthetic frame equal to the top of the existing stack, to avoid
-                  erroneously inferring frames that shouldn't exist when execution happens
-                  within a [try ... with] block that doesn't involve calls (and thus
-                  generation of new frames). *)
-               let top = Callstack.top thread_info.callstack |> Option.value_exn in
-               Stack.push thread_info.inactive_callstacks thread_info.callstack;
-               thread_info.callstack <- Callstack.create ~create_time:time;
-               Callstack.push thread_info.callstack top
-             | Poptrap ->
-               (* Assuming we didn't drop anything, we should only have the synthetic
-                  frame we created at this point. If we have more than that, we either got
-                  confused in our state tracking somewhere, or more likely, IPT dropped
-                  some data. *)
-               if Callstack.depth thread_info.callstack <> 1
-               then
-                 (* Conditional on happening once, this is likely to happen again... don't
-                    spam the user's terminal. *)
-                 eprint_s_once
-                   t
-                   [%here]
-                   [%message
-                     "WARNING: expected callstack depth to be the same going into a \
-                      [try] block as when leaving it, but it wasn't. Did Intel Processor \
-                      Trace drop some data? Will attempt to recover. Further errors will \
-                      be suppressed.\n"
-                       ~depth:(Callstack.depth thread_info.callstack - 1 : int)
-                       (src : Event.Location.t)
-                       (dst : Event.Location.t)
-                       (last_known_instruction_pointer : Int64.Hex.t)]
-               else (
-                 (* Only pop the exception callstack if we're at the same callstack
-                    depth as we were when we saw [Pushtrap]. This should let us recover
-                    from situations like:
-
-                    - Pushtrap 1
-                    - Pushtrap 2
-                    - Poptrap 2
-                    - Poptrap 1
-
-                    where "Pushtrap 2" gets dropped. *)
-                 ignore (Callstack.pop thread_info.callstack : _);
-                 clear_trap_stack t thread_info ~time)));
-      last_known_instruction_pointer := Some dst.instruction_pointer
-  ;;
-end
-
-let assert_trace_scope t event trace_scopes =
-  if List.find trace_scopes ~f:(Trace_scope.equal t.trace_scope) |> Option.is_none
-  then
-    (* CR-someday cgaebel: Should this raise? *)
-    eprint_s
-      [%message
-        "BUG: assumptions violated, saw an unexpected event for this trace mode"
-          ~trace_scope:(t.trace_scope : Trace_scope.t)
-          (event : Event.t)]
+let write_trace_segments (type thread) (t : thread inner) =
+  Hashtbl.iter t.thread_info ~f:(fun thread_info ->
+    Nonempty_vec.iter
+      thread_info.trace_segments
+      ~f:(fun #(trace_segment, ~in_filtered_region) ->
+        if in_filtered_region
+        then Trace_segment.write_trace trace_segment t.trace thread_info.thread))
 ;;
 
 let end_of_trace ?to_time (T t) =
   (* CR-someday cgaebel: I wish this iteration had a defined order; it'd make magic-trace
      a little bit more deterministic. *)
   Hashtbl.iter t.thread_info ~f:(fun thread_info ->
-    end_of_thread t thread_info ~time:thread_info.last_event_time ~is_kernel_address:false;
+    end_of_thread t thread_info ~time:thread_info.last_event_time;
     match to_time with
     | Some time ->
       let mapped_time = map_time t time in
-      thread_info.pending_time <- mapped_time;
-      thread_info.last_event_time <- mapped_time;
-      thread_info.callstack.create_time <- mapped_time
+      thread_info.last_event_time <- mapped_time
     | None -> ())
 ;;
 
-let rewrite_callstack t ~(callstack : Callstack.t) ~thread_info ~time =
-  let called_locations = callstack.stack |> Stack.to_list |> List.rev in
-  List.iter called_locations ~f:(fun location ->
-    write_pending_event'
-      t
-      thread_info
-      time
-      (Pending_event.create_call location ~from_untraced:true)
-    (* Not necessarily true, but setting [~from_untraced:true] causes the timestamp to be annotated as inferred *));
-  callstack.create_time
-  <- Mapped_time.add
-       time
-       (Time_ns.Span.of_ns
-          (-1.)
-          (* Set the reset time of future untraced returns to before the rewritten callstack *))
+let finalize t =
+  end_of_trace t;
+  let (T t) = t in
+  write_trace_segments t
 ;;
 
-let rewrite_all_callstacks t ~(thread_info : _ Thread_info.t) ~time =
-  let inactive_callstacks =
-    thread_info.inactive_callstacks |> Stack.to_list |> List.rev
-  in
-  List.iter inactive_callstacks ~f:(fun callstack ->
-    rewrite_callstack t ~callstack ~thread_info ~time);
-  rewrite_callstack t ~callstack:thread_info.callstack ~thread_info ~time
-;;
-
-let maybe_start_filtered_region t ~should_write ~time =
+let maybe_start_filtered_region t ~should_write ~time:_ =
   if (not t.in_filtered_region) && should_write
   then (
     Hashtbl.iter t.thread_info ~f:(fun thread_info ->
-      flush t ~to_time:time thread_info;
-      Deque.clear thread_info.start_events);
-    t.in_filtered_region <- true;
-    Hashtbl.iter t.thread_info ~f:(fun thread_info ->
-      rewrite_all_callstacks t ~thread_info ~time))
+      Thread_info.start_new_trace_segment
+        thread_info
+        ~in_filtered_region:true
+        ~kind:Continuing_from_current);
+    t.in_filtered_region <- true)
 ;;
 
 let maybe_stop_filtered_region t ~should_write =
   if t.in_filtered_region && not should_write
   then (
     end_of_trace (T t);
-    t.in_filtered_region <- false)
+    t.in_filtered_region <- false;
+    Hashtbl.iter t.thread_info ~f:(fun thread_info ->
+      Thread_info.start_new_trace_segment
+        thread_info
+        ~in_filtered_region:false
+        ~kind:Continuing_from_current))
 ;;
 
-let write_event_and_callstack
-  (events_writer : Tracing_tool_output.events_writer)
-  event
-  callstack
-  =
-  let compression_event =
-    Callstack_compression.compress_callstack
-      events_writer.callstack_compression_state
-      (Callstack.(callstack.stack)
-       |> Stack.to_list
-       |> List.map ~f:(fun Event.Location.{ symbol; _ } -> symbol))
-  in
+let write_event_and_callstack (events_writer : Tracing_tool_output.events_writer) event =
   let event_and_callstack =
-    Event_and_callstack.{ event; callstack = compression_event }
+    (* TODO Actually populate [callstack] *)
+    Event_and_callstack.{ event; callstack = { new_symbols = []; callstack = [] } }
   in
   match events_writer.format with
   | Sexp ->
@@ -970,7 +413,23 @@ let write_event_and_callstack
       event_and_callstack
 ;;
 
+let print_error_disclaimer_once =
+  lazy
+    (let #(color_start, color_end) =
+       if Core_unix.isatty Core_unix.stderr then #("\x1b[31m", "\x1b[0m") else #("", "")
+     in
+     eprintf
+       {|%s
+WARNING: You are using the new trace-writer, which currently HAS NO ERROR RECOVERY.
+An error has just been encountered. YOUR TRACE IS LIKELY TO BE HORRIFICALLY BROKEN.
+%s%!
+|}
+       color_start
+       color_end)
+;;
+
 let warn_decode_error ~instruction_pointer ~message =
+  force print_error_disclaimer_once;
   eprintf
     "Warning: perf reported an error decoding the trace: %s\n%!"
     (match instruction_pointer with
@@ -1037,18 +496,20 @@ and write_event' (T t) ?events_writer event =
     warn_decode_error ~instruction_pointer ~message;
     let name = sprintf !"[decode error: %s]" message in
     write_duration_instant t ~thread ~name ~time ~args:[];
-    let is_kernel_address =
-      match instruction_pointer with
-      | None -> false
-      | Some ip -> is_kernel_address ip
-    in
-    end_of_thread t thread_info ~time ~is_kernel_address
+    end_of_thread t thread_info ~time;
+    Thread_info.start_new_trace_segment
+      thread_info
+      ~in_filtered_region:t.in_filtered_region
+      ~kind:Independent
   | Ok event_value ->
     if should_write
     then
       Option.iter events_writer ~f:(fun events_writer ->
-        write_event_and_callstack events_writer event thread_info.callstack);
+        write_event_and_callstack events_writer event);
     (match event_value with
+     | { Event.Ok.thread = _; time = _; data = Trace _ as data; in_transaction = _ } ->
+       (* TODO Re-add the assertion from the old trace-writer on impossible [kind, trace_state_change] combinations *)
+       Thread_info.add_event_to_trace_segment thread_info data (time :> Time_ns.Span.t)
      | { Event.Ok.thread = _
        ; time = _
        ; data = Event_sample { location; count; name }
@@ -1094,140 +555,7 @@ and write_event' (T t) ?events_writer event =
          ~name:"CPU"
          ~time
          ~args:Tracing.Trace.Arg.[ "freq (MHz)", Int freq ]
-     | { Event.Ok.thread = _ (* Already used this to look up thread info. *)
-       ; time = _ (* Already in scope. Also, this time hasn't been [map_time]'d. *)
-       ; data = Stacktrace_sample { callstack }
-       ; in_transaction = _
-       } ->
-       let how_many_ret =
-         Stack.length thread_info.callstack.stack
-         - Callstack.how_many_match thread_info.callstack callstack
-       in
-       List.init how_many_ret ~f:Fn.id |> List.iter ~f:(fun _ -> ret t thread_info ~time);
-       let calls = List.drop callstack (Stack.length thread_info.callstack.stack) in
-       List.iter calls ~f:(fun location -> call t thread_info ~time ~location)
-     | { Event.Ok.thread = _ (* Already used this to look up thread info. *)
-       ; time = _ (* Already in scope. Also, this time hasn't been [map_time]'d. *)
-       ; data = Trace { kind; trace_state_change; src; dst }
-       ; in_transaction = _
-       } ->
-       Ocaml_hacks.track_executed_pushtraps_and_poptraps_in_range
-         t
-         thread_info
-         ~src
-         ~dst
-         ~time;
-       (match kind, trace_state_change with
-        | Some Call, (None | Some End) -> call t thread_info ~time ~location:dst
-        | ( Some
-              ( Async
-              | Call
-              | Syscall
-              | Return
-              | Hardware_interrupt
-              | Iret
-              | Interrupt
-              | Sysret
-              | Jump
-              | Tx_abort )
-          , Some Start )
-        | Some Async, None
-        | Some (Hardware_interrupt | Jump | Interrupt | Tx_abort), Some End ->
-          raise_s
-            [%message
-              "BUG: magic-trace devs thought this event was impossible, but you just \
-               proved them wrong. Please report this to \
-               https://github.com/janestreet/magic-trace/issues/"
-                (event : Event.t)]
-        | (None | Some Async), Some End ->
-          call t thread_info ~time ~location:Event.Location.untraced
-        | Some Syscall, Some End ->
-          (* We should only be getting these under /u *)
-          assert_trace_scope t outer_event [ Userspace ];
-          call t thread_info ~time ~location:Event.Location.syscall
-        | Some Return, Some End ->
-          call t thread_info ~time ~location:Event.Location.returned
-        | Some Return, None ->
-          Ocaml_hacks.ret_track_exn_data t thread_info ~time;
-          (* [caml_raise_exn], at least at the time of writing, modifies the stack
-             and then [ret]s when raising. The OCaml compiler's codegen uses indirect
-             [jmp]s instead. *)
-          Ocaml_hacks.check_current_symbol_track_entertraps t thread_info ~time dst
-        | None, Some Start ->
-          (* Might get this under /u, /k, and /uk, but we need to handle them all
-             differently. *)
-          if Trace_scope.equal t.trace_scope Kernel
-          then (
-            (* We're back in the kernel after having been in userspace. We have a
-               brand new stack to work with. [clear_callstack] here should only be
-               clearing the [untraced] frame here pushed by [End (Iret | Sysret)]. *)
-            clear_callstack t thread_info ~time;
-            Thread_info.set_callstack_from_addr
-              thread_info
-              ~addr:dst.instruction_pointer
-              ~time)
-          else if Callstack.is_empty thread_info.callstack
-          then
-            (* View stopping tracing always as a call (typically the result of a call
-               into a special library / linker), with starting tracing again as
-               exiting it. The one exception is the initial start of the trace for
-               that process, when there is no stack and a prior end won't have pushed
-               a synthetic stack frame. *)
-            call t thread_info ~time ~location:dst
-          else
-            (* We don't call [check_current_symbol] here because stops don't change
-               the program location in most cases, and when a call to a symbol page
-               faults, the restart after the page fault at the new location would get
-               treated as a tail call if we did call [check_current_symbol]. *)
-            Ocaml_hacks.ret_track_exn_data t thread_info ~time
-        | Some ((Syscall | Hardware_interrupt) as kind), None ->
-          (* We should only be getting [Syscall] these under /uk, but we can get
-             [Hardware_interrupt] under /uk, /k. *)
-          [ [ Trace_scope.Userspace_and_kernel ]
-          ; (if [%compare.equal: Event.Kind.t] kind Hardware_interrupt
-             then [ Kernel ]
-             else [])
-          ]
-          |> List.concat
-          |> assert_trace_scope t outer_event;
-          (* A syscall or hardware interrupt can be modelled as operating on a new
-             stack, and shouldn't be allowed to modify the previous stack.
-
-             Also, hardware interrupts can occur during syscalls, so we maintain a
-             "stack of callstacks" here. *)
-          Stack.push thread_info.inactive_callstacks thread_info.callstack;
-          Thread_info.set_callstack_from_addr
-            thread_info
-            ~addr:dst.instruction_pointer
-            ~time;
-          call t thread_info ~time ~location:dst
-        | Some (Iret | Sysret), Some End ->
-          (* We should only be getting these under /k *)
-          assert_trace_scope t outer_event [ Kernel ];
-          clear_callstack t thread_info ~time;
-          call t thread_info ~time ~location:Event.Location.untraced
-        | Some ((Iret | Sysret) as kind), None ->
-          (* We should only get [Sysret] under /uk, but might get [Iret] under /k as
-             well (because the kernel can be interrupted). *)
-          [ [ Trace_scope.Userspace_and_kernel ]
-          ; (if [%compare.equal: Event.Kind.t] kind Iret then [ Kernel ] else [])
-          ]
-          |> List.concat
-          |> assert_trace_scope t outer_event;
-          clear_callstack t thread_info ~time;
-          (match Stack.pop thread_info.inactive_callstacks with
-           | Some callstack -> thread_info.callstack <- callstack
-           | None ->
-             Thread_info.set_callstack_from_addr
-               thread_info
-               ~addr:dst.instruction_pointer
-               ~time;
-             check_current_symbol t thread_info ~time dst)
-        | Some Tx_abort, None -> check_current_symbol t thread_info ~time dst
-        | Some (Jump | Interrupt), None ->
-          Ocaml_hacks.check_current_symbol_track_entertraps t thread_info ~time dst
-        (* (None, _) comes up when perf spews something magic-trace doesn't recognize.
-           Instead of crashing, ignore it and keep going. *)
-        | None, _ -> ());
-       if !debug then print_s (sexp_of_inner t))
+     | { Event.Ok.data = Stacktrace_sample _; _ } ->
+       (* This should be unreachable, we currently delegate support for sampling to the old trace-writer. *)
+       assert false)
 ;;

src/new_trace_writer.mli

@@ -0,0 +1,2 @@
+open! Core
+include Trace_writer_implementation_intf.S

src/nonempty_vec.ml

@@ -0,0 +1,32 @@
+open! Core
+
+module%template [@kind k = (value & value, value & value & value)] T = struct
+  type ('a : k) t = ('a Vec.t[@kind k])
+
+  let create x =
+    let t = (Vec.create [@kind k]) () in
+    (Vec.push_back [@kind k]) t x;
+    t
+  ;;
+
+  let unsafe_get = (Vec.unsafe_get [@kind k])
+  let get = (Vec.get [@kind k])
+  let set = (Vec.set [@kind k])
+  let length = (Vec.length [@kind k])
+  let first t = unsafe_get t 0
+  let last t = unsafe_get t (length t - 1)
+  let push_back = (Vec.push_back [@kind k])
+  let iter = (Vec.iter [@kind k])
+
+  let iter_pairs t ~f =
+    let mutable prev = first t in
+    for i = 1 to length t - 1 do
+      let curr = unsafe_get t i in
+      f #(prev, curr);
+      prev <- curr
+    done
+  ;;
+end
+
+module Valuex2 = T [@kind value & value]
+module Valuex3 = T [@kind value & value & value]

src/nonempty_vec.mli

@@ -0,0 +1,19 @@
+open! Core
+
+module type%template [@kind k = (value & value, value & value & value)] S := sig
+  (** A [Vec.t] guaranteed to contain at least one element. *)
+  type ('a : k) t
+
+  val create : 'a -> 'a t
+  val length : _ t -> int
+  val first : 'a t -> 'a
+  val get : 'a t -> int -> 'a
+  val set : 'a t -> int -> 'a -> unit
+  val last : 'a t -> 'a
+  val push_back : 'a t -> 'a -> unit
+  val iter : 'a t -> f:local_ ('a -> unit) -> unit
+  val iter_pairs : 'a t -> f:local_ (#('a * 'a) -> unit) -> unit
+end
+
+module Valuex2 : S [@kind value & value]
+module Valuex3 : S [@kind value & value & value]

src/ocaml_exception_info.mli

@@ -93,6 +93,6 @@ val is_entertrap : t -> addr:int64 -> bool
 val iter_pushtraps_and_poptraps_in_range
   :  from:int64
   -> to_:int64
-  -> f:(int64 * Kind.t -> unit)
+  -> f:local_ (int64 * Kind.t -> unit)
   -> t
   -> unit

src/perf_decode.ml

@@ -21,7 +21,7 @@ let perf_callstack_entry_re = Re.Perl.re "^\t *([0-9a-f]+) (.*)$" |> Re.compile
 
 let perf_branches_event_re =
   Re.Perl.re
-    {|^ *(call|return|tr strt(?: jmp)?|syscall|sysret|hw int|iret|int|tx abrt|tr end|tr strt tr end|tr end  (?:async|call|return|syscall|sysret|iret)|jmp|jcc) +(\(x\) +)?([0-9a-f]+) (.*) => +([0-9a-f]+) (.*)$|}
+    {|^ *(call|return|tr strt(?: jmp)?|syscall|sysret|hw int|iret|int|tx abrt|tr end|tr strt tr end|tr end  (?:async|call|return|syscall|sysret|iret|int)|jmp|jcc) +(\(x\) +)?([0-9a-f]+) (.*) => +([0-9a-f]+) (.*)$|}
   |> Re.compile
 ;;
 
@@ -35,7 +35,10 @@ let trace_error_re =
   |> Re.compile
 ;;
 
-let symbol_and_offset_re = Re.Perl.re {|^(.*)\+(0x[0-9a-f]+)\s+\(.*\)$|} |> Re.compile
+let symbol_and_offset_and_dso_re =
+  Re.Perl.re {|^(.*)\+(0x[0-9a-f]+)\s+\((.*)\)$|} |> Re.compile
+;;
+
 let unknown_symbol_dso_re = Re.Perl.re {|^\[unknown\]\s+\((.*)\)|} |> Re.compile
 
 type header =
@@ -109,9 +112,12 @@ let parse_event_header line =
           "Regex of perf output did not match expected fields" (results : string array)])
 ;;
 
-let parse_symbol_and_offset ?perf_maps pid str ~addr : Symbol.t * int =
-  match Re.Group.all (Re.exec symbol_and_offset_re str) with
-  | [| _; symbol; offset |] ->
+let parse_symbol_and_offset_and_dso ?perf_maps pid str ~addr
+  : #(Symbol.t * int * Interned_string.t or_null)
+  =
+  match Re.Group.all (Re.exec symbol_and_offset_and_dso_re str) with
+  | [| _; symbol; offset; dso |] ->
+    let dso = Interned_string.intern dso in
     let offset =
       (* Sometimes [perf] reports symbols and offsets like
          [memcpy@plt+0xffffffffff22f000], which are definitely wrong (the implied
@@ -124,16 +130,19 @@ let parse_symbol_and_offset ?perf_maps pid str ~addr : Symbol.t * int =
          avoid the extra allocation. *)
       Util.int_trunc_of_hex_string ~remove_hex_prefix:true offset
     in
-    From_perf symbol, offset
+    #(From_perf symbol, offset, This dso)
   | _ | (exception _) ->
-    let failed = Symbol.Unknown, 0 in
+    let failed = #(Symbol.Unknown, 0, Null) in
     (match perf_maps, pid with
      | None, _ | _, None ->
        (match Re.Group.all (Re.exec unknown_symbol_dso_re str) with
         | [| _; dso |] ->
+          let dso = Interned_string.intern dso in
           (* CR-someday tbrindus: ideally, we would subtract the DSO base offset
              from [offset] here. *)
-          From_perf [%string "[unknown @ %{addr#Int64.Hex} (%{dso})]"], 0
+          #( From_perf [%string "[unknown @ %{addr#Int64.Hex} (%{(dso :> string)})]"]
+           , 0
+           , This dso )
         | _ | (exception _) -> failed)
      | Some perf_map, Some pid ->
        (match Perf_map.Table.symbol ~pid perf_map ~addr with
@@ -142,7 +151,7 @@ let parse_symbol_and_offset ?perf_maps pid str ~addr : Symbol.t * int =
           (* It's strange that perf isn't resolving these symbols. It says on the
              tin that it supports perf map files! *)
           let offset = saturating_sub_i64 addr location.start_addr in
-          From_perf_map location, offset))
+          #(From_perf_map location, offset, Null)))
 ;;
 
 let trace_error_to_event line : Event.Decode_error.t =
@@ -182,10 +191,14 @@ let parse_location ?perf_maps ~pid instruction_pointer symbol_and_offset
   : Event.Location.t
   =
   let instruction_pointer = Util.int64_of_hex_string instruction_pointer in
-  let symbol, symbol_offset =
-    parse_symbol_and_offset ?perf_maps pid symbol_and_offset ~addr:instruction_pointer
+  let #(symbol, symbol_offset, dso) =
+    parse_symbol_and_offset_and_dso
+      ?perf_maps
+      pid
+      symbol_and_offset
+      ~addr:instruction_pointer
   in
-  { instruction_pointer; symbol; symbol_offset }
+  { instruction_pointer; symbol; symbol_offset; dso }
 ;;
 
 let parse_callstack_entry ?perf_maps (thread : Event.Thread.t) line : Event.Location.t =
@@ -218,15 +231,15 @@ let parse_perf_branches_event ?perf_maps (thread : Event.Thread.t) time line : E
     |] ->
     let src_instruction_pointer = Util.int64_of_hex_string src_instruction_pointer in
     let dst_instruction_pointer = Util.int64_of_hex_string dst_instruction_pointer in
-    let src_symbol, src_symbol_offset =
-      parse_symbol_and_offset
+    let #(src_symbol, src_symbol_offset, src_dso) =
+      parse_symbol_and_offset_and_dso
         ?perf_maps
         thread.pid
         src_symbol_and_offset
         ~addr:src_instruction_pointer
     in
-    let dst_symbol, dst_symbol_offset =
-      parse_symbol_and_offset
+    let #(dst_symbol, dst_symbol_offset, dst_dso) =
+      parse_symbol_and_offset_and_dso
         ?perf_maps
         thread.pid
         dst_symbol_and_offset
@@ -290,11 +303,13 @@ let parse_perf_branches_event ?perf_maps (thread : Event.Thread.t) time line : E
                 { instruction_pointer = src_instruction_pointer
                 ; symbol = src_symbol
                 ; symbol_offset = src_symbol_offset
+                ; dso = src_dso
                 }
             ; dst =
                 { instruction_pointer = dst_instruction_pointer
                 ; symbol = dst_symbol
                 ; symbol_offset = dst_symbol_offset
+                ; dso = dst_dso
                 }
             }
       ; in_transaction

src/real_trace.ml

@@ -7,8 +7,15 @@ let create (trace : Tracing.Trace.t) =
 
     let allocate_pid = Tracing.Trace.allocate_pid trace
     let allocate_thread = Tracing.Trace.allocate_thread trace
-    let write_duration_begin = Tracing.Trace.write_duration_begin trace ~category:""
-    let write_duration_end = Tracing.Trace.write_duration_end trace ~category:""
+
+    let write_duration_begin ?(category = "") () =
+      Tracing.Trace.write_duration_begin trace ~category
+    ;;
+
+    let write_duration_end ?(category = "") () =
+      Tracing.Trace.write_duration_end trace ~category
+    ;;
+
     let write_duration_complete = Tracing.Trace.write_duration_complete trace ~category:""
     let write_duration_instant = Tracing.Trace.write_duration_instant trace ~category:""
     let write_counter = Tracing.Trace.write_counter trace ~category:""

src/slice.ml

@@ -0,0 +1,36 @@
+open! Core
+
+type ('a : value mod non_float) t =
+  #{ len : int
+   ; pos : int
+   ; data : 'a iarray
+   }
+
+let empty = #{ len = 0; pos = 0; data = [::] }
+
+let create ~pos ~len data =
+  assert (pos >= 0 && len >= 0 && pos + len <= Iarray.length data);
+  #{ len; pos; data }
+;;
+
+let[@inline always] length t = t.#len
+let[@inline always] unsafe_get t i = Iarray.unsafe_get t.#data (t.#pos + i)
+
+let get t i =
+  assert (i >= 0 && i < t.#len);
+  unsafe_get t i
+;;
+
+let iter t ~f =
+  for i = 0 to t.#len - 1 do
+    f (unsafe_get t i)
+  done
+;;
+
+let map_to_list t ~f =
+  let list = ref [] in
+  for i = 0 to t.#len - 1 do
+    list := f (unsafe_get t i) :: !list
+  done;
+  List.rev !list
+;;

src/slice.mli

@@ -0,0 +1,11 @@
+open! Core
+
+type (+'a : value mod non_float) t : immediate & immediate & value
+
+val empty : 'a t
+val create : ('a : value mod non_float). pos:int -> len:int -> 'a iarray -> 'a t
+val length : ('a : value mod non_float). 'a t -> int
+val unsafe_get : ('a : value mod non_float). 'a t -> int -> 'a
+val get : ('a : value mod non_float). 'a t -> int -> 'a
+val iter : ('a : value mod non_float). 'a t -> f:('a -> unit) @ local -> unit
+val map_to_list : ('a : value mod non_float). 'a t -> f:('a -> 'b) @ local -> 'b list

src/symbolizer.ml

@@ -0,0 +1,102 @@
+open! Core
+open Unboxed
+
+(* TODO Nearly everything about the way this module is implemented is slow, and adds
+   measurable overhead. We should do something less naive here. *)
+
+module Request = struct
+  type t =
+    { addr : I64.t
+    ; executable : Interned_string.t
+    }
+  [@@deriving compare, sexp_of, hash]
+end
+
+module Info = struct
+  type t = { demangled_name : string }
+  [@@unboxed] [@@deriving equal, compare, hash, sexp_of]
+
+  let to_location { demangled_name } : Event.Location.t =
+    (* TODO Creating dummy locations for inlined frames like this is gross, but
+       with inlined frames our traces are already so large we can't really
+       afford to add more information until we optimize for trace size, and
+       not all of these have valid values anyway (e.g. [symbol_offset] for
+       an inlined function call is meaningless). *)
+    { symbol = From_perf demangled_name
+    ; symbol_offset = 0
+    ; instruction_pointer = 0L
+    ; dso = Null
+    }
+  ;;
+end
+
+module Response = struct
+  (** This is ordered root-to-leaf such that the entry at index 0 is the physical frame,
+      and the subsequent entries are the inlined frames. *)
+  type t = Info.t iarray [@@deriving sexp_of, equal, hash, compare]
+
+  let physical_frame t = Iarray.unsafe_get t 0
+  let inlined_frames t = Slice.create t ~pos:1 ~len:(Iarray.length t - 1)
+end
+
+module Llvm_symbolizer = struct
+  type t : word
+
+  external create
+    :  unit
+    -> t
+    = "caml_no_bytecode_impl" "magic_trace_llvm_symbolizer_create"
+  [@@noalloc]
+
+  external destroy
+    :  t
+    -> unit
+    = "caml_no_bytecode_impl" "magic_trace_llvm_symbolizer_destroy"
+  [@@noalloc]
+
+  external symbolize
+    :  t
+    -> executable:Interned_string.t
+    -> addr:i64
+    -> Response.t or_null
+    = "caml_no_bytecode_impl" "magic_trace_llvm_symbolize_address"
+end
+
+type t =
+  { symbolization_cache : (Request.t, Response.t or_null) Hashtbl.t
+  ; response_cache : Response.t Hash_set.t
+  ; llvm_symbolizer : Llvm_symbolizer.t
+  }
+
+let finalize (t : t) = Llvm_symbolizer.destroy t.llvm_symbolizer
+
+let create () =
+  let t =
+    { symbolization_cache = Hashtbl.create (module Request)
+    ; response_cache = Hash_set.create (module Response)
+    ; llvm_symbolizer = Llvm_symbolizer.create ()
+    }
+  in
+  Gc.Expert.add_finalizer_exn t finalize;
+  t
+;;
+
+let symbolize t ~executable ~addr =
+  match executable with
+  | Null -> Null
+  | This executable ->
+    let addr = I64.of_int64 addr in
+    (* LLVM can't symbolize things in the Kernel, and symbolizing at [NULL] (address 0) is meaningless;
+       checking for this explicitly avoids us polluting our cache with many [Null] responses. *)
+    if I64.O.(addr <= #0L)
+    then Null
+    else
+      (Hashtbl.find_or_add [@kind value value_or_null])
+        t.symbolization_cache
+        { addr; executable }
+        ~default:(stack_ fun () ->
+          match Llvm_symbolizer.symbolize t.llvm_symbolizer ~executable ~addr with
+          | Null -> Null
+          | This response -> This (Hash_set.get_or_add t.response_cache response))
+      [@nontail]
+;;

src/symbolizer.mli

@@ -0,0 +1,55 @@
+open! Core
+
+module Info : sig
+  type t = private { demangled_name : string }
+  [@@unboxed] [@@deriving equal, compare, hash, sexp_of]
+
+  (** This is currently a gross hack, to be used solely for inlined frames. *)
+  val to_location : t -> Event.Location.t
+end
+
+module Response : sig
+  type t [@@deriving sexp_of]
+
+  val physical_frame : t -> Info.t
+
+  (*= [inlined_frames] is ordered root-to-leaf, such that the "root" is at index 0,
+       and "leaf" is at index [length - 1]. [inlined_frames] does *not* contain the
+       enclosing physical (i.e. non-inlined) frame.
+
+       For example, if you had the following pseudocode:
+
+       ```
+       function baz(x) {
+         return x * 5;
+       }
+
+       function bar(x) {
+        return baz(x) / 3;
+       }
+
+       function foo(x) {
+         return bar(x) + 27;
+       }
+       ```
+
+       If the calls to [bar] and [baz] are both inlined, and you called [symbolize] on an address within [foo],
+       the [inlined_frames] you would receive would be:
+       ```
+       [: "bar"; "baz" :]
+       ```
+       (but with [Info.t] objects instead of the simple strings I've shown for the sake of explanation).
+   *)
+  val inlined_frames : t -> Info.t Slice.t
+end
+
+type t
+
+val create : unit -> t
+
+(** Symbolizes the given address. Returns [Null] if the address is unrecognized. *)
+val symbolize
+  :  t
+  -> executable:Interned_string.t or_null
+  -> addr:Int64.t @ local
+  -> Response.t or_null

src/timestamp.ml

@@ -0,0 +1,7 @@
+open! Core
+
+type t = Time_ns.Span.t [@@deriving equal]
+
+let create t = t
+let zero = Time_ns.Span.zero
+let ( >= ) = Time_ns.Span.( >= )

src/timestamp.mli

@@ -0,0 +1,8 @@
+open! Core
+
+(** A discrete point in time within a trace. *)
+type t = private Time_ns.Span.t [@@deriving equal]
+
+val create : Time_ns.Span.t -> t
+val zero : t
+val ( >= ) : t -> t -> bool

src/trace.ml

@@ -79,8 +79,8 @@ module Null_writer : Trace_writer_intf.S_trace = struct
 
   let allocate_pid ~name:_ = 0
   let allocate_thread ~pid:_ ~name:_ = ()
-  let write_duration_begin ~args:_ ~thread:_ ~name:_ ~time:_ : unit = ()
-  let write_duration_end ~args:_ ~thread:_ ~name:_ ~time:_ : unit = ()
+  let write_duration_begin ?category:_ () ~args:_ ~thread:_ ~name:_ ~time:_ : unit = ()
+  let write_duration_end ?category:_ () ~args:_ ~thread:_ ~name:_ ~time:_ : unit = ()
   let write_duration_complete ~args:_ ~thread:_ ~name:_ ~time:_ ~time_end:_ : unit = ()
   let write_duration_instant ~args:_ ~thread:_ ~name:_ ~time:_ : unit = ()
   let write_counter ~args:_ ~thread:_ ~name:_ ~time:_ : unit = ()
@@ -96,6 +96,7 @@ let write_trace_from_events
   ~hits
   ~events
   ~close_result
+  ~(collection_mode : Collection_mode.t)
   ()
   =
   (* Normalize to earliest event = 0 to avoid Perfetto rounding issues *)
@@ -122,6 +123,15 @@ let write_trace_from_events
     in
     Tracing.Trace.Expert.create ~base_time:(Some base_time) writer
   in
+  let (module Trace_writer : Trace_writer_implementation_intf.S) =
+    match collection_mode with
+    (* TODO Add support for [Stacktrace_sampling] to [New_trace_writer]. *)
+    | Stacktrace_sampling _ -> (module Trace_writer)
+    | Intel_processor_trace _ ->
+      if Env_vars.use_new_trace_writer
+      then (module New_trace_writer)
+      else (module Trace_writer)
+  in
   let writer =
     match trace with
     | Some trace ->
@@ -180,7 +190,7 @@ let write_trace_from_events
   (match events_writer with
    | Some Tracing_tool_output.{ format = Sexp; writer = w; _ } -> Writer.write_line w "))"
    | _ -> ());
-  Trace_writer.end_of_trace writer;
+  Trace_writer.finalize writer;
   Option.iter trace ~f:(fun trace -> Tracing.Trace.close trace);
   close_result
 ;;
@@ -220,7 +230,7 @@ module Make_commands (Backend : Backend_intf.S) = struct
     ~trace_scope
     ~debug_print_perf_commands
     ~record_dir
-    ~collection_mode
+    ~(collection_mode : Collection_mode.t)
     { Decode_opts.output_config; decode_opts; print_events }
     =
     Core.eprintf "[ Decoding, this takes a while... ]\n%!";
@@ -234,6 +244,11 @@ module Make_commands (Backend : Backend_intf.S) = struct
       | Sys_error _ -> None
     in
     let decode_events ?filter_same_symbol_jumps () =
+      let filter_same_symbol_jumps =
+        match collection_mode, Env_vars.use_new_trace_writer with
+        | Intel_processor_trace _, true -> Some false
+        | _, _ -> filter_same_symbol_jumps
+      in
       Backend.decode_events
         ?perf_maps
         ?filter_same_symbol_jumps
@@ -257,12 +272,18 @@ module Make_commands (Backend : Backend_intf.S) = struct
             Option.bind elf ~f:(fun elf -> Option.try_with (fun () -> Elf.addr_table elf))
           with
           | None ->
-            eprintf
-              "Warning: Debug info is unavailable, so filenames and line numbers will \
-               not be available in the trace.\n\
-               See \
-               https://github.com/janestreet/magic-trace/wiki/Compiling-code-for-maximum-compatibility-with-magic-trace \
-               for more info.\n";
+            (* The new trace-writer uses LLVM to process debug-info. While it's true right now
+               that we still use the Owee-provided symbol table for resolving the [-trigger ...]
+               symbol, I think printing out this warning under the new trace-writer is more
+               confusing than helpful. *)
+            if not Env_vars.use_new_trace_writer
+            then
+              eprintf
+                "Warning: Debug info is unavailable, so filenames and line numbers will \
+                 not be available in the trace.\n\
+                 See \
+                 https://github.com/janestreet/magic-trace/wiki/Compiling-code-for-maximum-compatibility-with-magic-trace \
+                 for more info.\n";
             None
           | Some _ as x -> x
         in
@@ -285,6 +306,7 @@ module Make_commands (Backend : Backend_intf.S) = struct
             ~hits
             ~events
             ~close_result
+            ~collection_mode
             ()
         in
         return ())
@@ -733,6 +755,7 @@ module Make_commands (Backend : Backend_intf.S) = struct
              in
              let%bind elf = create_elf ~executable ~when_to_snapshot in
              let%bind range_symbols =
+               (* TODO Use LLVM to load the symbol table, because Owee can't handle executables that use DWARF5. *)
                evaluate_trace_filter ~trace_filter:opts.trace_filter ~elf
              in
              let%bind () =

src/trace.mli

@@ -19,6 +19,7 @@ module For_testing : sig
     -> hits:(string * Breakpoint.Hit.t) list
     -> events:Event.With_write_info.t Pipe.Reader.t list
     -> close_result:'a Deferred.t
+    -> collection_mode:Collection_mode.t
     -> unit
     -> 'a Deferred.t
 end

src/trace_segment.mli

@@ -0,0 +1,19 @@
+open! Core
+
+(** A continuous, lossless, error-free segment of a trace corresponding to a single
+    thread. *)
+type t
+
+val create : Ocaml_exception_info.t option -> t
+
+(** Create a new trace segment that continues from the state of an existing segment,
+    taking the existing segment's last callstack as the new segment's first callstack. *)
+val create_continuing_from : t -> t
+
+val add_event : t -> Event.Ok.Data.t -> Timestamp.t -> unit
+
+val write_trace
+  :  t
+  -> (module Trace_writer_intf.S_trace with type thread = 'thread)
+  -> 'thread
+  -> unit

src/trace_writer.ml

@@ -52,7 +52,9 @@ module Pending_event = struct
   [@@deriving sexp]
 
   let create_call location ~from_untraced =
-    let { Event.Location.instruction_pointer; symbol; symbol_offset } = location in
+    let { Event.Location.instruction_pointer; symbol; symbol_offset; dso = _ } =
+      location
+    in
     { symbol
     ; kind = Call { addr = instruction_pointer; offset = symbol_offset; from_untraced }
     }
@@ -184,7 +186,7 @@ let write_duration_begin
   =
   let module T = (val t.trace) in
   if t.in_filtered_region
-  then T.write_duration_begin ~args ~thread ~name ~time:(time :> Time_ns.Span.t)
+  then T.write_duration_begin () ~args ~thread ~name ~time:(time :> Time_ns.Span.t)
 ;;
 
 let write_duration_end
@@ -198,7 +200,7 @@ let write_duration_end
   =
   let module T = (val t.trace) in
   if t.in_filtered_region
-  then T.write_duration_end ~args ~thread ~name ~time:(time :> Time_ns.Span.t)
+  then T.write_duration_end () ~args ~thread ~name ~time:(time :> Time_ns.Span.t)
 ;;
 
 let write_duration_complete
@@ -1132,14 +1134,14 @@ and write_event' (T t) ?events_writer event =
               | Tx_abort )
           , Some Start )
         | Some Async, None
-        | Some (Hardware_interrupt | Jump | Interrupt | Tx_abort), Some End ->
+        | Some (Hardware_interrupt | Jump | Tx_abort), Some End ->
           raise_s
             [%message
               "BUG: magic-trace devs thought this event was impossible, but you just \
                proved them wrong. Please report this to \
                https://github.com/janestreet/magic-trace/issues/"
                 (event : Event.t)]
-        | (None | Some Async), Some End ->
+        | (None | Some Async | Some Interrupt), Some End ->
           call t thread_info ~time ~location:Event.Location.untraced
         | Some Syscall, Some End ->
           (* We should only be getting these under /u *)
@@ -1231,3 +1233,5 @@ and write_event' (T t) ?events_writer event =
         | None, _ -> ());
        if !debug then print_s (sexp_of_inner t))
 ;;
+
+let finalize t = end_of_trace t

src/trace_writer.mli

@@ -0,0 +1,2 @@
+open! Core
+include Trace_writer_implementation_intf.S

src/trace_writer_implementation_intf.ml

@@ -34,14 +34,6 @@ module type S = sig
     val diff : t -> t -> Time_ns.Span.t
   end
 
-  module Callstack : sig
-    type t =
-      { stack : Event.Location.t Stack.t
-      ; mutable create_time : Mapped_time.t
-      }
-    [@@deriving sexp, bin_io]
-  end
-
   module Event_and_callstack : sig
     type t =
       { event : Event.t
@@ -69,4 +61,6 @@ module type S = sig
   (** Updates internal data structures when trace ends. If [to_time] is passed, will shift
       to new start time which is useful when writing out multiple snapshots from perf. *)
   val end_of_trace : ?to_time:Time_ns.Span.t -> t -> unit
+
+  val finalize : t -> unit
 end

src/trace_writer_intf.ml

@@ -7,14 +7,18 @@ module type S_trace = sig
   val allocate_thread : pid:int -> name:string -> thread
 
   val write_duration_begin
-    :  args:Tracing.Trace.Arg.t list
+    :  ?category:string
+    -> unit
+    -> args:Tracing.Trace.Arg.t list
     -> thread:thread
     -> name:string
     -> time:Time_ns.Span.t
     -> unit
 
   val write_duration_end
-    :  args:Tracing.Trace.Arg.t list
+    :  ?category:string
+    -> unit
+    -> args:Tracing.Trace.Arg.t list
     -> thread:thread
     -> name:string
     -> time:Time_ns.Span.t

test/dune

@@ -1,7 +1,13 @@
 (library
  (name magic_trace_app_test)
- (inline_tests)
- (libraries async core expect_test_helpers_core expect_test_helpers_async
-   magic_trace_lib)
+ (no_dynlink)
+ (inline_tests
+  (deps sample-targets/ocaml-raise/sample.exe))
+ (libraries
+  async
+  core
+  expect_test_helpers_core
+  expect_test_helpers_async
+  magic_trace_lib)
  (preprocess
   (pps ppx_jane)))

test/perf_script.ml

@@ -24,23 +24,23 @@ let run ?(debug = false) ?events_writer ?ocaml_exception_info ~trace_scope file
       !next_thread
     ;;
 
-    let write_duration_begin ~args:_ ~thread:_ ~name ~time : unit =
+    let write_duration_begin ?category:_ () ~args:_ ~thread:_ ~name ~time : unit =
       if not String.(name = "branch-misses" || name = "cache-misses")
       then printf "-> %8s BEGIN %s\n" (Time_ns.Span.to_string_hum time) name
     ;;
 
-    let write_duration_end ~args:_ ~thread:_ ~name ~time : unit =
+    let write_duration_end ?category:_ () ~args:_ ~thread:_ ~name ~time : unit =
       if not String.(name = "branch-misses" || name = "cache-misses")
       then printf "-> %8s END   %s\n" (Time_ns.Span.to_string_hum time) name
     ;;
 
     let write_duration_complete ~args ~thread ~name ~time ~time_end : unit =
-      write_duration_begin ~args ~thread ~name ~time;
-      write_duration_end ~args ~thread ~name ~time:time_end
+      write_duration_begin () ~args ~thread ~name ~time;
+      write_duration_end () ~args ~thread ~name ~time:time_end
     ;;
 
     let write_duration_instant ~args ~thread ~name ~time : unit =
-      write_duration_begin ~args ~thread ~name ~time;
+      write_duration_begin () ~args ~thread ~name ~time;
       printf "->          END   %s\n" name
     ;;
 
@@ -100,5 +100,5 @@ let run ?(debug = false) ?events_writer ?ocaml_exception_info ~trace_scope file
           Trace_writer.write_event ?events_writer trace_writer event
         | None -> ());
       printf "INPUT TRACE STREAM ENDED, any lines printed below this were deferred\n";
-      Trace_writer.end_of_trace trace_writer)
+      Trace_writer.finalize trace_writer)
 ;;

test/sample-targets/long-running/dune

@@ -1,6 +1,12 @@
 (executables
  (names long_running)
- (libraries core core_unix core_unix.core_thread core_unix.command_unix
-   magic_trace core_unix.time_ns_unix core_unix.time_stamp_counter)
+ (libraries
+  core
+  core_unix
+  core_unix.core_thread
+  core_unix.command_unix
+  magic_trace
+  core_unix.time_ns_unix
+  core_unix.time_stamp_counter)
  (preprocess
   (pps ppx_jane)))

test/sample-targets/ocaml-raise/dune

@@ -1,6 +1,10 @@
 (executables
  (names sample)
- (libraries core core_unix core_unix.command_unix magic_trace
-   core_unix.time_stamp_counter)
+ (libraries
+  core
+  core_unix
+  core_unix.command_unix
+  magic_trace
+  core_unix.time_stamp_counter)
  (preprocess
   (pps ppx_jane)))

test/test.ml

@@ -8,6 +8,7 @@ include struct
   module Event = Event
   module Symbol = Symbol
   module Trace_filter = Trace_filter
+  module Interned_string = Interned_string
 end
 
 module Trace_helpers : sig
@@ -38,7 +39,10 @@ end = struct
   let addr () = Random.State.int64_incl !rng 0L 0x7fffffffffffL
   let offset () = Random.State.int_incl !rng 0 0x1000
   let unknown = Symbol.From_perf "unknown"
-  let loc symbol = { Event.Location.instruction_pointer = 0L; symbol; symbol_offset = 0 }
+
+  let loc symbol =
+    { Event.Location.instruction_pointer = 0L; symbol; symbol_offset = 0; dso = Null }
+  ;;
 
   let symbol () =
     Symbol.From_perf
@@ -50,18 +54,37 @@ end = struct
     { instruction_pointer = addr ()
     ; symbol = Option.value symbol ~default:(Symbol.From_perf "")
     ; symbol_offset = offset ()
+    ; dso = Null
     }
   ;;
 
+  let start_location : Event.Location.t =
+    { instruction_pointer = 0x900000L
+    ; symbol = From_perf "_start"
+    ; symbol_offset = 4
+    ; dso = Null
+    }
+  ;;
+
+  let last_dst_location = ref start_location
+
   let random_ok_event ?kind ?symbol () : Event.Ok.t =
+    let src =
+      { !last_dst_location with
+        instruction_pointer = Int64.succ !last_dst_location.instruction_pointer
+      ; symbol_offset = !last_dst_location.symbol_offset + 1
+      }
+    in
+    let dst = random_location ?symbol () in
+    last_dst_location := dst;
     { thread
     ; time = time ()
     ; data =
         Trace
           { trace_state_change = None
           ; kind = Some (Option.value kind ~default:Event.Kind.Call)
-          ; src = random_location ()
-          ; dst = random_location ?symbol ()
+          ; src
+          ; dst
           }
     ; in_transaction = false
     }
@@ -122,6 +145,7 @@ end = struct
     Stack.clear stack;
     cur_time := start_time;
     rng := Random.State.make make_rng_array;
+    last_dst_location := start_location;
     ret
   ;;
 
@@ -153,6 +177,7 @@ let dump_using_file ?range_symbols events =
       ~hits:[]
       ~events:[ events ]
       ~close_result
+      ~collection_mode:(Intel_processor_trace { extra_events = [] })
       ()
   in
   ok_exn or_error;
@@ -202,17 +227,17 @@ let%expect_test "random perfs" =
       ((pid 1) (tid 2) (process_name ("[pid=1234] [tid=456]"))
        (thread_name (main)))))
     (Interned_string (index 104) (value address))
-    (Interned_string (index 105) (value "+O\002B~h"))
+    (Interned_string (index 105) (value "B~h\031T"))
     (Interned_string (index 106) (value symbol))
     (Interned_string (index 107) (value ""))
     (Event
-     ((timestamp 13ns) (thread 1) (category 107) (name 105)
-      (arguments ((104 (Pointer 0x38df7fb74073)) (106 (String 105))))
+     ((timestamp 71ns) (thread 1) (category 107) (name 105)
+      (arguments ((104 (Pointer 0x40a09d024a7)) (106 (String 105))))
       (event_type Duration_begin)))
-    (Interned_string (index 108) (value "\017c\004dl\\"))
+    (Interned_string (index 108) (value "\020\012\024f"))
     (Event
-     ((timestamp 87ns) (thread 1) (category 107) (name 108)
-      (arguments ((104 (Pointer 0x70b30bb76ae5)) (106 (String 108))))
+     ((timestamp 140ns) (thread 1) (category 107) (name 108)
+      (arguments ((104 (Pointer 0x4b46c9ab792e)) (106 (String 108))))
       (event_type Duration_begin)))
     (Interned_string (index 109) (value [unknown]))
     (Event
@@ -227,21 +252,21 @@ let%expect_test "random perfs" =
        ((104 (Pointer 0xd39111cc0c)) (106 (String 110)) (112 (String 111))))
       (event_type Duration_begin)))
     (Event
-     ((timestamp 166ns) (thread 1) (category 107) (name 108) (arguments ())
+     ((timestamp 190ns) (thread 1) (category 107) (name 108) (arguments ())
       (event_type Duration_end)))
-    (Interned_string (index 113) (value "\0188\020"))
+    (Interned_string (index 113) (value "\017c\004"))
     (Event
-     ((timestamp 166ns) (thread 1) (category 107) (name 113)
-      (arguments ((104 (Pointer 0x4c43bd1036db)) (106 (String 113))))
+     ((timestamp 190ns) (thread 1) (category 107) (name 113)
+      (arguments ((104 (Pointer 0x70b30bb76ae5)) (106 (String 113))))
       (event_type Duration_begin)))
     (Event
-     ((timestamp 166ns) (thread 1) (category 107) (name 113) (arguments ())
+     ((timestamp 190ns) (thread 1) (category 107) (name 113) (arguments ())
       (event_type Duration_end)))
     (Event
-     ((timestamp 166ns) (thread 1) (category 107) (name 105) (arguments ())
+     ((timestamp 190ns) (thread 1) (category 107) (name 105) (arguments ())
       (event_type Duration_end)))
     (Event
-     ((timestamp 166ns) (thread 1) (category 107) (name 110) (arguments ())
+     ((timestamp 190ns) (thread 1) (category 107) (name 110) (arguments ())
       (event_type Duration_end)))
     (Error No_more_words)
     |}];
@@ -290,14 +315,14 @@ let%expect_test "random perfs" =
     (Interned_string (index 104) (value "\026/"))
     (Interned_string (index 105) (value ""))
     (Event
-     ((timestamp 13ns) (thread 1) (category 105) (name 104) (arguments ())
+     ((timestamp 71ns) (thread 1) (category 105) (name 104) (arguments ())
       (event_type Duration_end)))
     (Interned_string (index 106) (value address))
-    (Interned_string (index 107) (value "+O\002B~h"))
+    (Interned_string (index 107) (value "B~h\031T"))
     (Interned_string (index 108) (value symbol))
     (Event
-     ((timestamp 13ns) (thread 1) (category 105) (name 107)
-      (arguments ((106 (Pointer 0x38df7fb74073)) (108 (String 107))))
+     ((timestamp 71ns) (thread 1) (category 105) (name 107)
+      (arguments ((106 (Pointer 0x40a09d024a7)) (108 (String 107))))
       (event_type Duration_begin)))
     (Interned_string (index 109) (value [unknown]))
     (Event
@@ -310,16 +335,16 @@ let%expect_test "random perfs" =
       (arguments
        ((106 (Pointer 0xd39111cc0c)) (108 (String 104)) (111 (String 110))))
       (event_type Duration_begin)))
-    (Interned_string (index 112) (value "\017c\004dl\\"))
+    (Interned_string (index 112) (value "\020\012\024f"))
     (Event
-     ((timestamp 87ns) (thread 1) (category 105) (name 112)
-      (arguments ((106 (Pointer 0x70b30bb76ae5)) (108 (String 112))))
+     ((timestamp 140ns) (thread 1) (category 105) (name 112)
+      (arguments ((106 (Pointer 0x4b46c9ab792e)) (108 (String 112))))
       (event_type Duration_begin)))
     (Event
-     ((timestamp 87ns) (thread 1) (category 105) (name 112) (arguments ())
+     ((timestamp 140ns) (thread 1) (category 105) (name 112) (arguments ())
       (event_type Duration_end)))
     (Event
-     ((timestamp 87ns) (thread 1) (category 105) (name 107) (arguments ())
+     ((timestamp 140ns) (thread 1) (category 105) (name 107) (arguments ())
       (event_type Duration_end)))
     (Error No_more_words)
     |}];
@@ -337,56 +362,56 @@ let%expect_test "random perfs" =
       ((pid 1) (tid 2) (process_name ("[pid=1234] [tid=456]"))
        (thread_name (main)))))
     (Interned_string (index 104) (value address))
-    (Interned_string (index 105) (value "+O\002B~h"))
+    (Interned_string (index 105) (value "B~h\031T"))
     (Interned_string (index 106) (value symbol))
     (Interned_string (index 107) (value ""))
     (Event
-     ((timestamp 13ns) (thread 1) (category 107) (name 105)
-      (arguments ((104 (Pointer 0x38df7fb74073)) (106 (String 105))))
+     ((timestamp 71ns) (thread 1) (category 107) (name 105)
+      (arguments ((104 (Pointer 0x40a09d024a7)) (106 (String 105))))
       (event_type Duration_begin)))
     (Event
-     ((timestamp 18ns) (thread 1) (category 107) (name 105) (arguments ())
+     ((timestamp 160ns) (thread 1) (category 107) (name 105) (arguments ())
       (event_type Duration_end)))
     (Interned_string (index 108) (value "\026/"))
     (Event
-     ((timestamp 18ns) (thread 1) (category 107) (name 108) (arguments ())
+     ((timestamp 160ns) (thread 1) (category 107) (name 108) (arguments ())
       (event_type Duration_end)))
     (Event
-     ((timestamp 18ns) (thread 1) (category 107) (name 105)
-      (arguments ((104 (Pointer 0x4b46c9ab792e)) (106 (String 105))))
+     ((timestamp 160ns) (thread 1) (category 107) (name 105)
+      (arguments ((104 (Pointer 0x38df7fb74073)) (106 (String 105))))
       (event_type Duration_begin)))
     (Event
-     ((timestamp 68ns) (thread 1) (category 107) (name 105) (arguments ())
+     ((timestamp 220ns) (thread 1) (category 107) (name 105) (arguments ())
       (event_type Duration_end)))
-    (Interned_string (index 109) (value "w7&\0188\020x\\"))
+    (Interned_string (index 109) (value "\017c\004dl"))
     (Event
-     ((timestamp 78ns) (thread 1) (category 107) (name 109)
-      (arguments ((104 (Pointer 0x76ae90948b21)) (106 (String 109))))
+     ((timestamp 270ns) (thread 1) (category 107) (name 109)
+      (arguments ((104 (Pointer 0x70b30bb76ae5)) (106 (String 109))))
       (event_type Duration_begin)))
     (Interned_string (index 110) (value true))
     (Interned_string (index 111) (value inferred_start_time))
     (Event
      ((timestamp 0s) (thread 1) (category 107) (name 108)
       (arguments
-       ((104 (Pointer 0x68bf42fc6148)) (106 (String 108)) (111 (String 110))))
+       ((104 (Pointer 0x2e982c5c3c4a)) (106 (String 108)) (111 (String 110))))
       (event_type Duration_begin)))
     (Event
      ((timestamp 0s) (thread 1) (category 107) (name 108)
       (arguments ((104 (Pointer 0xd39111cc0c)) (106 (String 108))))
       (event_type Duration_begin)))
-    (Interned_string (index 112) (value "\011X\024"))
+    (Interned_string (index 112) (value "w7&\0188\020x\\"))
     (Event
-     ((timestamp 124ns) (thread 1) (category 107) (name 112)
-      (arguments ((104 (Pointer 0x3bafd6d24276)) (106 (String 112))))
+     ((timestamp 358ns) (thread 1) (category 107) (name 112)
+      (arguments ((104 (Pointer 0x76ae90948b21)) (106 (String 112))))
       (event_type Duration_begin)))
     (Event
-     ((timestamp 124ns) (thread 1) (category 107) (name 112) (arguments ())
+     ((timestamp 358ns) (thread 1) (category 107) (name 112) (arguments ())
       (event_type Duration_end)))
     (Event
-     ((timestamp 124ns) (thread 1) (category 107) (name 109) (arguments ())
+     ((timestamp 358ns) (thread 1) (category 107) (name 109) (arguments ())
       (event_type Duration_end)))
     (Event
-     ((timestamp 124ns) (thread 1) (category 107) (name 108) (arguments ())
+     ((timestamp 358ns) (thread 1) (category 107) (name 108) (arguments ())
       (event_type Duration_end)))
     (Error No_more_words)
     |}];
@@ -426,88 +451,88 @@ let%expect_test "with initial returns" =
     (Interned_string (index 104) (value "\026/"))
     (Interned_string (index 105) (value ""))
     (Event
-     ((timestamp 13ns) (thread 1) (category 105) (name 104) (arguments ())
+     ((timestamp 71ns) (thread 1) (category 105) (name 104) (arguments ())
       (event_type Duration_end)))
-    (Interned_string (index 106) (value "+O\002B~h"))
+    (Interned_string (index 106) (value "B~h\031T"))
     (Event
-     ((timestamp 87ns) (thread 1) (category 105) (name 106) (arguments ())
+     ((timestamp 140ns) (thread 1) (category 105) (name 106) (arguments ())
       (event_type Duration_end)))
-    (Interned_string (index 107) (value "\017c\004dl\\"))
+    (Interned_string (index 107) (value "\020\012\024f"))
     (Event
-     ((timestamp 166ns) (thread 1) (category 105) (name 107) (arguments ())
+     ((timestamp 190ns) (thread 1) (category 105) (name 107) (arguments ())
       (event_type Duration_end)))
     (Interned_string (index 108) (value address))
-    (Interned_string (index 109) (value "\011X\024\018I]"))
+    (Interned_string (index 109) (value "w7&\0188\020x\\"))
     (Interned_string (index 110) (value symbol))
     (Event
-     ((timestamp 212ns) (thread 1) (category 105) (name 109)
-      (arguments ((108 (Pointer 0x3bafd6d24276)) (110 (String 109))))
+     ((timestamp 278ns) (thread 1) (category 105) (name 109)
+      (arguments ((108 (Pointer 0x76ae90948b21)) (110 (String 109))))
       (event_type Duration_begin)))
-    (Interned_string (index 111) (value "\006\0287KS{5"))
+    (Interned_string (index 111) (value "\bl@\011X\024\018I"))
     (Event
-     ((timestamp 263ns) (thread 1) (category 105) (name 111)
-      (arguments ((108 (Pointer 0x1ab97b79c3e9)) (110 (String 111))))
+     ((timestamp 353ns) (thread 1) (category 105) (name 111)
+      (arguments ((108 (Pointer 0x3d60dc058bdb)) (110 (String 111))))
       (event_type Duration_begin)))
     (Event
-     ((timestamp 290ns) (thread 1) (category 105) (name 111) (arguments ())
+     ((timestamp 400ns) (thread 1) (category 105) (name 111) (arguments ())
       (event_type Duration_end)))
     (Event
-     ((timestamp 290ns) (thread 1) (category 105) (name 109) (arguments ())
+     ((timestamp 400ns) (thread 1) (category 105) (name 109) (arguments ())
       (event_type Duration_end)))
     (Event
-     ((timestamp 290ns) (thread 1) (category 105) (name 111)
-      (arguments ((108 (Pointer 0x4e875e8d5917)) (110 (String 111))))
+     ((timestamp 400ns) (thread 1) (category 105) (name 111)
+      (arguments ((108 (Pointer 0xeab2ebcd97d)) (110 (String 111))))
       (event_type Duration_begin)))
     (Event
-     ((timestamp 337ns) (thread 1) (category 105) (name 111) (arguments ())
+     ((timestamp 430ns) (thread 1) (category 105) (name 111) (arguments ())
       (event_type Duration_end)))
-    (Interned_string (index 112) (value "\001/p:"))
+    (Interned_string (index 112) (value "]RP\006\0287"))
     (Event
-     ((timestamp 337ns) (thread 1) (category 105) (name 112)
-      (arguments ((108 (Pointer 0x7d1910749b4d)) (110 (String 112))))
+     ((timestamp 430ns) (thread 1) (category 105) (name 112)
+      (arguments ((108 (Pointer 0x27bf01bcea1d)) (110 (String 112))))
       (event_type Duration_begin)))
     (Event
-     ((timestamp 396ns) (thread 1) (category 105) (name 112) (arguments ())
+     ((timestamp 509ns) (thread 1) (category 105) (name 112) (arguments ())
       (event_type Duration_end)))
-    (Interned_string (index 113) (value "\0188\020"))
+    (Interned_string (index 113) (value "\017c\004"))
     (Event
-     ((timestamp 396ns) (thread 1) (category 105) (name 113) (arguments ())
+     ((timestamp 509ns) (thread 1) (category 105) (name 113) (arguments ())
       (event_type Duration_end)))
     (Event
-     ((timestamp 396ns) (thread 1) (category 105) (name 112)
-      (arguments ((108 (Pointer 0x3218dd4125e6)) (110 (String 112))))
+     ((timestamp 509ns) (thread 1) (category 105) (name 112)
+      (arguments ((108 (Pointer 0x6bd56981ff1e)) (110 (String 112))))
       (event_type Duration_begin)))
     (Event
-     ((timestamp 422ns) (thread 1) (category 105) (name 112) (arguments ())
+     ((timestamp 548ns) (thread 1) (category 105) (name 112) (arguments ())
       (event_type Duration_end)))
-    (Interned_string (index 114) (value "\002s\b6t\031L&3"))
+    (Interned_string (index 114) (value "p\011\004\027BMw`"))
     (Interned_string (index 115) (value true))
     (Interned_string (index 116) (value inferred_start_time))
     (Event
      ((timestamp 0s) (thread 1) (category 105) (name 114)
       (arguments
-       ((108 (Pointer 0x1d23eb1c2889)) (110 (String 114)) (116 (String 115))))
+       ((108 (Pointer 0x7484e5a78107)) (110 (String 114)) (116 (String 115))))
       (event_type Duration_begin)))
-    (Interned_string (index 117) (value "\015'p\011\004\027BM"))
+    (Interned_string (index 117) (value "5F\022\026x\001/p:}"))
     (Event
      ((timestamp 0s) (thread 1) (category 105) (name 117)
       (arguments
-       ((108 (Pointer 0x668b6c8c3735)) (110 (String 117)) (116 (String 115))))
+       ((108 (Pointer 0x3218dd4125e6)) (110 (String 117)) (116 (String 115))))
       (event_type Duration_begin)))
     (Event
      ((timestamp 0s) (thread 1) (category 105) (name 113)
       (arguments
-       ((108 (Pointer 0x4c43bd1036db)) (110 (String 113)) (116 (String 115))))
+       ((108 (Pointer 0x70b30bb76ae5)) (110 (String 113)) (116 (String 115))))
       (event_type Duration_begin)))
     (Event
      ((timestamp 0s) (thread 1) (category 105) (name 107)
       (arguments
-       ((108 (Pointer 0x70b30bb76ae5)) (110 (String 107)) (116 (String 115))))
+       ((108 (Pointer 0x4b46c9ab792e)) (110 (String 107)) (116 (String 115))))
       (event_type Duration_begin)))
     (Event
      ((timestamp 0s) (thread 1) (category 105) (name 106)
       (arguments
-       ((108 (Pointer 0x38df7fb74073)) (110 (String 106)) (116 (String 115))))
+       ((108 (Pointer 0x40a09d024a7)) (110 (String 106)) (116 (String 115))))
       (event_type Duration_begin)))
     (Interned_string (index 118) (value [unknown]))
     (Event
@@ -519,10 +544,10 @@ let%expect_test "with initial returns" =
        ((108 (Pointer 0xd39111cc0c)) (110 (String 104)) (116 (String 115))))
       (event_type Duration_begin)))
     (Event
-     ((timestamp 470ns) (thread 1) (category 105) (name 117) (arguments ())
+     ((timestamp 628ns) (thread 1) (category 105) (name 117) (arguments ())
       (event_type Duration_end)))
     (Event
-     ((timestamp 470ns) (thread 1) (category 105) (name 114) (arguments ())
+     ((timestamp 628ns) (thread 1) (category 105) (name 114) (arguments ())
       (event_type Duration_end)))
     (Error No_more_words)
     |}];
@@ -621,7 +646,8 @@ let%expect_test "time batch spreading" =
     (Event
      ((timestamp 103ns) (thread 1) (category 107) (name 103) (arguments ())
       (event_type Duration_end)))
-    (Error No_more_words) |}];
+    (Error No_more_words)
+    |}];
   return ()
 ;;
 
@@ -694,7 +720,8 @@ let%expect_test "enqueuing events at start" =
     (Event
      ((timestamp 3ns) (thread 1) (category 105) (name 108) (arguments ())
       (event_type Duration_end)))
-    (Error No_more_words) |}];
+    (Error No_more_words)
+    |}];
   return ()
 ;;
 
@@ -793,7 +820,8 @@ let%expect_test "filtered trace" =
     (Event
      ((timestamp 13ns) (thread 1) (category 109) (name 105) (arguments ())
       (event_type Duration_end)))
-    (Error No_more_words) |}];
+    (Error No_more_words)
+    |}];
   return ()
 ;;