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

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