Thread/CountDownLatch + SoftReference/ConcurrentHashMap so core.cache fully passes
Closes the last clojure.core.cache gaps (now 1314/0/0, including the 1000-thread cache-stampede): - java.lang.Thread over Chez fork-thread (shared heap): (Thread. thunk) + start/ join/run/isAlive, on a "user-thread" tag distinct from Thread/currentThread's interrupt shim. java.util.concurrent.CountDownLatch (count/mutex/condition). - java.util.concurrent.ConcurrentHashMap = the mutable HashMap shim; get / count / contains? read it (clojure.core), which SoftCache uses on its backing map. - java.lang.ref.SoftReference / ReferenceQueue: no JVM GC reference semantics, so the referent is held strongly (a SoftCache is unbounded rather than GC-evicting), but enqueue / poll work so clear-soft-cache! drains the queue. JVM-certified corpus rows. make test + shakesmoke green.
This commit is contained in:
parent
5d0989a860
commit
9312ad0937
3 changed files with 98 additions and 0 deletions
|
|
@ -328,3 +328,47 @@
|
||||||
(def-var! "jolt.host" "interrupt!" jolt-interrupt!)
|
(def-var! "jolt.host" "interrupt!" jolt-interrupt!)
|
||||||
(def-var! "jolt.host" "interrupted?" jolt-interrupted?)
|
(def-var! "jolt.host" "interrupted?" jolt-interrupted?)
|
||||||
(def-var! "jolt.host" "run-interruptible" jolt-run-interruptible)
|
(def-var! "jolt.host" "run-interruptible" jolt-run-interruptible)
|
||||||
|
|
||||||
|
;; --- java.lang.Thread / java.util.concurrent.CountDownLatch -----------------
|
||||||
|
;; Real OS threads over Chez fork-thread (shared heap — a captured atom/var is
|
||||||
|
;; shared). A Thread runs its Runnable thunk; start forks, join waits on a
|
||||||
|
;; condition latched at completion. CountDownLatch is a counting barrier.
|
||||||
|
(define (make-jthread thunk) (make-jhost "user-thread" (vector thunk #f (make-mutex) (make-condition))))
|
||||||
|
(for-each (lambda (nm) (register-class-ctor! nm (lambda (thunk . _) (make-jthread thunk))))
|
||||||
|
'("Thread" "java.lang.Thread"))
|
||||||
|
(register-host-methods! "user-thread"
|
||||||
|
(list (cons "start" (lambda (self)
|
||||||
|
(let ((st (jhost-state self)) (snap (dyn-binding-stack)))
|
||||||
|
(fork-thread (lambda ()
|
||||||
|
(dyn-binding-stack snap)
|
||||||
|
(guard (e (#t #f)) (jolt-invoke (vector-ref st 0)))
|
||||||
|
(with-mutex (vector-ref st 2)
|
||||||
|
(vector-set! st 1 #t)
|
||||||
|
(condition-broadcast (vector-ref st 3)))))
|
||||||
|
jolt-nil)))
|
||||||
|
(cons "run" (lambda (self) (jolt-invoke (vector-ref (jhost-state self) 0)) jolt-nil))
|
||||||
|
(cons "join" (lambda (self . _)
|
||||||
|
(let ((st (jhost-state self)))
|
||||||
|
(with-mutex (vector-ref st 2)
|
||||||
|
(let loop () (unless (vector-ref st 1) (condition-wait (vector-ref st 3) (vector-ref st 2)) (loop)))))
|
||||||
|
jolt-nil))
|
||||||
|
(cons "isAlive" (lambda (self) (not (vector-ref (jhost-state self) 1))))
|
||||||
|
(cons "interrupt" (lambda (self . _) jolt-nil))
|
||||||
|
(cons "setDaemon" (lambda (self . _) jolt-nil))))
|
||||||
|
|
||||||
|
(define (make-jlatch n) (make-jhost "count-down-latch" (vector n (make-mutex) (make-condition))))
|
||||||
|
(for-each (lambda (nm) (register-class-ctor! nm (lambda (n . _) (make-jlatch (jnum->exact n)))))
|
||||||
|
'("CountDownLatch" "java.util.concurrent.CountDownLatch"))
|
||||||
|
(register-host-methods! "count-down-latch"
|
||||||
|
(list (cons "countDown" (lambda (self)
|
||||||
|
(let ((st (jhost-state self)))
|
||||||
|
(with-mutex (vector-ref st 1)
|
||||||
|
(when (> (vector-ref st 0) 0) (vector-set! st 0 (- (vector-ref st 0) 1)))
|
||||||
|
(when (= (vector-ref st 0) 0) (condition-broadcast (vector-ref st 2)))))
|
||||||
|
jolt-nil))
|
||||||
|
(cons "await" (lambda (self . _)
|
||||||
|
(let ((st (jhost-state self)))
|
||||||
|
(with-mutex (vector-ref st 1)
|
||||||
|
(let loop () (when (> (vector-ref st 0) 0) (condition-wait (vector-ref st 2) (vector-ref st 1)) (loop)))))
|
||||||
|
jolt-nil))
|
||||||
|
(cons "getCount" (lambda (self) (vector-ref (jhost-state self) 0)))))
|
||||||
|
|
|
||||||
|
|
@ -211,6 +211,56 @@
|
||||||
(vector->list (hashtable-keys (hm-tbl self)))))))
|
(vector->list (hashtable-keys (hm-tbl self)))))))
|
||||||
(cons "entrySet" (lambda (self) (jolt-seq (hm->pmap self))))
|
(cons "entrySet" (lambda (self) (jolt-seq (hm->pmap self))))
|
||||||
(cons "toString" (lambda (self) (jolt-pr-str (hm->pmap self))))))
|
(cons "toString" (lambda (self) (jolt-pr-str (hm->pmap self))))))
|
||||||
|
;; java.util.concurrent.ConcurrentHashMap — one shared heap, so the mutable
|
||||||
|
;; HashMap shim serves. (get a-hashmap k) reads the map (clojure.core/get).
|
||||||
|
(define (make-hashmap-jhost . args)
|
||||||
|
(let ((ht (make-hashtable hm-hash jolt=2)))
|
||||||
|
(when (and (pair? args) (or (pmap? (car args)) (hm-hashmap? (car args)))) (hm-copy-into! ht (car args)))
|
||||||
|
(make-jhost "hashmap" (vector ht))))
|
||||||
|
(register-class-ctor! "ConcurrentHashMap" make-hashmap-jhost)
|
||||||
|
(register-class-ctor! "java.util.concurrent.ConcurrentHashMap" make-hashmap-jhost)
|
||||||
|
(register-get-arm! (lambda (x) (and (jhost? x) (string=? (jhost-tag x) "hashmap")))
|
||||||
|
(lambda (coll k d) (hashtable-ref (hm-tbl coll) k d)))
|
||||||
|
;; count / contains? over the mutable map shim (clojure.core/count + contains?,
|
||||||
|
;; which core.cache's SoftCache uses on its backing ConcurrentHashMap).
|
||||||
|
(define (jhost-hashmap? x) (and (jhost? x) (string=? (jhost-tag x) "hashmap")))
|
||||||
|
(let ((prev-count jolt-count) (prev-contains jolt-contains?))
|
||||||
|
(set! jolt-count (lambda (c) (if (jhost-hashmap? c) (hashtable-size (hm-tbl c)) (prev-count c))))
|
||||||
|
(set! jolt-contains? (lambda (c k) (if (jhost-hashmap? c)
|
||||||
|
(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))
|
||||||
|
(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 '())))))
|
||||||
|
'("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))))))))
|
||||||
|
|
||||||
;; ---- StringReader -----------------------------------------------------------
|
;; ---- StringReader -----------------------------------------------------------
|
||||||
;; state: a vector #(string pos marked).
|
;; state: a vector #(string pos marked).
|
||||||
|
|
|
||||||
|
|
@ -11,6 +11,10 @@
|
||||||
{:suite "interop / iterator-seq" :label "iterator-seq over .iterator" :expected "[:a :b]" :actual "(vec (iterator-seq (.iterator [:a :b])))"}
|
{:suite "interop / iterator-seq" :label "iterator-seq over .iterator" :expected "[:a :b]" :actual "(vec (iterator-seq (.iterator [:a :b])))"}
|
||||||
{:suite "deftype / IPersistentStack" :label "peek/pop dispatch" :expected "[1 [2 3]]" :actual "(do (deftype Stk [v] clojure.lang.IPersistentStack (peek [_] (first v)) (pop [_] (->Stk (rest v)))) [(peek (->Stk [1 2 3])) (vec (.v (pop (->Stk [1 2 3]))))])"}
|
{:suite "deftype / IPersistentStack" :label "peek/pop dispatch" :expected "[1 [2 3]]" :actual "(do (deftype Stk [v] clojure.lang.IPersistentStack (peek [_] (first v)) (pop [_] (->Stk (rest v)))) [(peek (->Stk [1 2 3])) (vec (.v (pop (->Stk [1 2 3]))))])"}
|
||||||
{:suite "deftype / equiv" :label "(= deftype other) uses equiv method" :expected "true" :actual "(do (deftype EqT [m] clojure.lang.IPersistentCollection (equiv [_ o] (= o m)) clojure.lang.Seqable (seq [_] (seq m))) (= (->EqT {:a 1}) {:a 1}))"}
|
{:suite "deftype / equiv" :label "(= deftype other) uses equiv method" :expected "true" :actual "(do (deftype EqT [m] clojure.lang.IPersistentCollection (equiv [_ o] (= o m)) clojure.lang.Seqable (seq [_] (seq m))) (= (->EqT {:a 1}) {:a 1}))"}
|
||||||
|
{: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 / 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 "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\"))"}
|
{:suite "interop / Class.forName" :label "known class resolves" :expected "\"java.lang.String\"" :actual "(.getName (Class/forName \"java.lang.String\"))"}
|
||||||
{:suite "clojure.string / replace" :label "char match and replacement" :expected "\"a-b-c\"" :actual "(clojure.string/replace \"a/b/c\" \\/ \\-)"}
|
{:suite "clojure.string / replace" :label "char match and replacement" :expected "\"a-b-c\"" :actual "(clojure.string/replace \"a/b/c\" \\/ \\-)"}
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue