diff options
author | Andy Wingo <wingo@pobox.com> | 2024-09-25 17:23:06 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2024-09-25 17:23:06 +0200 |
commit | 0dab58fc2a6ac6a8354439749d598f8c24f57ddd (patch) | |
tree | 6a2325c90f637a6deebfe208967ca231aa9c0a79 /module/language | |
parent | b04071cc579e7b9d38d0c999e731bdd94b7f7a78 (diff) | |
download | guile-0dab58fc2a6ac6a8354439749d598f8c24f57ddd.tar.gz |
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.
Diffstat (limited to 'module/language')
-rw-r--r-- | module/language/cps/specialize-numbers.scm | 27 |
1 files 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) |