X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fxref.lisp;h=514042199b8ca5968a7558af9ebece6191efa740;hb=c553e4be6da2d18f0827f190589c88e837b8b8a6;hp=a358784cee98bb37324d63069bee6d10974458e6;hpb=16062fad470533e429a12ac9cd0b9e53aa0e1e90;p=sbcl.git

diff --git a/src/compiler/xref.lisp b/src/compiler/xref.lisp
index a358784..5140421 100644
--- a/src/compiler/xref.lisp
+++ b/src/compiler/xref.lisp
@@ -101,20 +101,10 @@
                (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
           (record-xref :references (ref-%source-name node) context node nil)))))
@@ -140,26 +130,29 @@
                         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)))))