From 30e65b004ace56e530469a364c35a6f5f5d686eb Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Thu, 17 Sep 2009 15:35:47 +0000 Subject: [PATCH] 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. --- NEWS | 2 ++ contrib/sb-introspect/xref-test-data.lisp | 19 +++++++++++++++++++ contrib/sb-introspect/xref-test.lisp | 3 +++ src/compiler/ir1tran-lambda.lisp | 21 +++++++++++++++++++++ src/compiler/node.lisp | 5 +++-- src/compiler/xref.lisp | 18 ++++-------------- version.lisp-expr | 2 +- 7 files changed, 53 insertions(+), 17 deletions(-) diff --git a/NEWS b/NEWS index 9afc309..707f189 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4