c13a8ee402
The ray tracer is float-compute-bound (devirt, alloc removal, type-proving all measured flat on it), so it can't validate the optimization passes. Add a small cross-language suite (AWFY + CLBG style, portable Clojure) isolating the axes it misses: binary-trees allocation / GC pressure (escaping short-lived records) dispatch megamorphic protocol dispatch (~1M dispatches/s; WP can't devirt) collections persistent map/vector churn bench/run.sh runs them; bench/README.md maps each to the pass it exercises. collections immediately surfaced jolt-684u: the persistent hash map is O(n) per assoc (flat copy-on-write bucket array, not a HAMT) — n=4000 assocs take 50s. Invisible to the ray tracer (no maps). Co-authored-by: Yogthos <yogthos@gmail.com>
54 lines
2.1 KiB
Clojure
54 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 jolt-8flj
|
|
;; (escape analysis) targets and the ray tracer never exercises (~7% alloc).
|
|
;;
|
|
;; Portable Clojure: runs on jolt and JVM Clojure for cross-impl comparison.
|
|
;; jolt -m binary-trees 14 (JOLT_DIRECT_LINK=1 JOLT_WHOLE_PROGRAM=1)
|
|
;; clojure -M -m 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"))))
|