1.0.31.13: working XREF for inlined lambda with hairy lambda-lists

 Reported by Peter Seibel.

 * When a function with a hairy lambda-list is converted, the
   functional we get back is an OPTIONAL-DISPATCH, which the XREF code
   never sees: we need to mark the entry-points as resulting from the
   inlining to have things work.

 * While at it, address a FIXME by annotating the CLAMBDAs with the
   original GLOBAL-VAR, so that we don't need to make guesses based on
   names.

diff --git a/NEWS b/NEWS
index 9afc309..707f189 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -6,6 +6,8 @@ changes relative to sbcl-1.0.31
     by David Vázquez)
   * improvement: better error signalling for bogus parameter specializer names
     in DEFMETHOD forms (reported by Pluijzer)
+  * bug fix: correct WHO-CALLS information for inlined lambdas with complex
+    lambda-lists. (reported by Peter Seibel)
   * bug fix: SAVE-LISP-AND-DIE option :SAVE-RUNTIME-OPTIONS did not work
     correctly when starting from an executable core without saved runtime
     options (reported by Faré Rideau, thanks to Zach Beane)

diff --git a/contrib/sb-introspect/xref-test-data.lisp b/contrib/sb-introspect/xref-test-data.lisp
index e76fbba..a839a44 100644 (file)
--- a/contrib/sb-introspect/xref-test-data.lisp
+++ b/contrib/sb-introspect/xref-test-data.lisp
@@ -175,4 +175,23 @@
                  (macro/1)))
       (inner-m))))
 
+;;; Inlining functions with non-trivial lambda-lists.
+(declaim (inline inline/3))
+(defun inline/3 (a &optional b &key c d)
+  (list a b c d))
+(defun inline/3-user/1 (a)
+  (inline/3 a))
+(defun inline/3-user/2 (a b)
+  (inline/3 a b))
+(defun inline/3-user/3 (a b c)
+  (inline/3 a b :c c))
+(defun inline/3-user/4 (a b c d)
+  (inline/3 a b :d d :c c))
+
+(declaim (inline inline/4))
+(defun inline/4 (a &rest more)
+  (cons a more))
+(defun inline/4-user ()
+  (inline/4 :a :b :c))
+
 ;;; Test references to / from compiler-macros

diff --git a/contrib/sb-introspect/xref-test.lisp b/contrib/sb-introspect/xref-test.lisp
index dd3b338..ee445a5 100644 (file)
--- a/contrib/sb-introspect/xref-test.lisp
+++ b/contrib/sb-introspect/xref-test.lisp
@@ -31,6 +31,9 @@
                      ((sb-introspect::who-calls 'xref/11) ())
                      ((sb-introspect::who-calls 'inline/1) (xref/12))
                      ((sb-introspect::who-calls 'xref/12) (macro/1))
+                     ((sb-introspect::who-calls 'inline/3)
+                      (inline/3-user/1 inline/3-user/2 inline/3-user/3 inline/3-user/4))
+                     ((sb-introspect::who-calls 'inline/4) (inline/4-user))
                      ((sb-introspect::who-macroexpands 'macro/1)
                       (macro-use/1 macro-use/2 macro-use/3 macro-use/4 inline/2))
                      ((sb-introspect::who-binds '*a*) (xref/2))

diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp
index 33fd5fd..b1ee7ee 100644 (file)
--- a/src/compiler/ir1tran-lambda.lisp
+++ b/src/compiler/ir1tran-lambda.lisp
@@ -1147,6 +1147,27 @@
     (setf (functional-inlinep fun) inlinep)
     (assert-new-definition var fun)
     (setf (defined-fun-inline-expansion var) expansion)
+    ;; Associate VAR with the FUN -- and in case of an optional dispatch
+    ;; with the various entry-points. This allows XREF to know where the
+    ;; inline CLAMBDA comes from.
+    (flet ((note-inlining (f)
+             (typecase f
+               (functional
+                (setf (functional-inline-expanded f) var))
+               (cons
+                ;; Delayed entry-point.
+                (if (car f)
+                    (setf (functional-inline-expanded (cdr f)) var)
+                    (let ((old-thunk (cdr f)))
+                      (setf (cdr f) (lambda ()
+                                      (let ((g (funcall old-thunk)))
+                                        (setf (functional-inline-expanded g) var)
+                                        g)))))))))
+      (note-inlining fun)
+      (when (optional-dispatch-p fun)
+        (note-inlining (optional-dispatch-main-entry fun))
+        (note-inlining (optional-dispatch-more-entry fun))
+        (mapc #'note-inlining (optional-dispatch-entry-points fun))))
     ;; substitute for any old references
     (unless (or (not *block-compile*)
                 (and info

diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp
index 2d9d405..8253e8e 100644 (file)
--- a/src/compiler/node.lisp
+++ b/src/compiler/node.lisp
@@ -871,8 +871,9 @@
   ;; xref information for this functional (only used for functions with an
   ;; XEP)
   (xref () :type list)
-  ;; True if this functional was created from an inline expansion
-  (inline-expanded nil :type boolean))
+  ;; True if this functional was created from an inline expansion. This
+  ;; is either T, or the GLOBAL-VAR for which it is an expansion.
+  (inline-expanded nil))
 (defprinter (functional :identity t)
   %source-name
   %debug-name

diff --git a/src/compiler/xref.lisp b/src/compiler/xref.lisp
index a358784..4bf2fd0 100644 (file)
--- 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)))))

diff --git a/version.lisp-expr b/version.lisp-expr
index b2f1639..f8042a4 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.31.12"
+"1.0.31.13"