From 624c3dc2d6dab8a37576c7985f57ee892a3b3bb6 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Mon, 13 Jun 2005 14:29:26 +0000 Subject: [PATCH] Save xref information to fasls. This is done by faking it. The file being compiled is compiled as usual, but we append fake forms to the file as if they came from the file. These fake forms insert the necessary information into the xref databases when the fasl is loaded. To support this feature, we also updated COMPILE-FILE to recognize the :xref keyword arg. Set this to non-NIL to enable computing and saving xref information. code/exports.lisp: o Update XREF exports compiler/fndb.lisp: o Update with new definition of COMPILE-FILE. compiler/main.lisp: o Append fake forms to the file being compiled to save xref information to the fasl. This clears out any xref info we might have for the file, and inserts the necessary xref information into the database. o Add :XREF keyword arg to COMPILE-FILE. Default value of :XREF is C::*RECORD-XREF-INFO*. compiler/xref.lisp: o Add function to invalidate xref info for a given namestring, so we can reset the info when a fasl with xref info is loaded. o Add a function to find all xref information for a given pathname. Used for saving xref info to a fasl. --- code/exports.lisp | 6 ++- compiler/fndb.lisp | 5 ++- compiler/main.lisp | 98 ++++++++++++++++++++++++++++++++++++---------- compiler/xref.lisp | 56 ++++++++++++++++++++------ 4 files changed, 128 insertions(+), 37 deletions(-) diff --git a/code/exports.lisp b/code/exports.lisp index 4a59667e3..acdde5a39 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 435980cd0..27e316d91 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 bbfb9ef6a..6863b6eca 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 ea192bdca..db8b8ea62 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) -- GitLab