basis/compiler/cfg/value-numbering/simd/simd.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators combinators.short-circuit arrays
   4 fry kernel layouts math namespaces sequences cpu.architecture
   5 math.bitwise math.order classes
   6 vectors locals make alien.c-types io.binary grouping
   7 math.vectors.simd.intrinsics
   8 compiler.cfg
   9 compiler.cfg.registers
  10 compiler.cfg.comparisons
  11 compiler.cfg.instructions
  12 compiler.cfg.value-numbering.alien
  13 compiler.cfg.value-numbering.expressions
  14 compiler.cfg.value-numbering.graph
  15 compiler.cfg.value-numbering.rewrite
  16 compiler.cfg.value-numbering.simplify ;
  17 IN: compiler.cfg.value-numbering.simd
  18
  19 M: ##alien-vector rewrite rewrite-alien-addressing ;
  20 M: ##set-alien-vector rewrite rewrite-alien-addressing ;
  21
  22 ! Some lame constant folding for SIMD intrinsics. Eventually this
  23 ! should be redone completely.
  24
  25 : rewrite-shuffle-vector-imm ( insn expr -- insn' )
  26     2dup [ rep>> ] bi@ eq? [
  27         [ [ dst>> ] [ src>> vn>vreg ] bi* ]
  28         [ [ shuffle>> ] bi@ nths ]
  29         [ drop rep>> ]
  30         2tri \ ##shuffle-vector-imm new-insn
  31     ] [ 2drop f ] if ;
  32
  33 : (fold-shuffle-vector-imm) ( shuffle bytes -- bytes' )
  34     2dup length swap length /i group nths concat ;
  35
  36 : fold-shuffle-vector-imm ( insn expr -- insn' )
  37     [ [ dst>> ] [ shuffle>> ] bi ] dip value>>
  38     (fold-shuffle-vector-imm) \ ##load-reference new-insn ;
  39
  40 M: ##shuffle-vector-imm rewrite
  41     dup src>> vreg>expr {
  42         { [ dup shuffle-vector-imm-expr? ] [ rewrite-shuffle-vector-imm ] }
  43         { [ dup reference-expr? ] [ fold-shuffle-vector-imm ] }
  44         [ 2drop f ]
  45     } cond ;
  46
  47 : (fold-scalar>vector) ( insn bytes -- insn' )
  48     [ [ dst>> ] [ rep>> rep-length ] bi ] dip <repetition> concat
  49     \ ##load-reference new-insn ;
  50
  51 : fold-scalar>vector ( insn expr -- insn' )
  52     value>> over rep>> {
  53         { float-4-rep [ float>bits 4 >le (fold-scalar>vector) ] }
  54         { double-2-rep [ double>bits 8 >le (fold-scalar>vector) ] }
  55         [ [ untag-fixnum ] dip rep-component-type heap-size >le (fold-scalar>vector) ]
  56     } case ;
  57
  58 M: ##scalar>vector rewrite
  59     dup src>> vreg>expr dup reference-expr?
  60     [ fold-scalar>vector ] [ 2drop f ] if ;
  61
  62 M: ##xor-vector rewrite
  63     dup [ src1>> vreg>vn ] [ src2>> vreg>vn ] bi eq?
  64     [ [ dst>> ] [ rep>> ] bi \ ##zero-vector new-insn ] [ drop f ] if ;
  65
  66 : vector-not? ( expr -- ? )
  67     {
  68         [ not-vector-expr? ]
  69         [ {
  70             [ xor-vector-expr? ]
  71             [ [ src1>> ] [ src2>> ] bi [ vn>expr fill-vector-expr? ] either? ]
  72         } 1&& ]
  73     } 1|| ;
  74
  75 GENERIC: vector-not-src ( expr -- vreg )
  76 M: not-vector-expr vector-not-src src>> vn>vreg ;
  77 M: xor-vector-expr vector-not-src
  78     dup src1>> vn>expr fill-vector-expr? [ src2>> ] [ src1>> ] if vn>vreg ;
  79
  80 M: ##and-vector rewrite
  81     {
  82         { [ dup src1>> vreg>expr vector-not? ] [
  83             {
  84                 [ dst>> ]
  85                 [ src1>> vreg>expr vector-not-src ]
  86                 [ src2>> ]
  87                 [ rep>> ]
  88             } cleave \ ##andn-vector new-insn
  89         ] }
  90         { [ dup src2>> vreg>expr vector-not? ] [
  91             {
  92                 [ dst>> ]
  93                 [ src2>> vreg>expr vector-not-src ]
  94                 [ src1>> ]
  95                 [ rep>> ]
  96             } cleave \ ##andn-vector new-insn
  97         ] }
  98         [ drop f ]
  99     } cond ;
 100
 101 M: ##andn-vector rewrite
 102     dup src1>> vreg>expr vector-not? [
 103         {
 104             [ dst>> ]
 105             [ src1>> vreg>expr vector-not-src ]
 106             [ src2>> ]
 107             [ rep>> ]
 108         } cleave \ ##and-vector new-insn
 109     ] [ drop f ] if ;
 110
 111 M: scalar>vector-expr simplify*
 112     src>> vn>expr {
 113         { [ dup vector>scalar-expr? ] [ src>> ] }
 114         [ drop f ]
 115     } cond ;
 116
 117 M: shuffle-vector-imm-expr simplify*
 118     [ src>> ] [ shuffle>> ] [ rep>> rep-length iota ] tri
 119     sequence= [ drop f ] unless ;