diff --git a/BUGS b/BUGS index 937549c4f..af0d84714 100644 --- 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 8429f984d..f5f7b3c02 100644 --- 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 09ad701a5..ccb901f9d 100644 --- 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 2dcfc4dd3..6fcb1e7a1 100644 --- 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 5034636e6..b1b81c443 100644 --- 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