1 ! Copyright (C) 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs byte-arrays combinators
4 compiler.cfg compiler.cfg.instructions
5 compiler.cfg.loop-detection compiler.cfg.registers
6 compiler.cfg.representations.coalescing
7 compiler.cfg.representations.preferred compiler.cfg.rpo
8 compiler.cfg.utilities compiler.utilities cpu.architecture
9 disjoint-sets fry kernel locals math math.functions namespaces
11 IN: compiler.cfg.representations.selection
17 : handle-def ( vreg rep -- )
18 swap vreg>scc vreg-reps get
19 [ [ intersect ] when* ] change-at ;
21 : handle-use ( vreg rep -- )
22 int-rep eq? [ drop ] [ vreg>scc tagged-vregs get adjoin ] if ;
24 GENERIC: (collect-vreg-reps) ( insn -- )
26 M: ##load-reference (collect-vreg-reps)
27 [ dst>> ] [ obj>> ] bi {
28 { [ dup float? ] [ drop { float-rep double-rep } ] }
29 { [ dup byte-array? ] [ drop vector-reps ] }
33 M: vreg-insn (collect-vreg-reps)
34 [ [ handle-use ] each-use-rep ]
35 [ [ 1array handle-def ] each-def-rep ]
36 [ [ 1array handle-def ] each-temp-rep ]
39 M: insn (collect-vreg-reps) drop ;
41 : collect-vreg-reps ( cfg -- )
42 H{ } clone vreg-reps namespaces:set
43 HS{ } clone tagged-vregs namespaces:set
44 [ [ (collect-vreg-reps) ] each-non-phi ] each-basic-block ;
48 : possible-reps ( vreg reps -- vreg reps )
50 2dup [ tagged-vregs get in? not ] [ { tagged-rep } = ] bi* and
51 [ drop { tagged-rep int-rep } ] when ;
53 : compute-possibilities ( cfg -- )
55 vreg-reps get [ possible-reps ] assoc-map possibilities namespaces:set ;
57 ! For every vreg, compute the cost of keeping it in every possible
63 possibilities get [ [ 0 ] H{ } map>assoc ] assoc-map costs namespaces:set ;
65 : increase-cost ( rep scc factor -- )
66 [ costs get at 2dup key? ] dip
67 '[ [ current-loop-nesting 10^ _ * + ] change-at ] [ 2drop ] if ;
69 :: increase-costs ( vreg preferred factor -- )
71 scc possibilities get at [
72 dup preferred eq? [ drop ] [ scc factor increase-cost ] if
75 UNION: inert-tag-untag-insn
84 UNION: inert-arithmetic-tag-untag-insn
88 UNION: inert-bitwise-tag-untag-insn
93 UNION: peephole-optimizable
99 inert-arithmetic-tag-untag-insn
100 inert-bitwise-tag-untag-insn
105 ##compare-integer-imm
107 ##compare-integer-imm-branch
108 ##compare-integer-branch
114 GENERIC: compute-insn-costs ( insn -- )
116 M: insn compute-insn-costs drop ;
118 M: vreg-insn compute-insn-costs
119 dup peephole-optimizable? 2 5 ? '[ _ increase-costs ] each-rep ;
121 : compute-costs ( cfg -- )
124 [ basic-block namespaces:set ]
125 [ [ compute-insn-costs ] each-non-phi ] bi
128 : minimize-costs ( costs -- representations )
129 [ nip assoc-empty? ] assoc-reject
130 [ >alist alist-min first ] assoc-map ;
132 : compute-representations ( cfg -- )
133 compute-costs costs get minimize-costs
134 [ components get [ disjoint-set-members ] keep ] dip
135 '[ dup _ representative _ at ] H{ } map>assoc
136 representations namespaces:set ;