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