diff --git a/compiler/checkgen.lisp b/compiler/checkgen.lisp
index ed3bf64c8493340cc9e131890d9126f67a670264..96c9aba1d509c81d55cf55cd0e414ed4d8e6ee1a 100644
--- a/compiler/checkgen.lisp
+++ b/compiler/checkgen.lisp
@@ -142,18 +142,19 @@
 ;;; whether it is cheaper to then difference between the the proven type and
 ;;; the corresponding type in Types.  If so, we opt for a :HAIRY check with
 ;;; that test negated.  Otherwise, we try to do a simple test, and if that is
-;;; impossible, we do a hairy test with non-negated types.
+;;; impossible, we do a hairy test with non-negated types.  If true,
+;;; Force-Hairy forces a hairy type check.
 ;;;
 ;;;    When doing a non-negated hairy check, we call MAYBE-WEAKEN-CHECK to
 ;;; weaken the test to a convenient supertype (conditional on policy.)
 ;;;
-(defun maybe-negate-check (cont types)
+(defun maybe-negate-check (cont types force-hairy)
   (declare (type continuation cont) (list types))
   (multiple-value-bind
       (ptypes count)
       (no-function-values-types (continuation-proven-type cont))
     (if (eq count :unknown)
-	(if (every #'type-check-template types)
+	(if (and (every #'type-check-template types) (not force-hairy))
 	    (values :simple types)
 	    (values :hairy
 		    (mapcar #'(lambda (x)
@@ -169,7 +170,8 @@
 				     (list nil weak c))))
 			   ptypes types)))
 	  (if (and (not (find-if #'first res))
-		   (every #'type-check-template types))
+		   (every #'type-check-template types)
+		   (not force-hairy))
 	      (values :simple types)
 	      (values :hairy res))))))
 	    
@@ -188,6 +190,13 @@
 ;;; In this :SIMPLE case, the second value is a list of the type restrictions
 ;;; specified for the leading positional values.
 ;;;
+;;; We force a check to be hairy even when there are fixed values if we are in
+;;; a context where we may be forced to use the unknown values convention
+;;; anyway.  This is because IR2tran can't generate type checks for unknown
+;;; values continuations but people could still be depending on the check being
+;;; done.  We only care about EXIT and RETURN (not MV-COMBINATION) since these
+;;; are the only contexts where the ultimate values receiver 
+;;;
 ;;; In the :HAIRY case, the second value is a list of triples of the form:
 ;;;    (Not-P Type Original-Type)
 ;;;
@@ -209,11 +218,19 @@
     (multiple-value-bind (types count)
 			 (no-function-values-types type)
       (cond ((not (eq count :unknown))
-	     (maybe-negate-check cont types))
+	     (if (or (exit-p dest)
+		     (and (return-p dest)
+			  (multiple-value-bind
+			      (ignore count)
+			      (values-types (return-result-type dest))
+			    (declare (ignore ignore))
+			    (eq count :unknown))))
+		 (maybe-negate-check cont types t)
+		 (maybe-negate-check cont types nil)))
 	    ((and (mv-combination-p dest)
 		  (eq (basic-combination-kind dest) :local))
 	     (assert (values-type-p type))
-	     (maybe-negate-check cont (args-type-optional type)))
+	     (maybe-negate-check cont (args-type-optional type) nil))
 	    (t
 	     (values :too-hairy nil))))))
 
@@ -235,13 +252,22 @@
 ;;; since if we pass up this chance to do the check, it will be too late.  The
 ;;; penalty for being too conservative is duplicated type checks.
 ;;;
-;;; We always return true if there is a compile-time type error on the
-;;; continuation, so that this error will be signalled at runtime as well.
+;;; If there is a compile-time type error, then we always return true unless
+;;; the DEST is a full call.  With a full call, the theory is that the type
+;;; error is probably from a declaration in (or on) the callee, so the callee
+;;; should be able to do the check.  We want to let the callee do the check,
+;;; because it is possible that the error is really in the callee, not the
+;;; caller.  We don't want to make people recompile all calls to a function
+;;; when they were originally compiled with a bad declaration (or an old type
+;;; assertion derived from a definition appearing after the call.)
 ;;;
 (defun probable-type-check-p (cont)
   (declare (type continuation cont))
   (let ((dest (continuation-dest cont)))
-    (cond ((eq (continuation-type-check cont) :error))
+    (cond ((eq (continuation-type-check cont) :error)
+	   (if (and (combination-p dest) (eq (combination-kind dest) :full))
+	       nil
+	       t))
 	  ((or (not dest)
 	       (policy dest (zerop safety)))
 	   nil)
@@ -370,6 +396,65 @@
   (undefined-value))
 
 
+;;; DO-TYPE-WARNING  --  Internal
+;;;
+;;;    Emit a type warning for Node.  If the value of node is being used for a
+;;; variable binding, we figure out which one for source context.  If the value
+;;; is a constant, we print it specially.  We also print forms known to be of
+;;; type NIL specially.
+;;;
+(defun do-type-warning (node)
+  (declare (type node node))
+  (let* ((*compiler-error-context* node)
+	 (cont (node-cont node))
+	 (atype-spec (type-specifier (continuation-asserted-type cont)))
+	 (dtype (node-derived-type node))
+	 (dest (continuation-dest cont))
+	 (what (when (and (combination-p dest)
+			  (eq (combination-kind dest) :local))
+		 (let ((lambda (combination-lambda dest))
+		       (pos (position cont (combination-args dest))))
+		   (format nil "~:[A possible~;The~] binding of ~S"
+			   (and (continuation-use cont)
+				(eq (functional-kind lambda) :let))
+			   (leaf-name (elt (lambda-vars lambda) pos)))))))
+    (cond ((and (ref-p node) (constant-p (ref-leaf node)))
+	   (compiler-warning "~:[This~;~:*~A~] is not a ~S:~%  ~S"
+			     what atype-spec (constant-value (ref-leaf node))))
+	   ((eq dtype *empty-type*)
+	    (if what
+		(compiler-warning "~A is an expression that does not return."
+				  what)
+		(compiler-warning "Expression that does not return when ~
+				   expecting a value of type:~%  ~S."
+				  atype-spec)))
+	   (t
+	    (compiler-warning "~:[Result~;~:*~A~] is a ~S, ~<~%~:;not a ~S.~>"
+			      what (type-specifier dtype) atype-spec))))
+  (undefined-value))
+
+
+;;; MARK-ERROR-CONTINUATION  --  Internal
+;;;
+;;;    Mark Cont as being a continuation with a manifest type error.  We set
+;;; the kind to :ERROR, and clear any FUNCTION-INFO if the continuation is an
+;;; argument to a known call.  The last is done so that the back end doesn't
+;;; have to worry about type errors in arguments to known functions.  This
+;;; clearing is inhibited for things with IR2-CONVERT methods, since we can't
+;;; do a full call to funny functions.
+;;;
+(defun mark-error-continuation (cont)
+  (declare (type continuation cont))
+  (setf (continuation-%type-check cont) :error)
+  (let ((dest (continuation-dest cont)))
+    (when (and (combination-p dest)
+	       (let ((info (basic-combination-kind dest)))
+		 (and (function-info-p info)
+		      (not (function-info-ir2-convert info)))))
+      (setf (basic-combination-kind dest) :full)))
+  (undefined-value))
+
+
 ;;; Generate-Type-Checks  --  Interface
 ;;;
 ;;;    Loop over all blocks in Component that have TYPE-CHECK set, looking for
@@ -377,11 +462,10 @@
 ;;; compile-time type errors and determine if and how to do run-time type
 ;;; checks.
 ;;;
-;;;    If there is a compile-time type error, then we mark the continuation
-;;; with a :ERROR kind, emit a warning if appropriate, and clear any
-;;; FUNCTION-INFO if the continuation is an argument to a known call.  The last
-;;; is done so that the back end doesn't have to worry about type errors in
-;;; arguments to known functions.
+;;;    If there is a compile-time type error, then we mark the continuation and
+;;; emit a warning if appropriate.  This part loops over all the uses of the
+;;; continuation, since after we convert the check, the :DELETED kind will
+;;; inhibit warnings about the types of other uses.
 ;;;
 ;;;    If a continuation is too complex to be checked by the back end, or is
 ;;; better checked with explicit code, then convert to an explicit test.
@@ -400,25 +484,15 @@
     (when (block-type-check block)
       (do-nodes (node cont block)
 	(let ((type-check (continuation-type-check cont)))
-	  (unless (member type-check '(nil :error))
-	    (let ((dtype (node-derived-type node))
-		  (atype (continuation-asserted-type cont)))
-	      (unless (values-types-intersect dtype atype)
-		(setf (continuation-%type-check cont) :error)
-		(let ((dest (continuation-dest cont)))
-		  (when (and (combination-p dest)
-			     (function-info-p (basic-combination-kind dest)))
-		    (setf (basic-combination-kind dest) :full)))
-		(unless (policy node (= brevity 3))
-		  (let ((*compiler-error-context* node))
-		    (if (and (ref-p node) (constant-p (ref-leaf node)))
-			(compiler-warning "This is not a ~S:~%  ~S"
-					  (type-specifier atype)
-					  (constant-value (ref-leaf node)))
-			(compiler-warning "Result is a ~S, not a ~S."
-					  (type-specifier dtype)
-					  (type-specifier atype))))))))
-	  
+	  (unless (member type-check '(nil :error :deleted))
+	    (let ((atype (continuation-asserted-type cont)))
+	      (do-uses (use cont)
+		(unless (values-types-intersect (node-derived-type use)
+						atype)
+		  (mark-error-continuation cont)
+		  (unless (policy node (= brevity 3))
+		    (do-type-warning use))))))
+
 	  (when (eq type-check t)
 	    (let ((check-p (probable-type-check-p cont)))
 	      (multiple-value-bind (check types)