From c18f8087f06be012a79dbc8df97a4af762f85ba1 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Mon, 22 Jun 2026 18:57:16 -0400 Subject: [PATCH] Real nREPL interrupt + thread-local *ns* (jolt-amzy, jolt-6rld) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Two nREPL divergences the library shakeout surfaced — both have a real host mechanism on Chez. Interrupt (jolt-amzy): Chez's engine timer (set-timer + thread-local timer-interrupt-handler) is polled at procedure-call / loop back-edges, so a running computation — even a tight loop — can be aborted from another thread. concurrency.ss adds jolt.host/{make-interrupt, interrupt!, run-interruptible}: an interrupt token is a shared box; run-interruptible arms a periodic timer whose handler escapes (call/cc) when the token is set, throwing {:jolt/interrupted true}. The eval thread is reused, not abandoned. (A thread blocked in a __collect_safe foreign call only sees it on return — like the JVM not killing native code.) Thread-local *ns* (jolt-6rld): chez-current-ns is now a Chez thread-parameter, so each session worker / future has its own current ns (vars stay global, only the pointer is per-thread). *ns* reads derive from it (dyn-binding.ss), and a bound *ns* drives chez-current-ns — so (binding [*ns* the-ns] (load-string code)) resolves against the-ns, and concurrent in-ns across threads don't clobber each other. Single-threaded behaviour is unchanged. All runtime .ss — no re-mint. --- host/chez/concurrency.ss | 40 +++++++++++++++++++++++++++++++++++++++ host/chez/dyn-binding.ss | 14 ++++++++++++-- host/chez/loader.ss | 4 ++-- host/chez/multimethods.ss | 20 +++++++++++++++++--- host/chez/ns.ss | 3 ++- test/chez/unit.edn | 6 ++++++ 6 files changed, 79 insertions(+), 8 deletions(-) diff --git a/host/chez/concurrency.ss b/host/chez/concurrency.ss index 9785e6c..e24479e 100644 --- a/host/chez/concurrency.ss +++ b/host/chez/concurrency.ss @@ -272,3 +272,43 @@ (def-var! "clojure.core" "make-delay" jolt-make-delay) (def-var! "clojure.core" "delay?" jolt-delay?) (def-var! "clojure.core" "deref" jolt-deref) + +;; --- cooperative thread interrupt (jolt-amzy) ------------------------------- +;; Chez has no force-kill, but its engine timer (set-timer + timer-interrupt- +;; handler, thread-local) is polled at procedure-call / loop back-edges — so a +;; running computation, even a tight Scheme loop, can be aborted from another +;; thread. An interrupt TOKEN is a shared box; run-interruptible arms a periodic +;; timer in the eval thread whose handler escapes (via call/cc) when the token is +;; set; interrupt! sets the token from any thread. The aborted eval throws a jolt +;; ex-info {:jolt/interrupted true}, so the thread is REUSED, not abandoned. +;; +;; Caveat: a thread blocked in a __collect_safe foreign call (socket recv/accept, +;; sleep) only sees the interrupt when it returns to Scheme — like the JVM not +;; killing native code. +(define interrupt-check-ticks 100000) ; ~poll interval; responsive + low overhead +(define interrupt-sentinel (cons 'jolt 'interrupted)) +(define jolt-kw-interrupted (keyword "jolt" "interrupted")) +(define (jolt-make-interrupt) (box #f)) +(define (jolt-interrupt! token) (when (box? token) (set-box! token #t)) jolt-nil) +(define (jolt-interrupted? token) (and (box? token) (unbox token) #t)) +(define (jolt-run-interruptible token thunk) + (let ((prev-handler (timer-interrupt-handler))) + (let ((r (call/cc + (lambda (k) + (timer-interrupt-handler + (lambda () + (if (and (box? token) (unbox token)) + (k interrupt-sentinel) + (begin (set-timer interrupt-check-ticks) (void))))) + (set-timer interrupt-check-ticks) + (let ((v (thunk))) (set-timer 0) v))))) + ;; restore the prior timer state regardless of outcome. + (set-timer 0) + (timer-interrupt-handler prev-handler) + (if (eq? r interrupt-sentinel) + (jolt-throw (jolt-ex-info "Evaluation interrupted" (jolt-hash-map jolt-kw-interrupted #t))) + r)))) +(def-var! "jolt.host" "make-interrupt" jolt-make-interrupt) +(def-var! "jolt.host" "interrupt!" jolt-interrupt!) +(def-var! "jolt.host" "interrupted?" jolt-interrupted?) +(def-var! "jolt.host" "run-interruptible" jolt-run-interruptible) diff --git a/host/chez/dyn-binding.ss b/host/chez/dyn-binding.ss index e1d59fe..f49e936 100644 --- a/host/chez/dyn-binding.ss +++ b/host/chez/dyn-binding.ss @@ -102,12 +102,20 @@ ;; var-deref (rt.ss): the compiled-code read path for every clojure.core var ;; reference. Consult the stack first; fall straight back to the root (NOT through ;; jolt-var-get's unbound-error path) so undefined-var reads keep prior behaviour. +;; The *ns* var cell — its reads are thread-local: with no thread-binding they +;; derive from chez-current-ns (a thread-parameter), so *ns* tracks in-ns per +;; thread and a (binding [*ns* ..]) drives resolution (jolt-6rld). Captured now +;; that *ns* is defined (ns.ss loaded earlier); chez-current-ns consults it too. +(set! star-ns-cell (jolt-var "clojure.core" "*ns*")) + (define %dyn-rt-var-deref var-deref) (set! var-deref (lambda (ns name) (let ((cell (jolt-var ns name))) (let ((bv (dyn-binding-value cell))) - (if (eq? bv dyn-no-binding) (var-cell-root cell) bv))))) + (cond ((not (eq? bv dyn-no-binding)) bv) + ((eq? cell star-ns-cell) (intern-ns! (chez-current-ns))) + (else (var-cell-root cell))))))) ;; jolt-var-get (vars.ss): the var-get fn + deref/@ on a cell. Stack first, then ;; the original (which errors on an unbound root, matching Clojure). @@ -116,7 +124,9 @@ (lambda (v) (if (var-cell? v) (let ((bv (dyn-binding-value v))) - (if (eq? bv dyn-no-binding) (%dyn-var-get v) bv)) + (cond ((not (eq? bv dyn-no-binding)) bv) + ((eq? v star-ns-cell) (intern-ns! (chez-current-ns))) + (else (%dyn-var-get v)))) (%dyn-var-get v)))) ;; var-cell keys hash/compare by ns/name (jolt=2 in vars.ss already compares diff --git a/host/chez/loader.ss b/host/chez/loader.ss index b338e2d..7e1858f 100644 --- a/host/chez/loader.ss +++ b/host/chez/loader.ss @@ -90,8 +90,8 @@ ".clj (or .cljc) on the source roots") name)) (let ((saved (chez-current-ns))) (load-jolt-file file) - (set-chez-ns! saved) - (def-var! "clojure.core" "*ns*" (intern-ns! saved))))))) + ;; restore the current ns (thread-local); *ns* reads derive from it. + (set-chez-ns! saved)))))) ;; load-file: load an explicit path (a `run FILE`), in the current ns. (define (jolt-load-file path) diff --git a/host/chez/multimethods.ss b/host/chez/multimethods.ss index c5f99a6..e5284e1 100644 --- a/host/chez/multimethods.ss +++ b/host/chez/multimethods.ss @@ -21,9 +21,23 @@ ;; so they agree with defmulti. Loaded from rt.ss after seq.ss (jolt-invoke), ;; collections.ss (jolt=/key-hash/jolt-hash-map) and the var-cell machinery. -(define chez-current-ns-box (vector "user")) -(define (chez-current-ns) (vector-ref chez-current-ns-box 0)) -(define (set-chez-ns! ns) (vector-set! chez-current-ns-box 0 ns)) +;; THREAD-LOCAL (jolt-6rld): a Chez thread-parameter, so each OS thread (an nREPL +;; session worker / future) has its own current ns — vars stay global, only the +;; "current ns" pointer is per-thread, matching Clojure's thread-local *ns*. A new +;; thread inherits the forking thread's value. `star-ns-cell` (the *ns* var cell, +;; captured by dyn-binding.ss once *ns* exists) lets chez-current-ns DERIVE from a +;; thread-local (binding [*ns* ..]) so a bound *ns* drives load-string/analyzer +;; resolution; bootstrap-safe (it's #f until then, so we just read the parameter). +(define chez-current-ns-param (make-thread-parameter "user")) +(define star-ns-cell #f) +(define (chez-current-ns) + (if star-ns-cell + (let ((bv (dyn-binding-value star-ns-cell))) + (if (and (not (eq? bv dyn-no-binding)) (jns? bv)) + (jns-name bv) + (chez-current-ns-param))) + (chez-current-ns-param))) +(define (set-chez-ns! ns) (chez-current-ns-param ns)) (define-record-type jolt-multifn (fields name dispatch-fn methods default hierarchy prefers) diff --git a/host/chez/ns.ss b/host/chez/ns.ss index 8a8cf76..15707f1 100644 --- a/host/chez/ns.ss +++ b/host/chez/ns.ss @@ -111,8 +111,9 @@ ;; redirect them. It is enough for *ns* / str-of-ns to track the switch. (define (jolt-in-ns desig) (let* ((nm (ns-desig->name desig)) (n (intern-ns! nm))) + ;; set the THREAD-LOCAL current ns; *ns* reads derive from it (dyn-binding.ss), + ;; so this is per-thread — concurrent nREPL sessions don't clobber each other. (set-chez-ns! nm) - (def-var! "clojure.core" "*ns*" n) n)) ;; ns-name: a namespace's name as a (no-ns) symbol. Overrides the overlay (which diff --git a/test/chez/unit.edn b/test/chez/unit.edn index 64fcdf4..1134ce9 100644 --- a/test/chez/unit.edn +++ b/test/chez/unit.edn @@ -115,6 +115,12 @@ {:suite "hostobj" :expr "[(some? (ClassLoader/getSystemClassLoader)) (some? (.getContextClassLoader (Thread/currentThread)))]" :expected "[true true]"} {:suite "reify" :expr "(do (defprotocol P (pm [_])) (defprotocol Q (qm [_])) (extend-protocol Q java.lang.Object (qm [_] :q-default)) (qm (reify P (pm [_] :p))))" :expected ":q-default"} {:suite "reify" :expr "(do (defprotocol Q (qa [_]) (qb [_])) (extend-protocol Q java.lang.Object (qa [_] :da) (qb [_] :db)) (def r (reify Q (qa [_] :ra))) [(qa r) (qb r)])" :expected "[:ra :db]"} + {:suite "interrupt" :expr "(jolt.host/run-interruptible (jolt.host/make-interrupt) (fn [] (+ 1 2)))" :expected "3"} + {:suite "interrupt" :expr "(let [t (jolt.host/make-interrupt)] (jolt.host/interrupt! t) (try (jolt.host/run-interruptible t (fn [] (loop [i 0] (recur (inc i))))) :not-interrupted (catch :default e (:jolt/interrupted (ex-data e)))))" :expected "true"} + {:suite "ns-tl" :expr "(do (in-ns (quote foo.bar)) (str *ns*))" :expected "foo.bar"} + {:suite "ns-tl" :expr "(do (create-ns (quote my.ns)) (binding [*ns* (find-ns (quote my.ns))] (str *ns*)))" :expected "my.ns"} + {:suite "ns-tl" :expr "(do (in-ns (quote app.core)) (def sekret 42) (in-ns (quote user)) (binding [*ns* (find-ns (quote app.core))] (load-string \"sekret\")))" :expected "42"} + {:suite "ns-tl" :expr "(do (create-ns (quote a.x)) (create-ns (quote b.y)) (let [fa (future (in-ns (quote a.x)) (Thread/sleep 80) (str *ns*)) fb (future (in-ns (quote b.y)) (Thread/sleep 80) (str *ns*))] [(deref fa) (deref fb) (str *ns*)]))" :expected "[a.x b.y user]"} {:suite "dotform" :expr "(.equals \"a\" \"a\")" :expected "true"} {:suite "dotform" :expr "(.equals \"a\" \"b\")" :expected "false"} {:suite "dotform" :expr "(. {:value 41 :describe (fn [self] (str \"v=\" (:value self)))} describe)" :expected "v=41"}