(loop for ctran = start then (node-next (ctran-next ctran))
while ctran
do (record-node-xrefs (ctran-next ctran) functional))
- ;; Properly record the deferred macroexpansion information
- ;; that's been stored in the block.
- (dolist (xref-data (block-macroexpands block))
- (record-xref :macroexpands
- (car xref-data)
- ;; We use the debug-name of the functional
- ;; as an identifier. This works quite nicely,
- ;; except for (fast/slow)-methods with non-symbol,
- ;; non-number eql specializers, for which
- ;; the debug-name doesn't map exactly
- ;; to the fdefinition of the method.
- functional
- nil
- (cdr xref-data)))))
+ ;; Properly record the deferred macroexpansion and source
+ ;; transform information that's been stored in the block.
+ (dolist (xref-data (block-xrefs block))
+ (destructuring-bind (kind what path) xref-data
+ (record-xref kind what
+ ;; We use the debug-name of the functional
+ ;; as an identifier. This works quite nicely,
+ ;; except for (fast/slow)-methods with non-symbol,
+ ;; non-number eql specializers, for which
+ ;; the debug-name doesn't map exactly
+ ;; to the fdefinition of the method.
+ functional
+ nil
+ path)))))
(call-with-block-external-functionals block #'handle-node)))))
(defun call-with-block-external-functionals (block fun)
nil)))))))
(defun internal-name-p (what)
- ;; Don't store XREF information for internals. We define as internal
- ;; anything named only by symbols from either implementation
- ;; packages, COMMON-LISP or KEYWORD. The last one is useful for
- ;; example when dealing with ctors.
+ ;; Unless we're building with SB-XREF-FOR-INTERNALS, don't store
+ ;; XREF information for internals. We define anything with a symbol
+ ;; from either an implementation package or from COMMON-LISP as
+ ;; internal
(typecase what
(list
(every #'internal-name-p what))
(symbol
+ #!+sb-xref-for-internals
+ (eq '.anonymous. what)
+ #!-sb-xref-for-internals
(or (eq '.anonymous. what)
(member (symbol-package what)
- (load-time-value (list* (find-package "COMMON-LISP")
- (find-package "KEYWORD")
- #+sb-xc-host (find-package "SB-XC")
- (remove-if-not
- (lambda (package)
- (= (mismatch "SB!"
- (package-name package))
- 3))
- (list-all-packages)))))
- #+sb-xc-host ; again, special case like in genesis and dump
+ (load-time-value
+ (list* (find-package "COMMON-LISP")
+ #+sb-xc-host (find-package "SB-XC")
+ (remove-if-not
+ (lambda (package)
+ (= (mismatch "SB!"
+ (package-name package))
+ 3))
+ (list-all-packages)))))
+ #+sb-xc-host ; again, special case like in genesis and dump
(multiple-value-bind (cl-symbol cl-status)
(find-symbol (symbol-name what) sb!int:*cl-package*)
(and (eq what cl-symbol) (eq cl-status :external)))))
(defun record-macroexpansion (what block path)
(unless (internal-name-p what)
- (push (cons what path) (block-macroexpands block))))
+ (push (list :macroexpands what path) (block-xrefs block))))
+
+(defun record-call (what block path)
+ (unless (internal-name-p what)
+ (push (list :calls what path) (block-xrefs block))))
;;; Pack the xref table that was stored for a functional into a more
;;; space-efficient form, and return that packed form.