X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fcache.lisp;h=e7f60e4d6502f28b7319652849c274c9c99cc9f4;hb=dc5d8cef786c974258601109f79ab18f874b1270;hp=3204dbef49fbafb934cf283ad06569bf385e5301;hpb=229d5b35ac98f606f24c90d8e5cc037cae3829cd;p=sbcl.git

diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp
index 3204dbe..e7f60e4 100644
--- a/src/pcl/cache.lisp
+++ b/src/pcl/cache.lisp
@@ -322,6 +322,8 @@
         ;; 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)
@@ -362,13 +364,16 @@
                       ;; 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)
-                            (when (logbitp 0 drops)
+                            (when (logbitp (the unsigned-byte (decf drop-pos)) drops)
                               (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