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