diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index a73b114da..203c1da1c 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -14,70 +14,31 @@ jobs:
           - '5.2.0+ox'
 
     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 }}-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 }}-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))
           echo "OPAMYES=1" >> "$GITHUB_ENV"
@@ -93,11 +54,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
diff --git a/.gitignore b/.gitignore
index eb42dfd72..d46401d4f 100644
--- a/.gitignore
+++ b/.gitignore
@@ -2,5 +2,11 @@ _build
 *.install
 *.merlin
 _opam
+perf.data
+perf.data.old
 .vscode/*
 !.vscode/tasks.json
+*.fxt
+*.fxt.old
+*.fxt.gz
+*.fxt.gz.old
diff --git a/.ocamlformat b/.ocamlformat
index 3b217634a..c07affe0f 100644
--- a/.ocamlformat
+++ b/.ocamlformat
@@ -1 +1,3 @@
 profile=janestreet
+wrap-comments=false
+parse-docstrings=false
diff --git a/direct_backend/cinaps/dune b/direct_backend/cinaps/dune
index bf7580311..e983e06c5 100644
--- a/direct_backend/cinaps/dune
+++ b/direct_backend/cinaps/dune
@@ -1,5 +1,6 @@
 (library
  (name magic_trace_lib_cinaps_helpers)
+ (no_dynlink)
  (libraries core)
  (preprocess
   (pps ppx_jane)))
diff --git a/dune b/dune
index 04df9caac..e5b7b1cc0 100644
--- a/dune
+++ b/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)
diff --git a/dune-project b/dune-project
index 929c696e5..37f995d64 100644
--- a/dune-project
+++ b/dune-project
@@ -1 +1 @@
-(lang dune 2.0)
+(lang dune 3.0)
diff --git a/lib/magic_trace/src/dune b/lib/magic_trace/src/dune
index e4f4bb693..df14633b1 100644
--- a/lib/magic_trace/src/dune
+++ b/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))
diff --git a/lib/magic_trace/test/dune b/lib/magic_trace/test/dune
index 6f5684b2e..ea9a9a37e 100644
--- a/lib/magic_trace/test/dune
+++ b/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)))
diff --git a/magic-trace.opam b/magic-trace.opam
index 68d28a3e2..a45c9af4d 100644
--- a/magic-trace.opam
+++ b/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"
diff --git a/magic-trace.opam.locked b/magic-trace.opam.locked
index 85983ac0c..35b7831b3 100644
--- a/magic-trace.opam.locked
+++ b/magic-trace.opam.locked
@@ -13,12 +13,12 @@ bug-reports: "https://github.com/janestreet/magic-trace/issues"
 depends: [
   "angstrom" {= "0.16.1"}
   "astring" {= "0.8.5"}
-  "async" {= "v0.18~preview.130.83+317"}
-  "async_kernel" {= "v0.18~preview.130.83+317"}
-  "async_log" {= "v0.18~preview.130.83+317"}
-  "async_rpc_kernel" {= "v0.18~preview.130.83+317"}
-  "async_unix" {= "v0.18~preview.130.83+317"}
-  "base" {= "v0.18~preview.130.83+317"}
+  "async" {= "v0.18~preview.130.91+190"}
+  "async_kernel" {= "v0.18~preview.130.91+190"}
+  "async_log" {= "v0.18~preview.130.91+190"}
+  "async_rpc_kernel" {= "v0.18~preview.130.91+190"}
+  "async_unix" {= "v0.18~preview.130.91+190"}
+  "base" {= "v0.18~preview.130.91+190"}
   "base-bigarray" {= "base"}
   "base-bytes" {= "base"}
   "base-domains" {= "base"}
@@ -26,21 +26,20 @@ depends: [
   "base-threads" {= "base"}
   "base-unix" {= "base"}
   "base64" {= "3.5.2"}
-  "base_bigstring" {= "v0.18~preview.130.83+317"}
-  "base_quickcheck" {= "v0.18~preview.130.83+317"}
-  "basement" {= "v0.18~preview.130.83+317"}
-  "bigarray-compat" {= "1.1.0"}
+  "base_bigstring" {= "v0.18~preview.130.91+190"}
+  "base_quickcheck" {= "v0.18~preview.130.91+190"}
+  "basement" {= "v0.18~preview.130.91+190"}
   "bigstringaf" {= "0.10.0"}
-  "bin_prot" {= "v0.18~preview.130.83+317"}
+  "bin_prot" {= "v0.18~preview.130.91+190"}
   "camlp-streams" {= "5.0.1"}
   "camlzip" {= "1.14"}
-  "capitalization" {= "v0.18~preview.130.83+317"}
-  "capsule" {= "v0.18~preview.130.83+317"}
-  "capsule0" {= "v0.18~preview.130.83+317"}
+  "capitalization" {= "v0.18~preview.130.91+190"}
+  "capsule" {= "v0.18~preview.130.91+190"}
+  "capsule0" {= "v0.18~preview.130.91+190"}
   "cmdliner" {= "1.3.0"}
   "cohttp" {= "5.3.1"}
   "cohttp-async" {= "5.3.0"}
-  "cohttp_static_handler" {= "v0.18~preview.130.83+317"}
+  "cohttp_static_handler" {= "v0.18~preview.130.91+190"}
   "conduit" {= "8.0.0"}
   "conduit-async" {= "8.0.0"}
   "conf-autoconf" {= "0.2"}
@@ -48,41 +47,42 @@ depends: [
   "conf-which" {= "1"}
   "conf-zlib" {= "1"}
   "conf-zstd" {= "1.3.8"}
-  "core" {= "v0.18~preview.130.83+317"}
-  "core_extended" {= "v0.18~preview.130.83+317"}
-  "core_kernel" {= "v0.18~preview.130.83+317"}
-  "core_unix" {= "v0.18~preview.130.83+317"}
+  "core" {= "v0.18~preview.130.91+190"}
+  "core_extended" {= "v0.18~preview.130.91+190"}
+  "core_kernel" {= "v0.18~preview.130.91+190"}
+  "core_unix" {= "v0.18~preview.130.91+190"}
   "crunch" {= "4.0.0"}
   "csexp" {= "1.5.2"}
   "cstruct" {= "6.2.0"}
-  "ctypes" {= "0.23.0+ox"}
+  "ctypes" {= "0.24.0+ox"}
   "domain-name" {= "0.5.0"}
-  "dune" {= "3.21.1"}
-  "dune-build-info" {= "3.21.1" & with-test}
-  "dune-configurator" {= "3.21.1"}
-  "either" {= "1.0.0" & with-test}
-  "expect_test_helpers_async" {= "v0.18~preview.130.83+317"}
-  "expect_test_helpers_core" {= "v0.18~preview.130.83+317"}
-  "fieldslib" {= "v0.18~preview.130.83+317"}
-  "fix" {= "20250919" & with-test}
-  "flexible_sexp" {= "v0.18~preview.130.83+317"}
-  "fmt" {= "0.10.0"}
-  "fpath" {= "0.7.3" & with-test}
-  "int_repr" {= "v0.18~preview.130.83+317"}
+  "dune" {= "3.20.2+ox1"}
+  "dune-build-info" {= "3.20.2"}
+  "dune-configurator" {= "3.20.2+ox"}
+  "either" {= "1.0.0"}
+  "expect_test_helpers_async" {= "v0.18~preview.130.91+190"}
+  "expect_test_helpers_core" {= "v0.18~preview.130.91+190"}
+  "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"}
   "integers" {= "0.7.0"}
   "ipaddr" {= "5.6.2"}
   "ipaddr-sexp" {= "5.6.2"}
-  "jane-street-headers" {= "v0.18~preview.130.83+317"}
+  "jane-street-headers" {= "v0.18~preview.130.91+190"}
   "jsonm" {= "1.0.2"}
-  "jst-config" {= "v0.18~preview.130.83+317"}
-  "logs" {= "0.9.0"}
+  "jst-config" {= "v0.18~preview.130.91+190"}
+  "logs" {= "0.10.0"}
   "macaddr" {= "5.6.2"}
   "magic-mime" {= "1.3.1"}
-  "menhir" {= "20260209" & with-test}
-  "menhirCST" {= "20260209" & with-test}
-  "menhirGLR" {= "20260209" & with-test}
-  "menhirLib" {= "20260209" & with-test}
-  "menhirSdk" {= "20260209" & with-test}
+  "menhir" {= "20260209"}
+  "menhirCST" {= "20260209"}
+  "menhirGLR" {= "20260209"}
+  "menhirLib" {= "20260209"}
+  "menhirSdk" {= "20260209"}
   "num" {= "1.6"}
   "ocaml" {= "5.2.0"}
   "ocaml-compiler-libs" {= "v0.17.0+ox"}
@@ -90,104 +90,178 @@ depends: [
   "ocaml-options-vanilla" {= "1"}
   "ocaml-syntax-shims" {= "1.0.0"}
   "ocaml-variants" {= "5.2.0+ox"}
-  "ocaml-version" {= "4.0.4" & with-test}
-  "ocaml_intrinsics" {= "v0.18~preview.130.83+317"}
-  "ocaml_intrinsics_kernel" {= "v0.18~preview.130.83+317"}
-  "ocamlbuild" {= "0.15.0+ox"}
+  "ocaml-version" {= "4.1.0"}
+  "ocaml_intrinsics" {= "v0.18~preview.130.91+190"}
+  "ocaml_intrinsics_kernel" {= "v0.18~preview.130.91+190"}
+  "ocamlbuild" {= "0.16.1+ox"}
   "ocamlfind" {= "1.9.8+ox"}
-  "ocamlformat" {= "0.26.2+ox" & with-test}
-  "ocamlformat-lib" {= "0.26.2+ox" & with-test}
-  "ocp-indent" {= "1.9.0" & with-test}
+  "ocamlformat" {= "0.26.2+ox1" & with-test}
+  "ocamlformat-lib" {= "0.26.2+ox1"}
+  "ocp-indent" {= "1.9.0"}
   "odoc-parser" {= "3.1.0+ox"}
   "owee" {= "0.8"}
-  "parsexp" {= "v0.18~preview.130.83+317"}
-  "pipe_with_writer_error" {= "v0.18~preview.130.83+317"}
-  "portable" {= "v0.18~preview.130.83+317"}
-  "ppx_array_base" {= "v0.18~preview.130.83+317"}
-  "ppx_assert" {= "v0.18~preview.130.83+317"}
-  "ppx_base" {= "v0.18~preview.130.83+317"}
-  "ppx_bench" {= "v0.18~preview.130.83+317"}
-  "ppx_bin_prot" {= "v0.18~preview.130.83+317"}
-  "ppx_cold" {= "v0.18~preview.130.83+317"}
-  "ppx_compare" {= "v0.18~preview.130.83+317"}
-  "ppx_custom_printf" {= "v0.18~preview.130.83+317"}
-  "ppx_debug_assert" {= "v0.18~preview.130.83+317"}
+  "oxcaml" {= "latest"}
+  "oxcaml-alcotest" {= "guard"}
+  "oxcaml-backoff" {= "guard"}
+  "oxcaml-chrome-trace" {= "guard"}
+  "oxcaml-cmarkit" {= "guard"}
+  "oxcaml-compiler" {= "5.2.0minus31"}
+  "oxcaml-ctypes-foreign" {= "guard"}
+  "oxcaml-ctypes-patches" {= "enabled"}
+  "oxcaml-dot-merlin-reader" {= "guard"}
+  "oxcaml-dune-action-plugin" {= "guard"}
+  "oxcaml-dune-build-info" {= "guard"}
+  "oxcaml-dune-configurator-patches" {= "enabled"}
+  "oxcaml-dune-glob" {= "guard"}
+  "oxcaml-dune-patches" {= "enabled"}
+  "oxcaml-dune-private-libs" {= "guard"}
+  "oxcaml-dune-rpc" {= "guard"}
+  "oxcaml-dune-rpc-lwt" {= "guard"}
+  "oxcaml-dune-site" {= "guard"}
+  "oxcaml-dyn" {= "guard"}
+  "oxcaml-eio" {= "guard"}
+  "oxcaml-eio_linux" {= "guard"}
+  "oxcaml-eio_main" {= "guard"}
+  "oxcaml-eio_posix" {= "guard"}
+  "oxcaml-fs-io" {= "guard"}
+  "oxcaml-gen_js_api" {= "guard"}
+  "oxcaml-js_of_ocaml" {= "guard"}
+  "oxcaml-js_of_ocaml-compiler" {= "guard"}
+  "oxcaml-js_of_ocaml-ppx" {= "guard"}
+  "oxcaml-js_of_ocaml-toplevel" {= "guard"}
+  "oxcaml-jsonrpc" {= "guard"}
+  "oxcaml-lsp" {= "guard"}
+  "oxcaml-lwt" {= "guard"}
+  "oxcaml-lwt_direct" {= "guard"}
+  "oxcaml-lwt_ppx" {= "guard"}
+  "oxcaml-lwt_runtime_events" {= "guard"}
+  "oxcaml-mdx" {= "guard"}
+  "oxcaml-merlin" {= "guard"}
+  "oxcaml-merlin-lib" {= "guard"}
+  "oxcaml-notty-community" {= "guard"}
+  "oxcaml-ocaml-compiler-libs-patches" {= "enabled"}
+  "oxcaml-ocaml-index" {= "guard"}
+  "oxcaml-ocaml-lsp-server" {= "guard"}
+  "oxcaml-ocamlbuild-patches" {= "enabled"}
+  "oxcaml-ocamlc-loc" {= "guard"}
+  "oxcaml-ocamlfind-patches" {= "enabled"}
+  "oxcaml-ocamlformat-lib-patches" {= "enabled"}
+  "oxcaml-ocamlformat-patches" {= "enabled"}
+  "oxcaml-odoc" {= "guard"}
+  "oxcaml-odoc-driver" {= "guard"}
+  "oxcaml-odoc-md" {= "guard"}
+  "oxcaml-odoc-parser-patches" {= "enabled"}
+  "oxcaml-ojs" {= "guard"}
+  "oxcaml-omd" {= "guard"}
+  "oxcaml-opam-core" {= "guard"}
+  "oxcaml-opam-format" {= "guard"}
+  "oxcaml-ordering" {= "guard"}
+  "oxcaml-patch-guards" {= "ox"}
+  "oxcaml-ppx_deriving" {= "guard"}
+  "oxcaml-ppxlib-patches" {= "enabled"}
+  "oxcaml-ppxlib_ast-patches" {= "enabled"}
+  "oxcaml-re-patches" {= "enabled"}
+  "oxcaml-sedlex" {= "guard"}
+  "oxcaml-sherlodoc" {= "guard"}
+  "oxcaml-spawn-patches" {= "enabled"}
+  "oxcaml-stdune" {= "guard"}
+  "oxcaml-top-closure" {= "guard"}
+  "oxcaml-topkg-patches" {= "enabled"}
+  "oxcaml-utop" {= "guard"}
+  "oxcaml-uutf-patches" {= "enabled"}
+  "oxcaml-wasm_of_ocaml-compiler" {= "guard"}
+  "oxcaml-xdg" {= "guard"}
+  "oxcaml-yojson" {= "guard"}
+  "oxcaml-zarith" {= "guard"}
+  "parsexp" {= "v0.18~preview.130.91+190"}
+  "pipe_with_writer_error" {= "v0.18~preview.130.91+190"}
+  "portable" {= "v0.18~preview.130.91+190"}
+  "ppx_array_base" {= "v0.18~preview.130.91+190"}
+  "ppx_assert" {= "v0.18~preview.130.91+190"}
+  "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"}
+  "ppx_custom_printf" {= "v0.18~preview.130.91+190"}
+  "ppx_debug_assert" {= "v0.18~preview.130.91+190"}
   "ppx_derivers" {= "1.2.1"}
-  "ppx_diff" {= "v0.18~preview.130.83+317"}
-  "ppx_disable_unused_warnings" {= "v0.18~preview.130.83+317"}
-  "ppx_enumerate" {= "v0.18~preview.130.83+317"}
-  "ppx_expect" {= "v0.18~preview.130.83+317"}
-  "ppx_fields_conv" {= "v0.18~preview.130.83+317"}
-  "ppx_fixed_literal" {= "v0.18~preview.130.83+317"}
-  "ppx_fuelproof" {= "v0.18~preview.130.83+317"}
-  "ppx_globalize" {= "v0.18~preview.130.83+317"}
-  "ppx_hash" {= "v0.18~preview.130.83+317"}
-  "ppx_helpers" {= "v0.18~preview.130.83+317"}
-  "ppx_here" {= "v0.18~preview.130.83+317"}
-  "ppx_ignore_instrumentation" {= "v0.18~preview.130.83+317"}
-  "ppx_inline_test" {= "v0.18~preview.130.83+317"}
-  "ppx_int63_literal" {= "v0.18~preview.130.83+317"}
-  "ppx_jane" {= "v0.18~preview.130.83+317"}
-  "ppx_js_style" {= "v0.18~preview.130.83+317"}
-  "ppx_let" {= "v0.18~preview.130.83+317"}
-  "ppx_log" {= "v0.18~preview.130.83+317"}
-  "ppx_module_timer" {= "v0.18~preview.130.83+317"}
-  "ppx_optcomp" {= "v0.18~preview.130.83+317"}
-  "ppx_optional" {= "v0.18~preview.130.83+317"}
-  "ppx_pipebang" {= "v0.18~preview.130.83+317"}
-  "ppx_portable" {= "v0.18~preview.130.83+317"}
-  "ppx_sexp_conv" {= "v0.18~preview.130.83+317"}
-  "ppx_sexp_message" {= "v0.18~preview.130.83+317"}
-  "ppx_sexp_value" {= "v0.18~preview.130.83+317"}
-  "ppx_shorthand" {= "v0.18~preview.130.83+317"}
-  "ppx_stable" {= "v0.18~preview.130.83+317"}
-  "ppx_stable_witness" {= "v0.18~preview.130.83+317"}
-  "ppx_string" {= "v0.18~preview.130.83+317"}
-  "ppx_string_conv" {= "v0.18~preview.130.83+317"}
-  "ppx_template" {= "v0.18~preview.130.83+317"}
-  "ppx_tydi" {= "v0.18~preview.130.83+317"}
-  "ppx_typed_fields" {= "v0.18~preview.130.83+317"}
-  "ppx_typerep_conv" {= "v0.18~preview.130.83+317"}
-  "ppx_var_name" {= "v0.18~preview.130.83+317"}
-  "ppx_variants_conv" {= "v0.18~preview.130.83+317"}
-  "ppxlib" {= "0.33.0+ox"}
-  "ppxlib_ast" {= "0.33.0+ox"}
-  "ppxlib_jane" {= "v0.18~preview.130.83+317"}
-  "protocol_version_header" {= "v0.18~preview.130.83+317"}
+  "ppx_diff" {= "v0.18~preview.130.91+190"}
+  "ppx_disable_unused_warnings" {= "v0.18~preview.130.91+190"}
+  "ppx_enumerate" {= "v0.18~preview.130.91+190"}
+  "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"}
+  "ppx_helpers" {= "v0.18~preview.130.91+190"}
+  "ppx_here" {= "v0.18~preview.130.91+190"}
+  "ppx_ignore_instrumentation" {= "v0.18~preview.130.91+190"}
+  "ppx_inline_test" {= "v0.18~preview.130.91+190"}
+  "ppx_int63_literal" {= "v0.18~preview.130.91+190"}
+  "ppx_jane" {= "v0.18~preview.130.91+190"}
+  "ppx_js_style" {= "v0.18~preview.130.91+190"}
+  "ppx_let" {= "v0.18~preview.130.91+190"}
+  "ppx_log" {= "v0.18~preview.130.91+190"}
+  "ppx_module_timer" {= "v0.18~preview.130.91+190"}
+  "ppx_optcomp" {= "v0.18~preview.130.91+190"}
+  "ppx_optional" {= "v0.18~preview.130.91+190"}
+  "ppx_pipebang" {= "v0.18~preview.130.91+190"}
+  "ppx_portable" {= "v0.18~preview.130.91+190"}
+  "ppx_sexp_conv" {= "v0.18~preview.130.91+190"}
+  "ppx_sexp_message" {= "v0.18~preview.130.91+190"}
+  "ppx_sexp_value" {= "v0.18~preview.130.91+190"}
+  "ppx_shorthand" {= "v0.18~preview.130.91+190"}
+  "ppx_stable" {= "v0.18~preview.130.91+190"}
+  "ppx_stable_witness" {= "v0.18~preview.130.91+190"}
+  "ppx_string" {= "v0.18~preview.130.91+190"}
+  "ppx_string_conv" {= "v0.18~preview.130.91+190"}
+  "ppx_template" {= "v0.18~preview.130.91+190"}
+  "ppx_tydi" {= "v0.18~preview.130.91+190"}
+  "ppx_typed_fields" {= "v0.18~preview.130.91+190"}
+  "ppx_typerep_conv" {= "v0.18~preview.130.91+190"}
+  "ppx_var_name" {= "v0.18~preview.130.91+190"}
+  "ppx_variants_conv" {= "v0.18~preview.130.91+190"}
+  "ppxlib" {= "0.33.0+ox1"}
+  "ppxlib_ast" {= "0.33.0+ox1"}
+  "ppxlib_jane" {= "v0.18~preview.130.91+190"}
+  "protocol_version_header" {= "v0.18~preview.130.91+190"}
   "ptime" {= "1.2.0"}
   "re" {= "1.14.0+ox"}
-  "record_builder" {= "v0.18~preview.130.83+317"}
+  "record_builder" {= "v0.18~preview.130.91+190"}
   "result" {= "1.5"}
   "seq" {= "base"}
-  "sexp_pretty" {= "v0.18~preview.130.83+317"}
-  "sexp_type" {= "v0.18~preview.130.83+317"}
-  "sexplib" {= "v0.18~preview.130.83+317"}
-  "sexplib0" {= "v0.18~preview.130.83+317"}
-  "shell" {= "v0.18~preview.130.83+317"}
+  "sexp_pretty" {= "v0.18~preview.130.91+190"}
+  "sexp_type" {= "v0.18~preview.130.91+190"}
+  "sexplib" {= "v0.18~preview.130.91+190"}
+  "sexplib0" {= "v0.18~preview.130.91+190"}
+  "shell" {= "v0.18~preview.130.91+190"}
   "spawn" {= "v0.15.1+ox"}
-  "splittable_random" {= "v0.18~preview.130.83+317"}
-  "stdio" {= "v0.18~preview.130.83+317"}
+  "splittable_random" {= "v0.18~preview.130.91+190"}
+  "stdio" {= "v0.18~preview.130.91+190"}
   "stdlib-shims" {= "0.3.0"}
-  "string_dict" {= "v0.18~preview.130.83+317"}
+  "string_dict" {= "v0.18~preview.130.91+190"}
   "stringext" {= "1.6.0"}
-  "textutils" {= "v0.18~preview.130.83+317"}
-  "time_now" {= "v0.18~preview.130.83+317"}
-  "topkg" {= "1.0.8+ox"}
-  "typerep" {= "v0.18~preview.130.83+317"}
-  "unique" {= "v0.18~preview.130.83+317"}
-  "univ_map" {= "v0.18~preview.130.83+317"}
-  "uopt" {= "v0.18~preview.130.83+317"}
+  "textutils" {= "v0.18~preview.130.91+190"}
+  "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"}
   "uri" {= "4.4.0"}
   "uri-sexp" {= "4.4.0"}
-  "uucp" {= "16.0.0" & with-test}
-  "uuseg" {= "16.0.0" & with-test}
-  "uutf" {= "1.0.3+ox"}
-  "variantslib" {= "v0.18~preview.130.83+317"}
-  "zstandard" {= "v0.18~preview.130.83+317"}
+  "uucp" {= "17.0.0"}
+  "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"
-pin-depends: [
-  "dune.3.21.1"
-  "https://github.com/ocaml/dune/releases/download/3.21.1/dune-3.21.1.tbz"
-]
diff --git a/src/dune b/src/dune
index f6976b52a..ee9979877 100644
--- a/src/dune
+++ b/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)))
diff --git a/src/env_vars.ml b/src/env_vars.ml
index 5be6eb7d5..e87055b7e 100644
--- a/src/env_vars.ml
+++ b/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")
diff --git a/src/env_vars.mli b/src/env_vars.mli
index 79121a98b..2df1e1213 100644
--- a/src/env_vars.mli
+++ b/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
diff --git a/src/event.ml b/src/event.ml
index 24694485c..a0ed5778e 100644
--- a/src/event.ml
+++ b/src/event.ml
@@ -25,29 +25,39 @@ 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
     }
   [@@deriving sexp, fields, bin_io]
 
   module Ignore_symbol = struct
     (* Ignoring symbol strings when serializing to save space. This reduces the size of events file
        by ~50% based on small tests. The symbol information is still available implicitly by looking at the top
-       of the callstack that optionally is exported together with the events. Symbol offset will be missing.*)
+       of the callstack that optionally is exported together with the events. Symbol offset will be missing. *)
 
     type nonrec t = t
 
     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 = Interned_string.empty
+      }
     ;;
 
     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 = Interned_string.empty
+      }
     ;;
 
     let caller_identity =
@@ -60,7 +70,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 = Interned_string.empty }
+  ;;
+
   let unknown = locationless Unknown
   let untraced = locationless Untraced
   let returned = locationless Returned
@@ -83,6 +96,10 @@ module Ok = struct
           ; count : int
           ; name : Collection_mode.Event.Name.t
           }
+      | Ptwrite of
+          { location : Location.t
+          ; data : string
+          }
     [@@deriving sexp, bin_io]
   end
 
diff --git a/src/event.mli b/src/event.mli
index 929854d07..a621837ed 100644
--- a/src/event.mli
+++ b/src/event.mli
@@ -28,6 +28,7 @@ module Location : sig
     { instruction_pointer : int64
     ; symbol : Symbol.t
     ; symbol_offset : int
+    ; dso : Interned_string.t
     }
   [@@deriving sexp, fields, bin_io]
 
@@ -55,6 +56,10 @@ module Ok : sig
           ; count : int
           ; name : Collection_mode.Event.Name.t
           } (** Represents counter based events collected through sampling. *)
+      | Ptwrite of
+          { location : Location.t
+          ; data : string
+          } (** Represents ptwrite events collected through Intel PT using PTWRITE. *)
     [@@deriving sexp]
   end
 
diff --git a/src/for_range.ml b/src/for_range.ml
index 1ac527726..b0c212e9b 100644
--- a/src/for_range.ml
+++ b/src/for_range.ml
@@ -25,7 +25,10 @@ let range_hit_times ~decode_events ~range_symbols =
     let is_start symbol = String.(Symbol.display_name symbol = start_symbol) in
     let is_stop symbol = String.(Symbol.display_name symbol = stop_symbol) in
     Pipe.filter_map events ~f:(function
-      | Error _ | Ok { data = Power _; _ } | Ok { data = Event_sample _; _ } -> None
+      | Error _
+      | Ok { data = Power _; _ }
+      | Ok { data = Event_sample _; _ }
+      | Ok { data = Ptwrite _; _ } -> None
       | Ok { data = Trace trace; time; _ } ->
         (match trace.kind with
          | Some Call ->
@@ -93,6 +96,7 @@ let decode_events_and_annotate ~decode_events ~range_symbols =
                | Ok { data = Power _; _ }
                | Ok { data = Stacktrace_sample _; _ }
                | Ok { data = Event_sample _; _ }
+               | Ok { data = Ptwrite _; _ }
                | Error _ -> hits, in_filtered_region)
           in
           ( (hits, in_filtered_region)
diff --git a/src/interned_string.ml b/src/interned_string.ml
new file mode 100644
index 000000000..4bb8b33b1
--- /dev/null
+++ b/src/interned_string.ml
@@ -0,0 +1,23 @@
+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 empty = ""
+let cache = String.Hash_set.of_list [ empty ]
+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
diff --git a/src/interned_string.mli b/src/interned_string.mli
new file mode 100644
index 000000000..3f04df3ff
--- /dev/null
+++ b/src/interned_string.mli
@@ -0,0 +1,6 @@
+open! Core
+
+type t = private string [@@deriving equal, hash, compare, sexp, bin_io]
+
+val intern : string -> t
+val empty : t
diff --git a/src/llvm_symbolizer_stubs.cpp b/src/llvm_symbolizer_stubs.cpp
new file mode 100644
index 000000000..d98942933
--- /dev/null
+++ b/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);
+}
+}
diff --git a/src/new_trace_writer.ml b/src/new_trace_writer.ml
new file mode 100644
index 000000000..f9c330f9c
--- /dev/null
+++ b/src/new_trace_writer.ml
@@ -0,0 +1,1038 @@
+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
+   compensate, the trace writer subtracts the time of the first event from all time spans, producing
+   what we call a "mapped time". Only mapped times may be written to the trace file. *)
+module Mapped_time : sig
+  type t = private Time_ns.Span.t [@@deriving sexp, compare, bin_io]
+
+  include Comparable with type t := t
+
+  val start_of_trace : t
+  val create : Time_ns.Span.t -> base_time:Time_ns.Span.t -> t
+  val is_base_time : t -> bool
+  val add : t -> Time_ns.Span.t -> t
+  val diff : t -> t -> Time_ns.Span.t
+end = struct
+  module T = struct
+    type t = Time_ns.Span.t [@@deriving sexp, compare, bin_io]
+  end
+
+  let start_of_trace = Time_ns.Span.zero
+  let create t ~base_time = Time_ns.Span.( - ) t base_time
+  let is_base_time = Time_ns.Span.( = ) Time_ns.Span.zero
+  let add = Time_ns.Span.( + )
+  let diff = Time_ns.Span.( - )
+
+  include T
+  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; dso = _ } =
+      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 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
+    ; callstack : Callstack_compression.compression_event
+    }
+  [@@deriving sexp, bin_io]
+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
+        (* 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_fiber_id t fiber_id =
+    let #(trace_segment, ~in_filtered_region:_) = Nonempty_vec.last t.trace_segments in
+    Trace_segment.set_fiber_id trace_segment fiber_id
+  ;;
+
+  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)
+    ~fiber_stacks
+    =
+    let new_trace_segment =
+      match kind with
+      | Independent ->
+        let ocaml_exception_info =
+          match t.ocaml_exception_state with
+          | Without_exception_info _ -> None
+          | With_exception_info { ocaml_exception_info; _ } -> Some ocaml_exception_info
+        in
+        Trace_segment.create ocaml_exception_info fiber_stacks
+      | 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
+
+module type Trace = Trace_writer_intf.S_trace
+
+type 'thread inner =
+  { debug_info : Elf.Addr_table.t
+  ; ocaml_exception_info : Ocaml_exception_info.t option
+  ; thread_info : 'thread Thread_info.t Hashtbl.M(Event.Thread).t
+  ; base_time : Time_ns.Span.t
+  ; trace_scope : Trace_scope.t
+  ; trace : (module Trace with type thread = 'thread)
+  ; annotate_inferred_start_times : bool
+  ; mutable in_filtered_region : bool
+  ; mutable transaction_events : Event.With_write_info.t Deque.t
+  ; pending_flows : ('thread -> Time_ns.Span.t -> unit) Hashtbl.M(Int).t
+  ; fiber_stacks : Trace_segment.Fiber.t Hashtbl.M(Int).t
+  }
+
+type t = T : 'thread inner -> t
+
+let sexp_of_inner inner =
+  [%sexp_of: _ Thread_info.t Hashtbl.M(Event.Thread).t] inner.thread_info
+;;
+
+let sexp_of_t (T inner) = sexp_of_inner inner
+
+let allocate_pid (type thread) (t : thread inner) ~name : int =
+  let module T = (val t.trace) in
+  T.allocate_pid ~name
+;;
+
+let allocate_thread (type thread) (t : thread inner) ~pid ~name : thread =
+  let module T = (val t.trace) in
+  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)
+  ~args
+  ~thread
+  ~name
+  ~(time : Mapped_time.t)
+  ~(time_end : Mapped_time.t)
+  : unit
+  =
+  let module T = (val t.trace) in
+  if t.in_filtered_region
+  then
+    T.write_duration_complete
+      ~args
+      ~thread
+      ~name
+      ~time:(time :> Time_ns.Span.t)
+      ~time_end:(time_end :> Time_ns.Span.t)
+;;
+
+let write_duration_instant
+  (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_instant ~args ~thread ~name ~time:(time :> Time_ns.Span.t)
+;;
+
+let write_counter
+  (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_counter ~args ~thread ~name ~time:(time :> Time_ns.Span.t)
+;;
+
+let map_time t time = Mapped_time.create time ~base_time:t.base_time
+
+let write_hits (T t) hits =
+  if not (List.is_empty hits)
+  then (
+    let pid = allocate_pid t ~name:"Snapshot symbol hits" in
+    let thread = allocate_thread t ~pid ~name:"hits" in
+    List.iter hits ~f:(fun (sym, (hit : Breakpoint.Hit.t)) ->
+      let is_default_symbol = String.( = ) sym Magic_trace.Private.stop_symbol in
+      let name = [%string "hit %{sym}"] in
+      let time = map_time t hit.timestamp in
+      let args =
+        Tracing.Trace.Arg.
+          [ "timestamp", Int (Time_ns.Span.to_int_ns hit.timestamp)
+          ; "tid", Int (Pid.to_int hit.tid)
+          ; "ip", Pointer hit.ip
+          ]
+      in
+      (* Args that are computed from captured registers are only meaningful on our
+         special stop symbol, we still capture them regardless, but on other symbols
+         they'll just have confusing broken values. *)
+      let args =
+        if is_default_symbol
+        then
+          Tracing.Trace.Arg.
+            [ "timestamp_passed", Int (Time_ns.Span.to_int_ns hit.passed_timestamp)
+            ; "arg", Int hit.passed_val
+            ]
+          @ args
+        else args
+      in
+      (* For the special symbol, if present the passed timestamp comes from
+         Magic_trace.mark_start and marks the start of a region of interest.
+
+         We check it for validity since it's possible someone uses an older version of
+         [Magic_trace.take_snapshot] and that should at least produce a valid trace. *)
+      let valid_timestamp =
+        Time_ns.Span.(
+          hit.passed_timestamp > t.base_time && hit.passed_timestamp < hit.timestamp)
+      in
+      let start =
+        if is_default_symbol && valid_timestamp
+        then map_time t hit.passed_timestamp
+        else time
+      in
+      write_duration_complete t ~thread ~args ~name ~time:start ~time_end:time))
+;;
+
+let create_expert
+  ~trace_scope
+  ~debug_info
+  ~ocaml_exception_info
+  ~earliest_time
+  ~hits
+  ~annotate_inferred_start_times
+  trace
+  =
+  let base_time =
+    List.fold hits ~init:earliest_time ~f:(fun acc (_, (hit : Breakpoint.Hit.t)) ->
+      Time_ns.Span.min acc hit.timestamp)
+  in
+  let t =
+    T
+      { debug_info = Option.value debug_info ~default:(Int.Table.create ())
+      ; ocaml_exception_info
+      ; thread_info = Hashtbl.create (module Event.Thread)
+      ; base_time
+      ; trace_scope
+      ; trace
+      ; annotate_inferred_start_times
+      ; in_filtered_region = true
+      ; transaction_events = Deque.create ()
+      ; pending_flows = Hashtbl.create (module Int)
+      ; fiber_stacks = Hashtbl.create (module Int)
+      }
+  in
+  write_hits t hits;
+  t
+;;
+
+let create
+  ~trace_scope
+  ~debug_info
+  ~ocaml_exception_info
+  ~earliest_time
+  ~hits
+  ~annotate_inferred_start_times
+  trace
+  =
+  create_expert
+    ~trace_scope
+    ~debug_info
+    ~ocaml_exception_info
+    ~earliest_time
+    ~hits
+    ~annotate_inferred_start_times
+    (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 -> "?"
+  | Some pid -> Pid.to_string pid
+;;
+
+(* A practical, but not perfect, fix for #155: If events happen with the exact same timestamp
+   as a decode error, stacks break. We implement this "#155 hack" to prevent that:
+
+   If an event happens at exactly the same time as the previous decode error, slide it forward
+   by one nanosecond. Maintain the invariant that no event which follows a decode error has the
+   same timestamp as that decode error.
+
+   This should have minimal impact on the timestamps displayed to the user, they're precise to at
+   most ~40ns anyhow. But it does make sure our stacks always come out in the right order.
+
+   Also worth noting is that despite the fact that we're changing timestamps, this can't reorder
+   events. 1ns is the minimum amount of time by which timestamps can differ. So even if there were
+   more events exactly 1ns after the decode error, they'll be seen as having the exact same
+   timestamp as the events that happened during the decode error. *)
+let hack_155 (thread_info : _ Thread_info.t) time =
+  let last_decode_error_time = thread_info.last_decode_error_time in
+  if Mapped_time.( = ) time last_decode_error_time
+     && Mapped_time.( <> ) last_decode_error_time Mapped_time.start_of_trace
+  then Mapped_time.add time (Time_ns.Span.of_int_ns 1)
+  else time
+;;
+
+let event_time t (event : Event.t) (thread_info : _ Thread_info.t) =
+  let event_time = Event.time event in
+  let unadjusted_time =
+    match%optional.Time_ns_unix.Span.Option event_time with
+    | None ->
+      (* Decode errors sometimes do not have a timestamp, so we pretend they happen at the
+         same time as the last event. *)
+      thread_info.last_event_time
+    | Some time ->
+      let time = map_time t time in
+      thread_info.last_event_time <- time;
+      time
+  in
+  hack_155 thread_info unadjusted_time
+;;
+
+let create_thread t event =
+  let thread = Event.thread event in
+  let effective_time =
+    match%optional.Time_ns_unix.Span.Option Event.time event with
+    | None -> Mapped_time.start_of_trace
+    | Some time -> map_time t time
+  in
+  let pid = opt_pid_to_string thread.pid in
+  let tid = opt_pid_to_string thread.tid in
+  let default_name =
+    if String.(pid = tid)
+    then [%string "[pid=%{pid}]"]
+    else [%string "[pid=%{pid}] [tid=%{tid}]"]
+  in
+  let name =
+    match thread.pid with
+    | None -> default_name
+    | Some pid ->
+      (match Process_info.cmdline_of_pid pid with
+       | None -> default_name
+       | Some cmdline ->
+         let concat_cmdline = String.concat ~sep:" " cmdline in
+         let name = [%string "%{concat_cmdline} %{default_name}"] in
+         if String.length name > Tracing_zero.Writer.max_interned_string_length
+         then default_name
+         else name)
+  in
+  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 ()
+  ; 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 t.fiber_stacks
+         , ~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 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 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
+            t.debug_info
+            ~enter_initial_callstack:true
+            ~exit_final_callstack:true))
+;;
+
+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;
+    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
+    | None -> ())
+;;
+
+let finalize t =
+  end_of_trace t;
+  let (T t) = t in
+  write_trace_segments t
+;;
+
+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 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 =
+  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;
+      Thread_info.start_new_trace_segment
+        thread_info
+        ~in_filtered_region:true
+        ~kind:Continuing_from_current
+        ~fiber_stacks:t.fiber_stacks);
+    t.in_filtered_region <- true;
+    Hashtbl.iter t.thread_info ~f:(fun thread_info ->
+      rewrite_all_callstacks t ~thread_info ~time))
+;;
+
+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;
+    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
+        ~fiber_stacks:t.fiber_stacks))
+;;
+
+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 event_and_callstack =
+    Event_and_callstack.{ event; callstack = compression_event }
+  in
+  match events_writer.format with
+  | Sexp ->
+    Async.Writer.write_sexp
+      ~terminate_with:Newline
+      events_writer.writer
+      [%sexp (event_and_callstack : Event_and_callstack.t)]
+  | Binio ->
+    Async.Writer.write_bin_prot
+      events_writer.writer
+      Event_and_callstack.bin_writer_t
+      event_and_callstack
+;;
+
+let warn_decode_error ~instruction_pointer ~message =
+  eprintf
+    "Warning: perf reported an error decoding the trace: %s\n%!"
+    (match instruction_pointer with
+     | None -> [%string "'%{message}'"]
+     | Some instruction_pointer ->
+       [%string "'%{message}' @ IP %{instruction_pointer#Int64.Hex}."])
+;;
+
+(* Write perf_events into a file as a Fuchsia trace (stack events). Events should be
+   collected with --itrace=bep or cre, and -F pid,tid,time,flags,addr,sym,symoff as per
+   the constants defined above. *)
+let rec write_event (T t) ?events_writer original_event =
+  if Env_vars.skip_transaction_handling
+  then write_event' (T t) ?events_writer original_event
+  else (
+    let { Event.With_write_info.event; should_write = _ } = original_event in
+    (* 1. If this event is within a transaction, queue it.
+       2. If this event ends a transaction, deliver all queued events (then deliver it)
+       3. If this event is a transaction abort, clear all queued events and discard
+       the [Tx_abort]. *)
+    match event with
+    | Ok { Event.Ok.thread = _; time = _; data; in_transaction } ->
+      let is_abort =
+        match data with
+        | Trace { kind = Some Tx_abort; _ } -> true
+        | _ -> false
+      in
+      if is_abort
+      then (
+        Deque.clear t.transaction_events;
+        write_event' (T t) ?events_writer original_event)
+      else if in_transaction
+      then Deque.enqueue_back t.transaction_events original_event
+      else (
+        if not (Deque.is_empty t.transaction_events)
+        then (
+          Deque.iter' t.transaction_events `front_to_back ~f:(fun ev ->
+            write_event' (T t) ?events_writer ev);
+          Deque.clear t.transaction_events);
+        write_event' (T t) ?events_writer original_event)
+    | Error _ ->
+      (* Unsure how to best handle errors during a transaction. *)
+      if not (Deque.is_empty t.transaction_events)
+      then (
+        eprintf
+          "Warning: error received during transaction, dropping all transaction events\n\
+           %!";
+        Deque.clear t.transaction_events);
+      write_event' (T t) ?events_writer original_event)
+
+and write_event' (T t) ?events_writer event =
+  let { Event.With_write_info.event; should_write } = event in
+  let thread = Event.thread event in
+  let thread_info =
+    Hashtbl.find_or_add t.thread_info thread ~default:(fun () -> create_thread t event)
+  in
+  let thread = thread_info.thread in
+  let time = event_time t event thread_info in
+  let outer_event = event in
+  maybe_start_filtered_region t ~should_write ~time;
+  maybe_stop_filtered_region t ~should_write;
+  match event with
+  | Error { thread = _; instruction_pointer; message; time = _ } ->
+    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;
+    Thread_info.start_new_trace_segment
+      thread_info
+      ~in_filtered_region:t.in_filtered_region
+      ~kind:Independent
+      ~fiber_stacks:t.fiber_stacks
+  | 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);
+    (match event_value with
+     | { Event.Ok.thread = _
+       ; time = _
+       ; data = Event_sample { location; count; name }
+       ; in_transaction = _
+       } ->
+       let track_name = Collection_mode.Event.Name.to_string name in
+       let track_thread =
+         Hashtbl.find_or_add thread_info.extra_event_tracks name ~default:(fun () ->
+           allocate_thread t ~pid:thread_info.track_group_id ~name:track_name)
+       in
+       let args =
+         Tracing.Trace.Arg.(
+           List.concat
+             [ [ "timestamp", Int (Time_ns.Span.to_int_ns (time :> Time_ns.Span.t)) ]
+             ; [ "symbol", String (Symbol.display_name location.symbol) ]
+             ; [ "addr", Pointer location.instruction_pointer ]
+             ; [ "count", Int count ]
+             ; Option.value_map
+                 (Event.thread outer_event).pid
+                 ~f:(fun pid -> [ "pid", Int (Pid.to_int pid) ])
+                 ~default:[]
+             ; Option.value_map
+                 (Event.thread outer_event).tid
+                 ~f:(fun tid -> [ "tid", Int (Pid.to_int tid) ])
+                 ~default:[]
+             ])
+       in
+       write_duration_complete
+         t
+         ~thread:track_thread
+         ~args
+         ~name:track_name
+         ~time
+         ~time_end:time
+     | { 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 = Power { freq }
+       ; in_transaction = _
+       } ->
+       write_counter
+         t
+         ~thread
+         ~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 = _
+       ; time = _
+       ; data = Trace { kind = _; trace_state_change = _; src = _; dst = _ }
+       ; 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
+         event_value.data
+         (time :> Time_ns.Span.t)
+     | { Event.Ok.thread = _ (* Already used this to look up thread info. *)
+       ; time = _
+       ; data = Ptwrite { location; data }
+       ; in_transaction = _
+       } ->
+       let symbol_name = Symbol.display_name location.symbol in
+       let is_perform = String.equal symbol_name "caml_perform" in
+       let is_resume = String.equal symbol_name "caml_resume" in
+       if is_perform || is_resume
+       then (
+         let fiber_id = Int64.to_int_trunc (Int64.of_string data) in
+         Thread_info.set_fiber_id thread_info fiber_id;
+         let name = if is_perform then "Perform Effect" else "Resume Continuation" in
+         let args = Tracing.Trace.Arg.[ "fiber", String (sprintf "0x%x" fiber_id) ] in
+         write_duration_complete t ~thread ~args ~name ~time ~time_end:time;
+         if is_perform
+         then (
+           let module T = (val t.trace) in
+           let flow = T.create_flow () in
+           T.write_flow_step flow ~thread ~time:(time :> Time_ns.Span.t);
+           Hashtbl.set t.pending_flows ~key:fiber_id ~data:(fun thread time ->
+             T.write_flow_step flow ~thread ~time;
+             T.finish_flow flow))
+         else (
+           match Hashtbl.find_and_remove t.pending_flows fiber_id with
+           | Some finish -> finish thread (time :> Time_ns.Span.t)
+           | None -> ()))
+       else (
+         let args =
+           Tracing.Trace.Arg.(
+             List.concat
+               [ [ "timestamp", Int (Time_ns.Span.to_int_ns (time :> Time_ns.Span.t)) ]
+               ; [ "symbol", String symbol_name ]
+               ; [ "addr", Pointer location.instruction_pointer ]
+               ; [ "data", String data ]
+               ; Option.value_map
+                   (Event.thread outer_event).pid
+                   ~f:(fun pid -> [ "pid", Int (Pid.to_int pid) ])
+                   ~default:[]
+               ; Option.value_map
+                   (Event.thread outer_event).tid
+                   ~f:(fun tid -> [ "tid", Int (Pid.to_int tid) ])
+                   ~default:[]
+               ])
+         in
+         write_duration_complete t ~thread ~args ~name:"PTWRITE" ~time ~time_end:time))
+;;
diff --git a/src/new_trace_writer.mli b/src/new_trace_writer.mli
new file mode 100644
index 000000000..bd0e8fb1e
--- /dev/null
+++ b/src/new_trace_writer.mli
@@ -0,0 +1,2 @@
+open! Core
+include Trace_writer_implementation_intf.S
diff --git a/src/nonempty_vec.ml b/src/nonempty_vec.ml
new file mode 100644
index 000000000..f41c6b7c2
--- /dev/null
+++ b/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]
diff --git a/src/nonempty_vec.mli b/src/nonempty_vec.mli
new file mode 100644
index 000000000..259c3ebb5
--- /dev/null
+++ b/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]
diff --git a/src/ocaml_exception_info.mli b/src/ocaml_exception_info.mli
index a8867fc70..61df58658 100644
--- a/src/ocaml_exception_info.mli
+++ b/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
diff --git a/src/perf_capabilities.ml b/src/perf_capabilities.ml
index 2597d756b..7141fa6ec 100644
--- a/src/perf_capabilities.ml
+++ b/src/perf_capabilities.ml
@@ -9,6 +9,7 @@ let snapshot_on_exit = bit 3
 let last_branch_record = bit 4
 let dlfilter = bit 5
 let ctlfd = bit 6
+let ptwrite = bit 7
 
 include Flags.Make (struct
     let allow_intersecting = false
@@ -22,6 +23,7 @@ include Flags.Make (struct
       ; last_branch_record, "last_branch_record"
       ; dlfilter, "dlfilter"
       ; ctlfd, "ctlfd"
+      ; ptwrite, "ptwrite"
       ]
     ;;
   end)
@@ -58,6 +60,18 @@ let supports_configurable_psb_period () =
   | Sys_error _ -> false
 ;;
 
+let supports_ptwrite () =
+  try
+    let ptwrite_cap =
+      In_channel.read_all "/sys/bus/event_source/devices/intel_pt/caps/ptwrite"
+    in
+    String.( = ) ptwrite_cap "1\n"
+  with
+  (* Even if this file is not present (i.e. when Intel PT isn't present), we
+     don't want capability checking to fail. *)
+  | Sys_error _ -> false
+;;
+
 (* This checks if pdcm flag is present in /proc/cpuinfo. This is necessary for
    LBR to work. Although I couldn't ascertain that it is also sufficient.
    However it seems unlikely this would fail on most machines. *)
@@ -113,6 +127,7 @@ let detect_exn () =
   let set_if bool flag cap = cap + if bool then flag else empty in
   empty
   |> set_if (supports_configurable_psb_period ()) configurable_psb_period
+  |> set_if (supports_ptwrite ()) ptwrite
   |> set_if (supports_tracing_kernel ()) kernel_tracing
   |> set_if (supports_kcore version) kcore
   |> set_if (supports_snapshot_on_exit version) snapshot_on_exit
diff --git a/src/perf_capabilities.mli b/src/perf_capabilities.mli
index 3c55ac4f9..9b253123e 100644
--- a/src/perf_capabilities.mli
+++ b/src/perf_capabilities.mli
@@ -12,4 +12,5 @@ val snapshot_on_exit : t
 val last_branch_record : t
 val dlfilter : t
 val ctlfd : t
+val ptwrite : t
 val detect_exn : unit -> t Deferred.t
diff --git a/src/perf_decode.ml b/src/perf_decode.ml
index 433932039..27b6129ac 100644
--- a/src/perf_decode.ml
+++ b/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
 ;;
 
@@ -29,13 +29,22 @@ let perf_cbr_event_re =
   Re.Perl.re {|^ *([a-z )(]*)? +cbr: +([0-9]+ +freq: +([0-9]+) MHz)?(.*)$|} |> Re.compile
 ;;
 
+let perf_ptwrite_event_re =
+  Re.Perl.re
+    {|^ *(call|return|tr strt|syscall|sysret|hw int|iret|int|tx abrt|tr end|tr strt tr end|tr end  (?:async|call|return|syscall|sysret|iret)|jmp|jcc)? +IP: +([0-9a-f]+) +payload: +((?:0x)?[0-9a-f]+) (.*) ([0-9]+) +([0-9a-f]+) (.*)$|}
+  |> Re.compile
+;;
+
 let trace_error_re =
   Re.Posix.re
     {|^ instruction trace error type [0-9]+ (time ([0-9]+)\.([0-9]+) )?cpu [\-0-9]+ pid ([\-0-9]+) tid ([\-0-9]+) ip (0x[0-9a-fA-F]+|0) code [0-9]+: (.*)$|}
   |> 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 =
@@ -44,7 +53,15 @@ type header =
       { thread : Event.Thread.t
       ; time : Time_ns.Span.t
       ; period : int
-      ; event : [ `Branches | `Cbr | `Psb | `Cycles | `Branch_misses | `Cache_misses ]
+      ; event :
+          [ `Branches
+          | `Cbr
+          | `Psb
+          | `Cycles
+          | `Branch_misses
+          | `Cache_misses
+          | `Ptwrite
+          ]
       ; remaining_line : string
       }
 
@@ -96,6 +113,7 @@ let parse_event_header line =
         | "cycles" -> `Cycles
         | "branch-misses" -> `Branch_misses
         | "cache-misses" -> `Cache_misses
+        | "ptwrite" -> `Ptwrite
         | _ ->
           raise_s
             [%message
@@ -109,9 +127,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)
+  =
+  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 +145,18 @@ 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, dso)
   | _ | (exception _) ->
-    let failed = Symbol.Unknown, 0 in
+    let failed = #(Symbol.Unknown, 0, Interned_string.empty) in
     (match perf_maps, pid with
      | None, _ | _, None ->
        (match Re.Group.all (Re.exec unknown_symbol_dso_re str) with
         | [| _; dso |] ->
           (* 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})]"]
+           , 0
+           , Interned_string.intern dso )
         | _ | (exception _) -> failed)
      | Some perf_map, Some pid ->
        (match Perf_map.Table.symbol ~pid perf_map ~addr with
@@ -142,7 +165,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, Interned_string.empty)))
 ;;
 
 let trace_error_to_event line : Event.Decode_error.t =
@@ -182,10 +205,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 +245,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 +317,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
@@ -334,6 +363,33 @@ let parse_perf_extra_sampled_event
     }
 ;;
 
+let parse_perf_ptwrite_event ?perf_maps (thread : Event.Thread.t) time line : Event.t =
+  match Re.Group.all (Re.exec perf_ptwrite_event_re line) with
+  | [| _
+     ; _branch_kind
+     ; _fup_ip
+     ; payload
+     ; _payload_ascii
+     ; _unknown
+     ; instruction_pointer
+     ; symbol_and_offset
+    |] ->
+    let location =
+      parse_location ?perf_maps ~pid:thread.pid instruction_pointer symbol_and_offset
+    in
+    Ok
+      { thread
+      ; time
+      ; data = Ptwrite { location; data = payload }
+      ; in_transaction = false
+      }
+  | results ->
+    raise_s
+      [%message
+        "Regex of perf ptwrite event did not match expected fields"
+          (results : string array)]
+;;
+
 let to_event ?perf_maps lines : Event.t option =
   try
     match lines with
@@ -370,7 +426,9 @@ let to_event ?perf_maps lines : Event.t option =
                  period
                  remaining_line
                  lines
-                 Cache_misses)))
+                 Cache_misses)
+          | `Ptwrite ->
+            Some (parse_perf_ptwrite_event ?perf_maps thread time remaining_line)))
   with
   | exn ->
     raise_s
@@ -740,6 +798,61 @@ module%test _ = struct
             (Trace (trace_state_change End) (kind Async) (src 0x7f6fce0b71f4)
              (dst 0x0)))))) |}]
   ;;
+
+  let%expect_test "perf ptwrite event" =
+    check
+      {| 2769074/2769293 2592496.569782106:          1                                        ptwrite:   call                   IP: 0 payload: 0x1b5                            0     55c7952ad2d0 [unknown] (foo.bin)|};
+    [%expect
+      {|
+      ((Ok
+        ((thread ((pid (2769074)) (tid (2769293)))) (time 30d8m16.569782106s)
+         (data (Ptwrite (location 0x55c7952ad2d0) (data 0x1b5))))))
+      |}]
+  ;;
+
+  let%expect_test "perf ptwrite event with printable payload" =
+    check
+      {|2817453/2817483 2596547.813541321:          1                                        ptwrite:   call                   IP: 0 payload: 0x62 b                           0     613d946b42d0 [unknown] (foo.bin)|};
+    [%expect
+      {|
+      ((Ok
+        ((thread ((pid (2817453)) (tid (2817483)))) (time 30d1h15m47.813541321s)
+         (data (Ptwrite (location 0x613d946b42d0) (data 0x62))))))
+      |}]
+  ;;
+
+  let%expect_test "perf ptwrite event with jcc instruction" =
+    check
+      {|3256341/3256760 2632746.069047397:          1                                        ptwrite:   jcc                    IP: 0 payload: 0x5000000000061b2                 0     577bcad80555 [unknown] (foo.bin)|};
+    [%expect
+      {|
+      ((Ok
+        ((thread ((pid (3256341)) (tid (3256760)))) (time 30d11h19m6.069047397s)
+         (data (Ptwrite (location 0x577bcad80555) (data 0x5000000000061b2))))))
+      |}]
+  ;;
+
+  let%expect_test "perf ptwrite event without instruction" =
+    check
+      {|3285832/3286108 2634666.172476558:          1                                        ptwrite:                          IP: 0 payload: 0xa00000000000000                 0     64d20fb10432 [unknown] (foo.bin)|};
+    [%expect
+      {|
+      ((Ok
+        ((thread ((pid (3285832)) (tid (3286108)))) (time 30d11h51m6.172476558s)
+         (data (Ptwrite (location 0x64d20fb10432) (data 0xa00000000000000))))))
+      |}]
+  ;;
+
+  let%expect_test "perf ptwrite event zero payload" =
+    check
+      {|997136/997136  340026.788189283:          1                                        ptwrite:   jcc                    IP: 0 payload: 0                 0     64d20fb10432 [unknown] (foo.bin)|};
+    [%expect
+      {|
+      ((Ok
+        ((thread ((pid (997136)) (tid (997136)))) (time 3d22h27m6.788189283s)
+         (data (Ptwrite (location 0x64d20fb10432) (data 0))))))
+      |}]
+  ;;
 end
 
 module For_testing = struct
diff --git a/src/perf_tool_backend.ml b/src/perf_tool_backend.ml
index 68470a870..d2617afae 100644
--- a/src/perf_tool_backend.ml
+++ b/src/perf_tool_backend.ml
@@ -246,29 +246,41 @@ module Recording = struct
         Timer_resolution.Low
       | _, _ -> timer_resolution
     in
-    match timer_resolution with
-    | Low -> Or_error.return ""
-    | Normal -> Or_error.return "cyc=1,cyc_thresh=1,mtc_period=0"
-    | High -> Or_error.return "cyc=1,cyc_thresh=1,mtc_period=0,noretcomp=1"
-    | Sample _ ->
-      Or_error.error_string
-        "[-timer-resolution Sample] can only be used in sampling mode. (Did you forget \
-         [-sampling]?)"
-    | Custom { cyc; cyc_thresh; mtc; mtc_period; noretcomp; psb_period } ->
-      let make_config key = function
-        | None -> None
-        | Some value -> Some [%string "%{key}=%{value#Int}"]
-      in
-      [ make_config "cyc" (Option.map ~f:Bool.to_int cyc)
-      ; make_config "cyc_thresh" cyc_thresh
-      ; make_config "mtc" (Option.map ~f:Bool.to_int mtc)
-      ; make_config "mtc_period" mtc_period
-      ; make_config "noretcomp" (Option.map ~f:Bool.to_int noretcomp)
-      ; make_config "psb_period" psb_period
-      ]
-      |> List.filter_opt
-      |> String.concat ~sep:","
-      |> Or_error.return
+    let ptw =
+      if Perf_capabilities.(do_intersect capabilities ptwrite) then "ptw" else ""
+    in
+    (* If ptwrite is not supported, we don't need to add it to the config string. *)
+    let config =
+      match timer_resolution with
+      | Low -> Or_error.return ""
+      | Normal -> Or_error.return "cyc=1,cyc_thresh=1,mtc_period=0"
+      | High -> Or_error.return "cyc=1,cyc_thresh=1,mtc_period=0,noretcomp=1"
+      | Sample _ ->
+        Or_error.error_string
+          "[-timer-resolution Sample] can only be used in sampling mode. (Did you forget \
+           [-sampling]?)"
+      | Custom { cyc; cyc_thresh; mtc; mtc_period; noretcomp; psb_period } ->
+        let make_config key = function
+          | None -> None
+          | Some value -> Some [%string "%{key}=%{value#Int}"]
+        in
+        [ make_config "cyc" (Option.map ~f:Bool.to_int cyc)
+        ; make_config "cyc_thresh" cyc_thresh
+        ; make_config "mtc" (Option.map ~f:Bool.to_int mtc)
+        ; make_config "mtc_period" mtc_period
+        ; make_config "noretcomp" (Option.map ~f:Bool.to_int noretcomp)
+        ; make_config "psb_period" psb_period
+        ]
+        |> List.filter_opt
+        |> String.concat ~sep:","
+        |> Or_error.return
+    in
+    match config with
+    | Ok config ->
+      if String.is_empty config
+      then Or_error.return [%string "%{ptw}"]
+      else Or_error.return [%string "%{config},%{ptw}"]
+    | Error _ as e -> e
   ;;
 
   let perf_cycles_config_of_timer_resolution (timer_resolution : Timer_resolution.t) =
@@ -606,7 +618,7 @@ let decode_events
     Deferred.List.map files ~how:`Sequential ~f:(fun perf_data_file ->
       let itrace_opts =
         match collection_mode with
-        | Intel_processor_trace _ -> [ "--itrace=bep" ]
+        | Intel_processor_trace _ -> [ "--itrace=bepw" ]
         | Stacktrace_sampling _ -> []
       in
       let fields_opts =
diff --git a/src/real_trace.ml b/src/real_trace.ml
index 09801ca5d..ba3015c10 100644
--- a/src/real_trace.ml
+++ b/src/real_trace.ml
@@ -12,6 +12,16 @@ let create (trace : Tracing.Trace.t) =
     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:""
+
+    type flow = Tracing.Flow.t
+
+    let create_flow () = Tracing.Trace.create_flow trace
+
+    let write_flow_step flow ~thread ~time =
+      Tracing.Trace.write_flow_step trace flow ~thread ~time
+    ;;
+
+    let finish_flow flow = Tracing.Trace.finish_flow trace flow
   end
   in
   (module T : S_trace with type thread = Tracing.Trace.Thread.t)
diff --git a/src/slice.ml b/src/slice.ml
new file mode 100644
index 000000000..a5653900e
--- /dev/null
+++ b/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
+;;
diff --git a/src/slice.mli b/src/slice.mli
new file mode 100644
index 000000000..871372538
--- /dev/null
+++ b/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
diff --git a/src/symbolizer.ml b/src/symbolizer.ml
new file mode 100644
index 000000000..ce963c1ce
--- /dev/null
+++ b/src/symbolizer.ml
@@ -0,0 +1,101 @@
+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 display_name { demangled_name } = demangled_name ^ " (inlined)"
+
+  let to_location t : 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 (display_name t)
+    ; symbol_offset = 0
+    ; instruction_pointer = 0L
+    ; dso = Interned_string.empty
+    }
+  ;;
+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 =
+  let addr = I64.of_int64 addr in
+  (* LLVM can't symbolize things in the Kernel; 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]
+;;
diff --git a/src/symbolizer.mli b/src/symbolizer.mli
new file mode 100644
index 000000000..e003b5ad9
--- /dev/null
+++ b/src/symbolizer.mli
@@ -0,0 +1,57 @@
+open! Core
+
+module Info : sig
+  type t = private { demangled_name : string }
+  [@@unboxed] [@@deriving equal, compare, hash, sexp_of]
+
+  val display_name : t -> string
+
+  (** 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
+  -> addr:Int64.t @ local
+  -> Response.t or_null
diff --git a/src/timestamp.ml b/src/timestamp.ml
new file mode 100644
index 000000000..ed711d584
--- /dev/null
+++ b/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.( >= )
diff --git a/src/timestamp.mli b/src/timestamp.mli
new file mode 100644
index 000000000..0a9400574
--- /dev/null
+++ b/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
diff --git a/src/trace.ml b/src/trace.ml
index 042ac22b8..397a2515d 100644
--- a/src/trace.ml
+++ b/src/trace.ml
@@ -84,6 +84,12 @@ module Null_writer : Trace_writer_intf.S_trace = struct
   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 = ()
+
+  type flow = unit
+
+  let create_flow () = ()
+  let write_flow_step () ~thread:_ ~time:_ = ()
+  let finish_flow () = ()
 end
 
 let write_trace_from_events
@@ -122,6 +128,11 @@ 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) =
+    if Env_vars.use_new_trace_writer
+    then (module New_trace_writer)
+    else (module Trace_writer)
+  in
   let writer =
     match trace with
     | Some trace ->
@@ -170,7 +181,10 @@ let write_trace_from_events
          | None -> Trace_writer.end_of_trace writer
          | Some to_time -> Trace_writer.end_of_trace ~to_time writer);
         last_index := index
-      | Ok { data = Event_sample _; _ } | Ok { data = Power _; _ } | Error _ -> ());
+      | Ok { data = Event_sample _; _ }
+      | Ok { data = Ptwrite _; _ }
+      | Ok { data = Power _; _ }
+      | Error _ -> ());
     Trace_writer.write_event writer ?events_writer ev
   in
   let%bind () =
@@ -180,7 +194,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
 ;;
@@ -772,7 +786,8 @@ module Make_commands (Backend : Backend_intf.S) = struct
            (optional (Arg_type.comma_separated Filename_unix.arg_type))
            ~doc:"FILE for JITs, path to a perf map file, in /tmp/perf-PID.map"
        and collection_mode = Collection_mode.param
-       and debug_print_perf_commands in
+       and debug_print_perf_commands
+       and trace_filter = Trace_filter.param in
        fun () ->
          (* Doesn't use create_elf because there's no need to check that the binary has symbols if
             we're trying to snapshot it. *)
@@ -783,8 +798,12 @@ module Make_commands (Backend : Backend_intf.S) = struct
            | Some files ->
              Perf_map.Table.load_by_files files |> Deferred.map ~f:Option.some
          in
+         let%bind.Deferred.Or_error range_symbols =
+           evaluate_trace_filter ~trace_filter ~elf
+         in
          decode_to_trace
            ?perf_maps
+           ?range_symbols
            ~elf
            ~trace_scope
            ~debug_print_perf_commands
diff --git a/src/trace_segment.ml b/src/trace_segment.ml
new file mode 100644
index 000000000..3e067e168
--- /dev/null
+++ b/src/trace_segment.ml
@@ -0,0 +1,1764 @@
+open! Core
+open Unboxed
+module Location = Event.Location
+module Nonempty_vec = Nonempty_vec.Valuex3
+
+let debug = false
+
+module Frame : sig
+  module Kind : sig
+    type t =
+      | Physical
+      (** A physical stack frame, attributable directly to information given to us by
+          [perf] in an [Event.t]. *)
+      | Inlined (** An inlined function call, known to us solely via debug-info. *)
+  end
+
+  (* The [location], [parent], and [kind] fields are actually **immutable** except for on [Sentinel.t] instances. *)
+  type t =
+    { mutable location : Event.Location.t
+    ; mutable parent : t or_null
+    ; mutable kind : Kind.t
+    ; (* TODO Make this an [i64] *)
+      mutable instruction_pointer : int64
+    }
+
+  val create : Location.t -> parent:t -> kind:Kind.t -> t
+  val set_instruction_pointer : t -> int64 -> unit
+
+  (** Find the first [Physical] frame whose [location.symbol] matches the provided
+      argument.
+
+      Returns the matching frame (if found) along with:
+      - [distance]: the number of frames between the frame provided as an argument, and
+        the returned frame (e.g. a call to [find my_frame my_symbol] with a return value
+        of [#(This _, ~distance:0, ..)] indicates that [my_frame.location.symbol] is
+        [my_symbol]).
+      - [physical_distance]: like [distance] but only counting [kind = Physical] frames.
+      - [leaf_of_inlined_stack]: the leaf of the stack of [kind = Inlined] frames attached
+        to the returned frame (which is always physical), along with its distance from the
+        frame provided as an argument. *)
+  val find
+    :  t
+    -> Symbol.t
+    -> #(t or_null
+        * distance:int
+        * physical_distance:int
+        * leaf_of_inlined_stack:#(t or_null * int))
+
+  (** Iterate from leaf-to-root up to the given number of frames, or until encountering
+      the [Sentinel.t]. *)
+  val iter_n : t -> int -> f:local_ (t -> unit) -> unit
+
+  (** Like [iter_n], this iterates from **leaf-to-root**. The "rev" here signifies that
+      the callback [f] is invoked in the reverse order of iteration (i.e. root-to-leaf).
+      Note that this is *not* tail-recursive, given that frames form a singly-linked list
+      from leaf-to-root. *)
+  val iter_n_rev : t -> int -> f:local_ (t -> unit) -> unit
+
+  (* If you're still confused between [iter_n] and [iter_n_rev], here's a small example:
+
+      {v
+            ┌────────┬────────┐
+     root:  │  fn1   │  Null  │
+            └────────┴────────┘
+                         ▲
+                         │
+            ┌────────┬────────┐
+            │  fn2   │        │
+            └────────┴────────┘
+                         ▲
+                         │
+            ┌────────┬────────┐
+            │  fn3   │        │
+            └────────┴────────┘
+                         ▲
+                         │
+            ┌────────┬────────┐
+            │  fn4   │        │
+            └────────┴────────┘
+                         ▲
+                         │
+            ┌────────┬────────┐
+     leaf:  │  fn5   │        │
+            └────────┴────────┘
+      v}
+
+      {[
+        Frame.iter_n leaf 3 ~f:(fun frame -> printf "%s; " (Symbol.display_name frame.location.symbol));
+        > fn5; fn4; fn3
+        Frame.iter_n_rev leaf 3 ~f:(fun frame -> printf "%s; " (Symbol.display_name frame.location.symbol));
+        > fn3; fn4; fn5
+      ]}
+  *)
+
+  val find_ancestor
+    :  t
+    -> ancestor:t
+    -> #(distance:int or_null * leaf_of_inlined_stack:#(t or_null * int))
+
+  (** Unlike the other functions, this *can* return a [Sentinel.t]. This is probably a bad
+      idea. *)
+  val find_first_physical : t -> #(t * distance:int)
+
+  val nth_ancestor_exn : t -> int -> t
+
+  module Sentinel : sig
+    type frame := t
+
+    (** The root of a callstack. A sentinel does not correspond to a real program
+        location, and its parent is always [Null]; it is the *only* frame allowed to have
+        a [Null] parent.
+
+        Using a sentinel allows us to avoid a variety of special-cases, and lets us update
+        the root of all callstacks in a trace in O(1) time. *)
+    type t = private frame
+
+    val create : unit -> t
+
+    (** Mutate [t]'s fields to the provided arguments and return [t] as a [frame]. *)
+    val become_frame : t -> Location.t -> parent:frame -> kind:Kind.t -> frame
+  end
+
+  module For_testing : sig
+    val to_string_list : t -> string list
+    val print_callstack : t -> unit
+  end
+end = struct
+  module Kind = struct
+    type t =
+      | Physical
+      | Inlined
+  end
+
+  type t =
+    { mutable location : Event.Location.t
+    ; mutable parent : t or_null
+    ; mutable kind : Kind.t
+    ; mutable instruction_pointer : int64
+    }
+
+  let create location ~parent ~kind =
+    { location
+    ; parent = This parent
+    ; kind
+    ; instruction_pointer = location.instruction_pointer
+    }
+  ;;
+
+  let[@inline always] set_instruction_pointer t instruction_pointer =
+    t.instruction_pointer <- instruction_pointer
+  ;;
+
+  let rec find t target ~distance ~physical_distance ~leaf_of_inlined_stack =
+    match t with
+    | { parent = Null; _ } ->
+      #(Null, ~distance, ~physical_distance, ~leaf_of_inlined_stack)
+    | { kind = Physical; location = { symbol; _ }; _ } when Symbol.equal symbol target ->
+      #(This t, ~distance, ~physical_distance, ~leaf_of_inlined_stack)
+    | { parent = This parent; kind = Physical; _ } ->
+      find
+        parent
+        target
+        ~distance:(distance + 1)
+        ~physical_distance:(physical_distance + 1)
+        ~leaf_of_inlined_stack:#(Null, distance)
+    | { parent = This parent; kind = Inlined; _ } ->
+      let leaf_of_inlined_stack =
+        match leaf_of_inlined_stack with
+        | #(Null, _) -> #(This t, distance)
+        | leaf_of_inlined_stack -> leaf_of_inlined_stack
+      in
+      find
+        parent
+        target
+        ~distance:(distance + 1)
+        ~physical_distance
+        ~leaf_of_inlined_stack
+  ;;
+
+  let find t target =
+    find t target ~distance:0 ~physical_distance:0 ~leaf_of_inlined_stack:#(Null, 0)
+  ;;
+
+  let rec iter_n t n ~f =
+    match t, n with
+    | { parent = Null; _ }, _ | _, 0 -> ()
+    | { parent = This parent; _ }, n ->
+      f t;
+      iter_n parent (n - 1) ~f
+  ;;
+
+  let rec iter_n_rev t n ~f =
+    match t, n with
+    | { parent = Null; _ }, _ | _, 0 -> ()
+    | { parent = This parent; _ }, n ->
+      iter_n_rev parent (n - 1) ~f;
+      f t
+  ;;
+
+  let rec find_ancestor t ~ancestor ~distance ~leaf_of_inlined_stack =
+    if phys_equal t ancestor
+    then #(~distance:(This distance), ~leaf_of_inlined_stack)
+    else (
+      match t with
+      | { parent = Null; _ } -> #(~distance:Null, ~leaf_of_inlined_stack:#(Null, distance))
+      | { parent = This parent; kind = Physical; _ } ->
+        find_ancestor
+          parent
+          ~ancestor
+          ~distance:(distance + 1)
+          ~leaf_of_inlined_stack:#(Null, distance)
+      | { parent = This parent; kind = Inlined; _ } ->
+        let leaf_of_inlined_stack =
+          match leaf_of_inlined_stack with
+          | #(Null, _) -> #(This t, distance)
+          | leaf_of_inlined_stack -> leaf_of_inlined_stack
+        in
+        find_ancestor parent ~ancestor ~distance:(distance + 1) ~leaf_of_inlined_stack)
+  ;;
+
+  let find_ancestor t ~ancestor =
+    find_ancestor t ~ancestor ~distance:0 ~leaf_of_inlined_stack:#(Null, 0)
+  ;;
+
+  let rec find_first_physical t ~distance =
+    match t with
+    | { kind = Physical; _ } -> #(t, ~distance)
+    | { parent = This parent; _ } -> find_first_physical parent ~distance:(distance + 1)
+    | { parent = Null; kind = Inlined; _ } ->
+      (* [Sentinel.t]s cannot have [kind = Inlined]. *)
+      assert false
+  ;;
+
+  let find_first_physical t = find_first_physical t ~distance:0
+
+  let nth_ancestor_exn t n =
+    let mutable t = t in
+    for _ = 1 to n do
+      t <- Or_null.value_exn t.parent
+    done;
+    t
+  ;;
+
+  module Sentinel = struct
+    type nonrec t = t
+
+    let sentinel_location : Location.t =
+      { instruction_pointer = 0L
+      ; symbol_offset = 0
+      ; (* For the sake of being defensive, we define a special symbol for the sentinel which is *impossible*
+           to confuse with a real symbol, because ELF symbol names are NULL-terminated strings.
+
+           See https://refspecs.linuxbase.org/elf/gabi4+/ch4.strtab.html *)
+        symbol = From_perf "\x00_"
+      ; dso = Interned_string.empty
+      }
+    ;;
+
+    let[@inline always] create () =
+      { location = sentinel_location
+      ; parent = Null
+      ; kind = Physical
+      ; instruction_pointer = 0L
+      }
+    ;;
+
+    let become_frame t location ~parent ~kind =
+      t.location <- location;
+      t.parent <- This parent;
+      t.kind <- kind;
+      t.instruction_pointer <- location.instruction_pointer;
+      t
+    ;;
+  end
+
+  module For_testing = struct
+    let rec to_string_list acc t =
+      match t.parent with
+      | Null -> acc
+      | This parent ->
+        let kind =
+          if not debug
+          then ""
+          else (
+            match t.kind with
+            | Physical -> " PHYSICAL"
+            | Inlined -> " INLINED")
+        in
+        to_string_list
+          ([%string "%{Symbol.display_name t.location.symbol}%{kind}"] :: acc)
+          parent
+    ;;
+
+    let to_string_list t = to_string_list [] t
+    let print_callstack leaf = to_string_list leaf |> String.concat_lines |> eprintf "%s"
+  end
+end
+
+module Control_flow = struct
+  type t =
+    | Call of { depth : int }
+    (** [depth] indicates how many new frames were introduced. *)
+    | Return of { distance : int }
+    (** [distance] indicates how many frames this return pops off of the callstack.
+        [distance = 1] is the usual case of returning from the current frame to its
+        parent. *)
+  [@@deriving sexp_of]
+end
+
+module Callstack = struct
+  type t =
+    #{ time : Timestamp.t
+     ; leaf : Frame.t
+     ; control_flow : Control_flow.t
+     }
+end
+
+module Fiber = struct
+  module Last_event = struct
+    type t =
+      | Perform
+      | Resume
+  end
+
+  type t =
+    { mutable last_event : Last_event.t
+    ; mutable handler : Frame.t
+    ; mutable callstack : Callstack.t
+    ; exception_handlers : Frame.t Vec.t
+    }
+end
+
+type t =
+  { mutable root : Frame.Sentinel.t
+  ; mutable last_event_time : Timestamp.t
+  (** Strictly speaking maintaining [last_event_time] is not necessary, but we do so in
+      order to make bugs obvious. *)
+  ; callstacks : Callstack.t Nonempty_vec.t
+  (** Our reconstruction of the program's control-flow based on the input event stream.
+      When appending new elements to [callstacks], it's **vitally important** to maintain
+      the following invariants in order for [callstacks] to be correctly processed during
+      [write_trace]:
+
+      1. A callstack with [control_flow = Call { depth }] introduces [depth] new frames
+         which were not present in the callstack immediately preceding it. These new
+         frames are the first [depth] frames starting from this callstack's [leaf].
+      2. A callstack with [control_flow = Return { distance }] **exits** [distance]
+         frames, starting from the [leaf] of the callstack immediately preceding it. *)
+  ; symbolizer : Symbolizer.t
+  ; ocaml_exception_info : Ocaml_exception_info.t or_null
+  ; exception_handlers : Frame.t Vec.t
+  ; effect_handlers : (Frame.t * exn_depth:int) Vec.t
+  ; fiber_stacks : Fiber.t Hashtbl.M(Int).t
+  ; mutable last_known_fiber_id : int or_null
+  (** The currently active OCaml exception handlers. This is used to determine which frame
+      to return to when [ocaml_exception_info] indicates that the current event is an
+      OCaml exception being raised in the traced program.
+
+      In contrast to [callstacks] — which records the entire history of control-flow for
+      later examination — [exception_handlers] represents the state **as of the event we
+      are currently processing**, and as such is only used during the "ingestion" phase
+      (i.e. while calls are still being made to [add_event]). *)
+  ; mutable last_known_location : Location.t
+  }
+
+let unknown_location : Location.t =
+  { symbol = Unknown
+  ; symbol_offset = 0
+  ; instruction_pointer = Int64.max_value
+  ; dso = Interned_string.empty
+  }
+;;
+
+let create ocaml_exception_info fiber_stacks =
+  let root = Frame.Sentinel.create () in
+  { root
+  ; last_event_time = Timestamp.zero
+  ; callstacks =
+      Nonempty_vec.create
+        (#{ time = Timestamp.zero
+          ; leaf = (root :> Frame.t)
+          ; control_flow = Return { distance = 0 }
+          }
+         : Callstack.t)
+  ; symbolizer = Symbolizer.create ()
+  ; ocaml_exception_info = Or_null.of_option ocaml_exception_info
+  ; exception_handlers = Vec.create ()
+  ; effect_handlers = Vec.create ()
+  ; fiber_stacks
+  ; last_known_fiber_id = Null
+  ; last_known_location = unknown_location
+  }
+;;
+
+let create_continuing_from existing =
+  let last_callstack = Nonempty_vec.last existing.callstacks in
+  { existing with
+    callstacks =
+      Nonempty_vec.create
+        (#{ last_callstack with control_flow = Return { distance = 0 } } : Callstack.t)
+  ; exception_handlers = Vec.copy existing.exception_handlers
+  ; effect_handlers = Vec.copy existing.effect_handlers
+  }
+;;
+
+let[@inline always] current_frame t = (Nonempty_vec.last t.callstacks).#leaf
+let[@inline always] current_physical_frame t = Frame.find_first_physical (current_frame t)
+
+let replace_root t location ~kind =
+  let new_sentinel = Frame.Sentinel.create () in
+  let root =
+    Frame.Sentinel.become_frame t.root location ~parent:(new_sentinel :> Frame.t) ~kind
+  in
+  t.root <- new_sentinel;
+  root
+;;
+
+let diff_inlined_frames'
+  (t : t)
+  time
+  ~dso:_
+  ~(before : Symbolizer.Info.t Slice.t)
+  ~(after : Symbolizer.Info.t Slice.t)
+  =
+  let length = Int.min (Slice.length before) (Slice.length after) in
+  let mutable first_different_index = 0 in
+  while
+    first_different_index < length
+    && Symbolizer.Info.equal
+         (Slice.unsafe_get before first_different_index)
+         (Slice.unsafe_get after first_different_index)
+  do
+    first_different_index <- first_different_index + 1
+  done;
+  let return_distance = Slice.length before - first_different_index in
+  if return_distance <> 0
+  then
+    Nonempty_vec.push_back
+      t.callstacks
+      #{ time
+       ; leaf = Frame.nth_ancestor_exn (current_frame t) return_distance
+       ; control_flow = Return { distance = return_distance }
+       };
+  let mutable parent = current_frame t in
+  for i = first_different_index to Slice.length after - 1 do
+    let inlined_frame_info = Slice.unsafe_get after i in
+    let inlined_frame =
+      Frame.create (Symbolizer.Info.to_location inlined_frame_info) ~parent ~kind:Inlined
+    in
+    parent <- inlined_frame
+  done;
+  let frames_created = Slice.length after - first_different_index in
+  if frames_created > 0
+  then
+    Nonempty_vec.push_back
+      t.callstacks
+      #{ time; leaf = parent; control_flow = Call { depth = frames_created } }
+;;
+
+let symbolize_inlined_frames t ~dso ~addr =
+  match Symbolizer.symbolize t.symbolizer ~executable:dso ~addr with
+  | Null -> Slice.empty
+  | This result -> Symbolizer.Response.inlined_frames result
+;;
+
+let diff_inlined_frames (t : t) time ~dso ~(before : int64) ~(after : int64) =
+  if Env_vars.check_invariants
+  then (
+    let #(current_physical_frame, ~distance:_) = current_physical_frame t in
+    [%test_eq: Interned_string.t] current_physical_frame.location.dso dso);
+  diff_inlined_frames'
+    t
+    time
+    ~dso
+    ~before:(symbolize_inlined_frames t ~dso ~addr:before)
+    ~after:(symbolize_inlined_frames t ~dso ~addr:after)
+;;
+
+let append_inlined_frames t time ~(physical_frame : Frame.t) ~physical_frame_is_new =
+  assert (phys_equal physical_frame.kind Physical);
+  match
+    Symbolizer.symbolize
+      t.symbolizer
+      ~executable:physical_frame.location.dso
+      ~addr:physical_frame.instruction_pointer
+  with
+  | Null ->
+    if physical_frame_is_new
+    then
+      Nonempty_vec.push_back
+        t.callstacks
+        #{ time; leaf = physical_frame; control_flow = Call { depth = 1 } }
+  | This response ->
+    let parent = stack_ (ref physical_frame) in
+    let inlined_frames = Symbolizer.Response.inlined_frames response in
+    Slice.iter inlined_frames ~f:(stack_ fun inlined_frame_info ->
+      let inlined_leaf_frame =
+        Frame.create
+          ~kind:Inlined
+          (Symbolizer.Info.to_location inlined_frame_info)
+          ~parent:!parent
+      in
+      parent := inlined_leaf_frame);
+    if physical_frame_is_new || Slice.length inlined_frames > 0
+    then
+      Nonempty_vec.push_back
+        t.callstacks
+        #{ time
+         ; leaf = !parent
+         ; control_flow =
+             Call
+               { depth = Bool.to_int physical_frame_is_new + Slice.length inlined_frames }
+         }
+;;
+
+(** This is intended to mark code we hope is *unreachable*, not merely uncommon. Hopefully
+    over time we can strengthen its callsites to assertions. *)
+let[@cold] log_unexpected_case ~(here : [%call_pos]) sexp =
+  eprintf
+    "Warning, unexpected case reached [%s:%d:%d]: %s\n"
+    here.pos_fname
+    here.pos_lnum
+    (here.pos_cnum - here.pos_bol)
+    (Sexp.to_string_mach sexp)
+;;
+
+(* [handle_call] uses [src], unlike the other event handlers. The rationale for this
+   is that in the context of a call, [src] is the parent frame of the call to [dst]
+   and thus *it continues to exist*. We want our callstacks to reflect that. *)
+(* TODO I think now that we have inlined frames the [src] reconciliation logic wouldn't
+   work because we run the "straightline-execution inline frames" logic in [add_event]
+   before we ever get here. *)
+let handle_call (t : t) (time : Timestamp.t) ~(src : Location.t) ~(dst : Location.t) =
+  (* First, reconcile things such that [src] matches [current_physical_frame t] if it doesn't
+     already. *)
+  let () =
+    match Frame.find (current_frame t) src.symbol with
+    | #(This _, ~physical_distance:0, ..) ->
+      (* The happy case, [src] matches [current_physical_frame t]. The inlined frames
+         should already be correct on account of the straightline-execution
+         inlined frames logic at the start of [add_event]. *)
+      ()
+    | #(Null, ~physical_distance:0, ..) ->
+      (* I would only ever expect this to occur at the very beginning of a trace. *)
+      let src_frame = Frame.create src ~parent:(t.root :> Frame.t) ~kind:Physical in
+      append_inlined_frames t time ~physical_frame:src_frame ~physical_frame_is_new:true
+    | #(This src_frame, ~physical_distance:_, ~distance, ~leaf_of_inlined_stack) ->
+      log_unexpected_case
+        [%message "call [src] exists, but is higher up the callstack." (src : Location.t)];
+      (match leaf_of_inlined_stack with
+       | #(Null, _) ->
+         Nonempty_vec.push_back
+           t.callstacks
+           #{ time; leaf = src_frame; control_flow = Return { distance } };
+         diff_inlined_frames
+           t
+           time
+           ~dso:src.dso
+           ~before:src_frame.instruction_pointer
+           ~after:src.instruction_pointer
+       | #(This inlined_leaf, inlined_leaf_distance) ->
+         Nonempty_vec.push_back
+           t.callstacks
+           #{ time
+            ; leaf = inlined_leaf
+            ; control_flow = Return { distance = inlined_leaf_distance }
+            };
+         diff_inlined_frames
+           t
+           time
+           ~dso:src.dso
+           ~before:src_frame.instruction_pointer
+           ~after:src.instruction_pointer)
+    | #(Null, ~physical_distance:_, ..) ->
+      log_unexpected_case
+        [%message "call [src] does not match known trace state." (src : Location.t)];
+      (* We've somehow reached [src] without seeing the control-flow that brought us here.
+
+         To maximize our chances of producing a coherent trace, we create a frame for
+         [src] as a child of the current frame. The idea here is that because we support
+         "long" [Return]s (i.e. [Return]s with [distance > 1]), inserting the additional
+         frame for [src] ( *in addition* to the frame we always create for [dst]) gives us
+         better odds of resynchronizing with the event stream, since now we can easily
+         handle a later return event to [src], [dst], or even both. *)
+      let src_frame = Frame.create src ~parent:(current_frame t) ~kind:Physical in
+      append_inlined_frames t time ~physical_frame:src_frame ~physical_frame_is_new:true
+  in
+  let #(src_frame, ~distance:_) = current_physical_frame t in
+  assert (not (Or_null.is_null src_frame.parent));
+  Frame.set_instruction_pointer src_frame src.instruction_pointer;
+  (* Then create the new frame for [dst]. *)
+  let dst_frame = Frame.create dst ~parent:(current_frame t) ~kind:Physical in
+  append_inlined_frames t time ~physical_frame:dst_frame ~physical_frame_is_new:true
+;;
+
+(** We are returning into something we did not see the call for. This can happen if
+    there's a series of calls like [fn1 -> fn2 -> fn3] and we started tracing during the
+    execution of [fn2], then we see a return into [fn1]. *)
+let return_to_unseen (t : t) (time : Timestamp.t) ~(dst : Location.t) ~(distance : int) =
+  (* We symbolize at one byte before the return address because the callstack we want to
+     see reflected as roots of the whole trace corresponds to the code as of the [call]
+     instruction we are returning from, *not* whatever comes immediately after it. *)
+  let addr = Int64.O.(dst.instruction_pointer - 1L) in
+  let inlined_frames = symbolize_inlined_frames t ~dso:dst.dso ~addr in
+  let mutable inlined_leaf = Null in
+  for i = Slice.length inlined_frames - 1 downto 0 do
+    let%tydi inlined_frame_info = Slice.unsafe_get inlined_frames i in
+    let inlined_frame =
+      replace_root t (Symbolizer.Info.to_location inlined_frame_info) ~kind:Inlined
+    in
+    if Or_null.is_null inlined_leaf then inlined_leaf <- This inlined_frame
+  done;
+  let (physical_root : Frame.t) =
+    replace_root t { dst with instruction_pointer = addr } ~kind:Physical
+  in
+  Nonempty_vec.push_back
+    t.callstacks
+    #{ time
+     ; leaf = Or_null.value inlined_leaf ~default:physical_root
+     ; control_flow = Return { distance }
+     };
+  diff_inlined_frames t time ~dso:dst.dso ~before:addr ~after:dst.instruction_pointer;
+  Frame.set_instruction_pointer physical_root dst.instruction_pointer
+;;
+
+let handle_return (t : t) (time : Timestamp.t) ~(dst : Location.t) =
+  match current_physical_frame t with
+  | #({ parent = Null; _ }, ~distance:_) -> return_to_unseen t time ~dst ~distance:0
+  | #({ parent = This parent_frame; _ }, ~distance:distance_to_current_frame) ->
+    (* We start our search for [dst] from the parent of the current physical frame because
+       otherwise you'd incorrectly handle non-tail recursion, and because returning to the
+       current frame is impossible anyway. We add 1 to the distance here to
+       account for the one extra frame implicitly traversed by doing this. *)
+    let distance_to_parent_frame = distance_to_current_frame + 1 in
+    (match Frame.find parent_frame dst.symbol with
+     | #(This dst_frame, ~distance, ~leaf_of_inlined_stack, ..) ->
+       (* 99% of the time [physical_distance] should be 0, indicating we are returning to
+          [parent_frame] as expected. We allow for the possibility of "long" returns to
+          account for [Sysret]/[Iret] events that return to userspace directly from deep
+          within their kernel/interrupt stack. *)
+       (match leaf_of_inlined_stack with
+        | #(Null, _) ->
+          Frame.set_instruction_pointer dst_frame dst.instruction_pointer;
+          Nonempty_vec.push_back
+            t.callstacks
+            #{ time
+             ; leaf = dst_frame
+             ; control_flow = Return { distance = distance + distance_to_parent_frame }
+             };
+          append_inlined_frames
+            t
+            time
+            ~physical_frame:dst_frame
+            ~physical_frame_is_new:false
+        | #(This inlined_leaf, inlined_leaf_distance) ->
+          Nonempty_vec.push_back
+            t.callstacks
+            #{ time
+             ; leaf = inlined_leaf
+             ; control_flow =
+                 Return { distance = inlined_leaf_distance + distance_to_parent_frame }
+             };
+          diff_inlined_frames
+            t
+            time
+            ~dso:dst.dso
+            ~before:dst_frame.instruction_pointer
+            ~after:dst.instruction_pointer;
+          Frame.set_instruction_pointer dst_frame dst.instruction_pointer)
+     | #(Null, ~physical_distance:0, ~distance, ..) ->
+       (* Our [parent_frame] is the sentinel. *)
+       return_to_unseen t time ~dst ~distance:(distance + distance_to_parent_frame)
+     | #(Null, ~physical_distance:_, ..) ->
+       log_unexpected_case
+         [%message
+           "return [dst] does not match known trace state."
+             (dst : Location.t)
+             (dst.symbol : Symbol.t)];
+       (* Something is probably wrong if we ever make it to this case, where the state
+          we're maintaining and the event we are processing seem to completely disagree.
+          Treating it like a tail-call seems like the least bad option, and at the very
+          least gets us to agree with the event stream that the current frame is [dst]. *)
+       Nonempty_vec.push_back
+         t.callstacks
+         #{ time
+          ; leaf = parent_frame
+          ; control_flow = Return { distance = distance_to_parent_frame }
+          };
+       let dst_frame = Frame.create dst ~parent:parent_frame ~kind:Physical in
+       append_inlined_frames t time ~physical_frame:dst_frame ~physical_frame_is_new:true)
+;;
+
+let handle_jump (t : t) (time : Timestamp.t) ~(src : Location.t) ~(dst : Location.t) =
+  let #(current_physical_frame, ~distance) = current_physical_frame t in
+  if Symbol.equal current_physical_frame.location.symbol dst.symbol
+  then (
+    (* [dst] matches [current_frame t]. This is either a branch within a function, or tail-recursion. *)
+    diff_inlined_frames
+      t
+      time
+      ~dso:dst.dso
+      ~before:src.instruction_pointer
+      ~after:dst.instruction_pointer;
+    Frame.set_instruction_pointer current_physical_frame dst.instruction_pointer)
+  else (
+    match current_physical_frame.parent with
+    | Null ->
+      (* This is probably a non-recursive tail-call, but we don't know anything
+         about the previous frame, so we treat this is a [Call] because we only
+         want to emit a frame-enter while writing out the trace. *)
+      let dst_frame = Frame.create dst ~parent:(t.root :> Frame.t) ~kind:Physical in
+      append_inlined_frames t time ~physical_frame:dst_frame ~physical_frame_is_new:true
+    | This parent ->
+      (* This is probably a non-recursive tail-call. *)
+      Nonempty_vec.push_back
+        t.callstacks
+        #{ time; leaf = parent; control_flow = Return { distance = distance + 1 } };
+      let dst_frame = Frame.create dst ~parent ~kind:Physical in
+      append_inlined_frames t time ~physical_frame:dst_frame ~physical_frame_is_new:true)
+;;
+
+let is_ocaml_exception_handler t ~(dst : Location.t) =
+  match t.ocaml_exception_info with
+  | Null -> false
+  | This ocaml_exception_info ->
+    (match Symbol.display_name dst.symbol, dst.symbol_offset with
+     | "caml_runstack", 0x13d -> true
+     | _ ->
+       Ocaml_exception_info.is_entertrap
+         ocaml_exception_info
+         ~addr:dst.instruction_pointer)
+;;
+
+let handle_ocaml_exception (t : t) (time : Timestamp.t) ~(dst : Location.t) =
+  match Vec.last t.exception_handlers with
+  | This dst_frame ->
+    Vec.pop_back_unit_exn t.exception_handlers;
+    if not (Symbol.equal dst_frame.location.symbol dst.symbol)
+    then
+      log_unexpected_case
+        [%message
+          "Mismatched handler and dst"
+            (dst_frame.location.symbol : Symbol.t)
+            (dst.instruction_pointer : Int64.Hex.t)
+            (dst.symbol : Symbol.t)];
+    (match Frame.find_ancestor (current_frame t) ~ancestor:dst_frame with
+     | #(~distance:(This distance), ~leaf_of_inlined_stack) ->
+       (* This is the happy case where our exception handler tracking is working as expected. *)
+       (match leaf_of_inlined_stack with
+        | #(Null, _) ->
+          Frame.set_instruction_pointer dst_frame dst.instruction_pointer;
+          Nonempty_vec.push_back
+            t.callstacks
+            #{ time; leaf = dst_frame; control_flow = Return { distance } };
+          append_inlined_frames
+            t
+            time
+            ~physical_frame:dst_frame
+            ~physical_frame_is_new:false
+        | #(This inlined_leaf, inlined_leaf_distance) ->
+          Nonempty_vec.push_back
+            t.callstacks
+            #{ time
+             ; leaf = inlined_leaf
+             ; control_flow = Return { distance = inlined_leaf_distance }
+             };
+          diff_inlined_frames
+            t
+            time
+            ~dso:dst.dso
+            ~before:dst_frame.instruction_pointer
+            ~after:dst.instruction_pointer;
+          Frame.set_instruction_pointer dst_frame dst.instruction_pointer)
+     | #(~distance:Null, ..) ->
+       let message =
+         match Frame.find (current_frame t) dst.symbol with
+         | #(Null, ..) -> "This is likely to be a bug."
+         | #(This _, ..) ->
+           "This is deeply concerning because another frame with a matching symbol was \
+            found. This is very likely to be a bug."
+       in
+       log_unexpected_case
+         [%message
+           [%string
+             "[exception_handlers] appears to be out-of-sync with [callstacks]; active \
+              exception handler was not found in [callstacks]. %{message}"]
+             (dst : Location.t)];
+       (* TODO Decide if maybe we should just raise in this case? The trace is probably going to be pretty broken if we make it here. *)
+       handle_return t time ~dst)
+  | Null ->
+    (match Frame.find (current_frame t) dst.symbol with
+     | #(Null, ~distance, ..) ->
+       (* We are probably raising into an exception handler much further up the stack that we never saw the entrance into. *)
+       let dst_frame = replace_root t dst ~kind:Physical in
+       Nonempty_vec.push_back
+         t.callstacks
+         #{ time; leaf = dst_frame; control_flow = Return { distance } };
+       (* Unlike [handle_return] we do *not* make the inlined frames at [dst] (or [dst.instruction_pointer - 1])
+          the parents of the existing frames. The rationale is that unlike [handle_return], we have no idea
+          where we might've been within the frame for [dst] that we just inferred. *)
+       append_inlined_frames
+         t
+         time
+         ~physical_frame:dst_frame
+           (* This is subtle; Yes the frame is new, but we *don't* want to reflect that in a
+              [Call], because discovered roots are handled separately. *)
+         ~physical_frame_is_new:false
+     | #(This dst_frame, ~distance, ~leaf_of_inlined_stack, ..) ->
+       log_unexpected_case
+         [%message
+           "[exception_handlers] appears to be out-of-sync with [callstacks]; there is \
+            no active exception handler, but a frame with a matching symbol was found."
+             (dst : Location.t)
+             (dst.symbol : Symbol.t)];
+       (match leaf_of_inlined_stack with
+        | #(Null, _) ->
+          Frame.set_instruction_pointer dst_frame dst.instruction_pointer;
+          Nonempty_vec.push_back
+            t.callstacks
+            #{ time; leaf = dst_frame; control_flow = Return { distance } };
+          append_inlined_frames
+            t
+            time
+            ~physical_frame:dst_frame
+            ~physical_frame_is_new:false
+        | #(This inlined_leaf, inlined_leaf_distance) ->
+          Nonempty_vec.push_back
+            t.callstacks
+            #{ time
+             ; leaf = inlined_leaf
+             ; control_flow = Return { distance = inlined_leaf_distance }
+             };
+          diff_inlined_frames
+            t
+            time
+            ~dso:dst.dso
+            ~before:dst_frame.instruction_pointer
+            ~after:dst.instruction_pointer;
+          Frame.set_instruction_pointer dst_frame dst.instruction_pointer))
+;;
+
+let set_fiber_id (t : t) fiber_id = t.last_known_fiber_id <- This fiber_id
+
+let current_fiber (t : t) ~time =
+  let fiber_id = Or_null.value ~default:0 t.last_known_fiber_id in
+  Hashtbl.find_or_add t.fiber_stacks fiber_id ~default:(fun () ->
+    { last_event = Resume
+    ; handler = current_frame t
+    ; callstack =
+        #{ time; leaf = current_frame t; control_flow = Return { distance = 0 } }
+    ; exception_handlers = Vec.create ()
+    })
+;;
+
+(* CR mslater: dedup *)
+let handle_ocaml_perform (t : t) (time : Timestamp.t) ~(dst : Location.t) =
+  (* CR mslater: test without ptwrites *)
+  let fiber = current_fiber t ~time in
+  fiber.last_event <- Perform;
+  match Vec.last t.effect_handlers with
+  | This (dst_frame, ~exn_depth) ->
+    fiber.handler <- dst_frame;
+    while Vec.length t.exception_handlers > exn_depth do
+      Vec.push_back fiber.exception_handlers (Vec.pop_back_exn t.exception_handlers)
+    done;
+    (* We expect the handler and dst to be different symbols. *)
+    (match Frame.find_ancestor (current_frame t) ~ancestor:dst_frame with
+     | #(~distance:(This distance), ~leaf_of_inlined_stack) ->
+       (* This is the happy case where our exception handler tracking is working as expected. *)
+       (match leaf_of_inlined_stack with
+        | #(Null, _) ->
+          (* CR mslater: other cases *)
+          fiber.callstack
+          <- #{ time; leaf = current_frame t; control_flow = Call { depth = distance } };
+          Frame.set_instruction_pointer dst_frame dst.instruction_pointer;
+          Nonempty_vec.push_back
+            t.callstacks
+            #{ time; leaf = dst_frame; control_flow = Return { distance } };
+          append_inlined_frames
+            t
+            time
+            ~physical_frame:dst_frame
+            ~physical_frame_is_new:false
+        | #(This inlined_leaf, inlined_leaf_distance) ->
+          Nonempty_vec.push_back
+            t.callstacks
+            #{ time
+             ; leaf = inlined_leaf
+             ; control_flow = Return { distance = inlined_leaf_distance }
+             };
+          diff_inlined_frames
+            t
+            time
+            ~dso:dst.dso
+            ~before:dst_frame.instruction_pointer
+            ~after:dst.instruction_pointer;
+          Frame.set_instruction_pointer dst_frame dst.instruction_pointer)
+     | #(~distance:Null, ..) ->
+       let message =
+         match Frame.find (current_frame t) dst.symbol with
+         | #(Null, ..) -> "This is likely to be a bug."
+         | #(This _, ..) ->
+           "This is deeply concerning because another frame with a matching symbol was \
+            found. This is very likely to be a bug."
+       in
+       log_unexpected_case
+         [%message
+           [%string
+             "[effect_handlers] appears to be out-of-sync with [callstacks]; active \
+              effect handler was not found in [callstacks]. %{message}"]
+             (dst : Location.t)];
+       (* TODO Decide if maybe we should just raise in this case? The trace is probably going to be pretty broken if we make it here. *)
+       handle_return t time ~dst)
+  | Null ->
+    (match Frame.find (current_frame t) dst.symbol with
+     | #(Null, ~distance, ..) ->
+       (* We are probably raising into an effect handler much further up the stack that we never saw the entrance into. *)
+       let dst_frame = replace_root t dst ~kind:Physical in
+       Nonempty_vec.push_back
+         t.callstacks
+         #{ time; leaf = dst_frame; control_flow = Return { distance } };
+       (* Unlike [handle_return] we do *not* make the inlined frames at [dst] (or [dst.instruction_pointer - 1])
+          the parents of the existing frames. The rationale is that unlike [handle_return], we have no idea
+          where we might've been within the frame for [dst] that we just inferred. *)
+       append_inlined_frames
+         t
+         time
+         ~physical_frame:dst_frame
+           (* This is subtle; Yes the frame is new, but we *don't* want to reflect that in a
+              [Call], because discovered roots are handled separately. *)
+         ~physical_frame_is_new:false
+     | #(This dst_frame, ~distance, ~leaf_of_inlined_stack, ..) ->
+       log_unexpected_case
+         [%message
+           "[effect_handlers] appears to be out-of-sync with [callstacks]; there is no \
+            active effect handler, but a frame with a matching symbol was found."
+             (dst : Location.t)];
+       (match leaf_of_inlined_stack with
+        | #(Null, _) ->
+          Frame.set_instruction_pointer dst_frame dst.instruction_pointer;
+          Nonempty_vec.push_back
+            t.callstacks
+            #{ time; leaf = dst_frame; control_flow = Return { distance } };
+          append_inlined_frames
+            t
+            time
+            ~physical_frame:dst_frame
+            ~physical_frame_is_new:false
+        | #(This inlined_leaf, inlined_leaf_distance) ->
+          Nonempty_vec.push_back
+            t.callstacks
+            #{ time
+             ; leaf = inlined_leaf
+             ; control_flow = Return { distance = inlined_leaf_distance }
+             };
+          diff_inlined_frames
+            t
+            time
+            ~dso:dst.dso
+            ~before:dst_frame.instruction_pointer
+            ~after:dst.instruction_pointer;
+          Frame.set_instruction_pointer dst_frame dst.instruction_pointer))
+;;
+
+let handle_ocaml_resume t time =
+  let fiber = current_fiber t ~time in
+  fiber.last_event <- Resume;
+  Vec.push_back
+    t.effect_handlers
+    (fiber.handler, ~exn_depth:(Vec.length t.exception_handlers));
+  while Vec.length fiber.exception_handlers > 0 do
+    Vec.push_back t.exception_handlers (Vec.pop_back_exn fiber.exception_handlers)
+  done;
+  Nonempty_vec.push_back
+    t.callstacks
+    #{ time
+     ; leaf = Or_null.value_exn (current_frame t).parent
+     ; control_flow = Return { distance = 1 }
+     };
+  let distance =
+    match Frame.find fiber.callstack.#leaf fiber.handler.location.symbol with
+    | #(This frame, ~distance, ~physical_distance:_, ~leaf_of_inlined_stack:_) ->
+      frame.parent <- This (current_frame t);
+      distance
+    | _ -> 0
+  in
+  fiber.callstack
+  <- #{ fiber.callstack with time; control_flow = Call { depth = distance + 1 } };
+  Nonempty_vec.push_back t.callstacks fiber.callstack
+;;
+
+let handle_ocaml_enter_runstack t ~current_physical_frame =
+  Vec.push_back
+    t.effect_handlers
+    (current_physical_frame, ~exn_depth:(Vec.length t.exception_handlers));
+  Vec.push_back t.exception_handlers current_physical_frame
+;;
+
+let handle_ocaml_exit_runstack t =
+  let _, ~exn_depth = Vec.pop_back_exn t.effect_handlers in
+  while Vec.length t.exception_handlers > exn_depth do
+    Vec.pop_back_unit_exn t.exception_handlers
+  done
+;;
+
+let[@cold] print (event : Event.Ok.Data.t) (time : Timestamp.t) =
+  match event with
+  | Trace { kind; src; dst; trace_state_change } ->
+    eprint_s
+      ~mach:()
+      [%message
+        (kind : Event.Kind.t option)
+          ~time:(Time_ns.Span.to_int_ns (time :> Time_ns.Span.t) % 10000000 : int)
+          ~src:(Symbol.display_name src.symbol)
+          ~src_ip:(src.instruction_pointer : Int64.Hex.t)
+          ~dst:(Symbol.display_name dst.symbol)
+          ~dst_ip:(dst.instruction_pointer : Int64.Hex.t)
+          (trace_state_change : Trace_state_change.t option)]
+  | _ -> ()
+;;
+
+let[@inline always] print (event : Event.Ok.Data.t) (time : Timestamp.t) =
+  if debug then print event time
+;;
+
+let add_event (t : t) (event : Event.Ok.Data.t) (time : Timestamp.t) =
+  print event time;
+  assert (Timestamp.( >= ) time t.last_event_time);
+  t.last_event_time <- time;
+  (match event with
+   | Trace { src; dst; _ } ->
+     if Interned_string.equal t.last_known_location.dso src.dso
+        && Int64.( <> ) t.last_known_location.instruction_pointer 0L
+        && Int64.( <> ) src.instruction_pointer 0L
+     then (
+       let mutable prev_inlined_frames =
+         symbolize_inlined_frames
+           t
+           ~dso:t.last_known_location.dso
+           ~addr:t.last_known_location.instruction_pointer
+       in
+       (* TODO I fear symbolizing at every byte like this is likely to be *very* expensive, but let's focus on just getting things working for now. *)
+       let mutable addr = I64.of_int64 t.last_known_location.instruction_pointer in
+       let src_addr = I64.of_int64 src.instruction_pointer in
+       (* There are no [i64] for-loops yet :( *)
+       while I64.O.(addr <= src_addr) do
+         let addr_inlined_frames =
+           symbolize_inlined_frames t ~dso:src.dso ~addr:(I64.box addr)
+         in
+         diff_inlined_frames'
+           t
+           time
+           ~dso:src.dso
+           ~before:prev_inlined_frames
+           ~after:addr_inlined_frames;
+         prev_inlined_frames <- addr_inlined_frames;
+         addr <- I64.O.(addr + #1L)
+       done);
+     let #(current_physical_frame, ~distance:_) = current_physical_frame t in
+     (match t.ocaml_exception_info with
+      | Null -> ()
+      | This ocaml_exception_info ->
+        Ocaml_exception_info.iter_pushtraps_and_poptraps_in_range
+          ocaml_exception_info
+          ~from:t.last_known_location.instruction_pointer
+          ~to_:src.instruction_pointer
+          ~f:(stack_ fun (_, kind) ->
+            match kind with
+            | Pushtrap -> Vec.push_back t.exception_handlers current_physical_frame
+            | Poptrap ->
+              (match Vec.last t.exception_handlers with
+               | This current_exception_handler
+                 when phys_equal current_exception_handler current_physical_frame ->
+                 Vec.pop_back_unit_exn t.exception_handlers
+               | Null ->
+                 (* Hitting this case a couple of times early in the trace is not unusual. *)
+                 ()
+               | This current_exception_handler ->
+                 log_unexpected_case
+                   [%message
+                     "[exception_handlers] appears to be out-of-sync with [callstacks]; \
+                      the active exception handler does not match the current physical \
+                      frame."
+                       ~current_exception_handler:
+                         (current_exception_handler.location : Location.t)
+                       ~current_physical_frame:
+                         (current_physical_frame.location : Location.t)]));
+        (match Symbol.display_name src.symbol, src.symbol_offset with
+         (* CR mslater: export these from the compiler *)
+         | "caml_runstack", 0xa9 -> handle_ocaml_enter_runstack t ~current_physical_frame
+         | "caml_runstack", 0x13b -> handle_ocaml_exit_runstack t
+         | "caml_perform", 0xb5 -> handle_ocaml_perform t time ~dst
+         | "caml_resume", 0xda -> handle_ocaml_resume t time
+         | _ -> ()));
+     t.last_known_location <- dst
+   | _ -> ());
+  (match event with
+   (* TODO Get the untraced "kind" right instead of always showing [Location.untraced] for untraced time. *)
+   | Trace { trace_state_change = Some Start; dst; _ } -> handle_return t time ~dst
+   | Trace { trace_state_change = Some End; src; dst = _; _ } ->
+     handle_call t time ~src ~dst:Location.untraced
+   | Trace { trace_state_change = None; kind = Some kind; src; dst } ->
+     (match kind with
+      | Call | Syscall | Hardware_interrupt | Interrupt -> handle_call t time ~src ~dst
+      | (Return | Jump) when is_ocaml_exception_handler t ~dst ->
+        handle_ocaml_exception t time ~dst
+      | Return | Sysret | Iret -> handle_return t time ~dst
+      | Jump | Tx_abort | Async -> handle_jump t time ~src ~dst)
+   | Trace { kind = None; _ } -> ()
+   (* All of the below events are handled in [new_trace_writer.ml]. *)
+   | Power _ | Stacktrace_sample _ | Event_sample _ | Ptwrite _ -> ());
+  if debug
+  then (
+    Frame.For_testing.print_callstack (current_frame t);
+    print_endline "-------------------------------");
+  if Env_vars.check_invariants
+  then (
+    let #(current_physical_frame, ~distance) = current_physical_frame t in
+    (* Maintaining [t.last_known_location] separately is a minor optimization so that
+       we don't have to walk from [current_frame t] to find the current physical frame
+       at the start of processing each event. The corollary is that updating the [instruction_pointer]
+       on the current physical frame on each event **is truly necessary**; maintaining *only*
+       [t.last_known_location] would be insufficient to accurately process traces.
+       In particular this comes up when handling returns (and by extension, exceptions),
+       where you need to know what the instruction-pointer was in the physical frame you
+       are returning to the last time the program was there, so that you can
+       [diff_inlined_frames] in order to return to *the correct inlined child* of that
+       physical frame. *)
+    [%test_eq: Int64.Hex.t]
+      ~message:
+        "Recorded [last_known_location] does not match the current physical frame after \
+         processing this event"
+      t.last_known_location.instruction_pointer
+      current_physical_frame.instruction_pointer;
+    let actual_inlined_frames = ref [] in
+    Frame.iter_n (current_frame t) distance ~f:(fun { location = { symbol; _ }; _ } ->
+      actual_inlined_frames := Symbol.display_name symbol :: !actual_inlined_frames);
+    let expected_inlined_frames =
+      symbolize_inlined_frames
+        t
+        ~dso:t.last_known_location.dso
+        ~addr:t.last_known_location.instruction_pointer
+      |> Slice.map_to_list ~f:(fun inlined_frame_info ->
+        Symbolizer.Info.display_name inlined_frame_info)
+    in
+    [%test_result: string list]
+      ~message:"Inlined frames in callstacks did not match expectation"
+      !actual_inlined_frames
+      ~expect:expected_inlined_frames)
+;;
+
+module Writer : sig
+  type 'thread t
+
+  val create
+    :  (module Trace_writer_intf.S_trace with type thread = 'thread)
+    -> 'thread
+    -> Elf.Addr_table.t
+    -> 'thread t @ local
+
+  val emit_frame_enter : 'thread t @ local -> Timestamp.t -> Frame.t -> unit
+  val emit_frame_exit : 'thread t @ local -> Timestamp.t -> Frame.t -> unit
+end = struct
+  type 'thread t =
+    { mutable last_time : Timestamp.t @@ global
+    ; active_frames : Symbol.t Vec.t @@ global
+    (** Strictly speaking maintaining [last_time] and [active_frames] is not necessary
+        assuming the rest of the code is written correctly, but not checking our
+        invariants makes it *much* harder to figure out where things go wrong, because you
+        would just end up with a mangled Perfetto trace but the [magic-trace] invocation
+        would complete silently and successfully. *)
+    ; write_duration_begin :
+        args:Tracing.Trace.Arg.t list -> name:string -> time:Time_ns.Span.t -> unit
+      @@ global
+    ; write_duration_end :
+        args:Tracing.Trace.Arg.t list -> name:string -> time:Time_ns.Span.t -> unit
+      @@ global
+    ; debug_info : Elf.Addr_table.t @@ global
+    }
+
+  let create
+    (type thread)
+    (trace : (module Trace_writer_intf.S_trace with type thread = thread))
+    (thread : thread)
+    debug_info
+    = exclave_
+    let module T = (val trace) in
+    stack_
+      { last_time = Timestamp.zero
+      ; active_frames = Vec.create ()
+      ; write_duration_begin =
+          (fun ~args ~name ~time -> T.write_duration_begin ~args ~thread ~name ~time)
+      ; write_duration_end =
+          (fun ~args ~name ~time -> T.write_duration_end ~args ~thread ~name ~time)
+      ; debug_info
+      }
+  ;;
+
+  let emit_frame_enter (local_ (t : _ t)) (time : Timestamp.t) (frame : Frame.t) =
+    let location = frame.location in
+    assert (Timestamp.( >= ) time t.last_time);
+    t.last_time <- time;
+    Vec.push_back t.active_frames location.symbol;
+    if debug then eprintf "Enter %s\n" (Symbol.display_name location.symbol);
+    (* TODO In the future we can surface more detailed information in [args]
+       (e.g. filename, line number, etc.) since LLVM can easily provide it to us,
+       but for now we omit it given that the traces are already huge. *)
+    let args : Tracing.Trace.Arg.t list =
+      match frame.kind with
+      | Inlined -> []
+      | Physical -> [ "address", Pointer location.instruction_pointer ]
+    in
+    t.write_duration_begin
+      ~args
+      ~name:(Symbol.display_name location.symbol)
+      ~time:(time :> Time_ns.Span.t)
+  ;;
+
+  let emit_frame_exit (t : _ t) (time : Timestamp.t) (frame : Frame.t) =
+    let location = frame.location in
+    assert (Timestamp.( >= ) time t.last_time);
+    t.last_time <- time;
+    (* [%test_result: Symbol.t] ~expect:(Vec.pop_back_exn t.active_frames) location.symbol; *)
+    if debug then eprintf "Exit %s\n" (Symbol.display_name location.symbol);
+    t.write_duration_end
+      ~args:[]
+      ~name:(Symbol.display_name location.symbol)
+      ~time:(time :> Time_ns.Span.t)
+  ;;
+end
+
+(* Intel PT may produce many events with the same timestamp due to resolution limitations.
+   To produce better visual traces, we "smear" time, evenly distributing time amongst runs
+   of consecutive events that all have the same timestamp. *)
+let smear_times (callstacks : Callstack.t Nonempty_vec.t) =
+  (* It would be reasonable to also have [Return]s 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[@inline always] consumes_time : Callstack.t -> bool = function
+    | #{ control_flow = Call _; _ } -> true
+    | _ -> false
+  in
+  let len = Nonempty_vec.length callstacks in
+  let mutable i = 0 in
+  while i < len do
+    let t1 = (Nonempty_vec.get callstacks i).#time in
+    (* Find the end of the run of events with the same timestamp *)
+    let mutable run_end = i in
+    let mutable num_time_consuming_events =
+      consumes_time (Nonempty_vec.get callstacks i) |> Bool.to_int
+    in
+    while
+      run_end + 1 < len
+      && Timestamp.equal (Nonempty_vec.get callstacks (run_end + 1)).#time t1
+    do
+      num_time_consuming_events
+      <- num_time_consuming_events
+         + (consumes_time (Nonempty_vec.get callstacks (run_end + 1)) |> Bool.to_int);
+      run_end <- run_end + 1
+    done;
+    num_time_consuming_events <- Int.max 1 num_time_consuming_events;
+    let run_length = run_end - i + 1 in
+    if run_end + 1 < len
+    then (
+      (* Smear times across this run *)
+      let t2 = (Nonempty_vec.get callstacks (run_end + 1)).#time in
+      let duration_ns =
+        Time_ns.Span.( - ) (t2 :> Time_ns.Span.t) (t1 :> Time_ns.Span.t)
+        |> Time_ns.Span.to_int_ns
+      in
+      let mutable time_consuming_events_seen = 0 in
+      for k = 0 to run_length - 1 do
+        let cs = Nonempty_vec.get callstacks (i + k) in
+        let offset_ns =
+          duration_ns * time_consuming_events_seen / num_time_consuming_events
+        in
+        let smeared_time =
+          Timestamp.create Time_ns.Span.((t1 :> Time_ns.Span.t) + of_int_ns offset_ns)
+        in
+        (* Rewriting the entire [Callstack.t] instead of modifying just the [time] field
+           in-place is sad, but I'm not sure the microoptimization is worth the hassle
+           it'd take to achieve it. *)
+        Nonempty_vec.set callstacks (i + k) #{ cs with time = smeared_time };
+        time_consuming_events_seen
+        <- time_consuming_events_seen + (consumes_time cs |> Bool.to_int)
+      done
+      (* else: final run - keep original times *));
+    i <- run_end + 1
+  done
+;;
+
+let write_trace
+  (type thread)
+  (t : t)
+  (trace : (module Trace_writer_intf.S_trace with type thread = thread))
+  (thread : thread)
+  debug_info
+  ~enter_initial_callstack
+  ~exit_final_callstack
+  =
+  let writer = Writer.create trace thread debug_info in
+  smear_times t.callstacks;
+  if enter_initial_callstack
+  then (
+    (* Call [emit_frame_enter] for everything in the initial callstack. This takes care of
+       entering any root frames that we discovered by returning into them (i.e. the places
+       where we call [replace_root]). *)
+    let%tydi #{ leaf; time; _ } = Nonempty_vec.first t.callstacks in
+    Frame.iter_n_rev leaf Int.max_value ~f:(stack_ fun frame ->
+      Writer.emit_frame_enter writer time frame));
+  Nonempty_vec.iter_pairs
+    t.callstacks
+    ~f:(stack_ fun (#(prev, curr) : #(Callstack.t * Callstack.t)) ->
+      let time = curr.#time in
+      match curr.#control_flow with
+      | Call { depth } ->
+        Frame.iter_n_rev curr.#leaf depth ~f:(stack_ fun frame ->
+          Writer.emit_frame_enter writer time frame)
+        [@nontail]
+      | Return { distance } ->
+        Frame.iter_n prev.#leaf distance ~f:(stack_ fun frame ->
+          Writer.emit_frame_exit writer time frame)
+        [@nontail]);
+  if exit_final_callstack
+  then (
+    (* Call [emit_frame_exit] for all remaining frames at the end of the segment. *)
+    let last_callstack = Nonempty_vec.last t.callstacks in
+    Frame.iter_n last_callstack.#leaf Int.max_value ~f:(stack_ fun frame ->
+      Writer.emit_frame_exit writer last_callstack.#time frame)
+    [@nontail])
+;;
+
+module%test _ = struct
+  (* Takes a string like "a-b-c-d-e" which describes a callstack in root-to-leaf order,
+     each letter being a function name. *)
+  let parse_frames string =
+    let root = Frame.Sentinel.create () in
+    let leaf =
+      String.split string ~on:'-'
+      |> List.fold
+           ~init:(root :> Frame.t)
+           ~f:(fun root leaf_name ->
+             Frame.create
+               Location.
+                 { symbol_offset = 0
+                 ; instruction_pointer = 0L
+                 ; symbol = From_perf leaf_name
+                 ; dso = Interned_string.empty
+                 }
+               ~parent:root
+               ~kind:Physical)
+    in
+    #(~root, ~leaf)
+  ;;
+
+  (* Throughout this test-suite, things are rendered vertically in the same way they'd
+     appear in the Perfetto viewer. *)
+
+  let print_frame_callstack = Frame.For_testing.print_callstack
+
+  let%expect_test "[parse_frames] utility" =
+    let #(~root:_, ~leaf) = parse_frames "a-b-c-d-e" in
+    print_frame_callstack leaf;
+    [%expect {|
+      a
+      b
+      c
+      d
+      e
+      |}]
+  ;;
+
+  module%test Smear_times = struct
+    let create_callstacks_with_control_flow (items : (int * Control_flow.t) list)
+      : Callstack.t Nonempty_vec.t
+      =
+      let #(~root:_, ~leaf) = parse_frames "a" in
+      match items with
+      | [] -> assert false
+      | (first_time, first_cf) :: rest ->
+        let vec =
+          Nonempty_vec.create
+            (#{ time = Timestamp.create (Time_ns.Span.of_int_ns first_time)
+              ; leaf
+              ; control_flow = first_cf
+              }
+             : Callstack.t)
+        in
+        List.iter rest ~f:(fun (t, cf) ->
+          Nonempty_vec.push_back
+            vec
+            (#{ time = Timestamp.create (Time_ns.Span.of_int_ns t)
+              ; leaf
+              ; control_flow = cf
+              }
+             : Callstack.t));
+        vec
+    ;;
+
+    let create_callstacks (times : int list) : Callstack.t Nonempty_vec.t =
+      List.map ~f:(fun time -> time, Control_flow.Call { depth = 1 }) times
+      |> create_callstacks_with_control_flow
+    ;;
+
+    let print_times (callstacks : Callstack.t Nonempty_vec.t) =
+      Nonempty_vec.iter callstacks ~f:(fun (cs : Callstack.t) ->
+        printf "%2d " (Time_ns.Span.to_int_ns (cs.#time :> Time_ns.Span.t)));
+      print_endline ""
+    ;;
+
+    let%expect_test "[smear_times] with all different timestamps (no smearing needed)" =
+      let callstacks = create_callstacks [ 0; 10; 20; 30 ] in
+      print_times callstacks;
+      [%expect {|  0 10 20 30 |}];
+      smear_times callstacks;
+      print_times callstacks;
+      [%expect {|  0 10 20 30 |}]
+    ;;
+
+    let%expect_test "[smear_times] with consecutive same timestamps" =
+      let callstacks = create_callstacks [ 0; 0; 0; 30 ] in
+      print_times callstacks;
+      [%expect {|  0  0  0 30 |}];
+      smear_times callstacks;
+      print_times callstacks;
+      [%expect {|  0 10 20 30 |}]
+    ;;
+
+    let%expect_test "[smear_times] with multiple runs of same timestamps" =
+      let callstacks = create_callstacks [ 0; 0; 20; 20; 20; 50 ] in
+      print_times callstacks;
+      [%expect {|  0  0 20 20 20 50 |}];
+      smear_times callstacks;
+      print_times callstacks;
+      [%expect {|  0 10 20 30 40 50 |}]
+    ;;
+
+    let%expect_test "[smear_times] final run keeps original time" =
+      let callstacks = create_callstacks [ 0; 0; 30; 30; 30 ] in
+      print_times callstacks;
+      [%expect {|  0  0 30 30 30 |}];
+      smear_times callstacks;
+      print_times callstacks;
+      [%expect {|  0 15 30 30 30 |}]
+    ;;
+
+    let%expect_test "[smear_times] single event" =
+      let callstacks = create_callstacks [ 100 ] in
+      print_times callstacks;
+      [%expect {| 100 |}];
+      smear_times callstacks;
+      print_times callstacks;
+      [%expect {| 100 |}]
+    ;;
+
+    let%expect_test "[smear_times] all same timestamp (final run)" =
+      let callstacks = create_callstacks [ 50; 50; 50 ] in
+      print_times callstacks;
+      [%expect {| 50 50 50 |}];
+      smear_times callstacks;
+      print_times callstacks;
+      [%expect {| 50 50 50 |}]
+    ;;
+
+    let%expect_test "[smear_times] only Call events consume time" =
+      let callstacks =
+        create_callstacks_with_control_flow
+          [ 0, Return { distance = 1 }
+          ; 0, Call { depth = 1 }
+          ; 0, Return { distance = 1 }
+          ; 0, Call { depth = 1 }
+          ; 100, Call { depth = 1 }
+          ]
+      in
+      print_times callstacks;
+      [%expect {|  0  0  0  0 100 |}];
+      smear_times callstacks;
+      print_times callstacks;
+      [%expect {|  0  0 50 50 100 |}]
+    ;;
+
+    let%expect_test "[smear_times] first event is a Call" =
+      let callstacks =
+        create_callstacks_with_control_flow
+          [ 0, Call { depth = 1 }
+          ; 0, Return { distance = 1 }
+          ; 0, Call { depth = 1 }
+          ; 90, Call { depth = 1 }
+          ]
+      in
+      print_times callstacks;
+      [%expect {|  0  0  0 90 |}];
+      smear_times callstacks;
+      print_times callstacks;
+      [%expect {|  0 45 45 90 |}]
+    ;;
+
+    let%expect_test "[smear_times] only Returns uses fallback" =
+      let callstacks =
+        create_callstacks_with_control_flow
+          [ 0, Return { distance = 1 }
+          ; 0, Return { distance = 1 }
+          ; 0, Return { distance = 1 }
+          ; 90, Call { depth = 1 }
+          ]
+      in
+      print_times callstacks;
+      [%expect {|  0  0  0 90 |}];
+      smear_times callstacks;
+      print_times callstacks;
+      [%expect {|  0  0  0 90 |}]
+    ;;
+  end
+
+  let setup_test () =
+    let t = create None (Hashtbl.create (module Int)) in
+    let ip = ref (-1) in
+    let time = ref Time_ns.Span.zero in
+    let incr_time () = time := Time_ns.Span.(!time + of_int_ns 1) in
+    let location (name : string) : Location.t =
+      incr ip;
+      Location.
+        { instruction_pointer = Int64.of_int !ip
+        ; symbol_offset = 0
+        ; symbol = From_perf name
+        ; dso = Interned_string.empty
+        }
+    in
+    let call ~src ~dst =
+      incr_time ();
+      let event =
+        Event.Ok.Data.Trace
+          { kind = Some Call
+          ; src = location src
+          ; dst = location dst
+          ; trace_state_change = None
+          }
+      in
+      add_event t event (Timestamp.create !time)
+    in
+    let return ~src ~dst =
+      incr_time ();
+      let event =
+        Event.Ok.Data.Trace
+          { kind = Some Return
+          ; src = location src
+          ; dst = location dst
+          ; trace_state_change = None
+          }
+      in
+      add_event t event (Timestamp.create !time)
+    in
+    let jump ~src ~dst =
+      incr_time ();
+      let event =
+        Event.Ok.Data.Trace
+          { kind = Some Jump
+          ; src = location src
+          ; dst = location dst
+          ; trace_state_change = None
+          }
+      in
+      add_event t event (Timestamp.create !time)
+    in
+    #(~t, ~call, ~return, ~jump)
+  ;;
+
+  let frames_to_list t =
+    let result = ref [] in
+    Nonempty_vec.iter t.callstacks ~f:(fun (cs : Callstack.t) ->
+      result := cs.#leaf :: !result);
+    List.rev !result
+  ;;
+
+  let concat_horizontal (lists : string list list) : string =
+    let max_len =
+      List.fold lists ~init:0 ~f:(fun acc lst -> Int.max acc (List.length lst))
+    in
+    let width = 20 in
+    List.init max_len ~f:(fun row_idx ->
+      List.map lists ~f:(fun lst ->
+        let s = List.nth lst row_idx |> Option.value ~default:"" in
+        sprintf "%-*s" width s)
+      |> String.concat)
+    |> String.concat ~sep:"\n"
+  ;;
+
+  let print_callstacks (t : t) =
+    frames_to_list t
+    (* Skip the initial sentinel callstack *)
+    |> List.tl
+    |> Option.value ~default:[]
+    |> List.map ~f:(fun frame -> Frame.For_testing.to_string_list frame)
+    |> concat_horizontal
+    |> print_endline;
+    (* So that the closing |}] of the [%expect ...] block is on its own line. *)
+    print_endline "-"
+  ;;
+
+  (* In all of the following examples, unless otherwise specified assume no
+     tail-call-optimization is performed. *)
+
+  (*=
+       let fn2 () = ()
+       let fn3 () = ()
+
+       let fn1 () =
+         fn2 ()
+         fn3 ()
+       ;;
+
+       let main () = fn1 ()
+    *)
+  let%expect_test "Sanity-check [add_event]" =
+    let #(~t, ~call, ~return, ~jump:_) = setup_test () in
+    call ~src:"main" ~dst:"fn1";
+    call ~src:"fn1" ~dst:"fn2";
+    return ~src:"fn2" ~dst:"fn1";
+    call ~src:"fn1" ~dst:"fn3";
+    (* Return from [fn3] *)
+    return ~src:"fn3" ~dst:"fn1";
+    (* Return from [fn1] *)
+    return ~src:"fn1" ~dst:"main";
+    print_callstacks t;
+    [%expect
+      {|
+      main                main                main                main                main                main                main
+                          fn1                 fn1                 fn1                 fn1                 fn1
+                                              fn2                                     fn3
+      -
+      |}]
+  ;;
+
+  (*=
+       Assume we started tracing during the execution of [main] so we never saw the calls to [start] or [init]
+
+       let fn2 () = ()
+       let fn3 () = ()
+
+       let fn1 () =
+         fn2 ()
+         fn3 ()
+       ;;
+
+       let main () = fn1 ()
+
+       let start () = main ()
+       let init () = start ()
+    *)
+  let%expect_test "A return to a function we never saw the call for" =
+    let #(~t, ~call, ~return, ~jump:_) = setup_test () in
+    call ~src:"main" ~dst:"fn1";
+    call ~src:"fn1" ~dst:"fn2";
+    return ~src:"fn2" ~dst:"fn1";
+    call ~src:"fn1" ~dst:"fn3";
+    return ~src:"fn3" ~dst:"fn1";
+    return ~src:"fn1" ~dst:"main";
+    print_callstacks t;
+    [%expect
+      {|
+      main                main                main                main                main                main                main
+                          fn1                 fn1                 fn1                 fn1                 fn1
+                                              fn2                                     fn3
+      -
+      |}];
+    (* Return for a call we didn't see *)
+    return ~src:"main" ~dst:"start";
+    print_callstacks t;
+    [%expect
+      {|
+      start               start               start               start               start               start               start               start
+      main                main                main                main                main                main                main
+                          fn1                 fn1                 fn1                 fn1                 fn1
+                                              fn2                                     fn3
+      -
+      |}];
+    (* Another return for a call we didn't see *)
+    return ~src:"start" ~dst:"init";
+    print_callstacks t;
+    [%expect
+      {|
+      init                init                init                init                init                init                init                init                init
+      start               start               start               start               start               start               start               start
+      main                main                main                main                main                main                main
+                          fn1                 fn1                 fn1                 fn1                 fn1
+                                              fn2                                     fn3
+      -
+      |}]
+  ;;
+
+  (*=
+       let fn2 () = ()
+       let fn3 () = raise Failure
+
+       let fn1 () =
+         fn2 ()
+         fn3 ()
+       ;;
+
+       let main () = try fn1 () with _ -> ()
+       *)
+  let%expect_test "Return multiple levels up the stack" =
+    let #(~t, ~call, ~return, ~jump:_) = setup_test () in
+    call ~src:"main" ~dst:"fn1";
+    call ~src:"fn1" ~dst:"fn2";
+    return ~src:"fn2" ~dst:"fn1";
+    call ~src:"fn1" ~dst:"fn3";
+    (* Raise from [fn3] into the [try] in [main] *)
+    return ~src:"fn3" ~dst:"main";
+    print_callstacks t;
+    [%expect
+      {|
+      main                main                main                main                main                main
+                          fn1                 fn1                 fn1                 fn1
+                                              fn2                                     fn3
+      -
+      |}]
+  ;;
+
+  (*=
+       let fn1 () =
+         if something then do_something else do_something_else
+       ;;
+
+       let main () = fn1 ()
+       *)
+  let%expect_test "Simple jumps within a function" =
+    let #(~t, ~call, ~return, ~jump) = setup_test () in
+    call ~src:"main" ~dst:"fn1";
+    jump ~src:"fn1" ~dst:"fn1";
+    return ~src:"fn1" ~dst:"main";
+    print_callstacks t;
+    [%expect
+      {|
+      main                main                main
+                          fn1
+      -
+      |}]
+  ;;
+
+  (*=
+
+       let fn2 () = ()
+       let fn1 () = fn2() [@tail]
+
+       let main () = fn1 ()
+       *)
+  let%expect_test "Tail-call" =
+    let #(~t, ~call, ~return, ~jump) = setup_test () in
+    call ~src:"main" ~dst:"fn1";
+    (* Tail-call [fn2] from [fn1] *)
+    jump ~src:"fn1" ~dst:"fn2";
+    return ~src:"fn2" ~dst:"main";
+    print_callstacks t;
+    (* TODO Showing a return to [main] and subsequent call into [fn2] is a bug that was
+       introduced when adding support for inlined frames. We need to fix this. *)
+    [%expect
+      {|
+      main                main                main                main                main
+                          fn1                                     fn2
+      -
+      |}]
+  ;;
+end
diff --git a/src/trace_segment.mli b/src/trace_segment.mli
new file mode 100644
index 000000000..8c4ef6be7
--- /dev/null
+++ b/src/trace_segment.mli
@@ -0,0 +1,29 @@
+open! Core
+
+(** A continuous, lossless, error-free segment of a trace corresponding to a single
+    thread. *)
+type t
+
+module Fiber : sig
+  type t
+end
+
+val create : Ocaml_exception_info.t option -> Fiber.t Hashtbl.M(Int).t -> 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 set_fiber_id : t -> int -> unit
+
+val write_trace
+  :  t
+  -> (module Trace_writer_intf.S_trace with type thread = 'thread)
+  -> 'thread
+  -> Elf.Addr_table.t
+  -> enter_initial_callstack:bool
+       (** Emit a frame-enter for each frame in the *first* callstack of this segment. *)
+  -> exit_final_callstack:bool
+       (** Emit a frame-exit for each frame in the *last* callstack of this segment. *)
+  -> unit
diff --git a/src/trace_writer.ml b/src/trace_writer.ml
index 6293daf4e..6c1a8d058 100644
--- a/src/trace_writer.ml
+++ b/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 }
     }
@@ -1071,8 +1073,8 @@ and write_event' (T t) ?events_writer event =
                  ~f:(fun pid -> [ "pid", Int (Pid.to_int pid) ])
                  ~default:[]
              ; Option.value_map
-                 (Event.thread outer_event).pid
-                 ~f:(fun pid -> [ "tid", Int (Pid.to_int pid) ])
+                 (Event.thread outer_event).tid
+                 ~f:(fun tid -> [ "tid", Int (Pid.to_int tid) ])
                  ~default:[]
              ])
        in
@@ -1083,6 +1085,29 @@ and write_event' (T t) ?events_writer event =
          ~name:track_name
          ~time
          ~time_end:time
+     | { Event.Ok.thread = _ (* Already used this to look up thread info. *)
+       ; time = _
+       ; data = Ptwrite { location; data }
+       ; in_transaction = _
+       } ->
+       let args =
+         Tracing.Trace.Arg.(
+           List.concat
+             [ [ "timestamp", Int (Time_ns.Span.to_int_ns (time :> Time_ns.Span.t)) ]
+             ; [ "symbol", String (Symbol.display_name location.symbol) ]
+             ; [ "addr", Pointer location.instruction_pointer ]
+             ; [ "data", String data ]
+             ; Option.value_map
+                 (Event.thread outer_event).pid
+                 ~f:(fun pid -> [ "pid", Int (Pid.to_int pid) ])
+                 ~default:[]
+             ; Option.value_map
+                 (Event.thread outer_event).tid
+                 ~f:(fun tid -> [ "tid", Int (Pid.to_int tid) ])
+                 ~default:[]
+             ])
+       in
+       write_duration_complete t ~thread ~args ~name:"PTWRITE" ~time ~time_end:time
      | { 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 = Power { freq }
@@ -1231,3 +1256,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
diff --git a/src/trace_writer.mli b/src/trace_writer.mli
index 43534873b..bd0e8fb1e 100644
--- a/src/trace_writer.mli
+++ b/src/trace_writer.mli
@@ -1,70 +1,2 @@
 open! Core
-
-(* Enable this in tests to see [t] after every perf event. Don't forget to disable it when
-   you're done!
-
-   To take advantage of this from perf script tests, call [Perf_script.run ~debug:true].
-*)
-val debug : bool ref
-
-type t [@@deriving sexp_of]
-
-val create
-  :  trace_scope:Trace_scope.t
-  -> debug_info:Elf.Addr_table.t option
-  -> ocaml_exception_info:Ocaml_exception_info.t option
-  -> earliest_time:Time_ns.Span.t
-  -> hits:(string * Breakpoint.Hit.t) list
-  -> annotate_inferred_start_times:bool
-  -> Tracing.Trace.t
-  -> t
-
-module type Trace = Trace_writer_intf.S_trace
-
-module Mapped_time : sig
-  type t = private Time_ns.Span.t [@@deriving sexp, compare, bin_io]
-
-  include Comparable with type t := t
-
-  val start_of_trace : t
-  val create : Time_ns.Span.t -> base_time:Time_ns.Span.t -> t
-  val is_base_time : t -> bool
-  val add : t -> Time_ns.Span.t -> t
-  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
-    ; callstack : Callstack_compression.compression_event
-    }
-  [@@deriving sexp, bin_io]
-end
-
-val create_expert
-  :  trace_scope:Trace_scope.t
-  -> debug_info:Elf.Addr_table.t option
-  -> ocaml_exception_info:Ocaml_exception_info.t option
-  -> earliest_time:Time_ns.Span.t
-  -> hits:(string * Breakpoint.Hit.t) list
-  -> annotate_inferred_start_times:bool
-  -> (module Trace with type thread = _)
-  -> t
-
-val write_event
-  :  t
-  -> ?events_writer:Tracing_tool_output.events_writer
-  -> Event.With_write_info.t
-  -> unit
-
-(** 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
+include Trace_writer_implementation_intf.S
diff --git a/src/trace_writer_implementation_intf.ml b/src/trace_writer_implementation_intf.ml
new file mode 100644
index 000000000..8af19fcf5
--- /dev/null
+++ b/src/trace_writer_implementation_intf.ml
@@ -0,0 +1,74 @@
+open! Core
+
+module type S = sig
+  (* Enable this in tests to see [t] after every perf event. Don't forget to disable it when
+   you're done!
+
+   To take advantage of this from perf script tests, call [Perf_script.run ~debug:true].
+  *)
+  val debug : bool ref
+
+  type t [@@deriving sexp_of]
+
+  val create
+    :  trace_scope:Trace_scope.t
+    -> debug_info:Elf.Addr_table.t option
+    -> ocaml_exception_info:Ocaml_exception_info.t option
+    -> earliest_time:Time_ns.Span.t
+    -> hits:(string * Breakpoint.Hit.t) list
+    -> annotate_inferred_start_times:bool
+    -> Tracing.Trace.t
+    -> t
+
+  module type Trace = Trace_writer_intf.S_trace
+
+  module Mapped_time : sig
+    type t = private Time_ns.Span.t [@@deriving sexp, compare, bin_io]
+
+    include Comparable with type t := t
+
+    val start_of_trace : t
+    val create : Time_ns.Span.t -> base_time:Time_ns.Span.t -> t
+    val is_base_time : t -> bool
+    val add : t -> Time_ns.Span.t -> t
+    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
+      ; callstack : Callstack_compression.compression_event
+      }
+    [@@deriving sexp, bin_io]
+  end
+
+  val create_expert
+    :  trace_scope:Trace_scope.t
+    -> debug_info:Elf.Addr_table.t option
+    -> ocaml_exception_info:Ocaml_exception_info.t option
+    -> earliest_time:Time_ns.Span.t
+    -> hits:(string * Breakpoint.Hit.t) list
+    -> annotate_inferred_start_times:bool
+    -> (module Trace with type thread = _)
+    -> t
+
+  val write_event
+    :  t
+    -> ?events_writer:Tracing_tool_output.events_writer
+    -> Event.With_write_info.t
+    -> unit
+
+  (** 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
diff --git a/src/trace_writer_intf.ml b/src/trace_writer_intf.ml
index aef6a6d3e..2e4c2d297 100644
--- a/src/trace_writer_intf.ml
+++ b/src/trace_writer_intf.ml
@@ -41,4 +41,10 @@ module type S_trace = sig
     -> name:string
     -> time:Time_ns.Span.t
     -> unit
+
+  type flow
+
+  val create_flow : unit -> flow
+  val write_flow_step : flow -> thread:thread -> time:Time_ns.Span.t -> unit
+  val finish_flow : flow -> unit
 end
diff --git a/test/dune b/test/dune
index 69d9af82b..79bf312d0 100644
--- a/test/dune
+++ b/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)))
diff --git a/test/perf_script.ml b/test/perf_script.ml
index 798408106..6d60393c5 100644
--- a/test/perf_script.ml
+++ b/test/perf_script.ml
@@ -45,6 +45,12 @@ let run ?(debug = false) ?events_writer ?ocaml_exception_info ~trace_scope file
     ;;
 
     let write_counter ~args:_ ~thread:_ ~name:_ ~time:_ : unit = ()
+
+    type flow = unit
+
+    let create_flow () = ()
+    let write_flow_step () ~thread:_ ~time:_ = ()
+    let finish_flow () = ()
   end
   in
   Magic_trace_lib.Trace_writer.debug := debug;
@@ -100,5 +106,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)
 ;;
diff --git a/test/sample-targets/long-running/dune b/test/sample-targets/long-running/dune
index 64e13c395..614ef2f0a 100644
--- a/test/sample-targets/long-running/dune
+++ b/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)))
diff --git a/test/sample-targets/ocaml-raise/dune b/test/sample-targets/ocaml-raise/dune
index 118f07bf9..36b9152fa 100644
--- a/test/sample-targets/ocaml-raise/dune
+++ b/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)))
diff --git a/test/test.ml b/test/test.ml
index 3ec670e09..f5fbd44d4 100644
--- a/test/test.ml
+++ b/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,14 @@ 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 = Interned_string.empty
+    }
+  ;;
 
   let symbol () =
     Symbol.From_perf
@@ -50,18 +58,37 @@ end = struct
     { instruction_pointer = addr ()
     ; symbol = Option.value symbol ~default:(Symbol.From_perf "")
     ; symbol_offset = offset ()
+    ; dso = Interned_string.empty
+    }
+  ;;
+
+  let start_location : Event.Location.t =
+    { instruction_pointer = 0x900000L
+    ; symbol = From_perf "_start"
+    ; symbol_offset = 4
+    ; dso = Interned_string.empty
     }
   ;;
 
+  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 +149,7 @@ end = struct
     Stack.clear stack;
     cur_time := start_time;
     rng := Random.State.make make_rng_array;
+    last_dst_location := start_location;
     ret
   ;;
 
@@ -202,17 +230,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 +255,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 +318,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 +338,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 +365,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 +454,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 +547,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 +649,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 +723,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 +823,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 ()
 ;;