diff --git a/compiler/ir1util.lisp b/compiler/ir1util.lisp
index 0a15fe99525f6c8c31f53af4553d898f74d55538..6ab1a88b3b7226e7bc4e73e8b45ef014d2983f86 100644
--- a/compiler/ir1util.lisp
+++ b/compiler/ir1util.lisp
@@ -12,7 +12,13 @@
 ;;;
 ;;; Written by Rob MacLachlan
 ;;;
-(in-package 'c)
+(in-package "C")
+(export '(*compiler-notification-function*))
+(in-package "EXTENSIONS")
+(export '(*error-print-level* *error-print-length*
+	  *source-context-take-car-forms* *undefined-warning-limit*
+	  *enclosing-source-cutoff*))
+(in-package "C")
 
 
 ;;;; Cleanup hackery:
@@ -1085,6 +1091,17 @@ inlines
     (change-ref-leaf ref new-leaf))
   (undefined-value))
 
+;;; SUBSTITUTE-LEAF-IF  --  Interface
+;;;
+;;;    Like SUBSITIUTE-LEAF, only there is a predicate on the Ref to tell
+;;; whether to substitute.
+;;;
+(defun substitute-leaf-if (test new-leaf old-leaf)
+  (declare (type leaf new-leaf old-leaf) (type function test))
+  (dolist (ref (leaf-refs old-leaf))
+    (when (funcall test ref)
+      (change-ref-leaf ref new-leaf)))
+  (undefined-value))
 
 ;;; Find-Constant  --  Interface
 ;;;
@@ -1233,8 +1250,8 @@ inlines
 (proclaim '(type unsigned-byte *enclosing-source-cutoff*))
 
 
-(defparameter *defmumble-take-car-forms* '(defstruct)
-  "A list of \"DEFxxx\" forms for which we should we should compute the source
+(defparameter *source-context-take-car-forms* '(defstruct function)
+  "A list of form names for which we should we should compute the source
   context by taking the CAR of the first arg when it is a list.")
 
 
@@ -1264,8 +1281,17 @@ inlines
   (original-source nil :type simple-string)
   ;;
   ;; A list of prefixes of "interesting" forms that enclose original-source.
-  (context nil :type list))
-
+  (context nil :type list)
+  ;;
+  ;; The FILE-INFO-NAME for the relevant FILE-INFO.
+  (file-name nil :type (or pathname (member :lisp :stream)))
+  ;;
+  ;; The file position at which the top-level form starts, if applicable.
+  (file-position nil :type (or index null))
+  ;;
+  ;; The original source part of the source path.
+  (original-source-path nil :type list))
+  
   
 ;;; If true, this is the node which is used as context in compiler warning
 ;;; messages.
@@ -1275,6 +1301,25 @@ inlines
 (defvar *compiler-error-context* nil)
 
 
+;;; SOURCE-FORM-CONTEXT  --  Internal
+;;;
+;;;    Return the first two elements of Form if Form is a list.  Take the car
+;;; of the second form if appropriate.
+;;;
+(defun source-form-context (form)
+  (cond ((atom form) nil)
+	((>= (length form) 2)
+	 (let ((head (first form))
+	       (next (second form)))
+	   (list head
+		 (if (and (listp next)
+			  (member head *source-context-take-car-forms*))
+		     (car next)
+		     next))))
+	(t
+	 form)))
+
+  
 ;;; Find-Original-Source  --  Internal
 ;;;
 ;;;    Given a source path, return the original source form and a description
@@ -1292,7 +1337,8 @@ inlines
 (defun find-original-source (path)
   (declare (list path))
   (let* ((rpath (reverse (source-path-original-source path)))
-	 (root (find-source-root (first rpath) *source-info*)))
+	 (tlf (first rpath))
+	 (root (find-source-root tlf *source-info*)))
     (collect ((context))
       (let ((form root)
 	    (current (rest rpath)))
@@ -1304,25 +1350,15 @@ inlines
 	    (when (symbolp head)
 	      (let ((name (symbol-name head)))
 		(when (and (>= (length name) 3) (string= name "DEF" :end1 3))
-		  (if (>= (length form) 2)
-		      (let ((next (second form)))
-			(context
-			 (list head
-			       (if (and (listp next)
-					(member head
-						*defmumble-take-car-forms*))
-				   (car next)
-				   next))))
-		      (context (list head)))))))
+		  (context (source-form-context form))))))
 	  (when (null current) (return))
 	  (setq form (nth (pop current) form)))
 	
 	(cond ((context)
 	       (values form (context)))
 	      ((and path root)
-	       (if (listp root)
-		   (values form (list (subseq root 0 (min 2 (length root)))))
-		   (values form ())))
+	       (let ((c (source-form-context root)))
+		 (values form (if c (list c) nil))))
 	      (t
 	       (values '(unable to locate source)
 		       '((some strange place)))))))))
@@ -1334,8 +1370,8 @@ inlines
 ;;; compiler warnings.
 ;;;
 (defun stringify-form (form &optional (pretty t))
-  (let ((*print-level* *error-print-level*)
-	(*print-length* *error-print-length*)
+  (let ((*print-level* (or *error-print-level* *print-level*))
+	(*print-length* (or *error-print-length* *print-length*))
 	(*print-pretty* pretty))
     (if pretty
 	(format nil "  ~S~%" form)
@@ -1374,12 +1410,22 @@ inlines
 					       nil))
 			(full (stringify-form src)))
 		    (incf n)))
-		
-		(make-compiler-error-context
-		 :enclosing-source (short)
-		 :source (full)
-		 :original-source (stringify-form form)
-		 :context src-context))))))))
+
+		(let* ((tlf (source-path-tlf-number path))
+		       (file (find-file-info tlf *source-info*)))
+		  (make-compiler-error-context
+		   :enclosing-source (short)
+		   :source (full)
+		   :original-source (stringify-form form)
+		   :context src-context
+		   :file-name (file-info-name file)
+		   :file-position
+		   (multiple-value-bind (ignore pos)
+					(find-source-root tlf *source-info*)
+		     (declare (ignore ignore))
+		     pos)
+		   :original-source-path
+		   (source-path-original-source path))))))))))
 
 
 ;;;; Printing error messages:
@@ -1415,6 +1461,36 @@ inlines
 (defvar *last-message-count* 0)
 (proclaim '(type index *last-message-count*))
 
+(defvar *compiler-notification-function* nil
+  "This is the function called by the compiler to specially note a warning,
+   comment, or error.  The function must take four arguments, the severity
+   a string for context, the file namestring, and the file position.  The
+   severity is one of :note, :warning, or :error.  Except for the severity, all
+   of these can be NIL if unavailable or inapplicable.")
+
+
+;;; COMPILER-NOTIFICATION  --  Internal
+;;;
+;;;    Call any defined notification function.
+;;;
+(defun compiler-notification (severity context)
+  (declare (type (member :note :warning :error) severity)
+	   (type (or compiler-error-context null) context))
+  (when *compiler-notification-function*
+    (if context
+	(let ((*print-level* 2)
+	      (*print-pretty* nil)
+	      (name (compiler-error-context-file-name context)))
+	  (funcall *compiler-notification-function* severity 
+		   (format nil "~{~{~S~^ ~}~^ => ~}"
+			   (compiler-error-context-context context))
+		   (when (typep name 'pathname)
+		     (namestring name))
+		   (compiler-error-context-file-position context)))
+	(funcall *compiler-notification-function* severity nil nil nil)))
+  (undefined-value))
+
+
 ;;; Note-Message-Repeats  --  Internal
 ;;;
 ;;;    If the last message was given more than once, then print out an
@@ -1442,18 +1518,28 @@ inlines
 ;;; the number of times that the message is repeated.
 ;;;
 (defun print-error-message (what format-string format-args)
-  (declare (string what format-string) (list format-args))
-  (let* ((*print-level* *error-print-level*)
-	 (*print-length* *error-print-length*)
+  (declare (type (member :error :warning :note) what) (string format-string)
+	   (list format-args))
+  (let* ((*print-level* (or *error-print-level* *print-level*))
+	 (*print-length* (or *error-print-length* *print-length*))
 	 (stream *compiler-error-output*)
 	 (context (find-error-context format-args)))
     (cond
      (context
-      (let ((in (compiler-error-context-context context))
+      (let ((file (compiler-error-context-file-name context))
+	    (in (compiler-error-context-context context))
 	    (form (compiler-error-context-original-source context))
 	    (enclosing (compiler-error-context-enclosing-source context))
 	    (source (compiler-error-context-source context))
 	    (last *last-error-context*))
+	(compiler-notification what context)
+
+	(unless (and last
+		     (equal file (compiler-error-context-file-name last)))
+	  (when (typep file 'pathname)
+	    (note-message-repeats)
+	    (setq last nil)
+	    (format stream "~2&File: ~A~%" (namestring file))))
 	
 	(unless (and last
 		     (equal in (compiler-error-context-context last)))
@@ -1485,6 +1571,7 @@ inlines
 	      (write-line "==>" stream)
 	      (write-string src stream))))))
      (t
+      (compiler-notification what nil)
       (note-message-repeats)
       (setq *last-format-string* nil)
       (format stream "~2&")))
@@ -1496,7 +1583,7 @@ inlines
       (note-message-repeats nil)
       (setq *last-format-string* format-string)
       (setq *last-format-args* format-args)
-      (format stream "~&~A: ~?~&" what format-string format-args)))
+      (format stream "~&~:(~A~): ~?~&" what format-string format-args)))
   
   (incf *last-message-count*)
   (undefined-value))
@@ -1523,24 +1610,24 @@ inlines
 ;;;
 (defun compiler-error (format-string &rest format-args)
   (incf *compiler-error-count*)
-  (print-error-message "Error" format-string format-args)
+  (print-error-message :error format-string format-args)
   (funcall *compiler-error-bailout*)
   (error "*Compiler-Error-Bailout* returned?"))
 ;;;
 (defun compiler-error-message (format-string &rest format-args)
   (incf *compiler-error-count*)
-  (print-error-message "Error" format-string format-args))
+  (print-error-message :error format-string format-args))
 ;;;
 (defun compiler-warning (format-string &rest format-args)
   (incf *compiler-warning-count*)
-  (print-error-message "Warning" format-string format-args))
+  (print-error-message :warning format-string format-args))
 ;;;
 (defun compiler-note (format-string &rest format-args)
   (incf *compiler-note-count*)
   (unless (if *compiler-error-context*
 	      (policy *compiler-error-context* (= brevity 3))
 	      (policy nil (= brevity 3)))
-    (print-error-message "Note" format-string format-args)))
+    (print-error-message :note format-string format-args)))
 
 
 ;;; Compiler-Mumble  --  Interface
@@ -1640,7 +1727,8 @@ inlines
 ;;; value to indicate this.  Node is used as the error context for any error
 ;;; message, and Context is a string that is spliced into the warning.
 ;;;
-(proclaim '(function careful-call (function list node string) (values list boolean)))
+(proclaim '(function careful-call ((or symbol function) list node string)
+		     (values list boolean)))
 (defun careful-call (function args node context)
   (values
    (multiple-value-list