0.8.4.11:

        * Fix bug found by WHN and Paul Dietz: do not replace optional
          dispatch with an entry point in a block to be deleted.

diff --git a/BUGS b/BUGS
index 0185dc7..dd0e902 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -961,11 +961,6 @@ WORKAROUND:
 
   b. The same for CSUBTYPEP.
 
-261:
-    * (let () (list (the (values &optional fixnum) (eval '(values)))))
-    debugger invoked on condition of type TYPE-ERROR:
-      The value NIL is not of type FIXNUM.
-
 262: "yet another bug in inline expansion of local functions"
   Compiler fails on
 

diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index 849d66e..46e9e85 100644 (file)
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -713,7 +713,6 @@
             :format-arguments (list (namestring pathname))))
     result))
 
-;;; If PATHNAME exists, return its truename, otherwise NIL.
 (defun probe-file (pathname)
   #!+sb-doc
   "Return a pathname which is the truename of the file if it exists, or NIL

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 5e14d26..e41c094 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -324,6 +324,13 @@
 (defun node-dest (node)
   (awhen (node-lvar node) (lvar-dest it)))
 
+;;; Checks whether NODE is in a block to be deleted
+(declaim (inline node-to-be-deleted-p))
+(defun node-to-be-deleted-p (node)
+  (let ((block (node-block node)))
+    (or (block-delete-p block)
+        (eq (functional-kind (block-home-lambda block)) :deleted))))
+
 (declaim (ftype (sfunction (clambda) cblock) lambda-block))
 (defun lambda-block (clambda)
   (node-block (lambda-bind clambda)))

diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index a1253e2..a4bf8fa 100644 (file)
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -234,22 +234,21 @@
 ;;; do LET conversion here.
 (defun locall-analyze-fun-1 (fun)
   (declare (type functional fun))
-  (let ((refs (leaf-refs fun))
-       (first-time t))
+  (let ((refs (leaf-refs fun)))
     (dolist (ref refs)
       (let* ((lvar (node-lvar ref))
             (dest (when lvar (lvar-dest lvar))))
-       (cond ((and (basic-combination-p dest)
-                   (eq (basic-combination-fun dest) lvar)
-                   (eq (lvar-uses lvar) ref))
+        (unless (node-to-be-deleted-p ref)
+          (cond ((and (basic-combination-p dest)
+                      (eq (basic-combination-fun dest) lvar)
+                      (eq (lvar-uses lvar) ref))
 
-              (convert-call-if-possible ref dest)
+                 (convert-call-if-possible ref dest)
 
-              (unless (eq (basic-combination-kind dest) :local)
-                (reference-entry-point ref)))
-             (t
-              (reference-entry-point ref))))
-      (setq first-time nil)))
+                 (unless (eq (basic-combination-kind dest) :local)
+                   (reference-entry-point ref)))
+                (t
+                 (reference-entry-point ref)))))))
 
   (values))
 
@@ -393,8 +392,7 @@
         (original-fun (ref-leaf ref)))
     (aver (functional-p original-fun))
     (unless (or (member (basic-combination-kind call) '(:local :error))
-               (block-delete-p block)
-               (eq (functional-kind (block-home-lambda block)) :deleted)
+                (node-to-be-deleted-p call)
                (member (functional-kind original-fun)
                        '(:toplevel-xep :deleted))
                (not (or (eq (component-kind component) :initial)
@@ -1032,9 +1030,7 @@
          (when (and (basic-combination-p dest)
                     (eq (basic-combination-fun dest) ref-lvar)
                     (eq (basic-combination-kind dest) :local)
-                    (not (block-delete-p (node-block dest)))
-                     (neq (functional-kind (node-home-lambda dest))
-                          :deleted)
+                     (not (node-to-be-deleted-p dest))
                     (cond ((ok-initial-convert-p clambda) t)
                           (t
                            (reoptimize-lvar ref-lvar)

diff --git a/tests/compiler.pure-cload.lisp b/tests/compiler.pure-cload.lisp
index 85b484d..b61f5e5 100644 (file)
--- a/tests/compiler.pure-cload.lisp
+++ b/tests/compiler.pure-cload.lisp
@@ -143,3 +143,7 @@
                              (make-array 1 :element-type '(unsigned-byte 32)
                                          :initial-element n))
                     nil)))))))
+
+;;; bug 261
+(let ((x (list (the (values &optional fixnum) (eval '(values))))))
+  (assert (equal x '(nil))))

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 9776ae2..9525cca 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -643,3 +643,35 @@
                                (ash x -257)))
                    1024)
           0))
+
+;;; bug found by WHN and pfdietz: compiler failure while referencing
+;;; an entry point inside a deleted lambda
+(compile nil '(lambda ()
+               (let (r3533)
+                 (flet ((bbfn ()
+                          (setf r3533
+                                (progn
+                                  (flet ((truly (fn bbd)
+                                           (let (r3534)
+                                             (let ((p3537 nil))
+                                               (unwind-protect
+                                                    (multiple-value-prog1
+                                                        (progn
+                                                          (setf r3534
+                                                                (progn
+                                                                  (bubf bbd t)
+                                                                  (flet ((c-3536 ()
+                                                                           (funcall fn)))
+                                                                    (cdec #'c-3536
+                                                                          (vector bbd))))))
+                                                      (setf p3537 t))
+                                                 (unless p3537
+                                                   (error "j"))))
+                                             r3534))
+                                         (c (pd) (pdc pd)))
+                                    (let ((a (smock a))
+                                          (b (smock b))
+                                          (b (smock c)))))))))
+                   (wum #'bbfn "hc3" (list)))
+                 r3533)))
+(compile nil '(lambda () (flet ((%f () (unwind-protect nil))) nil)))

diff --git a/version.lisp-expr b/version.lisp-expr
index 48b5683..0e72f46 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.8.4.10"
+"0.8.4.11"