extra/compiler/cfg/gvn/simd/simd.factor

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