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

Soft/WeakReference: real GC eviction via Chez weak pairs + guardians

Browse source 
Replace the strong-ref stub with genuine reclamation. The referent is held
through a weak-cons, so Chez's generational collector reclaims it once it is
otherwise unreachable (the pair's car becomes the bwp object, and .get returns
nil). A guardian registered on the referent makes the reference itself available
the instant its referent is collected, which ReferenceQueue.poll surfaces as
enqueued — the same hook clojure.core.cache's clear-soft-cache! drains.

Chez has no softer-than-weak reference, so a SoftReference clears on
unreachability rather than under memory pressure: a SoftCache evicts more eagerly
than the JVM's but is now real GC eviction, not an unbounded strong cache.
WeakReference gets the same (faithful) semantics. Added System/gc -> a full
collect so callers (and the queue) can force the cycle.

core.cache stays 1314/0/0 (its test values are immortal literals). Corpus row for
System/gc; make test + shakesmoke green.
This commit is contained in:
Yogthos 2026-06-25 11:32:32 -04:00
parent e955b2072a
commit 80b2dfa9f9
3 changed files with 41 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

62
host/chez/host-static-classes.ss
View file

@ -230,37 +230,49 @@
(if (hashtable-contains? (hm-tbl c) k) #t #f)
(prev-contains c k)))))
;; ---- java.lang.ref.SoftReference / ReferenceQueue ---------------------------
;; No JVM GC reference semantics here: a SoftReference holds its referent strongly
;; (never auto-cleared), which makes a SoftCache an unbounded cache rather than a
;; GC-pressure one. .enqueue / ReferenceQueue.poll work so code that drains the
;; queue (clojure.core.cache's clear-soft-cache!) runs. soft-ref state:
;; #(referent queue enqueued?); ref-queue state: #(list-of-enqueued-refs).
(define (refqueue-add! rq ref)
(let ((st (jhost-state rq))) (vector-set! st 0 (append (vector-ref st 0) (list ref)))))
(for-each (lambda (nm)
(register-class-ctor! nm
(lambda (v . rest) (make-jhost "soft-ref" (vector v (if (pair? rest) (car rest) jolt-nil) #f)))))
'("SoftReference" "java.lang.ref.SoftReference"))
(register-host-methods! "soft-ref"
(list (cons "get" (lambda (self) (vector-ref (jhost-state self) 0)))
(cons "clear" (lambda (self) (vector-set! (jhost-state self) 0 jolt-nil) jolt-nil))
;; ---- java.lang.ref.Soft/WeakReference + ReferenceQueue ----------------------
;; Real GC reclamation via Chez's generational collector: the referent is held
;; through a weak pair (collected once otherwise unreachable, leaving the bwp
;; object), and a guardian registered on the referent makes the reference itself
;; available the moment its referent is reclaimed — which the ReferenceQueue
;; surfaces as enqueued, exactly like the JVM. (Chez has no softer-than-weak
;; reference, so a SoftReference clears on unreachability rather than under memory
;; pressure — its SoftCache evicts more eagerly than the JVM's, but it is genuine
;; GC eviction, not an unbounded strong cache. Immediates like fixnums/keywords
;; are never collected.)
;; ref-queue state: #(guardian pending-list); reference state: #(weak-pair queue enqueued?).
(define (rq-guardian-of q) (vector-ref (jhost-state q) 0))
(define (rq-add! q ref)
(let ((st (jhost-state q))) (vector-set! st 1 (append (vector-ref st 1) (list ref)))))
(define (rq-pump! q) ; drain GC-reclaimed refs onto the list
(let loop ()
(let ((rep ((rq-guardian-of q)))) (when rep (rq-add! q rep) (loop)))))
(define (rq-poll q)
(rq-pump! q)
(let* ((st (jhost-state q)) (l (vector-ref st 1)))
(if (null? l) jolt-nil (begin (vector-set! st 1 (cdr l)) (car l)))))
(define (a-ref-queue? x) (and (jhost? x) (string=? (jhost-tag x) "ref-queue")))
(define (make-reference v rest)
(let* ((rq (if (pair? rest) (car rest) jolt-nil))
(ref (make-jhost "weak-ref" (vector (weak-cons v #f) rq #f))))
(when (a-ref-queue? rq) ((rq-guardian-of rq) v ref)) ; fire on the referent's collection
ref))
(for-each (lambda (nm) (register-class-ctor! nm (lambda (v . rest) (make-reference v rest))))
'("SoftReference" "java.lang.ref.SoftReference" "WeakReference" "java.lang.ref.WeakReference"))
(register-host-methods! "weak-ref"
(list (cons "get" (lambda (self) (let ((r (car (vector-ref (jhost-state self) 0))))
(if (bwp-object? r) jolt-nil r))))
(cons "clear" (lambda (self) (set-car! (vector-ref (jhost-state self) 0) jolt-nil) jolt-nil))
(cons "isEnqueued" (lambda (self) (vector-ref (jhost-state self) 2)))
(cons "enqueue" (lambda (self)
(let* ((st (jhost-state self)) (rq (vector-ref st 1)))
(if (vector-ref st 2) #f
(begin (vector-set! st 2 #t)
(when (and (jhost? rq) (string=? (jhost-tag rq) "ref-queue")) (refqueue-add! rq self))
#t)))))))
(for-each (lambda (nm) (register-class-ctor! nm (lambda _ (make-jhost "ref-queue" (vector '())))))
(begin (vector-set! st 2 #t) (when (a-ref-queue? rq) (rq-add! rq self)) #t)))))))
(for-each (lambda (nm) (register-class-ctor! nm (lambda _ (make-jhost "ref-queue" (vector (make-guardian) '())))))
'("ReferenceQueue" "java.lang.ref.ReferenceQueue"))
(register-host-methods! "ref-queue"
(list (cons "poll" (lambda (self . _)
(let* ((st (jhost-state self)) (q (vector-ref st 0)))
(if (null? q) jolt-nil (begin (vector-set! st 0 (cdr q)) (car q))))))
(cons "remove" (lambda (self . _)
(let* ((st (jhost-state self)) (q (vector-ref st 0)))
(if (null? q) jolt-nil (begin (vector-set! st 0 (cdr q)) (car q))))))))
(list (cons "poll" (lambda (self . _) (rq-poll self)))
(cons "remove" (lambda (self . _) (rq-poll self)))))
;; ---- StringReader -----------------------------------------------------------
;; state: a vector #(string pos marked).

3
host/chez/host-static-methods.ss
View file

@ -106,6 +106,9 @@
(list (cons "currentTimeMillis" (lambda () (->num (now-millis))))
(cons "nanoTime" (lambda () (->num (* 1000000 (now-millis)))))
(cons "exit" (lambda args (exit (if (null? args) 0 (jnum->exact (car args))))))
;; System/gc -> a full Chez collection (so weak references clear and their
;; guardians fire); Runtime.gc() routes here too.
(cons "gc" (lambda _ (collect (collect-maximum-generation)) jolt-nil))
;; wrapped in lambdas: the helpers are defined below, resolved at call time.
(cons "getProperty" (lambda (k . d) (apply sys-get-property k d)))
(cons "setProperty" (lambda (k v) (sys-set-property k v)))

1
test/chez/corpus.edn
View file

@ -14,6 +14,7 @@
{:suite "interop / Thread" :label "start + join runs the thunk" :expected "7" :actual "(let [a (atom 0) t (Thread. (fn [] (reset! a 7)))] (.start t) (.join t) (deref a))"}
{:suite "interop / CountDownLatch" :label "countDown to zero, await returns" :expected "0" :actual "(let [l (java.util.concurrent.CountDownLatch. 1)] (.countDown l) (.await l) (.getCount l))"}
{:suite "interop / SoftReference" :label "get returns the referent" :expected ":v" :actual "(.get (java.lang.ref.SoftReference. :v))"}
{:suite "interop / System.gc" :label "gc runs and returns" :expected "42" :actual "(do (System/gc) 42)"}
{:suite "interop / ConcurrentHashMap" :label "put + get/count/contains?" :expected "[1 1 true]" :actual "(let [m (java.util.concurrent.ConcurrentHashMap.)] (.put m :a 1) [(get m :a) (count m) (contains? m :a)])"}
{:suite "interop / Class.forName" :label "unknown class throws ClassNotFoundException" :expected ":nf" :actual "(try (Class/forName \"no.such.Klass\") (catch ClassNotFoundException _ :nf))"}
{:suite "interop / Class.forName" :label "known class resolves" :expected "\"java.lang.String\"" :actual "(.getName (Class/forName \"java.lang.String\"))"}