;; (mod index (length vector))
;; using a bitmask.
(vector #() :type simple-vector)
- ;; The bitmask used to calculate (mod (* line-size line-hash) (length vector))).
+ ;; The bitmask used to calculate
+ ;; (mod (* line-size line-hash) (length vector))).
(mask 0 :type fixnum)
;; Current probe-depth needed in the cache.
(depth 0 :type index)
;;;; Copies and expands the cache, dropping any invalidated or
;;;; incomplete lines.
-(defun copy-and-expand-cache (cache)
+(defun copy-and-expand-cache (cache layouts value)
(let ((copy (%copy-cache cache))
(length (length (cache-vector cache))))
(when (< length +cache-vector-max-length+)
(setf length (* 2 length)))
(tagbody
:again
- (setf (cache-vector copy) (make-array length :initial-element '..empty..)
+ ;; Blow way the old vector first, so a GC potentially triggered by
+ ;; MAKE-ARRAY can collect it.
+ (setf (cache-vector copy) #()
+ (cache-vector copy) (make-array length :initial-element '..empty..)
(cache-depth copy) 0
(cache-mask copy) (compute-cache-mask length (cache-line-size cache))
(cache-limit copy) (compute-limit (/ length (cache-line-size cache))))
+ ;; First insert the new one -- if we don't do this first and
+ ;; the cache has reached it's maximum size we may end up
+ ;; looping in FILL-CACHE.
+ (unless (try-update-cache copy layouts value)
+ (bug "Could not insert ~S:~S to supposedly empty ~S." layouts value cache))
(map-cache (lambda (layouts value)
(unless (try-update-cache copy layouts value)
;; If the cache would grow too much we drop the
;; we just drop the invalid entries.
(%fill-cache (copy-cache cache) layouts value))
(t
- (%fill-cache (copy-and-expand-cache cache) layouts value)))))
+ (copy-and-expand-cache cache layouts value)))))
(if (listp layouts)
(%fill-cache cache layouts value)
(%fill-cache cache (list layouts) value))))