1 ! Copyright (C) 2010 Slava Pestov, 2011 Alex Vondrak.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors combinators combinators.short-circuit
4 cpu.architecture fry kernel layouts locals make math namespaces
6 compiler.cfg.instructions
9 compiler.cfg.gvn.folding
10 compiler.cfg.gvn.graph
11 compiler.cfg.gvn.avail
12 compiler.cfg.gvn.rewrite ;
13 IN: compiler.cfg.gvn.math
15 : f-insn? ( insn -- ? )
16 { [ ##load-reference? ] [ obj>> not ] } 1&& ; inline
18 : zero-insn? ( insn -- ? )
19 { [ ##load-integer? ] [ val>> 0 = ] } 1&& ; inline
21 M: ##tagged>integer rewrite
22 [ dst>> ] [ src>> vreg>insn ] bi {
23 { [ dup ##load-integer? ] [ val>> tag-fixnum ##load-integer new-insn ] }
24 { [ dup f-insn? ] [ drop \ f type-number ##load-integer new-insn ] }
28 : self-inverse? ( insn quot -- ? )
29 [ src>> vreg>insn ] dip with-available-uses? ; inline
31 : self-inverse ( insn -- insn' )
32 [ dst>> ] [ src>> vreg>insn src>> ] bi <copy> ;
34 : identity ( insn -- insn' )
35 [ dst>> ] [ src1>> ] bi <copy> ;
39 { [ dup [ ##neg? ] self-inverse? ] [ self-inverse ] }
40 { [ dup unary-constant-fold? ] [ unary-constant-fold ] }
46 { [ dup [ ##not? ] self-inverse? ] [ self-inverse ] }
47 { [ dup unary-constant-fold? ] [ unary-constant-fold ] }
51 ! Reassociation converts
55 ! ## *-imm 3 1 (X $ Y)
56 ! If * is associative, then $ is the same operation as *.
57 ! In the case of shifts, $ is addition.
58 : (reassociate) ( insn -- dst src1 src2' src2'' )
61 [ src1>> vreg>insn [ src1>> ] [ src2>> ] bi ]
65 : reassociate ( insn -- dst src1 src2 )
66 [ (reassociate) ] keep binary-constant-fold* ;
68 : ?new-insn ( dst src1 src2 ? class -- insn/f )
69 '[ _ new-insn ] [ 3drop f ] if ; inline
71 : reassociate-arithmetic ( insn new-insn -- insn/f )
72 [ reassociate dup immediate-arithmetic? ] dip ?new-insn ; inline
74 : reassociate-bitwise ( insn new-insn -- insn/f )
75 [ reassociate dup immediate-bitwise? ] dip ?new-insn ; inline
77 : reassociate-shift ( insn new-insn -- insn/f )
78 [ (reassociate) + dup immediate-shift-count? ] dip ?new-insn ; inline
82 { [ dup src2>> 0 = ] [ identity ] }
83 { [ dup binary-constant-fold? ] [ binary-constant-fold ] }
84 { [ dup src1>> vreg>insn [ ##add-imm? ] with-available-uses? ] [ ##add-imm reassociate-arithmetic ] }
88 : sub-imm>add-imm ( insn -- insn' )
89 [ dst>> ] [ src1>> ] [ src2>> neg ] tri
90 dup immediate-arithmetic?
93 M: ##sub-imm rewrite sub-imm>add-imm ;
95 ! Convert ##mul-imm -1 => ##neg
96 : mul-to-neg? ( insn -- ? )
99 : mul-to-neg ( insn -- insn' )
100 [ dst>> ] [ src1>> ] bi ##neg new-insn ;
102 ! Convert ##mul-imm 2^X => ##shl-imm X
103 : mul-to-shl? ( insn -- ? )
106 : mul-to-shl ( insn -- insn' )
107 [ [ dst>> ] [ src1>> ] bi ] [ src2>> log2 ] bi ##shl-imm new-insn ;
109 ! Distribution converts
115 ! Where * is mul or shl, + is add or sub
116 ! Have to make sure that X*Y fits in an immediate
117 :: (distribute) ( outer inner imm temp add-op mul-op -- new-outers/f )
118 imm immediate-arithmetic? [
120 temp inner src1>> outer src2>> mul-op execute
121 outer dst>> temp imm add-op execute
125 : distribute-over-add? ( insn -- ? )
126 final-iteration? get [
127 src1>> vreg>insn [ ##add-imm? ] with-available-uses?
130 : distribute-over-sub? ( insn -- ? )
131 final-iteration? get [
132 src1>> vreg>insn [ ##sub-imm? ] with-available-uses?
135 ! XXX next-vreg makes vregs>vns change on every iteration
136 : distribute ( insn add-op mul-op -- new-insns/f )
139 2dup src2>> swap [ src2>> ] keep binary-constant-fold*
141 ] 2dip (distribute) ; inline
145 { [ dup binary-constant-fold? ] [ binary-constant-fold ] }
146 { [ dup mul-to-neg? ] [ mul-to-neg ] }
147 { [ dup mul-to-shl? ] [ mul-to-shl ] }
148 { [ dup src1>> vreg>insn [ ##mul-imm? ] with-available-uses? ] [ ##mul-imm reassociate-arithmetic ] }
149 { [ dup distribute-over-add? ] [ \ ##add-imm, \ ##mul-imm, distribute ] }
150 { [ dup distribute-over-sub? ] [ \ ##sub-imm, \ ##mul-imm, distribute ] }
156 { [ dup binary-constant-fold? ] [ binary-constant-fold ] }
157 { [ dup src1>> vreg>insn [ ##and-imm? ] with-available-uses? ] [ ##and-imm reassociate-bitwise ] }
158 { [ dup src2>> 0 = ] [ dst>> 0 ##load-integer new-insn ] }
159 { [ dup src2>> -1 = ] [ identity ] }
165 { [ dup src2>> 0 = ] [ identity ] }
166 { [ dup src2>> -1 = ] [ dst>> -1 ##load-integer new-insn ] }
167 { [ dup binary-constant-fold? ] [ binary-constant-fold ] }
168 { [ dup src1>> vreg>insn [ ##or-imm? ] with-available-uses? ] [ ##or-imm reassociate-bitwise ] }
174 { [ dup src2>> 0 = ] [ identity ] }
175 { [ dup src2>> -1 = ] [ [ dst>> ] [ src1>> ] bi ##not new-insn ] }
176 { [ dup binary-constant-fold? ] [ binary-constant-fold ] }
177 { [ dup src1>> vreg>insn [ ##xor-imm? ] with-available-uses? ] [ ##xor-imm reassociate-bitwise ] }
183 { [ dup src2>> 0 = ] [ identity ] }
184 { [ dup binary-constant-fold? ] [ binary-constant-fold ] }
185 { [ dup src1>> vreg>insn [ ##shl-imm? ] with-available-uses? ] [ ##shl-imm reassociate-shift ] }
186 { [ dup distribute-over-add? ] [ \ ##add-imm, \ ##shl-imm, distribute ] }
187 { [ dup distribute-over-sub? ] [ \ ##sub-imm, \ ##shl-imm, distribute ] }
193 { [ dup src2>> 0 = ] [ identity ] }
194 { [ dup binary-constant-fold? ] [ binary-constant-fold ] }
195 { [ dup src1>> vreg>insn [ ##shr-imm? ] with-available-uses? ] [ ##shr-imm reassociate-shift ] }
201 { [ dup src2>> 0 = ] [ identity ] }
202 { [ dup binary-constant-fold? ] [ binary-constant-fold ] }
203 { [ dup src1>> vreg>insn [ ##sar-imm? ] with-available-uses? ] [ ##sar-imm reassociate-shift ] }
210 ! Where * is an operation with an -imm equivalent into
212 : insn>imm-insn ( insn op swap? -- new-insn )
214 [ [ dst>> ] [ src1>> ] [ src2>> ] tri ] dip
215 [ swap ] when vreg>integer
216 ] dip new-insn ; inline
220 { [ dup src2>> vreg-immediate-arithmetic? ] [ ##add-imm f insn>imm-insn ] }
221 { [ dup src1>> vreg-immediate-arithmetic? ] [ ##add-imm t insn>imm-insn ] }
225 : diagonal? ( insn -- ? )
226 [ src1>> vreg>vn ] [ src2>> vreg>vn ] bi = ; inline
228 ! ##sub 2 1 1 => ##load-integer 2 0
229 : rewrite-subtraction-identity ( insn -- insn' )
230 dst>> 0 ##load-integer new-insn ;
236 : sub-to-neg? ( ##sub -- ? )
237 src1>> vreg>insn zero-insn? ;
239 : sub-to-neg ( ##sub -- insn )
240 [ dst>> ] [ src2>> ] bi ##neg new-insn ;
244 { [ dup sub-to-neg? ] [ sub-to-neg ] }
245 { [ dup diagonal? ] [ rewrite-subtraction-identity ] }
246 { [ dup src2>> vreg-immediate-arithmetic? ] [ ##sub-imm f insn>imm-insn ] }
252 { [ dup src2>> vreg-immediate-arithmetic? ] [ ##mul-imm f insn>imm-insn ] }
253 { [ dup src1>> vreg-immediate-arithmetic? ] [ ##mul-imm t insn>imm-insn ] }
259 { [ dup diagonal? ] [ identity ] }
260 { [ dup src2>> vreg-immediate-bitwise? ] [ ##and-imm f insn>imm-insn ] }
261 { [ dup src1>> vreg-immediate-bitwise? ] [ ##and-imm t insn>imm-insn ] }
267 { [ dup diagonal? ] [ identity ] }
268 { [ dup src2>> vreg-immediate-bitwise? ] [ ##or-imm f insn>imm-insn ] }
269 { [ dup src1>> vreg-immediate-bitwise? ] [ ##or-imm t insn>imm-insn ] }
275 { [ dup diagonal? ] [ dst>> 0 ##load-integer new-insn ] }
276 { [ dup src2>> vreg-immediate-bitwise? ] [ ##xor-imm f insn>imm-insn ] }
277 { [ dup src1>> vreg-immediate-bitwise? ] [ ##xor-imm t insn>imm-insn ] }
283 { [ dup src2>> vreg-immediate-bitwise? ] [ ##shl-imm f insn>imm-insn ] }
289 { [ dup src2>> vreg-immediate-bitwise? ] [ ##shr-imm f insn>imm-insn ] }
295 { [ dup src2>> vreg-immediate-bitwise? ] [ ##sar-imm f insn>imm-insn ] }