1 ! Copyright (C) 2008, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs combinators.short-circuit
4 compiler.cfg.comparisons compiler.cfg.instructions
5 compiler.cfg.representations.preferred compiler.cfg.rpo
6 compiler.cfg.utilities cpu.architecture fry kernel locals math
7 namespaces sequences sets ;
8 IN: compiler.cfg.alias-analysis
10 ! Local copy propagation
13 : resolve ( vreg -- vreg ) copies get ?at drop ;
15 : record-copy ( ##copy -- )
16 [ src>> resolve ] [ dst>> ] bi copies get set-at ; inline
18 ! Map vregs -> alias classes
21 ! Map alias classes -> sequence of vregs
24 ! Alias class for objects which are loaded from the data stack
25 ! or other object slots. We pessimistically assume that they
26 ! can all alias each other.
29 : ac>vregs ( ac -- vregs )
30 acs>vregs get [ drop V{ } clone ] cache ;
32 : vreg>ac ( vreg -- ac )
33 #! Only vregs produced by ##allot, ##peek and ##slot can
34 #! ever be used as valid inputs to ##slot and ##set-slot,
35 #! so we assert this fact by not giving alias classes to
37 vregs>acs get [ heap-ac get [ ac>vregs push ] keep ] cache ;
39 : aliases ( vreg -- vregs )
40 #! All vregs which may contain the same value as vreg.
43 : each-alias ( vreg quot -- )
44 [ aliases ] dip each ; inline
46 : merge-acs ( vreg into -- )
50 [ vregs>acs get '[ [ _ ] dip _ set-at ] each ]
55 ! Map vregs -> slot# -> vreg
58 ! Maps vreg -> slot# -> insn# of last store or f
61 ! A set of insn#s of dead stores
64 : dead-store ( insn# -- ) dead-stores get adjoin ;
66 ERROR: vreg-not-new vreg ;
68 :: set-ac ( vreg ac -- )
69 #! Set alias class of newly-seen vreg.
70 vreg vregs>acs get key? [ vreg throw-vreg-not-new ] when
71 ac vreg vregs>acs get set-at
72 vreg ac ac>vregs push ;
74 : live-slot ( slot#/f vreg -- vreg' )
75 #! If the slot number is unknown, we never reuse a previous
77 over [ live-slots get at at ] [ 2drop f ] if ;
79 : load-constant-slot ( value slot# vreg -- )
80 live-slots get [ drop H{ } clone ] cache set-at ;
82 : load-slot ( value slot#/f vreg -- )
83 over [ load-constant-slot ] [ 3drop ] if ;
85 : record-constant-slot ( slot# vreg -- )
86 #! A load can potentially read every store of this slot#
87 #! in that alias class.
88 [ recent-stores get at delete-at ] with each-alias ;
90 : record-computed-slot ( vreg -- )
91 #! Computed load is like a load of every slot touched so far
92 [ recent-stores get at clear-assoc ] each-alias ;
94 :: remember-slot ( value slot# vreg -- )
96 slot# vreg record-constant-slot
97 value slot# vreg load-constant-slot
98 ] [ vreg record-computed-slot ] if ;
103 ac-counter [ dup 1 + ] change ;
105 : set-new-ac ( vreg -- ) next-ac set-ac ;
107 : kill-constant-set-slot ( slot# vreg -- )
108 [ live-slots get at delete-at ] with each-alias ;
110 : recent-stores-of ( vreg -- assoc )
111 recent-stores get [ drop H{ } clone ] cache ;
113 :: record-constant-set-slot ( insn# slot# vreg -- )
114 vreg recent-stores-of :> recent-stores
115 slot# recent-stores at [ dead-store ] when*
116 insn# slot# recent-stores set-at ;
118 : kill-computed-set-slot ( vreg -- )
119 [ live-slots get at clear-assoc ] each-alias ;
121 :: remember-set-slot ( insn# slot# vreg -- )
123 insn# slot# vreg record-constant-set-slot
124 slot# vreg kill-constant-set-slot
125 ] [ vreg kill-computed-set-slot ] if ;
127 : init-alias-analysis ( -- )
128 H{ } clone vregs>acs set
129 H{ } clone acs>vregs set
130 H{ } clone live-slots set
131 H{ } clone copies set
132 H{ } clone recent-stores set
133 HS{ } clone dead-stores set
136 GENERIC: insn-slot# ( insn -- slot#/f )
137 GENERIC: insn-object ( insn -- vreg )
139 M: ##slot insn-slot# drop f ;
140 M: ##slot-imm insn-slot# slot>> ;
141 M: ##set-slot insn-slot# drop f ;
142 M: ##set-slot-imm insn-slot# slot>> ;
143 M: ##alien-global insn-slot# [ library>> ] [ symbol>> ] bi 2array ;
144 M: ##vm-field insn-slot# offset>> ;
145 M: ##set-vm-field insn-slot# offset>> ;
147 M: ##slot insn-object obj>> resolve ;
148 M: ##slot-imm insn-object obj>> resolve ;
149 M: ##set-slot insn-object obj>> resolve ;
150 M: ##set-slot-imm insn-object obj>> resolve ;
151 M: ##alien-global insn-object drop ##alien-global ;
152 M: ##vm-field insn-object drop ##vm-field ;
153 M: ##set-vm-field insn-object drop ##vm-field ;
155 GENERIC: analyze-aliases ( insn -- insn' )
157 M: insn analyze-aliases ;
159 : def-acs ( insn -- insn' )
160 ! If an instruction defines a value with a non-integer
161 ! representation it means that the value will be boxed
162 ! anywhere its used as a tagged pointer. Boxing allocates
163 ! a new value, except boxing instructions haven't been
166 { int-rep tagged-rep } member?
167 [ drop ] [ set-new-ac ] if
170 M: vreg-insn analyze-aliases
173 M: allocation-insn analyze-aliases
174 #! A freshly allocated object is distinct from any other
176 dup dst>> set-new-ac ;
178 M: ##box-displaced-alien analyze-aliases
180 [ base>> heap-ac get merge-acs ] bi ;
182 M: read-insn analyze-aliases
184 dup [ dst>> ] [ insn-slot# ] [ insn-object ] tri
186 [ 2nip <copy> analyze-aliases nip ]
187 [ drop remember-slot ]
190 : idempotent? ( value slot#/f vreg -- ? )
191 #! Are we storing a value back to the same slot it was read
195 M:: write-insn analyze-aliases ( insn -- insn )
196 insn src>> resolve :> src
197 insn insn-slot# :> slot#
198 insn insn-object :> vreg
199 insn insn#>> :> insn#
201 src slot# vreg idempotent? [ insn# dead-store ] [
202 src heap-ac get merge-acs
203 insn insn#>> slot# vreg remember-set-slot
204 src slot# vreg load-slot
209 M: ##copy analyze-aliases
210 #! The output vreg gets the same alias class as the input
211 #! vreg, since they both contain the same value.
214 : useless-compare? ( insn -- ? )
217 [ [ src1>> ] [ src2>> ] bi [ resolve vreg>ac ] same? not ]
220 M: ##compare analyze-aliases
222 dup useless-compare? [
223 dst>> f ##load-reference new-insn
227 : clear-live-slots ( -- )
228 heap-ac get ac>vregs [ live-slots get at clear-assoc ] each ;
230 : clear-recent-stores ( -- )
231 recent-stores get values [ clear-assoc ] each ;
233 M: gc-map-insn analyze-aliases
234 ! Can't use call-next-method here because of a limitation, gah
236 clear-recent-stores ;
238 M: alien-call-insn analyze-aliases
243 GENERIC: eliminate-dead-stores ( insn -- ? )
245 M: ##set-slot-imm eliminate-dead-stores
246 insn#>> dead-stores get in? not ;
248 M: insn eliminate-dead-stores drop t ;
250 : reset-alias-analysis ( -- )
251 recent-stores get clear-assoc
252 vregs>acs get clear-assoc
253 acs>vregs get clear-assoc
254 live-slots get clear-assoc
255 copies get clear-assoc
256 dead-stores get clear-set
259 ##vm-field set-new-ac
260 ##alien-global set-new-ac ;
262 : alias-analysis-step ( insns -- insns' )
264 [ 0 [ [ insn#<< ] [ drop 1 + ] 2bi ] reduce drop ]
265 [ [ analyze-aliases ] map! [ eliminate-dead-stores ] filter! ] bi ;
267 : alias-analysis ( cfg -- )
269 [ alias-analysis-step ] simple-optimization ;