Real Thread/yield + Thread/interrupted (jolt-l2gc)

Thread/yield was a no-op and Thread/interrupted always returned false. Now:

- yield calls libc sched_yield (resolved once via the process symbols), so a
  spin loop relinquishes the CPU. Falls back to a zero-length park if the symbol
  can't be resolved.
- each OS thread carries an interrupt flag (a box, thread-local). currentThread
  returns a handle wrapping the calling thread's flag, so .interrupt from another
  thread sets the target's flag. .isInterrupted reads without clearing; the static
  Thread/interrupted reads and clears — JVM semantics.

Consolidates the Thread surface: currentThread + the instance methods live in
io.ss (where the handle and its classloader are built), the flag box + yield +
the interrupted static in host-static.ss. Unit cases cover yield, the read/clear
split, and a cross-thread interrupt over a future.

host/chez/host-static.ss

@@ -161,21 +161,48 @@
         (cons "PI" (->dbl (* 4 (atan 1)))) (cons "E" (->dbl (exp 1)))
         (cons "random" (lambda args (random 1.0)))))
 
-;; Thread: real OS threads back futures/promises, so sleep genuinely
+;; Thread: real OS threads back futures/promises.
-;; parks the calling thread for `ms` milliseconds (a worker sleeping doesn't block
+;;  - sleep parks the calling thread for `ms` ms (a worker sleeping doesn't block
-;; the parent). yield hands off the scheduler.
+;;    the parent).
-(register-class-statics! "Thread"
+;;  - yield hands the CPU to another runnable thread (libc sched_yield).
+;;  - each thread carries an interrupt flag; interrupted (static) reads AND clears
+;;    the current thread's flag, matching the JVM. currentThread / .interrupt /
+;;    .isInterrupted are wired in io.ss, where the thread handle is built.
+
+;; Per-thread interrupt flag, lazily allocated so each OS thread gets its own box.
+;; A thread handle (from currentThread) captures this box, so .interrupt from
+;; another thread sets the target thread's flag.
+(define thread-interrupt-box (make-thread-parameter #f))
+(define (current-interrupt-box)
+  (or (thread-interrupt-box)
+      (let ((b (box #f))) (thread-interrupt-box b) b)))
+(define (clear-thread-interrupt!) (set-box! (current-interrupt-box) #f))
+
+;; libc sched_yield, resolved once; fall back to a zero-length park if the symbol
+;; isn't available.
+(define thread-yield!
+  (let ((fp #f) (tried? #f))
+    (lambda ()
+      (unless tried?
+        (set! tried? #t)
+        (set! fp (guard (e (#t #f))
+                   (load-shared-object #f)
+                   (foreign-procedure "sched_yield" () int))))
+      (if fp (fp) (sleep (make-time 'time-duration 0 0)))
+      jolt-nil)))
+
+(define thread-statics
   (list (cons "sleep" (lambda (ms . _)
                         (let* ((ms* (exact (floor ms)))
                                (secs (quotient ms* 1000))
                                (nanos (* (remainder ms* 1000) 1000000)))
                           (sleep (make-time 'time-duration nanos secs)))
                         jolt-nil))
-        (cons "yield" (lambda () jolt-nil))
+        (cons "yield" (lambda _ (thread-yield!)))
-        (cons "interrupted" (lambda () #f))
+        (cons "interrupted" (lambda _ (let* ((b (current-interrupt-box)) (v (unbox b)))
-        (cons "currentThread" (lambda () (make-jhost "thread" '())))))
+                                        (set-box! b #f) (and v #t))))))
-(register-host-methods! "thread"
+(register-class-statics! "Thread" thread-statics)
-  (list (cons "getContextClassLoader" (lambda (self) (make-jhost "classloader" '())))))
+(register-class-statics! "java.lang.Thread" thread-statics)
 
 ;; clojure.lang.LockingTransaction: jolt has no STM (no refs/dosync), so a
 ;; transaction is never running. isRunning -> false.

host/chez/io.ss

@@ -369,13 +369,22 @@
                   (if (jolt-nil? u) jolt-nil (host-new "StringReader" (jolt-slurp (url-strip-scheme (url-spec u))))))))))
 (register-class-statics! "ClassLoader" (list (cons "getSystemClassLoader" (lambda () the-classloader))))
 (register-class-statics! "java.lang.ClassLoader" (list (cons "getSystemClassLoader" (lambda () the-classloader))))
-;; Thread/currentThread -> a thread jhost whose getContextClassLoader is the loader.
+;; Thread/currentThread -> a fresh thread jhost wrapping THIS thread's interrupt
-(define the-thread (make-jhost "thread" (vector)))
+;; flag (the box from current-interrupt-box, host-static.ss), so .interrupt from
+;; any thread sets the target thread's flag and .isInterrupted reads it without
+;; clearing (instance semantics; the static Thread/interrupted reads-and-clears).
+;; getContextClassLoader hands back the loader.
 (register-host-methods! "thread"
   (list (cons "getContextClassLoader" (lambda (self) the-classloader))
-        (cons "getName" (lambda (self) "main"))))
+        (cons "getName" (lambda (self) "main"))
-(register-class-statics! "Thread" (list (cons "currentThread" (lambda () the-thread))))
+        (cons "interrupt" (lambda (self)
-(register-class-statics! "java.lang.Thread" (list (cons "currentThread" (lambda () the-thread))))
+                            (when (box? (jhost-state self)) (set-box! (jhost-state self) #t))
+                            jolt-nil))
+        (cons "isInterrupted" (lambda (self)
+                                (and (box? (jhost-state self)) (unbox (jhost-state self)) #t)))))
+(define (current-thread-handle) (make-jhost "thread" (current-interrupt-box)))
+(register-class-statics! "Thread" (list (cons "currentThread" current-thread-handle)))
+(register-class-statics! "java.lang.Thread" (list (cons "currentThread" current-thread-handle)))
 
 ;; --- java.io.File / java.util.UUID constructors -----------------------------
 ;; (java.io.File. parent child) joins with "/"; (File. path) wraps the path.

host/chez/run-unit.ss

@@ -56,6 +56,7 @@
   (hashtable-clear! ns-alias-table)
   (hashtable-clear! ns-refer-table)
   (hashtable-clear! ns-refer-all-table)
+  (clear-thread-interrupt!)   ; a case that set the runner thread's interrupt flag mustn't leak
   (when zj-ghier (jolt-invoke (var-deref "clojure.core" "reset!")
                    (var-cell-root zj-ghier) (jolt-invoke (var-deref "clojure.core" "make-hierarchy"))))
   (set-chez-ns! "user"))

test/chez/unit.edn

@@ -117,6 +117,14 @@
   {: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 "interrupt" :expr "(do (Thread/yield) :ok)" :expected ":ok"}
+  {:suite "interrupt" :expr "(nil? (Thread/yield))" :expected "true"}
+  {:suite "interrupt" :expr "(.isInterrupted (Thread/currentThread))" :expected "false"}
+  {:suite "interrupt" :expr "(let [t (Thread/currentThread)] (.interrupt t) (.isInterrupted t))" :expected "true"}
+  {:suite "interrupt" :expr "(let [t (Thread/currentThread)] (.interrupt t) [(.isInterrupted t) (.isInterrupted t)])" :expected "[true true]"}
+  {:suite "interrupt" :expr "(let [t (Thread/currentThread)] (.interrupt t) [(Thread/interrupted) (Thread/interrupted)])" :expected "[true false]"}
+  {:suite "interrupt" :expr "(do (.interrupt (Thread/currentThread)) (Thread/interrupted) (.isInterrupted (Thread/currentThread)))" :expected "false"}
+  {:suite "interrupt" :expr "(let [t (atom nil) started (promise) go (promise) f (future (reset! t (Thread/currentThread)) (deliver started true) (deref go) (.isInterrupted (deref t)))] (deref started) (.interrupt (deref t)) (deliver go true) (deref f))" :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"}