basis/math/vectors/simd/intrinsics/intrinsics.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien alien.c-types alien.data assocs combinators
   4 cpu.architecture compiler.cfg.comparisons fry generalizations
   5 kernel libc macros math
   6 math.vectors.conversion.backend
   7 sequences sets effects accessors namespaces
   8 lexer parser vocabs.parser words arrays math.vectors ;
   9 IN: math.vectors.simd.intrinsics
  10
  11 ERROR: bad-simd-call ;
  12
  13 <<
  14
  15 : simd-effect ( word -- effect )
  16     stack-effect [ in>> "rep" suffix ] [ out>> ] bi <effect> ;
  17 : simd-conversion-effect ( word -- effect )
  18     stack-effect [ in>> but-last "rep" suffix ] [ out>> ] bi <effect> ;
  19
  20 SYMBOL: simd-ops
  21
  22 V{ } clone simd-ops set-global
  23
  24 : (SIMD-OP:) ( accum quot -- accum )
  25     [
  26         scan-word dup name>> "(simd-" ")" surround create-in
  27         [ nip [ bad-simd-call ] define ]
  28     ] dip
  29     '[ _ dip set-stack-effect ]
  30     [ 2array simd-ops get push ]
  31     2tri ; inline
  32
  33 SYNTAX: SIMD-OP:
  34     [ simd-effect ] (SIMD-OP:) ;
  35
  36 SYNTAX: SIMD-CONVERSION-OP:
  37     [ simd-conversion-effect ] (SIMD-OP:) ;
  38
  39 >>
  40
  41 SIMD-OP: v+
  42 SIMD-OP: v-
  43 SIMD-OP: v+-
  44 SIMD-OP: vs+
  45 SIMD-OP: vs-
  46 SIMD-OP: vs*
  47 SIMD-OP: v*
  48 SIMD-OP: v/
  49 SIMD-OP: vmin
  50 SIMD-OP: vmax
  51 SIMD-OP: v.
  52 SIMD-OP: vsqrt
  53 SIMD-OP: sum
  54 SIMD-OP: vabs
  55 SIMD-OP: vbitand
  56 SIMD-OP: vbitandn
  57 SIMD-OP: vbitor
  58 SIMD-OP: vbitxor
  59 SIMD-OP: vbitnot
  60 SIMD-OP: vand
  61 SIMD-OP: vandn
  62 SIMD-OP: vor
  63 SIMD-OP: vxor
  64 SIMD-OP: vnot
  65 SIMD-OP: vlshift
  66 SIMD-OP: vrshift
  67 SIMD-OP: hlshift
  68 SIMD-OP: hrshift
  69 SIMD-OP: vshuffle
  70 SIMD-OP: (vmerge-head)
  71 SIMD-OP: (vmerge-tail)
  72 SIMD-OP: v<=
  73 SIMD-OP: v<
  74 SIMD-OP: v=
  75 SIMD-OP: v>
  76 SIMD-OP: v>=
  77 SIMD-OP: vunordered?
  78 SIMD-OP: vany?
  79 SIMD-OP: vall?
  80 SIMD-OP: vnone?
  81
  82 SIMD-CONVERSION-OP: (v>float)
  83 SIMD-CONVERSION-OP: (v>integer)
  84 SIMD-CONVERSION-OP: (vpack-signed)
  85 SIMD-CONVERSION-OP: (vpack-unsigned)
  86 SIMD-CONVERSION-OP: (vunpack-head)
  87 SIMD-CONVERSION-OP: (vunpack-tail)
  88
  89 : (simd-with) ( x rep -- v ) bad-simd-call ;
  90 : (simd-gather-2) ( a b rep -- v ) bad-simd-call ;
  91 : (simd-gather-4) ( a b c d rep -- v ) bad-simd-call ;
  92 : (simd-select) ( v n rep -- x ) bad-simd-call ;
  93
  94 : assert-positive ( x -- y ) ;
  95
  96 : alien-vector ( c-ptr n rep -- value )
  97     ! Inefficient version for when intrinsics are missing
  98     [ swap <displaced-alien> ] dip rep-size memory>byte-array ;
  99
 100 : set-alien-vector ( value c-ptr n rep -- )
 101     ! Inefficient version for when intrinsics are missing
 102     [ swap <displaced-alien> swap ] dip rep-size memcpy ;
 103
 104 <<
 105
 106 : rep-components ( rep -- n )
 107     16 swap rep-component-type heap-size /i ; foldable
 108
 109 : rep-coercer ( rep -- quot )
 110     {
 111         { [ dup int-vector-rep? ] [ [ >fixnum ] ] }
 112         { [ dup float-vector-rep? ] [ [ >float ] ] }
 113     } cond nip ; foldable
 114
 115 : rep-coerce ( value rep -- value' )
 116     rep-coercer call( value -- value' ) ; inline
 117
 118 CONSTANT: rep-gather-words
 119     {
 120         { 2 (simd-gather-2) }
 121         { 4 (simd-gather-4) }
 122     }
 123
 124 : rep-gather-word ( rep -- word )
 125     rep-components rep-gather-words at ;
 126
 127 >>
 128
 129 MACRO: (simd-boa) ( rep -- quot )
 130     {
 131         [ rep-coercer ]
 132         [ rep-components ]
 133         [ ]
 134         [ rep-gather-word ]
 135     } cleave
 136     '[ _ _ napply _ _ execute ] ;
 137
 138 GENERIC# supported-simd-op? 1 ( rep intrinsic -- ? )
 139
 140 : (%unpack-reps) ( -- reps )
 141     %merge-vector-reps [ int-vector-rep? ] filter
 142     %unpack-vector-head-reps union ;
 143
 144 M: vector-rep supported-simd-op?
 145     {
 146         { \ (simd-v+)            [ %add-vector-reps            ] }
 147         { \ (simd-vs+)           [ %saturated-add-vector-reps  ] }
 148         { \ (simd-v+-)           [ %add-sub-vector-reps        ] }
 149         { \ (simd-v-)            [ %sub-vector-reps            ] }
 150         { \ (simd-vs-)           [ %saturated-sub-vector-reps  ] }
 151         { \ (simd-v*)            [ %mul-vector-reps            ] }
 152         { \ (simd-vs*)           [ %saturated-mul-vector-reps  ] }
 153         { \ (simd-v/)            [ %div-vector-reps            ] }
 154         { \ (simd-vmin)          [ %min-vector-reps            ] }
 155         { \ (simd-vmax)          [ %max-vector-reps            ] }
 156         { \ (simd-v.)            [ %dot-vector-reps            ] }
 157         { \ (simd-vsqrt)         [ %sqrt-vector-reps           ] }
 158         { \ (simd-sum)           [ %horizontal-add-vector-reps ] }
 159         { \ (simd-vabs)          [ %abs-vector-reps            ] }
 160         { \ (simd-vbitand)       [ %and-vector-reps            ] }
 161         { \ (simd-vbitandn)      [ %andn-vector-reps           ] }
 162         { \ (simd-vbitor)        [ %or-vector-reps             ] }
 163         { \ (simd-vbitxor)       [ %xor-vector-reps            ] }
 164         { \ (simd-vbitnot)       [ %xor-vector-reps            ] }
 165         { \ (simd-vand)          [ %and-vector-reps            ] }
 166         { \ (simd-vandn)         [ %andn-vector-reps           ] }
 167         { \ (simd-vor)           [ %or-vector-reps             ] }
 168         { \ (simd-vxor)          [ %xor-vector-reps            ] }
 169         { \ (simd-vnot)          [ %xor-vector-reps            ] }
 170         { \ (simd-vlshift)       [ %shl-vector-reps            ] }
 171         { \ (simd-vrshift)       [ %shr-vector-reps            ] }
 172         { \ (simd-hlshift)       [ %horizontal-shl-vector-reps ] }
 173         { \ (simd-hrshift)       [ %horizontal-shr-vector-reps ] }
 174         { \ (simd-vshuffle)      [ %shuffle-vector-reps        ] }
 175         { \ (simd-(vmerge-head)) [ %merge-vector-reps          ] }
 176         { \ (simd-(vmerge-tail)) [ %merge-vector-reps          ] }
 177         { \ (simd-(v>float))        [ %integer>float-vector-reps ] }
 178         { \ (simd-(v>integer))      [ %float>integer-vector-reps ] }
 179         { \ (simd-(vpack-signed))   [ %signed-pack-vector-reps   ] }
 180         { \ (simd-(vpack-unsigned)) [ %unsigned-pack-vector-reps ] }
 181         { \ (simd-(vunpack-head))   [ (%unpack-reps)             ] }
 182         { \ (simd-(vunpack-tail))   [ (%unpack-reps)             ] }
 183         { \ (simd-v<=)           [ cc<= %compare-vector-reps   ] }
 184         { \ (simd-v<)            [ cc< %compare-vector-reps    ] }
 185         { \ (simd-v=)            [ cc= %compare-vector-reps    ] }
 186         { \ (simd-v>)            [ cc> %compare-vector-reps    ] }
 187         { \ (simd-v>=)           [ cc>= %compare-vector-reps   ] }
 188         { \ (simd-vunordered?)   [ cc/<>= %compare-vector-reps ] }
 189         { \ (simd-gather-2)      [ %gather-vector-2-reps       ] }
 190         { \ (simd-gather-4)      [ %gather-vector-4-reps       ] }
 191         { \ (simd-vany?)         [ %test-vector-reps           ] }
 192         { \ (simd-vall?)         [ %test-vector-reps           ] }
 193         { \ (simd-vnone?)        [ %test-vector-reps           ] }
 194     } case member? ;