(return-from record-component-xrefs))
(do ((block (block-next (component-head component)) (block-next block)))
((null (block-next block)))
- (let* ((this-cont (block-start block))
- (last (block-last block)))
+ (let ((start (block-start block)))
(flet ((handle-node (functional)
;; Record xref information for all nodes in the block.
;; Note that this code can get executed several times
;; for the same block, if the functional is referenced
;; from multiple XEPs.
- (loop for node = (ctran-next this-cont)
- then (ctran-next (node-next node))
- until (eq node last)
- do (record-node-xrefs node functional))
+ (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))
(defun record-node-xrefs (node context)
(declare (type node node))
(etypecase node
- ((or creturn cif entry mv-combination cast))
+ ((or creturn cif entry mv-combination cast exit))
(combination
;; Record references to globals made using SYMBOL-VALUE.
(let ((fun (principal-lvar-use (combination-fun node)))
(record-xref :calls name context node nil)))))
;; Inlined global function
(clambda
- (when (functional-inlinep leaf)
- (let ((name (leaf-debug-name leaf)))
- ;; FIXME: we should store the original var into the
- ;; functional when creating inlined-functionals, so that
- ;; we could just check whether it was a global-var,
- ;; rather then needing to guess based on the debug-name.
- (when (or (symbolp name)
- ;; Any non-SETF non-symbol names will
- ;; currently be either non-functions or
- ;; internals.
- (and (consp name)
- (equal (car name) 'setf)))
- ;; TODO: a WHO-INLINES xref-kind could be useful
- (record-xref :calls name context node nil)))))
+ (let ((inline-var (functional-inline-expanded leaf)))
+ (when (global-var-p inline-var)
+ ;; TODO: a WHO-INLINES xref-kind could be useful
+ (record-xref :calls (leaf-debug-name inline-var) context node nil))))
;; Reading a constant
(constant
- (let* ((name (constant-%source-name leaf)))
- (record-xref :references name context node nil))))))
+ (record-xref :references (ref-%source-name node) context node nil)))))
;; Setting a special variable
(cset
(let* ((var (set-var node)))
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
- (member (symbol-package what)
- (load-time-value (list* (find-package "COMMON-LISP")
- (find-package "KEYWORD")
- (remove-if-not
- (lambda (package)
- (= (mismatch "SB!"
- (package-name package))
- 3))
- (list-all-packages))))))
+ #!+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")
+ #+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)))))
(t t)))
(defun record-xref (kind what context node path)