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