guile-commits
[Top][All Lists]
Advanced

[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)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]