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)