diff --git a/compiler/constraint.lisp b/compiler/constraint.lisp
index 132f3d55dd5d19138df5c748227a4da9f2640b8f..ace86bad1bd07aa410ef87d0860bf5055496251e 100644
--- a/compiler/constraint.lisp
+++ b/compiler/constraint.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/constraint.lisp,v 1.12 1992/03/21 19:41:31 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/constraint.lisp,v 1.13 1992/06/03 20:03:37 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -452,27 +452,36 @@
 ;;;
 (defun flow-propagate-constraints (block)
   (let* ((pred (block-pred block))
-	 (in (copy-sset (block-out (first pred)))))
-    (dolist (b (rest pred))
-      (sset-intersection in (block-out b)))
-    (setf (block-in block) in)
+	 (in (cond (pred
+		    (let ((res (copy-sset (block-out (first pred)))))
+		      (dolist (b (rest pred))
+			(sset-intersection res (block-out b)))
+		      res))
+		   (t
+		    (when *check-consistency*
+		      (let ((*compiler-error-context* (block-last block)))
+			(compiler-warning
+			 "*** Unreachable code in constraint ~
+			  propagation...  Bug?")))
+		    (make-sset))))
+	 (kill (block-kill block))
+	 (out (block-out block)))
 
-    (let ((kill (block-kill block))
-	  (out (block-out block)))
-      (cond ((null kill)
-	     (sset-union (block-out block) in))
-	    ((null (rest kill))
-	     (let ((con (lambda-var-constraints (first kill))))
-	       (if con
-		   (sset-union-of-difference out in con)
-		   (sset-union out in))))
-	    (t
-	     (let ((kill-set (make-sset)))
-	       (dolist (var kill)
-		 (let ((con (lambda-var-constraints var)))
-		   (when con
-		     (sset-union kill-set con))))
-	       (sset-union-of-difference (block-out block) in kill-set)))))))
+    (setf (block-in block) in)
+    (cond ((null kill)
+	   (sset-union (block-out block) in))
+	  ((null (rest kill))
+	   (let ((con (lambda-var-constraints (first kill))))
+	     (if con
+		 (sset-union-of-difference out in con)
+		 (sset-union out in))))
+	  (t
+	   (let ((kill-set (make-sset)))
+	     (dolist (var kill)
+	       (let ((con (lambda-var-constraints var)))
+		 (when con
+		   (sset-union kill-set con))))
+	     (sset-union-of-difference (block-out block) in kill-set))))))
 
 
 ;;; CONSTRAINT-PROPAGATE  --  Interface