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