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