From 5383aa5f1d4be123a43506b3193ef05fa2e8a9e5 Mon Sep 17 00:00:00 2001 From: emarsden <emarsden> Date: Wed, 5 Feb 2003 19:32:21 +0000 Subject: [PATCH] Added a cross-referencing facility to the compiler. The new XREF package exports function WHO-CALLS, WHO-REFERENCES, WHO-BINDS and WHO-SETS. These return structures of type XREF-CONTEXT, which contain the name of the referencing context, the file it was referenced from (or NIL when compiling from the toplevel), and the source-position in that file. Also change the names of lambda nodes in IR1 for macros and compiler-macros to be lists of the form (:macro macro-name) (:compiler-macro macro-name) instead of strings of the form "DEFMACRO MACRO-NAME". Documentation has been added to the User's Manual. This change shouldn't cause any bootstrapping problems when building. --- code/exports.lisp | 18 +++++++++++++++++- compiler/ir1tran.lisp | 9 +++------ compiler/loadcom.lisp | 3 ++- compiler/main.lisp | 20 ++++++++++++++------ tools/comcom.lisp | 9 ++++++--- 5 files changed, 42 insertions(+), 17 deletions(-) diff --git a/code/exports.lisp b/code/exports.lisp index fb6681a67..962c5e8bb 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.198 2003/02/05 11:08:44 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.199 2003/02/05 19:32:19 emarsden Exp $") ;;; ;;; ********************************************************************** ;;; @@ -93,6 +93,8 @@ (if (find-package "C") (rename-package "C" "C" '("OLD-C")) (make-package "C" :nicknames '("OLD-C") :use nil)) +(if (find-package "XREF") + (rename-package "XREF" "XREF" 'nil)) (if (find-package "WIRE") (rename-package "WIRE" "WIRE" 'nil) (make-package "WIRE" :nicknames 'nil :use nil)) @@ -1202,6 +1204,7 @@ "PREDICATE" "PRIMITIVE-TYPE" "PRIMITIVE-TYPE-OF" "PRIMITIVE-TYPE-OR-LOSE" "PRIMITIVE-TYPE-VOP" "PUSH-VALUES" "READ-PACKED-BIT-VECTOR" "READ-VAR-INTEGER" "READ-VAR-STRING" + "*RECORD-XREF-INFO*" "RESET-STACK-POINTER" "RESTORE-DYNAMIC-STATE" "RETURN" "RETURN-MULTIPLE" "RT-AFPA-FASL-FILE-IMPLEMENTATION" "RT-FASL-FILE-IMPLEMENTATION" "SAVE-DYNAMIC-STATE" "SB" @@ -1269,6 +1272,19 @@ "IR2-COMPONENT-DYNCOUNT-INFO" "DYNCOUNT-INFO" "DYNCOUNT-INFO-P") ) +(defpackage "XREF" + (:export "INIT-XREF-DATABASE" + "REGISTER-XREF" + "WHO-CALLS" + "WHO-REFERENCES" + "WHO-BINDS" + "WHO-SETS" + #+pcl "WHO-SUBCLASSES" + #+pcl "WHO-SUPERCLASSES" + "MAKE-XREF-CONTEXT" + "XREF-CONTEXT-NAME" + "XREF-CONTEXT-FILE" + "XREF-CONTEXT-SOURCE-PATH")) (defpackage "WIRE" (:export "*CURRENT-WIRE*" "CONNECT-TO-REMOTE-SERVER" "CREATE-REQUEST-SERVER" "DESTROY-REQUEST-SERVER" diff --git a/compiler/ir1tran.lisp b/compiler/ir1tran.lisp index 4a8d7e643..d48daf294 100644 --- a/compiler/ir1tran.lisp +++ b/compiler/ir1tran.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/ir1tran.lisp,v 1.136 2003/02/05 11:08:42 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.137 2003/02/05 19:32:20 emarsden Exp $") ;;; ;;; ********************************************************************** ;;; @@ -3337,8 +3337,7 @@ (let* ((*current-path* (revert-source-path 'defmacro)) (fun (ir1-convert-lambda def name 'defmacro))) - (setf (leaf-name fun) - (concatenate 'string "DEFMACRO " (symbol-name name))) + (setf (leaf-name fun) (list :macro name)) (setf (functional-arg-documentation fun) (eval lambda-list)) (ir1-convert start cont `(%%defmacro ',name ,fun ,doc))) @@ -3362,9 +3361,7 @@ (def (second def))) ; Don't want to make a function just yet... (let* ((*current-path* (revert-source-path 'define-compiler-macro)) (fun (ir1-convert-lambda def name 'define-compiler-macro))) - (setf (leaf-name fun) - (let ((*print-case* :upcase)) - (format nil "DEFINE-COMPILER-MACRO ~S" name))) + (setf (leaf-name fun) (list :compiler-macro name)) (setf (functional-arg-documentation fun) (eval lambda-list)) (ir1-convert start cont `(%%define-compiler-macro ',name ,fun ,doc))) diff --git a/compiler/loadcom.lisp b/compiler/loadcom.lisp index 720d5a348..e1c1b1443 100644 --- a/compiler/loadcom.lisp +++ b/compiler/loadcom.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/loadcom.lisp,v 1.49 2002/11/01 18:00:47 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/loadcom.lisp,v 1.50 2003/02/05 19:32:20 emarsden Exp $") ;;; ;;; ********************************************************************** ;;; @@ -64,6 +64,7 @@ (load "c:dump") (load "c:debug") +(load "c:xref") (load "c:copyprop") (load "c:represent") diff --git a/compiler/main.lisp b/compiler/main.lisp index ebd432903..442bb1b04 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.131 2003/01/21 16:51:09 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.132 2003/02/05 19:32:21 emarsden Exp $") ;;; ;;; ********************************************************************** ;;; @@ -66,7 +66,7 @@ (declaim (type (member t nil :maybe) *byte-compile* *byte-compiling* *byte-compile-default*)) -(defvar compiler-version "1.0") +(defvar compiler-version "1.1") (pushnew :python *features*) (setf (getf ext:*herald-items* :python) `(" Python " ,compiler-version ", target " @@ -74,6 +74,10 @@ (write-string (backend-version *backend*) stream)))) (defvar *check-consistency* nil) + +(defvar *record-xref-info* nil + "Whether the compiler should record cross-reference information.") + (defvar *all-components*) ;;; The current block compilation state. These are initialized to the @@ -437,6 +441,10 @@ (delete-if-no-entries component) + (when *record-xref-info* + (maybe-mumble "[record-xref-info]~%") + (record-component-xrefs component)) + (unless (eq (block-next (component-head component)) (component-tail component)) (if *byte-compiling* @@ -541,8 +549,8 @@ ;;; ;;; This function is called by WITH-COMPILATION-UNIT at the end of a ;;; compilation unit. It prints out any residual unknown function warnings and -;;; the total error counts. Abort-P should be true when the compilation unit -;;; was aborted by throwing out. Abort-Count is the number of dynamically +;;; the total error counts. ABORT-P should be true when the compilation unit +;;; was aborted by throwing out. ABORT-COUNT is the number of dynamically ;;; enclosed nested compilation units that were aborted. ;;; (defun print-summary (abort-p abort-count) @@ -730,7 +738,7 @@ ;;; Return a SOURCE-INFO which will read from Stream. ;;; (defun make-stream-source-info (stream language) - (declare (type (member :lisp #+nil :dylan) language)) + (declare (type (member :lisp) language)) (let ((files (list (make-file-info :name :stream :language language)))) (make-source-info :files files @@ -1134,7 +1142,7 @@ ;;; PRODUCING-FASL-FILE -- interface. ;;; ;;; Returns T iff we are currently producing a fasl-file and hence constants -;;; need to be dumped carfully. +;;; need to be dumped carefully. ;;; (defun producing-fasl-file () (unless *converting-for-interpreter* diff --git a/tools/comcom.lisp b/tools/comcom.lisp index 6f599ca20..b7d44b4e9 100644 --- a/tools/comcom.lisp +++ b/tools/comcom.lisp @@ -3,10 +3,12 @@ ;;; ********************************************************************** ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/comcom.lisp,v 1.53 2002/08/27 22:18:35 moore Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/comcom.lisp,v 1.54 2003/02/05 19:32:21 emarsden Exp $") ;;; ;;; ********************************************************************** ;;; +;;; Loading this file causes the CMUCL compiler to be compiled. +;;; (in-package "USER") #+bootstrap @@ -21,7 +23,7 @@ (unless (find-package "OLD-C") (rename-package "C" "C" '("OLD-C"))) -;;; Import so that these types which appear in the globldb are the same... +;;; Import so that these types which appear in the globaldb are the same... #+bootstrap (import '(old-c::approximate-function-type old-c::function-info old-c::defstruct-description @@ -223,7 +225,8 @@ (comf "target:compiler/codegen") (with-compilation-unit (:optimize '(optimize (debug 2) (safety 2))) - (comf "target:compiler/debug" :byte-compile *byte-compile*)) + (comf "target:compiler/debug" :byte-compile *byte-compile*) + (comf "target:compiler/xref" :byte-compile *byte-compile*)) #+nil (comf "target:compiler/statcount") (comf "target:compiler/dyncount") -- GitLab