1.0.28.44: better MACHINE-VERSION answers on BSD'ish platforms

[sbcl.git] / src / compiler / xref.lisp

diff --git a/src/compiler/xref.lisp b/src/compiler/xref.lisp
index 40c0d37..a358784 100644 (file)
--- a/src/compiler/xref.lisp
+++ b/src/compiler/xref.lisp
@@ -19,16 +19,15 @@
     (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))
@@ -80,7 +79,14 @@
 (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
@@ -111,8 +117,7 @@
                 (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)))
@@ -143,15 +148,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)