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.utilities
  11 compiler.cfg.comparisons
  12 compiler.cfg.instructions
  13 compiler.cfg.value-numbering.alien
  14 compiler.cfg.value-numbering.expressions
  15 compiler.cfg.value-numbering.graph
  16 compiler.cfg.value-numbering.rewrite ;
  17 IN: compiler.cfg.value-numbering.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 ( 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         { [ over useless-shuffle-vector-imm? ] [ drop [ dst>> ] [ src>> ] bi <copy> ] }
  43         { [ dup shuffle-vector-imm-expr? ] [ compose-shuffle-vector-imm ] }
  44         { [ dup reference-expr? ] [ fold-shuffle-vector-imm ] }
  45         [ 2drop f ]
  46     } cond ;
  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 ( insn expr -- insn' )
  53     value>> over rep>> {
  54         { float-4-rep [ float>bits 4 >le (fold-scalar>vector) ] }
  55         { double-2-rep [ double>bits 8 >le (fold-scalar>vector) ] }
  56         [ [ untag-fixnum ] dip rep-component-type heap-size >le (fold-scalar>vector) ]
  57     } case ;
  58
  59 M: ##scalar>vector rewrite
  60     dup src>> vreg>expr {
  61         { [ dup reference-expr? ] [ fold-scalar>vector ] }
  62         { [ dup vector>scalar-expr? ] [ [ dst>> ] [ src>> vn>vreg ] bi* <copy> ] }
  63         [ 2drop f ]
  64     } cond ;
  65
  66 M: ##xor-vector rewrite
  67     dup [ src1>> vreg>vn ] [ src2>> vreg>vn ] bi eq?
  68     [ [ dst>> ] [ rep>> ] bi \ ##zero-vector new-insn ] [ drop f ] if ;
  69
  70 : vector-not? ( expr -- ? )
  71     {
  72         [ not-vector-expr? ]
  73         [ {
  74             [ xor-vector-expr? ]
  75             [ [ src1>> ] [ src2>> ] bi [ vn>expr fill-vector-expr? ] either? ]
  76         } 1&& ]
  77     } 1|| ;
  78
  79 GENERIC: vector-not-src ( expr -- vreg )
  80 M: not-vector-expr vector-not-src src>> vn>vreg ;
  81 M: xor-vector-expr vector-not-src
  82     dup src1>> vn>expr fill-vector-expr? [ src2>> ] [ src1>> ] if vn>vreg ;
  83
  84 M: ##and-vector rewrite
  85     {
  86         { [ dup src1>> vreg>expr vector-not? ] [
  87             {
  88                 [ dst>> ]
  89                 [ src1>> vreg>expr vector-not-src ]
  90                 [ src2>> ]
  91                 [ rep>> ]
  92             } cleave \ ##andn-vector new-insn
  93         ] }
  94         { [ dup src2>> vreg>expr vector-not? ] [
  95             {
  96                 [ dst>> ]
  97                 [ src2>> vreg>expr vector-not-src ]
  98                 [ src1>> ]
  99                 [ rep>> ]
 100             } cleave \ ##andn-vector new-insn
 101         ] }
 102         [ drop f ]
 103     } cond ;
 104
 105 M: ##andn-vector rewrite
 106     dup src1>> vreg>expr vector-not? [
 107         {
 108             [ dst>> ]
 109             [ src1>> vreg>expr vector-not-src ]
 110             [ src2>> ]
 111             [ rep>> ]
 112         } cleave \ ##and-vector new-insn
 113     ] [ drop f ] if ;