-USING: compiler.cfg.instructions compiler.cfg.registers
-compiler.cfg.alias-analysis compiler.cfg.debugger
-cpu.architecture tools.test kernel ;
IN: compiler.cfg.alias-analysis.tests
-
-[ ] [
- {
- T{ ##peek f V int-regs 2 D 1 f }
- T{ ##box-alien f V int-regs 1 V int-regs 2 }
- T{ ##slot-imm f V int-regs 3 V int-regs 1 0 3 }
- } alias-analysis drop
-] unit-test
-
-[ ] [
- {
- T{ ##load-reference f V int-regs 1 "hello" }
- T{ ##slot-imm f V int-regs 0 V int-regs 1 0 3 }
- } alias-analysis drop
-] unit-test
-
-[
- {
- T{ ##peek f V int-regs 1 D 1 f }
- T{ ##peek f V int-regs 2 D 2 f }
- T{ ##replace f V int-regs 1 D 0 f }
- }
-] [
- {
- T{ ##peek f V int-regs 1 D 1 f }
- T{ ##peek f V int-regs 2 D 2 f }
- T{ ##replace f V int-regs 2 D 0 f }
- T{ ##replace f V int-regs 1 D 0 f }
- } alias-analysis
-] unit-test
-
-[
- {
- T{ ##peek f V int-regs 1 D 1 f }
- T{ ##peek f V int-regs 2 D 0 f }
- T{ ##copy f V int-regs 3 V int-regs 2 f }
- T{ ##copy f V int-regs 4 V int-regs 1 f }
- T{ ##replace f V int-regs 3 D 0 f }
- T{ ##replace f V int-regs 4 D 1 f }
- }
-] [
- {
- T{ ##peek f V int-regs 1 D 1 f }
- T{ ##peek f V int-regs 2 D 0 f }
- T{ ##replace f V int-regs 1 D 0 f }
- T{ ##replace f V int-regs 2 D 1 f }
- T{ ##peek f V int-regs 3 D 1 f }
- T{ ##peek f V int-regs 4 D 0 f }
- T{ ##replace f V int-regs 3 D 0 f }
- T{ ##replace f V int-regs 4 D 1 f }
- } alias-analysis
-] unit-test
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math namespaces assocs hashtables sequences arrays
accessors vectors combinators sets classes compiler.cfg
compiler.cfg.registers compiler.cfg.instructions
-compiler.cfg.copy-prop ;
+compiler.cfg.copy-prop compiler.cfg.rpo
+compiler.cfg.liveness ;
IN: compiler.cfg.alias-analysis
-! Alias analysis -- assumes compiler.cfg.height has already run.
-!
-! We try to eliminate redundant slot and stack
-! traffic using some simple heuristics.
+! We try to eliminate redundant slot operations using some simple heuristics.
!
! All heap-allocated objects which are loaded from the stack, or
! other object slots are pessimistically assumed to belong to
!
! Freshly-allocated objects get their own alias class.
!
-! The data and retain stack pointer registers are treated
-! uniformly, and each one gets its own alias class.
-!
! Simple pseudo-C example showing load elimination:
!
! int *x, *y, z: inputs
GENERIC: insn-slot# ( insn -- slot#/f )
GENERIC: insn-object ( insn -- vreg )
-M: ##peek insn-slot# loc>> n>> ;
-M: ##replace insn-slot# loc>> n>> ;
M: ##slot insn-slot# slot>> constant ;
M: ##slot-imm insn-slot# slot>> ;
M: ##set-slot insn-slot# slot>> constant ;
M: ##set-slot-imm insn-slot# slot>> ;
M: ##alien-global insn-slot# [ library>> ] [ symbol>> ] bi 2array ;
-M: ##peek insn-object loc>> class ;
-M: ##replace insn-object loc>> class ;
M: ##slot insn-object obj>> resolve ;
M: ##slot-imm insn-object obj>> resolve ;
M: ##set-slot insn-object obj>> resolve ;
M: ##set-slot-imm insn-object obj>> resolve ;
M: ##alien-global insn-object drop \ ##alien-global ;
-: init-alias-analysis ( -- )
+: init-alias-analysis ( basic-block -- )
H{ } clone histories set
H{ } clone vregs>acs set
H{ } clone acs>vregs set
H{ } clone constants set
H{ } clone copies set
+ live-in keys [ set-heap-ac ] each
+
0 ac-counter set
- next-ac heap-ac set
-
- ds-loc next-ac set-ac
- rs-loc next-ac set-ac ;
+ next-ac heap-ac set ;
GENERIC: analyze-aliases* ( insn -- insn' )
] unless
] when ;
-M: ##replace eliminate-dead-stores*
- #! Writes to above the top of the stack can be pruned also.
- #! This is sound since any such writes are not observable
- #! after the basic block, and any reads of those locations
- #! will have been converted to copies by analyze-slot,
- #! and the final stack height of the basic block is set at
- #! the beginning by compiler.cfg.stack.
- dup loc>> n>> 0 < [ drop f ] [ (eliminate-dead-stores) ] if ;
-
M: ##set-slot eliminate-dead-stores* (eliminate-dead-stores) ;
M: ##set-slot-imm eliminate-dead-stores* (eliminate-dead-stores) ;
: eliminate-dead-stores ( insns -- insns' )
[ insn# set eliminate-dead-stores* ] map-index sift ;
-: alias-analysis ( insns -- insns' )
- init-alias-analysis
- analyze-aliases
- compute-live-stores
- eliminate-dead-stores ;
+: alias-analysis-step ( basic-block -- )
+ dup init-alias-analysis
+ [
+ analyze-aliases
+ compute-live-stores
+ eliminate-dead-stores
+ ] change-instructions drop ;
+
+: alias-analysis ( rpo -- )
+ [ alias-analysis-step ] each ;
\ No newline at end of file
[ instructions>> check-basic-block ] each ;
: check-cfg ( cfg -- )
- entry>> reverse-post-order check-rpo ;
\ No newline at end of file
+ reverse-post-order check-rpo ;
\ No newline at end of file
H{ } clone liveness-graph set
H{ } clone live-vregs set ;
-GENERIC: compute-liveness ( insn -- )
+GENERIC: update-liveness-graph ( insn -- )
-M: ##flushable compute-liveness
+M: ##flushable update-liveness-graph
[ uses-vregs ] [ dst>> ] bi liveness-graph get set-at ;
: record-live ( vregs -- )
] if
] each ;
-M: insn compute-liveness uses-vregs record-live ;
+M: insn update-liveness-graph uses-vregs record-live ;
GENERIC: live-insn? ( insn -- ? )
M: insn live-insn? drop t ;
-: eliminate-dead-code ( rpo -- rpo )
+: eliminate-dead-code ( rpo -- )
init-dead-code
- [ [ instructions>> [ compute-liveness ] each ] each ]
+ [ [ instructions>> [ update-liveness-graph ] each ] each ]
[ [ [ [ live-insn? ] filter ] change-instructions drop ] each ]
- [ ]
- tri ;
\ No newline at end of file
+ bi ;
\ No newline at end of file
: compute-dominance ( cfg -- cfg )
H{ } clone idoms set
- dup entry>> reverse-post-order
+ dup reverse-post-order
unclip dup set-idom drop '[ _ iterate ] loop ;
\ No newline at end of file
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors math namespaces sequences kernel fry
-compiler.cfg compiler.cfg.registers compiler.cfg.instructions ;
+compiler.cfg compiler.cfg.registers compiler.cfg.instructions
+compiler.cfg.rpo ;
IN: compiler.cfg.height
! Combine multiple stack height changes into one at the
M: insn normalize-height* ;
-: normalize-height ( insns -- insns' )
+: height-step ( insns -- insns' )
0 ds-height set
0 rs-height set
- [ [ compute-heights ] each ]
- [ [ [ normalize-height* ] map sift ] with-scope ] bi
- ds-height get dup zero? [ drop ] [ f \ ##inc-d boa prefix ] if
- rs-height get dup zero? [ drop ] [ f \ ##inc-r boa prefix ] if ;
+ [
+ [ [ compute-heights ] each ]
+ [ [ [ normalize-height* ] map sift ] with-scope ] bi
+ ds-height get dup zero? [ drop ] [ f \ ##inc-d boa prefix ] if
+ rs-height get dup zero? [ drop ] [ f \ ##inc-r boa prefix ] if
+ ] change-instructions drop ;
+
+: normalize-height ( rpo -- )
+ [ height-step ] each ;
M: f ##load-literal drop \ f tag-number ##load-immediate ;
M: object ##load-literal ##load-reference ;
-INSN: ##peek < ##read { loc loc } ;
-INSN: ##replace < ##write { loc loc } ;
+INSN: ##peek < ##flushable { loc loc } ;
+INSN: ##replace < ##effect { loc loc } ;
INSN: ##inc-d { n integer } ;
INSN: ##inc-r { n integer } ;
[ [ linearize-basic-block ] each ] { } make ;
: build-mr ( cfg -- mr )
- [ entry>> reverse-post-order linearize-basic-blocks ]
+ [ reverse-post-order linearize-basic-blocks ]
[ word>> ] [ label>> ]
tri <mr> ;
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel namespaces deques accessors sets sequences assocs fry dlists
+compiler.cfg.def-use compiler.cfg.rpo ;
+IN: compiler.cfg.liveness
+
+! This is a backward dataflow analysis. See http://en.wikipedia.org/wiki/Liveness_analysis
+
+! Assoc mapping basic blocks to sets of vregs
+SYMBOL: live-ins
+
+: live-in ( basic-block -- set ) live-ins get at ;
+
+! Assoc mapping basic blocks to sets of vregs
+SYMBOL: live-outs
+
+: live-out ( basic-block -- set ) live-outs get at ;
+
+SYMBOL: work-list
+
+: add-to-work-list ( basic-blocks -- )
+ work-list get '[ _ push-front ] each ;
+
+: map-unique ( seq quot -- assoc )
+ map concat unique ; inline
+
+: gen-set ( basic-block -- seq )
+ instructions>> [ uses-vregs ] map-unique ;
+
+: kill-set ( basic-block -- seq )
+ instructions>> [ defs-vregs ] map-unique ;
+
+: update-live-in ( basic-block -- changed? )
+ [
+ [ [ gen-set ] [ live-out ] bi assoc-union ]
+ [ kill-set ]
+ bi assoc-diff
+ ] keep live-ins get maybe-set-at ;
+
+: update-live-out ( basic-block -- changed? )
+ [ successors>> [ live-in ] map assoc-combine ] keep
+ live-outs get maybe-set-at ;
+
+: liveness-step ( basic-block -- )
+ dup update-live-out [
+ dup update-live-in
+ [ predecessors>> add-to-work-list ] [ drop ] if
+ ] [ drop ] if ;
+
+: compute-liveness ( rpo -- )
+ <hashed-dlist> work-list set
+ H{ } clone live-ins set
+ H{ } clone live-outs set
+ <reversed> add-to-work-list
+ work-list get [ liveness-step ] slurp-deque ;
\ No newline at end of file
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences compiler.cfg.rpo
-compiler.cfg.instructions
+USING: kernel sequences accessors combinators
compiler.cfg.predecessors
compiler.cfg.useless-blocks
compiler.cfg.height
+compiler.cfg.stack-analysis
compiler.cfg.alias-analysis
compiler.cfg.value-numbering
-compiler.cfg.dead-code
-compiler.cfg.write-barrier ;
+compiler.cfg.dce
+compiler.cfg.write-barrier
+compiler.cfg.liveness
+compiler.cfg.rpo ;
IN: compiler.cfg.optimizer
-: trivial? ( insns -- ? )
- dup length 2 = [ first ##call? ] [ drop f ] if ;
-
-: optimize-cfg ( cfg -- cfg' )
- compute-predecessors
- delete-useless-blocks
- delete-useless-conditionals
+: optimize-cfg ( cfg -- cfg )
[
- dup trivial? [
- normalize-height
- alias-analysis
- value-numbering
- eliminate-dead-code
- eliminate-write-barriers
- ] unless
- ] change-basic-blocks ;
+ [ compute-predecessors ]
+ [ delete-useless-blocks ]
+ [ delete-useless-conditionals ] tri
+ ] [
+ reverse-post-order
+ {
+ [ compute-liveness ]
+ [ normalize-height ]
+ [ stack-analysis ]
+ [ alias-analysis ]
+ [ value-numbering ]
+ [ eliminate-dead-code ]
+ [ eliminate-write-barriers ]
+ } cleave
+ ] [ ] tri ;
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors sequences compiler.cfg.rpo ;
IN: compiler.cfg.predecessors
-: (compute-predecessors) ( bb -- )
+: predecessors-step ( bb -- )
dup successors>> [ predecessors>> push ] with each ;
-: compute-predecessors ( cfg -- cfg' )
- dup [ (compute-predecessors) ] each-basic-block ;
+: compute-predecessors ( cfg -- )
+ [ predecessors-step ] each-basic-block ;
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors namespaces make math sequences sets
assocs fry compiler.cfg compiler.cfg.instructions ;
SYMBOL: visited
: post-order-traversal ( bb -- )
- dup id>> visited get key? [ drop ] [
- dup id>> visited get conjoin
+ dup visited get key? [ drop ] [
+ dup visited get conjoin
[
successors>> <reversed>
[ post-order-traversal ] each
] [ , ] bi
] if ;
-: post-order ( bb -- blocks )
- [ post-order-traversal ] { } make ;
+: post-order ( cfg -- blocks )
+ [ entry>> post-order-traversal ] { } make ;
: number-blocks ( blocks -- )
[ >>number drop ] each-index ;
-: reverse-post-order ( bb -- blocks )
+: reverse-post-order ( cfg -- blocks )
H{ } clone visited [
post-order <reversed> dup number-blocks
] with-variable ; inline
: each-basic-block ( cfg quot -- )
- [ entry>> reverse-post-order ] dip each ; inline
-
-: change-basic-blocks ( cfg quot -- cfg' )
- [ '[ _ change-instructions drop ] each-basic-block ]
- [ drop ]
- 2bi ; inline
+ [ reverse-post-order ] dip each ; inline
compiler.cfg.dce compiler.cfg.registers sets ;
IN: compiler.cfg.stack-analysis.tests
-[ f ] [ 1 2 H{ { 2 1 } } maybe-set-at ] unit-test
-[ t ] [ 1 3 H{ { 2 1 } } clone maybe-set-at ] unit-test
-[ t ] [ 3 2 H{ { 2 1 } } clone maybe-set-at ] unit-test
-
! Fundamental invariant: a basic block should not load or store a value more than once
: check-for-redundant-ops ( rpo -- )
[
: test-stack-analysis ( quot -- mr )
dup cfg? [ test-cfg first ] unless
- compute-predecessors
- entry>> reverse-post-order
- optimize-stack
- dup [ [ normalize-height ] change-instructions drop ] each
- dup check-rpo dup check-for-redundant-ops ;
+ dup compute-predecessors
+ reverse-post-order
+ dup stack-analysis
+ dup normalize-height
+ dup check-rpo
+ dup check-for-redundant-ops ;
[ ] [ [ ] test-stack-analysis drop ] unit-test
! Make sure the replace stores a value with the right height
[ ] [
- [ [ . ] [ 2drop 1 ] if ] test-stack-analysis eliminate-dead-code linearize-basic-blocks
+ [ [ . ] [ 2drop 1 ] if ] test-stack-analysis dup eliminate-dead-code linearize-basic-blocks
[ ##replace? ] filter [ length 1 assert= ] [ first loc>> D 0 assert= ] bi
] unit-test
! translate-loc was the wrong way round
[ ] [
- [ 1 2 rot ] test-stack-analysis eliminate-dead-code linearize-basic-blocks
+ [ 1 2 rot ] test-stack-analysis dup eliminate-dead-code linearize-basic-blocks
[ [ ##load-immediate? ] count 2 assert= ]
[ [ ##peek? ] count 1 assert= ]
[ [ ##replace? ] count 3 assert= ]
] unit-test
[ ] [
- [ 1 2 ? ] test-stack-analysis eliminate-dead-code linearize-basic-blocks
+ [ 1 2 ? ] test-stack-analysis dup eliminate-dead-code linearize-basic-blocks
[ [ ##load-immediate? ] count 2 assert= ]
[ [ ##peek? ] count 1 assert= ]
[ [ ##replace? ] count 1 assert= ]
! Sync before a back-edge, not after
[ 1 ] [
- [ 1000 [ ] times ] test-stack-analysis eliminate-dead-code linearize-basic-blocks
+ [ 1000 [ ] times ] test-stack-analysis dup eliminate-dead-code linearize-basic-blocks
[ ##add-imm? ] count
] unit-test
\ No newline at end of file
! If 'poisoned' is set, disregard height information. This is set if we don't have
! height change information for an instruction.
-TUPLE: state locs>vregs actual-locs>vregs changed-locs d-height r-height poisoned? ;
+TUPLE: state locs>vregs actual-locs>vregs changed-locs ds-height rs-height poisoned? ;
: <state> ( -- state )
state new
H{ } clone >>locs>vregs
H{ } clone >>actual-locs>vregs
H{ } clone >>changed-locs
- 0 >>d-height
- 0 >>r-height ;
+ 0 >>ds-height
+ 0 >>rs-height ;
M: state clone
call-next-method
GENERIC: height-for ( loc -- n )
-M: ds-loc height-for drop state get d-height>> ;
-M: rs-loc height-for drop state get r-height>> ;
+M: ds-loc height-for drop state get ds-height>> ;
+M: rs-loc height-for drop state get rs-height>> ;
: (translate-loc) ( loc -- n height ) [ n>> ] [ height-for ] bi ; inline
[ sync-state ] when
, ;
-: adjust-d ( n -- ) state get [ + ] change-d-height drop ;
+: adjust-d ( n -- ) state get [ + ] change-ds-height drop ;
M: ##inc-d visit [ , ] [ n>> adjust-d ] bi ;
-: adjust-r ( n -- ) state get [ + ] change-r-height drop ;
+: adjust-r ( n -- ) state get [ + ] change-rs-height drop ;
M: ##inc-r visit [ , ] [ n>> adjust-r ] bi ;
: merge-heights ( state predecessors states -- state )
nip
- [ [ d-height>> ] map must-equal >>d-height ]
- [ [ r-height>> ] map must-equal >>r-height ] bi ;
+ [ [ ds-height>> ] map must-equal >>ds-height ]
+ [ [ rs-height>> ] map must-equal >>rs-height ] bi ;
: insert-peek ( predecessor loc -- vreg )
! XXX critical edges
] 2bi
] V{ } make >>instructions drop ;
-: optimize-stack ( rpo -- rpo )
+: stack-analysis ( rpo -- )
[
H{ } clone copies set
H{ } clone state-in set
H{ } clone state-out set
- dup [ visit-block ] each
+ [ visit-block ] each
] with-scope ;
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors sequences combinators classes vectors
-compiler.cfg compiler.cfg.rpo compiler.cfg.instructions ;
+compiler.cfg compiler.cfg.instructions compiler.cfg.rpo ;
IN: compiler.cfg.useless-blocks
: update-predecessor-for-delete ( bb -- )
[ t ]
} cond nip ;
-: delete-useless-blocks ( cfg -- cfg' )
- dup [
+: delete-useless-blocks ( cfg -- )
+ [
dup delete-basic-block? [ delete-basic-block ] [ drop ] if
] each-basic-block ;
[ but-last f \ ##branch boa suffix ] change-instructions
drop ;
-: delete-useless-conditionals ( cfg -- cfg' )
- dup [
+: delete-useless-conditionals ( cfg -- )
+ [
dup delete-conditional? [ delete-conditional ] [ drop ] if
] each-basic-block ;
and
] [ 2drop f ] if ;
-SYMBOL: input-expr-counter
-
-: next-input-expr ( -- n )
- input-expr-counter [ dup 1 + ] change ;
-
! Expressions whose values are inputs to the basic block. We
! can eliminate a second computation having the same 'n' as
! the first one; we can also eliminate input-exprs whose
! result is not used.
TUPLE: input-expr < expr n ;
+SYMBOL: input-expr-counter
+
+: next-input-expr ( class -- expr )
+ input-expr-counter [ dup 1 + ] change input-expr boa ;
+
: constant>vn ( constant -- vn ) <constant> expr>vn ; inline
GENERIC: >expr ( insn -- expr )
M: ##compare-float >expr compare>expr ;
-M: ##flushable >expr class next-input-expr input-expr boa ;
+M: ##flushable >expr class next-input-expr ;
: init-expressions ( -- )
0 input-expr-counter set ;
USING: compiler.cfg.value-numbering compiler.cfg.instructions
compiler.cfg.registers compiler.cfg.debugger cpu.architecture
tools.test kernel math combinators.short-circuit accessors
-sequences ;
+sequences compiler.cfg vectors arrays ;
: trim-temps ( insns -- insns )
[
} 1|| [ f >>temp ] when
] map ;
+: test-value-numbering ( insns -- insns )
+ basic-block new swap >vector >>instructions
+ dup value-numbering-step instructions>> >array ;
+
[
{
T{ ##peek f V int-regs 45 D 1 }
T{ ##peek f V int-regs 45 D 1 }
T{ ##copy f V int-regs 48 V int-regs 45 }
T{ ##compare-imm-branch f V int-regs 48 7 cc/= }
- } value-numbering
+ } test-value-numbering
] unit-test
[
T{ ##peek f V int-regs 3 D 0 }
T{ ##slot-imm f V int-regs 4 V int-regs 3 1 3 }
T{ ##replace f V int-regs 4 D 0 }
- } value-numbering
+ } test-value-numbering
] unit-test
[ t ] [
{
T{ ##peek f V int-regs 1 D 0 }
T{ ##dispatch f V int-regs 1 V int-regs 2 0 }
- } dup value-numbering =
+ } dup test-value-numbering =
] unit-test
[ t ] [
T{ ##alien-unsigned-1 f V int-regs 22 V int-regs 21 }
T{ ##shl-imm f V int-regs 23 V int-regs 22 3 }
T{ ##replace f V int-regs 23 D 0 }
- } dup value-numbering =
+ } dup test-value-numbering =
] unit-test
[
T{ ##mul-imm f V int-regs 2 V int-regs 1 8 }
T{ ##shr-imm f V int-regs 3 V int-regs 2 3 }
T{ ##replace f V int-regs 3 D 0 }
- } value-numbering
+ } test-value-numbering
] unit-test
[
T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc> }
T{ ##compare-imm f V int-regs 6 V int-regs 4 5 cc/= }
T{ ##replace f V int-regs 6 D 0 }
- } value-numbering trim-temps
+ } test-value-numbering trim-temps
] unit-test
[
T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc<= }
T{ ##compare-imm f V int-regs 6 V int-regs 4 5 cc= }
T{ ##replace f V int-regs 6 D 0 }
- } value-numbering trim-temps
+ } test-value-numbering trim-temps
] unit-test
[
T{ ##compare-float f V int-regs 12 V double-float-regs 10 V double-float-regs 11 cc< }
T{ ##compare-imm f V int-regs 14 V int-regs 12 5 cc= }
T{ ##replace f V int-regs 14 D 0 }
- } value-numbering trim-temps
+ } test-value-numbering trim-temps
] unit-test
[
T{ ##peek f V int-regs 30 D -2 }
T{ ##compare f V int-regs 33 V int-regs 29 V int-regs 30 cc<= }
T{ ##compare-imm-branch f V int-regs 33 5 cc/= }
- } value-numbering trim-temps
+ } test-value-numbering trim-temps
] unit-test
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces assocs biassocs classes kernel math accessors
sorting sets sequences
+compiler.cfg.liveness
compiler.cfg.value-numbering.graph
compiler.cfg.value-numbering.expressions
compiler.cfg.value-numbering.propagate
compiler.cfg.value-numbering.rewrite ;
IN: compiler.cfg.value-numbering
-: value-numbering ( insns -- insns' )
+: number-input-values ( basic-block -- )
+ live-in keys [ [ next-input-expr ] dip set-vn ] each ;
+
+: value-numbering-step ( basic-block -- )
init-value-graph
init-expressions
- [ [ number-values ] [ rewrite propagate ] bi ] map ;
+ dup number-input-values
+ [ [ [ number-values ] [ rewrite propagate ] bi ] map ] change-instructions drop ;
+
+: value-numbering ( rpo -- )
+ [ value-numbering-step ] each ;
USING: compiler.cfg.write-barrier compiler.cfg.instructions
compiler.cfg.registers compiler.cfg.debugger cpu.architecture
-arrays tools.test ;
+arrays tools.test vectors compiler.cfg kernel accessors ;
IN: compiler.cfg.write-barrier.tests
+: test-write-barrier ( insns -- insns )
+ basic-block new swap >vector >>instructions
+ dup write-barriers-step instructions>> >array ;
+
[
{
T{ ##peek f V int-regs 4 D 0 f }
T{ ##set-slot-imm f V int-regs 6 V int-regs 7 2 3 }
T{ ##write-barrier f V int-regs 7 V int-regs 12 V int-regs 13 }
T{ ##replace f V int-regs 7 D 0 }
- } eliminate-write-barriers
+ } test-write-barrier
] unit-test
[
T{ ##peek f V int-regs 6 D -2 }
T{ ##set-slot-imm f V int-regs 5 V int-regs 6 3 2 }
T{ ##write-barrier f V int-regs 6 V int-regs 7 V int-regs 8 }
- } eliminate-write-barriers
+ } test-write-barrier
] unit-test
[
T{ ##copy f V int-regs 29 V int-regs 19 }
T{ ##set-slot-imm f V int-regs 28 V int-regs 29 4 2 }
T{ ##write-barrier f V int-regs 29 V int-regs 30 V int-regs 3 }
- } eliminate-write-barriers
+ } test-write-barrier
] unit-test
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors namespaces assocs sets sequences locals
compiler.cfg compiler.cfg.instructions compiler.cfg.copy-prop ;
M: insn eliminate-write-barrier ;
-: eliminate-write-barriers ( insns -- insns' )
+: write-barriers-step ( basic-block -- )
H{ } clone safe set
H{ } clone mutated set
H{ } clone copies set
- [ eliminate-write-barrier ] map sift ;
+ [ [ eliminate-write-barrier ] map sift ] change-instructions drop ;
+
+: eliminate-write-barriers ( rpo -- )
+ [ write-barriers-step ] each ;