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

   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
   8
   9 ! Alias analysis -- assumes compiler.cfg.height has already run.
  10 !
  11 ! We try to eliminate redundant slot and stack
  12 ! traffic using some simple heuristics.
  13 !
  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.
  17 !
  18 ! Freshly-allocated objects get their own alias class.
  19 !
  20 ! The data and retain stack pointer registers are treated
  21 ! uniformly, and each one gets its own alias class.
  22 !
  23 ! Simple pseudo-C example showing load elimination:
  24 !
  25 ! int *x, *y, z: inputs
  26 ! int a, b, c, d, e: locals
  27 !
  28 ! Before alias analysis:
  29 !
  30 ! a = x[2]
  31 ! b = x[2]
  32 ! c = x[3]
  33 ! y[2] = z
  34 ! d = x[2]
  35 ! e = y[2]
  36 ! f = x[3]
  37 !
  38 ! After alias analysis:
  39 !
  40 ! a = x[2]
  41 ! b = a /* ELIMINATED */
  42 ! c = x[3]
  43 ! y[2] = z
  44 ! d = x[2] /* if x=y, d=z, if x!=y, d=b; NOT ELIMINATED */
  45 ! e = z /* ELIMINATED */
  46 ! f = c /* ELIMINATED */
  47 !
  48 ! Simple pseudo-C example showing store elimination:
  49 !
  50 ! Before alias analysis:
  51 !
  52 ! x[0] = a
  53 ! b = x[n]
  54 ! x[0] = c
  55 ! x[1] = d
  56 ! e = x[0]
  57 ! x[1] = c
  58 !
  59 ! After alias analysis:
  60 !
  61 ! x[0] = a /* dead if n = 0, live otherwise; NOT ELIMINATED */
  62 ! b = x[n]
  63 ! x[0] = c
  64 ! /* x[1] = d */  /* ELIMINATED */
  65 ! e = c
  66 ! x[1] = c
  67
  68 ! Map vregs -> alias classes
  69 SYMBOL: vregs>acs
  70
  71 : check ( obj -- obj )
  72     [ "BUG: static type error detected" throw ] unless* ; inline
  73
  74 : vreg>ac ( vreg -- ac )
  75     #! Only vregs produced by ##allot, ##peek and ##slot can
  76     #! ever be used as valid inputs to ##slot and ##set-slot,
  77     #! so we assert this fact by not giving alias classes to
  78     #! other vregs.
  79     vregs>acs get at check ;
  80
  81 ! Map alias classes -> sequence of vregs
  82 SYMBOL: acs>vregs
  83
  84 : ac>vregs ( ac -- vregs ) acs>vregs get at ;
  85
  86 : aliases ( vreg -- vregs )
  87     #! All vregs which may contain the same value as vreg.
  88     vreg>ac ac>vregs ;
  89
  90 : each-alias ( vreg quot -- )
  91     [ aliases ] dip each ; inline
  92
  93 ! Map vregs -> slot# -> vreg
  94 SYMBOL: live-slots
  95
  96 ! Current instruction number
  97 SYMBOL: insn#
  98
  99 ! Load/store history, for dead store elimination
 100 TUPLE: load insn# ;
 101 TUPLE: store insn# ;
 102
 103 : new-action ( class -- action )
 104     insn# get swap boa ; inline
 105
 106 ! Maps vreg -> slot# -> sequence of loads/stores
 107 SYMBOL: histories
 108
 109 : history ( vreg -- history ) histories get at ;
 110
 111 : set-ac ( vreg ac -- )
 112     #! Set alias class of newly-seen vreg.
 113     {
 114         [ drop H{ } clone swap histories get set-at ]
 115         [ drop H{ } clone swap live-slots get set-at ]
 116         [ swap vregs>acs get set-at ]
 117         [ acs>vregs get push-at ]
 118     } 2cleave ;
 119
 120 : live-slot ( slot#/f vreg -- vreg' )
 121     #! If the slot number is unknown, we never reuse a previous
 122     #! value.
 123     over [ live-slots get at at ] [ 2drop f ] if ;
 124
 125 : load-constant-slot ( value slot# vreg -- )
 126     live-slots get at check set-at ;
 127
 128 : load-slot ( value slot#/f vreg -- )
 129     over [ load-constant-slot ] [ 3drop ] if ;
 130
 131 : record-constant-slot ( slot# vreg -- )
 132     #! A load can potentially read every store of this slot#
 133     #! in that alias class.
 134     [
 135         history [ load new-action swap ?push ] change-at
 136     ] with each-alias ;
 137
 138 : record-computed-slot ( vreg -- )
 139     #! Computed load is like a load of every slot touched so far
 140     [
 141         history values [ load new-action swap push ] each
 142     ] each-alias ;
 143
 144 : remember-slot ( value slot#/f vreg -- )
 145     over
 146     [ [ record-constant-slot ] [ load-constant-slot ] 2bi ]
 147     [ 2nip record-computed-slot ] if ;
 148
 149 SYMBOL: ac-counter
 150
 151 : next-ac ( -- n )
 152     ac-counter [ dup 1+ ] change ;
 153
 154 ! Alias class for objects which are loaded from the data stack
 155 ! or other object slots. We pessimistically assume that they
 156 ! can all alias each other.
 157 SYMBOL: heap-ac
 158
 159 : set-heap-ac ( vreg -- ) heap-ac get set-ac ;
 160
 161 : set-new-ac ( vreg -- ) next-ac set-ac ;
 162
 163 : kill-constant-set-slot ( slot# vreg -- )
 164     [ live-slots get at delete-at ] with each-alias ;
 165
 166 : record-constant-set-slot ( slot# vreg -- )
 167     history [
 168         dup empty? [ dup last store? [ dup pop* ] when ] unless
 169         store new-action swap ?push
 170     ] change-at ;
 171
 172 : kill-computed-set-slot ( ac -- )
 173     [ live-slots get at clear-assoc ] each-alias ;
 174
 175 : remember-set-slot ( slot#/f vreg -- )
 176     over [
 177         [ record-constant-set-slot ]
 178         [ kill-constant-set-slot ] 2bi
 179     ] [ nip kill-computed-set-slot ] if ;
 180
 181 SYMBOL: constants
 182
 183 : constant ( vreg -- n/f )
 184     #! Return a ##load-immediate value, or f if the vreg was not
 185     #! assigned by an ##load-immediate.
 186     resolve constants get at ;
 187
 188 ! We treat slot accessors and stack traffic alike
 189 GENERIC: insn-slot# ( insn -- slot#/f )
 190 GENERIC: insn-object ( insn -- vreg )
 191
 192 M: ##peek insn-slot# loc>> n>> ;
 193 M: ##replace insn-slot# loc>> n>> ;
 194 M: ##slot insn-slot# slot>> constant ;
 195 M: ##slot-imm insn-slot# slot>> ;
 196 M: ##set-slot insn-slot# slot>> constant ;
 197 M: ##set-slot-imm insn-slot# slot>> ;
 198 M: ##alien-global insn-slot# [ library>> ] [ symbol>> ] bi 2array ;
 199
 200 M: ##peek insn-object loc>> class ;
 201 M: ##replace insn-object loc>> class ;
 202 M: ##slot insn-object obj>> resolve ;
 203 M: ##slot-imm insn-object obj>> resolve ;
 204 M: ##set-slot insn-object obj>> resolve ;
 205 M: ##set-slot-imm insn-object obj>> resolve ;
 206 M: ##alien-global insn-object drop \ ##alien-global ;
 207
 208 : init-alias-analysis ( -- )
 209     H{ } clone histories set
 210     H{ } clone vregs>acs set
 211     H{ } clone acs>vregs set
 212     H{ } clone live-slots set
 213     H{ } clone constants set
 214     H{ } clone copies set
 215
 216     0 ac-counter set
 217     next-ac heap-ac set
 218
 219     ds-loc next-ac set-ac
 220     rs-loc next-ac set-ac ;
 221
 222 GENERIC: analyze-aliases* ( insn -- insn' )
 223
 224 M: ##load-immediate analyze-aliases*
 225     dup [ val>> ] [ dst>> ] bi constants get set-at ;
 226
 227 M: ##load-reference analyze-aliases*
 228     dup dst>> set-heap-ac ;
 229
 230 M: ##alien-global analyze-aliases*
 231     dup dst>> set-heap-ac ;
 232
 233 M: ##allot analyze-aliases*
 234     #! A freshly allocated object is distinct from any other
 235     #! object.
 236     dup dst>> set-new-ac ;
 237
 238 M: ##box-float analyze-aliases*
 239     #! A freshly allocated object is distinct from any other
 240     #! object.
 241     dup dst>> set-new-ac ;
 242
 243 M: ##box-alien analyze-aliases*
 244     #! A freshly allocated object is distinct from any other
 245     #! object.
 246     dup dst>> set-new-ac ;
 247
 248 M: ##read analyze-aliases*
 249     dup dst>> set-heap-ac
 250     dup [ dst>> ] [ insn-slot# ] [ insn-object ] tri
 251     2dup live-slot dup [
 252         2nip f \ ##copy boa analyze-aliases* nip
 253     ] [
 254         drop remember-slot
 255     ] if ;
 256
 257 : idempotent? ( value slot#/f vreg -- ? )
 258     #! Are we storing a value back to the same slot it was read
 259     #! from?
 260     live-slot = ;
 261
 262 M: ##write analyze-aliases*
 263     dup
 264     [ src>> resolve ] [ insn-slot# ] [ insn-object ] tri
 265     [ remember-set-slot drop ] [ load-slot ] 3bi ;
 266
 267 M: ##copy analyze-aliases*
 268     #! The output vreg gets the same alias class as the input
 269     #! vreg, since they both contain the same value.
 270     dup record-copy ;
 271
 272 M: insn analyze-aliases* ;
 273
 274 : analyze-aliases ( insns -- insns' )
 275     [ insn# set analyze-aliases* ] map-index sift ;
 276
 277 SYMBOL: live-stores
 278
 279 : compute-live-stores ( -- )
 280     histories get
 281     values [
 282         values [ [ store? ] filter [ insn#>> ] map ] map concat
 283     ] map concat unique
 284     live-stores set ;
 285
 286 GENERIC: eliminate-dead-stores* ( insn -- insn' )
 287
 288 : (eliminate-dead-stores) ( insn -- insn' )
 289     dup insn-slot# [
 290         insn# get live-stores get key? [
 291             drop f
 292         ] unless
 293     ] when ;
 294
 295 M: ##replace eliminate-dead-stores*
 296     #! Writes to above the top of the stack can be pruned also.
 297     #! This is sound since any such writes are not observable
 298     #! after the basic block, and any reads of those locations
 299     #! will have been converted to copies by analyze-slot,
 300     #! and the final stack height of the basic block is set at
 301     #! the beginning by compiler.cfg.stack.
 302     dup loc>> n>> 0 < [ drop f ] [ (eliminate-dead-stores) ] if ;
 303
 304 M: ##set-slot eliminate-dead-stores* (eliminate-dead-stores) ;
 305
 306 M: ##set-slot-imm eliminate-dead-stores* (eliminate-dead-stores) ;
 307
 308 M: insn eliminate-dead-stores* ;
 309
 310 : eliminate-dead-stores ( insns -- insns' )
 311     [ insn# set eliminate-dead-stores* ] map-index sift ;
 312
 313 : alias-analysis ( insns -- insns' )
 314     init-alias-analysis
 315     analyze-aliases
 316     compute-live-stores
 317     eliminate-dead-stores ;