0.9.4.59:

        * Fix compiler failure reported by vrotaru on sbcl-help: the
          main pass of physical environment analysis clears closure
          information made by the prepass.

diff --git a/NEWS b/NEWS
index fbdb0c5..88dbe4c 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -12,7 +12,7 @@ changes in sbcl-0.9.5 relative to sbcl-0.9.4:
     non-threaded mode on non-NPTL systems, but refuse to start entirely.
   * bug fix: interrupts are disabled until startup is complete; no
     more sigsegvs when receiving a signal to soon
-  * optimization: Faster 32-bit SB-ROTATE-BYTE:ROTATE-BYTE on non-x86/ppc
+  * optimization: faster 32-bit SB-ROTATE-BYTE:ROTATE-BYTE on non-x86/ppc
     platforms
   * bug fix: add a workaround for the memory randomization features in
     Linux kernels >= 2.6.12 that interfere with SBCL's memory maps. This
@@ -36,6 +36,9 @@ changes in sbcl-0.9.5 relative to sbcl-0.9.4:
     finalized classes and the FUNCTION class.
   * bug fix: the SB-MOP:METAOBJECT class is now implemented as
     specified by AMOP.
+  * bug fix: flush closure information collected by physical
+    environment analysis prepass before the main pass. (bug reported
+    by vrotaru)
   * threads
     ** bug fix: parent thread now can be gc'ed even with a live
        child thread

diff --git a/src/compiler/physenvanal.lisp b/src/compiler/physenvanal.lisp
index 540b29c..481ce2e 100644 (file)
--- a/src/compiler/physenvanal.lisp
+++ b/src/compiler/physenvanal.lisp
@@ -88,18 +88,13 @@
           res))))
 
 ;;; If FUN has no physical environment, assign one, otherwise clean up
-;;; the old physical environment, removing/flagging variables that
-;;; have no sets or refs. If a var has no references, we remove it
-;;; from the closure. We always clear the INDIRECT flag. This is
-;;; necessary because pre-analysis is done before optimization.
+;;; the old physical environment and the INDIRECT flag on LAMBDA-VARs.
+;;; This is necessary because pre-analysis is done before
+;;; optimization.
 (defun reinit-lambda-physenv (fun)
   (let ((old (lambda-physenv (lambda-home fun))))
     (cond (old
-           (setf (physenv-closure old)
-                 (delete-if (lambda (x)
-                              (and (lambda-var-p x)
-                                   (null (leaf-refs x))))
-                            (physenv-closure old)))
+           (setf (physenv-closure old) nil)
            (flet ((clear (fun)
                     (dolist (var (lambda-vars fun))
                       (setf (lambda-var-indirect var) nil))))

diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp
index 5e07aba..44f7396 100644 (file)
--- a/tests/compiler.impure-cload.lisp
+++ b/tests/compiler.impure-cload.lisp
@@ -448,3 +448,45 @@
 (progv '(*hannu-trap*) '()
   (setq *hannu-trap* t))
 (assert (not *hannu-trap*))
+
+;;; bug reported on sbcl-help by vrotaru
+(let* ((initial-size (expt 2 16))
+       (prime-table (make-array initial-size
+                                :element-type 'integer))
+       (first-primes #(5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71
+       73
+                      79 83 89 97 101 103 107 109 113 127 131 137 139 149
+                      151 157 163 167 173 179 181 191 193 197 199 211 223
+                      227 229 233 239 241 251 257 263 269 271 277 281))
+       (count 0)
+       (increment 2))
+  
+  (defun largest-prime-so-far ()
+    (aref prime-table (1- count)))
+  (defun add-prime (prime)
+    (setf (aref prime-table count) prime) (incf count))
+  (defun init-table ()
+    (map 'nil #'add-prime first-primes))
+  (defun next-candidate (candidate)
+    (prog1 (+ candidate increment)
+      (ecase increment
+        (2 (setf increment 4))
+        (4 (setf increment 2)))))
+  (defun prime-p (n)
+    (let ((sqrt-n (truncate (sqrt n))))
+      (dotimes (i count)
+        (let ((prime (aref prime-table i)))
+          (when (> prime sqrt-n)
+            (return-from prime-p t))
+          (when (zerop (mod n prime))
+            (return-from prime-p nil))))
+      (error "~&prime-table too small: ~A ~A~%" n
+      (largest-prime-so-far))))
+  (defun generate-primes (required)
+    (do ((candidate (next-candidate (largest-prime-so-far))
+                    (next-candidate candidate)))
+        ((> candidate required))
+      (when (prime-p candidate)
+        (add-prime candidate))))
+  ;;
+  (init-table))

diff --git a/version.lisp-expr b/version.lisp-expr
index b0fe04d..d7346b4 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".)
-"0.9.4.58"
+"0.9.4.59"