diff --git a/compiler/ir1final.lisp b/compiler/ir1final.lisp
index 9dda94c72515ce9f28739b743efedb87dcbd721e..53f34c0355b1e0462522dc640b0c7a781298fedc 100644
--- a/compiler/ir1final.lisp
+++ b/compiler/ir1final.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/ir1final.lisp,v 1.9 1991/02/20 14:57:48 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1final.lisp,v 1.10 1991/03/11 17:14:09 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -19,7 +19,7 @@
 (in-package 'c)
 
 
-;;; Note-Failed-Optimization  --  Interface
+;;; Note-Failed-Optimization  --  Internal
 ;;;
 ;;;    Give the user grief about optimizations that we weren't able to do.  It
 ;;; is assumed that they want to hear, or there wouldn't be any entries in the
@@ -52,29 +52,72 @@
 	                      ~{~6T~?~^~&~}"
 			     (messages))))))))))
 
-	  
-;;; Check-Free-Function  --  Interface
+
+;;; Tail-Annotate  --  Internal
+;;;
+;;;    Mark all tail-recursive uses of function result continuations with the
+;;; corresponding tail-set.  Nodes whose type is NIL (i.e. don't return) such
+;;; as calls to ERROR are never annotated as tail, so as to preserve debugging
+;;; information.
 ;;;
-;;;    If the entry is a functional, then we update the global environment
-;;; according to the new definition, checking for inconsistency.
+(defun tail-annotate (component)
+  (declare (type component component))
+  (dolist (fun (component-lambdas component))
+    (let ((ret (lambda-return fun)))
+      (when ret
+	(let ((result (return-result ret))
+	      (tails (lambda-tail-set fun)))
+	  (do-uses (use result)
+	    (when (and (immediately-used-p result use)
+		       (or (not (eq (node-derived-type use) *empty-type*))
+			   (not (basic-combination-p use))
+			   (eq (basic-combination-kind use) :local)))
+	      (setf (node-tail-p use) tails)))))))
+  (undefined-value))
+
+
+;;; IR1-FINALIZE  --  Interface
 ;;;
-(proclaim '(function check-free-function (t leaf) void))
-(defun check-free-function (name leaf)
-  (etypecase leaf
-    (functional
-     (let* ((where (info function where-from name))
-	    (dtype (leaf-type leaf))
-	    (*compiler-error-context* (lambda-bind (main-entry leaf))))
-       (note-name-defined name :function)
-       (ecase where
-	 (:assumed
-	  (let ((approx-type (info function assumed-type name)))
-	    (when (and approx-type (function-type-p dtype))
-	      (valid-approximate-type approx-type dtype))
-	    (setf (info function type name) dtype)
-	    (setf (info function assumed-type name) nil))
-	  (setf (info function where-from name) :defined))
-	 (:declared); No check for now, just keep declared type.
-	 (:defined
-	  (setf (info function type name) dtype)))))
-    (global-var)))
+;;;    Do miscellaneous things that we want to do once all optimization has
+;;; been done:
+;;;  -- Record the derived result type before the back-end trashes the
+;;;     flow graph.
+;;;  -- For each named function with an XEP, note the definition of that name,
+;;;     and add derived type information to the info environment.  We also
+;;;     delete the FUNCTIONAL from *FREE-FUNCTIONS* to eliminate the
+;;;     possibility that new references might be converted to it.
+;;;  -- Note any failed optimizations.
+;;; 
+(defun ir1-finalize (component)
+  (declare (type component component))
+  (tail-annotate component)
+
+  (dolist (fun (component-lambdas component))
+    (case (functional-kind fun)
+      (:external
+       (let* ((leaf (functional-entry-function fun))
+	      (name (leaf-name leaf))
+	      (where (info function where-from name))
+	      (dtype (definition-type leaf))
+	      (*compiler-error-context* (lambda-bind (main-entry leaf))))
+	 (setf (leaf-type leaf) dtype)
+	 (when (eq leaf (gethash name *free-functions*))
+	   (note-name-defined name :function)
+	   (remhash name *free-functions*)
+	   (ecase where
+	     (:assumed
+	      (let ((approx-type (info function assumed-type name)))
+		(when (and approx-type (function-type-p dtype))
+		  (valid-approximate-type approx-type dtype))
+		(setf (info function type name) dtype)
+		(setf (info function assumed-type name) nil))
+	      (setf (info function where-from name) :defined))
+	     (:declared); Just keep declared type.
+	     (:defined
+	      (setf (info function type name) dtype))))))
+      ((nil)
+       (setf (leaf-type fun) (definition-type fun)))))
+
+  (maphash #'note-failed-optimization *failed-optimizations*)
+  (clrhash *failed-optimizations*)
+  (undefined-value))