[Guile-commits] 02/10: Fix slot allocation hinting for intervening terms that define dead values

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 8eea1fb1429d30053441706b1967130a3c9794ef
Author: Andy Wingo <address@hidden>
Date:   Fri Jun 5 00:13:47 2015 +0200

    Fix slot allocation hinting for intervening terms that define dead values
    
    * module/language/cps/slot-allocation.scm (allocate-slots): Even if an
      expression does not define a live value, it might need a place to
      put its value.  In that case we should stop scanning for hints,
      otherwise e.g. an (current-module) primcall whose value isn't used
      could clobber a hinted variable.
---
 module/language/cps/slot-allocation.scm |   17 ++++++++++++++---
 1 files changed, 14 insertions(+), 3 deletions(-)

diff --git a/module/language/cps/slot-allocation.scm 
b/module/language/cps/slot-allocation.scm
index f9a8695..d8cbd15 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -459,10 +459,21 @@ are comparable with eqv?.  A tmp slot may be used."
                        ;; assumptions that slots not allocated are not
                        ;; used.
                        ($ $values (or () (_))))
+                   (define (intset-empty? intset) (not (intset-next intset)))
                    (let ((killed (intset-subtract (live-before n) (live-after 
n))))
-                     (if (intset-next (intset-intersect killed needs-slot) #f)
-                         (finish-hints n (live-before n) args)
-                         (scan-for-hints (1- n) args))))
+                     ;; If the expression kills no values needing slots,
+                     ;; and defines no value needing a slot that's not
+                     ;; in our args, then we keep on trucking.
+                     (if (intset-empty? (intset-intersect
+                                         (fold (lambda (def clobber)
+                                                 (if (intset-ref args def)
+                                                     clobber
+                                                     (intset-add clobber def)))
+                                               killed
+                                               (vector-ref defv n))
+                                         needs-slot))
+                         (scan-for-hints (1- n) args)
+                         (finish-hints n (live-before n) args))))
                   ((or ($ $call) ($ $callk) ($ $values) ($ $branch))
                    (finish-hints n (live-before n) args))))
                ;; Otherwise we kill uses of the block entry.