diff --git a/compiler/envanal.lisp b/compiler/envanal.lisp
index 209a5f5b565c1c5fc234d6db32d55d47972dd2ed..2a73c1e8f35d4839e6cef8190ed6b8565dc1264c 100644
--- a/compiler/envanal.lisp
+++ b/compiler/envanal.lisp
@@ -24,7 +24,10 @@
 ;;;  1] Make an Environment structure for each non-let lambda, assigning the
 ;;;     lambda-environment for all lambdas.
 ;;;  2] Find all values that need to be closed over by each environment.
-;;;  3] Find any unreferenced variables in the lambdas in the component.
+;;;  3] Do summary analysis of this function:
+;;;      -- Record the derived result type before the back-end trashes the
+;;;         flow graph.
+;;;      -- Note if the function doesn't return.
 ;;;  4] Scan the blocks in the component closing over non-local-exit
 ;;;     continuations.
 ;;;  5] Compute a function type for each "real" function.  This is done now
@@ -35,10 +38,19 @@
   (declare (type component component))
   (assert (not (component-new-functions component)))
   (dolist (fun (component-lambdas component))
-    (let ((f (if (eq (functional-kind fun) :external)
-		 (functional-entry-function fun)
-		 fun)))
-      (setf (leaf-type f) (definition-type f)))
+    (let* ((f (if (eq (functional-kind fun) :external)
+		  (functional-entry-function fun)
+		  fun))
+	   (dtype (definition-type f))
+	   (node (lambda-bind fun)))
+      (setf (leaf-type f) dtype)
+      (when (and (eq (function-type-returns dtype) *empty-type*)
+		 (or (functional-entry-function f)
+		     (null (functional-kind f)))
+		 (policy node (>= safety brevity)))
+	(let ((*compiler-error-context* node))
+	  (compiler-note "Function does not return."))))
+
     (get-lambda-environment fun))
   
   (dolist (fun (component-lambdas component))
@@ -91,7 +103,7 @@
 ;;; 
 (defun get-node-environment (node)
   (declare (type node node))
-  (get-lambda-environment (block-lambda (node-block node))))
+  (get-lambda-environment (lexenv-lambda (node-lexenv node))))
 
 
 ;;; Compute-Closure  --  Internal
@@ -149,37 +161,6 @@
 
 ;;;; Non-local exit:
 
-;;; Find-NLX-Cleanup  --  Internal
-;;;
-;;;    Given an Exit node, return the associated cleanup.  We do this by
-;;; scanning up the cleanups from the ending cleanup of the Entry's block,
-;;; looking for an :Entry cleanup whose mess-up is Entry.
-;;;
-;;; If the previous cleanup was a :Catch or :Unwind-Protect, then we return the
-;;; previous cleanup instead, since we want to return the catch or UWP cleanup
-;;; when that is what the exit really represents.  This assumes that the :Catch
-;;; or :Unwind-Protect cleanup is always nested immediately inside the
-;;; corresponding Entry cleanup, and that the catch or UWP mess-up is always
-;;; converted in the same block as the Entry.
-;;;
-(defun find-nlx-cleanup (exit)
-  (declare (type exit exit))
-  (let ((entry (exit-entry exit)))
-    (let ((cleanup (find-enclosing-cleanup
-		    (block-end-cleanup (node-block entry))))
-	  (return-prev nil))
-      (loop
-	(ecase (cleanup-kind cleanup)
-	  (:special-bind
-	   (assert (not return-prev)))
-	  (:entry
-	   (when (eq (continuation-use (cleanup-start cleanup)) entry)
-	     (return (or return-prev cleanup)))
-	   (setq return-prev nil))
-	  ((:catch :unwind-protect)
-	   (setq return-prev cleanup)))
-	(setq cleanup (find-enclosing-cleanup (cleanup-enclosing cleanup)))))))
-
 
 ;;; Insert-NLX-Entry-Stub  --  Internal
 ;;;
@@ -192,29 +173,35 @@
 ;;; the component head.  This leaves the entry stub reachable, but makes the
 ;;; flow graph less confusing to flow analysis.
 ;;;
-;;; The ending cleanup of the entry stub is set to the enclosing cleanup for
-;;; the entry's cleanup, since this represents the dynamic state that was saved
-;;; at mess-up point.  It may be that additional local cleanups need to be done
-;;; before actually transferring control to the destination.
+;;; If a catch or an unwind-protect, then we set the Lexenv for the last node
+;;; in the cleanup code to be the enclosing environment, to represent the fact
+;;; that the binding was undone as a side-effect of the exit.  This will cause
+;;; a lexical exit to be broken up if we are actually exiting the scope (i.e.
+;;; a BLOCK), and will also do any other cleanups that may have to be done on
+;;; the way.
 ;;;
 (defun insert-nlx-entry-stub (exit env)
   (declare (type environment env) (type exit exit))
   (let* ((exit-block (node-block exit))
 	 (next-block (first (block-succ exit-block)))
-	 (cleanup (find-nlx-cleanup exit))
+	 (cleanup (entry-cleanup (exit-entry exit)))
 	 (info (make-nlx-info :cleanup cleanup
 			      :continuation (node-cont exit)))
+	 (entry (exit-entry exit))
 	 (new-block (insert-cleanup-code exit-block next-block
-					 (exit-entry exit)
-					 `(%nlx-entry ',info))))
+					 entry
+					 `(%nlx-entry ',info)
+					 (entry-cleanup entry))))
     (unlink-blocks exit-block new-block)
     (link-blocks (component-head (block-component new-block)) new-block)
     
     (setf (nlx-info-target info) new-block)
     (push info (environment-nlx-info env))
     (push info (cleanup-nlx-info cleanup))
-    (setf (block-end-cleanup new-block) (cleanup-enclosing cleanup)))
-
+    (when (member (cleanup-kind cleanup) '(:catch :unwind-protect))
+      (setf (node-lexenv (block-last new-block))
+	    (node-lexenv entry))))
+  
   (undefined-value))
 
 
@@ -238,7 +225,7 @@
   (declare (type environment env) (type exit exit))
   (let ((entry (exit-entry exit))
 	(cont (node-cont exit))
-	(exit-fun (lambda-home (block-lambda (node-block exit)))))
+	(exit-fun (node-home-lambda exit)))
 
     (if (find-nlx-info entry cont)
 	(let ((block (node-block exit)))
@@ -260,23 +247,21 @@
 
 ;;; Find-Non-Local-Exits  --  Internal
 ;;;
-;;;    Iterate over the blocks in Component, calling Note-Non-Local-Exit when
-;;; we find a block that ends in a non-local Exit node.  We also ensure that
-;;; all Exit nodes are either non-local or degenerate by calling
-;;; IR1-Optimize-Exit on local exits.  This makes life simpler for later
-;;; phases.
+;;;    Iterate over the Exits in Component, calling Note-Non-Local-Exit when we
+;;; find a block that ends in a non-local Exit node.  We also ensure that all
+;;; Exit nodes are either non-local or degenerate by calling IR1-Optimize-Exit
+;;; on local exits.  This makes life simpler for later phases.
 ;;;
 (defun find-non-local-exits (component)
   (declare (type component component))
-  (do-blocks (block component)
-    (let ((last (block-last block)))
-      (when (exit-p last)
-	(let ((target-env (lambda-environment
-			   (block-lambda (first (block-succ block)))))) 
-	    (if (eq (node-environment last) target-env)
-		(unless *converting-for-interpreter*
-		  (maybe-delete-exit last))
-		(note-non-local-exit target-env last))))))
+  (dolist (lambda (component-lambdas component))
+    (dolist (entry (lambda-entries lambda))
+      (dolist (exit (entry-exits entry))
+	(let ((target-env (node-environment entry)))
+	  (if (eq (node-environment exit) target-env)
+	      (unless *converting-for-interpreter*
+		(maybe-delete-exit exit))
+	      (note-non-local-exit target-env exit))))))
 
   (undefined-value))
 
@@ -285,24 +270,25 @@
 
 ;;; Emit-Cleanups  --  Internal
 ;;;
-;;;    Zoom up the Cleanup-Enclosing thread until we hit Cleanup1, accumulating
-;;; cleanup code as we go.  When we are done, convert the cleanup code in an
-;;; implicit MV-Prog1.  We have to force local call analysis of new references
-;;; to Unwind-Protect cleanup functions.
+;;;    Zoom up the cleanup nesting until we hit Cleanup1, accumulating cleanup
+;;; code as we go.  When we are done, convert the cleanup code in an implicit
+;;; MV-Prog1.  We have to force local call analysis of new references to
+;;; Unwind-Protect cleanup functions.  If we don't actually have to do
+;;; anything, then we don't insert any cleanup code.
 ;;;
-;;;    If we don't actually have to do anything, then we don't insert any
-;;; cleanup code.  In this case, we set Block1's End-Cleanup to be the
-;;; Start-Cleanup for block2 to indicate that no cleanup is necessary.
+;;;    We don't need to adjust the ending cleanup of the cleanup block, since
+;;; the cleanup blocks are inserted at the start of the DFO, and are thus never
+;;; scanned.
 ;;;
 (defun emit-cleanups (block1 block2)
   (declare (type cblock block1 block2))
   (collect ((code)
 	    (reanalyze-funs))
-    (let ((cleanup2 (find-enclosing-cleanup (block-start-cleanup block2))))
-      (do ((cleanup (find-enclosing-cleanup (block-end-cleanup block1))
-		    (find-enclosing-cleanup (cleanup-enclosing cleanup))))
+    (let ((cleanup2 (block-start-cleanup block2)))
+      (do ((cleanup (block-end-cleanup block1)
+		    (node-enclosing-cleanup (cleanup-mess-up cleanup))))
 	  ((eq cleanup cleanup2))
-	(let* ((node (continuation-use (cleanup-start cleanup)))
+	(let* ((node (cleanup-mess-up cleanup))
 	       (args (when (basic-combination-p node)
 		       (basic-combination-args node))))
 	  (ecase (cleanup-kind cleanup)
@@ -315,19 +301,16 @@
 	     (let ((fun (ref-leaf (continuation-use (second args)))))
 	       (reanalyze-funs fun)
 	       (code `(%funcall ,fun))))
-	    (:entry
+	    ((:block :tagbody)
 	     (dolist (nlx (cleanup-nlx-info cleanup))
 	       (code `(%lexical-exit-breakup ',nlx)))))))
 
-      (cond ((code)
-	     (let ((block (insert-cleanup-code block1 block2
-					       (block-last block1)
-					       `(progn ,@(code)))))
-	       (setf (block-end-cleanup block) cleanup2))
-	     (dolist (fun (reanalyze-funs))
-	       (local-call-analyze-1 fun)))
-	    (t
-	     (setf (block-end-cleanup block1) cleanup2)))))
+      (when (code)
+	(insert-cleanup-code block1 block2
+			     (block-last block1)
+			     `(progn ,@(code)))
+	(dolist (fun (reanalyze-funs))
+	  (local-call-analyze-1 fun)))))
 
   (undefined-value))
 
@@ -335,22 +318,27 @@
 ;;; Find-Cleanup-Points  --  Internal
 ;;;
 ;;;    Loop over the blocks in component, calling Emit-Cleanups when we see a
-;;; successor in the same environment with a different cleanup.  
+;;; successor in the same environment with a different cleanup.  We ignore the
+;;; cleanup transition if it is to a cleanup enclosed by the current cleanup,
+;;; since in that case we are just messing up the environment, hence this is
+;;; not the place to clean it.
 ;;;
 (defun find-cleanup-points (component)
   (declare (type component component))
   (do-blocks (block1 component)
-    (let ((env1 (lambda-environment (block-lambda block1)))
-	  (cleanup1 (find-enclosing-cleanup (block-end-cleanup block1))))
+    (let ((env1 (block-environment block1))
+	  (cleanup1 (block-end-cleanup block1)))
       (dolist (block2 (block-succ block1))
-	(let ((fun2 (block-lambda block2)))
-	  (when fun2
-	    (let ((env2 (lambda-environment fun2)))
-	      (when (and (eq env2 env1)
-			 (not (eq (find-enclosing-cleanup
-				   (block-start-cleanup block2))
-				  cleanup1)))
-		(emit-cleanups block1 block2))))))))
+	(when (block-start block2)
+	  (let ((env2 (block-environment block2))
+		(cleanup2 (block-start-cleanup block2)))
+	    (unless (or (not (eq env2 env1))
+			(eq cleanup1 cleanup2)
+			(and cleanup2
+			     (eq (node-enclosing-cleanup
+				  (cleanup-mess-up cleanup2))
+				 cleanup1)))
+	      (emit-cleanups block1 block2)))))))
   (undefined-value))