diff --git a/compiler/macros.lisp b/compiler/macros.lisp
index 708b12cea0e957e2a4642863ccbf6969e3216b7e..f6ec8411c1ebef3a766b91840d6a634b235f03d2 100644
--- a/compiler/macros.lisp
+++ b/compiler/macros.lisp
@@ -648,34 +648,52 @@
 ;;;
 ;;;    In the forward case, we terminate on Last-Cont so that we don't have to
 ;;; worry about our termination condition being changed when new code is added
-;;; during the iteration.  If CONT gets deleted out from under us, go again
-;;; from the previous CONT.  In the backward case, we do NODE-PREV before
+;;; during the iteration.  In the backward case, we do NODE-PREV before
 ;;; evaluating the body so that we can keep going when the current node is
 ;;; deleted.
 ;;;
-(defmacro do-nodes ((node-var cont-var block &optional result) &body body)
-  "Do-Nodes (Node-Var Cont-Var Block [Result]) {Declaration}* {Form}*
+;;; When Restart-P is supplied to DO-NODES, we start iterating over again at
+;;; the beginning of the block when we run into a continuation whose block
+;;; differs from the one we are trying to iterate over, either beacuse the
+;;; block was split, or because a node was deleted out from under us (hence its
+;;; block is NIL.)  If the block start is deleted, we just punt.  With
+;;; Restart-P, we are also more careful about termination, re-indirecting the
+;;; BLOCK-LAST each time.
+;;;
+(defmacro do-nodes ((node-var cont-var block &key restart-p) &body body)
+  "Do-Nodes (Node-Var Cont-Var Block {Key Value}*) {Declaration}* {Form}*
   Iterate over the nodes in Block, binding Node-Var to the each node and
-  Cont-Var to the node's Cont."
+  Cont-Var to the node's Cont.  The only keyword option is Restart-P, which
+  causes iteration to be restarted when a node is deleted out from under us (if
+  not supplied, this is an error.)"
   (let ((n-block (gensym))
-	(n-last-cont (gensym))
-	(n-prev-cont (gensym)))
+	(n-last-cont (gensym)))
     `(let* ((,n-block ,block)
-	    (,n-last-cont (node-cont (block-last ,n-block))))
+	    ,@(unless restart-p
+		`((,n-last-cont (node-cont (block-last ,n-block))))))
        (do* ((,node-var (continuation-next (block-start ,n-block))
-			(if (eq (continuation-kind ,cont-var) :deleted)
-			    (continuation-next ,n-prev-cont)
-			    (continuation-next ,cont-var)))
-	     (,n-prev-cont nil ,cont-var)
+			,(if restart-p
+			     `(cond
+			       ((eq (continuation-block ,cont-var) ,n-block)
+				(assert (continuation-next ,cont-var))
+				(continuation-next ,cont-var))
+			       (t
+				(let ((start (block-start ,n-block)))
+				  (unless (eq (continuation-kind start)
+					      :block-start)
+				    (return nil))
+				  (continuation-next start))))
+			     `(continuation-next ,cont-var)))
 	     (,cont-var (node-cont ,node-var) (node-cont ,node-var)))
 	    (())
 	 ,@body
-	 (when (eq ,cont-var ,n-last-cont)
-	   (return ,result))))))
+	 (when ,(if restart-p
+		    `(eq ,node-var (block-last ,n-block))
+		    `(eq ,cont-var ,n-last-cont))
+	   (return nil))))))
 ;;;
-(defmacro do-nodes-backwards ((node-var cont-var block &optional result)
-			      &body body)
-  "Do-Nodes-Backwards (Node-Var Cont-Var Block [Result]) {Declaration}* {Form}*
+(defmacro do-nodes-backwards ((node-var cont-var block) &body body)
+  "Do-Nodes-Backwards (Node-Var Cont-Var Block) {Declaration}* {Form}*
   Like Do-Nodes, only iterates in reverse order."
   (let ((n-block (gensym))
 	(n-start (gensym))
@@ -690,7 +708,7 @@
 	    (())
 	 ,@body
 	 (when (eq ,n-next ,n-start)
-	   (return ,result))))))
+	   (return nil))))))
 
 
 ;;; With-IR1-Environment  --  Interface
@@ -749,7 +767,7 @@
 ;;;    These functions are called by the expansion of the Defprinter
 ;;; macro to do the actual printing.
 ;;;
-(proclaim '(ftype (function (symbol t stream) void)
+(proclaim '(ftype (function (symbol t stream &optional t) void)
 		  defprinter-prin1 defprinter-princ))
 (defun defprinter-prin1 (name value stream &optional indent)
   (declare (ignore indent))