1 ! Copyright (C) 2009, 2011 Doug Coleman, Slava Pestov.
2 ! See https://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 kernel math namespaces sequences sets vectors ;
7 IN: compiler.cfg.branch-splitting
9 : clone-instructions ( insns -- insns' )
10 [ clone dup rename-insn-temps ] map ;
12 : clone-basic-block ( bb -- bb' )
16 [ instructions>> clone-instructions >>instructions ]
17 [ successors>> clone >>successors ]
18 [ kill-block?>> >>kill-block? ]
22 : new-blocks ( bb -- copies )
24 [ clone-basic-block ] [ 1vector ] bi*
28 : update-predecessor-successors ( copies old-bb -- )
29 [ predecessors>> swap ] keep
30 '[ [ _ ] dip update-successors ] 2each ;
32 :: update-successor-predecessor ( copies old-bb succ -- )
33 succ predecessors>> dup >array :> ( preds preds' )
37 [ drop copies preds push-all ] [ preds push ] if
40 : update-successor-predecessors ( copies old-bb -- )
42 [ update-successor-predecessor ] 2with each ;
44 : split-branch ( bb -- )
46 [ update-predecessor-successors ]
47 [ update-successor-predecessors ]
50 UNION: irrelevant ##peek ##replace ##inc ;
52 : split-instructions? ( insns -- ? ) [ irrelevant? not ] count 5 <= ;
54 : short-tail-block? ( bb -- ? )
55 [ successors>> empty? ] [ instructions>> length 2 = ] bi and ;
57 : short-block? ( bb -- ? )
58 ! If block is empty, always split
59 [ predecessors>> length ] [ instructions>> length 1 - ] bi * 10 <= ;
61 : cond-cond-block? ( bb -- ? )
63 [ predecessors>> length 2 = ]
64 [ successors>> length 2 = ]
65 [ instructions>> length 20 <= ]
68 : split-branch? ( bb -- ? )
69 dup loop-entry? [ drop f ] [
70 dup predecessors>> length 1 <= [ drop f ] [
82 : add-to-worklist ( bb -- )
83 dup visited get ?adjoin
84 [ worklist get push-front ] [ drop ] if ;
86 : init-worklist ( cfg -- )
87 <dlist> worklist namespaces:set
88 HS{ } clone visited namespaces:set
89 entry>> add-to-worklist ;
91 : split-branches ( cfg -- )
93 [ needs-predecessors ]
99 dup split-branch? [ dup split-branch ] when
100 successors>> [ add-to-worklist ] each