compiler.cfg.branch-splitting: split blocks with successors
Slava Pestov
parent
8ff473e42c
commit
d7aeae45be
|
|
@ -0,0 +1,85 @@
|
|||
USING: accessors assocs compiler.cfg
|
||||
compiler.cfg.branch-splitting compiler.cfg.debugger
|
||||
compiler.cfg.predecessors compiler.cfg.rpo fry kernel
|
||||
tools.test namespaces sequences vectors ;
|
||||
IN: compiler.cfg.branch-splitting.tests
|
||||
|
||||
: get-predecessors ( cfg -- assoc )
|
||||
H{ } clone [ '[ [ predecessors>> ] keep _ set-at ] each-basic-block ] keep ;
|
||||
|
||||
: check-predecessors ( cfg -- )
|
||||
[ get-predecessors ]
|
||||
[ compute-predecessors drop ]
|
||||
[ get-predecessors ] tri assert= ;
|
||||
|
||||
: check-branch-splitting ( cfg -- )
|
||||
compute-predecessors
|
||||
split-branches
|
||||
check-predecessors ;
|
||||
|
||||
: test-branch-splitting ( -- )
|
||||
cfg new 0 get >>entry check-branch-splitting ;
|
||||
|
||||
V{ } 0 test-bb
|
||||
|
||||
V{ } 1 test-bb
|
||||
|
||||
V{ } 2 test-bb
|
||||
|
||||
V{ } 3 test-bb
|
||||
|
||||
V{ } 4 test-bb
|
||||
|
||||
test-diamond
|
||||
|
||||
[ ] [ test-branch-splitting ] unit-test
|
||||
|
||||
V{ } 0 test-bb
|
||||
|
||||
V{ } 1 test-bb
|
||||
|
||||
V{ } 2 test-bb
|
||||
|
||||
V{ } 3 test-bb
|
||||
|
||||
V{ } 4 test-bb
|
||||
|
||||
V{ } 5 test-bb
|
||||
|
||||
0 get 1 get 2 get V{ } 2sequence >>successors drop
|
||||
|
||||
1 get 3 get 4 get V{ } 2sequence >>successors drop
|
||||
|
||||
2 get 3 get 4 get V{ } 2sequence >>successors drop
|
||||
|
||||
[ ] [ test-branch-splitting ] unit-test
|
||||
|
||||
V{ } 0 test-bb
|
||||
|
||||
V{ } 1 test-bb
|
||||
|
||||
V{ } 2 test-bb
|
||||
|
||||
V{ } 3 test-bb
|
||||
|
||||
V{ } 4 test-bb
|
||||
|
||||
0 get 1 get 2 get V{ } 2sequence >>successors drop
|
||||
|
||||
1 get 3 get 4 get V{ } 2sequence >>successors drop
|
||||
|
||||
2 get 4 get 1vector >>successors drop
|
||||
|
||||
[ ] [ test-branch-splitting ] unit-test
|
||||
|
||||
V{ } 0 test-bb
|
||||
|
||||
V{ } 1 test-bb
|
||||
|
||||
V{ } 2 test-bb
|
||||
|
||||
0 get 1 get 2 get V{ } 2sequence >>successors drop
|
||||
|
||||
1 get 2 get 1vector >>successors drop
|
||||
|
||||
[ ] [ test-branch-splitting ] unit-test
|
||||
|
|
@ -1,37 +1,79 @@
|
|||
! Copyright (C) 2009 Doug Coleman, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors combinators.short-circuit kernel math sequences
|
||||
compiler.cfg.def-use compiler.cfg compiler.cfg.rpo ;
|
||||
USING: accessors combinators.short-circuit kernel math math.order
|
||||
sequences assocs namespaces vectors fry arrays splitting
|
||||
compiler.cfg.def-use compiler.cfg compiler.cfg.rpo
|
||||
compiler.cfg.renaming compiler.cfg.instructions compiler.cfg.utilities ;
|
||||
IN: compiler.cfg.branch-splitting
|
||||
|
||||
! Predecessors must be recomputed after this
|
||||
: clone-renamings ( insns -- assoc )
|
||||
[ defs-vregs ] map concat [ dup fresh-vreg ] H{ } map>assoc ;
|
||||
|
||||
: split-branch-for ( bb predecessor -- )
|
||||
[
|
||||
: clone-instructions ( insns -- insns' )
|
||||
dup clone-renamings renamings [
|
||||
[
|
||||
<basic-block>
|
||||
swap
|
||||
[ instructions>> [ clone ] map >>instructions ]
|
||||
[ successors>> clone >>successors ]
|
||||
bi
|
||||
] keep
|
||||
] dip
|
||||
[ [ 2dup eq? [ 2drop ] [ 2nip ] if ] with with map ] change-successors
|
||||
drop ;
|
||||
clone
|
||||
dup rename-insn-defs
|
||||
dup rename-insn-uses
|
||||
dup fresh-insn-temps
|
||||
] map
|
||||
] with-variable ;
|
||||
|
||||
: clone-basic-block ( bb -- bb' )
|
||||
! The new block gets the same RPO number as the old one.
|
||||
! This is just to make 'back-edge?' work.
|
||||
<basic-block>
|
||||
swap
|
||||
[ instructions>> clone-instructions >>instructions ]
|
||||
[ successors>> clone >>successors ]
|
||||
[ number>> >>number ]
|
||||
tri ;
|
||||
|
||||
: new-blocks ( bb -- copies )
|
||||
dup predecessors>> [
|
||||
[ clone-basic-block ] dip
|
||||
1vector >>predecessors
|
||||
] with map ;
|
||||
|
||||
: update-predecessor-successor ( pred copy old-bb -- )
|
||||
'[
|
||||
[ _ _ 3dup nip eq? [ drop nip ] [ 2drop ] if ] map
|
||||
] change-successors drop ;
|
||||
|
||||
: update-predecessor-successors ( copies old-bb -- )
|
||||
[ predecessors>> swap ] keep
|
||||
'[ _ update-predecessor-successor ] 2each ;
|
||||
|
||||
: update-successor-predecessor ( copies old-bb succ -- )
|
||||
[
|
||||
swap 1array split swap join V{ } like
|
||||
] change-predecessors drop ;
|
||||
|
||||
: update-successor-predecessors ( copies old-bb -- )
|
||||
dup successors>> [
|
||||
update-successor-predecessor
|
||||
] with with each ;
|
||||
|
||||
: split-branch ( bb -- )
|
||||
dup predecessors>> [ split-branch-for ] with each ;
|
||||
[ new-blocks ] keep
|
||||
[ update-predecessor-successors ]
|
||||
[ update-successor-predecessors ]
|
||||
2bi ;
|
||||
|
||||
UNION: irrelevant ##peek ##replace ##inc-d ##inc-r ;
|
||||
|
||||
: split-instructions? ( insns -- ? )
|
||||
[ irrelevant? not ] count 5 <= ;
|
||||
|
||||
: split-branches? ( bb -- ? )
|
||||
{
|
||||
[ successors>> empty? ]
|
||||
[ predecessors>> length 1 > ]
|
||||
[ instructions>> [ defs-vregs ] any? not ]
|
||||
[ instructions>> [ temp-vregs ] any? not ]
|
||||
[ dup successors>> [ back-edge? ] with any? not ]
|
||||
[ predecessors>> length 1 4 between? ]
|
||||
[ instructions>> split-instructions? ]
|
||||
} 1&& ;
|
||||
|
||||
: split-branches ( cfg -- cfg' )
|
||||
dup [
|
||||
dup split-branches? [ split-branch ] [ drop ] if
|
||||
] each-basic-block
|
||||
f >>post-order ;
|
||||
cfg-changed ;
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ USING: accessors arrays compiler.cfg.checker
|
|||
compiler.cfg.debugger compiler.cfg.def-use
|
||||
compiler.cfg.instructions fry kernel kernel.private math
|
||||
math.partial-dispatch math.private sbufs sequences sequences.private sets
|
||||
slots.private strings tools.test vectors layouts ;
|
||||
slots.private strings strings.private tools.test vectors layouts ;
|
||||
IN: compiler.cfg.optimizer.tests
|
||||
|
||||
! Miscellaneous tests
|
||||
|
|
@ -40,6 +40,10 @@ IN: compiler.cfg.optimizer.tests
|
|||
] [ 2drop f ] if
|
||||
] [ 2drop f ] if
|
||||
]
|
||||
[
|
||||
pick 10 fixnum>= [ [ 123 fixnum-bitand ] 2dip ] [ ] if
|
||||
set-string-nth-fast
|
||||
]
|
||||
} [
|
||||
[ [ ] ] dip '[ _ test-mr first check-mr ] unit-test
|
||||
] each
|
||||
|
|
|
|||
|
|
@ -29,10 +29,9 @@ SYMBOL: check-optimizer?
|
|||
! The passes that need this document it.
|
||||
[
|
||||
optimize-tail-calls
|
||||
compute-predecessors
|
||||
delete-useless-conditionals
|
||||
split-branches
|
||||
compute-predecessors
|
||||
split-branches
|
||||
stack-analysis
|
||||
compute-liveness
|
||||
alias-analysis
|
||||
|
|
|
|||
|
|
@ -55,6 +55,12 @@ M: ##string-nth rename-insn-uses
|
|||
[ rename-value ] change-index
|
||||
drop ;
|
||||
|
||||
M: ##set-string-nth-fast rename-insn-uses
|
||||
dup call-next-method
|
||||
[ rename-value ] change-obj
|
||||
[ rename-value ] change-index
|
||||
drop ;
|
||||
|
||||
M: ##set-slot-imm rename-insn-uses
|
||||
dup call-next-method
|
||||
[ rename-value ] change-obj
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
IN: compiler.cfg.stack-analysis.merge.tests
|
||||
USING: compiler.cfg.stack-analysis.merge tools.test arrays accessors
|
||||
compiler.cfg.instructions compiler.cfg.stack-analysis.state
|
||||
compiler.cfg compiler.cfg.registers compiler.cfg.debugger
|
||||
cpu.architecture make assocs namespaces
|
||||
compiler.cfg.instructions compiler.cfg.stack-analysis.state
|
||||
compiler.cfg.utilities compiler.cfg compiler.cfg.registers
|
||||
compiler.cfg.debugger cpu.architecture make assocs namespaces
|
||||
sequences kernel classes ;
|
||||
|
||||
[
|
||||
|
|
|
|||
Loading…
Reference in New Issue