bench: latency harness + paired latency fixtures
The latency_harness.py harness spawns the bench binary on a PTY, records monotonic_ns() per stdout line, and reports inter-arrival gap distribution (median / p99 / p99.9 / max). Tail latency is Decision 10's central real-time claim; total wall-time and RSS are the wrong metrics for that question. Paired fixtures: bench_latency_implicit (Boehm-fair, no mode annotations, leaks under --alloc=rc) and bench_latency_explicit (mode-annotated hot path, what RC was built for). Both use a depth-19 balanced tree (~16 MB) as the persistent live working set, plus per-op IntList build+sum churn forcing GC pressure under Boehm. Authored by ailang-bencher; ships evidence, not features.
This commit is contained in:
Executable
+172
@@ -0,0 +1,172 @@
|
||||
#!/usr/bin/env python3
|
||||
"""
|
||||
Per-operation latency harness for the bench_latency_{implicit,explicit}
|
||||
fixtures.
|
||||
|
||||
The fixtures emit a stdout marker line every PRINT_K bench operations.
|
||||
We spawn the binary with its stdout connected to a PTY so libc's
|
||||
printf path is line-buffered (rather than block-buffered as it would
|
||||
be on a pipe), record `time.monotonic_ns()` at every line read, and
|
||||
report the inter-arrival distribution.
|
||||
|
||||
The headline numbers are median, p99, p99.9, max of the inter-arrival
|
||||
gaps (in microseconds). Tail latency is the question; total wall time
|
||||
is not.
|
||||
|
||||
We do NOT count the gap between READY (8888) and the first sample —
|
||||
that gap includes the build_tree(19) cost and is not a steady-state
|
||||
operation. We also drop the very last gap (DONE 9999) because the
|
||||
program exit path can include final teardown that is not part of the
|
||||
loop budget.
|
||||
|
||||
Usage:
|
||||
python3 bench/latency_harness.py <binary> [--label LABEL]
|
||||
"""
|
||||
|
||||
from __future__ import annotations
|
||||
|
||||
import argparse
|
||||
import os
|
||||
import pty
|
||||
import resource
|
||||
import select
|
||||
import sys
|
||||
import time
|
||||
|
||||
|
||||
def run_pty(binary: str, timeout_s: float = 600.0) -> tuple[list[int], int, int, int, float]:
|
||||
"""Run `binary` with stdout on a PTY, return (timestamps_ns, lines, exit_status, max_rss_kb, wall_s)."""
|
||||
pid, fd = pty.fork()
|
||||
if pid == 0:
|
||||
# Child: replace argv[0] with the binary and exec.
|
||||
try:
|
||||
os.execvp(binary, [binary])
|
||||
except FileNotFoundError as e:
|
||||
sys.stderr.write(f"exec failed: {e}\n")
|
||||
os._exit(127)
|
||||
|
||||
# Parent: read from the PTY master, timestamp every newline.
|
||||
timestamps: list[int] = []
|
||||
line_count = 0
|
||||
buf = bytearray()
|
||||
deadline = time.monotonic() + timeout_s
|
||||
t_start = time.monotonic()
|
||||
|
||||
try:
|
||||
while True:
|
||||
remaining = deadline - time.monotonic()
|
||||
if remaining <= 0:
|
||||
os.kill(pid, 9)
|
||||
raise TimeoutError(f"binary exceeded {timeout_s:.0f}s")
|
||||
r, _, _ = select.select([fd], [], [], min(remaining, 1.0))
|
||||
if not r:
|
||||
continue
|
||||
try:
|
||||
chunk = os.read(fd, 4096)
|
||||
except OSError:
|
||||
# PTY master read after child exit -> EIO on Linux.
|
||||
break
|
||||
if not chunk:
|
||||
break
|
||||
now = time.monotonic_ns()
|
||||
buf.extend(chunk)
|
||||
# Walk the buffer; record `now` for each newline encountered.
|
||||
# Multiple newlines in one read share the same monotonic_ns
|
||||
# — that's a known quantization artefact of bursty stdio
|
||||
# delivery, NOT a per-op timing artefact. We surface it in
|
||||
# the report.
|
||||
nl = buf.find(b"\n")
|
||||
while nl != -1:
|
||||
timestamps.append(now)
|
||||
line_count += 1
|
||||
del buf[: nl + 1]
|
||||
nl = buf.find(b"\n")
|
||||
finally:
|
||||
try:
|
||||
os.close(fd)
|
||||
except OSError:
|
||||
pass
|
||||
|
||||
# Wait for child and capture rusage.
|
||||
_, status = os.waitpid(pid, 0)
|
||||
ru = resource.getrusage(resource.RUSAGE_CHILDREN)
|
||||
t_end = time.monotonic()
|
||||
return timestamps, line_count, status, ru.ru_maxrss, t_end - t_start
|
||||
|
||||
|
||||
def percentile(xs: list[float], p: float) -> float:
|
||||
"""Nearest-rank percentile (xs assumed sorted)."""
|
||||
if not xs:
|
||||
return float("nan")
|
||||
k = max(0, min(len(xs) - 1, int(round((p / 100.0) * (len(xs) - 1)))))
|
||||
return xs[k]
|
||||
|
||||
|
||||
def report(label: str, timestamps_ns: list[int], lines: int, status: int, rss_kb: int, wall_s: float) -> None:
|
||||
# The fixtures emit:
|
||||
# line 1 : 8888 (READY, after build_tree)
|
||||
# line 2..1001 : per-chunk markers (1000 timing samples)
|
||||
# line 1002 : 9999 (DONE)
|
||||
# Inter-arrival gaps: between consecutive timestamps.
|
||||
# We drop the first gap (READY -> first chunk includes a partial
|
||||
# chunk's setup but is dominated by chunk work; still informative)
|
||||
# and the last gap (last chunk -> DONE includes program exit).
|
||||
# Per the orchestrator's brief we want the steady-state distribution,
|
||||
# so we trim both ends.
|
||||
if lines < 5:
|
||||
print(f"[{label}] FAIL: only {lines} lines, status={status}")
|
||||
return
|
||||
|
||||
gaps_ns: list[int] = []
|
||||
for i in range(1, len(timestamps_ns)):
|
||||
gaps_ns.append(timestamps_ns[i] - timestamps_ns[i - 1])
|
||||
|
||||
# Trim the first gap (READY -> first chunk; includes the loop's
|
||||
# first chunk's full work) and the last gap (last chunk -> DONE;
|
||||
# includes program teardown). Everything between is steady-state.
|
||||
trimmed = gaps_ns[1:-1] if len(gaps_ns) >= 3 else gaps_ns
|
||||
|
||||
gaps_us = sorted(g / 1000.0 for g in trimmed)
|
||||
|
||||
# Quantization detection: how many gaps are exactly 0 ns? That
|
||||
# means two newlines arrived in the same os.read.
|
||||
zero_gaps = sum(1 for g in trimmed if g == 0)
|
||||
|
||||
median = percentile(gaps_us, 50)
|
||||
p90 = percentile(gaps_us, 90)
|
||||
p99 = percentile(gaps_us, 99)
|
||||
p999 = percentile(gaps_us, 99.9)
|
||||
p_max = max(gaps_us) if gaps_us else float("nan")
|
||||
p_min = min(gaps_us) if gaps_us else float("nan")
|
||||
mean = sum(gaps_us) / len(gaps_us) if gaps_us else float("nan")
|
||||
|
||||
print(f"=== {label} ===")
|
||||
print(f" lines: {lines} exit_status: {status} wall: {wall_s:.3f}s max_rss: {rss_kb} KB")
|
||||
print(f" inter-arrival gaps (steady-state, n={len(trimmed)}, trimmed first+last):")
|
||||
print(f" min: {p_min:10.1f} us")
|
||||
print(f" median: {median:10.1f} us")
|
||||
print(f" mean: {mean:10.1f} us")
|
||||
print(f" p90: {p90:10.1f} us")
|
||||
print(f" p99: {p99:10.1f} us")
|
||||
print(f" p99.9: {p999:10.1f} us")
|
||||
print(f" max: {p_max:10.1f} us")
|
||||
print(f" p99/median: {p99 / median if median else float('nan'):.2f}x")
|
||||
print(f" max/median: {p_max / median if median else float('nan'):.2f}x")
|
||||
print(f" zero-ns gaps (read coalescing): {zero_gaps} / {len(trimmed)}")
|
||||
|
||||
|
||||
def main() -> int:
|
||||
ap = argparse.ArgumentParser()
|
||||
ap.add_argument("binary", help="path to the bench binary")
|
||||
ap.add_argument("--label", default=None, help="label for the report")
|
||||
ap.add_argument("--timeout", type=float, default=600.0)
|
||||
args = ap.parse_args()
|
||||
|
||||
label = args.label or os.path.basename(args.binary)
|
||||
timestamps, lines, status, rss_kb, wall_s = run_pty(args.binary, args.timeout)
|
||||
report(label, timestamps, lines, status, rss_kb, wall_s)
|
||||
return 0
|
||||
|
||||
|
||||
if __name__ == "__main__":
|
||||
sys.exit(main())
|
||||
File diff suppressed because one or more lines are too long
@@ -0,0 +1,169 @@
|
||||
; Latency-distribution bench fixture — explicit-mode variant.
|
||||
;
|
||||
; Companion to bench_latency_implicit. Same algorithm, with
|
||||
; `(borrow T)` / `(own T)` annotations so that under --alloc=rc the
|
||||
; codegen emits proper inc/dec instrumentation: the persistent tree
|
||||
; cache is borrowed (no inc/dec on pin_root's hot path), the per-op
|
||||
; IntList is owned by sum_list (param drop at fn return frees the
|
||||
; chain). The drop-iterative annotation on IntList keeps the per-op
|
||||
; deallocation O(1)-stack regardless of list length.
|
||||
;
|
||||
; This is the "RC-fair" arm of the latency bench; together with
|
||||
; bench_latency_implicit (under --alloc=gc) it tests the hypothesis
|
||||
; "Boehm has unbounded p99 per-operation latency under continuous
|
||||
; alloc pressure with a large persistent live working set; RC under
|
||||
; explicit-mode has p99 within a small constant factor of the
|
||||
; median".
|
||||
;
|
||||
; Workload (must match bench_latency_implicit's parameters exactly
|
||||
; for the comparison to be fair):
|
||||
; - Live cache: balanced binary tree of depth 19 (524_287 nodes,
|
||||
; ~16 MB), borrowed throughout the loop.
|
||||
; - Per-op: build a CHUNK_LEN-cell IntList of 0..CHUNK_LEN-1, sum
|
||||
; it, drop it. CHUNK_LEN, NUM_OPS, PRINT_K hardcoded to match
|
||||
; the implicit variant.
|
||||
; - Same stdout shape: one READY (8888), N_PRINT timing markers
|
||||
; each containing the per-op sum (validatable, always equal),
|
||||
; one DONE (9999).
|
||||
|
||||
(module bench_latency_explicit
|
||||
|
||||
(data Tree
|
||||
(doc "Balanced binary tree, 32-byte cells. Borrowed across the bench loop; tree-depth recursion at scope close is bounded (depth 19) so no drop-iterative needed.")
|
||||
(ctor TLeaf)
|
||||
(ctor TNode (con Int) (con Tree) (con Tree)))
|
||||
|
||||
(data IntList
|
||||
(doc "Singly-linked Int list. Per-op chains are CHUNK_LEN long; (drop-iterative) keeps Own-param drop O(1) stack regardless of length.")
|
||||
(ctor LNil)
|
||||
(ctor LCons (con Int) (con IntList))
|
||||
(drop-iterative))
|
||||
|
||||
; ---------- Live cache: balanced tree of given depth ----------
|
||||
|
||||
(fn build_tree
|
||||
(doc "Build a balanced tree of given depth, every value = 1. Returns owned Tree; main holds it across the loop and the final drop fires at main's scope close.")
|
||||
(type
|
||||
(fn-type
|
||||
(params (con Int))
|
||||
(ret (own (con Tree)))))
|
||||
(params depth)
|
||||
(body
|
||||
(if (app == depth 0)
|
||||
(term-ctor Tree TLeaf)
|
||||
(term-ctor Tree TNode
|
||||
1
|
||||
(app build_tree (app - depth 1))
|
||||
(app build_tree (app - depth 1))))))
|
||||
|
||||
(fn pin_root
|
||||
(doc "Constant-time tree liveness pin — read root tag, return 1 (TNode) or 0 (TLeaf). Borrows t so the persistent cache is not inc/dec'd on every op.")
|
||||
(type
|
||||
(fn-type
|
||||
(params (borrow (con Tree)))
|
||||
(ret (con Int))))
|
||||
(params t)
|
||||
(body
|
||||
(match t
|
||||
(case (pat-ctor TLeaf) 0)
|
||||
(case (pat-ctor TNode v l r) 1))))
|
||||
|
||||
; ---------- Per-op work: build/sum an N-cell list ----------
|
||||
|
||||
(fn cons_n_acc
|
||||
(doc "Tail-recursive list builder. Returns owned chain; caller is sum_list which owns and drops it.")
|
||||
(type
|
||||
(fn-type
|
||||
(params (con Int) (own (con IntList)))
|
||||
(ret (own (con IntList)))))
|
||||
(params n acc)
|
||||
(body
|
||||
(if (app == n 0)
|
||||
acc
|
||||
(tail-app cons_n_acc
|
||||
(app - n 1)
|
||||
(term-ctor IntList LCons (app - n 1) acc)))))
|
||||
|
||||
(fn cons_n
|
||||
(doc "Build [0,1,...,n-1] :: IntList. Returns owned chain.")
|
||||
(type
|
||||
(fn-type
|
||||
(params (con Int))
|
||||
(ret (own (con IntList)))))
|
||||
(params n)
|
||||
(body
|
||||
(app cons_n_acc n (term-ctor IntList LNil))))
|
||||
|
||||
(fn sum_list_acc
|
||||
(doc "Tail-recursive sum. Owns xs; consumes it via the LCons arm's t binder (move-into-tail-call).")
|
||||
(type
|
||||
(fn-type
|
||||
(params (own (con IntList)) (con Int))
|
||||
(ret (con Int))))
|
||||
(params xs acc)
|
||||
(body
|
||||
(match xs
|
||||
(case (pat-ctor LNil) acc)
|
||||
(case (pat-ctor LCons h t)
|
||||
(tail-app sum_list_acc t (app + acc h))))))
|
||||
|
||||
(fn sum_list
|
||||
(doc "Sum every element. Owns xs, hands it to sum_list_acc which consumes it.")
|
||||
(type
|
||||
(fn-type
|
||||
(params (own (con IntList)))
|
||||
(ret (con Int))))
|
||||
(params xs)
|
||||
(body
|
||||
(app sum_list_acc xs 0)))
|
||||
|
||||
(fn one_op
|
||||
(doc "One bench operation: build+sum a fresh CHUNK_LEN-cell list, pin the tree's root, return their sum so the value chain stays observable. Tree is borrowed; no inc/dec on the hot path against the persistent cache.")
|
||||
(type
|
||||
(fn-type
|
||||
(params (con Int) (borrow (con Tree)))
|
||||
(ret (con Int))))
|
||||
(params chunk_len t)
|
||||
(body
|
||||
(app + (app sum_list (app cons_n chunk_len)) (app pin_root t))))
|
||||
|
||||
; ---------- Bench loop ----------
|
||||
|
||||
(fn loop
|
||||
(doc "Tail-recursive bench loop. Tree is borrowed across all iterations.")
|
||||
(type
|
||||
(fn-type
|
||||
(params (con Int) (con Int) (con Int) (con Int) (borrow (con Tree)))
|
||||
(ret (con Unit))
|
||||
(effects IO)))
|
||||
(params remaining print_countdown chunk_len print_k t)
|
||||
(body
|
||||
(if (app == remaining 0)
|
||||
(do io/print_int 9999)
|
||||
(if (app == print_countdown 0)
|
||||
(seq
|
||||
(do io/print_int (app one_op chunk_len t))
|
||||
(tail-app loop
|
||||
(app - remaining 1)
|
||||
(app - print_k 1)
|
||||
chunk_len
|
||||
print_k
|
||||
t))
|
||||
(let _v (app one_op chunk_len t)
|
||||
(tail-app loop
|
||||
(app - remaining 1)
|
||||
(app - print_countdown 1)
|
||||
chunk_len
|
||||
print_k
|
||||
t))))))
|
||||
|
||||
(fn main
|
||||
(doc "Top-level: build tree, signal READY (8888), run loop, signal DONE (9999 emitted by loop).")
|
||||
(type (fn-type (params) (ret (con Unit)) (effects IO)))
|
||||
(params)
|
||||
(body
|
||||
(let t (app build_tree 19)
|
||||
(let _root (app pin_root t)
|
||||
(seq
|
||||
(do io/print_int 8888)
|
||||
(app loop 20000 0 500 20 t)))))))
|
||||
File diff suppressed because one or more lines are too long
@@ -0,0 +1,225 @@
|
||||
; Latency-distribution bench fixture — Implicit-mode variant.
|
||||
;
|
||||
; Companion to bench_latency_explicit. Together they test the
|
||||
; hypothesis "Boehm has unbounded p99 per-operation latency under
|
||||
; continuous alloc pressure with a large persistent live working
|
||||
; set; RC under explicit-mode has p99 within a small constant
|
||||
; factor of the median".
|
||||
;
|
||||
; Implicit-mode variant: no `(borrow T)`, `(own T)`, `(reuse-as)`,
|
||||
; `(drop-iterative)` annotations. This is the canonical "Boehm-fair"
|
||||
; arm — the way you'd write the program without thinking about
|
||||
; modes. Under `--alloc=gc`, Boehm cleans up. Under `--alloc=rc`,
|
||||
; this variant LEAKS (Implicit params are not dec'd) and is not a
|
||||
; meaningful RC measurement; the bench harness intentionally only
|
||||
; runs this fixture under `--alloc=gc`.
|
||||
;
|
||||
; Workload:
|
||||
; - Live cache: balanced binary tree of depth 19 (524_287 nodes,
|
||||
; ~16 MB). Stays referenced through the entire bench loop.
|
||||
; - Per-op work: build a 500-cell IntList of 0..499, sum it
|
||||
; (sum = 124750), print one stdout marker line every PRINT_K
|
||||
; ops. Total churn: 20000 * 500 cells = 10M cell-allocs ≈
|
||||
; 240 MB ≫ live-set, forcing Boehm to collect many times.
|
||||
; - Total ops: 20_000. Print every PRINT_K=20 ops → 1000 timing
|
||||
; samples + 1 final summary line.
|
||||
;
|
||||
; What the harness sees:
|
||||
; - One "READY" line at startup once the tree is built.
|
||||
; - 1000 lines, each containing the per-chunk sum (always 124750)
|
||||
; so output stays validatable. The harness ignores values and
|
||||
; records only inter-arrival times.
|
||||
; - One final "DONE" line.
|
||||
;
|
||||
; The harness times each line's arrival via clock_gettime on its
|
||||
; end of a PTY-controlled stdout (PTY forces line-buffering through
|
||||
; libc's printf), then computes median / p99 / p99.9 / max of the
|
||||
; gaps.
|
||||
;
|
||||
; Why a print-driven gap measurement: AILang has no high-resolution
|
||||
; clock extern. Adding one would mean a codegen change (a new `do
|
||||
; bench/clock` op routed into the codegen seam), which is
|
||||
; implementer territory, not bencher territory. Stdout-gap timing
|
||||
; has a noise floor of ~10-50 µs (printf + pipe roundtrip) which is
|
||||
; well below the millisecond-scale STW pauses the hypothesis
|
||||
; predicts; if the hypothesis is right, the signal swamps the
|
||||
; noise. If the data shows a tighter distribution than that noise
|
||||
; floor, we'll have to escalate to in-process clocks; otherwise the
|
||||
; bench is sufficient.
|
||||
|
||||
(module bench_latency_implicit
|
||||
|
||||
(data Tree
|
||||
(doc "Balanced binary tree, 32-byte cells (tag + Int payload + 2 ptrs).")
|
||||
(ctor TLeaf)
|
||||
(ctor TNode (con Int) (con Tree) (con Tree)))
|
||||
|
||||
(data IntList
|
||||
(doc "Singly-linked Int list, 24-byte cells.")
|
||||
(ctor LNil)
|
||||
(ctor LCons (con Int) (con IntList)))
|
||||
|
||||
; ---------- Live cache: balanced tree of given depth ----------
|
||||
|
||||
(fn build_tree
|
||||
(doc "Build a balanced tree of given depth, every value = 1. Constructor-blocked — recursion depth = `depth`, fits 8MB stack at depth 19.")
|
||||
(type
|
||||
(fn-type
|
||||
(params (con Int))
|
||||
(ret (con Tree))))
|
||||
(params depth)
|
||||
(body
|
||||
(if (app == depth 0)
|
||||
(term-ctor Tree TLeaf)
|
||||
(term-ctor Tree TNode
|
||||
1
|
||||
(app build_tree (app - depth 1))
|
||||
(app build_tree (app - depth 1))))))
|
||||
|
||||
(fn sum_tree
|
||||
(doc "Touch every node of the tree (ensures liveness across the loop).")
|
||||
(type
|
||||
(fn-type
|
||||
(params (con Tree))
|
||||
(ret (con Int))))
|
||||
(params t)
|
||||
(body
|
||||
(match t
|
||||
(case (pat-ctor TLeaf) 0)
|
||||
(case (pat-ctor TNode v l r)
|
||||
(app + v (app + (app sum_tree l) (app sum_tree r)))))))
|
||||
|
||||
; ---------- Per-op work: build/sum an N-cell list ----------
|
||||
|
||||
(fn cons_n_acc
|
||||
(doc "Tail-recursive list builder. Result = [n-1, n-2, ..., 0] :: IntList.")
|
||||
(type
|
||||
(fn-type
|
||||
(params (con Int) (con IntList))
|
||||
(ret (con IntList))))
|
||||
(params n acc)
|
||||
(body
|
||||
(if (app == n 0)
|
||||
acc
|
||||
(tail-app cons_n_acc
|
||||
(app - n 1)
|
||||
(term-ctor IntList LCons (app - n 1) acc)))))
|
||||
|
||||
(fn cons_n
|
||||
(doc "Build [0,1,...,n-1] :: IntList.")
|
||||
(type
|
||||
(fn-type
|
||||
(params (con Int))
|
||||
(ret (con IntList))))
|
||||
(params n)
|
||||
(body
|
||||
(app cons_n_acc n (term-ctor IntList LNil))))
|
||||
|
||||
(fn sum_list_acc
|
||||
(doc "Tail-recursive sum.")
|
||||
(type
|
||||
(fn-type
|
||||
(params (con IntList) (con Int))
|
||||
(ret (con Int))))
|
||||
(params xs acc)
|
||||
(body
|
||||
(match xs
|
||||
(case (pat-ctor LNil) acc)
|
||||
(case (pat-ctor LCons h t)
|
||||
(tail-app sum_list_acc t (app + acc h))))))
|
||||
|
||||
(fn sum_list
|
||||
(doc "Sum every element. Calls sum_list_acc with seed 0.")
|
||||
(type
|
||||
(fn-type
|
||||
(params (con IntList))
|
||||
(ret (con Int))))
|
||||
(params xs)
|
||||
(body
|
||||
(app sum_list_acc xs 0)))
|
||||
|
||||
; One operation: build and sum a list of length CHUNK_LEN, return
|
||||
; the sum. The tree `t` is passed through and subjected to
|
||||
; `sum_tree` so the optimizer can't eliminate it, but the result
|
||||
; is XOR'd back into the int we return so the value chain stays
|
||||
; live without unbounded accumulation.
|
||||
;
|
||||
; Note: we don't actually want sum_tree to fire on every op (it
|
||||
; would dominate the per-op cost and bury allocator effects).
|
||||
; Instead we touch only the tree's root via a cheap `pin_root`
|
||||
; that pattern-matches once. Boehm's tracing still walks the
|
||||
; whole tree on every collection because the tree pointer is
|
||||
; live through the loop scope.
|
||||
(fn pin_root
|
||||
(doc "Constant-time tree liveness pin — read root tag, return 1 (TNode) or 0 (TLeaf).")
|
||||
(type
|
||||
(fn-type
|
||||
(params (con Tree))
|
||||
(ret (con Int))))
|
||||
(params t)
|
||||
(body
|
||||
(match t
|
||||
(case (pat-ctor TLeaf) 0)
|
||||
(case (pat-ctor TNode v l r) 1))))
|
||||
|
||||
(fn one_op
|
||||
(doc "One bench operation: build+sum a fresh CHUNK_LEN-cell list, pin the tree's root, return their sum so the value chain stays observable.")
|
||||
(type
|
||||
(fn-type
|
||||
(params (con Int) (con Tree))
|
||||
(ret (con Int))))
|
||||
(params chunk_len t)
|
||||
(body
|
||||
(app + (app sum_list (app cons_n chunk_len)) (app pin_root t))))
|
||||
|
||||
; ---------- Bench loop ----------
|
||||
|
||||
; Loop runs `remaining` ops. Every PRINT_K ops, prints the
|
||||
; rolling sum from the most-recent op (always equal to
|
||||
; CHUNK_LEN*(CHUNK_LEN-1)/2 + 1 = 124750 + 1 = 124751 for
|
||||
; CHUNK_LEN=500). The print is the timing event. The
|
||||
; print_every counter's role is to keep stdout lines per second
|
||||
; tractable for the harness (1000 timings instead of 20000).
|
||||
;
|
||||
; The tree `t` is passed through every recursive call so it
|
||||
; stays a live root; Boehm has to trace through it on every
|
||||
; collection.
|
||||
|
||||
(fn loop
|
||||
(doc "Tail-recursive bench loop. Ops countdown in `remaining`; print marker every time `print_countdown` hits 0.")
|
||||
(type
|
||||
(fn-type
|
||||
(params (con Int) (con Int) (con Int) (con Int) (con Tree))
|
||||
(ret (con Unit))
|
||||
(effects IO)))
|
||||
(params remaining print_countdown chunk_len print_k t)
|
||||
(body
|
||||
(if (app == remaining 0)
|
||||
(do io/print_int 9999)
|
||||
(if (app == print_countdown 0)
|
||||
(seq
|
||||
(do io/print_int (app one_op chunk_len t))
|
||||
(tail-app loop
|
||||
(app - remaining 1)
|
||||
(app - print_k 1)
|
||||
chunk_len
|
||||
print_k
|
||||
t))
|
||||
(let _v (app one_op chunk_len t)
|
||||
(tail-app loop
|
||||
(app - remaining 1)
|
||||
(app - print_countdown 1)
|
||||
chunk_len
|
||||
print_k
|
||||
t))))))
|
||||
|
||||
(fn main
|
||||
(doc "Top-level: build tree, signal READY (8888), run loop, signal DONE (9999 emitted by loop).")
|
||||
(type (fn-type (params) (ret (con Unit)) (effects IO)))
|
||||
(params)
|
||||
(body
|
||||
(let t (app build_tree 19)
|
||||
(let _root (app pin_root t)
|
||||
(seq
|
||||
(do io/print_int 8888)
|
||||
(app loop 20000 0 500 20 t)))))))
|
||||
Reference in New Issue
Block a user