compiler.cfg.dcn: starting work on deconcatenatization pass to replace compiler.cfg.stack-analysis

db4
Slava Pestov 2009-07-18 22:27:42 -05:00
parent a213db05db
commit ec1407bdae
6 changed files with 791 additions and 0 deletions

View File

@ -0,0 +1,394 @@
IN: compiler.cfg.dcn.tests
USING: tools.test kernel accessors namespaces assocs
cpu.architecture vectors sequences
compiler.cfg
compiler.cfg.debugger
compiler.cfg.registers
compiler.cfg.predecessors
compiler.cfg.instructions
compiler.cfg.dcn.height
compiler.cfg.dcn.local
compiler.cfg.dcn.local.private
compiler.cfg.dcn.global
compiler.cfg.dcn.global.private
compiler.cfg.dcn.rewrite ;
: test-local-dcn ( insns -- insns' )
<basic-block> swap >>instructions
[ local-analysis ] keep
instructions>> ;
[
V{
T{ ##copy f V int-regs 1 V int-regs 0 }
T{ ##copy f V int-regs 3 V int-regs 2 }
T{ ##copy f V int-regs 5 V int-regs 4 }
}
] [
V{
T{ ##peek f V int-regs 0 D 0 }
T{ ##peek f V int-regs 1 D 0 }
T{ ##peek f V int-regs 2 D 1 }
T{ ##peek f V int-regs 3 D 1 }
T{ ##replace f V int-regs 2 D 1 }
T{ ##replace f V int-regs 4 D 2 }
T{ ##peek f V int-regs 5 D 2 }
T{ ##replace f V int-regs 5 D 2 }
T{ ##replace f V int-regs 6 D 0 }
} test-local-dcn
] unit-test
[
H{
{ V int-regs 1 V int-regs 0 }
{ V int-regs 3 V int-regs 2 }
{ V int-regs 5 V int-regs 4 }
}
] [
copies get
] unit-test
[
H{
{ D 0 V int-regs 0 }
{ D 1 V int-regs 2 }
}
] [ reads-locations get ] unit-test
[
H{
{ D 0 V int-regs 6 }
{ D 2 V int-regs 4 }
}
] [ writes-locations get ] unit-test
: test-global-dcn ( -- )
cfg new 0 get >>entry
compute-predecessors
[ compute-heights ]
[ compute-local-sets ]
[ compute-global-sets ] tri ;
V{ T{ ##return } } 0 test-bb
[ ] [ test-global-dcn ] unit-test
V{
T{ ##prologue }
T{ ##branch }
} 0 test-bb
V{
T{ ##peek f V int-regs 0 D 0 }
T{ ##replace f V int-regs 1 D 1 }
} 1 test-bb
V{
T{ ##epilogue }
T{ ##return }
} 2 test-bb
0 get 1 get 1vector >>successors drop
1 get 2 get 1vector >>successors drop
[ t ] [ 0 get kill-block? ] unit-test
[ t ] [ 2 get kill-block? ] unit-test
[ ] [ test-global-dcn ] unit-test
[ t ] [ D 0 1 get peek-in key? ] unit-test
[ f ] [ D 0 0 get peek-in key? ] unit-test
[ t ] [ D 0 1 get avail-out key? ] unit-test
[ f ] [ D 0 0 get avail-out key? ] unit-test
[ { D 0 } ] [ 0 get 1 get inserting-peeks ] unit-test
[ { } ] [ 1 get 2 get inserting-peeks ] unit-test
[ { } ] [ 0 get 1 get inserting-replaces ] unit-test
[ { D 1 } ] [ 1 get 2 get inserting-replaces ] unit-test
V{
T{ ##prologue }
T{ ##branch }
} 0 test-bb
V{
T{ ##branch }
} 1 test-bb
V{
T{ ##peek f V int-regs 0 D 0 }
T{ ##branch }
} 2 test-bb
V{
T{ ##epilogue }
T{ ##return }
} 3 test-bb
V{
T{ ##peek f V int-regs 1 D 0 }
T{ ##peek f V int-regs 2 D 1 }
T{ ##replace f V int-regs 2 D 0 }
T{ ##branch }
} 4 test-bb
V{
T{ ##epilogue }
T{ ##return }
} 5 test-bb
0 get 1 get 1vector >>successors drop
1 get 2 get 4 get V{ } 2sequence >>successors drop
2 get 3 get 1vector >>successors drop
4 get 5 get 1vector >>successors drop
[ ] [ test-global-dcn ] unit-test
[ { D 0 } ] [ 0 get 1 get inserting-peeks ] unit-test
[ { } ] [ 0 get 1 get inserting-replaces ] unit-test
[ { } ] [ 1 get 2 get inserting-peeks ] unit-test
[ { } ] [ 1 get 2 get inserting-replaces ] unit-test
[ { } ] [ 1 get 3 get inserting-peeks ] unit-test
[ { } ] [ 1 get 3 get inserting-replaces ] unit-test
[ { D 1 } ] [ 2 get 4 get inserting-peeks ] unit-test
[ { } ] [ 2 get 4 get inserting-replaces ] unit-test
[ { } ] [ 4 get 5 get inserting-peeks ] unit-test
[ { D 0 } ] [ 4 get 5 get inserting-replaces ] unit-test
[ t ] [ D 0 1 get peek-out key? ] unit-test
[ f ] [ D 1 1 get peek-out key? ] unit-test
[ t ] [ D 1 4 get peek-in key? ] unit-test
[ f ] [ D 1 4 get avail-in key? ] unit-test
[ t ] [ D 1 4 get avail-out key? ] unit-test
V{
T{ ##prologue }
T{ ##branch }
} 0 test-bb
V{
T{ ##peek f V int-regs 0 D 0 }
T{ ##branch }
} 1 test-bb
V{
T{ ##peek f V int-regs 1 D 1 }
T{ ##branch }
} 2 test-bb
V{
T{ ##replace f V int-regs 2 D 1 }
T{ ##peek f V int-regs 4 D 2 }
T{ ##branch }
} 3 test-bb
V{
T{ ##replace f V int-regs 3 D 1 }
T{ ##branch }
} 4 test-bb
V{
T{ ##epilogue }
T{ ##return }
} 5 test-bb
0 get 1 get 1vector >>successors drop
1 get 2 get 3 get V{ } 2sequence >>successors drop
2 get 4 get 1vector >>successors drop
3 get 4 get 1vector >>successors drop
4 get 5 get 1vector >>successors drop
[ ] [ test-global-dcn ] unit-test
[ t ] [ D 1 4 get avail-in key? ] unit-test
[ f ] [ D 2 4 get avail-in key? ] unit-test
[ t ] [ D 1 2 get peek-in key? ] unit-test
[ f ] [ D 1 3 get peek-in key? ] unit-test
[ { D 0 } ] [ 0 get 1 get inserting-peeks ] unit-test
[ { } ] [ 0 get 1 get inserting-replaces ] unit-test
[ { D 1 } ] [ 1 get 2 get inserting-peeks ] unit-test
[ { } ] [ 1 get 2 get inserting-replaces ] unit-test
[ { D 2 } ] [ 1 get 3 get inserting-peeks ] unit-test
[ { } ] [ 1 get 3 get inserting-replaces ] unit-test
[ { } ] [ 3 get 4 get inserting-peeks ] unit-test
[ { } ] [ 2 get 4 get inserting-replaces ] unit-test
[ { } ] [ 3 get 4 get inserting-replaces ] unit-test
[ { D 1 } ] [ 4 get 5 get inserting-replaces ] unit-test
V{
T{ ##prologue }
T{ ##branch }
} 0 test-bb
V{
T{ ##peek f V int-regs 0 D 0 }
T{ ##branch }
} 1 test-bb
V{
T{ ##branch }
} 2 test-bb
V{
T{ ##call f drop }
T{ ##branch }
} 3 test-bb
V{
T{ ##peek f V int-regs 1 D 0 }
T{ ##return }
} 4 test-bb
[ t ] [ 0 get kill-block? ] unit-test
[ t ] [ 3 get kill-block? ] unit-test
0 get 1 get 1vector >>successors drop
1 get 2 get 3 get V{ } 2sequence >>successors drop
2 get 4 get 1vector >>successors drop
3 get 4 get 1vector >>successors drop
[ ] [ test-global-dcn ] unit-test
[ t ] [ D 0 2 get avail-out key? ] unit-test
[ f ] [ D 0 3 get peek-out key? ] unit-test
[ f ] [ D 0 3 get avail-out key? ] unit-test
[ f ] [ D 0 4 get avail-in key? ] unit-test
[ { D 0 } ] [ 0 get 1 get inserting-peeks ] unit-test
[ { } ] [ 1 get 2 get inserting-peeks ] unit-test
[ { } ] [ 1 get 3 get inserting-peeks ] unit-test
[ { } ] [ 2 get 4 get inserting-peeks ] unit-test
[ { D 0 } ] [ 3 get 4 get inserting-peeks ] unit-test
V{
T{ ##prologue }
T{ ##branch }
} 0 test-bb
V{
T{ ##peek f V int-regs 0 D 0 }
T{ ##branch }
} 1 test-bb
V{ T{ ##return } } 2 test-bb
V{ T{ ##branch } } 3 test-bb
0 get 1 get 1vector >>successors drop
1 get 2 get 3 get V{ } 2sequence >>successors drop
3 get 1 get 1vector >>successors drop
[ ] [ test-global-dcn ] unit-test
[ t ] [ D 0 1 get avail-out key? ] unit-test
[ { D 0 } ] [ 0 get 1 get inserting-peeks ] unit-test
[ { } ] [ 1 get 2 get inserting-peeks ] unit-test
[ { } ] [ 1 get 3 get inserting-peeks ] unit-test
[ { } ] [ 3 get 1 get inserting-peeks ] unit-test
V{
T{ ##prologue }
T{ ##branch }
} 0 test-bb
V{
T{ ##branch }
} 1 test-bb
V{
T{ ##call f drop }
T{ ##branch }
} 2 test-bb
V{
T{ ##branch }
} 3 test-bb
V{
T{ ##peek f V int-regs 0 D 0 }
T{ ##branch }
} 4 test-bb
V{
T{ ##peek f V int-regs 1 D 0 }
T{ ##branch }
} 5 test-bb
V{
T{ ##epilogue }
T{ ##return }
} 6 test-bb
0 get 1 get 1vector >>successors drop
1 get 2 get 3 get V{ } 2sequence >>successors drop
2 get 4 get 1vector >>successors drop
3 get 4 get 1vector >>successors drop
4 get 5 get 1vector >>successors drop
5 get 6 get 1vector >>successors drop
[ ] [ test-global-dcn ] unit-test
[ { } ] [ 0 get 1 get inserting-peeks ] unit-test
[ { } ] [ 1 get 2 get inserting-peeks ] unit-test
[ { } ] [ 3 get 4 get inserting-peeks ] unit-test
[ { D 0 } ] [ 2 get 4 get inserting-peeks ] unit-test
[ { D 0 } ] [ 1 get 3 get inserting-peeks ] unit-test
[ { } ] [ 4 get 5 get inserting-peeks ] unit-test
[ { } ] [ 5 get 6 get inserting-peeks ] unit-test
V{
T{ ##prologue }
T{ ##branch }
} 0 test-bb
V{
T{ ##branch }
} 1 test-bb
V{
T{ ##replace f V int-regs 1 D 0 }
T{ ##branch }
} 2 test-bb
V{
T{ ##peek f V int-regs 2 D 0 }
T{ ##branch }
} 3 test-bb
V{
T{ ##peek f V int-regs 0 D 0 }
T{ ##branch }
} 4 test-bb
V{
T{ ##epilogue }
T{ ##return }
} 5 test-bb
0 get 1 get 1vector >>successors drop
1 get 2 get 3 get V{ } 2sequence >>successors drop
2 get 4 get 1vector >>successors drop
3 get 4 get 1vector >>successors drop
4 get 5 get 1vector >>successors drop
[ ] [ test-global-dcn ] unit-test
[ { } ] [ 1 get 2 get inserting-peeks ] unit-test
[ { } ] [ 1 get 2 get inserting-replaces ] unit-test
[ { D 0 } ] [ 1 get 3 get inserting-peeks ] unit-test
[ { } ] [ 1 get 3 get inserting-replaces ] unit-test
[ { } ] [ 2 get 4 get inserting-peeks ] unit-test
[ { D 0 } ] [ 2 get 4 get inserting-replaces ] unit-test
[ { } ] [ 3 get 4 get inserting-peeks ] unit-test
[ { } ] [ 3 get 4 get inserting-replaces ] unit-test
[ { } ] [ 4 get 5 get inserting-peeks ] unit-test
[ { } ] [ 4 get 5 get inserting-replaces ] unit-test

View File

@ -0,0 +1,30 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: ;
IN: compiler.cfg.dcn
! "DeConcatenatizatioN" -- dataflow analysis to recover registers
! from stack locations.
! Local sets:
! - P(b): locations that block b peeks before replacing
! - R(b): locations that block b replaces
! - A(b): P(b) \/ R(b) -- locations that are available in registers at the end of b
! Global sets:
! - P_out(b) = /\ P_in(sux) for sux in successors(b)
! - P_in(b) = (P_out(b) - R(b)) \/ P(b)
!
! - R_in(b) = R_out(b) \/ R(b)
! - R_out(b) = \/ R_in(sux) for sux in successors(b)
!
! - A_in(b) = /\ A_out(pred) for pred in predecessors(b)
! - A_out(b) = A_in(b) \/ P(b) \/ R(b)
! On every edge [b --> sux], insert a replace for each location in
! R_out(b) - R_in(sux)
! On every edge [pred --> b], insert a peek for each location in
! P_in(b) - (P_out(pred) \/ A_out(pred))
! Locations are height-normalized.

View File

@ -0,0 +1,202 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs deques dlists fry kernel namespaces sequences
combinators combinators.short-circuit compiler.cfg.instructions
compiler.cfg.dcn.local compiler.cfg.rpo compiler.cfg ;
IN: compiler.cfg.dcn.global
<PRIVATE
PREDICATE: kill-block < basic-block
instructions>> {
[ length 2 = ]
[ first kill-vreg-insn? ]
} 1&& ;
: assoc-refine ( seq -- assoc )
[ f ] [ [ ] [ assoc-intersect ] map-reduce ] if-empty ;
SYMBOL: work-list
: add-to-work-list ( basic-blocks -- )
work-list get '[ _ push-front ] each ;
! Peek analysis. Peek-in is the set of all locations anticipated at
! the start of a basic block.
SYMBOLS: peek-ins peek-outs ;
PRIVATE>
: peek-in ( bb -- assoc ) peek-ins get at ;
: peek-out ( bb -- assoc ) peek-outs get at ;
<PRIVATE
GENERIC: compute-peek-in ( bb -- assoc )
M: basic-block compute-peek-in
[ [ peek-out ] [ replace ] bi assoc-diff ] [ peek ] bi assoc-union ;
M: kill-block compute-peek-in drop f ;
: update-peek-in ( bb -- ? )
[ compute-peek-in ] keep peek-ins get maybe-set-at ;
GENERIC: compute-peek-out ( bb -- assoc )
M: basic-block compute-peek-out
successors>> peek-ins get '[ _ at ] map assoc-refine ;
M: kill-block compute-peek-out drop f ;
: update-peek-out ( bb -- ? )
[ compute-peek-out ] keep peek-outs get maybe-set-at ;
: peek-step ( bb -- )
dup update-peek-out [
dup update-peek-in
[ predecessors>> add-to-work-list ] [ drop ] if
] [ drop ] if ;
: compute-peek-sets ( cfg -- )
H{ } clone peek-ins set
H{ } clone peek-outs set
post-order add-to-work-list work-list get [ peek-step ] slurp-deque ;
! Replace analysis. Replace-in is the set of all locations which
! will be overwritten at some point after the start of a basic block.
SYMBOLS: replace-ins replace-outs ;
PRIVATE>
: replace-in ( bb -- assoc ) replace-ins get at ;
: replace-out ( bb -- assoc ) replace-outs get at ;
<PRIVATE
GENERIC: compute-replace-in ( bb -- assoc )
M: basic-block compute-replace-in
predecessors>> replace-outs get '[ _ at ] map assoc-refine ;
M: kill-block compute-replace-in drop f ;
: update-replace-in ( bb -- ? )
[ compute-replace-in ] keep replace-ins get maybe-set-at ;
GENERIC: compute-replace-out ( bb -- assoc )
M: basic-block compute-replace-out
[ replace-in ] [ replace ] bi assoc-union ;
M: kill-block compute-replace-out drop f ;
: update-replace-out ( bb -- ? )
[ compute-replace-out ] keep replace-outs get maybe-set-at ;
: replace-step ( bb -- )
dup update-replace-in [
dup update-replace-out
[ successors>> add-to-work-list ] [ drop ] if
] [ drop ] if ;
: compute-replace-sets ( cfg -- )
H{ } clone replace-ins set
H{ } clone replace-outs set
reverse-post-order add-to-work-list work-list get [ replace-step ] slurp-deque ;
! Availability analysis. Avail-out is the set of all locations
! in registers at the end of a basic block.
SYMBOLS: avail-ins avail-outs ;
PRIVATE>
: avail-in ( bb -- assoc ) avail-ins get at ;
: avail-out ( bb -- assoc ) avail-outs get at ;
<PRIVATE
GENERIC: compute-avail-in ( bb -- assoc )
M: basic-block compute-avail-in
predecessors>> avail-outs get '[ _ at ] map assoc-refine ;
M: kill-block compute-avail-in drop f ;
: update-avail-in ( bb -- ? )
[ compute-avail-in ] keep avail-ins get maybe-set-at ;
GENERIC: compute-avail-out ( bb -- assoc )
M: basic-block compute-avail-out
[ avail-in ] [ peek ] [ replace ] tri assoc-union assoc-union ;
M: kill-block compute-avail-out drop f ;
: update-avail-out ( bb -- ? )
[ compute-avail-out ] keep avail-outs get maybe-set-at ;
: avail-step ( bb -- )
dup update-avail-in [
dup update-avail-out
[ successors>> add-to-work-list ] [ drop ] if
] [ drop ] if ;
: compute-avail-sets ( cfg -- )
H{ } clone avail-ins set
H{ } clone avail-outs set
reverse-post-order add-to-work-list work-list get [ avail-step ] slurp-deque ;
! Kill analysis. Kill-in is the set of all locations
! which are going to be overwritten.
SYMBOLS: kill-ins kill-outs ;
PRIVATE>
: kill-in ( bb -- assoc ) kill-ins get at ;
: kill-out ( bb -- assoc ) kill-outs get at ;
<PRIVATE
GENERIC: compute-kill-in ( bb -- assoc )
M: basic-block compute-kill-in
[ kill-out ] [ replace ] bi assoc-union ;
M: kill-block compute-kill-in drop f ;
: update-kill-in ( bb -- ? )
[ compute-kill-in ] keep kill-ins get maybe-set-at ;
GENERIC: compute-kill-out ( bb -- assoc )
M: basic-block compute-kill-out
successors>> kill-ins get '[ _ at ] map assoc-refine ;
M: kill-block compute-kill-out drop f ;
: update-kill-out ( bb -- ? )
[ compute-kill-out ] keep kill-outs get maybe-set-at ;
: kill-step ( bb -- )
dup update-kill-out [
dup update-kill-in
[ predecessors>> add-to-work-list ] [ drop ] if
] [ drop ] if ;
: compute-kill-sets ( cfg -- )
H{ } clone kill-ins set
H{ } clone kill-outs set
post-order add-to-work-list work-list get [ kill-step ] slurp-deque ;
PRIVATE>
! Main word
: compute-global-sets ( cfg -- )
<hashed-dlist> work-list set
{
[ compute-peek-sets ]
[ compute-replace-sets ]
[ compute-avail-sets ]
[ compute-kill-sets ]
} cleave ;

View File

@ -0,0 +1,82 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces assocs accessors sequences kernel math locals fry
compiler.cfg.instructions compiler.cfg.rpo compiler.cfg.registers ;
IN: compiler.cfg.dcn.height
! Compute block in-height and out-height sets. These are relative to the
! stack height from the start of the procedure.
<PRIVATE
SYMBOLS: in-ds-heights out-ds-heights in-rs-heights out-rs-heights ;
GENERIC: ds-height-change ( insn -- n )
M: insn ds-height-change drop 0 ;
M: ##inc-d ds-height-change n>> ;
! XXX
! M: ##call ds-height-change height>> ;
M: ##call ds-height-change drop 0 ;
M: ##alien-invoke ds-height-change height>> ;
M: ##alien-indirect ds-height-change height>> ;
GENERIC: rs-height-change ( insn -- n )
M: insn rs-height-change drop 0 ;
M: ##inc-r rs-height-change n>> ;
:: compute-in-height ( bb in out -- )
bb predecessors>> [ out at ] map-find drop 0 or
bb in set-at ;
:: compute-out-height ( bb in out quot -- )
bb instructions>>
bb in at
[ quot call + ] reduce
bb out set-at ; inline
:: compute-height ( bb in out quot -- )
bb in get out get
[ compute-in-height ]
[ quot compute-out-height ] 3bi ; inline
: compute-ds-height ( bb -- )
in-ds-heights out-ds-heights [ ds-height-change ] compute-height ;
: compute-rs-height ( bb -- )
in-rs-heights out-rs-heights [ rs-height-change ] compute-height ;
PRIVATE>
: compute-heights ( cfg -- )
H{ } clone in-ds-heights set
H{ } clone out-ds-heights set
H{ } clone in-rs-heights set
H{ } clone out-rs-heights set
[
[ compute-rs-height ]
[ compute-ds-height ] bi
] each-basic-block ;
GENERIC# translate-in-loc 1 ( loc bb -- loc' )
M: ds-loc translate-in-loc n>> in-ds-heights get at + <ds-loc> ;
M: rs-loc translate-in-loc n>> in-rs-heights get at + <ds-loc> ;
GENERIC# translate-out-loc 1 ( loc bb -- loc' )
M: ds-loc translate-out-loc n>> out-ds-heights get at + <ds-loc> ;
M: rs-loc translate-out-loc n>> out-rs-heights get at + <ds-loc> ;
: translate-in-set ( assoc bb -- assoc' )
'[ [ _ translate-in-loc ] dip ] assoc-map ;
: translate-out-set ( assoc bb -- assoc' )
'[ [ _ translate-out-loc ] dip ] assoc-map ;

View File

@ -0,0 +1,73 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs kernel make
namespaces sequences
compiler.cfg.rpo
compiler.cfg.instructions ;
IN: compiler.cfg.dcn.local
<PRIVATE
SYMBOL: copies
: record-copy ( dst src -- ) swap copies get set-at ;
: resolve-copy ( vreg -- vreg' ) copies get ?at drop ;
SYMBOLS: reads-locations writes-locations ;
: loc>vreg ( loc -- vreg )
dup writes-locations get at
[ ] [ reads-locations get at ] ?if ;
GENERIC: visit ( insn -- )
M: insn visit , ;
M: ##peek visit
! If location is in a register already, copy existing
! register to destination. Otherwise, associate the
! location with the register.
[ dst>> ] [ loc>> ] bi dup loc>vreg
[ [ record-copy ] [ ##copy ] 2bi ]
[ reads-locations get set-at ]
?if ;
M: ##replace visit
! If location already contains the same value, do nothing.
! Otherwise, associate the location with the register.
[ src>> resolve-copy ] [ loc>> ] bi 2dup loc>vreg =
[ 2drop ] [ writes-locations get set-at ] if ;
M: ##copy visit
! Not needed at this point because IR doesn't have ##copy
! on input to dcn pass, but in the future it might.
[ dst>> ] [ src>> resolve-copy ] bi record-copy ;
: local-analysis ( bb -- )
! Removes all ##peek and ##replace from the basic block.
! Conceptually, moves all ##peeks to the start
! (reads-locations assoc) and all ##replaces to the end
! (writes-locations assoc).
H{ } clone copies set
H{ } clone reads-locations set
H{ } clone writes-locations set
[ [ [ visit ] each ] V{ } make ] change-instructions drop ;
SYMBOLS: peeks replaces ;
: visit-block ( bb -- )
[ local-analysis ]
[ [ reads-locations get ] dip peeks get set-at ]
[ [ writes-locations get ] dip replaces get set-at ]
tri ;
PRIVATE>
: peek ( bb -- assoc ) peeks get at ;
: replace ( bb -- assoc ) replaces get at ;
: compute-local-sets ( cfg -- )
H{ } clone peeks set
H{ } clone replaces set
[ visit-block ] each-basic-block ;

View File

@ -0,0 +1,10 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces assocs kernel compiler.cfg.dcn.global ;
IN: compiler.cfg.dcn.rewrite
: inserting-peeks ( from to -- seq )
peek-in swap [ peek-out ] [ avail-out ] bi assoc-union assoc-diff keys ;
: inserting-replaces ( from to -- seq )
[ replace-out ] [ kill-in ] bi* assoc-diff keys ;