wingo pushed a commit to branch master in repository guile. commit 8eea1fb1429d30053441706b1967130a3c9794ef Author: Andy Wingo <wi...@pobox.com> 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.