[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/04: Fix fixpoint needed-bits computation in specializ
From: |
Andy Wingo |
Subject: |
[Guile-commits] 02/04: Fix fixpoint needed-bits computation in specialize-numbers |
Date: |
Wed, 25 Sep 2024 11:46:03 -0400 (EDT) |
wingo pushed a commit to branch main
in repository guile.
commit 0dab58fc2a6ac6a8354439749d598f8c24f57ddd
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Wed Sep 25 17:23:06 2024 +0200
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)