jolt/bench/binary_trees.clj
Dmitri Sotnikov 93ddf2c85a
Make the benchmark harness build optimized binaries on Chez (#220)
bench/run.sh was Janet-era: it invoked a 'jolt' binary and set
JOLT_DIRECT_LINK/JOLT_WHOLE_PROGRAM, none of which exist on Chez, where
'joltc run -m' runs fully unoptimized (direct-link and inline default off). So
the suite was measuring jolt's unoptimized path.

run.sh now compiles each benchmark to an optimized AOT binary (joltc build
--direct-link --opt) and times it against JVM Clojure on the same portable
source, auto-detecting the Chez kernel dev files like build-smoke.sh. Adds
bench/deps.edn so joltc resolves the namespaces, NO_JVM to skip the reference.

mandelbrot.clj dropped its jolt.png require so the JVM reference can run it; the
picture demo moved to mandelbrot_png.clj (jolt-only). README scorecard refreshed
with current Chez numbers and the two-regime read (compute ~8-10x substrate floor;
dispatch/alloc ~120-330x architectural gaps the passes don't touch). Stale
'jolt -m' header lines point at bench/run.sh.

Co-authored-by: Yogthos <yogthos@gmail.com>
2026-06-26 04:59:52 +00:00

53 lines
2.1 KiB
Clojure

;; binary-trees (Computer Language Benchmarks Game) — an ALLOCATION/GC stress
;; test. Builds and discards millions of short-lived `Node` records; the nodes
;; ESCAPE (stored in the tree, walked later), so this is the regime escape analysis
;; targets and the ray tracer never exercises (~7% alloc).
;;
;; Portable Clojure: runs on jolt and JVM Clojure for cross-impl comparison.
;; bench/run.sh binary-trees 14
(ns binary-trees)
(defrecord Node [left right])
(defn make-tree [depth]
(if (zero? depth)
(->Node nil nil)
(->Node (make-tree (dec depth)) (make-tree (dec depth)))))
(defn check-tree [node]
(let [l (:left node)]
(if (nil? l)
1
(+ (+ 1 (check-tree l)) (check-tree (:right node))))))
(defn run [max-depth]
(let [min-depth 4
stretch-depth (inc max-depth)
_ (check-tree (make-tree stretch-depth))
long-lived (make-tree max-depth)]
(loop [d min-depth acc 0]
(if (<= d max-depth)
(let [iterations (bit-shift-left 1 (+ (- max-depth d) min-depth))
sum (loop [i 0 s 0]
(if (< i iterations)
(recur (inc i) (+ s (check-tree (make-tree d))))
s))]
(recur (+ d 2) (+ acc sum)))
;; touch the long-lived tree so it isn't dead-code-eliminated
(+ acc (check-tree long-lived))))))
(defn -main [& args]
(let [max-depth (if (seq args) (Integer/parseInt (first args)) 14)]
(dotimes [_ 2] (run (min max-depth 10))) ; warmup
(let [runs 3
times (mapv (fn [_]
(let [t0 (System/nanoTime)
r (run max-depth)
ms (/ (- (System/nanoTime) t0) 1000000.0)]
[ms r]))
(range runs))
mss (mapv first times)
mean (/ (reduce + mss) runs)]
(println "binary-trees depth" max-depth "checksum" (second (first times)))
(println "runs:" (mapv (fn [t] (/ (Math/round (* t 10.0)) 10.0)) mss))
(println "mean:" (/ (Math/round (* mean 10.0)) 10.0) "ms"))))