common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

assignment-convert: Don't try to be so smart with cleanups.

Browse source 
Trying to assignment convert more lambdas whose calls have different
cleanups but not modulo harmfulness only *almost* works. While
conceptually it's fine, it causes problems during cleanup
emission. When we merge lambdas, we anchor to a specific
lexenv/cleanup, not to the messiest common ancestor. Since cleaup
emission itself has no notion of skipping harmless cleanups, it tries
to emit cleanups when it shouldn't, breaking things. I think the
actual correct as in optimal way to do it is to make cleanup emission
also ignore harmless cleanups as well, but that gets a bit hairy with
the existing cleanup sharing code in EMIT-CLEANUPS. So give up and go
back to the slightly dumber cleanup checking code.

No LLM/AI was used to diagnose this issue, so the responsibility for
this rambling is mine.

Unfortunately, a few of the assignment conversion tests (but not all of
the new ones) have to be turned off because the block tag introduced
by labels gets in the way of the optimization. Even for these tests we
still contify more than before though.

Fixes #lp2162990.
This commit is contained in:
Charles Zhang 2026-08-07 22:27:30 +02:00
parent 4727a49892
commit 6cbab77cdb
3 changed files with 49 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
src/compiler/locall.lisp
View file

@ -1461,17 +1461,10 @@
;;;; tail local calls and assignments
;;; Return T if the cleanup definitely won't generate any cleanup
;;; code. Currently we recognize lexical entry points that are only
;;; used locally (if at all).
(defun harmless-cleanup-p (cleanup)
(case (cleanup-kind cleanup)
((:block :tagbody)
(null (entry-exits (cleanup-mess-up cleanup))))
(t nil)))
;;; Return T if there are no cleanups between BLOCK1 and
;;; BLOCK2, or if they definitely won't generate any cleanup code.
;;; Return T if there are no cleanups between BLOCK1 and BLOCK2, or if
;;; they definitely won't generate any cleanup code. Currently we
;;; recognize lexical entry points that are only used locally (if at
;;; all).
(defun only-harmless-cleanups (block1 block2)
(declare (type cblock block1 block2))
(or (eq block1 block2)
@ -1479,16 +1472,11 @@
(do-nested-cleanups (cleanup block1 t)
(when (eq cleanup cleanup2)
(return t))
(unless (harmless-cleanup-p cleanup)
(return nil))))))
;;; Return the innermost cleanup enclosing NODE which would actually
;;; generate any cleanup code, or NIL if there is none.
(defun node-real-enclosing-cleanup (node)
(declare (type node node))
(do-nested-cleanups (cleanup node nil)
(unless (harmless-cleanup-p cleanup)
(return cleanup))))
(case (cleanup-kind cleanup)
((:block :tagbody)
(when (entry-exits (cleanup-mess-up cleanup))
(return nil)))
(t (return nil)))))))
;;; If a potentially TR local call really is TR, then convert it to
;;; jump directly to the called function. We also call
@ -1672,7 +1660,7 @@
(lvar (and (valued-node-p call)
(node-lvar call)))
(env (node-home-lambda call))
(cleanup (node-real-enclosing-cleanup call)))
(cleanup (node-enclosing-cleanup call)))
(aver env)
(cond ((null return-env)
(setq return-ctran ctran
@ -1681,11 +1669,19 @@
return-cleanup cleanup)
t)
(t
;; We can only convert multiple outside calls when
;; they are all in the same environment, so we don't
;; muck up tail sets. This is not a conceptual
;; restriction though; it may be possible to lift
;; this if things are reworked.
;; We can only convert multiple outside calls
;; when they are all in the same environment, so
;; we don't muck up tail sets. This is not a
;; conceptual restriction though; it may be
;; possible to lift this if things are
;; reworked. The cleanup checking here is also
;; overly conservative. A better approach would
;; be to check for harmful cleanups with respect
;; to the messiest common ancestor, though care
;; would need to be taken with cleanup emission
;; as merging lambdas will anchor to a specific
;; predecessor's lexenv/cleanup, not to the
;; ancestor's.
(and (or (eq (node-derived-type call) *empty-type*)
(and (eq return-ctran ctran)
(eq return-lvar lvar)))

13
tests/compiler-ir.pure.lisp
View file

@ -308,7 +308,12 @@
;;; cannot. In this case, FM, F, G and H all have the same
;;; continuation.
#+sb-devel
(with-test (:name (:assignment-convert :fluet-weeks-5.1))
(with-test (:name (:assignment-convert :fluet-weeks-5.1)
;; Unfortunately, this test and the next few almost work
;; but are defeated by the block tags inserted by LABELS
;; since we don't have smart enough cleanup logic in the
;; assignment conversion code.
:fails-on :sbcl)
(let ((converted '()))
(let ((fun (inspect-ir
'(lambda (b x y flag)
@ -342,7 +347,8 @@
;;; A modified version of the above test, but with an outside call for
;;; H.
#+sb-devel
(with-test (:name (:assignment-convert :fluet-weeks-5.1-modified))
(with-test (:name (:assignment-convert :fluet-weeks-5.1-modified)
:fails-on :sbcl)
(let ((converted '()))
(let ((fun (inspect-ir
'(lambda (b x y flag)
@ -382,7 +388,8 @@
;;; analysis. In this case, F, G1, G2 and H all have the same
;;; continuation.
#+sb-devel
(with-test (:name (:assignment-convert :fluet-weeks-5.2))
(with-test (:name (:assignment-convert :fluet-weeks-5.2)
:fails-on :sbcl)
(let ((converted '()))
(let ((fun (inspect-ir
'(lambda (b x y flag)

16
tests/compiler.pure.lisp
View file

@ -6363,3 +6363,19 @@
(recurse (the fixnum (1- x)) fn))))
(recurse x fn)))
:allow-notes nil))
(with-test (:name (:assignment-convert :lp2162990))
(checked-compile-and-assert ()
`(lambda (a)
(block done
(let ((done (lambda (&rest values) (return-from done (values-list values))))
(l (lambda ())))
(flet ((c (f)
(funcall f)))
(declare (inline c))
(if a
(c l)
(c l)))
(funcall done nil))))
((t) nil)
((nil) nil)))