basis/compiler/cfg/representations/representations.factor

   1 ! Copyright (C) 2009 Slava Pestov
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel fry accessors sequences assocs sets namespaces
   4 arrays combinators combinators.short-circuit math make locals
   5 deques dlists layouts byte-arrays cpu.architecture
   6 compiler.utilities
   7 compiler.constants
   8 compiler.cfg
   9 compiler.cfg.rpo
  10 compiler.cfg.hats
  11 compiler.cfg.registers
  12 compiler.cfg.instructions
  13 compiler.cfg.def-use
  14 compiler.cfg.utilities
  15 compiler.cfg.loop-detection
  16 compiler.cfg.renaming.functor
  17 compiler.cfg.representations.preferred ;
  18 FROM: namespaces => set ;
  19 IN: compiler.cfg.representations
  20
  21 ! Virtual register representation selection.
  22
  23 ERROR: bad-conversion dst src dst-rep src-rep ;
  24
  25 GENERIC: emit-box ( dst src rep -- )
  26 GENERIC: emit-unbox ( dst src rep -- )
  27
  28 M:: float-rep emit-box ( dst src rep -- )
  29     double-rep next-vreg-rep :> temp
  30     temp src ##single>double-float
  31     dst temp double-rep emit-box ;
  32
  33 M:: float-rep emit-unbox ( dst src rep -- )
  34     double-rep next-vreg-rep :> temp
  35     temp src double-rep emit-unbox
  36     dst temp ##double>single-float ;
  37
  38 M: double-rep emit-box
  39     drop
  40     [ drop 16 float int-rep next-vreg-rep ##allot ]
  41     [ float-offset swap ##set-alien-double ]
  42     2bi ;
  43
  44 M: double-rep emit-unbox
  45     drop float-offset ##alien-double ;
  46
  47 M:: vector-rep emit-box ( dst src rep -- )
  48     int-rep next-vreg-rep :> temp
  49     dst 16 2 cells + byte-array int-rep next-vreg-rep ##allot
  50     temp 16 tag-fixnum ##load-immediate
  51     temp dst 1 byte-array type-number ##set-slot-imm
  52     dst byte-array-offset src rep ##set-alien-vector ;
  53
  54 M: vector-rep emit-unbox
  55     [ byte-array-offset ] dip ##alien-vector ;
  56
  57 M:: scalar-rep emit-box ( dst src rep -- )
  58     int-rep next-vreg-rep :> temp
  59     temp src rep ##scalar>integer
  60     dst temp tag-bits get ##shl-imm ;
  61
  62 M:: scalar-rep emit-unbox ( dst src rep -- )
  63     int-rep next-vreg-rep :> temp
  64     temp src tag-bits get ##sar-imm
  65     dst temp rep ##integer>scalar ;
  66
  67 : emit-conversion ( dst src dst-rep src-rep -- )
  68     {
  69         { [ 2dup eq? ] [ drop ##copy ] }
  70         { [ dup int-rep eq? ] [ drop emit-unbox ] }
  71         { [ over int-rep eq? ] [ nip emit-box ] }
  72         [
  73             2dup 2array {
  74                 { { double-rep float-rep } [ 2drop ##single>double-float ] }
  75                 { { float-rep double-rep } [ 2drop ##double>single-float ] }
  76                 ! Punning SIMD vector types? Naughty naughty! But
  77                 ! it is allowed... otherwise bail out.
  78                 [
  79                     drop 2dup [ reg-class-of ] bi@ eq?
  80                     [ drop ##copy ] [ bad-conversion ] if
  81                 ]
  82             } case
  83         ]
  84     } cond ;
  85
  86 <PRIVATE
  87
  88 ! For every vreg, compute possible representations.
  89 SYMBOL: possibilities
  90
  91 : possible ( vreg -- reps ) possibilities get at ;
  92
  93 : compute-possibilities ( cfg -- )
  94     H{ } clone [ '[ swap _ conjoin-at ] with-vreg-reps ] keep
  95     [ keys ] assoc-map possibilities set ;
  96
  97 ! Compute vregs which must remain tagged for their lifetime.
  98 SYMBOL: always-boxed
  99
 100 :: (compute-always-boxed) ( vreg rep assoc -- )
 101     rep int-rep eq? [
 102         int-rep vreg assoc set-at
 103     ] when ;
 104
 105 : compute-always-boxed ( cfg -- assoc )
 106     H{ } clone [
 107         '[
 108             [
 109                 dup [ ##load-reference? ] [ ##load-constant? ] bi or
 110                 [ drop ] [ [ _ (compute-always-boxed) ] each-def-rep ] if
 111             ] each-non-phi
 112         ] each-basic-block
 113     ] keep ;
 114
 115 ! For every vreg, compute the cost of keeping it in every possible
 116 ! representation.
 117
 118 ! Cost map maps vreg to representation to cost.
 119 SYMBOL: costs
 120
 121 : init-costs ( -- )
 122     possibilities get [ [ 0 ] H{ } map>assoc ] assoc-map costs set ;
 123
 124 : increase-cost ( rep vreg -- )
 125     ! Increase cost of keeping vreg in rep, making a choice of rep less
 126     ! likely.
 127     [ basic-block get loop-nesting-at ] 2dip costs get at at+ ;
 128
 129 : maybe-increase-cost ( possible vreg preferred -- )
 130     pick eq? [ 2drop ] [ increase-cost ] if ;
 131
 132 : representation-cost ( vreg preferred -- )
 133     ! 'preferred' is a representation that the instruction can accept with no cost.
 134     ! So, for each representation that's not preferred, increase the cost of keeping
 135     ! the vreg in that representation.
 136     [ drop possible ]
 137     [ '[ _ _ maybe-increase-cost ] ]
 138     2bi each ;
 139
 140 : compute-costs ( cfg -- costs )
 141     init-costs [ representation-cost ] with-vreg-reps costs get ;
 142
 143 ! For every vreg, compute preferred representation, that minimizes costs.
 144 : minimize-costs ( costs -- representations )
 145     [ >alist alist-min first ] assoc-map ;
 146
 147 : compute-representations ( cfg -- )
 148     [ compute-costs minimize-costs ]
 149     [ compute-always-boxed ]
 150     bi assoc-union
 151     representations set ;
 152
 153 ! Insert conversions. This introduces new temporaries, so we need
 154 ! to rename opearands too.
 155
 156 ! Mapping from vreg,rep pairs to vregs
 157 SYMBOL: alternatives
 158
 159 :: emit-def-conversion ( dst preferred required -- new-dst' )
 160     ! If an instruction defines a register with representation 'required',
 161     ! but the register has preferred representation 'preferred', then
 162     ! we rename the instruction's definition to a new register, which
 163     ! becomes the input of a conversion instruction.
 164     dst required next-vreg-rep [ preferred required emit-conversion ] keep ;
 165
 166 :: emit-use-conversion ( src preferred required -- new-src' )
 167     ! If an instruction uses a register with representation 'required',
 168     ! but the register has preferred representation 'preferred', then
 169     ! we rename the instruction's input to a new register, which
 170     ! becomes the output of a conversion instruction.
 171     preferred required eq? [ src ] [
 172         src required alternatives get [
 173             required next-vreg-rep :> new-src
 174             [ new-src ] 2dip preferred emit-conversion
 175             new-src
 176         ] 2cache
 177     ] if ;
 178
 179 SYMBOLS: renaming-set needs-renaming? ;
 180
 181 : init-renaming-set ( -- )
 182     needs-renaming? off
 183     V{ } clone renaming-set set ;
 184
 185 : no-renaming ( vreg -- )
 186     dup 2array renaming-set get push ;
 187
 188 : record-renaming ( from to -- )
 189     2array renaming-set get push needs-renaming? on ;
 190
 191 :: (compute-renaming-set) ( ..a vreg required quot: ( ..a vreg preferred required -- ..b ) -- ..b )
 192     vreg rep-of :> preferred
 193     preferred required eq?
 194     [ vreg no-renaming ]
 195     [ vreg vreg preferred required quot call record-renaming ] if ; inline
 196
 197 : compute-renaming-set ( insn -- )
 198     ! temp vregs don't need conversions since they're always in their
 199     ! preferred representation
 200     init-renaming-set
 201     [ [ [ emit-use-conversion ] (compute-renaming-set) ] each-use-rep ]
 202     [ , ]
 203     [ [ [ emit-def-conversion ] (compute-renaming-set) ] each-def-rep ]
 204     tri ;
 205
 206 : converted-value ( vreg -- vreg' )
 207     renaming-set get pop first2 [ assert= ] dip ;
 208
 209 RENAMING: convert [ converted-value ] [ converted-value ] [ ]
 210
 211 : perform-renaming ( insn -- )
 212     needs-renaming? get [
 213         renaming-set get reverse! drop
 214         [ convert-insn-uses ] [ convert-insn-defs ] bi
 215         renaming-set get length 0 assert=
 216     ] [ drop ] if ;
 217
 218 GENERIC: conversions-for-insn ( insn -- )
 219
 220 SYMBOL: phi-mappings
 221
 222 ! compiler.cfg.cssa inserts conversions which convert phi inputs into
 223 !  the representation of the output. However, we still have to do some
 224 !  processing here, because if the only node that uses the output of
 225 !  the phi instruction is another phi instruction then this phi node's
 226 ! output won't have a representation assigned.
 227 M: ##phi conversions-for-insn
 228     [ , ] [ [ inputs>> values ] [ dst>> ] bi phi-mappings get set-at ] bi ;
 229
 230 ! When a literal zeroes/ones vector is unboxed, we replace the ##load-reference
 231 ! with a ##zero-vector or ##fill-vector instruction since this is more efficient.
 232 : convert-to-zero-vector? ( insn -- ? )
 233     {
 234         [ dst>> rep-of vector-rep? ]
 235         [ obj>> B{ 0 0 0 0  0 0 0 0  0 0 0 0  0 0 0 0 } = ]
 236     } 1&& ;
 237 : convert-to-fill-vector? ( insn -- ? )
 238     {
 239         [ dst>> rep-of vector-rep? ]
 240         [ obj>> B{ 255 255 255 255  255 255 255 255  255 255 255 255  255 255 255 255 } = ]
 241     } 1&& ;
 242
 243 : (convert-to-zero/fill-vector) ( insn -- dst rep )
 244     dst>> dup rep-of ; inline
 245
 246 : conversions-for-load-insn ( insn -- ?insn )
 247     {
 248         {
 249             [ dup convert-to-zero-vector? ]
 250             [ (convert-to-zero/fill-vector) ##zero-vector f ]
 251         }
 252         {
 253             [ dup convert-to-fill-vector? ]
 254             [ (convert-to-zero/fill-vector) ##fill-vector f ]
 255         }
 256         [ ]
 257     } cond ;
 258
 259 M: ##load-reference conversions-for-insn
 260     conversions-for-load-insn [ call-next-method ] when* ;
 261
 262 M: ##load-constant conversions-for-insn
 263     conversions-for-load-insn [ call-next-method ] when* ;
 264
 265 M: vreg-insn conversions-for-insn
 266     [ compute-renaming-set ] [ perform-renaming ] bi ;
 267
 268 M: insn conversions-for-insn , ;
 269
 270 : conversions-for-block ( bb -- )
 271     dup kill-block? [ drop ] [
 272         [
 273             [
 274                 H{ } clone alternatives set
 275                 [ conversions-for-insn ] each
 276             ] V{ } make
 277         ] change-instructions drop
 278     ] if ;
 279
 280 ! If the output of a phi instruction is only used as the input to another
 281 ! phi instruction, then we want to use the same representation for both
 282 ! if possible.
 283 SYMBOL: work-list
 284
 285 : add-to-work-list ( vregs -- )
 286     work-list get push-all-front ;
 287
 288 : rep-assigned ( vregs -- vregs' )
 289     representations get '[ _ key? ] filter ;
 290
 291 : rep-not-assigned ( vregs -- vregs' )
 292     representations get '[ _ key? not ] filter ;
 293
 294 : add-ready-phis ( -- )
 295     phi-mappings get keys rep-assigned add-to-work-list ;
 296
 297 : process-phi-mapping ( dst -- )
 298     ! If dst = phi(src1,src2,...) and dst's representation has been
 299     ! determined, assign that representation to each one of src1,...
 300     ! that does not have a representation yet, and process those, too.
 301     dup phi-mappings get at* [
 302         [ rep-of ] [ rep-not-assigned ] bi*
 303         [ [ set-rep-of ] with each ] [ add-to-work-list ] bi
 304     ] [ 2drop ] if ;
 305
 306 : remaining-phi-mappings ( -- )
 307     phi-mappings get keys rep-not-assigned
 308     [ [ int-rep ] dip set-rep-of ] each ;
 309
 310 : process-phi-mappings ( -- )
 311     <hashed-dlist> work-list set
 312     add-ready-phis
 313     work-list get [ process-phi-mapping ] slurp-deque
 314     remaining-phi-mappings ;
 315
 316 : insert-conversions ( cfg -- )
 317     H{ } clone phi-mappings set
 318     [ conversions-for-block ] each-basic-block
 319     process-phi-mappings ;
 320
 321 PRIVATE>
 322
 323 : select-representations ( cfg -- cfg' )
 324     needs-loops
 325
 326     {
 327         [ compute-possibilities ]
 328         [ compute-representations ]
 329         [ insert-conversions ]
 330         [ ]
 331     } cleave
 332     representations get cfg get (>>reps) ;