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