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

Be more diligent about deleted nodes in do-nodes :restart-p t

Browse source 
Fixes lp#2166714
This commit is contained in:
Stas Boukarev 2026-09-08 03:41:40 +03:00
parent 39aa19ebee
commit d638084646
2 changed files with 23 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
src/compiler/macros.lisp
View file

@ -597,7 +597,11 @@
(cond
((not next)
(return))
((eq (ctran-block next) ,n-block)
((and (eq (ctran-block next) ,n-block)
;; unlink-node only resets node-prev, not node-next
;; don't follow node-next if it's been just deleted.
;; (node-prev ,node-var)
)
(ctran-next next))
(t
(let ((start (block-start ,n-block)))
@ -609,10 +613,10 @@
(ctran-next it))
(t (return)))))
,@(when lvar-var
`((,lvar-var (when (valued-node-p ,node-var)
(node-lvar ,node-var))
(when (valued-node-p ,node-var)
(node-lvar ,node-var))))))
`((,lvar-var (when (valued-node-p ,node-var)
(node-lvar ,node-var))
(when (valued-node-p ,node-var)
(node-lvar ,node-var))))))
(nil)
,@body
,@(when restart-p

32
tests/compiler-2.pure.lisp
View file

@ -3779,24 +3779,20 @@
(the (integer -504635362412860905 -99686857090873309) (lognand b 11))))))
(with-test (:name :not-folded-vops)
(assert
(type-specifiers-equal
(caddr
(sb-kernel:%simple-fun-type
(checked-compile
`(lambda ()
(floor
(dpb 42
(byte 15 7)
(block b
(loop for lv below 1 count
(floor
(flet ((%f (f1)
(- (floor f1 f1) (return-from b -9))))
(multiple-value-call #'%f (values (block b3 lv))))
42))))
42)))))
'(values (integer -99734 -99734) (integer 19 19) &optional))))
(assert-type
(lambda ()
(floor
(dpb 42
(byte 15 7)
(block b
(loop for lv below 1 count
(floor
(flet ((%f (f1)
(- (floor f1 f1) (return-from b -9))))
(multiple-value-call #'%f (values (block b3 lv))))
42))))
42))
nil))
(with-test (:name :bit-ir2opt)
(checked-compile-and-assert