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

Remove needless label remapping in slot-allocation

Browse source 
* module/language/cps/slot-allocation.scm (dead-after-def?):
  (dead-after-use?, allocate-slots): Remove some needless remapping
  between label indexes in the CFA, the DFA, and their names.
This commit is contained in:
Andy Wingo 2014-04-15 12:25:26 +02:00
parent 21a528fd82
commit 863034a8ac
1 changed files with 9 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

27
module/language/cps/slot-allocation.scm
View file

@ -223,13 +223,11 @@ are comparable with eqv?. A tmp slot may be used."
tmp) tmp)
(loop to-move b (cons s+d moved) last-source)))))))))) (loop to-move b (cons s+d moved) last-source))))))))))
(define (dead-after-def? def-k v-idx dfa) (define (dead-after-def? k-idx v-idx dfa)
(let ((l (dfa-k-idx dfa def-k))) (not (bitvector-ref (dfa-k-in dfa k-idx) v-idx)))
(not (bitvector-ref (dfa-k-in dfa l) v-idx))))
(define (dead-after-use? use-k v-idx dfa) (define (dead-after-use? k-idx v-idx dfa)
(let ((l (dfa-k-idx dfa use-k))) (not (bitvector-ref (dfa-k-out dfa k-idx) v-idx)))
(not (bitvector-ref (dfa-k-out dfa l) v-idx))))
(define (allocate-slots fun dfg) (define (allocate-slots fun dfg)
(let* ((dfa (compute-live-variables fun dfg)) (let* ((dfa (compute-live-variables fun dfg))
@ -275,7 +273,7 @@ are comparable with eqv?. A tmp slot may be used."
(1- (find-first-trailing-zero live-slots))) (1- (find-first-trailing-zero live-slots)))
(define (recompute-live-slots k nargs) (define (recompute-live-slots k nargs)
(let ((in (dfa-k-in dfa (dfa-k-idx dfa k)))) (let ((in (dfa-k-in dfa (label->idx k))))
(let lp ((v 0) (live-slots (1- (ash 1 (1+ nargs))))) (let lp ((v 0) (live-slots (1- (ash 1 (1+ nargs)))))
(let ((v (bit-position #t in v))) (let ((v (bit-position #t in v)))
(if v (if v
@ -384,7 +382,7 @@ are comparable with eqv?. A tmp slot may be used."
;; predecessor. ;; predecessor.
((or (_) ((? kreceive-get-kargs) ...)) ((or (_) ((? kreceive-get-kargs) ...))
(for-each (lambda (var) (for-each (lambda (var)
(when (dead-after-def? (idx->label n) var dfa) (when (dead-after-def? n var dfa)
(bitvector-set! needs-slotv var #f))) (bitvector-set! needs-slotv var #f)))
(vector-ref defv n))) (vector-ref defv n)))
(_ #f)) (_ #f))
@ -399,17 +397,10 @@ are comparable with eqv?. A tmp slot may be used."
;; frames as soon as it's known that a call will happen. It would ;; frames as soon as it's known that a call will happen. It would
;; be nice to recast this as a proper data-flow problem. ;; be nice to recast this as a proper data-flow problem.
(define (compute-needs-hint!) (define (compute-needs-hint!)
;; We traverse the graph using reverse-post-order on a forward
;; control-flow graph, but we did the live variable analysis in
;; the opposite direction -- so the continuation numbers don't
;; correspond. This helper adapts them.
(define (label-idx->dfa-k-idx n)
(dfa-k-idx dfa (idx->label n)))
(define (live-before n) (define (live-before n)
(dfa-k-in dfa (label-idx->dfa-k-idx n))) (dfa-k-in dfa n))
(define (live-after n) (define (live-after n)
(dfa-k-out dfa (label-idx->dfa-k-idx n))) (dfa-k-out dfa n))
;; Walk backwards. At a call, compute the set of variables that ;; Walk backwards. At a call, compute the set of variables that
;; have allocated slots and are live before but not after. This ;; have allocated slots and are live before but not after. This
@ -611,7 +602,7 @@ are comparable with eqv?. A tmp slot may be used."
(let ((slot (vector-ref slots v))) (let ((slot (vector-ref slots v)))
(if (and slot (if (and slot
(> slot nargs) (> slot nargs)
(pred (idx->label n) v dfa)) (pred n v dfa))
(kill-dead-slot slot live) (kill-dead-slot slot live)
live))) live)))
live live