1 ! Copyright (C) 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors combinators kernel math math.order namespaces
4 sequences vectors combinators.short-circuit
7 compiler.cfg.comparisons
8 compiler.cfg.instructions
10 compiler.cfg.value-numbering.math
11 compiler.cfg.value-numbering.graph
12 compiler.cfg.value-numbering.rewrite ;
13 IN: compiler.cfg.value-numbering.comparisons
15 ! Optimizations performed here:
17 ! 1) Eliminating intermediate boolean values when the result of
18 ! a comparison is used by a compare-branch
19 ! 2) Folding comparisons where both inputs are literal
20 ! 3) Folding comparisons where both inputs are congruent
21 ! 4) Converting compare instructions into compare-imm instructions
23 : fold-compare-imm? ( insn -- ? )
24 src1>> vreg>insn literal-insn? ;
26 : evaluate-compare-imm ( insn -- ? )
27 [ src1>> vreg>literal ] [ src2>> ] [ cc>> ] tri
33 : fold-compare-integer-imm? ( insn -- ? )
34 src1>> vreg>insn ##load-integer? ;
36 : evaluate-compare-integer-imm ( insn -- ? )
37 [ src1>> vreg>integer ] [ src2>> ] [ cc>> ] tri
38 [ <=> ] dip evaluate-cc ;
40 : fold-test-imm? ( insn -- ? )
41 src1>> vreg>insn ##load-integer? ;
43 : evaluate-test-imm ( insn -- ? )
44 [ src1>> vreg>integer ] [ src2>> ] [ cc>> ] tri
50 : rewrite-into-test? ( insn -- ? )
52 [ drop test-instruction? ]
53 [ cc>> { cc= cc/= } member-eq? ]
57 : >compare< ( insn -- in1 in2 cc )
58 [ src1>> ] [ src2>> ] [ cc>> ] tri ; inline
60 : >test-vector< ( insn -- src1 temp rep vcc )
68 UNION: scalar-compare-insn
75 ##compare-float-unordered
76 ##compare-float-ordered ;
78 UNION: general-compare-insn scalar-compare-insn ##test-vector ;
80 : rewrite-boolean-comparison? ( insn -- ? )
82 [ src1>> vreg>insn general-compare-insn? ]
87 : rewrite-boolean-comparison ( insn -- insn )
89 { [ dup ##compare? ] [ >compare< ##compare-branch new-insn ] }
90 { [ dup ##compare-imm? ] [ >compare< ##compare-imm-branch new-insn ] }
91 { [ dup ##compare-integer? ] [ >compare< ##compare-integer-branch new-insn ] }
92 { [ dup ##compare-integer-imm? ] [ >compare< ##compare-integer-imm-branch new-insn ] }
93 { [ dup ##test? ] [ >compare< ##test-branch new-insn ] }
94 { [ dup ##test-imm? ] [ >compare< ##test-imm-branch new-insn ] }
95 { [ dup ##compare-float-unordered? ] [ >compare< ##compare-float-unordered-branch new-insn ] }
96 { [ dup ##compare-float-ordered? ] [ >compare< ##compare-float-ordered-branch new-insn ] }
97 { [ dup ##test-vector? ] [ >test-vector< ##test-vector-branch new-insn ] }
100 : fold-branch ( ? -- insn )
102 basic-block get [ nth 1vector ] change-successors drop
105 : fold-compare-imm-branch ( insn -- insn/f )
106 evaluate-compare-imm fold-branch ;
108 : >test-branch ( insn -- insn )
109 [ src1>> ] [ src1>> ] [ cc>> ] tri ##test-branch new-insn ;
111 M: ##compare-imm-branch rewrite
113 { [ dup rewrite-boolean-comparison? ] [ rewrite-boolean-comparison ] }
114 { [ dup fold-compare-imm? ] [ fold-compare-imm-branch ] }
118 : fold-compare-integer-imm-branch ( insn -- insn/f )
119 evaluate-compare-integer-imm fold-branch ;
121 M: ##compare-integer-imm-branch rewrite
123 { [ dup fold-compare-integer-imm? ] [ fold-compare-integer-imm-branch ] }
124 { [ dup rewrite-into-test? ] [ >test-branch ] }
128 : fold-test-imm-branch ( insn -- insn/f )
129 evaluate-test-imm fold-branch ;
131 M: ##test-imm-branch rewrite
133 { [ dup fold-test-imm? ] [ fold-test-imm-branch ] }
137 : swap-compare ( src1 src2 cc swap? -- src1 src2 cc )
138 [ [ swap ] dip swap-cc ] when ; inline
140 : (>compare-imm-branch) ( insn swap? -- src1 src2 cc )
141 [ [ src1>> ] [ src2>> ] [ cc>> ] tri ] dip swap-compare ; inline
143 : >compare-imm-branch ( insn swap? -- insn' )
144 (>compare-imm-branch)
146 ##compare-imm-branch new-insn ; inline
148 : >compare-integer-imm-branch ( insn swap? -- insn' )
149 (>compare-imm-branch)
151 ##compare-integer-imm-branch new-insn ; inline
153 : evaluate-self-compare ( insn -- ? )
154 cc>> { cc= cc<= cc>= } member-eq? ;
156 : rewrite-self-compare-branch ( insn -- insn' )
157 evaluate-self-compare fold-branch ;
159 M: ##compare-branch rewrite
161 { [ dup src1>> vreg-immediate-comparand? ] [ t >compare-imm-branch ] }
162 { [ dup src2>> vreg-immediate-comparand? ] [ f >compare-imm-branch ] }
163 { [ dup diagonal? ] [ rewrite-self-compare-branch ] }
167 M: ##compare-integer-branch rewrite
169 { [ dup src1>> vreg-immediate-arithmetic? ] [ t >compare-integer-imm-branch ] }
170 { [ dup src2>> vreg-immediate-arithmetic? ] [ f >compare-integer-imm-branch ] }
171 { [ dup diagonal? ] [ rewrite-self-compare-branch ] }
175 : (>compare-imm) ( insn swap? -- dst src1 src2 cc )
176 [ { [ dst>> ] [ src1>> ] [ src2>> ] [ cc>> ] } cleave ] dip
177 swap-compare ; inline
179 : >compare-imm ( insn swap? -- insn' )
182 next-vreg ##compare-imm new-insn ; inline
184 : >compare-integer-imm ( insn swap? -- insn' )
187 next-vreg ##compare-integer-imm new-insn ; inline
189 : >boolean-insn ( insn ? -- insn' )
190 [ dst>> ] dip ##load-reference new-insn ;
192 : rewrite-self-compare ( insn -- insn' )
193 dup evaluate-self-compare >boolean-insn ;
197 { [ dup src1>> vreg-immediate-comparand? ] [ t >compare-imm ] }
198 { [ dup src2>> vreg-immediate-comparand? ] [ f >compare-imm ] }
199 { [ dup diagonal? ] [ rewrite-self-compare ] }
203 M: ##compare-integer rewrite
205 { [ dup src1>> vreg-immediate-arithmetic? ] [ t >compare-integer-imm ] }
206 { [ dup src2>> vreg-immediate-arithmetic? ] [ f >compare-integer-imm ] }
207 { [ dup diagonal? ] [ rewrite-self-compare ] }
211 : rewrite-redundant-comparison? ( insn -- ? )
213 [ src1>> vreg>insn scalar-compare-insn? ]
215 [ cc>> { cc= cc/= } member? ]
218 : rewrite-redundant-comparison ( insn -- insn' )
219 [ cc>> ] [ dst>> ] [ src1>> vreg>insn ] tri {
220 { [ dup ##compare? ] [ >compare< next-vreg ##compare new-insn ] }
221 { [ dup ##compare-imm? ] [ >compare< next-vreg ##compare-imm new-insn ] }
222 { [ dup ##compare-integer? ] [ >compare< next-vreg ##compare-integer new-insn ] }
223 { [ dup ##compare-integer-imm? ] [ >compare< next-vreg ##compare-integer-imm new-insn ] }
224 { [ dup ##test? ] [ >compare< next-vreg ##test new-insn ] }
225 { [ dup ##test-imm? ] [ >compare< next-vreg ##test-imm new-insn ] }
226 { [ dup ##compare-float-unordered? ] [ >compare< next-vreg ##compare-float-unordered new-insn ] }
227 { [ dup ##compare-float-ordered? ] [ >compare< next-vreg ##compare-float-ordered new-insn ] }
229 swap cc= eq? [ [ negate-cc ] change-cc ] when ;
231 : fold-compare-imm ( insn -- insn' )
232 dup evaluate-compare-imm >boolean-insn ;
234 M: ##compare-imm rewrite
236 { [ dup rewrite-redundant-comparison? ] [ rewrite-redundant-comparison ] }
237 { [ dup fold-compare-imm? ] [ fold-compare-imm ] }
241 : fold-compare-integer-imm ( insn -- insn' )
242 dup evaluate-compare-integer-imm >boolean-insn ;
244 : >test ( insn -- insn' )
245 { [ dst>> ] [ src1>> ] [ src1>> ] [ cc>> ] [ temp>> ] } cleave
248 M: ##compare-integer-imm rewrite
250 { [ dup fold-compare-integer-imm? ] [ fold-compare-integer-imm ] }
251 { [ dup rewrite-into-test? ] [ >test ] }
255 : (simplify-test) ( insn -- src1 src2 cc )
256 [ src1>> vreg>insn [ src1>> ] [ src2>> ] bi ] [ cc>> ] bi ; inline
258 : simplify-test ( insn -- insn )
259 dup (simplify-test) drop [ >>src1 ] [ >>src2 ] bi* ; inline
261 : simplify-test-branch ( insn -- insn )
262 dup (simplify-test) drop [ >>src1 ] [ >>src2 ] bi* ; inline
264 : (simplify-test-imm) ( insn -- src1 src2 cc )
265 [ src1>> vreg>insn [ src1>> ] [ src2>> ] bi ] [ cc>> ] bi ; inline
267 : simplify-test-imm ( insn -- insn )
268 [ dst>> ] [ (simplify-test-imm) ] [ temp>> ] tri ##test-imm new-insn ; inline
270 : simplify-test-imm-branch ( insn -- insn )
271 (simplify-test-imm) ##test-imm-branch new-insn ; inline
273 : >test-imm ( insn ? -- insn' )
274 (>compare-imm) [ vreg>integer ] dip next-vreg
275 ##test-imm new-insn ; inline
277 : >test-imm-branch ( insn ? -- insn' )
278 (>compare-imm-branch) [ vreg>integer ] dip
279 ##test-imm-branch new-insn ; inline
283 { [ dup src1>> vreg-immediate-comparand? ] [ t >test-imm ] }
284 { [ dup src2>> vreg-immediate-comparand? ] [ f >test-imm ] }
285 { [ dup diagonal? ] [
287 { [ dup src1>> vreg>insn ##and? ] [ simplify-test ] }
288 { [ dup src1>> vreg>insn ##and-imm? ] [ simplify-test-imm ] }
295 M: ##test-branch rewrite
297 { [ dup src1>> vreg-immediate-comparand? ] [ t >test-imm-branch ] }
298 { [ dup src2>> vreg-immediate-comparand? ] [ f >test-imm-branch ] }
299 { [ dup diagonal? ] [
301 { [ dup src1>> vreg>insn ##and? ] [ simplify-test-branch ] }
302 { [ dup src1>> vreg>insn ##and-imm? ] [ simplify-test-imm-branch ] }
309 : fold-test-imm ( insn -- insn' )
310 dup evaluate-test-imm >boolean-insn ;
312 M: ##test-imm rewrite
314 { [ dup fold-test-imm? ] [ fold-test-imm ] }