From db770d287bb64a58967d08fdd8225c02cdd4d45a Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Fri, 14 Mar 2008 20:41:25 +0000 Subject: [PATCH] 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%. --- contrib/sb-bsd-sockets/inet.lisp | 2 +- src/code/unix.lisp | 4 ++-- src/pcl/cache.lisp | 15 ++++++++++----- version.lisp-expr | 2 +- 4 files changed, 14 insertions(+), 9 deletions(-) diff --git a/contrib/sb-bsd-sockets/inet.lisp b/contrib/sb-bsd-sockets/inet.lisp index 716095c..57ab02c 100644 --- a/contrib/sb-bsd-sockets/inet.lisp +++ b/contrib/sb-bsd-sockets/inet.lisp @@ -25,7 +25,7 @@ Examples: \"127.0.0.1\". Signals an error if the string is malformed." (declare (type string dotted-quads)) (labels ((oops () - (error "~S is not a string designating an IP address." + (error "~S is not a string designating an IP address." dotted-quads)) (check (x) (if (typep x '(unsigned-byte 8)) diff --git a/src/code/unix.lisp b/src/code/unix.lisp index f5f28ca..368665e 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -113,9 +113,9 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." #!-win32 (define-alien-routine ("getenv" posix-getenv) c-string - "Return the \"value\" part of the environment string \"name=value\" which + "Return the \"value\" part of the environment string \"name=value\" which corresponds to NAME, or NIL if there is none." - (name c-string)) + (name c-string)) ;;; from stdio.h 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 diff --git a/version.lisp-expr b/version.lisp-expr index c23cce7..0ebe39b 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.15.33" +"1.0.15.34" -- 1.7.10.4