From: Nikodemus S. <de...@us...> - 2008-03-14 20:41:31
|
Update of /cvsroot/sbcl/sbcl/src/pcl In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv26928/src/pcl Modified Files: cache.lisp Log Message: 1.0.15.34: tweak the PCL cache improvement from 1.0.15.12 * Thanks to Paul Khuong for noting that we weren't actually dropping 50% of the entries, but somewhat less. Now (assuming our RANDOM is good) we really should average 50%. Index: cache.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/cache.lisp,v retrieving revision 1.61 retrieving revision 1.62 diff -u -d -r1.61 -r1.62 --- cache.lisp 3 Mar 2008 19:34:18 -0000 1.61 +++ cache.lisp 14 Mar 2008 20:41:26 -0000 1.62 @@ -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 |