Real nREPL interrupt + thread-local *ns* (jolt-amzy, jolt-6rld)
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.
This commit is contained in:
parent
f30a517cf7
commit
c18f8087f0
6 changed files with 79 additions and 8 deletions
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue