(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
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
((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
;; 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
(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)))))
+
\f
;;;; tests not in the problem domain, but of the consistency of the
;;;; compiler machinery itself
;;; 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"
projects / sbcl.git / commitdiff