https://debbugs.gnu.org/cgi/bugreport.cgi?bug=71891 says the issue was fixed in aff9ac968840e9c86719fb613bd2ed3c39b9905c, but to avoid conflicts (which I don't know how to resolve, not knowing scheme), also pull in 5e6288c9304b60f1875a44808ee3858e3d6efc83 0dab58fc2a6ac6a8354439749d598f8c24f57ddd and e45b70dcded37eb77e71ec30445b12040b6bb1b7.
74 lines
3.1 KiB
Diff
74 lines
3.1 KiB
Diff
From 0dab58fc2a6ac6a8354439749d598f8c24f57ddd Mon Sep 17 00:00:00 2001
|
|
From: Andy Wingo <wingo@pobox.com>
|
|
Date: Wed, 25 Sep 2024 17:23:06 +0200
|
|
Subject: [PATCH] Fix fixpoint needed-bits computation in specialize-numbers
|
|
|
|
* module/language/cps/specialize-numbers.scm (next-power-of-two): Use
|
|
integer-length. No change.
|
|
(compute-significant-bits): Fix the fixpoint computation, which was
|
|
failing to complete in some cases with loops.
|
|
---
|
|
module/language/cps/specialize-numbers.scm | 27 ++++++++--------------
|
|
1 file changed, 10 insertions(+), 17 deletions(-)
|
|
|
|
diff --git a/module/language/cps/specialize-numbers.scm b/module/language/cps/specialize-numbers.scm
|
|
index cd884533c..f70c28e08 100644
|
|
--- a/module/language/cps/specialize-numbers.scm
|
|
+++ b/module/language/cps/specialize-numbers.scm
|
|
@@ -265,10 +265,7 @@
|
|
(sigbits-intersect a (sigbits-intersect b c)))
|
|
|
|
(define (next-power-of-two n)
|
|
- (let lp ((out 1))
|
|
- (if (< n out)
|
|
- out
|
|
- (lp (ash out 1)))))
|
|
+ (ash 1 (integer-length n)))
|
|
|
|
(define (range->sigbits min max)
|
|
(cond
|
|
@@ -310,18 +307,16 @@
|
|
BITS indicating the significant bits needed for a variable. BITS may be
|
|
#f to indicate all bits, or a non-negative integer indicating a bitmask."
|
|
(let ((preds (invert-graph (compute-successors cps kfun))))
|
|
- (let lp ((worklist (intmap-keys preds)) (visited empty-intset)
|
|
- (out empty-intmap))
|
|
+ (let lp ((worklist (intmap-keys preds)) (out empty-intmap))
|
|
(match (intset-prev worklist)
|
|
(#f out)
|
|
(label
|
|
- (let ((worklist (intset-remove worklist label))
|
|
- (visited* (intset-add visited label)))
|
|
+ (let ((worklist (intset-remove worklist label)))
|
|
(define (continue out*)
|
|
- (if (and (eq? out out*) (eq? visited visited*))
|
|
- (lp worklist visited out)
|
|
+ (if (eq? out out*)
|
|
+ (lp worklist out)
|
|
(lp (intset-union worklist (intmap-ref preds label))
|
|
- visited* out*)))
|
|
+ out*)))
|
|
(define (add-def out var)
|
|
(intmap-add out var 0 sigbits-union))
|
|
(define (add-defs out vars)
|
|
@@ -352,12 +347,10 @@ BITS indicating the significant bits needed for a variable. BITS may be
|
|
(($ $values args)
|
|
(match (intmap-ref cps k)
|
|
(($ $kargs _ vars)
|
|
- (if (intset-ref visited k)
|
|
- (fold (lambda (arg var out)
|
|
- (intmap-add out arg (intmap-ref out var)
|
|
- sigbits-union))
|
|
- out args vars)
|
|
- out))
|
|
+ (fold (lambda (arg var out)
|
|
+ (intmap-add out arg (intmap-ref out var (lambda (_) 0))
|
|
+ sigbits-union))
|
|
+ out args vars))
|
|
(($ $ktail)
|
|
(add-unknown-uses out args))))
|
|
(($ $call proc args)
|
|
--
|
|
2.34.1
|
|
|