chore: import upstream snapshot with attribution
This commit is contained in:
wehub-resource-sync
@@ -0,0 +1,4 @@
|
||||
18c9878c95c38cdeebb8abd108b615f44dc2953f
|
||||
a79dcc8e199781b5fd2c167685652aeb4af09e61
|
||||
da1edf3d8fa58bb6153a6c051a07f7042d614b2d
|
||||
1f28c8a51ffc664d18aa9f3106eb084d5daf8fa2
|
||||
@@ -0,0 +1,3 @@
|
||||
*.ml linguist-language=OCaml
|
||||
*.mli linguist-language=OCaml
|
||||
vendor/** -linguist-vendored
|
||||
@@ -0,0 +1,23 @@
|
||||
---
|
||||
name: "Bug Report"
|
||||
about: Report a reproducible bug or regression.
|
||||
labels: 'bug'
|
||||
---
|
||||
|
||||
Thanks for helping us make magic-trace better!
|
||||
|
||||
Please consider answering any subset of the following questions, based on what you think
|
||||
is most relevant to your report:
|
||||
|
||||
- What happened?
|
||||
- What did you expect to happen?
|
||||
- How can we, magic-trace developers, reproduce the issue you're seeing?
|
||||
- What version of perf userspace tools are you running? `perf --version`
|
||||
- What CPU do you have? `cat /proc/cpuinfo`
|
||||
- If you're reporting a UI bug, can you provide the trace file and/or screenshots
|
||||
of the probem?
|
||||
|
||||
Please also consider scanning the [existing set of issues](https://github.com/janestreet/magic-trace/issues)
|
||||
for other people reporting the same thing, and checking out the
|
||||
[FAQ](https://github.com/janestreet/magic-trace/wiki/FAQ) just in case you're running into
|
||||
a common pitfall.
|
||||
@@ -0,0 +1,5 @@
|
||||
blank_issues_enabled: true
|
||||
contact_links:
|
||||
- name: Questions and Help
|
||||
url: https://github.com/janestreet/magic-trace/discussions
|
||||
about: This issue tracker is not for support questions. Please refer to magic-trace's discussion forums.
|
||||
@@ -0,0 +1,2 @@
|
||||
require:
|
||||
members: false
|
||||
@@ -0,0 +1,41 @@
|
||||
name: build-deb
|
||||
|
||||
on: push
|
||||
|
||||
jobs:
|
||||
build:
|
||||
runs-on: ubuntu_x64_8_cores
|
||||
steps:
|
||||
- name: Checkout code
|
||||
uses: actions/checkout@v6
|
||||
with:
|
||||
fetch-depth: 0
|
||||
|
||||
- name: Install dependencies
|
||||
run: |
|
||||
sudo apt-get update
|
||||
sudo apt-get install opam ocaml-dune debhelper devscripts llvm-20 llvm-20-dev lld
|
||||
|
||||
- name: Build packages
|
||||
run: |
|
||||
export PATH="/usr/lib/llvm-20/bin:$PATH"
|
||||
DEBFULLNAME="Jane Street" DEBEMAIL=opensource-contacts@janestreet.com dch -b --newversion "$(git describe --tags | sed 's/^v//')+deb$(grep VERSION_ID /etc/os-release | cut -d'"' -f2)" -D unstable 'Building latest upstream'
|
||||
dpkg-buildpackage -us -uc -b -j$(nproc)
|
||||
# Because actions/upload-artifact will refuse to upload relative paths...
|
||||
mv ../*.deb .
|
||||
|
||||
- uses: actions/upload-artifact@v6
|
||||
with:
|
||||
name: Packages
|
||||
path: '*.deb'
|
||||
if-no-files-found: error
|
||||
|
||||
- name: Upload to GitHub releases
|
||||
if: startsWith(github.ref, 'refs/tags/')
|
||||
uses: svenstaro/upload-release-action@v2
|
||||
with:
|
||||
repo_token: ${{ secrets.GITHUB_TOKEN }}
|
||||
file: '*.deb'
|
||||
tag: ${{ github.ref }}
|
||||
overwrite: true
|
||||
file_glob: true
|
||||
@@ -0,0 +1,85 @@
|
||||
name: build
|
||||
|
||||
on:
|
||||
- push
|
||||
- pull_request
|
||||
|
||||
jobs:
|
||||
build:
|
||||
strategy:
|
||||
matrix:
|
||||
os:
|
||||
- ubuntu_x64_8_cores
|
||||
ocaml-version:
|
||||
- '5.2.0+ox'
|
||||
oxcaml-opam-commit:
|
||||
- '231c88c2e564fdca40e15e750aacad5fb0887435'
|
||||
|
||||
runs-on: ${{ matrix.os }}
|
||||
container:
|
||||
image: alpine:latest
|
||||
steps:
|
||||
# This has to come first because the `actions/*` GitHub Actions require `node`,
|
||||
# which isn't installed by default on this container image.
|
||||
- name: "Install apk packages"
|
||||
run: |
|
||||
apk add autoconf bash bubblewrap build-base clang coreutils git libstdc++ \
|
||||
libstdc++-dev libunwind-static linux-headers lld llvm20 llvm20-dev llvm20-static \
|
||||
nodejs opam rsync upx zlib-static zstd-static
|
||||
echo "PATH=/usr/lib/llvm20/bin:$PATH" >> "$GITHUB_ENV"
|
||||
|
||||
- name: Checkout code
|
||||
uses: actions/checkout@v6
|
||||
|
||||
# This is necessary to avoid an error of the form 'fatal: detected dubious ownership in repository ...'
|
||||
- run: git config --global --add safe.directory $(pwd)
|
||||
|
||||
- uses: actions/cache@v5
|
||||
with:
|
||||
path: ~/.opam
|
||||
key: ${{ matrix.os }}-opam-${{ matrix.ocaml-version }}-${{ matrix.oxcaml-opam-commit }}-2
|
||||
|
||||
- name: Use OCaml ${{ matrix.ocaml-version }}
|
||||
run: |
|
||||
export OPAMYES=1
|
||||
export OPAMJOBS=$(($(nproc) + 2))
|
||||
export OPAMROOTISOK=1
|
||||
echo "OPAMYES=1" >> "$GITHUB_ENV"
|
||||
echo "OPAMJOBS=$OPAMJOBS" >> "$GITHUB_ENV"
|
||||
echo "OPAMROOTISOK=$OPAMROOTISOK" >> "$GITHUB_ENV"
|
||||
|
||||
opam init --bare -yav https://github.com/ocaml/opam-repository.git
|
||||
opam switch set ${{ matrix.ocaml-version }} 2>/dev/null || \
|
||||
opam switch create ${{ matrix.ocaml-version }} --repos "ox=git+https://github.com/oxcaml/opam-repository.git#${{ matrix.oxcaml-opam-commit }},default"
|
||||
|
||||
- run: opam install . --deps-only --locked --with-test
|
||||
|
||||
- run: opam exec -- dune build @fmt
|
||||
|
||||
- run: opam exec -- make PROFILE=static
|
||||
|
||||
- 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
|
||||
|
||||
- uses: actions/upload-artifact@v6
|
||||
with:
|
||||
name: magic-trace
|
||||
path: magic-trace
|
||||
if-no-files-found: error
|
||||
|
||||
- name: Upload to GitHub releases
|
||||
if: startsWith(github.ref, 'refs/tags/')
|
||||
uses: svenstaro/upload-release-action@v2
|
||||
with:
|
||||
repo_token: ${{ secrets.GITHUB_TOKEN }}
|
||||
file: magic-trace
|
||||
asset_name: magic-trace
|
||||
tag: ${{ github.ref }}
|
||||
overwrite: true
|
||||
+14
@@ -0,0 +1,14 @@
|
||||
_build
|
||||
*.install
|
||||
*.merlin
|
||||
_opam
|
||||
perf.data
|
||||
perf.data.old
|
||||
.vscode/*
|
||||
!.vscode/tasks.json
|
||||
*.fxt
|
||||
*.fxt.old
|
||||
*.fxt.gz
|
||||
*.fxt.gz.old
|
||||
*.fxt.zst
|
||||
*.fxt.zst.old
|
||||
@@ -0,0 +1,3 @@
|
||||
profile=janestreet
|
||||
wrap-comments=false
|
||||
parse-docstrings=false
|
||||
Vendored
+23
@@ -0,0 +1,23 @@
|
||||
{
|
||||
// See https://go.microsoft.com/fwlink/?LinkId=733558
|
||||
// for the documentation about the tasks.json format
|
||||
"version": "2.0.0",
|
||||
"tasks": [
|
||||
{
|
||||
"label": "watch",
|
||||
"command": "dune",
|
||||
"args": [
|
||||
"build",
|
||||
"@default",
|
||||
"@runtest",
|
||||
"@fmt",
|
||||
"--auto-promote",
|
||||
"--watch"
|
||||
],
|
||||
"problemMatcher": [
|
||||
"$ocamlc"
|
||||
],
|
||||
"isBackground": true,
|
||||
}
|
||||
]
|
||||
}
|
||||
@@ -0,0 +1,67 @@
|
||||
This repository contains open source software that is developed and
|
||||
maintained by [Jane Street][js].
|
||||
|
||||
Contributions to this project are welcome and should be submitted via
|
||||
GitHub pull requests.
|
||||
|
||||
Signing contributions
|
||||
---------------------
|
||||
|
||||
We require that you sign your contributions. Your signature certifies
|
||||
that you wrote the patch or otherwise have the right to pass it on as
|
||||
an open-source patch. The rules are pretty simple: if you can certify
|
||||
the below (from [developercertificate.org][dco]):
|
||||
|
||||
```
|
||||
Developer Certificate of Origin
|
||||
Version 1.1
|
||||
|
||||
Copyright (C) 2004, 2006 The Linux Foundation and its contributors.
|
||||
1 Letterman Drive
|
||||
Suite D4700
|
||||
San Francisco, CA, 94129
|
||||
|
||||
Everyone is permitted to copy and distribute verbatim copies of this
|
||||
license document, but changing it is not allowed.
|
||||
|
||||
|
||||
Developer's Certificate of Origin 1.1
|
||||
|
||||
By making a contribution to this project, I certify that:
|
||||
|
||||
(a) The contribution was created in whole or in part by me and I
|
||||
have the right to submit it under the open source license
|
||||
indicated in the file; or
|
||||
|
||||
(b) The contribution is based upon previous work that, to the best
|
||||
of my knowledge, is covered under an appropriate open source
|
||||
license and I have the right under that license to submit that
|
||||
work with modifications, whether created in whole or in part
|
||||
by me, under the same open source license (unless I am
|
||||
permitted to submit under a different license), as indicated
|
||||
in the file; or
|
||||
|
||||
(c) The contribution was provided directly to me by some other
|
||||
person who certified (a), (b) or (c) and I have not modified
|
||||
it.
|
||||
|
||||
(d) I understand and agree that this project and the contribution
|
||||
are public and that a record of the contribution (including all
|
||||
personal information I submit with it, including my sign-off) is
|
||||
maintained indefinitely and may be redistributed consistent with
|
||||
this project or the open source license(s) involved.
|
||||
```
|
||||
|
||||
Then you just add a line to every git commit message:
|
||||
|
||||
```
|
||||
Signed-off-by: Joe Smith <joe.smith@email.com>
|
||||
```
|
||||
|
||||
Use your real name (sorry, no pseudonyms or anonymous contributions.)
|
||||
|
||||
If you set your `user.name` and `user.email` git configs, you can sign
|
||||
your commit automatically with git commit -s.
|
||||
|
||||
[dco]: http://developercertificate.org/
|
||||
[js]: https://opensource.janestreet.com/
|
||||
+21
@@ -0,0 +1,21 @@
|
||||
The MIT License
|
||||
|
||||
Copyright (c) 2022 Jane Street Group, LLC <opensource@janestreet.com>
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
of this software and associated documentation files (the "Software"), to deal
|
||||
in the Software without restriction, including without limitation the rights
|
||||
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||
copies of the Software, and to permit persons to whom the Software is
|
||||
furnished to do so, subject to the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be included in all
|
||||
copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||
SOFTWARE.
|
||||
@@ -0,0 +1,18 @@
|
||||
INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),)
|
||||
BUILD_ARGS := $(if $(PROFILE),--profile $(PROFILE),)
|
||||
|
||||
default:
|
||||
dune build $(BUILD_ARGS)
|
||||
|
||||
install:
|
||||
dune install $(INSTALL_ARGS) magic-trace
|
||||
|
||||
uninstall:
|
||||
dune uninstall $(INSTALL_ARGS)
|
||||
|
||||
reinstall: uninstall install
|
||||
|
||||
clean:
|
||||
dune clean
|
||||
|
||||
.PHONY: default install uninstall reinstall clean
|
||||
@@ -0,0 +1,165 @@
|
||||
<h1 align="center">
|
||||
<picture>
|
||||
<source media="(prefers-color-scheme: dark)" srcset="docs/assets/logo-dark.svg?sanitize=true">
|
||||
<img src="docs/assets/logo-light.svg?sanitize=true" width="150px">
|
||||
</picture>
|
||||
<br>
|
||||
magic-trace
|
||||
</h1>
|
||||
<p align="center">
|
||||
<a href="https://github.com/janestreet/magic-trace/actions?query=workflow%3Abuild" alt="Linux Build Status">
|
||||
<img src="https://img.shields.io/github/actions/workflow/status/janestreet/magic-trace/build.yml?branch=master&logo=github&style=flat-square"/>
|
||||
</a>
|
||||
<a href="https://github.com/janestreet/magic-trace/releases/latest">
|
||||
<img src="https://img.shields.io/github/v/tag/janestreet/magic-trace?label=version&style=flat-square"/>
|
||||
</a>
|
||||
<a href="LICENSE.md">
|
||||
<img src="https://img.shields.io/github/license/janestreet/magic-trace?style=flat-square"/>
|
||||
</a>
|
||||
</p>
|
||||
|
||||
# Overview
|
||||
|
||||
magic-trace collects and displays high-resolution traces of what a process is doing. People have used it to:
|
||||
|
||||
- figure out why an application running in production handles some requests slowly while simultaneously handling a sea of uninteresting requests,
|
||||
- look at what their code is *actually* doing instead of what they *think* it's doing,
|
||||
- get a history of what their application was doing before it crashed, instead of a mere stacktrace at that final instant,
|
||||
- ...and much more!
|
||||
|
||||
magic-trace:
|
||||
|
||||
- has [2%-10% overhead](https://github.com/janestreet/magic-trace/wiki/Overhead),
|
||||
- doesn't require application changes to use,
|
||||
- traces *every function call* with ~40ns resolution, and
|
||||
- renders a timeline of call stacks going back (a configurable) ~10ms.
|
||||
|
||||
You use it like [`perf`](https://en.wikipedia.org/wiki/Perf_(Linux)): point it to a process and off it goes. The key difference from `perf` is that instead of sampling call stacks throughout time, magic-trace uses [Intel Processor Trace](https://man7.org/linux/man-pages/man1/perf-intel-pt.1.html) to snapshot a ring buffer of *all control flow* leading up to a chosen point in time[^1]. Then, you can explore an interactive timeline of what happened.
|
||||
|
||||
You can point magic-trace at a function such that when your application calls it, magic-trace takes a snapshot. Alternatively, attach it to a running process and detach it with <kbd>Ctrl</kbd>+<kbd>C</kbd>, to see a trace of an arbitrary point in your program.
|
||||
|
||||
[^1]: `perf` can do this too, but that's not how most people use it. In fact, if you peek under the hood you'll see that magic-trace uses `perf` to drive Intel PT.
|
||||
|
||||
# Testimonials
|
||||
|
||||
> "Magic-trace is one of the simplest command-line debugging tools I have ever used."
|
||||
- Francis Ricci, Jane Street
|
||||
|
||||
> "Magic-trace is not just for performance. The tool gives insight directly into what happens in your program, when, and why. Consider using it for all your introspective goals!"
|
||||
- Andrew Hunter, Jane Street
|
||||
|
||||
> I use perf a ton, and I think that both perf and magic-trace give perspectives that the other doesn't. The benefit I got from magic-trace was entirely based on the fact that it works in slices at any zoom level, so I was able to see all the function calls that a 70ns function was performing, which was invisible in perf.
|
||||
- Doug Patti, Jane Street
|
||||
|
||||
[more testimonials...](https://github.com/janestreet/magic-trace/wiki/Unsolicited-reviews)
|
||||
|
||||
# Install
|
||||
|
||||
1. Make sure the system you want to trace is [supported](https://github.com/janestreet/magic-trace/wiki/Supported-platforms,-programming-languages,-and-runtimes). The constraints that most commonly trip people up are: VMs are mostly not supported, Intel only (Skylake[^3] or later), Linux only.
|
||||
|
||||
2. Grab a release binary from the [latest release page](https://github.com/janestreet/magic-trace/releases/latest).
|
||||
|
||||
1. If downloading the prebuilt binary (not package), `chmod +x magic-trace`[^4]
|
||||
1. If downloading the package, run `sudo dpkg -i magic-trace*.deb`
|
||||
|
||||
Then, test it by running `magic-trace -help`, which should bring up some help text.
|
||||
|
||||
[^3]: Strictly speaking, anything newer than Broadwell, but this is not a platform we regularly test on, and timing resolution is worse (~1us).
|
||||
[^4]: https://github.com/actions/upload-artifact/issues/38
|
||||
|
||||
# Getting started
|
||||
|
||||
1. [Here](https://raw.githubusercontent.com/janestreet/magic-trace/master/demo/demo.c)'s a sample C program to try out. It's a slightly modified version of the example in `man 3 dlopen`. Download that, build it with `gcc demo.c -ldl -o demo`, then leave it running `./demo`. We're going to use that program to learn how `dlopen` works.
|
||||
|
||||
2. Run `magic-trace attach -pid $(pidof demo)`. When you see the message that it's successfully attached, wait a couple seconds and <kbd>Ctrl</kbd>+<kbd>C</kbd> `magic-trace`. It will output a file called `trace.fxt.gz` in your working directory.
|
||||
|
||||
<p align="center">
|
||||
<img src="docs/assets/stage-1.gif">
|
||||
</p>
|
||||
|
||||
3. Open [magic-trace.org](https://magic-trace.org/), click _"Open trace file"_ in the top-left-hand and give it the trace file generated in the previous step.
|
||||
|
||||
<p align="center">
|
||||
<img src="docs/assets/stage-2.gif">
|
||||
</p>
|
||||
|
||||
4. That should have expanded into a trace. Zoom in until you can see an individual loop through `dlopen`/`dlsym`/`cos`/`printf`/`dlclose`.
|
||||
- <kbd>W</kbd> zooms into wherever your mouse cursor is pointed (you'll need to zoom in a bunch to see anything useful),
|
||||
- <kbd>S</kbd> zooms out,
|
||||
- <kbd>A</kbd> moves left,
|
||||
- <kbd>D</kbd> moves right, and
|
||||
- scroll wheel moves your viewport up and down the stack. You'll only need to scroll to see particularly deep stack traces, it's probably not useful for this example.
|
||||
|
||||
<p align="center">
|
||||
<img src="docs/assets/stage-3.gif">
|
||||
</p>
|
||||
|
||||
5. Click and drag on the white space around the call stacks to measure. Plant flags by clicking in the timeline along the top. Using the measurement tool, measure how long it takes to run `cos`. On my screen it takes ~5.7us.
|
||||
|
||||
<p align="center">
|
||||
<img src="docs/assets/stage-4.gif">
|
||||
</p>
|
||||
|
||||
Congratulations, you just magically traced your first program!
|
||||
|
||||
In contrast to traditional `perf` workflows, magic-trace excels at hypothesis generation. For example, you might notice that taking 6us to run `cos` is a really long time! If you zoom in even more, you'll see that there's actually five pink "\[untraced\]" cells in there. If you re-run magic-trace with root and pass it `-trace-include-kernel`, you'll see stacktraces for those. They're page fault handlers! The demo program actually calls `cos` twice. If you zoom in even more near the end of the 6us `cos` call, you'll see that the second call takes *far* less time and does not page fault.
|
||||
|
||||
# How to use it
|
||||
|
||||
magic-trace continuously records control flow into a ring buffer. Upon some sort of trigger, it takes a snapshot of that buffer and reconstructs call stacks.
|
||||
|
||||
There are two ways to take a snapshot:
|
||||
|
||||
We just did this one: <kbd>Ctrl</kbd>+<kbd>C</kbd> magic-trace. If magic-trace terminates without already having taken a snapshot, it takes a snapshot of the end of the program.
|
||||
|
||||
You can also trigger snapshots when the application calls a function. To do so, pass magic-trace
|
||||
the `-trigger` flag.
|
||||
|
||||
- `-trigger '?'` brings up a fuzzy-finding selector that lets you choose from all
|
||||
symbols in your executable,
|
||||
- `-trigger SYMBOL` selects a specific, fully mangled, symbol you know ahead of time, and
|
||||
- `-trigger .` selects the default symbol `magic_trace_stop_indicator`.
|
||||
|
||||
Stop indicators are powerful. Here are some ideas for where you might want to place one:
|
||||
|
||||
- If you're using an asynchronous runtime, any time a scheduler cycle takes too long.
|
||||
- In a server, when a request takes a surprisingly long time.
|
||||
- After the garbage collector runs, to see what it's doing and what it interrupted.
|
||||
- After a compiler pass has completed.
|
||||
|
||||
You may leave the stop indicator in production code. It doesn't need to do anything in particular, magic-trace just needs the name. It is just an empty, but not inlined, function. It will cost ~10us to call, but *only when magic-trace actually uses it to take a snapshot*.
|
||||
|
||||
# Documentation
|
||||
|
||||
More documentation is available on [the magic-trace wiki](https://github.com/janestreet/magic-trace/wiki).
|
||||
|
||||
# Discussion
|
||||
|
||||
Join us [on Discord](https://discord.gg/vkzPYeZ292) to chat synchronously, or the [GitHub discussion group](https://github.com/janestreet/magic-trace/discussions) to do so asynchronously.
|
||||
|
||||
# Contributing
|
||||
|
||||
If you'd like to contribute:
|
||||
|
||||
1. [read the build instructions](https://github.com/janestreet/magic-trace/wiki/Build-instructions),
|
||||
1. [set up your editor](https://ocaml.org/learn/tutorials/up_and_running.html#Editor-support-for-OCaml),
|
||||
1. [take a quick tour through the codebase](https://github.com/janestreet/magic-trace/wiki/A-quick-tour-of-the-codebase), then
|
||||
1. [hit up the issue tracker](https://github.com/janestreet/magic-trace/issues?q=is%3Aissue+is%3Aopen+label%3A%22good+first+issue%22) for a good starter project.
|
||||
|
||||
# Privacy policy
|
||||
|
||||
magic-trace does not send your code or derivatives of your code (including traces) anywhere.
|
||||
|
||||
[magic-trace.org](https://magic-trace.org) is a [lightly modified fork of Perfetto](https://github.com/janestreet/magic-trace/wiki/About-the-UI), and runs entirely in your browser. As far as we can tell, it does not send your trace anywhere. If you're worried about that changing one day, [set up your own local copy of the Perfetto UI](https://github.com/janestreet/magic-trace/wiki/Setting-up-a-local-copy-of-the-UI) and use that instead.
|
||||
|
||||
# Acknowledgements
|
||||
|
||||
[Tristan Hume](https://github.com/trishume) is the original author of magic-trace. He wrote it while working at [Jane Street](https://www.janestreet.com/join-jane-street/), who currently maintains it.
|
||||
|
||||
Intel PT is the foundational technology upon which magic-trace rests. We'd like to thank the people at Intel for their years-long efforts to make it available, despite its slow uptake in the greater software community.
|
||||
|
||||
magic-trace would not be possible without `perf`s extensive support for Intel PT. `perf` does most of the work in interpreting Intel PT's output, and magic-trace likely wouldn't exist were it not for their efforts. Thank you, `perf` developers.
|
||||
|
||||
[magic-trace.org](https://magic-trace.org) is a fork of [Perfetto](https://github.com/janestreet/magic-trace/wiki/About-the-UI), with minor modifications. We'd like to thank the people at Google responsible for it. It's a high quality codebase that solves a hard problem well.
|
||||
|
||||
The ideas behind magic-trace are in no way unique. We've written down a list of [prior art](https://github.com/janestreet/magic-trace/wiki/Prior-art) that has influenced its design.
|
||||
@@ -0,0 +1,7 @@
|
||||
# WeHub 来源说明
|
||||
|
||||
- 原始项目：`janestreet/magic-trace`
|
||||
- 原始仓库：https://github.com/janestreet/magic-trace
|
||||
- 导入方式：上游默认分支的最新快照
|
||||
- 原作者、版权和许可证信息以原始仓库及本仓库 LICENSE 为准
|
||||
- 本文件仅用于记录来源，不代表 WeHub 是原项目作者
|
||||
@@ -0,0 +1,17 @@
|
||||
(executables
|
||||
(names magic_trace_bin)
|
||||
(public_names magic-trace)
|
||||
(libraries core magic_trace_lib core_unix.command_unix)
|
||||
(link_flags
|
||||
(:standard -cclib -lstdc++))
|
||||
(foreign_stubs
|
||||
(language c)
|
||||
(names version_stubs))
|
||||
(preprocess
|
||||
(pps ppx_jane)))
|
||||
|
||||
(rule
|
||||
(target version_stubs.c)
|
||||
(deps gen-versions.sh)
|
||||
(action
|
||||
(run %{deps} %{target})))
|
||||
Executable
+18
@@ -0,0 +1,18 @@
|
||||
#!/bin/sh
|
||||
|
||||
if [ -z "$1" ]; then
|
||||
echo "Usage: $0 <file to generate>"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
VERSION="$(git describe --always --dirty --abbrev=7 --tags)"
|
||||
|
||||
cat > "$1" <<EOF
|
||||
#include <caml/mlvalues.h>
|
||||
#include <caml/memory.h>
|
||||
#include <caml/alloc.h>
|
||||
|
||||
CAMLprim value generated_hg_version(value unit __attribute__ ((unused))) {
|
||||
return caml_copy_string("${VERSION}");
|
||||
}
|
||||
EOF
|
||||
@@ -0,0 +1,3 @@
|
||||
open! Core
|
||||
|
||||
let () = Command_unix.run Magic_trace_lib.Trace.command
|
||||
@@ -0,0 +1 @@
|
||||
(*_ This signature is deliberately empty. *)
|
||||
Vendored
+5
@@ -0,0 +1,5 @@
|
||||
magic-trace (0.0-1) unstable; urgency=medium
|
||||
|
||||
* Base version to allow building in CI
|
||||
|
||||
-- Jane Street <opensource-contacts@janestreet.com> Sun, 20 Mar 2022 12:49:30 -0400
|
||||
Vendored
+15
@@ -0,0 +1,15 @@
|
||||
Source: magic-trace
|
||||
Section: devel
|
||||
Priority: optional
|
||||
Maintainer: Jane Street <opensource-contacts@janestreet.com>
|
||||
Build-Depends: debhelper-compat (= 12), opam, ocaml-dune
|
||||
Standards-Version: 4.5.1
|
||||
Homepage: https://github.com/janestreet/magic-trace
|
||||
Vcs-Browser: https://github.com/janestreet/magic-trace
|
||||
Vcs-Git: https://github.com/janestreet/magic-trace.git
|
||||
Rules-Requires-Root: no
|
||||
|
||||
Package: magic-trace
|
||||
Architecture: amd64
|
||||
Depends: ${shlibs:Depends}, ${misc:Depends}
|
||||
Description: Easy Intel Processor Trace visualizer
|
||||
+21
@@ -0,0 +1,21 @@
|
||||
#!/usr/bin/make -f
|
||||
export DH_VERBOSE=1
|
||||
export DEBIAN_DIR=$(shell dirname $(realpath $(firstword $(MAKEFILE_LIST))))
|
||||
export OPAMROOT=${DEBIAN_DIR}/.opam
|
||||
|
||||
%:
|
||||
dh $@
|
||||
|
||||
override_dh_clean:
|
||||
rm -rf "${OPAMROOT}"
|
||||
dh_clean
|
||||
|
||||
override_dh_auto_build:
|
||||
opam init -y --bare
|
||||
opam switch create -y 5.2.0+ox --repos "ox=git+https://github.com/oxcaml/opam-repository.git#231c88c2e564fdca40e15e750aacad5fb0887435,default"
|
||||
opam exec -- opam install -y . --deps-only --locked
|
||||
opam exec -- dh_auto_build
|
||||
|
||||
override_dh_auto_install:
|
||||
make install PREFIX=debian/magic-trace
|
||||
rm -rf debian/magic-trace/lib
|
||||
Vendored
+1
@@ -0,0 +1 @@
|
||||
3.0 (quilt)
|
||||
@@ -0,0 +1,7 @@
|
||||
# Demonstrations
|
||||
|
||||
This directory contains programs that demonstrate how to use magic trace with
|
||||
different languages.
|
||||
|
||||
To play around with one, run it (e.g. ./demo.js) and use magic-trace to create
|
||||
a trace.
|
||||
@@ -0,0 +1,2 @@
|
||||
bin/
|
||||
obj/
|
||||
@@ -0,0 +1,12 @@
|
||||
using System;
|
||||
using System.IO;
|
||||
|
||||
FileStream r = new FileStream("/dev/zero", FileMode.Open, FileAccess.Read);
|
||||
FileStream w = new FileStream("/dev/null", FileMode.Open, FileAccess.Write);
|
||||
int len = 4096;
|
||||
byte[] buf = new byte[len];
|
||||
|
||||
for(;;) {
|
||||
r.Read(buf, 0, len);
|
||||
w.Write(buf, 0, len);
|
||||
}
|
||||
@@ -0,0 +1,10 @@
|
||||
<Project Sdk="Microsoft.NET.Sdk">
|
||||
|
||||
<PropertyGroup>
|
||||
<OutputType>Exe</OutputType>
|
||||
<TargetFramework>net6.0</TargetFramework>
|
||||
<ImplicitUsings>enable</ImplicitUsings>
|
||||
<Nullable>enable</Nullable>
|
||||
</PropertyGroup>
|
||||
|
||||
</Project>
|
||||
Executable
+2
@@ -0,0 +1,2 @@
|
||||
#!/usr/bin/env bash
|
||||
COMPlus_PerfMapEnabled=1 dotnet run
|
||||
Executable
+37
@@ -0,0 +1,37 @@
|
||||
///usr/bin/env -S gcc -std=c99 -Wall -ldl -o demo "$0" -o /tmp/demo && exec /tmp/demo "$@"
|
||||
|
||||
#include <dlfcn.h>
|
||||
#include <gnu/lib-names.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
int main(void) {
|
||||
FILE *out = fopen("/dev/null", "w");
|
||||
for (;;) {
|
||||
void *handle;
|
||||
double (*cosine)(double);
|
||||
char *error;
|
||||
double cos1, cos2;
|
||||
|
||||
handle = dlopen(LIBM_SO, RTLD_LAZY);
|
||||
if (!handle) {
|
||||
fprintf(stderr, "%s\n", dlerror());
|
||||
exit(EXIT_FAILURE);
|
||||
}
|
||||
|
||||
dlerror();
|
||||
|
||||
cosine = (double (*)(double))dlsym(handle, "cos");
|
||||
error = dlerror();
|
||||
if (error != NULL) {
|
||||
fprintf(stderr, "%s\n", error);
|
||||
exit(EXIT_FAILURE);
|
||||
}
|
||||
|
||||
cos1 = cosine(2.0);
|
||||
cos2 = cosine(cos1);
|
||||
|
||||
fprintf(out, "%f\n", cos2);
|
||||
dlclose(handle);
|
||||
}
|
||||
}
|
||||
Executable
+19
@@ -0,0 +1,19 @@
|
||||
///usr/bin/env -S clang++ "$0" -o /tmp/demo && exec /tmp/demo "$@"
|
||||
#include <fstream>
|
||||
|
||||
using namespace std;
|
||||
|
||||
int main()
|
||||
{
|
||||
ifstream r;
|
||||
ofstream w;
|
||||
r.open("/dev/zero", ios::binary);
|
||||
w.open("/dev/null", ios::binary);
|
||||
char buf[4096] = {0};
|
||||
for (;;)
|
||||
{
|
||||
r.read(buf, sizeof(buf));
|
||||
w.write(buf, sizeof(buf));
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
Executable
+25
@@ -0,0 +1,25 @@
|
||||
///usr/bin/true; go build -ldflags=-compressdwarf=false -gcflags=-dwarflocationlists=true -o /tmp/demo demo.go; exec /tmp/demo
|
||||
package main
|
||||
|
||||
import (
|
||||
"os"
|
||||
)
|
||||
|
||||
func check(e error) {
|
||||
if e != nil {
|
||||
panic(e)
|
||||
}
|
||||
}
|
||||
|
||||
func main() {
|
||||
r, err := os.Open("/dev/zero")
|
||||
check(err)
|
||||
w, err := os.Create("/dev/null")
|
||||
check(err)
|
||||
buf := make([]byte, 4096)
|
||||
for i := 0; i < 10; i++ {
|
||||
_, err = r.Read(buf)
|
||||
_, err = w.Write(buf)
|
||||
check(err)
|
||||
}
|
||||
}
|
||||
Executable
+23
@@ -0,0 +1,23 @@
|
||||
#!/usr/bin/env -S node --perf-basic-prof
|
||||
// Magic-trace requires a map of JIT-ed symbols, which node will
|
||||
// generate if you provide --perf-basic-prof.
|
||||
|
||||
// Spams HTTP requests to an HTTP server. One connection, one request in flight at all times.
|
||||
const http = require('http');
|
||||
const PORT = 40210
|
||||
|
||||
function req(req, resp) {
|
||||
resp.end()
|
||||
}
|
||||
|
||||
server = http.createServer(req);
|
||||
server.listen(PORT);
|
||||
|
||||
const options = { host: '127.0.0.1', method: 'GET', path: '/', port: PORT }
|
||||
|
||||
const reqloop = () => {
|
||||
var request = http.request(options, (response) => reqloop())
|
||||
request.end()
|
||||
};
|
||||
|
||||
reqloop();
|
||||
Executable
+11
@@ -0,0 +1,11 @@
|
||||
#!/usr/bin/env ocaml
|
||||
|
||||
let () =
|
||||
let r = open_in "/dev/zero" in
|
||||
let w = open_out "/dev/null" in
|
||||
let buf = Bytes.create 4096 in
|
||||
while true do
|
||||
let bytes_read = input r buf 0 (Bytes.length buf) in
|
||||
output w buf 0 bytes_read
|
||||
done
|
||||
;;
|
||||
@@ -0,0 +1,17 @@
|
||||
#!/usr/bin/env -S java -XX:+UnlockDiagnosticVMOptions -XX:+DebugNonSafepoints -XX:+DumpPerfMapAtExit -XX:+PreserveFramePointer --source 17
|
||||
|
||||
import java.io.FileReader;
|
||||
import java.io.FileWriter;
|
||||
import java.io.IOException;
|
||||
|
||||
public class java {
|
||||
public static void main(String[] args) throws IOException {
|
||||
FileReader r = new FileReader("/dev/zero");
|
||||
FileWriter w = new FileWriter("/dev/null");
|
||||
char[] buf = new char[4096];
|
||||
for (;;) {
|
||||
int bytesRead = r.read(buf);
|
||||
w.write(buf, 0, bytesRead);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -0,0 +1,98 @@
|
||||
# The magic-trace direct backend and ideas for the future
|
||||
|
||||
The `direct_backend` subdirectory of `magic-trace` contains an
|
||||
alternative backend which directly uses `perf_event_open` and the
|
||||
`libipt` library to capture the Processor Trace data and decode it.
|
||||
This is faster for decoding than going via the `perf` command, and
|
||||
gives more control, but had more gotchas and needed more work than
|
||||
initially expected.
|
||||
|
||||
It works, but currently it doesn't support decoding usage of the Linux
|
||||
vDSO, which means whenever a vDSO syscall like getting the current time
|
||||
happens, it causes a trace decoding error leading to a short gap in the
|
||||
trace. It's also missing many other features `perf` has like
|
||||
multi-threaded recording and capturing multiple snapshots.
|
||||
|
||||
It remains here because it represents a substantial investment in
|
||||
figuring out how to directly use `perf_event_open` with Intel Processor
|
||||
Trace and `libipt` together, the only such example code I know of.
|
||||
Should anyone want to do something that requires deeper control over
|
||||
Processor Trace, they may need this code. That's also why it's
|
||||
open-sourced despite it not (yet) being set up to build outside the
|
||||
Jane Street tree, because it's potentially valuable reference code.
|
||||
|
||||
## The demand for instruction-level information
|
||||
|
||||
The main reason we started down the path to this backend is that the
|
||||
basic `perf` backend of `magic-trace` doesn't properly follow the
|
||||
effect of OCaml exceptions on the stack. Doing so requires noticing the
|
||||
instructions that push, pop and raise from the OCaml exception handler
|
||||
stack, which aren't branches and so aren't listed in perf's branch
|
||||
output.
|
||||
|
||||
The initial purpose of the `libipt` backend, as well as increased
|
||||
decoding performance, was enabling instruction-by-instruction decoding
|
||||
so we could follow exceptions properly.
|
||||
|
||||
## An alternative approach
|
||||
|
||||
During the process of implementing the direct backend, it became clear
|
||||
that the task was more difficult than we thought, and a picture of an
|
||||
alternative approach emerged, on that seemed like potentially less work
|
||||
than bringing the direct backend up to where `perf` is.
|
||||
|
||||
Here's a sketch about what the future of `magic-trace` could look like:
|
||||
|
||||
### perf dlfilter
|
||||
|
||||
Newer versions of `perf` have a feature called `perf-dlfilter` that
|
||||
allows `perf` to load a shared library which gets callbacks for decoded
|
||||
events using a C API. This was specifically designed to allow consuming
|
||||
Intel Processor Trace data very quickly and without text parsing.
|
||||
|
||||
We could implement a small shared library in something that's easy to
|
||||
connect with a C interface, like C/Rust/Zig, that does the following:
|
||||
|
||||
- Filter out jumps that are within the same symbol, currently we need
|
||||
to process and discard all of these in OCaml, which is inefficient.
|
||||
- Write out info about the relevant events in an efficient binary
|
||||
format that's easy to consume from OCaml, potentially even Fuchsia
|
||||
Trace Format.
|
||||
|
||||
This would achieve the goal of improving decoding performance with much
|
||||
less tricky C code and without reimplementing so many `perf` features.
|
||||
|
||||
### perf --control
|
||||
|
||||
Currently we tell `perf` to take snapshots by sending it `SIGUSR2`.
|
||||
This requires some arbitrary wait timers and has some issues reliably
|
||||
capturing snapshots when a process shuts down. The direct backend's use
|
||||
of `perf_event_open` was going to solve this.
|
||||
|
||||
However newer versions of perf add a `--control` flag that allows using
|
||||
a FIFO with acks to toggle events and take snapshots, removing the need
|
||||
for signals and waits, and also a `--snapshot=e` option to guarantee a
|
||||
snapshot on end if there hasn't been another snapshot.
|
||||
|
||||
### instruction-level decoding using basic blocks
|
||||
|
||||
In order to handle OCaml exceptions we need instruction-level decoding.
|
||||
This could've been done with `libipt` but an alternative way is to use
|
||||
a separate instruction decoding library/tool to decode the instructions
|
||||
between branch events provided by `perf`.
|
||||
|
||||
This would look something like having a cache of computed info for each
|
||||
previously encountered basic block, for example the exception handler
|
||||
pushes and pops present in it. When a new basic block (start and end
|
||||
address of execution with no intervening branches) is encountered, that
|
||||
range of the binary is decoded with a disassembler library and the
|
||||
necessary info computed from it and put in the cache.
|
||||
|
||||
There's a few potential ways to do this:
|
||||
|
||||
- Do the basic block decoding inside the `perf-dlfilter` stub and then
|
||||
pass out the decoded info.
|
||||
- Use an instruction decoding library from OCaml.
|
||||
- Use an offline disassembler tool like `objdump` on the entire binary
|
||||
and fetch basic blocks from that and parse them from text. This is
|
||||
probably the simplest to do from OCaml but would run slowest.
|
||||
@@ -0,0 +1,6 @@
|
||||
(library
|
||||
(name magic_trace_lib_cinaps_helpers)
|
||||
(no_dynlink)
|
||||
(libraries core)
|
||||
(preprocess
|
||||
(pps ppx_jane)))
|
||||
@@ -0,0 +1,119 @@
|
||||
(* -*- mode: tuareg -*- *)
|
||||
|
||||
open! Core
|
||||
|
||||
let p x = print_string [%string "\n%{x}\n"]
|
||||
|
||||
let event_kinds =
|
||||
( [ "other"
|
||||
; "call"
|
||||
; "ret"
|
||||
; "start_trace"
|
||||
; "end_trace"
|
||||
; "end_trace_syscall"
|
||||
; "install_handler"
|
||||
; "raise_exception"
|
||||
; "decode_error"
|
||||
; "jump"
|
||||
]
|
||||
, "event_kind" )
|
||||
;;
|
||||
|
||||
let decode_result = [ "end_of_trace"; "event"; "add_section" ], "decode_result"
|
||||
|
||||
let gen_ocaml_enum (enum, name) =
|
||||
let body =
|
||||
List.map enum ~f:(fun n -> [%string "| %{String.capitalize n}"])
|
||||
|> String.concat ~sep:" "
|
||||
in
|
||||
p
|
||||
[%string
|
||||
{|module %{String.capitalize name} =
|
||||
struct type t = %{body}
|
||||
[@@deriving sexp]
|
||||
end|}]
|
||||
;;
|
||||
|
||||
let gen_c_enum (enum, name) =
|
||||
let body =
|
||||
List.mapi enum ~f:(fun i n -> [%string "\t%{name}_%{n} = %{i#Int},\n"])
|
||||
|> String.concat
|
||||
in
|
||||
p [%string "enum %{name} {\n %{name}_none = -1,\n%{body}\t};"]
|
||||
;;
|
||||
|
||||
let event_packet =
|
||||
( [ "pid", "int"
|
||||
; "tid", "int"
|
||||
; "kind", "Event_kind.t"
|
||||
; "addr", "int"
|
||||
; "time", "int"
|
||||
; "isid", "int"
|
||||
; "symbol_begin", "int"
|
||||
; "symbol_end", "int"
|
||||
]
|
||||
, "event" )
|
||||
;;
|
||||
|
||||
let add_section_packet =
|
||||
( [ "filename", "string"; "offset", "int"; "size", "int"; "vaddr", "int"; "isid", "int" ]
|
||||
, "add_section" )
|
||||
;;
|
||||
|
||||
let decoding_config =
|
||||
( [ "sideband_filename", "string"
|
||||
; "pt_data_fd", "int"
|
||||
; "setup_info", "Manual_perf.Setup_info.t"
|
||||
]
|
||||
, "config" )
|
||||
;;
|
||||
|
||||
let mmap =
|
||||
[ "vaddr", "int"; "length", "int"; "offset", "int"; "filename", "string" ], "mmap"
|
||||
;;
|
||||
|
||||
let setup_info =
|
||||
( [ "initial_maps", "Mmap.t list"; "trace_meta", "Trace_meta.t"; "pid", "int" ]
|
||||
, "setup_info" )
|
||||
;;
|
||||
|
||||
let recording_config =
|
||||
( [ "pid", "int"
|
||||
; "data_size", "int"
|
||||
; "aux_size", "int"
|
||||
; "filter", "string option"
|
||||
; "pt_fd", "int"
|
||||
; "sb_fd", "int"
|
||||
]
|
||||
, "recording_config" )
|
||||
;;
|
||||
|
||||
let trace_meta =
|
||||
( [ "time_shift", "int"
|
||||
; "time_mult", "int"
|
||||
; "time_zero", "int"
|
||||
; "max_nonturbo_ratio", "int"
|
||||
]
|
||||
, "trace_meta" )
|
||||
;;
|
||||
|
||||
let gen_ocaml_record ?(for_sig = false) (pkt, name) =
|
||||
let body =
|
||||
List.map pkt ~f:(fun (f, t) -> [%string "mutable %{f} : %{t}"])
|
||||
|> String.concat ~sep:"; "
|
||||
in
|
||||
let joiner = if for_sig then ": sig" else "= struct" in
|
||||
p
|
||||
[%string
|
||||
{|module %{String.capitalize name} %{joiner}
|
||||
type t = { %{body} } [@@deriving sexp]
|
||||
end|}]
|
||||
;;
|
||||
|
||||
let gen_c_record_enum (pkt, name) =
|
||||
let body =
|
||||
List.map pkt ~f:(fun (f, t) -> [%string "\t%{name}_field_%{f} /* %{t} */,\n"])
|
||||
|> String.concat
|
||||
in
|
||||
p [%string "enum %{name}_field {\n%{body}\t};"]
|
||||
;;
|
||||
@@ -0,0 +1,18 @@
|
||||
open! Core
|
||||
|
||||
type enum := string list * string
|
||||
type record := (string * string) list * string
|
||||
|
||||
val event_kinds : enum
|
||||
val decode_result : enum
|
||||
val event_packet : record
|
||||
val add_section_packet : record
|
||||
val decoding_config : record
|
||||
val recording_config : record
|
||||
val mmap : record
|
||||
val setup_info : record
|
||||
val trace_meta : record
|
||||
val gen_ocaml_enum : enum -> unit
|
||||
val gen_ocaml_record : ?for_sig:bool -> record -> unit
|
||||
val gen_c_enum : enum -> unit
|
||||
val gen_c_record_enum : record -> unit
|
||||
@@ -0,0 +1,228 @@
|
||||
open! Core
|
||||
open! Import
|
||||
|
||||
module Generated_interop = struct
|
||||
(*$
|
||||
open Magic_trace_lib_cinaps_helpers.Trace_decoding_interop;;
|
||||
|
||||
gen_ocaml_enum event_kinds;;
|
||||
gen_ocaml_enum decode_result;;
|
||||
gen_ocaml_record event_packet;;
|
||||
gen_ocaml_record add_section_packet;;
|
||||
gen_ocaml_record decoding_config
|
||||
*)
|
||||
module Event_kind = struct
|
||||
type t =
|
||||
| Other
|
||||
| Call
|
||||
| Ret
|
||||
| Start_trace
|
||||
| End_trace
|
||||
| End_trace_syscall
|
||||
| Install_handler
|
||||
| Raise_exception
|
||||
| Decode_error
|
||||
| Jump
|
||||
[@@deriving sexp]
|
||||
end
|
||||
|
||||
module Decode_result = struct
|
||||
type t =
|
||||
| End_of_trace
|
||||
| Event
|
||||
| Add_section
|
||||
[@@deriving sexp]
|
||||
end
|
||||
|
||||
module Event = struct
|
||||
type t =
|
||||
{ mutable pid : int
|
||||
; mutable tid : int
|
||||
; mutable kind : Event_kind.t
|
||||
; mutable addr : int
|
||||
; mutable time : int
|
||||
; mutable isid : int
|
||||
; mutable symbol_begin : int
|
||||
; mutable symbol_end : int
|
||||
}
|
||||
[@@deriving sexp]
|
||||
end
|
||||
|
||||
module Add_section = struct
|
||||
type t =
|
||||
{ mutable filename : string
|
||||
; mutable offset : int
|
||||
; mutable size : int
|
||||
; mutable vaddr : int
|
||||
; mutable isid : int
|
||||
}
|
||||
[@@deriving sexp]
|
||||
end
|
||||
|
||||
module Config = struct
|
||||
type t =
|
||||
{ mutable sideband_filename : string
|
||||
; mutable pt_data_fd : int
|
||||
; mutable setup_info : Manual_perf.Setup_info.t
|
||||
}
|
||||
[@@deriving sexp]
|
||||
end
|
||||
(*$*)
|
||||
end
|
||||
|
||||
module Stub = struct
|
||||
include Generated_interop
|
||||
|
||||
(* In event, [symbol_{begin,end}] are set by OCaml and used by C to check if a jump
|
||||
remained in the same symbol, so we don't have to look up symbols after every jump. *)
|
||||
|
||||
let blank_event () : Event.t =
|
||||
{ pid = 1
|
||||
; tid = 1
|
||||
; kind = Event_kind.Other
|
||||
; addr = 0
|
||||
; time = 0
|
||||
; isid = 0
|
||||
; symbol_begin = 0
|
||||
; symbol_end = 0
|
||||
}
|
||||
;;
|
||||
|
||||
let blank_add_section () : Add_section.t =
|
||||
{ filename = ""; offset = 0; size = 0; vaddr = 0; isid = 0 }
|
||||
;;
|
||||
|
||||
type c_decoding_state
|
||||
|
||||
external init_decoder : Config.t -> c_decoding_state = "magic_pt_init_decoder_stub"
|
||||
|
||||
external run_decoder
|
||||
: c_decoding_state
|
||||
-> Event.t
|
||||
-> Add_section.t
|
||||
-> Decode_result.t
|
||||
= "magic_pt_run_decoder_stub"
|
||||
end
|
||||
|
||||
type state =
|
||||
{ elfs_by_filename : Elf.t Filename.Table.t
|
||||
; resolver_by_isid : Elf.Symbol_resolver.t Int.Table.t
|
||||
; mutable fallback_resolvers : (int * int * Elf.Symbol_resolver.t) list
|
||||
}
|
||||
|
||||
let handle_add_section (state : state) (add : Stub.Add_section.t) =
|
||||
(* Core.print_s [%message "handle_add_section" (add : Stub.Add_section.t)]; *)
|
||||
let elf =
|
||||
match Hashtbl.find state.elfs_by_filename add.filename with
|
||||
| Some elf -> Some elf
|
||||
| None ->
|
||||
(match Elf.create add.filename with
|
||||
| None -> None
|
||||
| Some elf ->
|
||||
Hashtbl.add_exn state.elfs_by_filename ~key:add.filename ~data:elf;
|
||||
Some elf)
|
||||
in
|
||||
match elf with
|
||||
| None -> ()
|
||||
| Some elf ->
|
||||
let resolver : Elf.Symbol_resolver.t =
|
||||
{ elf; file_offset = add.offset; loaded_offset = add.vaddr }
|
||||
in
|
||||
state.fallback_resolvers
|
||||
<- (add.vaddr, add.size, resolver) :: state.fallback_resolvers;
|
||||
Hashtbl.add_exn state.resolver_by_isid ~key:add.isid ~data:resolver
|
||||
;;
|
||||
|
||||
let convert_trace_event state (event : Stub.Event.t) =
|
||||
let resolved : Elf.Symbol_resolver.resolved =
|
||||
let resolver =
|
||||
match Hashtbl.find state.resolver_by_isid event.isid with
|
||||
| Some resolver -> Some resolver
|
||||
| None ->
|
||||
(* Tracing start/stop events don't have an isid so we need a fallback *)
|
||||
List.find state.fallback_resolvers ~f:(fun (vaddr, size, _) ->
|
||||
event.addr > vaddr && event.addr < vaddr + size)
|
||||
|> Option.map ~f:(fun (_, _, r) -> r)
|
||||
in
|
||||
match resolver with
|
||||
| None -> { name = "[unknown section]"; start_addr = 0; end_addr = 0 }
|
||||
| Some resolver ->
|
||||
Elf.Symbol_resolver.resolve resolver event.addr
|
||||
|> Option.value ~default:{ name = "[unknown symbol]"; start_addr = 0; end_addr = 0 }
|
||||
in
|
||||
event.symbol_begin <- resolved.start_addr;
|
||||
event.symbol_end <- resolved.end_addr;
|
||||
let symbol = resolved.name in
|
||||
(* print_s [%message (event : Stub.Event.t) (symbol : string)]; *)
|
||||
let thread : Backend_intf.Event.Thread.t =
|
||||
{ pid = Pid.of_int event.pid; tid = event.tid }
|
||||
in
|
||||
let time = Time_ns.Span.of_int_ns event.time in
|
||||
let addr = event.addr in
|
||||
let kind =
|
||||
match event.kind with
|
||||
| Generated_interop.Event_kind.Other -> Backend_intf.Event.Unknown
|
||||
| Call -> Call
|
||||
| Ret -> Return
|
||||
| Start_trace -> Start
|
||||
| End_trace -> End None
|
||||
| End_trace_syscall -> End Syscall
|
||||
| Install_handler -> Other "Install_handler"
|
||||
| Raise_exception -> Other "Raise_exception"
|
||||
| Jump -> Jump
|
||||
| Decode_error -> Decode_error
|
||||
in
|
||||
let offset = event.addr - resolved.start_addr in
|
||||
{ Backend_intf.Event.thread
|
||||
; time
|
||||
; addr
|
||||
; kind
|
||||
; symbol
|
||||
; offset
|
||||
; ip
|
||||
; ip_symbol
|
||||
; ip_offset
|
||||
}
|
||||
;;
|
||||
|
||||
type t =
|
||||
{ state : state
|
||||
; decoder : Stub.c_decoding_state
|
||||
; event : Stub.Event.t
|
||||
; add_section : Stub.Add_section.t
|
||||
}
|
||||
|
||||
let create ~pt_file ~sideband_file ~setup_file =
|
||||
let setup_info =
|
||||
In_channel.read_all setup_file
|
||||
|> Sexp.of_string
|
||||
|> [%of_sexp: Manual_perf.Setup_info.t]
|
||||
in
|
||||
(* print_s [%sexp (setup_info : Manual_perf.Setup_info.t)]; *)
|
||||
let%bind.With pt_data_fd f = Core_unix.with_file pt_file ~mode:[ O_RDONLY ] ~f in
|
||||
let config : Stub.Config.t =
|
||||
{ sideband_filename = sideband_file
|
||||
; pt_data_fd = Core_unix.File_descr.to_int pt_data_fd
|
||||
; setup_info
|
||||
}
|
||||
in
|
||||
let state =
|
||||
{ elfs_by_filename = Filename.Table.create ()
|
||||
; resolver_by_isid = Int.Table.create ()
|
||||
; fallback_resolvers = []
|
||||
}
|
||||
in
|
||||
let event = Stub.blank_event () in
|
||||
let add_section = Stub.blank_add_section () in
|
||||
let decoder = Stub.init_decoder config in
|
||||
{ state; decoder; event; add_section }
|
||||
;;
|
||||
|
||||
let rec decode_one t =
|
||||
match Stub.run_decoder t.decoder t.event t.add_section with
|
||||
| End_of_trace -> None
|
||||
| Event -> Some (convert_trace_event t.state t.event)
|
||||
| Add_section ->
|
||||
handle_add_section t.state t.add_section;
|
||||
decode_one t
|
||||
;;
|
||||
@@ -0,0 +1,7 @@
|
||||
open! Core
|
||||
open! Import
|
||||
|
||||
type t
|
||||
|
||||
val create : pt_file:Filename.t -> sideband_file:Filename.t -> setup_file:Filename.t -> t
|
||||
val decode_one : t -> Backend_intf.Event.t option
|
||||
@@ -0,0 +1,535 @@
|
||||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
#include <unistd.h>
|
||||
#include <stdbool.h>
|
||||
#include <assert.h>
|
||||
|
||||
#include <sys/mman.h>
|
||||
#include <linux/perf_event.h>
|
||||
|
||||
#include <intel-pt.h>
|
||||
#include <libipt-sb.h>
|
||||
#include <pevent.h>
|
||||
|
||||
#include <caml/mlvalues.h>
|
||||
#include <caml/custom.h>
|
||||
#include <caml/fail.h>
|
||||
#include <caml/memory.h>
|
||||
#include <caml/callback.h>
|
||||
#include <caml/alloc.h>
|
||||
|
||||
/*** INTEROP CODE ***/
|
||||
|
||||
/*$
|
||||
open Magic_trace_lib_cinaps_helpers.Trace_decoding_interop ;;
|
||||
|
||||
gen_c_enum event_kinds ;;
|
||||
gen_c_enum decode_result ;;
|
||||
gen_c_record_enum event_packet ;;
|
||||
gen_c_record_enum add_section_packet ;;
|
||||
gen_c_record_enum decoding_config ;;
|
||||
gen_c_record_enum mmap ;;
|
||||
gen_c_record_enum trace_meta ;;
|
||||
gen_c_record_enum setup_info ;;
|
||||
*/
|
||||
enum event_kind {
|
||||
event_kind_none = -1,
|
||||
event_kind_other = 0,
|
||||
event_kind_call = 1,
|
||||
event_kind_ret = 2,
|
||||
event_kind_start_trace = 3,
|
||||
event_kind_end_trace = 4,
|
||||
event_kind_end_trace_syscall = 5,
|
||||
event_kind_install_handler = 6,
|
||||
event_kind_raise_exception = 7,
|
||||
event_kind_decode_error = 8,
|
||||
event_kind_jump = 9,
|
||||
};
|
||||
|
||||
enum decode_result {
|
||||
decode_result_none = -1,
|
||||
decode_result_end_of_trace = 0,
|
||||
decode_result_event = 1,
|
||||
decode_result_add_section = 2,
|
||||
};
|
||||
|
||||
enum event_field {
|
||||
event_field_pid /* int */,
|
||||
event_field_tid /* int */,
|
||||
event_field_kind /* Event_kind.t */,
|
||||
event_field_addr /* int */,
|
||||
event_field_time /* int */,
|
||||
event_field_isid /* int */,
|
||||
event_field_symbol_begin /* int */,
|
||||
event_field_symbol_end /* int */,
|
||||
};
|
||||
|
||||
enum add_section_field {
|
||||
add_section_field_filename /* string */,
|
||||
add_section_field_offset /* int */,
|
||||
add_section_field_size /* int */,
|
||||
add_section_field_vaddr /* int */,
|
||||
add_section_field_isid /* int */,
|
||||
};
|
||||
|
||||
enum config_field {
|
||||
config_field_sideband_filename /* string */,
|
||||
config_field_pt_data_fd /* int */,
|
||||
config_field_setup_info /* Manual_perf.Setup_info.t */,
|
||||
};
|
||||
|
||||
enum mmap_field {
|
||||
mmap_field_vaddr /* int */,
|
||||
mmap_field_length /* int */,
|
||||
mmap_field_offset /* int */,
|
||||
mmap_field_filename /* string */,
|
||||
};
|
||||
|
||||
enum trace_meta_field {
|
||||
trace_meta_field_time_shift /* int */,
|
||||
trace_meta_field_time_mult /* int */,
|
||||
trace_meta_field_time_zero /* int */,
|
||||
trace_meta_field_max_nonturbo_ratio /* int */,
|
||||
};
|
||||
|
||||
enum setup_info_field {
|
||||
setup_info_field_initial_maps /* Mmap.t list */,
|
||||
setup_info_field_trace_meta /* Trace_meta.t */,
|
||||
setup_info_field_pid /* int */,
|
||||
};
|
||||
/*$*/
|
||||
|
||||
|
||||
unsigned char TODO_ASM_INSTALL[] = { 0 };
|
||||
|
||||
/*** MAIN ***/
|
||||
|
||||
struct pending_section {
|
||||
char *filename;
|
||||
uint64_t offset;
|
||||
uint64_t size;
|
||||
uint64_t vaddr;
|
||||
uint64_t isid;
|
||||
|
||||
struct pending_section *next;
|
||||
};
|
||||
|
||||
struct decoding_state {
|
||||
// passed
|
||||
int pt_fd;
|
||||
|
||||
// internal to the decoding state
|
||||
uint8_t *pt_mmap;
|
||||
size_t pt_length;
|
||||
uint64_t tsc;
|
||||
|
||||
struct pt_insn_decoder *decoder;
|
||||
struct pt_image_section_cache *iscache;
|
||||
struct pt_sb_session *session;
|
||||
|
||||
struct pev_config pev_config;
|
||||
|
||||
enum event_kind pending_event_kind;
|
||||
bool last_was_syscall;
|
||||
|
||||
bool pt_synced;
|
||||
int saved_status;
|
||||
|
||||
struct pending_section *pending_section_head;
|
||||
|
||||
// These values are only used temporarily during decode calls
|
||||
value *event;
|
||||
value *add_section;
|
||||
enum decode_result pending_decode_result;
|
||||
};
|
||||
|
||||
static void destroy_decoding_state(struct decoding_state *s) {
|
||||
if (!s) return;
|
||||
|
||||
if (s->pt_mmap) munmap(s->pt_mmap, s->pt_length);
|
||||
if (s->decoder) pt_insn_free_decoder(s->decoder);
|
||||
if (s->iscache) pt_iscache_free(s->iscache);
|
||||
if (s->session) pt_sb_free(s->session);
|
||||
free(s);
|
||||
}
|
||||
|
||||
/*** EVENT HANDLERS ***/
|
||||
|
||||
static void commit_event(struct decoding_state *s) {
|
||||
uint64_t timestamp_ns;
|
||||
// This only fails if we call it wrong
|
||||
assert(pev_time_from_tsc(×tamp_ns, s->tsc, &(s->pev_config)) == 0);
|
||||
Store_field(*s->event, event_field_time, Val_long(timestamp_ns));
|
||||
s->pending_decode_result = decode_result_event;
|
||||
}
|
||||
|
||||
static int handle_event(struct decoding_state *s, const struct pt_event *event) {
|
||||
int error = 0;
|
||||
if (event->has_tsc) {
|
||||
s->tsc = event->tsc;
|
||||
}
|
||||
|
||||
enum event_kind kind = event_kind_none;
|
||||
uint64_t ip = 0;
|
||||
switch (event->type) {
|
||||
case ptev_enabled:
|
||||
kind = event_kind_start_trace;
|
||||
ip = event->variant.enabled.ip;
|
||||
break;
|
||||
case ptev_disabled:
|
||||
kind = s->last_was_syscall ? event_kind_end_trace_syscall : event_kind_end_trace;
|
||||
ip = event->variant.disabled.ip;
|
||||
break;
|
||||
case ptev_async_disabled:
|
||||
kind = event_kind_end_trace;
|
||||
ip = event->variant.async_disabled.ip;
|
||||
break;
|
||||
default:
|
||||
break;
|
||||
}
|
||||
if(kind != event_kind_none) {
|
||||
Store_field(*s->event, event_field_kind, Val_int(kind));
|
||||
if(ip) Store_field(*s->event, event_field_addr, Val_int(ip));
|
||||
Store_field(*s->event, event_field_isid, Val_int(0));
|
||||
commit_event(s);
|
||||
}
|
||||
|
||||
|
||||
struct pt_image *image = NULL;
|
||||
error = pt_sb_event(s->session, &image, event, sizeof(*event), stdout,
|
||||
0);
|
||||
// ptsbp_verbose | ptsbp_filename | ptsbp_file_offset | ptsbp_tsc);
|
||||
if (error < 0) return error;
|
||||
|
||||
if (image) {
|
||||
return pt_insn_set_image(s->decoder, image);
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
static void handle_instruction(struct decoding_state *s, const struct pt_insn *insn) {
|
||||
uint64_t ip = insn->ip;
|
||||
uint64_t prev_sym_start = Long_val(Field(*s->event, event_field_symbol_begin));
|
||||
uint64_t prev_sym_end = Long_val(Field(*s->event, event_field_symbol_end));
|
||||
|
||||
if(s->pending_event_kind != event_kind_none) {
|
||||
Store_field(*s->event, event_field_kind, Val_int(s->pending_event_kind));
|
||||
Store_field(*s->event, event_field_addr, Val_int(ip));
|
||||
Store_field(*s->event, event_field_isid, Val_int(insn->isid));
|
||||
commit_event(s);
|
||||
s->pending_event_kind = event_kind_none;
|
||||
}
|
||||
|
||||
enum event_kind kind = event_kind_none;
|
||||
switch (insn->iclass) {
|
||||
case ptic_call:
|
||||
kind = event_kind_call;
|
||||
break;
|
||||
case ptic_return:
|
||||
kind = event_kind_ret;
|
||||
break;
|
||||
case ptic_jump: case ptic_cond_jump: case ptic_far_jump:
|
||||
// do not report a jump as an event if we remain in the address space of the current
|
||||
// symbol
|
||||
if (prev_sym_start <= ip && ip < prev_sym_end)
|
||||
break;
|
||||
kind = event_kind_jump;
|
||||
break;
|
||||
case ptic_far_return: // sysreturn
|
||||
case ptic_far_call: // syscall
|
||||
case ptic_other:
|
||||
/* TODO: handle checking exception handlers */
|
||||
// fallthrough
|
||||
default:
|
||||
break;
|
||||
}
|
||||
s->last_was_syscall = (insn->iclass == ptic_far_call);
|
||||
s->pending_event_kind = kind;
|
||||
}
|
||||
|
||||
|
||||
/*** LIBIPT BOILERPLATE ***/
|
||||
// https://github.com/intel/libipt/blob/master/doc/howto_libipt.md
|
||||
|
||||
static void pop_pending_section(struct decoding_state *s) {
|
||||
if(s->pending_section_head != NULL) {
|
||||
struct pending_section *popped = s->pending_section_head;
|
||||
s->pending_section_head = popped->next;
|
||||
|
||||
Store_field(*s->add_section, add_section_field_filename, caml_copy_string(popped->filename));
|
||||
Store_field(*s->add_section, add_section_field_offset, Val_long(popped->offset));
|
||||
Store_field(*s->add_section, add_section_field_size, Val_long(popped->size));
|
||||
Store_field(*s->add_section, add_section_field_vaddr, Val_long(popped->vaddr));
|
||||
Store_field(*s->add_section, add_section_field_isid, Val_int(popped->isid));
|
||||
s->pending_decode_result = decode_result_add_section;
|
||||
|
||||
free(popped->filename);
|
||||
free(popped);
|
||||
}
|
||||
}
|
||||
|
||||
static int handle_events(struct decoding_state *s, int status) {
|
||||
while (status & pts_event_pending) {
|
||||
struct pt_event event;
|
||||
|
||||
status = pt_insn_event(s->decoder, &event, sizeof(event));
|
||||
if (status < 0) break;
|
||||
|
||||
handle_event(s, &event);
|
||||
if (s->pending_decode_result != decode_result_none) break;
|
||||
}
|
||||
|
||||
return status;
|
||||
}
|
||||
|
||||
// Turn this to true to enable debug printing for decoding issues
|
||||
static const bool debug_decoding = false;
|
||||
|
||||
static int decode_until_event(struct decoding_state *s) {
|
||||
uint64_t offset;
|
||||
int status = s->saved_status;
|
||||
|
||||
pop_pending_section(s);
|
||||
if (s->pending_decode_result != decode_result_none) return 0;
|
||||
|
||||
if(!s->pt_synced) {
|
||||
status = pt_insn_sync_forward(s->decoder);
|
||||
if(debug_decoding) {
|
||||
pt_insn_get_offset(s->decoder, &offset);
|
||||
printf("1 %d %lx\n", status, offset); fflush(stdout);
|
||||
}
|
||||
if (status == -pte_eos) {
|
||||
s->pending_decode_result = decode_result_end_of_trace;
|
||||
return 0;
|
||||
}
|
||||
if (status < 0) return status;
|
||||
s->pt_synced = true;
|
||||
}
|
||||
|
||||
for (;;) {
|
||||
struct pt_insn insn;
|
||||
status = handle_events(s, status);
|
||||
if(debug_decoding) {
|
||||
printf("2 %s %d\n", pt_errstr(-status), s->pending_decode_result); fflush(stdout);
|
||||
}
|
||||
if (status < 0) goto decode_error;
|
||||
if (s->pending_decode_result != decode_result_none) break;
|
||||
pop_pending_section(s);
|
||||
if (s->pending_decode_result != decode_result_none) break;
|
||||
|
||||
status = pt_insn_next(s->decoder, &insn, sizeof(insn));
|
||||
if(debug_decoding) {
|
||||
printf("3 %s %d\n", pt_errstr(-status), s->pending_decode_result); fflush(stdout);
|
||||
}
|
||||
if (insn.iclass != ptic_error) {
|
||||
handle_instruction(s, &insn);
|
||||
}
|
||||
if (status < 0) goto decode_error;
|
||||
if (s->pending_decode_result != decode_result_none) break;
|
||||
}
|
||||
|
||||
s->saved_status = status;
|
||||
return status;
|
||||
|
||||
decode_error:
|
||||
if(debug_decoding) {
|
||||
pt_insn_get_offset(s->decoder, &offset);
|
||||
printf("error %s at %lx\n", pt_errstr(-status), offset); fflush(stdout);
|
||||
}
|
||||
Store_field(*s->event, event_field_kind, Val_int(event_kind_decode_error));
|
||||
commit_event(s);
|
||||
s->pt_synced = false;
|
||||
s->saved_status = 0;
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
static void do_add_section_callback(void *s_void, const char *filename, uint64_t offset,
|
||||
uint64_t size, uint64_t vaddr, int isid) {
|
||||
if (filename[0] != '/') return;
|
||||
struct decoding_state *s = s_void;
|
||||
|
||||
struct pending_section *section = malloc(sizeof(*section));
|
||||
section->filename = strdup(filename);
|
||||
section->offset = offset;
|
||||
section->size = size;
|
||||
section->vaddr = vaddr;
|
||||
section->isid = isid;
|
||||
section->next = s->pending_section_head;
|
||||
s->pending_section_head = section;
|
||||
}
|
||||
|
||||
static int add_initial_images(struct decoding_state *s, value mmap_list, uint32_t pid) {
|
||||
CAMLparam1(mmap_list);
|
||||
CAMLlocal3(list, cur, filename_val);
|
||||
|
||||
int error = 0;
|
||||
struct pt_sb_context *context;
|
||||
error = pt_sb_get_context_by_pid(&context, s->session, pid);
|
||||
if(error < 0) CAMLreturn(error);
|
||||
|
||||
for (list = mmap_list; Is_block(list); list = Field(list, 1)) {
|
||||
cur = Field(list, 0);
|
||||
filename_val = Field(cur, mmap_field_filename);
|
||||
const char *filename = String_val(filename_val);
|
||||
uint64_t
|
||||
vaddr = Long_val(Field(cur, mmap_field_vaddr)),
|
||||
size = Long_val(Field(cur, mmap_field_length)),
|
||||
offset = Long_val(Field(cur, mmap_field_offset));
|
||||
if (filename[0] != '/') continue;
|
||||
|
||||
error = pt_sb_ctx_mmap(s->session, context, filename, offset, size, vaddr);
|
||||
if (error < 0) break;
|
||||
}
|
||||
|
||||
CAMLreturn(error);
|
||||
}
|
||||
|
||||
static int setup_decoding(struct decoding_state *s, value setup_info, value sb_filename) {
|
||||
CAMLparam2(setup_info, sb_filename);
|
||||
int error;
|
||||
|
||||
// mmap
|
||||
off_t pt_length = lseek(s->pt_fd, 0, SEEK_END);
|
||||
if (pt_length == -1) CAMLreturn (-1);
|
||||
s->pt_length = pt_length;
|
||||
s->pt_mmap = mmap(NULL, pt_length, PROT_READ, MAP_SHARED, s->pt_fd, 0);
|
||||
|
||||
if (s->pt_mmap == MAP_FAILED) CAMLreturn (-1);
|
||||
|
||||
value trace_meta = Field(setup_info, setup_info_field_trace_meta);
|
||||
|
||||
// instruction decoder
|
||||
struct pt_config config;
|
||||
|
||||
memset(&config, 0, sizeof(config));
|
||||
config.size = sizeof(config);
|
||||
config.begin = s->pt_mmap;
|
||||
config.end = s->pt_mmap + s->pt_length;
|
||||
config.flags.variant.insn.enable_tick_events = 1;
|
||||
|
||||
config.nom_freq = Long_val(Field(trace_meta, trace_meta_field_max_nonturbo_ratio));
|
||||
|
||||
s->decoder = pt_insn_alloc_decoder(&config);
|
||||
if (!s->decoder) CAMLreturn (-pte_bad_config);
|
||||
|
||||
// image cache
|
||||
s->iscache = pt_iscache_alloc(NULL);
|
||||
if (!s->iscache) CAMLreturn (-1);
|
||||
pt_iscache_set_file_hook(s->iscache, do_add_section_callback, s);
|
||||
|
||||
// pevent sideband
|
||||
s->session = pt_sb_alloc(s->iscache);
|
||||
if (!s->session) CAMLreturn(-1);
|
||||
|
||||
struct pt_sb_pevent_config pevent;
|
||||
memset(&pevent, 0, sizeof(pevent));
|
||||
pevent.primary = 1;
|
||||
pevent.size = sizeof(pevent);
|
||||
pevent.kernel_start = UINT64_MAX;
|
||||
pevent.filename = String_val(sb_filename);
|
||||
pevent.begin = pevent.end = 0;
|
||||
pevent.sample_type = s->pev_config.sample_type =
|
||||
PERF_SAMPLE_IP | PERF_SAMPLE_TID | PERF_SAMPLE_TIME;
|
||||
|
||||
pevent.time_shift = s->pev_config.time_shift =
|
||||
Long_val(Field(trace_meta, trace_meta_field_time_shift));
|
||||
pevent.time_mult = s->pev_config.time_mult =
|
||||
Long_val(Field(trace_meta, trace_meta_field_time_mult));
|
||||
pevent.time_zero = s->pev_config.time_zero =
|
||||
Long_val(Field(trace_meta, trace_meta_field_time_zero));
|
||||
|
||||
// Use these for debugging with libipt tooling
|
||||
// printf("--cpu 6/85/7 --cpuid-0x15.ebx %u --cpuid-0x15.eax %u --nom-freq %u --mtc-freq %u\n",
|
||||
// config.cpuid_0x15_ebx, config.cpuid_0x15_eax, config.nom_freq, config.mtc_freq);
|
||||
// printf("--pevent:sample-type %lu --pevent:time-shift %u --pevent:time-mult %u --pevent:time-zero %lu --pevent:primary %s\n",
|
||||
// pevent.sample_type, pevent.time_shift, pevent.time_mult, pevent.time_zero, pevent.filename);
|
||||
|
||||
error = pt_sb_alloc_pevent_decoder(s->session, &pevent);
|
||||
if (error < 0) CAMLreturn (error);
|
||||
|
||||
error = pt_sb_init_decoders(s->session);
|
||||
if (error < 0) CAMLreturn (error);
|
||||
|
||||
intnat pid = Long_val(Field(setup_info, setup_info_field_pid));
|
||||
error = add_initial_images(s, Field(setup_info, setup_info_field_initial_maps), pid);
|
||||
if (error < 0) CAMLreturn (error);
|
||||
|
||||
CAMLreturn (error);
|
||||
}
|
||||
|
||||
/*** OCAML STUBS ***/
|
||||
|
||||
#define Decoding_state_val(v) (*((struct decoding_state **) Data_custom_val(v)))
|
||||
|
||||
static void finalize_decoding_state(value v) {
|
||||
destroy_decoding_state(Decoding_state_val(v));
|
||||
}
|
||||
|
||||
|
||||
static struct custom_operations decoding_state_ops =
|
||||
{ .identifier = "com.janestreet.magic-trace.decoding_state"
|
||||
, .finalize = finalize_decoding_state
|
||||
, .compare = custom_compare_default
|
||||
, .compare_ext = custom_compare_ext_default
|
||||
, .hash = custom_hash_default
|
||||
, .serialize = custom_serialize_default
|
||||
, .deserialize = custom_deserialize_default
|
||||
, .fixed_length = custom_fixed_length_default
|
||||
};
|
||||
|
||||
|
||||
CAMLprim value magic_pt_init_decoder_stub(value config) {
|
||||
CAMLparam1(config);
|
||||
CAMLlocal1(v);
|
||||
|
||||
struct decoding_state *state = malloc(sizeof(*state));
|
||||
v = caml_alloc_custom(&decoding_state_ops, sizeof(state), 0, 1);
|
||||
Decoding_state_val(v) = state;
|
||||
|
||||
memset(state, 0, sizeof(*state));
|
||||
state->pt_fd = Int_val(Field(config, config_field_pt_data_fd));
|
||||
state->pending_event_kind = event_kind_none;
|
||||
state->last_was_syscall = false;
|
||||
state->pt_synced = false;
|
||||
state->pending_section_head = NULL;
|
||||
state->saved_status = 0;
|
||||
pev_config_init(&state->pev_config);
|
||||
|
||||
int status = setup_decoding(state,
|
||||
Field(config, config_field_setup_info),
|
||||
Field(config, config_field_sideband_filename));
|
||||
|
||||
if(status < 0) {
|
||||
destroy_decoding_state(state);
|
||||
caml_failwith(pt_errstr(-status));
|
||||
}
|
||||
|
||||
CAMLreturn(v);
|
||||
}
|
||||
|
||||
CAMLprim value magic_pt_run_decoder_stub(value state_v, value event, value add_section) {
|
||||
CAMLparam3(state_v, event, add_section);
|
||||
|
||||
struct decoding_state *state = Decoding_state_val(state_v);
|
||||
|
||||
// We need to shove these in the state instead of using another parameter because of the
|
||||
// add_section callback only having access to the state.
|
||||
state->event = &event;
|
||||
state->add_section = &add_section;
|
||||
state->pending_decode_result = decode_result_none;
|
||||
|
||||
int result = decode_until_event(state);
|
||||
|
||||
state->event = NULL;
|
||||
state->add_section = NULL;
|
||||
|
||||
if(result < 0) {
|
||||
caml_failwith(pt_errstr(-result));
|
||||
}
|
||||
|
||||
enum decode_result decode_result = state->pending_decode_result;
|
||||
assert(decode_result >= 0);
|
||||
CAMLreturn(Val_int(decode_result));
|
||||
}
|
||||
@@ -0,0 +1,3 @@
|
||||
module Backend_intf = Magic_trace_core.Backend_intf
|
||||
module Elf = Magic_trace_core.Elf
|
||||
module Errno = Magic_trace_core.Errno
|
||||
@@ -0,0 +1,84 @@
|
||||
open! Core
|
||||
open! Async
|
||||
|
||||
let pt_file dir = dir ^/ "auxdata.bin"
|
||||
let sb_file dir = dir ^/ "sideband.bin"
|
||||
let setup_file dir = dir ^/ "setup.sexp"
|
||||
|
||||
type record_opts = unit
|
||||
|
||||
let record_param = Command.Param.return ()
|
||||
|
||||
type recording =
|
||||
{ state : Manual_perf.Tracing_state.t
|
||||
; mutable snapshot_taken : bool
|
||||
}
|
||||
|
||||
let attach_and_record () ~record_dir ?filter pid =
|
||||
let res =
|
||||
let setup_file = setup_file record_dir in
|
||||
let pt_file = pt_file record_dir in
|
||||
let sideband_file = sb_file record_dir in
|
||||
let%map.Or_error state =
|
||||
Manual_perf.Tracing_state.attach ?filter ~pt_file ~sideband_file ~setup_file pid
|
||||
in
|
||||
{ state; snapshot_taken = false }
|
||||
in
|
||||
Deferred.return res
|
||||
;;
|
||||
|
||||
let take_snapshot t =
|
||||
match t.snapshot_taken with
|
||||
| true -> Ok ()
|
||||
| false ->
|
||||
t.snapshot_taken <- true;
|
||||
Manual_perf.Tracing_state.take_snapshot t.state
|
||||
;;
|
||||
|
||||
let finish_recording' t =
|
||||
Manual_perf.Tracing_state.destroy t.state;
|
||||
Or_error.return ()
|
||||
;;
|
||||
|
||||
let finish_recording t = Deferred.return (finish_recording' t)
|
||||
|
||||
type decode_opts = unit
|
||||
|
||||
let decode_param = Command.Param.return ()
|
||||
|
||||
let rec fill_with_items n q decoder =
|
||||
if n = 0
|
||||
then ()
|
||||
else (
|
||||
match Decoding.decode_one decoder with
|
||||
| Some item ->
|
||||
Queue.enqueue q item;
|
||||
fill_with_items (n - 1) q decoder
|
||||
| None -> ())
|
||||
;;
|
||||
|
||||
let decode_events () ~record_dir =
|
||||
(* Adapt the decoder to a pipe by pushing things in batches to avoid going through the
|
||||
async scheduler on every event. *)
|
||||
let batch_size = 100 in
|
||||
let rec decode_into decoder writer =
|
||||
let q = Queue.create ~capacity:batch_size () in
|
||||
fill_with_items batch_size q decoder;
|
||||
match Queue.is_empty q with
|
||||
| true ->
|
||||
Pipe.close writer;
|
||||
Deferred.unit
|
||||
| false ->
|
||||
let%bind () = Pipe.transfer_in writer ~from:q in
|
||||
decode_into decoder writer
|
||||
in
|
||||
let reader, writer = Pipe.create ~size_budget:batch_size () in
|
||||
let decoder =
|
||||
Decoding.create
|
||||
~pt_file:(pt_file record_dir)
|
||||
~sideband_file:(sb_file record_dir)
|
||||
~setup_file:(setup_file record_dir)
|
||||
in
|
||||
don't_wait_for (decode_into decoder writer);
|
||||
Deferred.Or_error.return reader
|
||||
;;
|
||||
@@ -0,0 +1,2 @@
|
||||
open! Import
|
||||
include Backend_intf.S
|
||||
@@ -0,0 +1,141 @@
|
||||
open! Core
|
||||
open! Import
|
||||
|
||||
module Generated_interop = struct
|
||||
[@@@disable_unused_warnings]
|
||||
|
||||
(*$
|
||||
open Magic_trace_lib_cinaps_helpers.Trace_decoding_interop;;
|
||||
|
||||
gen_ocaml_record recording_config;;
|
||||
gen_ocaml_record trace_meta;;
|
||||
gen_ocaml_record mmap;;
|
||||
gen_ocaml_record setup_info
|
||||
*)
|
||||
module Recording_config = struct
|
||||
type t =
|
||||
{ mutable pid : int
|
||||
; mutable data_size : int
|
||||
; mutable aux_size : int
|
||||
; mutable filter : string option
|
||||
; mutable pt_fd : int
|
||||
; mutable sb_fd : int
|
||||
}
|
||||
[@@deriving sexp]
|
||||
end
|
||||
|
||||
module Trace_meta = struct
|
||||
type t =
|
||||
{ mutable time_shift : int
|
||||
; mutable time_mult : int
|
||||
; mutable time_zero : int
|
||||
; mutable max_nonturbo_ratio : int
|
||||
}
|
||||
[@@deriving sexp]
|
||||
end
|
||||
|
||||
module Mmap = struct
|
||||
type t =
|
||||
{ mutable vaddr : int
|
||||
; mutable length : int
|
||||
; mutable offset : int
|
||||
; mutable filename : string
|
||||
}
|
||||
[@@deriving sexp]
|
||||
end
|
||||
|
||||
module Setup_info = struct
|
||||
type t =
|
||||
{ mutable initial_maps : Mmap.t list
|
||||
; mutable trace_meta : Trace_meta.t
|
||||
; mutable pid : int
|
||||
}
|
||||
[@@deriving sexp]
|
||||
end
|
||||
(*$*)
|
||||
end
|
||||
|
||||
module Stub = struct
|
||||
include Generated_interop
|
||||
|
||||
type c_tracing_state
|
||||
|
||||
external create_empty_state
|
||||
: unit
|
||||
-> c_tracing_state
|
||||
= "magic_recording_create_state_stub"
|
||||
|
||||
external take_snapshot : c_tracing_state -> int = "magic_recording_take_snapshot_stub"
|
||||
|
||||
external destroy_tracing_state
|
||||
: c_tracing_state
|
||||
-> unit
|
||||
= "magic_recording_destroy_stub"
|
||||
|
||||
external attach
|
||||
: c_tracing_state
|
||||
-> Recording_config.t
|
||||
-> Trace_meta.t
|
||||
-> int
|
||||
= "magic_recording_attach_stub"
|
||||
end
|
||||
|
||||
module Mmap = Stub.Mmap
|
||||
module Trace_meta = Stub.Trace_meta
|
||||
module Setup_info = Stub.Setup_info
|
||||
|
||||
let read_current_maps pid =
|
||||
Owee_linux_maps.scan_pid (Pid.to_int pid)
|
||||
|> List.filter_map
|
||||
~f:(fun { address_start; address_end; pathname; offset; perm_execute; _ } ->
|
||||
match perm_execute with
|
||||
| false -> None
|
||||
| true ->
|
||||
let open Int64 in
|
||||
Some
|
||||
{ Mmap.vaddr = to_int_exn address_start
|
||||
; length = address_end - address_start |> to_int_exn
|
||||
; offset = to_int_exn offset
|
||||
; filename = pathname
|
||||
})
|
||||
;;
|
||||
|
||||
module Tracing_state = struct
|
||||
type t = Stub.c_tracing_state
|
||||
|
||||
let attach
|
||||
?(data_size = 0x400000)
|
||||
?(aux_size = 0x400000)
|
||||
?filter
|
||||
~pt_file
|
||||
~sideband_file
|
||||
~setup_file
|
||||
pid
|
||||
=
|
||||
let state = Stub.create_empty_state () in
|
||||
let trace_meta : Stub.Trace_meta.t =
|
||||
{ time_shift = 0; time_mult = 0; time_zero = 0; max_nonturbo_ratio = 0 }
|
||||
in
|
||||
let open_fd name =
|
||||
Core_unix.openfile ~mode:[ O_RDWR; O_CREAT; O_TRUNC ] name
|
||||
|> Core_unix.File_descr.to_int
|
||||
in
|
||||
let pt_fd = open_fd pt_file in
|
||||
let sb_fd = open_fd sideband_file in
|
||||
let config : Stub.Recording_config.t =
|
||||
{ pid = Pid.to_int pid; data_size; aux_size; filter; pt_fd; sb_fd }
|
||||
in
|
||||
let%map.Result () = Stub.attach state config trace_meta |> Errno.to_result in
|
||||
Out_channel.write_all
|
||||
setup_file
|
||||
~data:
|
||||
([%sexp
|
||||
({ initial_maps = read_current_maps pid; trace_meta; pid = Pid.to_int pid }
|
||||
: Setup_info.t)]
|
||||
|> Sexp.to_string);
|
||||
state
|
||||
;;
|
||||
|
||||
let destroy t = Stub.destroy_tracing_state t
|
||||
let take_snapshot t = Stub.take_snapshot t |> Errno.to_result
|
||||
end
|
||||
@@ -0,0 +1,56 @@
|
||||
open! Core
|
||||
open! Async
|
||||
|
||||
(*$
|
||||
open Magic_trace_lib_cinaps_helpers.Trace_decoding_interop;;
|
||||
|
||||
gen_ocaml_record ~for_sig:true trace_meta;;
|
||||
gen_ocaml_record ~for_sig:true mmap;;
|
||||
gen_ocaml_record ~for_sig:true setup_info
|
||||
*)
|
||||
module Trace_meta : sig
|
||||
type t =
|
||||
{ mutable time_shift : int
|
||||
; mutable time_mult : int
|
||||
; mutable time_zero : int
|
||||
; mutable max_nonturbo_ratio : int
|
||||
}
|
||||
[@@deriving sexp]
|
||||
end
|
||||
|
||||
module Mmap : sig
|
||||
type t =
|
||||
{ mutable vaddr : int
|
||||
; mutable length : int
|
||||
; mutable offset : int
|
||||
; mutable filename : string
|
||||
}
|
||||
[@@deriving sexp]
|
||||
end
|
||||
|
||||
module Setup_info : sig
|
||||
type t =
|
||||
{ mutable initial_maps : Mmap.t list
|
||||
; mutable trace_meta : Trace_meta.t
|
||||
; mutable pid : int
|
||||
}
|
||||
[@@deriving sexp]
|
||||
end
|
||||
(*$*)
|
||||
|
||||
module Tracing_state : sig
|
||||
type t
|
||||
|
||||
val attach
|
||||
: ?data_size:int
|
||||
-> ?aux_size:int
|
||||
-> ?filter:string
|
||||
-> pt_file:Filename.t
|
||||
-> sideband_file:Filename.t
|
||||
-> setup_file:Filename.t
|
||||
-> Pid.t
|
||||
-> t Or_error.t
|
||||
|
||||
val take_snapshot : t -> unit Or_error.t
|
||||
val destroy : t -> unit
|
||||
end
|
||||
@@ -0,0 +1,369 @@
|
||||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
#include <stdbool.h>
|
||||
#include <unistd.h>
|
||||
#include <errno.h>
|
||||
#include <string.h>
|
||||
#include <fcntl.h>
|
||||
#include <poll.h>
|
||||
|
||||
#include <sys/syscall.h>
|
||||
#include <sys/mman.h>
|
||||
#include <sys/ioctl.h>
|
||||
|
||||
#include <linux/perf_event.h>
|
||||
|
||||
#include <caml/mlvalues.h>
|
||||
#include <caml/custom.h>
|
||||
#include <caml/memory.h>
|
||||
#include <caml/threads.h>
|
||||
|
||||
/*** INTEROP CODE ***/
|
||||
|
||||
/*$
|
||||
open Magic_trace_lib_cinaps_helpers.Trace_decoding_interop ;;
|
||||
|
||||
gen_c_record_enum recording_config ;;
|
||||
gen_c_record_enum trace_meta ;;
|
||||
*/
|
||||
enum recording_config_field {
|
||||
recording_config_field_pid /* int */,
|
||||
recording_config_field_data_size /* int */,
|
||||
recording_config_field_aux_size /* int */,
|
||||
recording_config_field_filter /* string option */,
|
||||
recording_config_field_pt_fd /* int */,
|
||||
recording_config_field_sb_fd /* int */,
|
||||
};
|
||||
|
||||
enum trace_meta_field {
|
||||
trace_meta_field_time_shift /* int */,
|
||||
trace_meta_field_time_mult /* int */,
|
||||
trace_meta_field_time_zero /* int */,
|
||||
trace_meta_field_max_nonturbo_ratio /* int */,
|
||||
};
|
||||
/*$*/
|
||||
|
||||
|
||||
/*** UTIL ***/
|
||||
|
||||
#define or_ret(val) \
|
||||
do { \
|
||||
int __res = (val); \
|
||||
if (__res != 0) return __res; \
|
||||
} while (0)
|
||||
|
||||
static int write_all(int fd, const char *buf, size_t amt) {
|
||||
size_t written = 0;
|
||||
while (written < amt) {
|
||||
ssize_t res = write(fd, buf + written, amt - written);
|
||||
if (res < 0) return res;
|
||||
written += res;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int sys_perf_event_open(struct perf_event_attr *attr, pid_t pid,
|
||||
int cpu, int group_fd, unsigned long flags) {
|
||||
return syscall(SYS_perf_event_open, attr, pid, cpu, group_fd, flags);
|
||||
}
|
||||
|
||||
static uint64_t round_power2_pages(uint64_t n) {
|
||||
uint64_t r = sysconf(_SC_PAGESIZE);
|
||||
while (r < n) r <<= 1;
|
||||
return r;
|
||||
}
|
||||
|
||||
static bool pt_aux_buffer_has_wrapped(char *buf, size_t size) {
|
||||
// check the last 512-ish words of the buffer for zeros
|
||||
// cast to words to make it a bit faster.
|
||||
int upper = size / sizeof(uint64_t);
|
||||
int lower = upper - 512;
|
||||
if(lower < 0) lower = 0;
|
||||
|
||||
uint64_t *word_buf = (uint64_t*)buf;
|
||||
for (int i = lower; i < upper; i++) {
|
||||
if (word_buf[i])
|
||||
return true;
|
||||
}
|
||||
|
||||
return false;
|
||||
}
|
||||
|
||||
static int dump_pt_aux_buffer(int fd, char *base,
|
||||
uint64_t size, uint64_t head_) {
|
||||
bool has_wrapped = pt_aux_buffer_has_wrapped(base, size);
|
||||
// printf("ptdump %lu %lu %d\n", size, head_, has_wrapped); fflush(stdout);
|
||||
char *end = base + size;
|
||||
char *head = base + (head_ & (size - 1));
|
||||
|
||||
if (!has_wrapped) {
|
||||
or_ret(write_all(fd, base, head - base));
|
||||
} else {
|
||||
or_ret(write_all(fd, head, end - head));
|
||||
or_ret(write_all(fd, base, head - base));
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int dump_perf_buffer(int fd, char *base,
|
||||
uint64_t size, uint64_t head_, uint64_t tail_) {
|
||||
// printf("dumping %lu %lu %lu\n", size, head_, tail_); fflush(stdout);
|
||||
char *end = base + size;
|
||||
char *head = base + (head_ & (size - 1));
|
||||
char *tail = base + (tail_ & (size - 1));
|
||||
|
||||
if (tail <= head) {
|
||||
or_ret(write_all(fd, tail, head - tail));
|
||||
} else {
|
||||
or_ret(write_all(fd, tail, end - tail));
|
||||
or_ret(write_all(fd, base, head - base));
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
// See [lib/pmc/src/msr_stubs.c:187] for an explanation
|
||||
#define rmb() asm volatile("" ::: "memory")
|
||||
|
||||
/*** OPERATIONS ***/
|
||||
|
||||
struct tracing_state {
|
||||
bool failure_state;
|
||||
int intel_pt_type;
|
||||
int perf_fd;
|
||||
struct perf_event_mmap_page *header;
|
||||
char *base, *data, *aux;
|
||||
uint64_t base_mmap_size, aux_mmap_size;
|
||||
|
||||
int pt_fd;
|
||||
int sb_fd;
|
||||
};
|
||||
|
||||
static int read_int_file(const char *path, int *result) {
|
||||
FILE* intel_pt_type_f = fopen(path, "r");
|
||||
if (intel_pt_type_f == NULL) return -1;
|
||||
int res = fscanf(intel_pt_type_f, "%d", result);
|
||||
fclose(intel_pt_type_f);
|
||||
return (res != 1) ? -1 : 0;
|
||||
}
|
||||
|
||||
static int init_tracing_state(struct tracing_state *s) {
|
||||
if(read_int_file("/sys/bus/event_source/devices/intel_pt/type", &s->intel_pt_type))
|
||||
return -1;
|
||||
|
||||
s->failure_state = false;
|
||||
s->perf_fd = -1;
|
||||
s->base = s->data = s->aux = NULL;
|
||||
s->base_mmap_size = s->aux_mmap_size = 0;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int destroy_tracing_state(struct tracing_state *s) {
|
||||
if (!s) return 0;
|
||||
|
||||
if (s->perf_fd != -1) {
|
||||
close(s->perf_fd);
|
||||
s->perf_fd = -1;
|
||||
}
|
||||
|
||||
if (s->aux) munmap(s->aux, s->aux_mmap_size);
|
||||
if (s->base) munmap(s->base, s->base_mmap_size);
|
||||
|
||||
close(s->pt_fd);
|
||||
close(s->sb_fd);
|
||||
|
||||
s->aux = s->base = NULL;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
static int dump_tracing_data(struct tracing_state *s) {
|
||||
if (ioctl(s->perf_fd, PERF_EVENT_IOC_DISABLE) == -1) return -1;
|
||||
|
||||
struct perf_event_mmap_page *hdr = s->header;
|
||||
|
||||
uint64_t data_head = hdr->data_head, data_tail = hdr->data_tail;
|
||||
// perf_event_open documentation dictates that after reading the head field of a
|
||||
// circular buffer an rmb() should be issued
|
||||
rmb();
|
||||
|
||||
|
||||
or_ret(dump_perf_buffer(s->sb_fd, s->data, hdr->data_size,
|
||||
data_head, data_tail));
|
||||
hdr->data_tail = data_head;
|
||||
|
||||
uint64_t aux_head = hdr->aux_head;
|
||||
rmb();
|
||||
|
||||
or_ret(dump_pt_aux_buffer(s->pt_fd, s->aux, hdr->aux_size, aux_head));
|
||||
hdr->aux_tail = aux_head;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int dump_tracing_data_withfailure(struct tracing_state *s) {
|
||||
if (!s || s->failure_state || s->perf_fd == -1) {
|
||||
errno = EINVAL;
|
||||
return -1;
|
||||
}
|
||||
|
||||
int ret = dump_tracing_data(s);
|
||||
if (ret != 0) s->failure_state = true;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static int start_tracing(struct tracing_state *s, value config, value trace_meta) {
|
||||
if (!s || s->failure_state || s->perf_fd != -1) {
|
||||
errno = EINVAL;
|
||||
goto failed_tracing;
|
||||
}
|
||||
|
||||
s->pt_fd = Long_val(Field(config, recording_config_field_pt_fd));
|
||||
s->sb_fd = Long_val(Field(config, recording_config_field_sb_fd));
|
||||
|
||||
int max_nonturbo_ratio;
|
||||
if(read_int_file("/sys/bus/event_source/devices/intel_pt/max_nonturbo_ratio", &max_nonturbo_ratio))
|
||||
goto failed_tracing;
|
||||
|
||||
int pid = Int_val(Field(config, recording_config_field_pid));
|
||||
uint64_t data_size_raw = Long_val(Field(config, recording_config_field_data_size));
|
||||
uint64_t aux_size_raw = Long_val(Field(config, recording_config_field_aux_size));
|
||||
value filter_v = Field(config, recording_config_field_filter);
|
||||
// Current libraries are too old for option constructors, but can manually substitute
|
||||
// https://github.com/ocaml/ocaml/commit/973eeb1867f41ef2669ad4cbfa9c2e76ddef1749#diff-3fac38e5f784aae1fec51339ed6c17636608cdbcb35e2a99ca181a371fd0e894R376
|
||||
char *filter = Is_block(filter_v) ? strdup(String_val(Field(filter_v, 0))) : NULL;
|
||||
|
||||
// https://github.com/intel/libipt/blob/master/doc/howto_tracing.md
|
||||
struct perf_event_attr attr;
|
||||
memset(&attr, 0, sizeof(attr));
|
||||
|
||||
attr.type = s->intel_pt_type;
|
||||
attr.exclude_kernel = 1;
|
||||
attr.exclude_hv = 1;
|
||||
attr.sample_period = attr.sample_freq = 1;
|
||||
attr.sample_type = PERF_SAMPLE_IP | PERF_SAMPLE_TID | PERF_SAMPLE_TIME;
|
||||
attr.sample_id_all = attr.mmap = attr.mmap2 = attr.context_switch = 1;
|
||||
|
||||
// These config bits were determined by running this command:
|
||||
// grep -H . /sys/bus/event_source/devices/intel_pt/format/*
|
||||
// It's reasonably complex to parse these dynamically, and they seem consistent
|
||||
// so for now we'll just hard-code the following bits:
|
||||
// cyc (bit 1)=1 - enable high-resolution cycle counts
|
||||
// cyc_thresh (bits 19-22)=1 - set them to the maximum possible frequency
|
||||
// tsc (bit 10)=1 - enable time stamp counter packets for calibration
|
||||
attr.config = (1 << 19) | (1 << 1) | (1 << 10);
|
||||
|
||||
attr.comm = attr.comm_exec = 1;
|
||||
attr.task = 1;
|
||||
attr.context_switch = 1;
|
||||
|
||||
// Track a specific pid, on any cpu. There should only be one active at any time so
|
||||
// grouping is unnecessary.
|
||||
s->perf_fd = sys_perf_event_open(&attr, pid, -1, -1, PERF_FLAG_FD_CLOEXEC);
|
||||
if (s->perf_fd == -1) goto failed_open;
|
||||
|
||||
uint64_t data_size = round_power2_pages(data_size_raw);
|
||||
uint64_t aux_size = round_power2_pages(aux_size_raw);
|
||||
uint64_t base_mmap_size = data_size + sysconf(_SC_PAGESIZE);
|
||||
s->base = mmap(NULL, base_mmap_size, PROT_WRITE,
|
||||
MAP_SHARED, s->perf_fd, 0);
|
||||
if (s->base == MAP_FAILED) goto failed_base;
|
||||
s->base_mmap_size = base_mmap_size;
|
||||
|
||||
s->header = (struct perf_event_mmap_page *)s->base;
|
||||
s->data = s->base + s->header->data_offset;
|
||||
s->header->data_tail = 0;
|
||||
|
||||
s->header->aux_offset = s->header->data_offset + s->header->data_size;
|
||||
s->header->aux_size = aux_size;
|
||||
|
||||
s->aux = mmap(NULL, s->header->aux_size, PROT_READ,
|
||||
MAP_SHARED, s->perf_fd, s->header->aux_offset);
|
||||
if (s->aux == MAP_FAILED) goto failed_aux;
|
||||
s->aux_mmap_size = aux_size;
|
||||
|
||||
if (filter) {
|
||||
if (ioctl(s->perf_fd, PERF_EVENT_IOC_SET_FILTER, filter) == -1) goto failed_ioctl;
|
||||
free(filter);
|
||||
}
|
||||
|
||||
Store_field(trace_meta, trace_meta_field_time_shift, Val_long(s->header->time_shift));
|
||||
Store_field(trace_meta, trace_meta_field_time_mult, Val_long(s->header->time_mult));
|
||||
Store_field(trace_meta, trace_meta_field_time_zero, Val_long(s->header->time_zero));
|
||||
Store_field(trace_meta, trace_meta_field_max_nonturbo_ratio, Val_long(max_nonturbo_ratio));
|
||||
|
||||
return 0;
|
||||
|
||||
// error states
|
||||
failed_ioctl:
|
||||
failed_aux:
|
||||
munmap(s->base, base_mmap_size);
|
||||
failed_base:
|
||||
close(s->perf_fd);
|
||||
s->perf_fd = -1;
|
||||
failed_open:
|
||||
s->failure_state = true;
|
||||
if(filter) free(filter);
|
||||
failed_tracing:
|
||||
return -1;
|
||||
}
|
||||
|
||||
/*** OCAML HOOKS ***/
|
||||
|
||||
#define Tracing_state_val(v) (*((struct tracing_state **) Data_custom_val(v)))
|
||||
|
||||
static void finalize_tracing_state(value v) {
|
||||
destroy_tracing_state(Tracing_state_val(v));
|
||||
}
|
||||
|
||||
static struct custom_operations tracing_state_ops =
|
||||
{ .identifier = "com.janestreet.magic-trace.tracing_state"
|
||||
, .finalize = finalize_tracing_state
|
||||
, .compare = custom_compare_default
|
||||
, .compare_ext = custom_compare_ext_default
|
||||
, .hash = custom_hash_default
|
||||
, .serialize = custom_serialize_default
|
||||
, .deserialize = custom_deserialize_default
|
||||
, .fixed_length = custom_fixed_length_default
|
||||
};
|
||||
|
||||
CAMLprim value magic_recording_create_state_stub(value unit __attribute__((unused)) ) {
|
||||
CAMLparam0 ();
|
||||
CAMLlocal1 (v);
|
||||
|
||||
struct tracing_state *s = malloc(sizeof(*s));
|
||||
v = caml_alloc_custom(&tracing_state_ops, sizeof(s), 0, 1);
|
||||
Tracing_state_val(v) = s;
|
||||
|
||||
CAMLreturn (v);
|
||||
}
|
||||
|
||||
static value attach_to_process(value state, value config, value trace_meta) {
|
||||
struct tracing_state *s = Tracing_state_val(state);
|
||||
if(init_tracing_state(s)) return -1;
|
||||
if(start_tracing(s, config, trace_meta)) return -1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
CAMLprim value magic_recording_attach_stub(value state, value config, value trace_meta) {
|
||||
int result = attach_to_process(state, config, trace_meta);
|
||||
return Val_int(result ? errno : 0);
|
||||
}
|
||||
|
||||
CAMLprim value magic_recording_take_snapshot_stub(value v) {
|
||||
int result = dump_tracing_data_withfailure(Tracing_state_val(v));
|
||||
return Val_int(result ? errno : 0);
|
||||
}
|
||||
|
||||
CAMLprim value magic_recording_destroy_stub(value v) {
|
||||
destroy_tracing_state(Tracing_state_val(v));
|
||||
Tracing_state_val(v) = NULL;
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1 @@
|
||||
<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" viewBox="0 0 288 288"><defs><style>.cls-1{fill:#fd248a;stroke-width:20px;}.cls-1,.cls-3{stroke:#fff;stroke-miterlimit:10;}.cls-2{fill:#fff;}.cls-3{stroke-width:8px;fill:url(#linear-gradient);}</style><linearGradient id="linear-gradient" x1="78.98" y1="107.81" x2="111.44" y2="2.46" gradientUnits="userSpaceOnUse"><stop offset="0.02" stop-color="#fff" stop-opacity="0.1"/><stop offset="0.41" stop-color="#fff" stop-opacity="0.4"/><stop offset="0.71" stop-color="#fff" stop-opacity="0.25"/><stop offset="0.98" stop-color="#fff" stop-opacity="0.1"/></linearGradient></defs><title>magic-trace-for dark mode</title><g id="Layer_5" data-name="Layer 5"><circle class="cls-1" cx="147.34" cy="140.56" r="120.15"/></g><g id="Layer_8" data-name="Layer 8"><path class="cls-2" d="M276.48,17.54l-89.39,87.27-80.74,86.13a31.92,31.92,0,0,0-5.06,9.48c-2.13,6-5.07,8.66-5.07,8.66l-4.58,5.23s-7.51,4.25-9.8,5.23-7.36,6.86-5.4,11.6c0,0-2.45,3.92-6.53,3.43s-23.7,19.78-23.7,19.78-5.23,5.23-5.39,10.79S31,274.29,31,274.29l-1.31,2.12S25.78,279,25,277.72s-1.47,0-1.47,0-11.6-4.25-13.23-12.09l1.3-2.95s-1.47-7.19,6.87-11.44c0,0,.49-2.94,2.94-2,0,0,2-3.27,4.74-2.94,0,0,2.94-3.92,3.59-3.59s-.65-.33-.65-.33,5.23-1.15,7.84-4.09,9.16-11.6,8.67-13.07S48.83,224,48.83,224s1.14,2.13,2.12.49,15.36-17.16,15.36-17.16a7.85,7.85,0,0,1,4.09-4.08c2.94-1.15,8.33-10,8.33-10a9.55,9.55,0,0,0,5.4-5.4c1.3-3.92,6.86-2.12,6.86-2.12s3.92-1.15,5.39-3.11,57.2-53.93,60.47-57.52,4.42-2.62,13.73-12.1S272.89,14.43,272.89,14.43,277.63,11.49,276.48,17.54Z"/></g><g id="Layer_7" data-name="Layer 7"><path class="cls-2" d="M173.75,146.79a2.09,2.09,0,0,0,1,1.41c3.26.93,4.76,3.32,5.66,6.33a2.16,2.16,0,0,0,1.08,1.36c3,.93,4.36,3.16,5.18,5.91,2.29,7.69,5.77,14.71,11.6,20.35,3.57,3.47,7.15,7,11,10.12,10.07,8.23,19.56,17,27.49,27.38a57.67,57.67,0,0,1,11.16,27.16c.87,5.93,3.83,9.83,9.28,12.06a51.45,51.45,0,0,1,6,2.81,4.57,4.57,0,0,1,2.41,2.49c.58,1.88.16,3.95-1.32,4.88a7.31,7.31,0,0,0-2.71,2.67c-1.5,3.1-4.12,4.72-7.1,5.89a4.49,4.49,0,0,1-2.61-.09c-4.05-1.13-5-4.58-5.41-8a13.58,13.58,0,0,0-4.22-8.76c-1.3-1.2-2.76-2.24-4.27-3.45.28.34-3.13-1-3.55-1.16a62.84,62.84,0,0,1-8.55-3.27c-6.25-3.28-11.4-8-16.15-13.18-8.38-9.12-15.06-19.43-21-30.22-6.51-11.75-14.63-21.79-27.4-27.22-2.31-1-3.42-3-4.13-5.36-.19-.61-.58-1.44-1.09-1.64a7.77,7.77,0,0,1-5.29-6.33,1.82,1.82,0,0,0-.95-1.22c-3.48-1.23-5.45-3.61-5.6-7.22a22.39,22.39,0,0,1-3-1c-2.17-1.09-4-4.63-2.84-5.62,1.89-1.61,1-2.79,0-4.21a3.33,3.33,0,0,1-.47-1.38c-.34-2.18-.43-4.41-1-6.53-1.94-7.55-6.74-12.57-14-15.32-3-1.15-3.49-3.71-1-5.75,3.33-2.76,6.64-5.53,10-8.21.79-.63,2.22-1.52,2.71-1.22a5.81,5.81,0,0,1,2.69,3.14c1.82,8.26,6.3,14.15,14.37,17.08,1.81.65,3.76,1,5.5,1.78,1.2.54,1.95,1.43,3.51.36.75-.51,2.63,0,3.64.61,2.21,1.36,3.64,3.39,3.15,6.29A7.49,7.49,0,0,1,173.75,146.79Z"/></g><g id="Layer_3" data-name="Layer 3"><circle class="cls-3" cx="90.25" cy="71.25" r="55.1"/></g></svg>
|
||||
|
After Width: | Height: | Size: 2.9 KiB |
@@ -0,0 +1 @@
|
||||
<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" viewBox="0 0 288 288"><defs><style>.cls-1{fill:#fd248a;stroke-width:20px;}.cls-1,.cls-2{stroke:#000;stroke-miterlimit:10;}.cls-2{stroke-width:8px;fill:url(#linear-gradient);}</style><linearGradient id="linear-gradient" x1="78.98" y1="107.81" x2="111.44" y2="2.46" gradientUnits="userSpaceOnUse"><stop offset="0.02" stop-color="#fff" stop-opacity="0.1"/><stop offset="0.41" stop-color="#fff" stop-opacity="0.4"/><stop offset="0.71" stop-color="#fff" stop-opacity="0.25"/><stop offset="0.98" stop-color="#fff" stop-opacity="0.1"/></linearGradient></defs><title>magic-trace-for light mode</title><g id="Layer_5" data-name="Layer 5"><circle class="cls-1" cx="147.34" cy="140.56" r="120.15"/></g><g id="Layer_8" data-name="Layer 8"><path d="M276.48,17.54l-89.39,87.27-80.74,86.13a31.92,31.92,0,0,0-5.06,9.48c-2.13,6-5.07,8.66-5.07,8.66l-4.58,5.23s-7.51,4.25-9.8,5.23-7.36,6.86-5.4,11.6c0,0-2.45,3.92-6.53,3.43s-23.7,19.78-23.7,19.78-5.23,5.23-5.39,10.79S31,274.29,31,274.29l-1.31,2.12S25.78,279,25,277.72s-1.47,0-1.47,0-11.6-4.25-13.23-12.09l1.3-2.95s-1.47-7.19,6.87-11.44c0,0,.49-2.94,2.94-2,0,0,2-3.27,4.74-2.94,0,0,2.94-3.92,3.59-3.59s-.65-.33-.65-.33,5.23-1.15,7.84-4.09,9.16-11.6,8.67-13.07S48.83,224,48.83,224s1.14,2.13,2.12.49,15.36-17.16,15.36-17.16a7.85,7.85,0,0,1,4.09-4.08c2.94-1.15,8.33-10,8.33-10a9.55,9.55,0,0,0,5.4-5.4c1.3-3.92,6.86-2.12,6.86-2.12s3.92-1.15,5.39-3.11,57.2-53.93,60.47-57.52,4.42-2.62,13.73-12.1S272.89,14.43,272.89,14.43,277.63,11.49,276.48,17.54Z"/></g><g id="Layer_7" data-name="Layer 7"><path d="M173.75,146.79a2.09,2.09,0,0,0,1,1.41c3.26.93,4.76,3.32,5.66,6.33a2.16,2.16,0,0,0,1.08,1.36c3,.93,4.36,3.16,5.18,5.91,2.29,7.69,5.77,14.71,11.6,20.35,3.57,3.47,7.15,7,11,10.12,10.07,8.23,19.56,17,27.49,27.38a57.67,57.67,0,0,1,11.16,27.16c.87,5.93,3.83,9.83,9.28,12.06a51.45,51.45,0,0,1,6,2.81,4.57,4.57,0,0,1,2.41,2.49c.58,1.88.16,3.95-1.32,4.88a7.31,7.31,0,0,0-2.71,2.67c-1.5,3.1-4.12,4.72-7.1,5.89a4.49,4.49,0,0,1-2.61-.09c-4.05-1.13-5-4.58-5.41-8a13.58,13.58,0,0,0-4.22-8.76c-1.3-1.2-2.76-2.24-4.27-3.45.28.34-3.13-1-3.55-1.16a62.84,62.84,0,0,1-8.55-3.27c-6.25-3.28-11.4-8-16.15-13.18-8.38-9.12-15.06-19.43-21-30.22-6.51-11.75-14.63-21.79-27.4-27.22-2.31-1-3.42-3-4.13-5.36-.19-.61-.58-1.44-1.09-1.64a7.77,7.77,0,0,1-5.29-6.33,1.82,1.82,0,0,0-.95-1.22c-3.48-1.23-5.45-3.61-5.6-7.22a22.39,22.39,0,0,1-3-1c-2.17-1.09-4-4.63-2.84-5.62,1.89-1.61,1-2.79,0-4.21a3.33,3.33,0,0,1-.47-1.38c-.34-2.18-.43-4.41-1-6.53-1.94-7.55-6.74-12.57-14-15.32-3-1.15-3.49-3.71-1-5.75,3.33-2.76,6.64-5.53,10-8.21.79-.63,2.22-1.52,2.71-1.22a5.81,5.81,0,0,1,2.69,3.14c1.82,8.26,6.3,14.15,14.37,17.08,1.81.65,3.76,1,5.5,1.78,1.2.54,1.95,1.43,3.51.36.75-.51,2.63,0,3.64.61,2.21,1.36,3.64,3.39,3.15,6.29A7.49,7.49,0,0,1,173.75,146.79Z"/></g><g id="Layer_3" data-name="Layer 3"><circle class="cls-2" cx="90.25" cy="71.25" r="55.1"/></g></svg>
|
||||
|
After Width: | Height: | Size: 2.9 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 3.2 MiB |
Binary file not shown.
|
After Width: | Height: | Size: 4.0 MiB |
Binary file not shown.
|
After Width: | Height: | Size: 8.4 MiB |
Binary file not shown.
|
After Width: | Height: | Size: 10 MiB |
@@ -0,0 +1,8 @@
|
||||
(env
|
||||
(static
|
||||
(flags
|
||||
(:standard -cclib -static -cclib -no-pie))
|
||||
(link_flags
|
||||
(:standard -cclib -static -cclib -no-pie))))
|
||||
|
||||
(vendored_dirs vendor)
|
||||
@@ -0,0 +1 @@
|
||||
(lang dune 3.0)
|
||||
@@ -0,0 +1,9 @@
|
||||
# Magic_trace library
|
||||
|
||||
Used with the `magic-trace` tool to capture a trace of the execution
|
||||
leading up to a call to `Magic_trace.take_snapshot ()` for performance
|
||||
analysis and debugging.
|
||||
|
||||
The tool can attach to any symbol, but it defaults to the special
|
||||
symbol used by this library, making this the easiest way to modify
|
||||
your code to take a snapshot under certain conditions.
|
||||
@@ -0,0 +1,10 @@
|
||||
(library
|
||||
(name magic_trace)
|
||||
(public_name magic-trace.magic_trace)
|
||||
(no_dynlink)
|
||||
(foreign_stubs
|
||||
(language c)
|
||||
(names stop_stubs))
|
||||
(libraries core core_unix.time_stamp_counter)
|
||||
(preprocess
|
||||
(pps ppx_jane)))
|
||||
@@ -0,0 +1,41 @@
|
||||
open! Core
|
||||
|
||||
module Private = struct
|
||||
let stop_symbol = "magic_trace_stop_indicator"
|
||||
end
|
||||
|
||||
external stop_indicator : int -> int -> unit = "magic_trace_stop_indicator" [@@noalloc]
|
||||
|
||||
let start_time = ref 0
|
||||
|
||||
let[@inline] tsc_int () =
|
||||
let tsc = Time_stamp_counter.now () in
|
||||
Time_stamp_counter.to_int63 tsc |> Int63.to_int_exn
|
||||
;;
|
||||
|
||||
let mark_start () = start_time := tsc_int ()
|
||||
|
||||
module Min_duration = struct
|
||||
type t = int
|
||||
|
||||
let of_ns ns =
|
||||
Time_stamp_counter.Span.of_ns
|
||||
(Int63.of_int ns)
|
||||
~calibrator:(force Time_stamp_counter.calibrator)
|
||||
|> Time_stamp_counter.Span.to_int_exn
|
||||
;;
|
||||
|
||||
let over min =
|
||||
let span = tsc_int () - !start_time in
|
||||
span > min
|
||||
;;
|
||||
end
|
||||
|
||||
let take_snapshot_with_arg i = stop_indicator !start_time i
|
||||
|
||||
let take_snapshot_with_time_and_arg tsc i =
|
||||
let tsc_i = Time_stamp_counter.to_int63 tsc |> Int63.to_int_exn in
|
||||
stop_indicator tsc_i i
|
||||
;;
|
||||
|
||||
let take_snapshot () = take_snapshot_with_arg 0
|
||||
@@ -0,0 +1,53 @@
|
||||
(** The magic-trace tool can work with any binary, but using these functions allows you to
|
||||
easily mark places in your code to take a snapshot, and enables additional features
|
||||
like passing a value and marking the start of a duration. *)
|
||||
|
||||
(** This is the default symbol that the magic-trace command will attach to and use to take
|
||||
a snapshot. Use it if you want to take a snapshot based on custom logic, and it will
|
||||
save you the step of selecting the symbol you want to stop on.
|
||||
|
||||
It's an external C function that does nothing and should be very fast to call. It's
|
||||
only a C function to ensure it has a stable and exact symbol. *)
|
||||
val take_snapshot : unit -> unit
|
||||
|
||||
(** Passes an integer along that will show up in the resulting trace *)
|
||||
val take_snapshot_with_arg : int -> unit
|
||||
|
||||
(** Passes both the start tsc for the operation and an argument. *)
|
||||
val take_snapshot_with_time_and_arg : Time_stamp_counter.t -> int -> unit
|
||||
|
||||
(** Mark the start time of some operation which may lead to a snapshot. *)
|
||||
val mark_start : unit -> unit
|
||||
|
||||
(** Intended for use like so:
|
||||
|
||||
{[
|
||||
let min_dur = Magic_trace.Min_duration.of_ns 3_000
|
||||
|
||||
let my_fun a b c =
|
||||
Magic_trace.mark_start ();
|
||||
(* ... *)
|
||||
if Magic_trace.Min_duration.over min_dur then Magic_trace.take_snapshot ()
|
||||
;;
|
||||
]}
|
||||
|
||||
which allows capturing only unusually long executions without adding the ~10us
|
||||
breakpoint overhead on every run while magic-trace is attached.
|
||||
|
||||
See also the [-duration-thresh] flag for use in combination with this or instead of it
|
||||
if you can tolerate a 10us pause on every call. *)
|
||||
module Min_duration : sig
|
||||
type t
|
||||
|
||||
(** This involves using and forcing [Time_stamp_counter.calibrator] so should probably
|
||||
be done only once at the top level as opposed to every time. *)
|
||||
val of_ns : int -> t
|
||||
|
||||
(** Returns true if the time since [mark_start] is over the threshold *)
|
||||
val over : t -> bool
|
||||
end
|
||||
|
||||
(** Internal details about how to interact with the snapshot function from outside *)
|
||||
module Private : sig
|
||||
val stop_symbol : string
|
||||
end
|
||||
@@ -0,0 +1,5 @@
|
||||
#include <caml/mlvalues.h>
|
||||
|
||||
CAMLprim value magic_trace_stop_indicator (value a1 __attribute__((unused)), value a2 __attribute__((unused))) {
|
||||
return Val_unit;
|
||||
}
|
||||
@@ -0,0 +1,6 @@
|
||||
(library
|
||||
(name magic_trace_test)
|
||||
(no_dynlink)
|
||||
(libraries core expect_test_helpers_core magic_trace)
|
||||
(preprocess
|
||||
(pps ppx_jane)))
|
||||
@@ -0,0 +1,3 @@
|
||||
open! Core
|
||||
include Expect_test_helpers_core
|
||||
include Magic_trace
|
||||
@@ -0,0 +1,33 @@
|
||||
opam-version: "2.0"
|
||||
maintainer: "Jane Street developers"
|
||||
authors: ["Jane Street Group, LLC"]
|
||||
homepage: "https://magic-trace.org"
|
||||
bug-reports: "https://github.com/janestreet/magic-trace/issues"
|
||||
dev-repo: "git+https://github.com/janestreet/magic-trace.git"
|
||||
doc: "https://github.com/janestreet/magic-trace/wiki"
|
||||
license: "MIT"
|
||||
build: [
|
||||
["dune" "build" "-p" name "-j" jobs]
|
||||
]
|
||||
depends: [
|
||||
"ocaml" {>= "4.14"}
|
||||
"ocamlformat" {with-test}
|
||||
"ocaml_intrinsics"
|
||||
"async"
|
||||
"camlzip"
|
||||
"cohttp"
|
||||
"cohttp_static_handler"
|
||||
"core"
|
||||
"core_unix"
|
||||
"expect_test_helpers_async"
|
||||
"crunch"
|
||||
"ppx_jane"
|
||||
"shell"
|
||||
"dune" {>= "2.0.0"}
|
||||
"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"
|
||||
@@ -0,0 +1,267 @@
|
||||
opam-version: "2.0"
|
||||
name: "magic-trace"
|
||||
version: "1.0.1"
|
||||
synopsis:
|
||||
"Collects and displays high-resolution traces of what a process is doing"
|
||||
description: "https://github.com/janestreet/magic-trace"
|
||||
maintainer: "Jane Street developers"
|
||||
authors: "Jane Street Group, LLC"
|
||||
license: "MIT"
|
||||
homepage: "https://magic-trace.org"
|
||||
doc: "https://github.com/janestreet/magic-trace/wiki"
|
||||
bug-reports: "https://github.com/janestreet/magic-trace/issues"
|
||||
depends: [
|
||||
"angstrom" {= "0.16.1"}
|
||||
"astring" {= "0.8.5"}
|
||||
"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"}
|
||||
"base-nnp" {= "base"}
|
||||
"base-threads" {= "base"}
|
||||
"base-unix" {= "base"}
|
||||
"base64" {= "3.5.2"}
|
||||
"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.91+190"}
|
||||
"camlp-streams" {= "5.0.1"}
|
||||
"camlzip" {= "1.14"}
|
||||
"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.91+190"}
|
||||
"conduit" {= "8.0.0"}
|
||||
"conduit-async" {= "8.0.0"}
|
||||
"conf-autoconf" {= "0.2"}
|
||||
"conf-pkg-config" {= "4"}
|
||||
"conf-which" {= "1"}
|
||||
"conf-zlib" {= "1"}
|
||||
"conf-zstd" {= "1.3.8"}
|
||||
"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.24.0+ox"}
|
||||
"domain-name" {= "0.5.0"}
|
||||
"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.91+190"}
|
||||
"jsonm" {= "1.0.2"}
|
||||
"jst-config" {= "v0.18~preview.130.91+190"}
|
||||
"logs" {= "0.10.0"}
|
||||
"macaddr" {= "5.6.2"}
|
||||
"magic-mime" {= "1.3.1"}
|
||||
"menhir" {= "20260209"}
|
||||
"menhirCST" {= "20260209"}
|
||||
"menhirGLR" {= "20260209"}
|
||||
"menhirLib" {= "20260209"}
|
||||
"menhirSdk" {= "20260209"}
|
||||
"num" {= "1.6"}
|
||||
"ocaml" {= "5.2.0"}
|
||||
"ocaml-compiler-libs" {= "v0.17.0+ox"}
|
||||
"ocaml-config" {= "3"}
|
||||
"ocaml-options-vanilla" {= "1"}
|
||||
"ocaml-syntax-shims" {= "1.0.0"}
|
||||
"ocaml-variants" {= "5.2.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+ox1" & with-test}
|
||||
"ocamlformat-lib" {= "0.26.2+ox1"}
|
||||
"ocp-indent" {= "1.9.0"}
|
||||
"odoc-parser" {= "3.1.0+ox"}
|
||||
"owee" {= "0.8"}
|
||||
"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.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.91+190"}
|
||||
"result" {= "1.5"}
|
||||
"seq" {= "base"}
|
||||
"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.91+190"}
|
||||
"stdio" {= "v0.18~preview.130.91+190"}
|
||||
"stdlib-shims" {= "0.3.0"}
|
||||
"string_dict" {= "v0.18~preview.130.91+190"}
|
||||
"stringext" {= "1.6.0"}
|
||||
"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" {= "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"
|
||||
@@ -0,0 +1,57 @@
|
||||
(** Backends, which do the trace recording, present this unified interface in order to be
|
||||
exposed as commands which can generate traces. *)
|
||||
|
||||
open! Core
|
||||
open! Async
|
||||
|
||||
module type S = sig
|
||||
module Record_opts : sig
|
||||
type t
|
||||
|
||||
val param : t Command.Param.t
|
||||
end
|
||||
|
||||
module Recording : sig
|
||||
module Data : sig
|
||||
type t [@@deriving sexp]
|
||||
end
|
||||
|
||||
type t
|
||||
|
||||
val attach_and_record
|
||||
: Record_opts.t
|
||||
-> debug_print_perf_commands:bool
|
||||
-> subcommand:Subcommand.t
|
||||
-> when_to_snapshot:When_to_snapshot.t
|
||||
-> trace_scope:Trace_scope.t
|
||||
-> multi_snapshot:bool
|
||||
-> timer_resolution:Timer_resolution.t
|
||||
-> record_dir:string
|
||||
-> collection_mode:Collection_mode.t
|
||||
-> Pid.t list
|
||||
-> (t * Data.t) Deferred.Or_error.t
|
||||
|
||||
val maybe_take_snapshot : t -> source:[ `ctrl_c | `function_call ] -> unit
|
||||
val finish_recording : t -> unit Deferred.Or_error.t
|
||||
end
|
||||
|
||||
module Decode_opts : sig
|
||||
type t
|
||||
|
||||
val param : t Command.Param.t
|
||||
end
|
||||
|
||||
val decode_events
|
||||
: ?perf_maps:Perf_map.Table.t
|
||||
-> ?filter_same_symbol_jumps:bool
|
||||
(** Whether to filter unnecessary events which are jumps within the same
|
||||
function. Default [true]. *)
|
||||
-> debug_print_perf_commands:bool
|
||||
-> recording_data:Recording.Data.t option
|
||||
(** This parameter is passed to allow [decode_events] to depend on information or
|
||||
configuration from [attach_and_record]. *)
|
||||
-> record_dir:string
|
||||
-> collection_mode:Collection_mode.t
|
||||
-> Decode_opts.t
|
||||
-> Decode_result.t Deferred.Or_error.t
|
||||
end
|
||||
@@ -0,0 +1,17 @@
|
||||
open! Core
|
||||
|
||||
external clock_gettime_perf_ns : unit -> int = "magic_clock_gettime_perf_ns"
|
||||
|
||||
let time_ns_of_boot_in_perf_time () =
|
||||
let perf_ns =
|
||||
try clock_gettime_perf_ns () with
|
||||
| _ ->
|
||||
(* CR-soon tbrindus: this raises in CI, and [am_running_inline_test] and
|
||||
[am_running_test] don't seem to be set within @runtest. *)
|
||||
0
|
||||
in
|
||||
let realtime_ns = Time_ns.to_int_ns_since_epoch (Time_ns.now ()) in
|
||||
Time_ns.sub
|
||||
(Time_ns.of_int63_ns_since_epoch (Int63.of_int realtime_ns))
|
||||
(Time_ns.Span.of_int_ns perf_ns)
|
||||
;;
|
||||
@@ -0,0 +1,3 @@
|
||||
open! Core
|
||||
|
||||
val time_ns_of_boot_in_perf_time : unit -> Time_ns.t
|
||||
@@ -0,0 +1,60 @@
|
||||
#include <time.h>
|
||||
#include <unistd.h>
|
||||
|
||||
#include <sys/mman.h>
|
||||
#include <sys/syscall.h>
|
||||
|
||||
#include <asm/perf_regs.h>
|
||||
#include <linux/perf_event.h>
|
||||
|
||||
#include <caml/mlvalues.h>
|
||||
#include <caml/unixsupport.h>
|
||||
|
||||
#include "perf_utils.h"
|
||||
|
||||
static uint64_t rdtsc(void) {
|
||||
uint32_t hi, lo;
|
||||
__asm__ __volatile__("rdtsc" : "=a"(lo), "=d"(hi));
|
||||
return ((uint64_t)lo) | (((uint64_t)hi) << 32);
|
||||
}
|
||||
|
||||
CAMLprim value magic_clock_gettime_perf_ns(void) {
|
||||
/*
|
||||
* It should be stated that despite any appearances to the contrary, I have no
|
||||
* idea what I'm doing here.
|
||||
*
|
||||
* We need to get the "current time in [perf] units" to line up events with
|
||||
* absolute time. Here, we create a fake software event with bogus
|
||||
* information, just so we can get a reference to the [perf_event_mmap_page]
|
||||
* containing the time_{zero,shift,mult} fields we need to scale [rdtsc] by.
|
||||
*
|
||||
* I *think* creating a [PERF_TYPE_SOFTWARE] event handle should have no
|
||||
* side-effects, but I'm not 100% sure on that.
|
||||
*/
|
||||
struct perf_event_attr attr = {0};
|
||||
attr.size = sizeof(attr);
|
||||
attr.type = PERF_TYPE_SOFTWARE;
|
||||
|
||||
int fd = sys_perf_event_open(&attr, getpid(), -1, -1, PERF_FLAG_FD_CLOEXEC);
|
||||
if (fd < 0) {
|
||||
goto error_perf_event_open;
|
||||
}
|
||||
|
||||
size_t mmap_size =
|
||||
sysconf(_SC_PAGESIZE) * (1 + 1); // one metadata page plus one page buffer
|
||||
volatile struct perf_event_mmap_page *perf_mmap =
|
||||
mmap(NULL, mmap_size, PROT_READ, MAP_SHARED, fd, 0);
|
||||
if (mmap == MAP_FAILED) {
|
||||
goto error_mmap;
|
||||
}
|
||||
|
||||
uint64_t timestamp = perf_time_of_tsc(perf_mmap, rdtsc());
|
||||
|
||||
munmap(mmap, mmap_size);
|
||||
close(fd);
|
||||
return Val_long(timestamp);
|
||||
error_mmap:
|
||||
close(fd);
|
||||
error_perf_event_open:
|
||||
uerror("failed to get perf time", Nothing);
|
||||
}
|
||||
@@ -0,0 +1,42 @@
|
||||
open! Core
|
||||
|
||||
type t
|
||||
|
||||
external create
|
||||
: pid:Pid.t
|
||||
-> addr:int64
|
||||
-> (t, int) result
|
||||
= "magic_breakpoint_create_stub"
|
||||
|
||||
(* Keep in sync with magic_breakpoint_next_stub *)
|
||||
module Hit = struct
|
||||
type t =
|
||||
{ timestamp : Time_ns.Span.t
|
||||
; passed_timestamp : Time_ns.Span.t
|
||||
; passed_val : int
|
||||
; tid : Pid.t
|
||||
; ip : Int64.Hex.t
|
||||
}
|
||||
[@@deriving sexp]
|
||||
end
|
||||
|
||||
external get_fd : t -> int = "magic_breakpoint_fd_stub"
|
||||
external destroy : t -> unit = "magic_breakpoint_destroy_stub"
|
||||
external next_hit : t -> Hit.t option = "magic_breakpoint_next_stub"
|
||||
|
||||
external enable : t -> single_hit:bool -> int or_null = "magic_breakpoint_enable_stub"
|
||||
[@@noalloc]
|
||||
|
||||
let breakpoint_fd pid ~addr =
|
||||
match create ~pid ~addr with
|
||||
| Ok t -> Ok t
|
||||
| Error errno -> Errno.to_error errno
|
||||
;;
|
||||
|
||||
let enable t ~single_hit =
|
||||
match enable t ~single_hit with
|
||||
| Null -> Ok ()
|
||||
| This errno -> Errno.to_error errno
|
||||
;;
|
||||
|
||||
let fd t = get_fd t |> Core_unix.File_descr.of_int |> Core_unix.dup
|
||||
@@ -0,0 +1,30 @@
|
||||
open! Core
|
||||
|
||||
type t
|
||||
|
||||
(** Uses [perf_event_open] to set a hardware breakpoint at a given address in a process.
|
||||
When that breakpoint is hit the resulting file descriptor will poll as readable. The
|
||||
breakpoint starts disabled; call [enable] to arm it. *)
|
||||
val breakpoint_fd : Pid.t -> addr:int64 -> t Or_error.t
|
||||
|
||||
(** Arms the breakpoint. If [single_hit] is set the breakpoint will disable itself after
|
||||
being hit once. *)
|
||||
val enable : t -> single_hit:bool -> unit Or_error.t
|
||||
|
||||
val destroy : t -> unit
|
||||
|
||||
module Hit : sig
|
||||
type t =
|
||||
{ timestamp : Time_ns.Span.t
|
||||
; passed_timestamp : Time_ns.Span.t
|
||||
; passed_val : int
|
||||
; tid : Pid.t
|
||||
; ip : int64
|
||||
}
|
||||
[@@deriving sexp]
|
||||
end
|
||||
|
||||
val next_hit : t -> Hit.t option
|
||||
|
||||
(** Returns a waitable fd valid only until [t] is destroyed or GCd *)
|
||||
val fd : t -> Core_unix.File_descr.t
|
||||
@@ -0,0 +1,192 @@
|
||||
#include <assert.h>
|
||||
#include <errno.h>
|
||||
#include <string.h>
|
||||
#include <time.h>
|
||||
#include <unistd.h>
|
||||
|
||||
#include <sys/ioctl.h>
|
||||
#include <sys/mman.h>
|
||||
#include <sys/syscall.h>
|
||||
|
||||
#include <asm/perf_regs.h>
|
||||
#include <linux/hw_breakpoint.h>
|
||||
#include <linux/perf_event.h>
|
||||
|
||||
#include <caml/alloc.h>
|
||||
#include <caml/custom.h>
|
||||
#include <caml/fail.h>
|
||||
#include <caml/memory.h>
|
||||
#include <caml/mlvalues.h>
|
||||
|
||||
#include "perf_utils.h"
|
||||
|
||||
// See [lib/pmc/src/msr_stubs.c:187] for an explanation
|
||||
#define rmb() asm volatile("" ::: "memory")
|
||||
|
||||
struct breakpoint_state {
|
||||
int fd;
|
||||
size_t mmap_size;
|
||||
volatile struct perf_event_mmap_page *mmap;
|
||||
};
|
||||
|
||||
#define Breakpoint_state_val(v) \
|
||||
(*((struct breakpoint_state **)Data_custom_val(v)))
|
||||
|
||||
static void destroy_breakpoint_state(struct breakpoint_state *s) {
|
||||
if (s->mmap && s->mmap != MAP_FAILED)
|
||||
munmap((void *)s->mmap, s->mmap_size);
|
||||
if (s->fd > 0)
|
||||
close(s->fd);
|
||||
free(s);
|
||||
}
|
||||
|
||||
static void finalize_breakpoint_state(value v) {
|
||||
struct breakpoint_state *s = Breakpoint_state_val(v);
|
||||
if (s)
|
||||
destroy_breakpoint_state(s);
|
||||
Breakpoint_state_val(v) = NULL;
|
||||
}
|
||||
|
||||
CAMLprim value magic_breakpoint_destroy_stub(value v) {
|
||||
finalize_breakpoint_state(v);
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
static struct custom_operations breakpoint_state_ops = {
|
||||
.identifier = "com.janestreet.magic-trace.breakpoint_state",
|
||||
.finalize = finalize_breakpoint_state,
|
||||
.compare = custom_compare_default,
|
||||
.compare_ext = custom_compare_ext_default,
|
||||
.hash = custom_hash_default,
|
||||
.serialize = custom_serialize_default,
|
||||
.deserialize = custom_deserialize_default,
|
||||
.fixed_length = custom_fixed_length_default};
|
||||
|
||||
CAMLprim value magic_breakpoint_fd_stub(value state) {
|
||||
return Val_long(Breakpoint_state_val(state)->fd);
|
||||
}
|
||||
|
||||
CAMLprim value magic_breakpoint_create_stub(value pid, value addr) {
|
||||
CAMLparam2(pid, addr);
|
||||
CAMLlocal2(wrap, v);
|
||||
struct perf_event_attr attr;
|
||||
|
||||
memset(&attr, 0, sizeof(attr));
|
||||
attr.size = sizeof(attr);
|
||||
attr.type = PERF_TYPE_BREAKPOINT;
|
||||
attr.bp_type = HW_BREAKPOINT_X;
|
||||
attr.bp_addr = Int64_val(addr);
|
||||
attr.bp_len = sizeof(long);
|
||||
attr.sample_period = 1;
|
||||
attr.sample_type = PERF_SAMPLE_TIME | PERF_SAMPLE_IP | PERF_SAMPLE_REGS_USER |
|
||||
PERF_SAMPLE_TID;
|
||||
attr.exclude_hv = 1;
|
||||
attr.exclude_kernel = 1;
|
||||
attr.disabled = 1;
|
||||
attr.wakeup_events = 1;
|
||||
attr.precise_ip = 2;
|
||||
// first and second argument register
|
||||
attr.sample_regs_user = (1ul << PERF_REG_X86_DI) | (1ul << PERF_REG_X86_SI);
|
||||
// calloc returns zeroed memory so we don't try to free garbage in error cases
|
||||
struct breakpoint_state *s = calloc(1, sizeof(*s));
|
||||
|
||||
s->fd =
|
||||
sys_perf_event_open(&attr, Long_val(pid), -1, -1, PERF_FLAG_FD_CLOEXEC);
|
||||
|
||||
if (s->fd < 0)
|
||||
goto failed;
|
||||
|
||||
s->mmap_size =
|
||||
sysconf(_SC_PAGESIZE) * (1 + 1); // one metadata page plus one page buffer
|
||||
// The PROT_READ and PROT_WRITE is how we tell perf we'll be updating
|
||||
// data_tail
|
||||
s->mmap =
|
||||
mmap(NULL, s->mmap_size, PROT_READ | PROT_WRITE, MAP_SHARED, s->fd, 0);
|
||||
if (s->mmap == MAP_FAILED)
|
||||
goto failed;
|
||||
|
||||
v = caml_alloc_custom(&breakpoint_state_ops, sizeof(s), 0, 1);
|
||||
Breakpoint_state_val(v) = s;
|
||||
|
||||
wrap = caml_alloc(1, 0); // Ok constructor of result
|
||||
Field(wrap, 0) = v;
|
||||
|
||||
CAMLreturn(wrap);
|
||||
failed:
|
||||
destroy_breakpoint_state(s);
|
||||
assert(errno > 0);
|
||||
wrap = caml_alloc(1, 1); // Error constructor of result
|
||||
Field(wrap, 0) = Val_long(errno);
|
||||
CAMLreturn(wrap);
|
||||
}
|
||||
|
||||
CAMLprim value magic_breakpoint_enable_stub(value state, value single_hit) {
|
||||
const struct breakpoint_state *s = Breakpoint_state_val(state);
|
||||
int ret;
|
||||
if (Bool_val(single_hit)) {
|
||||
// Makes it so the breakpoint only triggers once before being disabled
|
||||
ret = ioctl(s->fd, PERF_EVENT_IOC_REFRESH, 1);
|
||||
} else {
|
||||
ret = ioctl(s->fd, PERF_EVENT_IOC_ENABLE, 0);
|
||||
}
|
||||
if (ret < 0) {
|
||||
assert(errno > 0);
|
||||
return Val_long(errno);
|
||||
}
|
||||
return (value)NULL;
|
||||
}
|
||||
|
||||
struct my_sample {
|
||||
struct perf_event_header header;
|
||||
uint64_t ip;
|
||||
uint32_t pid, tid;
|
||||
uint64_t time;
|
||||
uint64_t abi;
|
||||
uint64_t regs[2];
|
||||
};
|
||||
|
||||
CAMLprim value magic_breakpoint_next_stub(value state) {
|
||||
CAMLparam1(state);
|
||||
CAMLlocal3(res, info, ip);
|
||||
struct breakpoint_state *s = Breakpoint_state_val(state);
|
||||
if (!s)
|
||||
CAMLreturn(Val_none);
|
||||
|
||||
char *cur = (char *)s->mmap + s->mmap->data_offset +
|
||||
(s->mmap->data_tail % s->mmap->data_size);
|
||||
char *events_end = (char *)s->mmap + s->mmap->data_offset +
|
||||
(s->mmap->data_head % s->mmap->data_size);
|
||||
rmb();
|
||||
|
||||
while (cur < events_end) {
|
||||
struct perf_event_header *ev = (struct perf_event_header *)cur;
|
||||
if (ev->type == PERF_RECORD_SAMPLE) {
|
||||
struct my_sample *samp = (struct my_sample *)ev;
|
||||
// These may be nonsense but nothing should go wrong if they are.
|
||||
// We untag and retag unconditionally so that if it is garbage the
|
||||
// value passed to OCaml is a garbage integer and never a garbage pointer.
|
||||
uint64_t tsc = Long_val(samp->regs[1]);
|
||||
uint64_t val = Long_val(samp->regs[0]);
|
||||
|
||||
uint64_t timestamp = tsc != 0 ? perf_time_of_tsc(s->mmap, tsc) : 0;
|
||||
|
||||
/* Keep in sync with Breakpoint.Hit.t */
|
||||
ip = caml_copy_int64(samp->ip);
|
||||
info = caml_alloc_tuple(5);
|
||||
Store_field(info, 0, Val_long(samp->time));
|
||||
Store_field(info, 1, Val_long(timestamp));
|
||||
Store_field(info, 2, Val_long(val));
|
||||
Store_field(info, 3, Val_long(samp->tid));
|
||||
Store_field(info, 4, ip);
|
||||
res = caml_alloc_some(info);
|
||||
// Needs to be updated after we read the sample because the kernel uses
|
||||
// this value to not overwrite data until we've read it.
|
||||
s->mmap->data_tail += ev->size;
|
||||
CAMLreturn(res);
|
||||
} else {
|
||||
s->mmap->data_tail += ev->size;
|
||||
}
|
||||
cur += ev->size;
|
||||
}
|
||||
CAMLreturn(Val_none);
|
||||
}
|
||||
@@ -0,0 +1,45 @@
|
||||
open! Core
|
||||
|
||||
type t =
|
||||
| Last_branch_record of { stitched : bool [@sexp.default true] }
|
||||
| Frame_pointers
|
||||
| Dwarf
|
||||
[@@deriving sexp]
|
||||
|
||||
let of_string = function
|
||||
(* Kept the short names to match naming of callgraph modes from perf
|
||||
(lbr/dwarf/fp) for users who are familiar with perf. [lbr-no-stitch] is not
|
||||
from perf, but added as a shorter option. *)
|
||||
| "lbr" -> Last_branch_record { stitched = true }
|
||||
| "lbr-no-stitch" -> Last_branch_record { stitched = false }
|
||||
| "fp" -> Frame_pointers
|
||||
| "dwarf" -> Dwarf
|
||||
| str -> t_of_sexp (Sexp.of_string str)
|
||||
;;
|
||||
|
||||
let param =
|
||||
let open Command.Param in
|
||||
flag
|
||||
"-callgraph-mode"
|
||||
(optional (Command.Arg_type.create of_string))
|
||||
~doc:
|
||||
" When magic-trace is running with sampling collection mode, this sets how it \
|
||||
should reconstruct callstacks. The options are [lbr]/[lbr-no-stitch]/[dwarf]/[fp] \
|
||||
or a sexp. Will default to [lbr] is available and [dwarf] otherwise. For more \
|
||||
info: https://magic-trace.org/w/b"
|
||||
;;
|
||||
|
||||
let to_perf_record_args = function
|
||||
| Some (Last_branch_record _) -> [ "--call-graph"; "lbr" ]
|
||||
| Some Frame_pointers -> [ "--call-graph"; "fp" ]
|
||||
| Some Dwarf -> [ "--call-graph"; "dwarf" ]
|
||||
| None -> []
|
||||
;;
|
||||
|
||||
let to_perf_script_args = function
|
||||
| Some (Last_branch_record { stitched = true }) -> [ "--stitch-lbr" ]
|
||||
| Some (Last_branch_record { stitched = false })
|
||||
| Some Frame_pointers
|
||||
| Some Dwarf
|
||||
| None -> []
|
||||
;;
|
||||
@@ -0,0 +1,11 @@
|
||||
open! Core
|
||||
|
||||
type t =
|
||||
| Last_branch_record of { stitched : bool }
|
||||
| Frame_pointers
|
||||
| Dwarf
|
||||
[@@deriving sexp]
|
||||
|
||||
val param : t option Command.Param.t
|
||||
val to_perf_record_args : t option -> string list
|
||||
val to_perf_script_args : t option -> string list
|
||||
@@ -0,0 +1,86 @@
|
||||
(* Compression algorithm is slightly simplified version of
|
||||
external/memtrace/backtrace_codec.ml
|
||||
(callstacks and backtraces are essentially the same) *)
|
||||
|
||||
open Core
|
||||
|
||||
type t =
|
||||
{ symbol_to_id : (Symbol.t, int) Hashtbl.t
|
||||
; id_to_symbol : (int, Symbol.t) Hashtbl.t
|
||||
; mutable next_symbol_id : int
|
||||
; follow_table : (int, int) Hashtbl.t
|
||||
}
|
||||
|
||||
let init () =
|
||||
{ symbol_to_id = Hashtbl.create (module Symbol)
|
||||
; id_to_symbol = Hashtbl.create (module Int)
|
||||
; next_symbol_id = 0
|
||||
; follow_table = Hashtbl.create (module Int)
|
||||
}
|
||||
;;
|
||||
|
||||
type compression_event =
|
||||
{ new_symbols : (Symbol.t * int) list
|
||||
; callstack : (int * int) list
|
||||
}
|
||||
[@@deriving sexp, bin_io]
|
||||
|
||||
let update_follow_table t stack =
|
||||
(let%bind.Option suffix = List.tl stack in
|
||||
let%map.Option prefix = List.drop_last stack in
|
||||
List.iter2_exn prefix suffix ~f:(fun prev next ->
|
||||
Hashtbl.set t.follow_table ~key:prev ~data:next))
|
||||
|> Option.value ~default:()
|
||||
;;
|
||||
|
||||
let compress_with_follow_table t stack =
|
||||
let compressed_stack =
|
||||
List.fold stack ~init:[] ~f:(fun acc x ->
|
||||
match acc with
|
||||
| [] -> [ x, x, 0 ]
|
||||
| (from_s, to_s, steps) :: tl ->
|
||||
let pred_next = Hashtbl.find t.follow_table to_s in
|
||||
(match pred_next with
|
||||
| Some a when a = x -> (from_s, x, steps + 1) :: tl
|
||||
| _ -> (x, x, 0) :: acc))
|
||||
|> List.rev
|
||||
in
|
||||
List.map compressed_stack ~f:(fun (from_s, _, steps) -> from_s, steps)
|
||||
;;
|
||||
|
||||
let rec follow_symbol_steps t symbol = function
|
||||
| 0 -> []
|
||||
| steps ->
|
||||
let next_symbol = Hashtbl.find_exn t.follow_table symbol in
|
||||
next_symbol :: follow_symbol_steps t next_symbol (steps - 1)
|
||||
;;
|
||||
|
||||
let decompress_with_follow_table t comp_stack =
|
||||
List.concat_map comp_stack ~f:(fun (from_s, steps) ->
|
||||
from_s :: follow_symbol_steps t from_s steps)
|
||||
;;
|
||||
|
||||
let compress_callstack t callstack =
|
||||
let symbols = callstack in
|
||||
let new_symbol_events =
|
||||
List.filter_map symbols ~f:(fun s ->
|
||||
match Hashtbl.mem t.symbol_to_id s with
|
||||
| true -> None
|
||||
| false ->
|
||||
Hashtbl.add_exn t.symbol_to_id ~key:s ~data:t.next_symbol_id;
|
||||
t.next_symbol_id <- t.next_symbol_id + 1;
|
||||
Some (s, t.next_symbol_id - 1))
|
||||
in
|
||||
let symbol_ids = List.map symbols ~f:(fun s -> Hashtbl.find_exn t.symbol_to_id s) in
|
||||
let compressed_stack = compress_with_follow_table t symbol_ids in
|
||||
update_follow_table t symbol_ids;
|
||||
{ new_symbols = new_symbol_events; callstack = compressed_stack }
|
||||
;;
|
||||
|
||||
let decompress_callstack t { new_symbols; callstack } =
|
||||
List.iter new_symbols ~f:(fun (symbol, id) ->
|
||||
Hashtbl.set t.id_to_symbol ~key:id ~data:symbol);
|
||||
let symbol_ids = decompress_with_follow_table t callstack in
|
||||
update_follow_table t symbol_ids;
|
||||
List.map symbol_ids ~f:(fun s -> Hashtbl.find_exn t.id_to_symbol s)
|
||||
;;
|
||||
@@ -0,0 +1,33 @@
|
||||
open Core
|
||||
|
||||
type t =
|
||||
{ symbol_to_id : (Symbol.t, int) Hashtbl.t
|
||||
; id_to_symbol : (int, Symbol.t) Hashtbl.t
|
||||
; mutable next_symbol_id : int
|
||||
; follow_table : (int, int) Hashtbl.t
|
||||
}
|
||||
|
||||
(* Initialise a compression state *)
|
||||
val init : unit -> t
|
||||
|
||||
type compression_event =
|
||||
{ new_symbols : (Symbol.t * int) list
|
||||
; callstack : (int * int) list
|
||||
}
|
||||
[@@deriving sexp, bin_io]
|
||||
|
||||
(* Compress a callstack represented as a list of symbol, and update the compression
|
||||
state inplace.
|
||||
|
||||
When compressing a sequence of many callstacks, this function should be called
|
||||
in order on all callstacks with the same compression state.
|
||||
*)
|
||||
val compress_callstack : t -> Symbol.t list -> compression_event
|
||||
|
||||
(* Decompress a callstack represented as a compression_event, and update the compression
|
||||
state inplace.
|
||||
|
||||
When decompressing a sequence of many callstacks, this function should be called
|
||||
in order on all compression events with the same compression state.
|
||||
*)
|
||||
val decompress_callstack : t -> compression_event -> Symbol.t list
|
||||
@@ -0,0 +1,93 @@
|
||||
open! Core
|
||||
|
||||
module Event = struct
|
||||
module Name = struct
|
||||
type t =
|
||||
| Branch_misses
|
||||
| Cache_misses
|
||||
[@@deriving compare, hash, sexp, bin_io]
|
||||
|
||||
let to_string = function
|
||||
| Branch_misses -> "branch-misses"
|
||||
| Cache_misses -> "cache-misses"
|
||||
;;
|
||||
end
|
||||
|
||||
module When_to_sample = struct
|
||||
type t =
|
||||
| Frequency of int
|
||||
| Period of int
|
||||
[@@deriving of_sexp]
|
||||
end
|
||||
|
||||
module Precision = struct
|
||||
type t =
|
||||
| Arbitrary_skid
|
||||
| Constant_skid
|
||||
| Request_zero_skid
|
||||
| Zero_skid
|
||||
| Maximum_possible
|
||||
[@@deriving of_sexp]
|
||||
end
|
||||
|
||||
type t =
|
||||
{ when_to_sample : When_to_sample.t
|
||||
; name : Name.t
|
||||
; precision : Precision.t
|
||||
}
|
||||
[@@deriving of_sexp]
|
||||
|
||||
let of_string = function
|
||||
| "branch-misses" ->
|
||||
{ when_to_sample = Period 50; name = Branch_misses; precision = Maximum_possible }
|
||||
| "cache-misses" ->
|
||||
{ when_to_sample = Period 1; name = Cache_misses; precision = Maximum_possible }
|
||||
| str -> t_of_sexp (Sexp.of_string str)
|
||||
;;
|
||||
|
||||
let arg_type = Command.Arg_type.create of_string
|
||||
end
|
||||
|
||||
type t =
|
||||
| Intel_processor_trace of { extra_events : Event.t list }
|
||||
| Stacktrace_sampling of { extra_events : Event.t list }
|
||||
|
||||
let extra_events = function
|
||||
| Intel_processor_trace { extra_events } | Stacktrace_sampling { extra_events } ->
|
||||
extra_events
|
||||
;;
|
||||
|
||||
let select_collection_mode ~extra_events ~use_sampling =
|
||||
match use_sampling with
|
||||
| true -> Stacktrace_sampling { extra_events }
|
||||
| false ->
|
||||
(match Core_unix.access "/sys/bus/event_source/devices/intel_pt" [ `Exists ] with
|
||||
| Ok () -> Intel_processor_trace { extra_events }
|
||||
| Error _ ->
|
||||
Core.eprintf
|
||||
"Intel PT support not found. magic-trace will continue and use sampling instead.\n";
|
||||
Stacktrace_sampling { extra_events })
|
||||
;;
|
||||
|
||||
let param =
|
||||
let%map_open.Command extra_events =
|
||||
flag
|
||||
"-events"
|
||||
(optional_with_default
|
||||
[]
|
||||
(Command.Arg_type.comma_separated ~unique_values:true Event.arg_type))
|
||||
~doc:
|
||||
"EVENTS Select additional events which can be sampled as a comma separated list. \
|
||||
Valid options are [cache-misses] or [branch-misses]. For more info: \
|
||||
https://magic-trace.org/w/e"
|
||||
|> Util.experimental_flag ~default:[]
|
||||
and use_sampling =
|
||||
flag
|
||||
"-sampling"
|
||||
no_arg
|
||||
~doc:
|
||||
"Use stacktrace sampling instead of Intel PT. If Intel PT is not available, \
|
||||
magic-trace will default to this. For more info: https://magic-trace.org/w/b"
|
||||
in
|
||||
select_collection_mode ~extra_events ~use_sampling
|
||||
;;
|
||||
@@ -0,0 +1,40 @@
|
||||
open! Core
|
||||
|
||||
module Event : sig
|
||||
module Name : sig
|
||||
type t =
|
||||
| Branch_misses
|
||||
| Cache_misses
|
||||
[@@deriving compare, hash, sexp, bin_io]
|
||||
|
||||
val to_string : t -> string
|
||||
end
|
||||
|
||||
module When_to_sample : sig
|
||||
type t =
|
||||
| Frequency of int
|
||||
| Period of int
|
||||
end
|
||||
|
||||
module Precision : sig
|
||||
type t =
|
||||
| Arbitrary_skid
|
||||
| Constant_skid
|
||||
| Request_zero_skid
|
||||
| Zero_skid
|
||||
| Maximum_possible
|
||||
end
|
||||
|
||||
type t =
|
||||
{ when_to_sample : When_to_sample.t
|
||||
; name : Name.t
|
||||
; precision : Precision.t
|
||||
}
|
||||
end
|
||||
|
||||
type t =
|
||||
| Intel_processor_trace of { extra_events : Event.t list }
|
||||
| Stacktrace_sampling of { extra_events : Event.t list }
|
||||
|
||||
val extra_events : t -> Event.t list
|
||||
val param : t Command.Param.t
|
||||
@@ -0,0 +1,7 @@
|
||||
open Core
|
||||
open Async
|
||||
|
||||
type t =
|
||||
{ events : Event.t Pipe.Reader.t list
|
||||
; close_result : unit Or_error.t Deferred.t
|
||||
}
|
||||
@@ -0,0 +1,11 @@
|
||||
open Core
|
||||
open Async
|
||||
|
||||
(* The result of decoding events are pipe(s) of those events, and a deferred
|
||||
reason why the decoder exited. Multiple pipes will be returned if multiple
|
||||
snapshots were captured and processed, but they are returned in chronological
|
||||
order. Waiting on [close_result] will wait on pipes in sequential order. *)
|
||||
type t =
|
||||
{ events : Event.t Pipe.Reader.t list
|
||||
; close_result : unit Or_error.t Deferred.t
|
||||
}
|
||||
@@ -0,0 +1,48 @@
|
||||
open! Core
|
||||
|
||||
let decode_two_digit_hexadecimal_number first_character second_character =
|
||||
let%bind.Option hex_digit_of_first_character = Char.get_hex_digit first_character in
|
||||
let%bind.Option hex_digit_of_second_character = Char.get_hex_digit second_character in
|
||||
let leftshift_first_character = hex_digit_of_first_character lsl 4 in
|
||||
let bit_or_on_the_hexadecimals =
|
||||
leftshift_first_character lor hex_digit_of_second_character
|
||||
in
|
||||
Char.of_int bit_or_on_the_hexadecimals
|
||||
;;
|
||||
|
||||
let parser =
|
||||
let open Angstrom in
|
||||
let strip_numeric_suffix =
|
||||
char '_' *> skip_while Char.is_digit *> end_of_input *> return None
|
||||
in
|
||||
let double_underscores = string "__" >>| fun _ -> Some '.' in
|
||||
let two_digit_hexadecimal_number =
|
||||
let hex_character = satisfy Char.is_hex_digit in
|
||||
let hexcode =
|
||||
decode_two_digit_hexadecimal_number <$> char '$' *> hex_character <*> hex_character
|
||||
in
|
||||
hexcode
|
||||
>>= fun integer ->
|
||||
match integer with
|
||||
| None -> fail "invalid integer"
|
||||
| Some character -> return (Some character)
|
||||
in
|
||||
let normal_character = any_char >>| fun character -> Some character in
|
||||
let token =
|
||||
choice
|
||||
~failure_msg:"unrecognized token"
|
||||
[ strip_numeric_suffix
|
||||
; double_underscores
|
||||
; two_digit_hexadecimal_number
|
||||
; normal_character
|
||||
]
|
||||
in
|
||||
string "caml" *> many1 token
|
||||
;;
|
||||
|
||||
let demangle mangled_symbol =
|
||||
let mangled_string = Angstrom.parse_string ~consume:All parser mangled_symbol in
|
||||
match mangled_string with
|
||||
| Ok list -> Some (String.of_char_list (List.filter_map list ~f:Fn.id))
|
||||
| Error _ -> None
|
||||
;;
|
||||
@@ -0,0 +1,10 @@
|
||||
open! Core
|
||||
|
||||
(** The logic for this function is derived from perf [0]. This function is used to change
|
||||
the symbols in the application executable from a mangled form to a demangled form in
|
||||
ocaml. Now when running [magic-trace run -trigger] the symbols will appear in their
|
||||
demangled form. Will return None if the symbol is not recognized as an OCaml symbol.
|
||||
|
||||
[0]:
|
||||
https://github.com/torvalds/linux/blob/5bfc75d92efd494db37f5c4c173d3639d4772966/tools/perf/util/demangle-ocaml.c *)
|
||||
val demangle : string -> string option
|
||||
@@ -0,0 +1,53 @@
|
||||
(rule
|
||||
(targets perf_dlfilter.ml)
|
||||
(deps
|
||||
(:dep perf_dlfilter.c))
|
||||
(action
|
||||
(progn
|
||||
(run mkdir -p dlfilter)
|
||||
(run %{bin:gcc} -c -fpic %{dep})
|
||||
(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++ -Wall -Wextra -Werror -Wno-unused-parameter -DCAML_NAME_SPACE -I %{ocaml_where} $(llvm-config --cxxflags) -std=c++20 -O3 -march=broadwell -mtune=skylake -ffunction-sections -c llvm_symbolizer_stubs.cpp")
|
||||
(bash
|
||||
"ld.lld llvm_symbolizer_stubs.o --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 -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
|
||||
vec)
|
||||
(inline_tests)
|
||||
(preprocess
|
||||
(pps ppx_jane)))
|
||||
+411
@@ -0,0 +1,411 @@
|
||||
open! Core
|
||||
include Elf_intf
|
||||
|
||||
type t =
|
||||
{ symbol : Owee_elf.Symbol_table.t
|
||||
; string : Owee_elf.String_table.t
|
||||
; all_elf : Owee_buf.t
|
||||
; sections : Owee_elf.section array
|
||||
; programs : Owee_elf.program array
|
||||
; debug : Owee_buf.t option
|
||||
; ocaml_exception_info : Ocaml_exception_info.t option
|
||||
; base_offset : int
|
||||
; filename : string
|
||||
; statically_mappable : bool
|
||||
}
|
||||
|
||||
let ocaml_exception_info t = t.ocaml_exception_info
|
||||
|
||||
(** Elf files tend to have a "base offset" between where their sections end up in memory
|
||||
and where they are in the file, this function figures out that offset. *)
|
||||
let find_base_offset sections =
|
||||
(* iterate sections and find offset of first non-zero address *)
|
||||
Array.find_map sections ~f:(fun (section : Owee_elf.section) ->
|
||||
if Int64.(section.sh_addr = 0L)
|
||||
then None
|
||||
else Some Int64.(section.sh_addr - section.sh_offset))
|
||||
;;
|
||||
|
||||
let is_non_pie_executable (header : Owee_elf.header) =
|
||||
match header.e_type with
|
||||
| 2 (* ET_EXEC 2 Executable file *) -> true
|
||||
| 3 (* ET_DYN 3 Shared object file *) -> false
|
||||
| _e_type -> false
|
||||
;;
|
||||
|
||||
let find_ocaml_exception_info buffer sections =
|
||||
let read_note cursor ~actual_base =
|
||||
let descsz =
|
||||
Owee_elf_notes.read_desc_size ~expected_owner:"OCaml" ~expected_type:1 cursor
|
||||
in
|
||||
if descsz < 8 * 4
|
||||
then Owee_buf.invalid_format (Printf.sprintf "Too small size of note %d\n" descsz);
|
||||
let recorded_base = Owee_buf.Read.u64 cursor in
|
||||
let rec read_address_list acc =
|
||||
let addr = Owee_buf.Read.u64 cursor in
|
||||
if Int64.equal addr 0L
|
||||
then acc
|
||||
else (
|
||||
let addr = Owee_elf_notes.Stapsdt.adjust addr ~actual_base ~recorded_base in
|
||||
read_address_list (addr :: acc))
|
||||
in
|
||||
(* Order of field initializers matters!! Keep in sync with [Emit.mlp]. *)
|
||||
let entertraps = read_address_list [] in
|
||||
let pushtraps = read_address_list [] in
|
||||
let poptraps = read_address_list [] in
|
||||
entertraps, pushtraps, poptraps
|
||||
in
|
||||
try
|
||||
let ocaml_eh = Owee_elf_notes.find_notes_section sections ".note.ocaml_eh" in
|
||||
match Owee_elf_notes.Stapsdt.find_base_address sections with
|
||||
| None ->
|
||||
Core.eprint_s [%message "Found .note.ocaml_eh but not .stapsdt.base"];
|
||||
None
|
||||
| Some actual_base ->
|
||||
let rec read_all cursor ~entertraps ~pushtraps ~poptraps =
|
||||
if Owee_buf.at_end cursor
|
||||
then (
|
||||
let combine traps = Array.of_list (List.concat traps) in
|
||||
combine entertraps, combine pushtraps, combine poptraps)
|
||||
else (
|
||||
let entertraps', pushtraps', poptraps' = read_note cursor ~actual_base in
|
||||
read_all
|
||||
cursor
|
||||
~entertraps:(entertraps' :: entertraps)
|
||||
~pushtraps:(pushtraps' :: pushtraps)
|
||||
~poptraps:(poptraps' :: poptraps))
|
||||
in
|
||||
let body = Owee_elf.section_body buffer ocaml_eh in
|
||||
let cursor = Owee_buf.cursor body in
|
||||
let entertraps, pushtraps, poptraps =
|
||||
read_all cursor ~entertraps:[] ~pushtraps:[] ~poptraps:[]
|
||||
in
|
||||
Some (Ocaml_exception_info.create ~pushtraps ~poptraps ~entertraps)
|
||||
with
|
||||
| Owee_elf_notes.Section_not_found _ -> None
|
||||
;;
|
||||
|
||||
let create filename =
|
||||
try
|
||||
let buffer = Owee_buf.map_binary filename in
|
||||
let header, sections = Owee_elf.read_elf buffer in
|
||||
let string = Owee_elf.find_string_table buffer sections in
|
||||
let symbol = Owee_elf.find_symbol_table buffer sections in
|
||||
let programs = Owee_elf.read_programs buffer header in
|
||||
match string, symbol with
|
||||
| Some string, Some symbol ->
|
||||
let base_offset =
|
||||
find_base_offset sections |> Option.value ~default:0L |> Int64.to_int_exn
|
||||
in
|
||||
let statically_mappable = is_non_pie_executable header in
|
||||
let debug =
|
||||
Owee_elf.find_section_body buffer sections ~section_name:".debug_line"
|
||||
in
|
||||
let ocaml_exception_info = find_ocaml_exception_info buffer sections in
|
||||
Some
|
||||
{ string
|
||||
; symbol
|
||||
; debug
|
||||
; all_elf = buffer
|
||||
; sections
|
||||
; programs
|
||||
; base_offset
|
||||
; filename
|
||||
; statically_mappable
|
||||
; ocaml_exception_info
|
||||
}
|
||||
| _, _ -> None
|
||||
with
|
||||
| _ -> None
|
||||
;;
|
||||
|
||||
let is_func sym =
|
||||
match Owee_elf.Symbol_table.Symbol.type_attribute sym with
|
||||
| Func -> true
|
||||
| _ -> false
|
||||
;;
|
||||
|
||||
let matching_functions t symbol_re =
|
||||
let res = ref String.Map.empty in
|
||||
Owee_elf.Symbol_table.iter t.symbol ~f:(fun symbol ->
|
||||
match Owee_elf.Symbol_table.Symbol.name symbol t.string with
|
||||
| Some name when is_func symbol && Re.execp symbol_re name ->
|
||||
(* Duplicate symbols are possible if a symbol is in both the dynamic and static
|
||||
symbol tables. *)
|
||||
(match Map.add !res ~key:name ~data:symbol with
|
||||
| `Ok a -> res := a
|
||||
| `Duplicate -> ())
|
||||
| _ -> ());
|
||||
!res
|
||||
;;
|
||||
|
||||
let traverse_debug_line ~f t =
|
||||
Option.iter t.debug ~f:(fun body ->
|
||||
let cursor = Owee_buf.cursor body in
|
||||
let pointers_to_other_sections = Owee_elf.debug_line_pointers t.all_elf t.sections in
|
||||
let rec load_table_next () =
|
||||
match Owee_debug_line.read_chunk cursor ~pointers_to_other_sections with
|
||||
| None -> ()
|
||||
| Some (header, chunk) ->
|
||||
let process header (state : Owee_debug_line.state) () =
|
||||
if not state.end_sequence then f header state
|
||||
in
|
||||
Owee_debug_line.fold_rows (header, chunk) process ();
|
||||
load_table_next ()
|
||||
in
|
||||
load_table_next ())
|
||||
;;
|
||||
|
||||
let find_symbol t name =
|
||||
let some_name = Some name in
|
||||
with_return (fun return ->
|
||||
Owee_elf.Symbol_table.iter t.symbol ~f:(fun symbol ->
|
||||
if is_func symbol
|
||||
&& [%compare.equal: string option]
|
||||
(Owee_elf.Symbol_table.Symbol.name symbol t.string)
|
||||
some_name
|
||||
then return.return (Some symbol));
|
||||
None)
|
||||
;;
|
||||
|
||||
let find_selection t name : Selection.t option =
|
||||
let maybe_int_of_string str = Option.try_with (fun () -> Int.of_string str) in
|
||||
let find_line_selection name =
|
||||
let desired_filename, desired_line, desired_col =
|
||||
match String.split name ~on:':' with
|
||||
| [ desired_filename; desired_line; desired_col ] ->
|
||||
( Some desired_filename
|
||||
, maybe_int_of_string desired_line
|
||||
, maybe_int_of_string desired_col )
|
||||
| [ desired_filename; desired_line ] ->
|
||||
Some desired_filename, maybe_int_of_string desired_line, None
|
||||
| _ -> None, None, None
|
||||
in
|
||||
let%bind.Option desired_filename in
|
||||
let%bind.Option desired_line in
|
||||
let cols = ref [] in
|
||||
traverse_debug_line
|
||||
~f:(fun header state ->
|
||||
let filename = Owee_debug_line.get_filename header state in
|
||||
let line = state.line in
|
||||
let col = state.col in
|
||||
match filename with
|
||||
| Some filename ->
|
||||
if String.(desired_filename = filename) && desired_line = line
|
||||
then cols := (col, state.address) :: !cols
|
||||
| None -> ())
|
||||
t;
|
||||
let cols =
|
||||
List.sort !cols ~compare:(fun (col1, _) (col2, _) -> Int.compare col1 col2)
|
||||
in
|
||||
match cols with
|
||||
| [] -> None
|
||||
| (col, address) :: _ ->
|
||||
(match desired_col with
|
||||
| None ->
|
||||
if List.length cols > 1
|
||||
then
|
||||
Core.eprintf
|
||||
"Multiple snapshot symbols on same line. Selecting column %d with address \
|
||||
0x%x.\n"
|
||||
col
|
||||
address;
|
||||
Some (Selection.Address { address; name })
|
||||
| Some desired_col ->
|
||||
(match
|
||||
List.find_map cols ~f:(fun (col, _) ->
|
||||
if col = desired_col then Some address else None)
|
||||
with
|
||||
| None -> None
|
||||
| Some address -> Some (Selection.Address { address; name })))
|
||||
in
|
||||
let find_addr_selection addr =
|
||||
Option.bind
|
||||
(Option.try_with (fun () ->
|
||||
let addr =
|
||||
if not (String.is_prefix ~prefix:"0x" addr) then "0x" ^ addr else addr
|
||||
in
|
||||
Int.Hex.of_string addr))
|
||||
~f:(fun address -> Some (Selection.Address { address; name }))
|
||||
in
|
||||
let find_symbol_selection name =
|
||||
Option.map (find_symbol t name) ~f:(fun symbol -> Selection.Symbol symbol)
|
||||
in
|
||||
let prefix_and_functions =
|
||||
[ "symbol:", find_symbol_selection
|
||||
; "line:", find_line_selection
|
||||
; "addr:", find_addr_selection
|
||||
]
|
||||
in
|
||||
match
|
||||
List.find_map prefix_and_functions ~f:(fun (prefix, f) ->
|
||||
match String.is_prefix name ~prefix with
|
||||
| true -> f (String.drop_prefix name (String.length prefix))
|
||||
| false -> None)
|
||||
with
|
||||
| Some _ as result -> result
|
||||
| None -> List.find_map prefix_and_functions ~f:(fun ((_prefix : string), f) -> f name)
|
||||
;;
|
||||
|
||||
let all_symbols ?(select = `File_or_func) t =
|
||||
let res = String.Table.create () in
|
||||
Owee_elf.Symbol_table.iter t.symbol ~f:(fun symbol ->
|
||||
let should_add =
|
||||
match select, Owee_elf.Symbol_table.Symbol.type_attribute symbol with
|
||||
| `File_or_func, File | `File_or_func, Func -> true
|
||||
| `File, File | `Func, Func -> true
|
||||
| _, _ -> false
|
||||
in
|
||||
if should_add
|
||||
then (
|
||||
match Owee_elf.Symbol_table.Symbol.name symbol t.string with
|
||||
| None -> ()
|
||||
| Some name ->
|
||||
(* Duplicate symbols are possible if a symbol is in both the dynamic and static
|
||||
symbol tables. *)
|
||||
(match Hashtbl.add res ~key:name ~data:symbol with
|
||||
| `Ok | `Duplicate -> ())));
|
||||
Hashtbl.to_alist res
|
||||
;;
|
||||
|
||||
let all_file_selections t symbol =
|
||||
let locations = ref [] in
|
||||
let desired_filename = Owee_elf.Symbol_table.Symbol.name symbol t.string in
|
||||
traverse_debug_line
|
||||
~f:(fun header state ->
|
||||
let filename = Owee_debug_line.get_filename header state in
|
||||
match filename, desired_filename with
|
||||
| Some filename, Some desired_filename ->
|
||||
if String.(filename = desired_filename)
|
||||
then (
|
||||
let name = [%string "%{filename}:%{state.line#Int}:%{state.col#Int}"] in
|
||||
let closest_symbol =
|
||||
Owee_elf.Symbol_table.symbols_enclosing_address
|
||||
t.symbol
|
||||
~address:(Int64.of_int state.address)
|
||||
|> List.hd
|
||||
in
|
||||
let closest_symbol_name =
|
||||
Option.bind closest_symbol ~f:(fun closest_symbol ->
|
||||
Owee_elf.Symbol_table.Symbol.name closest_symbol t.string)
|
||||
in
|
||||
let show_name =
|
||||
match closest_symbol_name with
|
||||
| None -> name
|
||||
| Some closest_symbol_name -> [%string "%{name} %{closest_symbol_name}"]
|
||||
in
|
||||
let selection = Selection.Address { address = state.address; name } in
|
||||
locations := (show_name, selection) :: !locations)
|
||||
| None, _ | _, None -> ())
|
||||
t;
|
||||
!locations
|
||||
;;
|
||||
|
||||
let selection_stop_info t pid selection =
|
||||
let filename = Filename_unix.realpath t.filename in
|
||||
let compute_addr addr =
|
||||
if t.statically_mappable
|
||||
then addr
|
||||
else (
|
||||
(* Find the lowest p_vaddr from the program headers and use this as the base address *)
|
||||
let base_address =
|
||||
match
|
||||
List.fold_left
|
||||
~f:(fun acc ph ->
|
||||
if ph.p_type = 1
|
||||
then (
|
||||
match acc with
|
||||
| None -> Some ph.p_vaddr
|
||||
| Some min_vaddr -> Some (Int64.min min_vaddr ph.p_vaddr))
|
||||
else acc)
|
||||
~init:None
|
||||
(Array.to_list t.programs)
|
||||
with
|
||||
| Some vaddr -> vaddr
|
||||
| None -> failwith "No program headers of type LOAD found"
|
||||
in
|
||||
(* Find the first address that the binary is actually mapped into *)
|
||||
Owee_linux_maps.scan_pid (Pid.to_int pid)
|
||||
|> List.filter_map ~f:(fun { address_start; pathname; _ } ->
|
||||
let open Int64 in
|
||||
if String.(pathname = filename)
|
||||
then Some (address_start - base_address + addr)
|
||||
else None)
|
||||
|> List.hd_exn)
|
||||
in
|
||||
let compute_filter ~name ~addr ~size =
|
||||
let offset = Int64.( - ) addr (Int64.of_int t.base_offset) in
|
||||
let filter = [%string {|stop %{offset#Int64}/%{size#Int64}@%{filename}|}] in
|
||||
{ Stop_info.name; addr; filter }
|
||||
in
|
||||
match selection with
|
||||
| Selection.Symbol symbol ->
|
||||
let name = Owee_elf.Symbol_table.Symbol.name symbol t.string in
|
||||
let name = Option.value_exn ~message:"stop_info symbols must have a name" name in
|
||||
let addr = Owee_elf.Symbol_table.Symbol.value symbol in
|
||||
let addr = compute_addr addr in
|
||||
let size = Owee_elf.Symbol_table.Symbol.size_in_bytes symbol in
|
||||
compute_filter ~name ~addr ~size
|
||||
| Address { address; name } ->
|
||||
let addr = compute_addr (Int64.of_int address) in
|
||||
compute_filter ~name ~addr ~size:1L
|
||||
;;
|
||||
|
||||
let addr_table t =
|
||||
let table = Int.Table.create () in
|
||||
let symbol_starts = Int.Hash_set.create () in
|
||||
Owee_elf.Symbol_table.iter t.symbol ~f:(fun symbol ->
|
||||
if is_func symbol
|
||||
then
|
||||
Hash_set.add
|
||||
symbol_starts
|
||||
(Owee_elf.Symbol_table.Symbol.value symbol |> Int64.to_int_exn));
|
||||
traverse_debug_line
|
||||
~f:(fun header state ->
|
||||
if Hash_set.mem symbol_starts state.address
|
||||
then
|
||||
Hashtbl.set
|
||||
table
|
||||
~key:state.address
|
||||
~data:
|
||||
{ Location.filename = Owee_debug_line.get_filename header state
|
||||
; line = state.line
|
||||
; col = state.col
|
||||
})
|
||||
t;
|
||||
table
|
||||
;;
|
||||
|
||||
module Symbol_resolver = struct
|
||||
type nonrec t =
|
||||
{ elf : t
|
||||
; file_offset : int
|
||||
; loaded_offset : int
|
||||
}
|
||||
|
||||
type resolved =
|
||||
{ name : string
|
||||
; start_addr : int
|
||||
; end_addr : int
|
||||
}
|
||||
|
||||
let resolve (t : t) addr =
|
||||
let open Option.Let_syntax in
|
||||
let normal_offset = t.file_offset + t.elf.base_offset in
|
||||
let original_addr = addr - t.loaded_offset + normal_offset in
|
||||
let%bind symb =
|
||||
Owee_elf.Symbol_table.symbols_enclosing_address
|
||||
t.elf.symbol
|
||||
~address:(Int64.of_int original_addr)
|
||||
|> List.last
|
||||
in
|
||||
let name, start_addr, size =
|
||||
Owee_elf.Symbol_table.Symbol.(
|
||||
( name symb t.elf.string
|
||||
, (value symb |> Int64.to_int_exn) - normal_offset + t.loaded_offset
|
||||
, size_in_bytes symb |> Int64.to_int_exn ))
|
||||
in
|
||||
let%bind name in
|
||||
return { name; start_addr; end_addr = start_addr + size }
|
||||
;;
|
||||
end
|
||||
+50
@@ -0,0 +1,50 @@
|
||||
open! Core
|
||||
include module type of Elf_intf
|
||||
|
||||
type t
|
||||
|
||||
val create : Filename.t -> t option
|
||||
|
||||
(** Returns name, address and filter string for using a symbol as a snapshot point.
|
||||
|
||||
The address is suitable for placing a breakpoint, and the filter string causes tracing
|
||||
to stop when executing code from that symbol. The filter string syntax is in ftrace
|
||||
format and is accepted both by the perf command line tool and the
|
||||
[PERF_EVENT_IOC_SET_FILTER] ioctl for the [perf_event_open] syscall. *)
|
||||
val selection_stop_info : t -> Pid.t -> Selection.t -> Stop_info.t
|
||||
|
||||
val addr_table : t -> Addr_table.t
|
||||
val ocaml_exception_info : t -> Ocaml_exception_info.t option
|
||||
|
||||
(** Find function symbols matching a regex and return a map from symbol name to symbol
|
||||
suitable for asking the user to disambiguate. *)
|
||||
val matching_functions : t -> Re.re -> Owee_elf.Symbol_table.Symbol.t String.Map.t
|
||||
|
||||
val all_symbols
|
||||
: ?select:[ `File | `Func | `File_or_func ] (** Default [`File_or_func]. *)
|
||||
-> t
|
||||
-> (string * Owee_elf.Symbol_table.Symbol.t) list
|
||||
|
||||
val all_file_selections
|
||||
: t
|
||||
-> Owee_elf.Symbol_table.Symbol.t
|
||||
-> (string * Selection.t) list
|
||||
|
||||
val find_symbol : t -> string -> Owee_elf.Symbol_table.Symbol.t option
|
||||
val find_selection : t -> string -> Selection.t option
|
||||
|
||||
module Symbol_resolver : sig
|
||||
type nonrec t =
|
||||
{ elf : t
|
||||
; file_offset : int
|
||||
; loaded_offset : int
|
||||
}
|
||||
|
||||
type resolved =
|
||||
{ name : string
|
||||
; start_addr : int
|
||||
; end_addr : int
|
||||
}
|
||||
|
||||
val resolve : t -> int -> resolved option
|
||||
end
|
||||
@@ -0,0 +1,31 @@
|
||||
open! Core
|
||||
|
||||
module Location = struct
|
||||
type t =
|
||||
{ filename : string option
|
||||
; line : int
|
||||
; col : int
|
||||
}
|
||||
[@@deriving sexp]
|
||||
end
|
||||
|
||||
module Addr_table = struct
|
||||
type t = Location.t Int.Table.t
|
||||
end
|
||||
|
||||
module Stop_info = struct
|
||||
type t =
|
||||
{ name : string
|
||||
; addr : int64
|
||||
; filter : string
|
||||
}
|
||||
end
|
||||
|
||||
module Selection = struct
|
||||
type t =
|
||||
| Symbol of Owee_elf.Symbol_table.Symbol.t
|
||||
| Address of
|
||||
{ address : int
|
||||
; name : string
|
||||
}
|
||||
end
|
||||
@@ -0,0 +1,60 @@
|
||||
open! Core
|
||||
open Async
|
||||
|
||||
(* Points to a filesystem path will a copy of Perfetto. If provided, magic-trace will
|
||||
automatically start a local HTTP server for you to view the trace. You can use this
|
||||
"hidden" feature to serve a local copy of Perfetto if you don't want to copy trace
|
||||
files around. *)
|
||||
let perfetto_dir = Unix.getenv "MAGIC_TRACE_PERFETTO_DIR"
|
||||
|
||||
(* Documentation string for [-share] *)
|
||||
let share_doc = Unix.getenv "MAGIC_TRACE_SHARE_DOC"
|
||||
|
||||
(* Points to a filesystem path that will be invoked with a trace filename to implement
|
||||
[-share]. *)
|
||||
let share_command_filename = Unix.getenv "MAGIC_TRACE_SHARE_COMMAND"
|
||||
|
||||
(* Override which [perf] to use. If this isn't set, magic-trace will use whatever's first
|
||||
in $PATH. *)
|
||||
let perf_path = Option.value ~default:"perf" (Unix.getenv "MAGIC_TRACE_PERF_PATH")
|
||||
|
||||
(* Whether [perf] should be considered privileged when running as not-root. Bypasses error
|
||||
checks around kernel tracing when not root. *)
|
||||
let perf_is_privileged = Option.is_some (Unix.getenv "MAGIC_TRACE_PERF_IS_PRIVILEGED")
|
||||
|
||||
(* Override whether kcore will be used (in the case that [perf] supports it at all). *)
|
||||
let perf_no_kcore = Option.is_some (Unix.getenv "MAGIC_TRACE_PERF_NO_KCORE")
|
||||
|
||||
(* Turns on hidden command line options and attached "[inferred start time]" to functions
|
||||
with inferred start times.
|
||||
|
||||
This helps magic-trace developers debug magic-trace, it's not generally useful. *)
|
||||
let debug = Option.is_some (Unix.getenv "MAGIC_TRACE_DEBUG")
|
||||
|
||||
(* Turns on hidden command line options which are considered experimental
|
||||
features of magic-trace. *)
|
||||
let experimental = Option.is_some (Unix.getenv "MAGIC_TRACE_EXPERIMENTAL")
|
||||
|
||||
(* When tracing the kernel on certain systems, perf only has root access when
|
||||
being run with a specific set of flags. Since this does not include
|
||||
[--dlfilter], this environment variable allows the user to forcibly disable
|
||||
filtering. *)
|
||||
let no_dlfilter = Option.is_some (Unix.getenv "MAGIC_TRACE_NO_DLFILTER")
|
||||
|
||||
(* Demangle symbols in the fuzzy finder. This is currently slow on large binaries, so is
|
||||
disabled by default. *)
|
||||
let fzf_demangle_symbols = Option.is_some (Unix.getenv "MAGIC_TRACE_FZF_DEMANGLE_SYMBOLS")
|
||||
|
||||
(* Use old-style trace generation for exceptions in all cases. *)
|
||||
let no_ocaml_exception_debug_info =
|
||||
Option.is_some (Unix.getenv "MAGIC_TRACE_NO_OCAML_EXCEPTION_DEBUG_INFO")
|
||||
;;
|
||||
|
||||
(* Skip any special case transaction handling, intended for debugging tx/tx_abrt. *)
|
||||
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")
|
||||
@@ -0,0 +1,16 @@
|
||||
open! Core
|
||||
|
||||
val debug : bool
|
||||
val experimental : bool
|
||||
val perf_path : string
|
||||
val perf_is_privileged : bool
|
||||
val perf_no_kcore : bool
|
||||
val perfetto_dir : string option
|
||||
val share_doc : string option
|
||||
val share_command_filename : string option
|
||||
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
|
||||
@@ -0,0 +1,11 @@
|
||||
open! Core
|
||||
|
||||
let to_error errno =
|
||||
Core_unix.Error.of_system_int ~errno |> Core_unix.Error.message |> Or_error.error_string
|
||||
;;
|
||||
|
||||
let to_result errno =
|
||||
match errno with
|
||||
| 0 -> Ok ()
|
||||
| errno -> to_error errno
|
||||
;;
|
||||
@@ -0,0 +1,7 @@
|
||||
(** Using C errno numbers is a convenient way to plumb errors we might want to handle
|
||||
gracefully out of a C stub, rather than using exceptions. This file provides some
|
||||
utilities for converting them to OCaml errors. *)
|
||||
open! Core
|
||||
|
||||
val to_error : int -> 'a Or_error.t
|
||||
val to_result : int -> unit Or_error.t
|
||||
+148
@@ -0,0 +1,148 @@
|
||||
open! Core
|
||||
|
||||
module Kind = struct
|
||||
type t =
|
||||
| Async
|
||||
| Call
|
||||
| Return
|
||||
| Syscall
|
||||
| Sysret
|
||||
| Hardware_interrupt
|
||||
| Interrupt
|
||||
| Iret
|
||||
| Jump
|
||||
| Tx_abort
|
||||
[@@deriving sexp, compare, bin_io]
|
||||
end
|
||||
|
||||
module Thread = struct
|
||||
type t =
|
||||
{ pid : Pid.t option
|
||||
; tid : Pid.t option
|
||||
}
|
||||
[@@deriving sexp, compare, hash, bin_io]
|
||||
end
|
||||
|
||||
module Location = struct
|
||||
type t =
|
||||
{ (* TODO Use [i64] everywhere. *)
|
||||
instruction_pointer : Int64.Hex.t
|
||||
; symbol : Symbol.t
|
||||
; symbol_offset : Int.Hex.t
|
||||
; dso : Interned_string.t or_null
|
||||
}
|
||||
[@@deriving sexp, fields ~getters, 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. *)
|
||||
|
||||
type nonrec t = t
|
||||
|
||||
let to_sexpable { instruction_pointer; _ } = instruction_pointer
|
||||
|
||||
let of_sexpable instruction_pointer =
|
||||
{ instruction_pointer; symbol = Symbol.Unknown; symbol_offset = 0; dso = Null }
|
||||
;;
|
||||
|
||||
let to_binable { instruction_pointer; _ } = instruction_pointer
|
||||
|
||||
let of_binable instruction_pointer =
|
||||
{ instruction_pointer; symbol = Symbol.Unknown; symbol_offset = 0; dso = Null }
|
||||
;;
|
||||
|
||||
let caller_identity =
|
||||
Bin_prot.Shape.Uuid.of_string "0d14b306-09e1-11ed-9c9e-a4bb6d9e5f20"
|
||||
;;
|
||||
end
|
||||
|
||||
include Binable.Of_binable_with_uuid (Int64.Hex) (Ignore_symbol)
|
||||
include Sexpable.Of_sexpable (Int64.Hex) (Ignore_symbol)
|
||||
|
||||
(* 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; dso = Null }
|
||||
;;
|
||||
|
||||
let unknown = locationless Unknown
|
||||
let untraced = locationless Untraced
|
||||
let returned = locationless Returned
|
||||
let syscall = locationless Syscall
|
||||
end
|
||||
|
||||
module Ok = struct
|
||||
module Data = struct
|
||||
type t =
|
||||
| Trace of
|
||||
{ trace_state_change : Trace_state_change.t option [@sexp.option]
|
||||
; kind : Kind.t option [@sexp.option]
|
||||
; src : Location.t
|
||||
; dst : Location.t
|
||||
}
|
||||
| Power of { freq : int }
|
||||
| Stacktrace_sample of { callstack : Location.t list }
|
||||
| Event_sample of
|
||||
{ location : Location.t
|
||||
; count : int
|
||||
; name : Collection_mode.Event.Name.t
|
||||
}
|
||||
[@@deriving sexp, bin_io]
|
||||
end
|
||||
|
||||
type t =
|
||||
{ thread : Thread.t
|
||||
; time : Time_ns.Span.t
|
||||
; data : Data.t
|
||||
; in_transaction : bool [@sexp.bool]
|
||||
}
|
||||
[@@deriving sexp, bin_io]
|
||||
end
|
||||
|
||||
module Decode_error = struct
|
||||
type t =
|
||||
{ thread : Thread.t
|
||||
(* The time is only present sometimes. I haven't figured out when, exactly, but my
|
||||
Skylake test machine has it while my Tiger Lake test machine doesn't. It could
|
||||
easily be a difference between different versions of perf... *)
|
||||
; time : Time_ns_unix.Span.Option.t
|
||||
; instruction_pointer : Int64.Hex.t option
|
||||
; message : string
|
||||
}
|
||||
[@@deriving sexp, bin_io]
|
||||
end
|
||||
|
||||
type t = (Ok.t, Decode_error.t) Result.t [@@deriving sexp, bin_io]
|
||||
|
||||
let thread (t : t) =
|
||||
match t with
|
||||
| Ok { thread; _ } | Error { thread; _ } -> thread
|
||||
;;
|
||||
|
||||
let time (t : t) =
|
||||
match t with
|
||||
| Ok { time; _ } -> Time_ns_unix.Span.Option.some time
|
||||
| Error { time; _ } -> time
|
||||
;;
|
||||
|
||||
let change_time (t : t) ~f : t =
|
||||
match t with
|
||||
| Ok ({ time; _ } as t) -> Ok { t with time = f time }
|
||||
| Error ({ time; _ } as u) ->
|
||||
(match%optional.Time_ns_unix.Span.Option time with
|
||||
| None -> t
|
||||
| Some time -> Error { u with time = Time_ns_unix.Span.Option.some (f time) })
|
||||
;;
|
||||
|
||||
module With_write_info = struct
|
||||
type outer = t [@@deriving sexp_of]
|
||||
|
||||
type t =
|
||||
{ event : outer
|
||||
; should_write : bool
|
||||
}
|
||||
[@@deriving sexp_of, fields]
|
||||
|
||||
let create ?(should_write = true) event = { event; should_write }
|
||||
end
|
||||
@@ -0,0 +1,97 @@
|
||||
open! Core
|
||||
|
||||
module Kind : sig
|
||||
type t =
|
||||
| Async
|
||||
| Call
|
||||
| Return
|
||||
| Syscall
|
||||
| Sysret
|
||||
| Hardware_interrupt
|
||||
| Interrupt
|
||||
| Iret
|
||||
| Jump
|
||||
| Tx_abort
|
||||
[@@deriving sexp, compare]
|
||||
end
|
||||
|
||||
module Thread : sig
|
||||
type t =
|
||||
{ pid : Pid.t option
|
||||
; tid : Pid.t option
|
||||
}
|
||||
[@@deriving sexp, compare, hash]
|
||||
end
|
||||
|
||||
module Location : sig
|
||||
type t =
|
||||
{ instruction_pointer : int64
|
||||
; symbol : Symbol.t
|
||||
; symbol_offset : int
|
||||
; dso : Interned_string.t or_null
|
||||
}
|
||||
[@@deriving sexp, fields ~getters, bin_io]
|
||||
|
||||
val unknown : t
|
||||
val untraced : t
|
||||
val returned : t
|
||||
val syscall : t
|
||||
end
|
||||
|
||||
module Ok : sig
|
||||
module Data : sig
|
||||
type t =
|
||||
| Trace of
|
||||
{ trace_state_change : Trace_state_change.t option
|
||||
; kind : Kind.t option
|
||||
; src : Location.t
|
||||
; dst : Location.t
|
||||
} (** Represents an event collected from Intel PT. *)
|
||||
| Power of { freq : int } (** Power event collected by Intel PT. *)
|
||||
| Stacktrace_sample of
|
||||
{ callstack : Location.t list (** Oldest to most recent calls in order. *) }
|
||||
(** Represents cycles event collected through sampling. *)
|
||||
| Event_sample of
|
||||
{ location : Location.t
|
||||
; count : int
|
||||
; name : Collection_mode.Event.Name.t
|
||||
} (** Represents counter based events collected through sampling. *)
|
||||
[@@deriving sexp]
|
||||
end
|
||||
|
||||
type t =
|
||||
{ thread : Thread.t
|
||||
; time : Time_ns.Span.t
|
||||
; data : Data.t
|
||||
; in_transaction : bool
|
||||
}
|
||||
[@@deriving sexp]
|
||||
end
|
||||
|
||||
module Decode_error : sig
|
||||
type t =
|
||||
{ thread : Thread.t
|
||||
; time : Time_ns_unix.Span.Option.t
|
||||
; instruction_pointer : int64 option
|
||||
; message : string
|
||||
}
|
||||
[@@deriving sexp]
|
||||
end
|
||||
|
||||
type t = (Ok.t, Decode_error.t) Result.t [@@deriving sexp, bin_io]
|
||||
|
||||
val thread : t -> Thread.t
|
||||
val time : t -> Time_ns_unix.Span.Option.t
|
||||
val change_time : t -> f:(Time_ns.Span.t -> Time_ns.Span.t) -> t
|
||||
|
||||
module With_write_info : sig
|
||||
type outer = t
|
||||
|
||||
type t =
|
||||
{ event : outer
|
||||
; should_write : bool
|
||||
}
|
||||
[@@deriving sexp_of, fields]
|
||||
|
||||
val create : ?should_write:bool -> outer -> t
|
||||
end
|
||||
@@ -0,0 +1,102 @@
|
||||
open! Core
|
||||
open! Async
|
||||
|
||||
module Symbol_hit = struct
|
||||
module Kind = struct
|
||||
type t =
|
||||
| Start
|
||||
| Stop
|
||||
[@@deriving sexp_of]
|
||||
end
|
||||
|
||||
type t =
|
||||
{ kind : Kind.t
|
||||
; symbol : Symbol.t
|
||||
; time : Time_ns.Span.t
|
||||
}
|
||||
[@@deriving sexp_of]
|
||||
end
|
||||
|
||||
let range_hit_times ~decode_events ~range_symbols =
|
||||
let open Deferred.Or_error.Let_syntax in
|
||||
let%bind { Decode_result.events; _ } = decode_events () in
|
||||
Deferred.List.map events ~how:`Sequential ~f:(fun events ->
|
||||
let { Trace_filter.start_symbol; stop_symbol } = range_symbols in
|
||||
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
|
||||
| Ok { data = Trace trace; time; _ } ->
|
||||
(match trace.kind with
|
||||
| Some Call ->
|
||||
let symbol = trace.dst.symbol in
|
||||
if is_start symbol
|
||||
then Some { Symbol_hit.kind = Start; symbol; time }
|
||||
else if is_stop symbol
|
||||
then Some { Symbol_hit.kind = Stop; symbol; time }
|
||||
else None
|
||||
| _ -> None)
|
||||
| Ok { data = Stacktrace_sample { callstack }; time; _ } ->
|
||||
List.rev callstack
|
||||
|> List.fold ~init:None ~f:(fun acc call ->
|
||||
match acc, call with
|
||||
| None, { symbol; _ } when is_start symbol ->
|
||||
Some { Symbol_hit.kind = Start; symbol; time }
|
||||
| None, { symbol; _ } when is_stop symbol ->
|
||||
Some { Symbol_hit.kind = Stop; symbol; time }
|
||||
| acc, _ -> acc))
|
||||
|> Pipe.to_list)
|
||||
|> Deferred.map ~f:Or_error.return
|
||||
;;
|
||||
|
||||
let remove_unmatched_hits (hits : Symbol_hit.t list) =
|
||||
let rec remove_unmatched_hits' ~accum hits =
|
||||
match hits with
|
||||
| [] -> accum
|
||||
| [ { Symbol_hit.kind = Start; _ } ] -> accum
|
||||
| [ { Symbol_hit.kind = Stop; _ } ] -> accum
|
||||
| first :: second :: rest ->
|
||||
(match first.kind, second.kind with
|
||||
| _, Start -> remove_unmatched_hits' ~accum (second :: rest)
|
||||
| Stop, Stop -> remove_unmatched_hits' ~accum rest
|
||||
| Start, Stop -> remove_unmatched_hits' ~accum:(second :: first :: accum) rest)
|
||||
in
|
||||
remove_unmatched_hits' ~accum:[] hits |> List.rev
|
||||
;;
|
||||
|
||||
(* Calls provided [decode_event] and marks events if they should be written (are
|
||||
in-between a start and stop symbol). If there are multiple calls to
|
||||
[range_start_symbol] at the same time, they will all be marked [should_write = true]. *)
|
||||
let decode_events_and_annotate ~decode_events ~range_symbols =
|
||||
let open Deferred.Or_error.Let_syntax in
|
||||
let%bind { Decode_result.events; close_result } = decode_events ()
|
||||
and range_hit_times = range_hit_times ~decode_events ~range_symbols in
|
||||
let hit_sequences = List.map range_hit_times ~f:remove_unmatched_hits in
|
||||
let events =
|
||||
List.zip_exn events hit_sequences
|
||||
|> List.map ~f:(fun (events, hit_sequence) ->
|
||||
Pipe.folding_map
|
||||
events
|
||||
~init:(hit_sequence, false)
|
||||
~f:(fun (hits, in_filtered_region) event ->
|
||||
let hits, in_filtered_region =
|
||||
match hits with
|
||||
| [] -> hits, in_filtered_region
|
||||
| hd :: tl ->
|
||||
(match event with
|
||||
| Ok { data = Trace { kind = Some Call; dst; _ }; time; _ }
|
||||
when Time_ns_unix.Span.(time = hd.time)
|
||||
&& Symbol.equal dst.symbol hd.symbol -> tl, not in_filtered_region
|
||||
| Ok { data = Stacktrace_sample _; time; _ }
|
||||
when Time_ns_unix.Span.(time = hd.time) -> tl, not in_filtered_region
|
||||
| Ok { data = Trace _; _ }
|
||||
| Ok { data = Power _; _ }
|
||||
| Ok { data = Stacktrace_sample _; _ }
|
||||
| Ok { data = Event_sample _; _ }
|
||||
| Error _ -> hits, in_filtered_region)
|
||||
in
|
||||
( (hits, in_filtered_region)
|
||||
, Event.With_write_info.create ~should_write:in_filtered_region event )))
|
||||
in
|
||||
return (events, close_result)
|
||||
;;
|
||||
@@ -0,0 +1,8 @@
|
||||
open! Core
|
||||
open! Async
|
||||
|
||||
val decode_events_and_annotate
|
||||
: decode_events:(unit -> Decode_result.t Deferred.Or_error.t)
|
||||
-> range_symbols:Trace_filter.t
|
||||
-> (Event.With_write_info.t Async.Pipe.Reader.t list * unit Deferred.Or_error.t)
|
||||
Deferred.Or_error.t
|
||||
@@ -0,0 +1,22 @@
|
||||
open! Core
|
||||
|
||||
type t = string [@@deriving sexp_of]
|
||||
|
||||
let equal = phys_equal
|
||||
let compare t1 t2 = Int.compare (Obj.magic t1) (Obj.magic t2)
|
||||
let hash t = Int.hash (Obj.magic t)
|
||||
let hash_fold_t hash_state t = Int.hash_fold_t hash_state (Obj.magic t)
|
||||
let cache = String.Hash_set.create ()
|
||||
let intern t = Hash_set.get_or_add cache t
|
||||
|
||||
let t_of_sexp = function
|
||||
| Sexp.Atom string -> intern string
|
||||
| _ -> assert false
|
||||
;;
|
||||
|
||||
let of_string = intern
|
||||
let to_string t = t
|
||||
let uuid = "6c0bf9f4-3378-11f1-ae24-c84bd6ab9c33"
|
||||
let caller_identity = Bin_prot.Shape.Uuid.of_string uuid
|
||||
|
||||
include functor Binable.Of_stringable_with_uuid
|
||||
@@ -0,0 +1,5 @@
|
||||
open! Core
|
||||
|
||||
type t = private string [@@deriving equal, hash, compare, sexp, bin_io]
|
||||
|
||||
val intern : string -> t
|
||||
@@ -0,0 +1,99 @@
|
||||
#include <cstdint>
|
||||
#include <cstring>
|
||||
#include <cstddef>
|
||||
#include <string_view>
|
||||
|
||||
#include "caml/alloc.h"
|
||||
#include "caml/memory.h"
|
||||
#include "caml/mlvalues.h"
|
||||
#include "llvm/DebugInfo/Symbolize/SymbolizableModule.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());
|
||||
}
|
||||
|
||||
// Matches `caml[A-Z]`, the prefix for an OCaml mangled name.
|
||||
bool is_ocaml_mangled(std::string_view name) noexcept {
|
||||
return name.starts_with("caml") && name.size() > 4 && name[4] >= 'A' && name[4] <= 'Z';
|
||||
}
|
||||
} // namespace
|
||||
|
||||
extern "C" {
|
||||
CAMLprim llvm::symbolize::LLVMSymbolizer *__attribute__((used, retain))
|
||||
magic_trace_llvm_symbolizer_create() {
|
||||
return new llvm::symbolize::LLVMSymbolizer();
|
||||
}
|
||||
|
||||
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, symbol_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);
|
||||
}
|
||||
|
||||
// LLVM gives us the (demangled) LinkageName, but it can't demangle OCaml
|
||||
// symbols. We could demangle ourselves, but the name the compiler emits
|
||||
// under [DW_AT_name] is considerably more readable, so we use that instead.
|
||||
const llvm::DIInliningInfo *short_frames = nullptr;
|
||||
llvm::DIInliningInfo short_result;
|
||||
bool needs_short_names = false;
|
||||
for (uint32_t i = 0; i < num_frames; i++) {
|
||||
if (is_ocaml_mangled(frames.getFrame(i).FunctionName)) {
|
||||
needs_short_names = true;
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (needs_short_names) {
|
||||
if (auto module = symbolizer->getOrCreateModuleInfo(executable_file)) {
|
||||
if (llvm::symbolize::SymbolizableModule *info = *module) {
|
||||
short_result = info->symbolizeInlinedCode(
|
||||
sectioned_address,
|
||||
llvm::DILineInfoSpecifier(
|
||||
llvm::DILineInfoSpecifier::FileLineInfoKind::AbsoluteFilePath,
|
||||
llvm::DINameKind::ShortName),
|
||||
/*UseSymbolTable=*/true);
|
||||
short_frames = &short_result;
|
||||
}
|
||||
} else {
|
||||
llvm::consumeError(module.takeError());
|
||||
}
|
||||
}
|
||||
|
||||
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);
|
||||
std::string_view name = frame.FunctionName;
|
||||
if (short_frames != nullptr && is_ocaml_mangled(frame.FunctionName) &&
|
||||
i < short_frames->getNumberOfFrames()) {
|
||||
name = short_frames->getFrame(i).FunctionName;
|
||||
}
|
||||
symbol_name = ocaml_string_of_cpp_string(name);
|
||||
caml_modify(&Field(inlined_frames, num_frames - 1 - i), symbol_name);
|
||||
}
|
||||
CAMLreturn(inlined_frames);
|
||||
}
|
||||
}
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user