1 ! Copyright (C) 2009, 2011 Doug Coleman, Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays combinators combinators.short-circuit
4 compiler.cfg compiler.cfg.instructions compiler.cfg.predecessors
5 compiler.cfg.renaming compiler.cfg.rpo compiler.cfg.utilities
6 deques dlists fry kernel locals math namespaces sequences sets
8 IN: compiler.cfg.branch-splitting
10 : clone-instructions ( insns -- insns' )
11 [ clone dup rename-insn-temps ] map ;
13 : clone-basic-block ( bb -- bb' )
17 [ instructions>> clone-instructions >>instructions ]
18 [ successors>> clone >>successors ]
19 [ kill-block?>> >>kill-block? ]
23 : new-blocks ( bb -- copies )
25 [ clone-basic-block ] [ 1vector ] bi*
29 : update-predecessor-successors ( copies old-bb -- )
30 [ predecessors>> swap ] keep
31 '[ [ _ ] dip update-successors ] 2each ;
33 :: update-successor-predecessor ( copies old-bb succ -- )
34 succ predecessors>> dup >array :> ( preds preds' )
38 [ drop copies preds push-all ] [ preds push ] if
41 : update-successor-predecessors ( copies old-bb -- )
43 [ update-successor-predecessor ] 2with each ;
45 : split-branch ( bb -- )
47 [ update-predecessor-successors ]
48 [ update-successor-predecessors ]
51 UNION: irrelevant ##peek ##replace ##inc ;
53 : split-instructions? ( insns -- ? ) [ irrelevant? not ] count 5 <= ;
55 : short-tail-block? ( bb -- ? )
56 [ successors>> empty? ] [ instructions>> length 2 = ] bi and ;
58 : short-block? ( bb -- ? )
59 ! If block is empty, always split
60 [ predecessors>> length ] [ instructions>> length 1 - ] bi * 10 <= ;
62 : cond-cond-block? ( bb -- ? )
64 [ predecessors>> length 2 = ]
65 [ successors>> length 2 = ]
66 [ instructions>> length 20 <= ]
69 : split-branch? ( bb -- ? )
70 dup loop-entry? [ drop f ] [
71 dup predecessors>> length 1 <= [ drop f ] [
83 : add-to-worklist ( bb -- )
84 dup visited get ?adjoin
85 [ worklist get push-front ] [ drop ] if ;
87 : init-worklist ( cfg -- )
89 HS{ } clone visited set
90 entry>> add-to-worklist ;
92 : split-branches ( cfg -- )
94 [ needs-predecessors ]
100 dup split-branch? [ dup split-branch ] when
101 successors>> [ add-to-worklist ] each