X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fxref.lisp;h=4bf2fd08582705a748eff9f5c6bea4bf915c6e77;hb=95591ed483dbb8c0846c129953acac1554f28809;hp=53dbaafc197577c03efbaf091c3cd7e1872b3ef3;hpb=9669ea3219874406e66f3dca4554325d5e5b6318;p=sbcl.git diff --git a/src/compiler/xref.lisp b/src/compiler/xref.lisp index 53dbaaf..4bf2fd0 100644 --- a/src/compiler/xref.lisp +++ b/src/compiler/xref.lisp @@ -101,24 +101,13 @@ (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))) @@ -149,15 +138,21 @@ (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") + #+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)