basis/compiler/cfg/alias-analysis/alias-analysis.factor

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