extra/compiler/cfg/gvn/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 generalizations
   6 combinators.smart locals make alien.c-types io.binary grouping
   7 math.vectors.simd.intrinsics
   8 compiler.cfg
   9 compiler.cfg.registers
  10 compiler.cfg.utilities
  11 compiler.cfg.comparisons
  12 compiler.cfg.instructions
  13 compiler.cfg.gvn.math
  14 compiler.cfg.gvn.graph
  15 compiler.cfg.gvn.rewrite ;
  16 IN: compiler.cfg.gvn.simd
  17
  18 ! Some lame constant folding for SIMD intrinsics. Eventually this
  19 ! should be redone completely.
  20
  21 : useless-shuffle-vector-imm? ( insn -- ? )
  22     [ shuffle>> ] [ rep>> rep-length iota ] bi sequence= ;
  23
  24 : compose-shuffle-vector-imm ( outer inner -- insn' )
  25     2dup [ rep>> ] bi@ eq? [
  26         [ [ dst>> ] [ src>> ] bi* ]
  27         [ [ shuffle>> ] bi@ nths ]
  28         [ drop rep>> ]
  29         2tri \ ##shuffle-vector-imm new-insn
  30     ] [ 2drop f ] if ;
  31
  32 : (fold-shuffle-vector-imm) ( shuffle bytes -- bytes' )
  33     2dup length swap length /i group nths concat ;
  34
  35 : fold-shuffle-vector-imm ( outer inner -- insn' )
  36     [ [ dst>> ] [ shuffle>> ] bi ] [ obj>> ] bi*
  37     (fold-shuffle-vector-imm) \ ##load-reference new-insn ;
  38
  39 M: ##shuffle-vector-imm rewrite
  40     dup src>> vreg>insn {
  41         { [ over useless-shuffle-vector-imm? ] [ drop [ dst>> ] [ src>> ] bi <copy> ] }
  42         { [ dup ##shuffle-vector-imm? ] [ compose-shuffle-vector-imm ] }
  43         { [ dup ##load-reference? ] [ fold-shuffle-vector-imm ] }
  44         [ 2drop f ]
  45     } cond ;
  46
  47 : scalar-value ( literal-insn rep -- byte-array )
  48     {
  49         { float-4-rep [ obj>> float>bits 4 >le ] }
  50         { double-2-rep [ obj>> double>bits 8 >le ] }
  51         [ [ val>> ] [ rep-component-type heap-size ] bi* >le ]
  52     } case ;
  53
  54 : (fold-scalar>vector) ( insn bytes -- insn' )
  55     [ [ dst>> ] [ rep>> rep-length ] bi ] dip <repetition> concat
  56     \ ##load-reference new-insn ;
  57
  58 : fold-scalar>vector ( outer inner -- insn' )
  59     over rep>> scalar-value (fold-scalar>vector) ;
  60
  61 M: ##scalar>vector rewrite
  62     dup src>> vreg>insn {
  63         { [ dup literal-insn? ] [ fold-scalar>vector ] }
  64         { [ dup ##vector>scalar? ] [ [ dst>> ] [ src>> ] bi* <copy> ] }
  65         [ 2drop f ]
  66     } cond ;
  67
  68 :: fold-gather-vector-2 ( insn src1 src2 -- insn )
  69     insn dst>>
  70     src1 src2 [ insn rep>> scalar-value ] bi@ append
  71     \ ##load-reference new-insn ;
  72
  73 : rewrite-gather-vector-2 ( insn -- insn/f )
  74     dup [ src1>> vreg>insn ] [ src2>> vreg>insn ] bi {
  75         { [ 2dup [ literal-insn? ] both? ] [ fold-gather-vector-2 ] }
  76         [ 3drop f ]
  77     } cond ;
  78
  79 M: ##gather-vector-2 rewrite rewrite-gather-vector-2 ;
  80
  81 M: ##gather-int-vector-2 rewrite rewrite-gather-vector-2 ;
  82
  83 :: fold-gather-vector-4 ( insn src1 src2 src3 src4 -- insn )
  84     insn dst>>
  85     [
  86         src1 src2 src3 src4
  87         [ insn rep>> scalar-value ] 4 napply
  88     ] B{ } append-outputs-as
  89     \ ##load-reference new-insn ;
  90
  91 : rewrite-gather-vector-4 ( insn -- insn/f )
  92     dup { [ src1>> ] [ src2>> ] [ src3>> ] [ src4>> ] } cleave [ vreg>insn ] 4 napply
  93     {
  94         { [ 4 ndup [ literal-insn? ] 4 napply and and and ] [ fold-gather-vector-4 ] }
  95         [ 5 ndrop f ]
  96     } cond ;
  97
  98 M: ##gather-vector-4 rewrite rewrite-gather-vector-4 ;
  99
 100 M: ##gather-int-vector-4 rewrite rewrite-gather-vector-4 ;
 101
 102 : fold-shuffle-vector ( insn src1 src2 -- insn )
 103     [ dst>> ] [ obj>> ] [ obj>> ] tri*
 104     swap nths \ ##load-reference new-insn ;
 105
 106 M: ##shuffle-vector rewrite
 107     dup [ src>> vreg>insn ] [ shuffle>> vreg>insn ] bi
 108     {
 109         { [ 2dup [ ##load-reference? ] both? ] [ fold-shuffle-vector ] }
 110         [ 3drop f ]
 111     } cond ;
 112
 113 M: ##xor-vector rewrite
 114     dup diagonal?
 115     [ [ dst>> ] [ rep>> ] bi \ ##zero-vector new-insn ] [ drop f ] if ;
 116
 117 : vector-not? ( insn -- ? )
 118     {
 119         [ ##not-vector? ]
 120         [ {
 121             [ ##xor-vector? ]
 122             [ [ src1>> ] [ src2>> ] bi [ vreg>insn ##fill-vector? ] either? ]
 123         } 1&& ]
 124     } 1|| ;
 125
 126 GENERIC: vector-not-src ( insn -- vreg )
 127
 128 M: ##not-vector vector-not-src
 129     src>> ;
 130
 131 M: ##xor-vector vector-not-src
 132     dup src1>> vreg>insn ##fill-vector? [ src2>> ] [ src1>> ] if ;
 133
 134 M: ##and-vector rewrite
 135     {
 136         { [ dup src1>> vreg>insn vector-not? ] [
 137             {
 138                 [ dst>> ]
 139                 [ src1>> vreg>insn vector-not-src ]
 140                 [ src2>> ]
 141                 [ rep>> ]
 142             } cleave \ ##andn-vector new-insn
 143         ] }
 144         { [ dup src2>> vreg>insn vector-not? ] [
 145             {
 146                 [ dst>> ]
 147                 [ src2>> vreg>insn vector-not-src ]
 148                 [ src1>> ]
 149                 [ rep>> ]
 150             } cleave \ ##andn-vector new-insn
 151         ] }
 152         [ drop f ]
 153     } cond ;
 154
 155 M: ##andn-vector rewrite
 156     dup src1>> vreg>insn vector-not? [
 157         {
 158             [ dst>> ]
 159             [ src1>> vreg>insn vector-not-src ]
 160             [ src2>> ]
 161             [ rep>> ]
 162         } cleave \ ##and-vector new-insn
 163     ] [ drop f ] if ;