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>
56 lines
2.3 KiB
Clojure
56 lines
2.3 KiB
Clojure
;; dispatch — a POLYMORPHIC-DISPATCH stress test. A protocol method is called in
|
|
;; a hot loop over a heterogeneous (megamorphic) collection of record types, with
|
|
;; minimal per-call work, so protocol dispatch dominates. This is the regime
|
|
;; jolt-41m (devirtualization) and the inline-cache target, and the one the ray
|
|
;; tracer can't reveal — its dispatch is monomorphic and a small fraction of the
|
|
;; float-math cost (devirt measured FLAT there).
|
|
;;
|
|
;; Portable Clojure (jolt + JVM Clojure).
|
|
;; jolt -m dispatch 20000 (JOLT_DIRECT_LINK=1 JOLT_WHOLE_PROGRAM=1)
|
|
(ns dispatch)
|
|
|
|
(defprotocol Shape
|
|
(area [s])
|
|
(sides [s]))
|
|
|
|
(defrecord Circle [r] Shape (area [_] (* (* 3.14159 r) r)) (sides [_] 0))
|
|
(defrecord Square [s] Shape (area [_] (* s s)) (sides [_] 4))
|
|
(defrecord Triangle [b h] Shape (area [_] (* (* 0.5 b) h)) (sides [_] 3))
|
|
(defrecord Rect [w h] Shape (area [_] (* w h)) (sides [_] 4))
|
|
|
|
(defn build-shapes [n]
|
|
(mapv (fn [i]
|
|
(let [k (mod i 4)]
|
|
(cond
|
|
(= k 0) (->Circle (+ 1 (mod i 7)))
|
|
(= k 1) (->Square (+ 1 (mod i 5)))
|
|
(= k 2) (->Triangle (+ 1 (mod i 3)) (+ 2 (mod i 6)))
|
|
:else (->Rect (+ 1 (mod i 4)) (+ 1 (mod i 8))))))
|
|
(range n)))
|
|
|
|
;; megamorphic: every element may be a different type -> the call site sees all 4
|
|
(defn sum-area [shapes]
|
|
(reduce (fn [acc s] (+ (+ acc (area s)) (sides s))) 0.0 shapes))
|
|
|
|
(defn run [iters]
|
|
(let [shapes (build-shapes 1000)]
|
|
(loop [i 0 acc 0.0]
|
|
(if (< i iters)
|
|
(recur (inc i) (+ acc (sum-area shapes)))
|
|
acc))))
|
|
|
|
(defn -main [& args]
|
|
(let [iters (if (seq args) (Integer/parseInt (first args)) 20000)]
|
|
(dotimes [_ 2] (run (quot iters 4))) ; warmup
|
|
(let [runs 3
|
|
times (mapv (fn [_]
|
|
(let [t0 (System/nanoTime)
|
|
r (run iters)
|
|
ms (/ (- (System/nanoTime) t0) 1000000.0)]
|
|
[ms r]))
|
|
(range runs))
|
|
mss (mapv first times)
|
|
mean (/ (reduce + mss) runs)]
|
|
(println "dispatch iters" iters "result" (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"))))
|