1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 23:00:22 +02:00

Fix DCE for refactor-introduced borkage

* module/language/cps/dce.scm ($fun-data, compute-live-code)
  (process-eliminations): Fix clownshoes regarding fun-data field names
  and order.
This commit is contained in:
Andy Wingo 2014-04-02 15:41:14 +02:00
parent b7dc00b1e7
commit ce1dbe8c1b

View file

@ -43,11 +43,10 @@
#:export (eliminate-dead-code)) #:export (eliminate-dead-code))
(define-record-type $fun-data (define-record-type $fun-data
(make-fun-data min-label effects conts live-conts defs) (make-fun-data min-label effects live-conts defs)
fun-data? fun-data?
(min-label fun-data-min-label) (min-label fun-data-min-label)
(effects fun-data-effects) (effects fun-data-effects)
(conts fun-data-conts)
(live-conts fun-data-live-conts) (live-conts fun-data-live-conts)
(defs fun-data-defs)) (defs fun-data-defs))
@ -100,14 +99,14 @@
(effects (compute-effects dfg min-label label-count)) (effects (compute-effects dfg min-label label-count))
(live-conts (make-bitvector label-count #f)) (live-conts (make-bitvector label-count #f))
(defs (compute-defs dfg min-label label-count)) (defs (compute-defs dfg min-label label-count))
(fun-data (make-fun-data min-label label-count (fun-data (make-fun-data
effects live-conts defs))) min-label effects live-conts defs)))
(hashq-set! fun-data-table fun fun-data) (hashq-set! fun-data-table fun fun-data)
(set! changed? #t) (set! changed? #t)
fun-data))))) fun-data)))))
(define (visit-fun fun) (define (visit-fun fun)
(match (ensure-fun-data fun) (match (ensure-fun-data fun)
(($ $fun-data min-label label-count effects live-conts defs) (($ $fun-data min-label effects live-conts defs)
(define (visit-grey-exp n) (define (visit-grey-exp n)
(let ((defs (vector-ref defs n))) (let ((defs (vector-ref defs n)))
(cond (cond
@ -118,7 +117,7 @@
(else (else
(or-map value-live? defs))))) (or-map value-live? defs)))))
(define (idx->label idx) (+ idx min-label)) (define (idx->label idx) (+ idx min-label))
(let lp ((n (1- label-count))) (let lp ((n (1- (vector-length effects))))
(unless (< n 0) (unless (< n 0)
(let ((cont (lookup-cont (idx->label n) dfg))) (let ((cont (lookup-cont (idx->label n) dfg)))
(match cont (match cont
@ -191,7 +190,7 @@
($continue k #f ($values live))))))) ($continue k #f ($values live)))))))
(define (visit-fun fun) (define (visit-fun fun)
(match (hashq-ref fun-data-table fun) (match (hashq-ref fun-data-table fun)
(($ $fun-data min-label label-count effects live-conts defs) (($ $fun-data min-label effects live-conts defs)
(define (label->idx label) (- label min-label)) (define (label->idx label) (- label min-label))
(define (visit-cont cont) (define (visit-cont cont)
(match (visit-cont* cont) (match (visit-cont* cont)