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

compute-live-variables uses CFA analysis

Browse source 
* module/language/cps/dfg.scm ($dfa): Store a CFA instead of a separate
  k-map and order.
  (dfa-k-idx, dfa-k-sym, dfa-k-count): Adapt.
  (compute-live-variables): Use analyze-control-flow instead of rolling
  out own RPO numbering.  Will allow us to fix some prompt-related
  things in a central place.
This commit is contained in:
Andy Wingo 2014-01-09 10:56:22 +01:00
parent 6eb0296027
commit f235f926d1
1 changed files with 48 additions and 73 deletions
Download patch file Download diff file Expand all files Collapse all files

71
module/language/cps/dfg.scm
View file

@ -495,12 +495,10 @@
;; Data-flow analysis. ;; Data-flow analysis.
(define-record-type $dfa (define-record-type $dfa
(make-dfa k-map order var-map names syms in out) (make-dfa cfa var-map names syms in out)
dfa? dfa?
;; Hash table mapping k-sym -> k-idx ;; CFA, for its reverse-post-order numbering
(k-map dfa-k-map) (cfa dfa-cfa)
;; Vector of k-idx -> k-sym
(order dfa-order)
;; Hash table mapping var-sym -> var-idx ;; Hash table mapping var-sym -> var-idx
(var-map dfa-var-map) (var-map dfa-var-map)
;; Vector of var-idx -> name ;; Vector of var-idx -> name
@ -513,14 +511,13 @@
(out dfa-out)) (out dfa-out))
(define (dfa-k-idx dfa k) (define (dfa-k-idx dfa k)
(or (hashq-ref (dfa-k-map dfa) k) (cfa-k-idx (dfa-cfa dfa) k))
(error "unknown k" k)))
(define (dfa-k-sym dfa idx) (define (dfa-k-sym dfa idx)
(vector-ref (dfa-order dfa) idx)) (cfa-k-sym (dfa-cfa dfa) idx))
(define (dfa-k-count dfa) (define (dfa-k-count dfa)
(vector-length (dfa-order dfa))) (cfa-k-count (dfa-cfa dfa)))
(define (dfa-var-idx dfa var) (define (dfa-var-idx dfa var)
(or (hashq-ref (dfa-var-map dfa) var) (or (hashq-ref (dfa-var-map dfa) var)
@ -550,38 +547,15 @@
(set! n (1+ n))) (set! n (1+ n)))
use-maps) use-maps)
(values mapping n))) (values mapping n)))
(define (block-accessor blocks accessor)
(lambda (k)
(accessor (lookup-block k blocks))))
(define (renumbering-accessor mapping blocks accessor)
(lambda (k)
(map (cut hashq-ref mapping <>)
((block-accessor blocks accessor) k))))
(match fun
(($ $fun src meta free
(and entry
($ $cont kentry ($ $kentry self ($ $cont ktail tail)))))
(call-with-values (lambda () (make-variable-mapping (dfg-use-maps dfg))) (call-with-values (lambda () (make-variable-mapping (dfg-use-maps dfg)))
(lambda (var-map nvars) (lambda (var-map nvars)
(define (fold-all-conts f seed) (let* ((cfa (analyze-control-flow fun dfg #:reverse? #t))
(fold-local-conts (lambda (k cont seed) (f k seed))
seed entry))
(let* ((blocks (dfg-blocks dfg))
(order (reverse-post-order ktail
(block-accessor blocks block-preds)
fold-all-conts))
(k-map (make-block-mapping order))
(succs (convert-predecessors
order
(renumbering-accessor k-map blocks block-succs)))
(syms (make-vector nvars #f)) (syms (make-vector nvars #f))
(names (make-vector nvars #f)) (names (make-vector nvars #f))
(usev (make-vector (vector-length order) '())) (usev (make-vector (cfa-k-count cfa) '()))
(defv (make-vector (vector-length order) '())) (defv (make-vector (cfa-k-count cfa) '()))
(live-in (make-vector (vector-length order) #f)) (live-in (make-vector (cfa-k-count cfa) #f))
(live-out (make-vector (vector-length order) #f))) (live-out (make-vector (cfa-k-count cfa) #f)))
(define (k->idx k)
(or (hashq-ref k-map k) (error "unknown k" k)))
;; Initialize syms, names, defv, and usev. ;; Initialize syms, names, defv, and usev.
(hash-for-each (hash-for-each
(lambda (sym use-map) (lambda (sym use-map)
@ -592,10 +566,10 @@
(vector-set! syms v sym) (vector-set! syms v sym)
(vector-set! names v name) (vector-set! names v name)
(for-each (lambda (def) (for-each (lambda (def)
(vector-push! defv (k->idx def) v)) (vector-push! defv (cfa-k-idx cfa def) v))
((block-accessor blocks block-preds) def)) (block-preds (lookup-block def (dfg-blocks dfg))))
(for-each (lambda (use) (for-each (lambda (use)
(vector-push! usev (k->idx use) v)) (vector-push! usev (cfa-k-idx cfa use) v))
uses))))) uses)))))
(dfg-use-maps dfg)) (dfg-use-maps dfg))
@ -608,16 +582,17 @@
;; Liveness is a reverse data-flow problem, so we give ;; Liveness is a reverse data-flow problem, so we give
;; compute-maximum-fixed-point a reversed graph, swapping in ;; compute-maximum-fixed-point a reversed graph, swapping in
;; and out, usev and defv, using successors instead of ;; for out, and usev for defv. Note that since we are using
;; predecessors, and starting with ktail instead of the ;; a reverse CFA, cfa-preds are actually successors, and
;; entry. ;; continuation 0 is ktail.
(compute-maximum-fixed-point succs live-out live-in defv usev #t) (compute-maximum-fixed-point (cfa-preds cfa)
live-out live-in defv usev #t)
(make-dfa k-map order var-map names syms live-in live-out))))))) (make-dfa cfa var-map names syms live-in live-out)))))
(define (print-dfa dfa) (define (print-dfa dfa)
(match dfa (match dfa
(($ $dfa k-map order var-map names syms in out) (($ $dfa cfa var-map names syms in out)
(define (print-var-set bv) (define (print-var-set bv)
(let lp ((n 0)) (let lp ((n 0))
(let ((n (bit-position #t bv n))) (let ((n (bit-position #t bv n)))
@ -625,8 +600,8 @@
(format #t " ~A" (vector-ref syms n)) (format #t " ~A" (vector-ref syms n))
(lp (1+ n)))))) (lp (1+ n))))))
(let lp ((n 0)) (let lp ((n 0))
(when (< n (vector-length order)) (when (< n (cfa-k-count cfa))
(format #t "~A:\n" (vector-ref order n)) (format #t "~A:\n" (cfa-k-sym cfa n))
(format #t " in:") (format #t " in:")
(print-var-set (vector-ref in n)) (print-var-set (vector-ref in n))
(newline) (newline)