1.0.6.47: small fixes

 * When expanding the CLOS cache, insert the new value before copying
   the old ones, in order to ensure that FILL-CACHE always terminations.

 * Cancel deadline before signalling the DEADLINE-ERROR, so that same
   deadline cannot be caught again during unwind.

diff --git a/src/code/deadline.lisp b/src/code/deadline.lisp
index 757e4d9..4ea6e72 100644 (file)
--- a/src/code/deadline.lisp
+++ b/src/code/deadline.lisp
@@ -65,6 +65,7 @@ deadlines while the condition is being handled."
   ;; FIXME: Maybe we should make ERROR do WITH-INTERRUPTS instead of
   ;; putting it all over the place (now that we have ALLOW-WITH-INTERRUPTS.)
   (with-interrupts
+    ;; Don't signal a deadline while handling a non-deadline timeout.
     (let ((*deadline* nil))
       (apply #'error datum arguments))))
 
@@ -72,6 +73,10 @@ deadlines while the condition is being handled."
   #!+sb-doc
   "Signal a DEADLINE-TIMEOUT condition. Implementors of blocking functions
 are responsible for calling this when a deadline is reached."
+  ;; Make sure we don't signal the same deadline twice. LET is not good
+  ;; enough: we might catch the same deadline again while unwinding.
+  (when *deadline*
+    (setf *deadline* nil))
   (signal-timeout 'deadline-timeout :seconds *deadline-seconds*))
 
 ;;; Returns TIMEOUT-SEC, TIMEOUT-USEC, DEADLINE-SEC, DEADLINE-USEC, SIGNALP

diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp
index d6afcc0..b4d3e9d 100644 (file)
--- a/src/pcl/cache.lisp
+++ b/src/pcl/cache.lisp
@@ -337,7 +337,7 @@
 
 ;;;; 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+)
@@ -351,6 +351,11 @@
              (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
@@ -413,7 +418,7 @@
                 ;; 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))))

diff --git a/version.lisp-expr b/version.lisp-expr
index a6682f8..57aad90 100644 (file)
--- 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.6.46"
+"1.0.6.47"