Direct-linking for closed-world builds (jolt build)

A release/optimized `jolt build` is a closed world: every app def is final, so
an app->app call can bind to the def's Scheme binding directly instead of going
through (jolt-invoke (var-deref ns name)).

The emitter gains a direct-link mode (off for the seed mint, runtime -e/repl, and
dev builds). With it on, a top-level app def also emits a binding jv$<ns>$<name>
that def-var! aliases; an app->app call or value-ref to a name already emitted in
the unit lowers to that binding, skipping both the var-table lookup and the
generic IFn dispatch. ^:dynamic/^:redef defs and nested defs (a defonce's inner
def) opt out and stay indirect. Off direct-link mode, emit-top-form is exactly
emit, so the seed and runtime eval are byte-unchanged (selfhost holds).

build.ss turns it on for release + optimized; the defined-set accumulates across
the dependency-ordered namespaces so a dep's defs are linkable by the time the
entry that calls them is emitted. App->core calls stay indirect for now (core is
the baked seed); that's a later stage.

~1.74x on a hot cross-namespace call loop (26.5s -> 15.2s).
This commit is contained in:
Yogthos 2026-06-23 15:51:34 -04:00
parent 9a68f96b6c
commit 7bc277b2e8
6 changed files with 283 additions and 95 deletions

View file

@ -4,7 +4,7 @@
# build step. `make test` is the full gate. `make remint` rebuilds the seed after a # build step. `make test` is the full gate. `make remint` rebuilds the seed after a
# source change. # source change.
.PHONY: test ci values corpus unit smoke buildsmoke selfhost sci certify ffi transient infer remint .PHONY: test ci values corpus unit smoke buildsmoke selfhost sci certify ffi transient infer directlink remint
# Full gate (dev machine). Includes the self-host byte-fixpoint, which only holds # Full gate (dev machine). Includes the self-host byte-fixpoint, which only holds
# on the same Chez that minted the seed. # on the same Chez that minted the seed.
@ -15,7 +15,7 @@ test: selfhost ci
# lockfile) — it RUNS correctly on any Chez, but `selfhost` rebuilds it and a # lockfile) — it RUNS correctly on any Chez, but `selfhost` rebuilds it and a
# different Chez version may emit byte-different (gensym/order) output, so the # different Chez version may emit byte-different (gensym/order) output, so the
# byte-fixpoint is a dev-machine check, not a CI one (jolt-8479). # byte-fixpoint is a dev-machine check, not a CI one (jolt-8479).
ci: values corpus unit smoke buildsmoke sci ffi transient infer certify ci: values corpus unit smoke buildsmoke sci ffi transient infer directlink certify
@echo "OK: CI gates passed" @echo "OK: CI gates passed"
# Self-host fixpoint: bootstrap.ss rebuild == checked-in seed. # Self-host fixpoint: bootstrap.ss rebuild == checked-in seed.
@ -61,6 +61,12 @@ transient:
infer: infer:
@chez --script host/chez/run-infer.ss @chez --script host/chez/run-infer.ss
# Direct-linking emission: a closed-world build binds top-level app defs to jv$
# Scheme bindings and routes app->app calls/refs to them, skipping var-deref +
# jolt-invoke; ^:dynamic/^:redef and nested defs opt out.
directlink:
@chez --script test/chez/directlink-test.ss
# JVM oracle: certify the corpus against reference Clojure. Skips if clojure absent. # JVM oracle: certify the corpus against reference Clojure. Skips if clojure absent.
certify: certify:
@if command -v clojure >/dev/null 2>&1; then \ @if command -v clojure >/dev/null 2>&1; then \

View file

@ -225,11 +225,19 @@
" — is it on the source roots?"))) " — is it on the source roots?")))
;; 2. emit each app namespace. `optimized` turns on the inference + flatten ;; 2. emit each app namespace. `optimized` turns on the inference + flatten
;; + scalar-replace passes (closed world); release/dev get const-fold only. ;; + scalar-replace passes (closed world); release/dev get const-fold only.
;; release + optimized are closed-world: turn on direct-linking so app->app
;; calls bind directly (dev stays open/indirect). The defined-set accumulates
;; across the dependency-ordered namespaces, so a dep's defs are direct-linkable
;; by the time the entry that calls them is emitted.
(set-optimize! (string=? mode "optimized")) (set-optimize! (string=? mode "optimized"))
(let ((dl (not (string=? mode "dev"))))
((var-deref "jolt.backend-scheme" "set-direct-link!") dl)
((var-deref "jolt.backend-scheme" "direct-link-reset!")))
(let* ((app-strs (apply append (let* ((app-strs (apply append
(map (lambda (nf) (bld-emit-ns (car nf) (read-file-string (cdr nf)))) (map (lambda (nf) (bld-emit-ns (car nf) (read-file-string (cdr nf))))
ordered))) ordered)))
(_ (set-optimize! #f)) (_ (set-optimize! #f))
(_ ((var-deref "jolt.backend-scheme" "set-direct-link!") #f))
(builddir (string-append out-path ".build")) (builddir (string-append out-path ".build"))
(flat-ss (string-append builddir "/flat.ss")) (flat-ss (string-append builddir "/flat.ss"))
(flat-so (string-append builddir "/flat.so")) (flat-so (string-append builddir "/flat.so"))

View file

@ -37,10 +37,13 @@
;; (mark-macro! ns name) so the on-Chez analyzer can expand it. ;; (mark-macro! ns name) so the on-Chez analyzer can expand it.
;; Analyze -> (optionally run passes) -> emit one form. optimize? runs ;; Analyze -> (optionally run passes) -> emit one form. optimize? runs
;; jolt.passes/run-passes (build optimizes; the seed minter stays un-optimized so ;; jolt.passes/run-passes (build optimizes; the seed minter stays un-optimized so
;; the self-host fixpoint is independent of the passes). ;; the self-host fixpoint is independent of the passes). emit-top-form is the
;; top-level entry: in direct-link mode it binds jv$<fqn> for a top-level def; off
;; that mode (the minter, runtime eval) it is exactly emit, so output is unchanged.
(define jolt-ce-emit-top (var-deref "jolt.backend-scheme" "emit-top-form"))
(define (ei-compile-form ctx f optimize?) (define (ei-compile-form ctx f optimize?)
(let ((ir (jolt-ce-analyze ctx f))) (let ((ir (jolt-ce-analyze ctx f)))
(jolt-ce-emit (if optimize? (jolt-ce-run-passes ir ctx) ir)))) (jolt-ce-emit-top (if optimize? (jolt-ce-run-passes ir ctx) ir))))
;; The emitted `(def-var! …)(mark-macro! …)` pair for a defmacro, guard-wrapped ;; The emitted `(def-var! …)(mark-macro! …)` pair for a defmacro, guard-wrapped
;; (tolerant) or bare (strict) to match guard?. ;; (tolerant) or bare (strict) to match guard?.

File diff suppressed because one or more lines are too long

View file

@ -83,6 +83,31 @@
(def prelude-mode? (atom false)) (def prelude-mode? (atom false))
(defn set-prelude-mode! [on] (reset! prelude-mode? on)) (defn set-prelude-mode! [on] (reset! prelude-mode? on))
;; DIRECT-LINK MODE. Off for ordinary runs, the seed mint, and `-e`/repl/load-string
;; (open world — vars are redefinable). `jolt build` (release/optimized) flips it on
;; during app emission: a closed-world program where every app def is final, so an
;; app->app call binds to the def's Scheme binding directly, skipping the var-table
;; lookup and the generic jolt-invoke dispatch.
(def direct-link? (atom false))
(defn set-direct-link! [on] (reset! direct-link? on))
;; Fully-qualified app var names ("ns/name") already emitted with a direct-link
;; binding in the current unit. A call/value-ref direct-links only to a name in this
;; set — one defined earlier in emission order (or itself), so the Scheme binding
;; exists by the time the reference runs. Reset per build.
(def direct-link-defined (atom #{}))
(defn direct-link-reset! [] (reset! direct-link-defined #{}))
;; A direct-link Scheme binding name for a var. The fqn maps to a unique identifier
;; jv$<ns>$<name>; chars that break a Scheme identifier or the `$` separator are
;; escaped so distinct vars never collide.
(defn- dl-munge [s]
(-> s (str/replace "$" "_D_") (str/replace "#" "_H_") (str/replace "'" "_Q_")))
(defn- dl-name [ns nm] (str "jv$" (dl-munge ns) "$" (dl-munge nm)))
(defn- dl-fqn [ns nm] (str ns "/" nm))
(defn- direct-linkable? [ns nm]
(and @direct-link? (contains? @direct-link-defined (dl-fqn ns nm))))
;; recur-target and the set of munged local names known to hold a procedure (a ;; recur-target and the set of munged local names known to hold a procedure (a
;; named fn's self-recursion name) are lexically scoped — dynamic vars so the ;; named fn's self-recursion name) are lexically scoped — dynamic vars so the
;; recursion auto-restores them (no manual save/restore, no throw-leak). ;; recursion auto-restores them (no manual save/restore, no throw-leak).
@ -412,6 +437,11 @@
;; a :local callee that isn't a known procedure -> dynamic IFn dispatch. ;; a :local callee that isn't a known procedure -> dynamic IFn dispatch.
(and (= :local (:op fnode)) (not (*known-procs* (munge-name (:name fnode))))) (and (= :local (:op fnode)) (not (*known-procs* (munge-name (:name fnode)))))
(invoke) (invoke)
;; closed-world direct call: the callee var is an app def already emitted with
;; a Scheme binding — call it directly, no var lookup, no jolt-invoke.
(and (= :var (:op fnode)) (direct-linkable? (:ns fnode) (:name fnode)))
(order-args (fn [as] (str "(" (dl-name (:ns fnode) (:name fnode))
(if (seq as) (str " " (str/join " " as)) "") ")")))
;; a late-bound :var call head can hold a procedure OR a non-applicable ;; a late-bound :var call head can hold a procedure OR a non-applicable
;; value the RT dispatches (multimethod, keyword/coll IFn) — route via ;; value the RT dispatches (multimethod, keyword/coll IFn) — route via
;; jolt-invoke (transparent for a procedure). ;; jolt-invoke (transparent for a procedure).
@ -453,6 +483,9 @@
:var (let [core-proc (and (= "clojure.core" (:ns node)) (core-value-procs (:name node)))] :var (let [core-proc (and (= "clojure.core" (:ns node)) (core-value-procs (:name node)))]
(cond (cond
core-proc core-proc core-proc core-proc
;; direct-linked app var used as a value -> reference its binding (same
;; root as the var cell for a final var; helps DCE keep it live).
(direct-linkable? (:ns node) (:name node)) (dl-name (:ns node) (:name node))
(and (stdlib-var? node) (not (deref prelude-mode?))) (and (stdlib-var? node) (not (deref prelude-mode?)))
(throw (ex-info (str "emit: unsupported stdlib ref `" (:ns node) "/" (:name node) (throw (ex-info (str "emit: unsupported stdlib ref `" (:ns node) "/" (:name node)
"` (no core on Chez yet)") {})) "` (no core on Chez yet)") {}))
@ -527,3 +560,32 @@
(str "(def-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) " " (str "(def-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) " "
(emit (:init node)) ")")) (emit (:init node)) ")"))
(throw (ex-info (str "emit: op not yet ported / unhandled: " (pr-str (:op node))) {})))) (throw (ex-info (str "emit: op not yet ported / unhandled: " (pr-str (:op node))) {}))))
;; ^:dynamic / ^:redef on a def opts it out of direct-linking: it stays redefinable,
;; so callers must go through the var cell. m is a def's :meta (a jolt map value).
(defn- dl-opt-out? [m] (or (get m :dynamic) (get m :redef)))
;; Per-form entry used by the image/build emitter. In direct-link mode a TOP-LEVEL
;; def (form root, or spliced from a top-level do) without an opt-out also binds
;; jv$<fqn> and aliases the var cell to it, so app->app calls/refs bind directly.
;; Off direct-link mode this is exactly `emit`, so the seed mint and runtime eval are
;; byte-unchanged. Nested defs (a defonce's inner def) never reach a top-level branch
;; here, so they stay indirect — a `define` would be illegal in their position.
(defn emit-top-form [node]
(cond
(not @direct-link?) (emit node)
;; top-level do splices: each statement/ret is itself a top-level form.
(= :do (:op node))
(str "(begin " (str/join " " (map emit-top-form (:statements node)))
(if (empty? (:statements node)) "" " ") (emit-top-form (:ret node)) ")")
(and (= :def (:op node)) (not (:no-init node)) (not (dl-opt-out? (:meta node))))
(let [ns (:ns node) nm (:name node) b (dl-name ns nm)]
;; register before emitting the init so a self-referential body direct-links.
(swap! direct-link-defined conj (dl-fqn ns nm))
(let [init (emit (:init node))]
(if (jmeta-nonempty? (:meta node))
(str "(begin (define " b " " init ") (def-var-with-meta! "
(chez-str-lit ns) " " (chez-str-lit nm) " " b " " (emit-quoted (:meta node)) "))")
(str "(begin (define " b " " init ") (def-var! "
(chez-str-lit ns) " " (chez-str-lit nm) " " b "))"))))
:else (emit node)))

View file

@ -0,0 +1,89 @@
;; Direct-linking emission (jolt build, closed world). With direct-link on, a
;; top-level app def emits a Scheme binding jv$<ns>$<name> aliased to its var cell,
;; and an app->app call/value-ref binds to it directly instead of going through
;; (jolt-invoke (var-deref ...)). ^:dynamic/^:redef defs and nested defs opt out.
;; Off direct-link mode the emission is byte-identical to plain `emit`. Run:
;; chez --script test/chez/directlink-test.ss
(import (chezscheme))
(load "host/chez/rt.ss")
(set-chez-ns! "clojure.core")
(load "host/chez/seed/prelude.ss")
(load "host/chez/post-prelude.ss")
(set-chez-ns! "user")
(load "host/chez/host-contract.ss")
(load "host/chez/seed/image.ss")
(load "host/chez/compile-eval.ss")
(load "host/chez/emit-image.ss")
(define total 0) (define fails 0)
(define (ok name pred) (set! total (+ total 1)) (unless pred (set! fails (+ fails 1)) (printf "FAIL: ~a\n" name)))
(define set-direct-link! (var-deref "jolt.backend-scheme" "set-direct-link!"))
(define direct-link-reset! (var-deref "jolt.backend-scheme" "direct-link-reset!"))
(define (contains? s sub)
(let ((ns (string-length s)) (nsub (string-length sub)))
(let loop ((i 0))
(cond ((> (+ i nsub) ns) #f)
((string=? (substring s i (+ i nsub)) sub) #t)
(else (loop (+ i 1)))))))
;; Analyze+emit one form (string) in a namespace through the real build entry
;; (ei-compile-form -> emit-top-form), no optimization passes.
(define (emit-form ns-name str)
(let-values (((f j) (rdr-read-form str 0 (string-length str))))
(ei-compile-form (make-analyze-ctx ns-name) f #f)))
;; Register var cells so resolve-global classifies references as :var (the build
;; loads the namespaces before re-emitting; here we eval the defs with direct-link
;; off first). Use fn* so no macro expansion is involved.
(set-direct-link! #f)
(jolt-compile-eval "(def a (fn* ([] 1)))" "app")
(jolt-compile-eval "(def b (fn* ([] (a))))" "app")
(jolt-compile-eval "(def hof (fn* ([] a)))" "app")
(jolt-compile-eval "(def ^:dynamic d 5)" "app")
(jolt-compile-eval "(def usesd (fn* ([] (d))))" "app")
;; --- direct-link OFF: every reference stays indirect (var-deref) ---
(let ((eb (emit-form "app" "(def b (fn* ([] (a))))")))
(ok "off: call to a routes through jolt-invoke + var-deref"
(and (contains? eb "(jolt-invoke") (contains? eb "(var-deref \"app\" \"a\")")))
(ok "off: no jv$ direct call" (not (contains? eb "(jv$app$a)")))
(ok "off: def emits plain def-var! (no jv$ binding)"
(and (contains? (emit-form "app" "(def a (fn* ([] 1)))") "(def-var! \"app\" \"a\"")
(not (contains? (emit-form "app" "(def a (fn* ([] 1)))") "(define jv$app$a")))))
;; --- direct-link ON ---
(set-direct-link! #t)
(direct-link-reset!)
(let ((ea (emit-form "app" "(def a (fn* ([] 1)))"))) ; registers app/a in the set
(ok "on: a's def emits a jv$ binding aliased to its var cell"
(and (contains? ea "(begin (define jv$app$a ")
(contains? ea "(def-var! \"app\" \"a\" jv$app$a)"))))
(let ((eb (emit-form "app" "(def b (fn* ([] (a))))")))
(ok "on: b's call to a is a direct (jv$app$a) call" (contains? eb "(jv$app$a)"))
(ok "on: b's call to a is NOT var-deref'd" (not (contains? eb "(var-deref \"app\" \"a\")")))
(ok "on: b's call to a is NOT jolt-invoke'd" (not (contains? eb "(jolt-invoke"))))
(let ((eh (emit-form "app" "(def hof (fn* ([] a)))")))
(ok "on: a used as a value references the binding directly" (contains? eh " jv$app$a)"))
(ok "on: value-ref to a is NOT var-deref'd" (not (contains? eh "(var-deref \"app\" \"a\")"))))
;; ^:dynamic opts out: no jv$ binding, callers stay indirect.
(let ((ed (emit-form "app" "(def ^:dynamic d 5)")))
(ok "on: ^:dynamic def gets no jv$ binding" (not (contains? ed "(define jv$app$d"))))
(let ((eu (emit-form "app" "(def usesd (fn* ([] (d))))")))
(ok "on: call to a ^:dynamic var stays indirect" (contains? eu "(var-deref \"app\" \"d\")"))
(ok "on: ^:dynamic var not direct-linked" (not (contains? eu "(jv$app$d)"))))
;; A var only defined LATER in emission order is not yet in the set -> indirect.
(direct-link-reset!)
(let ((efwd (emit-form "app" "(def caller (fn* ([] (a))))"))) ; a not (re)emitted since reset
(ok "on: forward/undefined ref stays indirect" (contains? efwd "(var-deref \"app\" \"a\")")))
(set-direct-link! #f)
(printf "~a/~a passed~n" (- total fails) total)
(exit (if (zero? fails) 0 1))