mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 06:50:31 +02:00
Code Activity

Fix bug in compute-significant-bits for phi predecessors

Browse source 
* module/language/cps/specialize-numbers.scm (compute-significant-bits):
  Always revisit predecessors after first visit.  Avoids situation where
  predecessor of an unvisited phi var could default to 0 significant
  bits and never be revisited.  Fixes (format #f "~2f" 9.9).
This commit is contained in:
Andy Wingo 2016-12-14 17:14:15 +01:00
parent 37551e40b8
commit 2660c0b3c8
1 changed files with 15 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL) ;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2015 Free Software Foundation, Inc. ;; Copyright (C) 2015, 2016 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -197,15 +197,18 @@
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)) (out empty-intmap)) (let lp ((worklist (intmap-keys preds)) (visited empty-intset)
(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 (eq? out out*) (if (and (eq? out out*) (eq? visited visited*))
(lp worklist out) (lp worklist visited out)
(lp (intset-union worklist (intmap-ref preds label)) out*))) (lp (intset-union worklist (intmap-ref preds label))
visited* 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)
@ -233,11 +236,12 @@ 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)
(fold (lambda (arg var out) (if (intset-ref visited k)
(intmap-add out arg (intmap-ref out var (fold (lambda (arg var out)
(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)