1 ! Copyright (C) 2008, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs combinators combinators.short-circuit
4 cpu.architecture kernel layouts locals make math namespaces sequences
5 sets vectors fry arrays compiler.cfg compiler.cfg.instructions
6 compiler.cfg.rpo compiler.utilities ;
7 IN: compiler.cfg.utilities
9 PREDICATE: kill-block < basic-block
12 [ penultimate kill-vreg-insn? ]
15 : back-edge? ( from to -- ? )
18 : loop-entry? ( bb -- ? )
19 dup predecessors>> [ swap back-edge? ] with any? ;
21 : empty-block? ( bb -- ? )
29 : (skip-empty-blocks) ( bb -- bb' )
30 dup visited get key? [
32 dup visited get conjoin
33 successors>> first (skip-empty-blocks)
37 : skip-empty-blocks ( bb -- bb' )
38 H{ } clone visited [ (skip-empty-blocks) ] with-variable ;
40 :: insert-basic-block ( froms to bb -- )
41 bb froms V{ } like >>predecessors drop
42 bb to 1vector >>successors drop
43 to predecessors>> [ dup froms member-eq? [ drop bb ] when ] map! drop
44 froms [ successors>> [ dup to eq? [ drop bb ] when ] map! drop ] each ;
46 : add-instructions ( bb quot -- )
47 [ instructions>> building ] dip '[
51 ] with-variable ; inline
53 : <simple-block> ( insns -- bb )
56 \ ##branch new-insn over push
59 : insert-simple-basic-block ( from to insns -- )
60 [ 1vector ] 2dip <simple-block> insert-basic-block ;
62 : has-phis? ( bb -- ? )
63 instructions>> first ##phi? ;
65 : cfg-has-phis? ( cfg -- ? )
66 post-order [ has-phis? ] any? ;
68 : if-has-phis ( bb quot: ( bb -- ) -- )
69 [ dup has-phis? ] dip [ drop ] if ; inline
71 : each-phi ( bb quot: ( ##phi -- ) -- )
72 [ instructions>> ] dip
73 '[ dup ##phi? [ @ t ] [ drop f ] if ] all? drop ; inline
75 : each-non-phi ( bb quot: ( insn -- ) -- )
76 [ instructions>> ] dip
77 '[ dup ##phi? [ drop ] _ if ] each ; inline
79 : predecessor ( bb -- pred )
80 predecessors>> first ; inline