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

stack: Fix preservation of intervening stack lifetimes, again^n.

Browse source 
We were sometimes merging dynamic extent lifetimes in such a way that
the stack lvar of a dynamic extent later in the flowgraph was used
instead of the earliest one. Fix this by checking the state of the
stack and making sure that dynamic extents always end up taking on the
stack lvars of dynamic extents that happen before them in the
flowgraph when merging their lifetimes.

Fix found with assistance from Gemini Pro after much heavy hinting
from me. Extended commentary and test case reduction by me.

Fixes lp#2156347.
This commit is contained in:
Charles Zhang 2026-08-24 14:07:54 +02:00
parent 2f5e20b7af
commit b69b11cc26
2 changed files with 48 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
src/compiler/stack.lisp
View file

@ -147,7 +147,18 @@
;; the stack lvar (and hence the lifetime). We must do
;; this because stack allocated objects can't move;
;; object identity must be preserved and we can't in
;; general track all references.
;; general track all references. Because values can be
;; stack allocated before their corresponding dynamic
;; extent cleanup is in scope in the flow graph, and
;; this function does not simulate stack popping, we
;; need to look at both the lexical nesting and the
;; state of the stack in this graph walk to determine
;; if we should merge the stack lifetime here. In
;; particular, we check the state of the stack to make
;; sure that dynamic extents always end up taking on
;; the stack lvars of dynamic extents that happen
;; before them in the flow graph when merging their
;; lifetimes.
((memq info stack)
(when (or (enclose-p node) (combination-p node))
(do-nested-cleanups (cleanup node)
@ -156,7 +167,9 @@
(when (eq dynamic-extent mess-up)
(return))
(let ((old (dynamic-extent-info mess-up)))
(when (and old (not (eq info old)))
(when (and old
(not (eq info old))
(memq info (memq old stack)))
(setf (ir2-lvar-kind (lvar-info old)) :unused)
(setf (dynamic-extent-info mess-up) info))))))))
(t

33
tests/dynamic-extent.pure.lisp
View file

@ -2658,3 +2658,36 @@
(funcall f (cons y x)))))
((1 2 t) nil)
((3 2 nil) nil)))
(with-test (:name :dynamic-extent-lp2156347)
(checked-compile-and-assert
()
'(lambda (n j)
(let ((elt
(let ((cr (make-array (the integer n))))
(declare (dynamic-extent cr))
(if j
(list (list 1)
(let ((n (make-array (length cr))))
(declare (dynamic-extent n))
n))))))
(declare (dynamic-extent elt))
(assert (sb-ext:stack-allocated-p elt))))
((0 t) nil)))
(with-test (:name :dynamic-extent-lp2156347.reduced)
(checked-compile-and-assert
()
'(lambda (n j)
(let ((elt
(let ((cr (cons n 2)))
(declare (dynamic-extent cr))
(if j
(list (list 1)
(let ((z (cons cr 2)))
(declare (dynamic-extent z))
z))))))
(declare (dynamic-extent elt))
(assert (sb-ext:stack-allocated-p elt))
2))
((0 t) 2)))