(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 combination 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)))
+ (arg (car (combination-args node))))
+ (when (and (ref-p fun) (eq 'symbol-value (leaf-%source-name (ref-leaf fun)))
+ (constant-lvar-p arg) (symbolp (lvar-value arg)))
+ (record-xref :references (lvar-value arg) context node nil))))
(ref
(let ((leaf (ref-leaf node)))
(typecase leaf
(record-xref :calls name 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)))
(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))))))
+ (or (eq '.anonymous. what)
+ (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)))))))
(t t)))
(defun record-xref (kind what context node path)