1 ! Copyright (C) 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel math namespaces assocs hashtables sequences arrays
4 accessors vectors combinators sets classes compiler.cfg
5 compiler.cfg.registers compiler.cfg.instructions
6 compiler.cfg.copy-prop ;
7 IN: compiler.cfg.alias-analysis
9 ! Alias analysis -- assumes compiler.cfg.height has already run.
11 ! We try to eliminate redundant slot and stack
12 ! traffic using some simple heuristics.
14 ! All heap-allocated objects which are loaded from the stack, or
15 ! other object slots are pessimistically assumed to belong to
16 ! the same alias class.
18 ! Freshly-allocated objects get their own alias class.
20 ! The data and retain stack pointer registers are treated
21 ! uniformly, and each one gets its own alias class.
23 ! Simple pseudo-C example showing load elimination:
25 ! int *x, *y, z: inputs
26 ! int a, b, c, d, e: locals
28 ! Before alias analysis:
38 ! After alias analysis:
41 ! b = a /* ELIMINATED */
44 ! d = x[2] /* if x=y, d=z, if x!=y, d=b; NOT ELIMINATED */
45 ! e = z /* ELIMINATED */
46 ! f = c /* ELIMINATED */
48 ! Simple pseudo-C example showing store elimination:
50 ! Before alias analysis:
59 ! After alias analysis:
61 ! x[0] = a /* dead if n = 0, live otherwise; NOT ELIMINATED */
64 ! /* x[1] = d */ /* ELIMINATED */
68 ! Map vregs -> alias classes
71 : check [ "BUG: static type error detected" throw ] unless* ; inline
73 : vreg>ac ( vreg -- ac )
74 #! Only vregs produced by ##allot, ##peek and ##slot can
75 #! ever be used as valid inputs to ##slot and ##set-slot,
76 #! so we assert this fact by not giving alias classes to
78 vregs>acs get at check ;
80 ! Map alias classes -> sequence of vregs
83 : ac>vregs ( ac -- vregs ) acs>vregs get at ;
85 : aliases ( vreg -- vregs )
86 #! All vregs which may contain the same value as vreg.
89 : each-alias ( vreg quot -- )
90 [ aliases ] dip each ; inline
92 ! Map vregs -> slot# -> vreg
95 ! Current instruction number
98 ! Load/store history, for dead store elimination
102 : new-action ( class -- action )
103 insn# get swap boa ; inline
105 ! Maps vreg -> slot# -> sequence of loads/stores
108 : history ( vreg -- history ) histories get at ;
110 : set-ac ( vreg ac -- )
111 #! Set alias class of newly-seen vreg.
113 [ drop H{ } clone swap histories get set-at ]
114 [ drop H{ } clone swap live-slots get set-at ]
115 [ swap vregs>acs get set-at ]
116 [ acs>vregs get push-at ]
119 : live-slot ( slot#/f vreg -- vreg' )
120 #! If the slot number is unknown, we never reuse a previous
122 over [ live-slots get at at ] [ 2drop f ] if ;
124 : load-constant-slot ( value slot# vreg -- )
125 live-slots get at check set-at ;
127 : load-slot ( value slot#/f vreg -- )
128 over [ load-constant-slot ] [ 3drop ] if ;
130 : record-constant-slot ( slot# vreg -- )
131 #! A load can potentially read every store of this slot#
132 #! in that alias class.
134 history [ load new-action swap ?push ] change-at
137 : record-computed-slot ( vreg -- )
138 #! Computed load is like a load of every slot touched so far
140 history values [ load new-action swap push ] each
143 : remember-slot ( value slot#/f vreg -- )
145 [ [ record-constant-slot ] [ load-constant-slot ] 2bi ]
146 [ 2nip record-computed-slot ] if ;
151 ac-counter [ dup 1+ ] change ;
153 ! Alias class for objects which are loaded from the data stack
154 ! or other object slots. We pessimistically assume that they
155 ! can all alias each other.
158 : set-heap-ac ( vreg -- ) heap-ac get set-ac ;
160 : set-new-ac ( vreg -- ) next-ac set-ac ;
162 : kill-constant-set-slot ( slot# vreg -- )
163 [ live-slots get at delete-at ] with each-alias ;
165 : record-constant-set-slot ( slot# vreg -- )
167 dup empty? [ dup peek store? [ dup pop* ] when ] unless
168 store new-action swap ?push
171 : kill-computed-set-slot ( ac -- )
172 [ live-slots get at clear-assoc ] each-alias ;
174 : remember-set-slot ( slot#/f vreg -- )
176 [ record-constant-set-slot ]
177 [ kill-constant-set-slot ] 2bi
178 ] [ nip kill-computed-set-slot ] if ;
182 : constant ( vreg -- n/f )
183 #! Return a ##load-immediate value, or f if the vreg was not
184 #! assigned by an ##load-immediate.
185 resolve constants get at ;
187 ! We treat slot accessors and stack traffic alike
188 GENERIC: insn-slot# ( insn -- slot#/f )
189 GENERIC: insn-object ( insn -- vreg )
191 M: ##peek insn-slot# loc>> n>> ;
192 M: ##replace insn-slot# loc>> n>> ;
193 M: ##slot insn-slot# slot>> constant ;
194 M: ##slot-imm insn-slot# slot>> ;
195 M: ##set-slot insn-slot# slot>> constant ;
196 M: ##set-slot-imm insn-slot# slot>> ;
197 M: ##alien-global insn-slot# [ library>> ] [ symbol>> ] bi 2array ;
199 M: ##peek insn-object loc>> class ;
200 M: ##replace insn-object loc>> class ;
201 M: ##slot insn-object obj>> resolve ;
202 M: ##slot-imm insn-object obj>> resolve ;
203 M: ##set-slot insn-object obj>> resolve ;
204 M: ##set-slot-imm insn-object obj>> resolve ;
205 M: ##alien-global insn-object drop \ ##alien-global ;
207 : init-alias-analysis ( -- )
208 H{ } clone histories set
209 H{ } clone vregs>acs set
210 H{ } clone acs>vregs set
211 H{ } clone live-slots set
212 H{ } clone constants set
213 H{ } clone copies set
218 ds-loc next-ac set-ac
219 rs-loc next-ac set-ac ;
221 GENERIC: analyze-aliases* ( insn -- insn' )
223 M: ##load-immediate analyze-aliases*
224 dup [ val>> ] [ dst>> ] bi constants get set-at ;
226 M: ##load-indirect analyze-aliases*
227 dup dst>> set-heap-ac ;
229 M: ##alien-global analyze-aliases*
230 dup dst>> set-heap-ac ;
232 M: ##allot analyze-aliases*
233 #! A freshly allocated object is distinct from any other
235 dup dst>> set-new-ac ;
237 M: ##box-float analyze-aliases*
238 #! A freshly allocated object is distinct from any other
240 dup dst>> set-new-ac ;
242 M: ##box-alien analyze-aliases*
243 #! A freshly allocated object is distinct from any other
245 dup dst>> set-new-ac ;
247 M: ##read analyze-aliases*
248 dup dst>> set-heap-ac
249 dup [ dst>> ] [ insn-slot# ] [ insn-object ] tri
251 2nip f \ ##copy boa analyze-aliases* nip
256 : idempotent? ( value slot#/f vreg -- ? )
257 #! Are we storing a value back to the same slot it was read
261 M: ##write analyze-aliases*
263 [ src>> resolve ] [ insn-slot# ] [ insn-object ] tri
264 [ remember-set-slot drop ] [ load-slot ] 3bi ;
266 M: ##copy analyze-aliases*
267 #! The output vreg gets the same alias class as the input
268 #! vreg, since they both contain the same value.
271 M: insn analyze-aliases* ;
273 : analyze-aliases ( insns -- insns' )
274 [ insn# set analyze-aliases* ] map-index sift ;
278 : compute-live-stores ( -- )
281 values [ [ store? ] filter [ insn#>> ] map ] map concat
285 GENERIC: eliminate-dead-stores* ( insn -- insn' )
287 : (eliminate-dead-stores) ( insn -- insn' )
289 insn# get live-stores get key? [
294 M: ##replace eliminate-dead-stores*
295 #! Writes to above the top of the stack can be pruned also.
296 #! This is sound since any such writes are not observable
297 #! after the basic block, and any reads of those locations
298 #! will have been converted to copies by analyze-slot,
299 #! and the final stack height of the basic block is set at
300 #! the beginning by compiler.cfg.stack.
301 dup loc>> n>> 0 < [ drop f ] [ (eliminate-dead-stores) ] if ;
303 M: ##set-slot eliminate-dead-stores* (eliminate-dead-stores) ;
305 M: ##set-slot-imm eliminate-dead-stores* (eliminate-dead-stores) ;
307 M: insn eliminate-dead-stores* ;
309 : eliminate-dead-stores ( insns -- insns' )
310 [ insn# set eliminate-dead-stores* ] map-index sift ;
312 : alias-analysis ( insns -- insns' )
316 eliminate-dead-stores ;