An @x86 alias, and the two scripts that ask what the backend costs

This commit is contained in:
Joseph Ferano 2026-09-13 22:49:38 +07:00
parent 8e0e99f439
commit 54da06d111
8 changed files with 380 additions and 3 deletions

86
spike/x86/bench.sh Executable file
View File

@ -0,0 +1,86 @@
#!/usr/bin/env bash
# The speed half of cost.sh, on programs that are long enough to time.
#
# Why this exists beside cost.sh rather than inside it: every program in
# test/programs runs in about two and a half milliseconds, of which nearly
# all is fork, exec and the dynamic loader. Best-of-five does not rescue a
# signal that is not there, and a table of 97 rows that all say "2.5ms vs
# 2.6ms" would be a measurement of execve. So the corpus answers the size
# question and these four answer the speed one, each written so that one
# suspected cost is most of what the program does.
#
# Four builds of each, and the third column is the one to read:
#
# llvm as shipped, -O2. Frequently the loop is simply gone; that is a
# true number about the toolchain and a useless one about codegen.
# llvm -O0 via --debug, which forces it. LLVM's instruction selection with
# its optimiser off -- the fair comparison for a backend that has
# no optimiser.
# x86 this backend.
# x86 nbc --no-bounds-checks, for b2, where the difference is the check.
#
# And --dev on both sides, which is the one suspected cost the two backends
# share: every cross-function call goes through an indirection cell, so it is
# a load and an indirect call where a release build has a direct one. b1 is
# where that has to show.
#
# Usage: spike/x86/bench.sh [name-substring ...]
set -u
orig=$(pwd)
here=$(cd "$(dirname "$0")" && pwd)
root=$(cd "$here/../.." && pwd)
cd "$root" || exit 1
if [ -n "${FLAN:-}" ]; then
case $FLAN in /*) flan=$FLAN;; *) flan=$orig/$FLAN;; esac
else
dune build --root . bin/main.exe 2>&1 | head -30
flan=$root/_build/default/bin/main.exe
fi
test -x "$flan" || { echo "build failed" >&2; exit 1; }
out=${COST_OUT:-${TMPDIR:-/tmp}/flan-bench.$$}
mkdir -p "$out" || exit 1
trap 'rm -rf "$out"' EXIT
REPS=${COST_REPS:-5}
best () {
min=
for i in $(seq "$REPS"); do
t0=$(date +%s%N)
timeout 120 "$1" >/dev/null 2>&1 </dev/null
t1=$(date +%s%N)
d=$(( (t1 - t0) / 1000 ))
if [ -z "$min" ] || [ "$d" -lt "$min" ]; then min=$d; fi
done
echo "$min"
}
own () {
nm --defined-only -S "$1" 2>/dev/null \
| awk 'NF==4 && ($3=="T"||$3=="t") && $4 ~ /^flan\./ {n+=strtonum("0x"$2)} END{print n+0}'
}
printf 'name\tllvm_us\to0_us\tx86_us\tllvm_nbc_us\tx86_nbc_us\tllvm_dev_us\tx86_dev_us\tllvm_own\to0_own\tx86_own\tx86_dev_own\n'
for src in "$root"/spike/x86/bench/*.flan; do
name=$(basename "$src" .flan)
if [ $# -gt 0 ]; then
want=0
for pat in "$@"; do case "$name" in *"$pat"*) want=1;; esac; done
[ $want = 1 ] || continue
fi
"$flan" build "$src" -o "$out/l" >/dev/null 2>&1 || { echo "$name: llvm build failed" >&2; continue; }
"$flan" build "$src" --debug -o "$out/d" >/dev/null 2>&1 || { echo "$name: -O0 build failed" >&2; continue; }
"$flan" build "$src" --x86 -o "$out/x" >/dev/null 2>&1 || { echo "$name: x86 build failed" >&2; continue; }
"$flan" build "$src" --no-bounds-checks -o "$out/ln" >/dev/null 2>&1
"$flan" build "$src" --x86 --no-bounds-checks -o "$out/xn" >/dev/null 2>&1
"$flan" build "$src" --dev -o "$out/lv" >/dev/null 2>&1
"$flan" build "$src" --x86 --dev -o "$out/xv" >/dev/null 2>&1
printf '%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\n' "$name" \
"$(best "$out/l")" "$(best "$out/d")" "$(best "$out/x")" \
"$(best "$out/ln")" "$(best "$out/xn")" \
"$(best "$out/lv")" "$(best "$out/xv")" \
"$(own "$out/l")" "$(own "$out/d")" "$(own "$out/x")" "$(own "$out/xv")"
done

View File

@ -0,0 +1,20 @@
;;;; A hot loop that does nothing but call.
;;;;
;;;; The suspected cost is the guard this backend emits after every call --
;;;; and, in a dev build, the load of the indirection cell before it. Neither
;;;; is visible in the corpus, where a program's whole run is process startup.
;;;; Here the call is the program: the body is one add, so whatever separates
;;;; this from LLVM at -O0 is the call sequence and not the arithmetic.
;;;;
;;;; Not in spike/x86 proper, where survey.sh would pick it up: the survey's
;;;; counts are quoted in three handoffs and a benchmark is not a case.
(defn step [a i64 b i64] i64
(+ a b))
(defn main [] i32
(let [acc (i64 0)]
(dotimes [i 20000000]
(set acc (step acc 1)))
(print acc) (println ""))
0)

View File

@ -0,0 +1,20 @@
;;;; A hot loop that does nothing but index a bounds-checked array.
;;;;
;;;; The suspected cost is three frame temporaries per check. This one has an
;;;; A/B that the others do not: --no-bounds-checks builds the same program
;;;; with the check gone, on both sides, so the difference between the two
;;;; x86 numbers is the check and nothing else, and the same difference on
;;;; the LLVM side says what the check costs when a compiler is allowed to
;;;; hoist it out of the loop.
(defvar xs [1024 i32])
(defn main [] i32
(dotimes [i 1024]
(set (at xs i) i))
(let [acc (i64 0)]
(dotimes [r 20000]
(dotimes [i 1024]
(set acc (+ acc (i64 (at xs i))))))
(print acc) (println ""))
0)

View File

@ -0,0 +1,21 @@
;;;; A hot loop of arithmetic and nothing else: no calls, no arrays, no
;;;; copies.
;;;;
;;;; The suspected cost is that every intermediate lives in a frame slot --
;;;; this backend allocates no registers, so an expression tree becomes a
;;;; chain of stores and reloads. The tree here is deliberately deep and
;;;; entirely dependent, so a register allocator would keep all of it in
;;;; registers and this backend cannot keep any of it.
(defn main [] i32
(let [acc (i64 1)]
(dotimes [i 5000000]
(let [a (+ acc 3)
b (* a 2)
c (- b 1)
d (bit-xor c 7)
e (+ d (* a 5))
f (- e (bit-and d 15))]
(set acc (+ (% f 1000003) 1))))
(print acc) (println ""))
0)

View File

@ -0,0 +1,20 @@
;;;; A hot loop of struct copies.
;;;;
;;;; The suspected cost is `rep movsb`: this backend copies an aggregate by
;;;; block-moving bytes, where LLVM either keeps the thing in registers or
;;;; emits a handful of wide moves. Eight i64 fields is 64 bytes -- big
;;;; enough that a copy is a real copy, small enough that `rep movsb` is
;;;; paying its setup cost on every one of them, which is the shape the
;;;; instruction is worst at.
(defstruct Big [a i64 b i64 c i64 d i64 e i64 f i64 g i64 h i64])
(defn main [] i32
(let [acc (i64 0)
v (Big {.a 1 .b 2 .c 3 .d 4 .e 5 .f 6 .g 7 .h 8})]
(dotimes [i 2000000]
(let [w v]
(set (.a v) (+ (.h w) 1))
(set acc (+ acc (.a w)))))
(print acc) (println ""))
0)

123
spike/x86/cost.sh Executable file
View File

@ -0,0 +1,123 @@
#!/usr/bin/env bash
# What does the hand-written backend cost, against LLVM, on the same programs?
#
# survey.sh answers "does it agree". This answers "what does agreeing cost",
# which is item 7 of HANDOFF-x86-rt.md and the one thing about this backend
# nobody had a number for. It builds each program the same two ways the
# survey does, and for each records three sizes and a time:
#
# file the whole executable on disk. Mostly runtime and libc glue, and
# the least interesting of the three -- it is here because it is
# the number anybody looks at first, and it should be visible how
# much of it is noise.
# text the .text section, from `size -A`. Still contains flan_rt.o,
# which is the same object on both sides.
# own the sum of the sizes of the defined symbols named `flan.<name>`
# -- the program's *own* code and nothing else. The runtime's C is
# `flan_<name>` with an underscore, so the two do not collide, and
# spot-checking a runtime symbol on both sides (flan_map_clone,
# 0x4b3 either way) says the runtime really is byte-identical and
# the difference in `own` is all codegen.
#
# The `own` column is the measurement; the other two are context.
#
# A fourth build, LLVM with --debug, is the reference that makes the number
# readable. --debug forces -O0, so it is LLVM's codegen with its optimiser
# switched off -- the closest thing available to what this backend is doing,
# which has no optimiser at all. Without it every ratio silently blames the
# backend for the whole of mem2reg and inlining. (--x86 --debug is refused,
# so the column exists on one side only, and that is the point of it.)
#
# Time is best-of-N, not a mean: a mean measures the other tenants of the
# machine. Even so, a corpus program is mostly process startup -- these are
# milliseconds -- so read the time column only where it is tens of
# milliseconds or more, and read the rest as size.
#
# Usage: spike/x86/cost.sh [name-substring ...] -> a TSV on stdout
# COST_FLAGS=--dev extra flags, given to both sides, as SURVEY_FLAGS is
# COST_REPS=5 timing repetitions
# COST_O0=0 skip the LLVM -O0 reference column
set -u
orig=$(pwd)
here=$(cd "$(dirname "$0")" && pwd)
root=$(cd "$here/../.." && pwd)
cd "$root" || exit 1
if [ -n "${FLAN:-}" ]; then
case $FLAN in /*) flan=$FLAN;; *) flan=$orig/$FLAN;; esac
else
dune build --root . bin/main.exe 2>&1 | head -30
flan=$root/_build/default/bin/main.exe
fi
test -x "$flan" || { echo "build failed" >&2; exit 1; }
# Not mktemp under /tmp by default: this writes a few hundred executables of
# a megabyte or two, and a full /tmp on this machine has already frozen one
# session. The guard is cheap and a wedged run is not.
out=${COST_OUT:-${TMPDIR:-/tmp}/flan-cost.$$}
mkdir -p "$out" || exit 1
trap 'rm -rf "$out"' EXIT
free=$(df -Pk "$out" | awk 'NR==2 {print $4}')
[ "$free" -gt 2000000 ] || { echo "less than 2GB free at $out" >&2; exit 1; }
forever="dev-loop dev-watch"
REPS=${COST_REPS:-5}
read -r -a extra <<<"${COST_FLAGS:-}"
o0=${COST_O0:-1}
[ -z "${COST_FLAGS:-}" ] || o0=0
# The sum of the defined text symbols the compiler itself named. `nm -S`
# prints value, size, type, name; a symbol with no size is not printed with
# four fields at all, which is why the guard is on NF.
own () {
nm --defined-only -S "$1" 2>/dev/null \
| awk 'NF==4 && ($3=="T"||$3=="t") && $4 ~ /^flan\./ {n+=strtonum("0x"$2)} END{print n+0}'
}
text () { size -A "$1" 2>/dev/null | awk '$1==".text" {print $2}'; }
# Best of REPS, in whole microseconds. A program that fails on one run and
# not another would make this meaningless, so the exit status of the first
# run is remembered and a run that disagrees with it poisons the row as -1.
best () {
exe=$1; min=; rc0=
for i in $(seq "$REPS"); do
t0=$(date +%s%N)
( cd "$out" && timeout 20 "$exe" >/dev/null 2>&1 </dev/null )
rc=$?
t1=$(date +%s%N)
[ -n "$rc0" ] || rc0=$rc
[ "$rc" = "$rc0" ] || { echo "-1"; return; }
d=$(( (t1 - t0) / 1000 ))
if [ -z "$min" ] || [ "$d" -lt "$min" ]; then min=$d; fi
done
echo "$min"
}
printf 'name\tllvm_file\tllvm_text\tllvm_own\to0_own\tx86_file\tx86_text\tx86_own\tllvm_us\tx86_us\n'
for src in "$root"/test/programs/*.flan "$root"/spike/x86/*.flan; do
name=$(basename "$src" .flan)
if [ $# -gt 0 ]; then
want=0
for pat in "$@"; do case "$name" in *"$pat"*) want=1;; esac; done
[ $want = 1 ] || continue
fi
case " $forever " in *" $name "*) continue;; esac
rm -f "$out/l" "$out/x" "$out/d"
"$flan" build "$src" "${extra[@]}" -o "$out/l" >/dev/null 2>&1 || continue
# No main is a link failure, and it leaves nothing behind to measure.
test -x "$out/l" || continue
"$flan" build "$src" --x86 "${extra[@]}" -o "$out/x" >/dev/null 2>&1 || continue
test -x "$out/x" || continue
d0=0
if [ "$o0" = 1 ] && "$flan" build "$src" --debug -o "$out/d" >/dev/null 2>&1; then
d0=$(own "$out/d")
fi
printf '%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\n' "$name" \
"$(stat -c %s "$out/l")" "$(text "$out/l")" "$(own "$out/l")" "$d0" \
"$(stat -c %s "$out/x")" "$(text "$out/x")" "$(own "$out/x")" \
"$(best "$out/l")" "$(best "$out/x")"
done

View File

@ -32,14 +32,33 @@
#
# Usage: spike/x86/survey.sh [name-substring ...]
set -u
orig=$(pwd)
here=$(cd "$(dirname "$0")" && pwd)
root=$(cd "$here/../.." && pwd)
cd "$root" || exit 1
dune build --root . bin/main.exe 2>&1 | head -30
flan=$root/_build/default/bin/main.exe
# FLAN is how the dune @x86 alias hands this script a compiler that dune has
# already built. Building it here instead would be a second dune inside the
# first one's lock, which does not run at all; and the alias has bin/main.exe
# in its deps precisely so it does not have to. Standalone -- the way the
# baseline in every handoff was measured -- nothing sets it and the build
# below is what it always was.
if [ -n "${FLAN:-}" ]; then
# Resolved against the directory this was invoked from, not against $root:
# dune spells its deps relative to the dune file, and the cd above has
# already happened by the time this is read.
case $FLAN in /*) flan=$FLAN;; *) flan=$orig/$FLAN;; esac
else
dune build --root . bin/main.exe 2>&1 | head -30
flan=$root/_build/default/bin/main.exe
fi
test -x "$flan" || { echo "build failed"; exit 1; }
# Where the corpus is read from. Under dune the script runs from the build
# tree, where test/programs is present but spike/x86 is not, so the alias
# points this at the source tree and gets both.
corpus=${SURVEY_CORPUS:-$root}
out=$(mktemp -d); trap 'rm -rf "$out"' EXIT
# The two that run until something stops them. Not a failure and not a match;
@ -58,7 +77,7 @@ read -r -a extra <<<"${SURVEY_FLAGS:-}"
declare -a match=() differ=() refused=() nox86=() skip=()
for src in "$root"/test/programs/*.flan "$root"/spike/x86/*.flan; do
for src in "$corpus"/test/programs/*.flan "$corpus"/spike/x86/*.flan; do
name=$(basename "$src" .flan)
if [ $# -gt 0 ]; then
want=0
@ -127,3 +146,19 @@ if [ "${#skip[@]}" != 0 ] && [ "${SURVEY_QUIET:-}" != 1 ]; then
printf '%s\n' "${skip[@]}" | sed 's/^[^:]*://' | sort | uniq -c \
| sed 's/^/ /'
fi
# Strict mode, for the @x86 alias: the counts above are a report, and a report
# nobody reads is how two refusals from another lane's new primitive sat in
# the tree for a month. A DIFFER is a wrong answer and a refusal by name is a
# node this backend has stopped lowering; either is a failure. NOX86 and SKIP
# are not: the first is usually a toolchain that is not installed here, and
# the second is the frontend refusing the program on both sides.
if [ "${SURVEY_STRICT:-}" = 1 ]; then
if [ "${#differ[@]}" != 0 ] || [ "${#refused[@]}" != 0 ]; then
echo
echo "x86 survey FAILED: ${#differ[@]} differ, ${#refused[@]} refused"
exit 1
fi
echo
echo "x86 survey ok: ${#match[@]} match"
fi

View File

@ -169,3 +169,55 @@
(glob_files programs/pkgs/macring/*)
(glob_files programs/pkgs/macspin/*))
(action (run ./test_valgrind.exe)))
; The corpus a fourth time, through the hand-written x86-64 backend, compared
; against LLVM on what each program prints and what it exits with. Its own
; alias for the same reason the two above have one -- it builds every program
; twice and runs both, which is a couple of minutes against `dune test`'s
; seconds -- but the reason it exists at all is different. @sanitize and
; @valgrind ask whether the runtime is sound. This one asks whether the
; second backend still lowers the language: it refuses by name rather than
; miscompiling, so when another lane adds a primitive the backend says so
; loudly, and nothing was listening. Two such refusals sat in the tree for a
; month. Now they fail a build somebody can run.
;
; dune build --root . @x86
;
; A rule with no executable beside it, unlike @sanitize and @valgrind: the
; check already exists as spike/x86/survey.sh, which is what every handoff
; quotes its counts from, and a second implementation in OCaml would be a
; second thing to drift. SURVEY_STRICT=1 turns its report into an exit
; status. FLAN is passed because the script otherwise runs `dune build` on
; the compiler, and a dune inside a dune action waits on a lock it cannot
; get; main.exe is in the deps instead. SURVEY_QUIET keeps the skip
; breakdown out of a passing build's log.
(rule
(alias x86)
(deps
(file %{workspace_root}/spike/x86/survey.sh)
(glob_files %{workspace_root}/spike/x86/*.flan)
(file %{workspace_root}/bin/main.exe)
(file %{workspace_root}/calc-me.flan)
(file %{workspace_root}/sand.flan)
(file %{workspace_root}/brush.png)
(glob_files %{workspace_root}/vendor/raylib/*)
(glob_files %{workspace_root}/vendor/agent/*)
(glob_files %{workspace_root}/vendor/edn/*)
(glob_files %{workspace_root}/examples/*)
(glob_files programs/*.flan)
(glob_files programs/assets/*)
; A glob per package directory, because dune's glob does not descend.
(glob_files programs/pkgs/shape/*)
(glob_files programs/pkgs/area/*)
(glob_files programs/pkgs/draw/*)
(glob_files programs/pkgs/ring-a/*)
(glob_files programs/pkgs/ring-b/*)
(glob_files programs/pkgs/ring-c/*)
(glob_files programs/pkgs/mac/*)
(glob_files programs/pkgs/macring/*)
(glob_files programs/pkgs/macspin/*))
(action
(setenv SURVEY_STRICT 1
(setenv SURVEY_QUIET 1
(setenv FLAN %{workspace_root}/bin/main.exe
(run bash %{workspace_root}/spike/x86/survey.sh))))))