master: Avoid infinite recursion in remove-moves
stassats via Sbcl-commits <[email protected]> Fri, 31 Jul 2026 22:49:00 +0000
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via efed52323627a941c0fb430b4c8e45be5190bcb2 (commit)
from ed2340f71ac49df95e0fe4fd201f3ac5a0e3c13b (commit)
- Log -----------------------------------------------------------------
commit efed52323627a941c0fb430b4c8e45be5190bcb2
Author: Stas Boukarev <[email protected]>
Date: Sat Aug 1 01:46:49 2026 +0300
Avoid infinite recursion in remove-moves
Fixes lp#2162597
---
src/compiler/generic/utils.lisp | 18 ++++++++++++------
1 file changed, 12 insertions(+), 6 deletions(-)
diff --git a/src/compiler/generic/utils.lisp b/src/compiler/generic/utils.lisp
index a34c1e4b3..c18306d14 100644
--- a/src/compiler/generic/utils.lisp
+++ b/src/compiler/generic/utils.lisp
@@ -369,12 +369,18 @@
:symbol)))
(defun remove-moves (tn)
- (or (let ((write (sb-c::tn-writes tn)))
- (when (and write (not (tn-ref-next write)))
- (let ((vop (tn-ref-vop write)))
- (when (and vop (eq (vop-name vop) 'move))
- (remove-moves (tn-ref-tn (vop-args vop)))))))
- tn))
+ (declare (type tn tn))
+ (labels ((remove-move (tn &optional seen)
+ (or
+ (unless (member tn seen)
+ (let ((write (sb-c::tn-writes tn)))
+ (when (and write (not (tn-ref-next write)))
+ (let ((vop (tn-ref-vop write)))
+ (when (and vop (eq (vop-name vop) 'move))
+ (remove-move (tn-ref-tn (vop-args vop))
+ (cons tn seen)))))))
+ tn)))
+ (remove-move tn)))
;;; Note that this is a allowed to fail by returning NIL.
;;; So it's really testing "CERTAINLY-STACK-CONSED-P", which is
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL