diff --git a/code/exports.lisp b/code/exports.lisp
index 4a59667e39fe6d48750b3cad077f6d26929cbd72..acdde5a39edda2f27887838feb7bb3c29e56f037 100644
--- a/code/exports.lisp
+++ b/code/exports.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.244 2005/04/14 20:52:02 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.245 2005/06/13 14:29:24 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1650,7 +1650,9 @@
            "MAKE-XREF-CONTEXT"
            "XREF-CONTEXT-NAME"
            "XREF-CONTEXT-FILE"
-           "XREF-CONTEXT-SOURCE-PATH"))
+           "XREF-CONTEXT-SOURCE-PATH"
+	   "INVALIDATE-XREFS-FOR-NAMESTRING"
+	   "FIND-XREFS-FOR-PATHNAME"))
 
 (defpackage "WIRE"
   (:export "*CURRENT-WIRE*" "CONNECT-TO-REMOTE-SERVER"
diff --git a/compiler/fndb.lisp b/compiler/fndb.lisp
index 435980cd0cba48e719146121a5c91f6ee743b5a4..27e316d91654902282257d704d1611506fe291ca 100644
--- a/compiler/fndb.lisp
+++ b/compiler/fndb.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.131 2005/04/22 15:01:32 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.132 2005/06/13 14:29:25 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1080,7 +1080,8 @@
    (:block-compile (member t nil :specified))
    (:entry-points list)
    (:byte-compile (member t nil :maybe))
-   (:external-format (member :default)))
+   (:external-format (member :default))
+   (:xref t))
   (values (or pathname null) boolean boolean))
 
 (defknown disassemble ((or callable cons)
diff --git a/compiler/main.lisp b/compiler/main.lisp
index bbfb9ef6ad885a5cd759106ba95fce09d50cb480..6863b6ecae862fbadae5b9e4726551aec68c921c 100644
--- a/compiler/main.lisp
+++ b/compiler/main.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.144 2004/12/16 21:55:38 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.145 2005/06/13 14:29:25 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -907,24 +907,75 @@ in the user USER-INFO slot of STREAM-SOURCE-LOCATIONs.")
 	 (stream (get-source-stream info)))
     (ecase language
       (:lisp
-       (loop
-	 (let* ((pos (file-position stream))
-		(eof '(*eof*))
-		(form (careful-read stream eof pos)))
-	   (if (eq form eof)
-	       (return)
-	       (let* ((forms (file-info-forms file))
-		      (current-idx (+ (fill-pointer forms)
-				      (file-info-source-root file))))
-		 (vector-push-extend form forms)
-		 (vector-push-extend pos (file-info-positions file))
-		 (clrhash *source-paths*)
-		 (find-source-paths form current-idx)
-		 (process-form form
-			       `(original-source-start 0 ,current-idx))))))))
-    (when (advance-source-file info)
-      (process-sources info))))
-
+       (flet
+	   ((process-one (stream)
+	      (loop
+		 (let* ((pos (file-position stream))
+			(eof '(*eof*))
+			(form (careful-read stream eof pos)))
+		   (if (eq form eof)
+		       (return)
+		       (let* ((forms (file-info-forms file))
+			      (current-idx (+ (fill-pointer forms)
+					      (file-info-source-root file))))
+			 (vector-push-extend form forms)
+			 (vector-push-extend pos (file-info-positions file))
+			 (clrhash *source-paths*)
+			 (find-source-paths form current-idx)
+			 (process-form form
+				       `(original-source-start 0 ,current-idx)))))))
+	    (process-xref-info (pathname)
+	      ;; When we have xref enabled, we save the xref data to the
+	      ;; file by faking it.  What we do is append a bunch of forms
+	      ;; to the file as if the file actually contained them.  These
+	      ;; forms clear out the entries from the xref databases
+	      ;; pertaining to this file, and then registers new entries
+	      ;; based on what we've found out so far from compiling this
+	      ;; file.
+	      ;;
+	      ;; Is this what we really want to do?  A new FOP might be good.
+	      ;;
+	      ;; Also, when compiling a file should we have a file-local
+	      ;; version of the databases?  This makes it easy to figure
+	      ;; out what we need to save to the fasl.  Then we can update
+	      ;; the global tables with the new info when we're done.  Or
+	      ;; we can just wait until the user loads the fasl.  This
+	      ;; latter option, however, changes how xref currently behaves.
+
+	      ;; Set *compile-print* to nil so we don't see any
+	      ;; spurious output from our fake source forms.  (Do we
+	      ;; need more?)
+	      (let ((*compile-print* nil))
+		;; Clear the xref database of all references to this file
+		(when (or (pathnamep pathname)
+			  (stringp pathname))
+		  (process-form `(xref::invalidate-xrefs-for-namestring
+				  ,(namestring pathname))
+				;; What should we use here?
+				`(original-source-start 0 0))
+		  ;; Now dump all the xref info pertaining to this file
+		  (dolist (db-type '(:calls :called :references :binds :sets
+				     :macroexpands))
+		    (dolist (xrefs (xref::find-xrefs-for-pathname db-type pathname))
+		      (destructuring-bind (target contexts)
+			  xrefs
+			(dolist (c contexts)
+			  (process-form
+			   `(xref:register-xref
+			     ,db-type ',target
+			     (xref:make-xref-context :name ',(xref:xref-context-name c)
+						     :file ,(xref:xref-context-file c)
+						     :source-path ',(xref:xref-context-source-path c)))
+
+			   `(original-source-start 0 0))))))))))
+	 ;; Compile the real file.
+	 (process-one stream)
+
+	 (when *record-xref-info*
+	   (process-xref-info (file-info-name file))))
+      
+       (when (advance-source-file info)
+	 (process-sources info))))))
 
 ;;; FIND-FILE-INFO  --  Interface
 ;;;
@@ -1685,7 +1736,9 @@ in the user USER-INFO slot of STREAM-SOURCE-LOCATIONs.")
 			     *block-compile-default*)
 			    ((:entry-points *entry-points*) nil)
 			    ((:byte-compile *byte-compile*)
-			     *byte-compile-default*))
+			     *byte-compile-default*)
+		            ((:xref *record-xref-info*)
+			     *record-xref-info*))
   "Compiles Source, producing a corresponding .FASL file.  Source may be a list
    of files, in which case the files are compiled as a unit, producing a single
    .FASL file.  The output file names are defaulted from the first (or only)
@@ -1723,7 +1776,10 @@ in the user USER-INFO slot of STREAM-SOURCE-LOCATIONs.")
       machine instructions.  Byte code is several times smaller, but much
       slower.  If :MAYBE, then only byte-compile when SPEED is 0 and
       DEBUG <= 1.  The default is the value of EXT:*BYTE-COMPILE-DEFAULT*,
-      which is initially :MAYBE."
+      which is initially :MAYBE.
+   :Xref
+      If non-NIL, enable recording of cross-reference information.  The default
+      is the value of C:*RECORD-XREF-INFO*"
   (declare (ignore external-format))
   (let* ((fasl-file nil)
 	 (error-file-stream nil)
diff --git a/compiler/xref.lisp b/compiler/xref.lisp
index ea192bdca3c89d91d40e48b741bacf4c3bbf911b..db8b8ea620d55befd47912dd3cb76c604d8e8e87 100644
--- a/compiler/xref.lisp
+++ b/compiler/xref.lisp
@@ -3,7 +3,7 @@
 ;;; Author: Eric Marsden <emarsden@laas.fr>
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/xref.lisp,v 1.5 2003/10/02 19:23:11 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/xref.lisp,v 1.6 2005/06/13 14:29:26 rtoy Rel $")
 ;;
 ;; This code was written as part of the CMUCL project and has been
 ;; placed in the public domain.
@@ -30,13 +30,7 @@
 ;;
 ;; Missing functionality:
 ;;
-;;   - there is no mechanism to save cross-reference information in a
-;;     FASL file, so you need to recompile all files in the current image
-;;
-;;   - maybe add macros EXT:WITH-XREF, and an :xref option to
-;;     COMPILE-FILE, as per ACL.
-;;
-;;   - add WHO-MACROEXPANDS
+;;   - maybe add macros EXT:WITH-XREF.
 ;;
 ;;   - in (defun foo (x) (flet ((bar (y) (+ x y))) (bar 3))), we want to see
 ;;     FOO calling (:internal BAR FOO)
@@ -63,7 +57,9 @@
           make-xref-context
           xref-context-name
           xref-context-file
-          xref-context-source-path))
+          xref-context-source-path
+	  invalidate-xrefs-for-namestring
+	  find-xrefs-for-pathname))
 
 
 (defstruct (xref-context
@@ -76,7 +72,7 @@
 (defun %print-xref-context (s stream d)
   (declare (ignore d))
   (cond (*print-readably*
-         (format stream "#S(xref::xref-context :name '~S :file ~S :source-path '~A)"
+         (format stream "#S(xref::xref-context :name '~S ~_ :file ~S ~_ :source-path '~A)"
                  (xref-context-name s)
                  (xref-context-file s)
                  (xref-context-source-path s)))
@@ -119,7 +115,7 @@
                     (:sets *who-sets*)
                     (:macroexpands *who-macroexpands*))))
     (if (gethash target database)
-        (pushnew context (gethash target database) :test 'equal)
+        (pushnew context (gethash target database) :test 'equalp)
         (setf (gethash target database) (list context)))
     context))
 
@@ -193,7 +189,43 @@ be set at runtime."
 (defun who-specializes (class)
   (pcl::specializer-direct-methods class))
 
-
+;; Go through all the databases and remove entries from that that
+;; reference the given Namestring.
+(defun invalidate-xrefs-for-namestring (namestring)
+  (labels ((matching-context (ctx)
+	     (equal namestring (if (pathnamep (xref-context-file ctx))
+				   (namestring (xref-context-file ctx))
+				   (xref-context-file ctx))))
+	   (invalidate-for-database (db)
+	     (maphash (lambda (target contexts)
+			(let ((valid-contexts (remove-if #'matching-context contexts)))
+			  (if (null valid-contexts)
+			      (remhash target db)
+			      (setf (gethash target db) valid-contexts))))
+		      db)))
+    (dolist (db (list *who-calls* *who-is-called* *who-references* *who-binds*
+		      *who-sets* *who-macroexpands*))
+      (invalidate-for-database db))))
+
+;; Look in Db for entries that reference the supplied Pathname and
+;; return a list of all the matches.  Each element of the list is a
+;; list of the target followed by the entries.
+(defun find-xrefs-for-pathname (db pathname)
+  (let ((entries '()))
+    (maphash #'(lambda (target contexts)
+		 (let ((matches '()))
+		   (dolist (ctx contexts)
+		     (when (equal pathname (xref-context-file ctx))
+		       (push ctx matches)))
+		   (push (list target matches) entries)))
+	     (ecase db
+	       (:calls *who-calls*)
+	       (:called *who-is-called*)
+	       (:references *who-references*)
+	       (:binds *who-binds*)
+	       (:sets *who-sets*)
+	       (:macroexpands *who-macroexpands*)))
+    entries))
 
 (in-package :compiler)