]> gitweb.factorcode.org Git - factor.git/blob - basis/compiler/cfg/alias-analysis/alias-analysis.factor
9fffa0eed247093ad1c4e023d4a36a349fa5326c
[factor.git] / basis / compiler / cfg / alias-analysis / alias-analysis.factor
1 ! Copyright (C) 2008, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel math namespaces assocs hashtables sequences arrays
4 accessors words vectors combinators combinators.short-circuit
5 sets classes layouts cpu.architecture
6 compiler.cfg
7 compiler.cfg.rpo
8 compiler.cfg.def-use
9 compiler.cfg.liveness
10 compiler.cfg.copy-prop
11 compiler.cfg.registers
12 compiler.cfg.comparisons
13 compiler.cfg.instructions
14 compiler.cfg.representations.preferred ;
15 IN: compiler.cfg.alias-analysis
16
17 ! We try to eliminate redundant slot operations using some simple heuristics.
18
19 ! All heap-allocated objects which are loaded from the stack, or
20 ! other object slots are pessimistically assumed to belong to
21 ! the same alias class.
22 !
23 ! Freshly-allocated objects get their own alias class.
24 !
25 ! Simple pseudo-C example showing load elimination:
26
27 ! int *x, *y, z: inputs
28 ! int a, b, c, d, e: locals
29
30 ! Before alias analysis:
31 !
32 ! a = x[2]
33 ! b = x[2]
34 ! c = x[3]
35 ! y[2] = z
36 ! d = x[2]
37 ! e = y[2]
38 ! f = x[3]
39 !
40 ! After alias analysis:
41 !
42 ! a = x[2]
43 ! b = a /* ELIMINATED */
44 ! c = x[3]
45 ! y[2] = z
46 ! d = x[2] /* if x=y, d=z, if x!=y, d=b; NOT ELIMINATED */
47 ! e = z /* ELIMINATED */
48 ! f = c /* ELIMINATED */
49 !
50 ! Simple pseudo-C example showing store elimination:
51 !
52 ! Before alias analysis:
53 !
54 ! x[0] = a
55 ! b = x[n]
56 ! x[0] = c
57 ! x[1] = d
58 ! e = x[0]
59 ! x[1] = c
60 !
61 ! After alias analysis:
62 !
63 ! x[0] = a /* dead if n = 0, live otherwise; NOT ELIMINATED */
64 ! b = x[n]
65 ! x[0] = c
66 ! /* x[1] = d */  /* ELIMINATED */
67 ! e = c
68 ! x[1] = c
69
70 ! Map vregs -> alias classes
71 SYMBOL: vregs>acs
72
73 ERROR: vreg-ac-not-set vreg ;
74
75 : vreg>ac ( vreg -- ac )
76     #! Only vregs produced by ##allot, ##peek and ##slot can
77     #! ever be used as valid inputs to ##slot and ##set-slot,
78     #! so we assert this fact by not giving alias classes to
79     #! other vregs.
80     vregs>acs get ?at [ vreg-ac-not-set ] unless ;
81
82 ! Map alias classes -> sequence of vregs
83 SYMBOL: acs>vregs
84
85 : ac>vregs ( ac -- vregs ) acs>vregs get at ;
86
87 GENERIC: aliases ( vreg -- vregs )
88
89 M: integer aliases
90     #! All vregs which may contain the same value as vreg.
91     vreg>ac ac>vregs ;
92
93 M: word aliases
94     1array ;
95
96 : each-alias ( vreg quot -- )
97     [ aliases ] dip each ; inline
98
99 ! Map vregs -> slot# -> vreg
100 SYMBOL: live-slots
101
102 ! Current instruction number
103 SYMBOL: insn#
104
105 ! Load/store history, for dead store elimination
106 TUPLE: load insn# ;
107 TUPLE: store insn# ;
108
109 : new-action ( class -- action )
110     insn# get swap boa ; inline
111
112 ! Maps vreg -> slot# -> sequence of loads/stores
113 SYMBOL: histories
114
115 : history ( vreg -- history ) histories get at ;
116
117 : set-ac ( vreg ac -- )
118     #! Set alias class of newly-seen vreg.
119     {
120         [ drop H{ } clone swap histories get set-at ]
121         [ drop H{ } clone swap live-slots get set-at ]
122         [ swap vregs>acs get set-at ]
123         [ acs>vregs get push-at ]
124     } 2cleave ;
125
126 : live-slot ( slot#/f vreg -- vreg' )
127     #! If the slot number is unknown, we never reuse a previous
128     #! value.
129     over [ live-slots get at at ] [ 2drop f ] if ;
130
131 ERROR: vreg-has-no-slots vreg ;
132
133 : load-constant-slot ( value slot# vreg -- )
134     live-slots get ?at [ vreg-has-no-slots ] unless set-at ;
135
136 : load-slot ( value slot#/f vreg -- )
137     over [ load-constant-slot ] [ 3drop ] if ;
138
139 : record-constant-slot ( slot# vreg -- )
140     #! A load can potentially read every store of this slot#
141     #! in that alias class.
142     [
143         history [ load new-action swap ?push ] change-at
144     ] with each-alias ;
145
146 : record-computed-slot ( vreg -- )
147     #! Computed load is like a load of every slot touched so far
148     [
149         history values [ load new-action swap push ] each
150     ] each-alias ;
151
152 : remember-slot ( value slot#/f vreg -- )
153     over
154     [ [ record-constant-slot ] [ load-constant-slot ] 2bi ]
155     [ 2nip record-computed-slot ] if ;
156
157 SYMBOL: ac-counter
158
159 : next-ac ( -- n )
160     ac-counter [ dup 1 + ] change ;
161
162 ! Alias class for objects which are loaded from the data stack
163 ! or other object slots. We pessimistically assume that they
164 ! can all alias each other.
165 SYMBOL: heap-ac
166
167 : set-heap-ac ( vreg -- ) heap-ac get set-ac ;
168
169 : set-new-ac ( vreg -- ) next-ac set-ac ;
170
171 : kill-constant-set-slot ( slot# vreg -- )
172     [ live-slots get at delete-at ] with each-alias ;
173
174 : record-constant-set-slot ( slot# vreg -- )
175     history [
176         dup empty? [ dup last store? [ dup pop* ] when ] unless
177         store new-action swap ?push
178     ] change-at ;
179
180 : kill-computed-set-slot ( ac -- )
181     [ live-slots get at clear-assoc ] each-alias ;
182
183 : remember-set-slot ( slot#/f vreg -- )
184     over [
185         [ record-constant-set-slot ]
186         [ kill-constant-set-slot ] 2bi
187     ] [ nip kill-computed-set-slot ] if ;
188
189 SYMBOL: constants
190
191 : constant ( vreg -- n/f )
192     #! Return a ##load-immediate value, or f if the vreg was not
193     #! assigned by an ##load-immediate.
194     resolve constants get at ;
195
196 GENERIC: insn-slot# ( insn -- slot#/f )
197 GENERIC: insn-object ( insn -- vreg )
198
199 M: ##slot insn-slot# slot>> constant ;
200 M: ##slot-imm insn-slot# slot>> ;
201 M: ##set-slot insn-slot# slot>> constant ;
202 M: ##set-slot-imm insn-slot# slot>> ;
203 M: ##alien-global insn-slot# [ library>> ] [ symbol>> ] bi 2array ;
204 M: ##vm-field-ptr insn-slot# field-name>> ;
205
206 M: ##slot insn-object obj>> resolve ;
207 M: ##slot-imm insn-object obj>> resolve ;
208 M: ##set-slot insn-object obj>> resolve ;
209 M: ##set-slot-imm insn-object obj>> resolve ;
210 M: ##alien-global insn-object drop \ ##alien-global ;
211 M: ##vm-field-ptr insn-object drop \ ##vm-field-ptr ;
212
213 : init-alias-analysis ( insns -- insns' )
214     H{ } clone histories set
215     H{ } clone vregs>acs set
216     H{ } clone acs>vregs set
217     H{ } clone live-slots set
218     H{ } clone constants set
219     H{ } clone copies set
220
221     0 ac-counter set
222     next-ac heap-ac set
223
224     \ ##vm-field-ptr set-new-ac
225     \ ##alien-global set-new-ac
226
227     dup local-live-in [ set-heap-ac ] each ;
228
229 GENERIC: analyze-aliases* ( insn -- insn' )
230
231 M: insn analyze-aliases*
232     ! If an instruction defines a value with a non-integer
233     ! representation it means that the value will be boxed
234     ! anywhere its used as a tagged pointer. Boxing allocates
235     ! a new value, except boxing instructions haven't been
236     ! inserted yet.
237     dup defs-vreg [
238         over defs-vreg-rep int-rep eq?
239         [ set-heap-ac ] [ set-new-ac ] if
240     ] when* ;
241
242 M: ##phi analyze-aliases*
243     dup defs-vreg set-heap-ac ;
244
245 M: ##load-immediate analyze-aliases*
246     call-next-method
247     dup [ val>> ] [ dst>> ] bi constants get set-at ;
248
249 M: ##allocation analyze-aliases*
250     #! A freshly allocated object is distinct from any other
251     #! object.
252     dup dst>> set-new-ac ;
253
254 M: ##read analyze-aliases*
255     call-next-method
256     dup [ dst>> ] [ insn-slot# ] [ insn-object ] tri
257     2dup live-slot dup [
258         2nip any-rep \ ##copy new-insn analyze-aliases* nip
259     ] [
260         drop remember-slot
261     ] if ;
262
263 : idempotent? ( value slot#/f vreg -- ? )
264     #! Are we storing a value back to the same slot it was read
265     #! from?
266     live-slot = ;
267
268 M: ##write analyze-aliases*
269     dup
270     [ src>> resolve ] [ insn-slot# ] [ insn-object ] tri
271     [ remember-set-slot drop ] [ load-slot ] 3bi ;
272
273 M: ##copy analyze-aliases*
274     #! The output vreg gets the same alias class as the input
275     #! vreg, since they both contain the same value.
276     dup record-copy ;
277
278 : useless-compare? ( insn -- ? )
279     {
280         [ cc>> cc= eq? ]
281         [ [ src1>> ] [ src2>> ] bi [ resolve vreg>ac ] bi@ = not ]
282     } 1&& ; inline
283
284 M: ##compare analyze-aliases*
285     call-next-method
286     dup useless-compare? [
287         dst>> \ f type-number \ ##load-immediate new-insn
288         analyze-aliases*
289     ] when ;
290
291 : analyze-aliases ( insns -- insns' )
292     [ insn# set analyze-aliases* ] map-index sift ;
293
294 SYMBOL: live-stores
295
296 : compute-live-stores ( -- )
297     histories get
298     values [
299         values [ [ store? ] filter [ insn#>> ] map ] map concat
300     ] map concat unique
301     live-stores set ;
302
303 GENERIC: eliminate-dead-stores* ( insn -- insn' )
304
305 : (eliminate-dead-stores) ( insn -- insn' )
306     dup insn-slot# [
307         insn# get live-stores get key? [
308             drop f
309         ] unless
310     ] when ;
311
312 M: ##set-slot eliminate-dead-stores* (eliminate-dead-stores) ;
313
314 M: ##set-slot-imm eliminate-dead-stores* (eliminate-dead-stores) ;
315
316 M: insn eliminate-dead-stores* ;
317
318 : eliminate-dead-stores ( insns -- insns' )
319     [ insn# set eliminate-dead-stores* ] map-index sift ;
320
321 : alias-analysis-step ( insns -- insns' )
322     init-alias-analysis
323     analyze-aliases
324     compute-live-stores
325     eliminate-dead-stores ;
326
327 : alias-analysis ( cfg -- cfg' )
328     [ alias-analysis-step ] local-optimization ;