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