-
-
Notifications
You must be signed in to change notification settings - Fork 68
/
gc.clj
85 lines (64 loc) · 2.12 KB
/
gc.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
(ns libpython-clj2.python.gc
"Binding of various sort of gc semantics optimized specifically for
libpython-clj."
(:import [java.util.concurrent ConcurrentHashMap ConcurrentLinkedDeque]
[java.lang.ref ReferenceQueue]
[tech.resource GCReference]))
(set! *warn-on-reflection* true)
(defonce ^:dynamic *stack-gc-context* nil)
(defn stack-context
^ConcurrentLinkedDeque []
*stack-gc-context*)
(defonce reference-queue-var (ReferenceQueue.))
(defn reference-queue
^ReferenceQueue []
reference-queue-var)
(defonce ptr-set-var (ConcurrentHashMap/newKeySet))
(defn ptr-set
^java.util.Set []
ptr-set-var)
(defn track
[item dispose-fn]
(let [stack-context (stack-context)]
(if (= stack-context :disabled)
item
(let [ptr-val (GCReference. item (reference-queue) (fn [ptr-val]
(.remove (ptr-set) ptr-val)
(dispose-fn)))]
;;We have to keep track of the pointer. If we do not the pointer gets gc'd then
;;it will not be put on the reference queue when the object itself is gc'd.
;;Nice little gotcha there.
(if stack-context
(.add ^ConcurrentLinkedDeque stack-context ptr-val)
;;Ensure we don't lose track of the weak reference. If it gets cleaned up
;;the gc system will fail.
(.add (ptr-set) ptr-val))
item))))
(defn clear-reference-queue
[]
(when-let [next-ref (.poll (reference-queue))]
(.run ^Runnable next-ref)
(recur)))
(defn clear-stack-context
[]
(when-let [next-ref (.pollLast (stack-context))]
(.run ^Runnable next-ref)
(recur)))
(defmacro with-stack-context
[& body]
`(with-bindings {#'*stack-gc-context* (ConcurrentLinkedDeque.)}
(try
~@body
(finally
(clear-stack-context)))))
(defmacro with-disabled-gc
[& body]
`(with-bindings {#'*stack-gc-context* :disabled}
~@body))
(defn gc-context
[]
*stack-gc-context*)
(defmacro with-gc-context
[gc-ctx & body]
`(with-bindings {#'*stack-gc-context* ~gc-ctx}
~@body))