From ed72064bbc8203d70526388e90d6858c28a6db25 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 3 Nov 2008 18:09:38 +0000 Subject: [PATCH] 1.0.22.13: fixed bug 426: nested inline expansion failure * In RECOGNIZE-KNOWN-CALL, if an inline function has already been converted in the component, replace the REF-LEAF with the functional. * Test cases. --- BUGS | 24 ---------------------- NEWS | 3 +++ src/compiler/ir1opt.lisp | 38 ++++++++++++++++++++-------------- tests/compiler.impure.lisp | 49 ++++++++++++++++++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 5 files changed, 76 insertions(+), 40 deletions(-) diff --git a/BUGS b/BUGS index 1a35b01..f58784a 100644 --- a/BUGS +++ b/BUGS @@ -1857,30 +1857,6 @@ generally try to check returns in safe code, so we should here too.) (Test-case adapted from CL-PPCRE.) -426: inlining failure involving multiple nested calls - - (declaim (inline foo)) - (defun foo (x y) - (cons x y)) - (defun bar (x) - (foo (foo x x) (foo x x))) - ;; shows a full call to FOO - (disassemble 'bar) - ;; simple way to test this programmatically - (let ((code (sb-c::fun-code-header #'bar)) - (foo (sb-impl::fdefinition-object 'foo nil))) - (loop for i from sb-vm:code-constants-offset below (sb-kernel:get-header-data code) - do (assert (not (eq foo (sb-kernel:code-header-ref code i)))))) - - This appears to be an ancient bug, inherited from CMUCL: reportedly - 18c does the same thing. RECOGNIZE-KNOWN-CALL correctly picks up only - one of the calls, but local call analysis fails to inline the call - for the second time. Nikodemus thinks (but is not 100% sure based on - very brief investigation) that the call that is not inlined is the - second nested one. A trivial fix is to call CHANGE-REF-LEAF in known - call for functions already inline converted there, but he is not sure - if this has adverse effects elsewhere. - 428: TIMER SCHEDULE-STRESS and PARALLEL-UNSCHEDULE in timer.impure.lisp fails diff --git a/NEWS b/NEWS index 4e54130..a3de845 100644 --- a/NEWS +++ b/NEWS @@ -11,6 +11,9 @@ changes in sbcl-1.0.23 relative to 1.0.22: now interact correctly with type declarations. * partial bug fix: PCL detects infinite recursion during wrapper validation. (thanks to Attila Lendvai) + * bug fix: #426; nested function calls are inlined properly. + Previously if FOO was an inline function, in calls of the form + (FOO (FOO ...)) the outer call was not inlined. changes in sbcl-1.0.22 relative to 1.0.21: * minor incompatible change: LOAD-SHARED-OBJECT no longer by default looks diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index b8b0054..9fe8589 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -849,14 +849,18 @@ ((nil :maybe-inline) (policy call (zerop space)))) (defined-fun-p leaf) (defined-fun-inline-expansion leaf) - (let ((fun (defined-fun-functional leaf))) - (or (not fun) - (and (eq inlinep :inline) (functional-kind fun)))) (inline-expansion-ok call)) - (flet (;; FIXME: Is this what the old CMU CL internal documentation - ;; called semi-inlining? A more descriptive name would - ;; be nice. -- WHN 2002-01-07 - (frob () + ;; Inline: if the function has already been converted at another call + ;; site in this component, we point this REF to the functional. If not, + ;; we convert the expansion. + ;; + ;; For :INLINE case local call analysis will copy the expansion later, + ;; but for :MAYBE-INLINE and NIL cases we only get one copy of the + ;; expansion per component. + ;; + ;; FIXME: We also convert in :INLINE & FUNCTIONAL-KIND case below. What + ;; is it for? + (flet ((frob () (let* ((name (leaf-source-name leaf)) (res (ir1-convert-inline-expansion name @@ -868,14 +872,18 @@ ;; following top level forms (setf (defined-fun-functional leaf) res) (change-ref-leaf ref res)))) - (if ir1-converting-not-optimizing-p - (frob) - (with-ir1-environment-from-node call - (frob) - (locall-analyze-component *current-component*)))) - - (values (ref-leaf (lvar-uses (basic-combination-fun call))) - nil)) + (let ((fun (defined-fun-functional leaf))) + (if (or (not fun) + (and (eq inlinep :inline) (functional-kind fun))) + ;; Convert. + (if ir1-converting-not-optimizing-p + (frob) + (with-ir1-environment-from-node call + (frob) + (locall-analyze-component *current-component*))) + ;; If we've already converted, change ref to the converted functional. + (change-ref-leaf ref fun)))) + (values (ref-leaf ref) nil)) (t (let ((info (info :function :info (leaf-source-name leaf)))) (if info diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index 6c8ed83..1a0f385 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -953,6 +953,55 @@ (assert (equal '(function (t &optional t) (values t &optional)) (sb-kernel:type-specifier (sb-int:info :function :type name)))))) +;;;; inline & maybe inline nested calls + +(defun quux-marker (x) x) +(declaim (inline foo-inline)) +(defun foo-inline (x) (quux-marker x)) +(declaim (maybe-inline foo-maybe-inline)) +(defun foo-maybe-inline (x) (quux-marker x)) +;; Pretty horrible, but does the job +(defun count-full-calls (name function) + (let ((code (with-output-to-string (s) + (disassemble function :stream s))) + (n 0)) + (with-input-from-string (s code) + (loop for line = (read-line s nil nil) + while line + when (search name line) + do (incf n))) + n)) + +(with-test (:name :nested-inline-calls) + (let ((fun (compile nil `(lambda (x) + (foo-inline (foo-inline (foo-inline x))))))) + (assert (= 0 (count-full-calls "FOO-INLINE" fun))) + (assert (= 3 (count-full-calls "QUUX-MARKER" fun))))) + +(with-test (:name :nested-maybe-inline-calls) + (let ((fun (compile nil `(lambda (x) + (declare (optimize (space 0))) + (foo-maybe-inline (foo-maybe-inline (foo-maybe-inline x))))))) + (assert (= 0 (count-full-calls "FOO-MAYBE-INLINE" fun))) + (assert (= 1 (count-full-calls "QUUX-MARKER" fun))))) + +(with-test (:name :inline-calls) + (let ((fun (compile nil `(lambda (x) + (list (foo-inline x) + (foo-inline x) + (foo-inline x)))))) + (assert (= 0 (count-full-calls "FOO-INLINE" fun))) + (assert (= 3 (count-full-calls "QUUX-MARKER" fun))))) + +(with-test (:name :maybe-inline-calls) + (let ((fun (compile nil `(lambda (x) + (declare (optimize (space 0))) + (list (foo-maybe-inline x) + (foo-maybe-inline x) + (foo-maybe-inline x)))))) + (assert (= 0 (count-full-calls "FOO-MAYBE-INLINE" fun))) + (assert (= 1 (count-full-calls "QUUX-MARKER" fun))))) + ;;;; tests not in the problem domain, but of the consistency of the ;;;; compiler machinery itself diff --git a/version.lisp-expr b/version.lisp-expr index 44d80aa..cf64264 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.22.12" +"1.0.22.13" -- 1.7.10.4