0.7.9.24:

        Committed patch for the bug 166 (APD sbcl-devel 2002-05-10)

diff --git a/BUGS b/BUGS
index 937549c..af0d847 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -781,31 +781,6 @@ WORKAROUND:
   isn't too surprising since there are many differences in stack
   implementation and GC conservatism between the X86 and other ports.)
 
-166:
-  Compiling 
-    (in-package :cl-user)
-    (defstruct uustk)
-    (defmethod permanentize ((uustk uustk))
-      (flet ((frob (hash-table test-for-deletion)
-               )
-             (obj-entry.stale? (oe)
-               (destructuring-bind (key . datum) oe
-                 (declare (type simple-vector key))
-                 (deny0 (void? datum))
-                 (some #'stale? key))))
-        (declare (inline frob obj-entry.stale?))
-        (frob (uustk.args-hash->obj-alist uustk)
-              #'obj-entry.stale?)
-        (frob (uustk.hash->memoized-objs-list uustk)
-              #'objs.stale?))
-      (call-next-method))
-  in sbcl-0.7.3.11 causes an assertion failure, 
-    failed AVER:
-      "(NOT
-(AND (NULL (BLOCK-SUCC B))
-      (NOT (BLOCK-DELETE-P B))
-      (NOT (EQ B (COMPONENT-HEAD #)))))"
-
 167:
   In sbcl-0.7.3.11, compiling the (illegal) code 
     (in-package :cl-user)

diff --git a/NEWS b/NEWS
index 8429f98..f5f7b3c 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1363,6 +1363,8 @@ changes in sbcl-0.7.10 relative to sbcl-0.7.9:
         correct order
      ** MULTIPLE-VALUE-SETQ evaluates side-effectful places before
         value producing form
+   * fixed bug 166: compiler preserves "there is a way to go"
+     invariant when deleting code
 
 planned incompatible changes in 0.7.x:
 * When the profiling interface settles down, maybe in 0.7.x, maybe

diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp
index 09ad701..ccb901f 100644 (file)
--- a/src/compiler/ir1-translators.lisp
+++ b/src/compiler/ir1-translators.lisp
@@ -299,8 +299,7 @@
   "MACROLET ({(Name Lambda-List Form*)}*) Body-Form*
   Evaluate the Body-Forms in an environment with the specified local macros
   defined. Name is the local macro name, Lambda-List is the DEFMACRO style
-  destructuring lambda list, and the Forms evaluate to the expansion. The
-  Forms are evaluated in the null environment."
+  destructuring lambda list, and the Forms evaluate to the expansion.."
   (funcall-in-macrolet-lexenv
    definitions
    (lambda (&key funs)

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 2dcfc4d..6fcb1e7 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -282,9 +282,9 @@
       ;; exception).
       (labels ((mark-blocks (block)
                  (dolist (pred (block-pred block))
-                   (when (and (not (block-delete-p pred))
-                              (eq (functional-kind (block-home-lambda pred))
-                                  :deleted))
+                   (unless (or (block-delete-p pred)
+                               (eq (component-head (block-component pred))
+                                   pred))
                      (setf (block-delete-p pred) t)
                      (mark-blocks pred)))))
         (mark-blocks block)

diff --git a/tests/compiler-1.impure-cload.lisp b/tests/compiler-1.impure-cload.lisp
index 5034636..b1b81c4 100644 (file)
--- a/tests/compiler-1.impure-cload.lisp
+++ b/tests/compiler-1.impure-cload.lisp
@@ -121,5 +121,22 @@
 (defun bug221 (b x)
   (funcall (if b #'bug221-f1 #'bug221-f2) x))
 
+;;; bug 166: compiler failure
+(defstruct bug166s)
+(defmethod permanentize ((uustk bug166s))
+  (flet ((frob (hash-table test-for-deletion)
+           )
+         (obj-entry.stale? (oe)
+           (destructuring-bind (key . datum) oe
+             (declare (type simple-vector key))
+             (deny0 (void? datum))
+             (some #'stale? key))))
+    (declare (inline frob obj-entry.stale?))
+    (frob (uustk.args-hash->obj-alist uustk)
+          #'obj-entry.stale?)
+    (frob (uustk.hash->memoized-objs-list uustk)
+          #'objs.stale?))
+  (call-next-method))
+
 (sb-ext:quit :unix-status 104) ; success