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

@@ -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
 

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

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

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

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"