simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request #276 from jolt-lang/clean-nrepl-exit

Browse source 
Fix nREPL server ^C shutdown crash
This commit is contained in:
Dmitri Sotnikov 2026-06-30 23:15:35 +00:00 • committed by GitHub
commit a58bca3bee
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
4 changed files with 111 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

18
README.md
View file

@ -106,6 +106,24 @@ compiler. They come with a from-source Chez install; a distro `chezscheme`
package ships only the runtime, so `build` won't link a binary there.
RFC 0007 (`docs/rfc/`) covers the design and the three-mode model.
## Standalone joltc binary
`make` builds joltc itself into a single self-contained native binary — the
runtime, compiler, `jolt-core`/`stdlib` source, and the Chez boots are baked in,
so the result runs and `build`s jolt apps on a machine with neither Chez nor a C
compiler. Build it on a host that *does* have both.
```bash
make joltc-release # => target/release/joltc (optimize-level 3, compressed)
make joltc-debug # => target/debug/joltc (optimize-level 0, inspector + debug info)
make joltc # re-mint the seed first, then both
```
`make joltc` re-mints the seed so the embedded compiler image is current before
linking; use `joltc-release`/`joltc-debug` directly to skip that when the seed is
already minted. Like `build`, both require Chez's kernel development files
(`libkernel.a`, `scheme.h`) and a C compiler.
## Architecture
A small Chez runtime (`host/chez/*.ss`: value model, persistent collections, seqs,

66
host/chez/java/concurrency.ss
View file

@ -459,6 +459,27 @@
(jolt-main-job-val job)
(raise (jolt-main-job-val job))))))))
(define jolt-pump-kih
(lambda ()
(for-each (lambda (th) (guard (e (#t #f)) (th)))
(reverse (unbox jolt-shutdown-hooks)))
(exit 0)))
;; Park the calling thread until a keyboard interrupt (^C), then run the shutdown
;; hooks and exit. Unlike run-main-pump (whose tight recursive condition-wait
;; loop elides Chez's interrupt poll points, so the handler never fires), this
;; uses a single condition-wait — the form Chez reliably interrupts. The nREPL
;; server parks here; SIGINT is unblocked in this thread first (it was masked by
;; jolt-block-sigint so the accept loop inherited a blocked mask and couldn't
;; absorb ^C in its foreign accept() call).
(define jolt-park-mu (make-mutex))
(define jolt-park-cv (make-condition))
(define (jolt-park-until-interrupt)
(keyboard-interrupt-handler jolt-pump-kih)
(jolt-set-sigint-blocked #f)
(with-mutex jolt-park-mu (condition-wait jolt-park-cv jolt-park-mu))
jolt-nil)
(define (jolt-run-main-pump)
(with-mutex jolt-main-queue-mu
(set-box! jolt-main-pump-stop #f)
@ -508,6 +529,51 @@
(condition-broadcast jolt-main-queue-cv))
jolt-nil)
;; Shutdown hooks run by jolt-pump-kih (the keyboard-interrupt-handler installed by
;; park-until-interrupt) before (exit 0), so a foreground server (nREPL) can close
;; its socket and drop .nrepl-port on ^C instead of Chez's default mutex-corrupting
;; abort. Newest-first; each hook is isolated so one failing hook can't block the exit.
(define jolt-shutdown-hooks (box '()))
(define (jolt-add-shutdown-hook thunk)
(set-box! jolt-shutdown-hooks (cons thunk (unbox jolt-shutdown-hooks)))
jolt-nil)
;; Per-thread SIGINT mask. A worker thread parked in a foreign call (the nREPL
;; accept loop in c-accept, or a conn handler) can't run Chez's keyboard-interrupt
;; handler on ^C, so if SIGINT is delivered there the process hangs. Block SIGINT
;; in the primordial thread BEFORE forking such workers (they inherit the mask),
;; then park-until-interrupt unblocks it in the primordial once its handler is
;; installed, so ^C is always delivered to the parked thread. pthread_sigmask/
;; sigaddset are libc/libpthread symbols, resolvable once the process object is
;; loaded (as the socket fns already are). 128 bytes covers Linux's 1024-bit
;; sigset_t and is larger than macOS's 4-byte one.
(define c-pthread-sigmask
(foreign-procedure "pthread_sigmask" (int u8* u8*) int))
(define c-sigemptyset (foreign-procedure "sigemptyset" (u8*) int))
(define c-sigaddset (foreign-procedure "sigaddset" (u8* int) int))
;; POSIX SIG_BLOCK/SIG_UNBLOCK numerics differ by platform: Linux/glibc 0/1,
;; Darwin/macOS 1/2 (SIG_UNBLOCK is SIG_BLOCK+1 on both). Resolve SIG_BLOCK for
;; this host from the machine-type symbol — macOS builds contain "osx".
(define jolt-sig-block-how
(let* ((s (symbol->string (machine-type)))
(n (string-length s)))
(let loop ((i 0))
(cond
((> (+ i 3) n) 0) ; default: Linux/glibc
((string=? (substring s i (+ i 3)) "osx") 1) ; Darwin/macOS
(else (loop (+ i 1)))))))
(define (jolt-set-sigint-blocked block?)
(let ((set (make-bytevector 128 0))
(old (make-bytevector 128 0)))
(c-sigemptyset set)
(c-sigaddset set 2) ; SIGINT = 2
(c-pthread-sigmask (if block? jolt-sig-block-how (+ jolt-sig-block-how 1)) set old)
jolt-nil))
(def-var! "jolt.host" "call-on-main-thread" jolt-call-on-main-thread)
(def-var! "jolt.host" "run-main-pump" jolt-run-main-pump)
(def-var! "jolt.host" "stop-main-pump" jolt-stop-main-pump)
(def-var! "jolt.host" "add-shutdown-hook" jolt-add-shutdown-hook)
(def-var! "jolt.host" "block-sigint" (lambda () (jolt-set-sigint-blocked #t)))
(def-var! "jolt.host" "park-until-interrupt" jolt-park-until-interrupt)
(def-var! "jolt.host" "delete-file" delete-file)

18
jolt-core/jolt/main.clj
View file

@ -200,10 +200,22 @@
;; the GUI main loop: glimmer's run marshals its startup here via
;; jolt.host/call-on-main-thread — on macOS GTK quartz, g_application_run
;; must run on the main thread or AppKit aborts when it sets the main menu.
;; Block SIGINT in this (primordial) thread before starting the server so the
;; accept-loop future — and the conn-handler futures it spawns — inherit a
;; blocked SIGINT mask. Without this, ^C lands on the accept loop blocked in
;; c-accept (a foreign call), where Chez can't fire the keyboard-interrupt
;; handler, and the server hangs. park-until-interrupt unblocks SIGINT here
;; once its own ^C handler is installed, so ^C reaches this thread and the
;; shutdown hooks run cleanly.
(jolt.host/block-sigint)
(let [stop ((resolve 'jolt.nrepl/start) port (:nrepl-middleware resolved))]
;; park here until something calls jolt.host/stop-main-pump, then shut the
;; server down cleanly (close the socket, remove .nrepl-port) and return.
(jolt.host/run-main-pump)
;; register stop so ^C (handled by park-until-interrupt) closes the socket
;; and drops .nrepl-port on the way out.
(jolt.host/add-shutdown-hook stop)
;; park here until ^C (handled by park-until-interrupt's keyboard-interrupt-
;; handler, which runs the shutdown hooks and exits). The accept loop
;; inherited SIGINT-blocked above, so ^C is delivered to this thread.
(jolt.host/park-until-interrupt)
(when stop (stop))))))
(defn- usage []

8
jolt-core/jolt/nrepl.clj
View file

@ -29,9 +29,9 @@
(ffi/defcfn c-bind "bind" [:int :pointer :int] :int)
(ffi/defcfn c-listen "listen" [:int :int] :int)
(ffi/defcfn c-setsockopt "setsockopt" [:int :int :int :pointer :int] :int)
(ffi/defcfn c-accept "accept" [:int :pointer :pointer] :int :blocking)
(ffi/defcfn c-recv "recv" [:int :pointer :size_t :int] :ssize_t :blocking)
(ffi/defcfn c-send "send" [:int :pointer :size_t :int] :ssize_t :blocking)
(ffi/defcfn c-accept "accept" [:int :pointer :pointer] :int :blocking)
(ffi/defcfn c-recv "recv" [:int :pointer :size_t :int] :ssize_t :blocking)
(ffi/defcfn c-send "send" [:int :pointer :size_t :int] :ssize_t :blocking)
(ffi/defcfn c-close "close" [:int] :int)
(def ^:private AF-INET 2)
@ -256,5 +256,5 @@
(fn stop []
(when (compare-and-set! stopped false true)
(c-close fd)
(try (io/delete-file ".nrepl-port" true) (catch :default _ nil)))
(jolt.host/delete-file ".nrepl-port"))
nil))))