mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Fix fixpoint needed-bits computation in specialize-numbers

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2024-09-25 17:23:06 +02:00
parent b04071cc57
commit 0dab58fc2a
1 changed files with 10 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

27
module/language/cps/specialize-numbers.scm
View file

@ -265,10 +265,7 @@
(sigbits-intersect a (sigbits-intersect b c))) (sigbits-intersect a (sigbits-intersect b c)))
(define (next-power-of-two n) (define (next-power-of-two n)
(let lp ((out 1)) (ash 1 (integer-length n)))
(if (< n out)
out
(lp (ash out 1)))))
(define (range->sigbits min max) (define (range->sigbits min max)
(cond (cond
@ -310,18 +307,16 @@
BITS indicating the significant bits needed for a variable. BITS may be 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." #f to indicate all bits, or a non-negative integer indicating a bitmask."
(let ((preds (invert-graph (compute-successors cps kfun)))) (let ((preds (invert-graph (compute-successors cps kfun))))
(let lp ((worklist (intmap-keys preds)) (visited empty-intset) (let lp ((worklist (intmap-keys preds)) (out empty-intmap))
(out empty-intmap))
(match (intset-prev worklist) (match (intset-prev worklist)
(#f out) (#f out)
(label (label
(let ((worklist (intset-remove worklist label)) (let ((worklist (intset-remove worklist label)))
(visited* (intset-add visited label)))
(define (continue out*) (define (continue out*)
(if (and (eq? out out*) (eq? visited visited*)) (if (eq? out out*)
(lp worklist visited out) (lp worklist out)
(lp (intset-union worklist (intmap-ref preds label)) (lp (intset-union worklist (intmap-ref preds label))
visited* out*))) out*)))
(define (add-def out var) (define (add-def out var)
(intmap-add out var 0 sigbits-union)) (intmap-add out var 0 sigbits-union))
(define (add-defs out vars) (define (add-defs out vars)
@ -352,12 +347,10 @@ BITS indicating the significant bits needed for a variable. BITS may be
(($ $values args) (($ $values args)
(match (intmap-ref cps k) (match (intmap-ref cps k)
(($ $kargs _ vars) (($ $kargs _ vars)
(if (intset-ref visited k) (fold (lambda (arg var out)
(fold (lambda (arg var out) (intmap-add out arg (intmap-ref out var (lambda (_) 0))
(intmap-add out arg (intmap-ref out var) sigbits-union))
sigbits-union)) out args vars))
out args vars)
out))
(($ $ktail) (($ $ktail)
(add-unknown-uses out args)))) (add-unknown-uses out args))))
(($ $call proc args) (($ $call proc args)