-
Notifications
You must be signed in to change notification settings - Fork 1
/
lru.lisp
155 lines (140 loc) · 4.29 KB
/
lru.lisp
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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
(in-package :orcinus-cache)
(defclass lru-cache ()
((size :type fixnum
:initarg :csize
:reader csize)
(fmsk :initarg :fmsk
:reader fmsk)
(emsk :initarg :emsk
:reader emsk)
(mat :initarg :mat
:reader mat)
(aval :initarg :aval
:reader aval)
(ht :initarg :ht
:reader ht)
(iht :initarg :iht
:reader iht)
(default-src-fn
:initarg :dsrcfn
:reader dsrcfn)
(default-windup-fn
:initarg :dwindfn
:reader dwindfn)))
(defmethod print-object ((inst lru-cache) stream)
(print-unreadable-object (inst stream :type t)
(format stream "~%size: ~s~%mat : ~s~%aval: ~s"
(csize inst) (mat inst) (aval inst))))
(defmacro lru-init (size src-fn windup-fn &key vtype (test 'equal))
(unless (constantp size)
(error "Cache size must be a constant fixnum."))
(let ((chc (make-array size
:element-type `(simple-bit-vector ,size))))
(dotimes (i size)
(setf (aref chc i)
(make-array size
:element-type 'bit)))
`(make-instance 'lru-cache
:csize ,size
:fmsk (make-array ,size
:initial-element 1
:element-type 'bit)
:emsk (make-array ,size
:initial-element 0
:element-type 'bit)
:mat ,chc
:aval (if ,vtype
(make-array ,size :element-type ,vtype)
(make-array ,size :initial-element nil))
:ht (make-hash-table :test #',test)
:iht (make-array ,size :initial-element nil)
:dsrcfn ,src-fn
:dwindfn ,windup-fn)))
(defmacro reset-row-bits (pos empty-mask mat)
`(bit-and (aref ,mat ,pos) ,empty-mask (aref ,mat ,pos)))
(defmethod direct-update ((inst lru-cache) pos)
(with-slots (size fmsk mat) inst
(bit-ior (aref mat pos)
fmsk
(aref mat pos))
(dotimes (i size)
(declare (type fixnum i))
(setf (aref (aref mat i) pos) 0))
inst))
(defmethod get-lu ((inst lru-cache))
(loop
for i fixnum from 0
for row simple-bit-vector across (mat inst)
when (equal row (emsk inst))
do (return i)))
(defmacro! rplacache (inst o!key o!val &key windup)
`(with-slots (aval ht iht default-src-fn default-windup-fn) ,inst
(let* ((pos (get-lu ,inst))
(windup-res
(aif (aref aval pos)
(with-gc
(funcall (or ,windup default-windup-fn) it)))))
(remhash (aref iht pos) ht)
(setf (aref iht pos) ,g!key
(aref aval pos) (with-gc ,g!val)
(gethash ,g!key ht) pos)
(direct-update ,inst pos)
(values ,g!val windup-res))))
(defmethod lru-get ((inst lru-cache) key &rest src-args
&key src windup)
(sb-sys:without-gcing
(with-slots (aval ht iht default-src-fn default-windup-fn) inst
(aif (gethash key ht)
(multiple-value-prog1
(values (aref aval it) nil)
(direct-update inst it))
(rplacache inst key (apply (or src default-src-fn)
(cons key src-args))
:windup windup)))))
(defmethod lru-set ((inst lru-cache) key val &key windup)
(sb-sys:without-gcing
(with-slots (aval mat ht iht default-windup-fn) inst
(aif (gethash key ht)
(multiple-value-prog1
(values (setf (aref aval it) val) nil)
(direct-update inst it))
(rplacache inst key val :windup windup)))))
(defmethod lru-rem ((inst lru-cache) key &key windup)
(sb-sys:without-gcing
(with-slots (mat emsk aval ht default-windup-fn) inst
(awhen (gethash key ht)
(reset-row-bits it emsk mat)
(setf (gethash key ht) nil)
(aif (aref aval it)
(with-gc
(funcall (or windup default-windup-fn) it)))))))
(defmethod lru-fclr ((inst lru-cache))
(sb-sys:without-gcing
(with-slots (size emsk mat aval ht iht) inst
(loop
for key being the hash-keys in ht
do (remhash key ht))
(loop
for i fixnum from 0 below size
do
(bit-and (aref mat i)
emsk
(aref mat i))))))
(defmethod lru-clr ((inst lru-cache) &key windup)
(sb-sys:without-gcing
(with-slots (size emsk mat aval ht iht default-windup-fn) inst
(loop
for key being the hash-keys in ht
do (remhash key ht))
(loop
with windup-fn = (or windup default-windup-fn)
for i fixnum from 0 below size
collect (aif (aref aval i)
(with-gc
(funcall windup-fn it)))
do
(setf (aref aval i) nil
(aref iht i) nil)
(bit-and (aref mat i)
emsk
(aref mat i))))))