projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
1.0.21.22: COMPILE-FILE and toplevel symbols
[sbcl.git]
/
src
/
pcl
/
cache.lisp
diff --git
a/src/pcl/cache.lisp
b/src/pcl/cache.lisp
index
3204dbe
..
73c197b
100644
(file)
--- a/
src/pcl/cache.lisp
+++ b/
src/pcl/cache.lisp
@@
-104,11
+104,6
@@
;; bits at the low end.
(logand (1- vector-length) (- line-size)))
;; bits at the low end.
(logand (1- vector-length) (- line-size)))
-;;; The smallest power of two that is equal to or greater then X.
-(declaim (inline power-of-two-ceiling))
-(defun power-of-two-ceiling (x)
- (ash 1 (integer-length (1- x))))
-
(defun cache-statistics (cache)
(let* ((vector (cache-vector cache))
(size (length vector))
(defun cache-statistics (cache)
(let* ((vector (cache-vector cache))
(size (length vector))
@@
-322,6
+317,8
@@
;; Make a smaller one, then
(make-cache :key-count key-count :value value :size (ceiling size 2)))))
;; Make a smaller one, then
(make-cache :key-count key-count :value value :size (ceiling size 2)))))
+(defconstant n-fixnum-bits #.(integer-length most-positive-fixnum))
+
;;;; Copies and expands the cache, dropping any invalidated or
;;;; incomplete lines.
(defun copy-and-expand-cache (cache layouts value)
;;;; Copies and expands the cache, dropping any invalidated or
;;;; incomplete lines.
(defun copy-and-expand-cache (cache layouts value)
@@
-362,13
+359,16
@@
;; analysis...
(flet ((random-fixnum ()
(random (1+ most-positive-fixnum))))
;; analysis...
(flet ((random-fixnum ()
(random (1+ most-positive-fixnum))))
- (let ((drops (random-fixnum)))
- (declare (fixnum drops))
+ (let ((drops (random-fixnum))
+ (drop-pos n-fixnum-bits))
+ (declare (fixnum drops)
+ (type (integer 0 #.n-fixnum-bits) drop-pos))
(lambda (layouts value)
(lambda (layouts value)
- (when (logbitp 0 drops)
+ (when (logbitp (the unsigned-byte (decf drop-pos)) drops)
(try-update-cache copy layouts value))
(try-update-cache copy layouts value))
- (when (zerop (ash drops -1))
- (setf drops (random-fixnum))))))
+ (when (zerop drop-pos)
+ (setf drops (random-fixnum)
+ drop-pos n-fixnum-bits)))))
(lambda (layouts value)
(unless (try-update-cache copy layouts value)
;; Didn't fit -- expand the cache, or drop
(lambda (layouts value)
(unless (try-update-cache copy layouts value)
;; Didn't fit -- expand the cache, or drop