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