1 ! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs kernel namespaces sequences
4 compiler.cfg.instructions compiler.cfg.def-use
5 compiler.cfg.rpo compiler.cfg.predecessors hash-sets sets ;
6 FROM: namespaces => set ;
9 ! Maps vregs to sequences of vregs
10 SYMBOL: liveness-graph
12 ! vregs which participate in side effects and thus are always live
15 : live-vreg? ( vreg -- ? )
18 ! vregs which are the result of an allocation
21 : allocation? ( vreg -- ? )
24 : init-dead-code ( -- )
25 H{ } clone liveness-graph set
26 HS{ } clone live-vregs set
27 HS{ } clone allocations set ;
29 GENERIC: build-liveness-graph ( insn -- )
31 : add-edges ( insn register -- )
32 [ uses-vregs ] dip liveness-graph get [ union ] change-at ;
34 : setter-liveness-graph ( insn vreg -- )
35 dup allocation? [ add-edges ] [ 2drop ] if ;
37 M: ##set-slot build-liveness-graph
38 dup obj>> setter-liveness-graph ;
40 M: ##set-slot-imm build-liveness-graph
41 dup obj>> setter-liveness-graph ;
43 M: ##write-barrier build-liveness-graph
44 dup src>> setter-liveness-graph ;
46 M: ##write-barrier-imm build-liveness-graph
47 dup src>> setter-liveness-graph ;
49 M: ##allot build-liveness-graph
50 [ dst>> allocations get adjoin ] [ call-next-method ] bi ;
52 M: insn build-liveness-graph
53 dup defs-vreg dup [ add-edges ] [ 2drop ] if ;
55 GENERIC: compute-live-vregs ( insn -- )
57 : (record-live) ( vregs -- )
59 dup live-vreg? [ drop ] [
60 [ live-vregs get adjoin ]
61 [ liveness-graph get at (record-live) ]
66 : record-live ( insn -- )
67 uses-vregs (record-live) ;
69 : setter-live-vregs ( insn vreg -- )
70 allocation? [ drop ] [ record-live ] if ;
72 M: ##set-slot compute-live-vregs
73 dup obj>> setter-live-vregs ;
75 M: ##set-slot-imm compute-live-vregs
76 dup obj>> setter-live-vregs ;
78 M: ##write-barrier compute-live-vregs
79 dup src>> setter-live-vregs ;
81 M: ##write-barrier-imm compute-live-vregs
82 dup src>> setter-live-vregs ;
84 M: ##fixnum-add compute-live-vregs record-live ;
86 M: ##fixnum-sub compute-live-vregs record-live ;
88 M: ##fixnum-mul compute-live-vregs record-live ;
90 M: insn compute-live-vregs
91 dup defs-vreg [ drop ] [ record-live ] if ;
93 GENERIC: live-insn? ( insn -- ? )
95 M: ##set-slot live-insn? obj>> live-vreg? ;
97 M: ##set-slot-imm live-insn? obj>> live-vreg? ;
99 M: ##write-barrier live-insn? src>> live-vreg? ;
101 M: ##write-barrier-imm live-insn? src>> live-vreg? ;
103 M: ##fixnum-add live-insn? drop t ;
105 M: ##fixnum-sub live-insn? drop t ;
107 M: ##fixnum-mul live-insn? drop t ;
109 M: insn live-insn? defs-vreg [ live-vreg? ] [ t ] if* ;
111 : eliminate-dead-code ( cfg -- cfg' )
112 ! Even though we don't use predecessors directly, we depend
113 ! on the predecessors pass updating phi nodes to remove dead
119 [ [ instructions>> [ build-liveness-graph ] each ] each-basic-block ]
120 [ [ instructions>> [ compute-live-vregs ] each ] each-basic-block ]
121 [ [ instructions>> [ live-insn? ] filter! drop ] each-basic-block ]