basis/compiler/tree/propagation/simd/simd.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors byte-arrays combinators continuations fry sequences
   4 compiler.tree.propagation.info cpu.architecture kernel words make math
   5 math.intervals math.vectors.simd.intrinsics ;
   6 IN: compiler.tree.propagation.simd
   7
   8 CONSTANT: vector>vector-intrinsics
   9     {
  10         (simd-v+)
  11         (simd-v-)
  12         (simd-vneg)
  13         (simd-v+-)
  14         (simd-vs+)
  15         (simd-vs-)
  16         (simd-vs*)
  17         (simd-v*)
  18         (simd-v/)
  19         (simd-vmin)
  20         (simd-vmax)
  21         (simd-vsqrt)
  22         (simd-vabs)
  23         (simd-vbitand)
  24         (simd-vbitandn)
  25         (simd-vbitor)
  26         (simd-vbitxor)
  27         (simd-vbitnot)
  28         (simd-vand)
  29         (simd-vandn)
  30         (simd-vor)
  31         (simd-vxor)
  32         (simd-vnot)
  33         (simd-vlshift)
  34         (simd-vrshift)
  35         (simd-hlshift)
  36         (simd-hrshift)
  37         (simd-vshuffle-elements)
  38         (simd-vshuffle-bytes)
  39         (simd-vmerge-head)
  40         (simd-vmerge-tail)
  41         (simd-v<=)
  42         (simd-v<)
  43         (simd-v=)
  44         (simd-v>)
  45         (simd-v>=)
  46         (simd-vunordered?)
  47         (simd-v>float)
  48         (simd-v>integer)
  49         (simd-vpack-signed)
  50         (simd-vpack-unsigned)
  51         (simd-vunpack-head)
  52         (simd-vunpack-tail)
  53         (simd-with)
  54         (simd-gather-2)
  55         (simd-gather-4)
  56         alien-vector
  57     }
  58
  59 CONSTANT: vector-other-intrinsics
  60     {
  61         (simd-v.)
  62         (simd-sum)
  63         (simd-vany?)
  64         (simd-vall?)
  65         (simd-vnone?)
  66         (simd-select)
  67         set-alien-vector
  68     }
  69
  70 : vector-intrinsics ( -- x )
  71     vector>vector-intrinsics vector-other-intrinsics append ;
  72
  73 vector>vector-intrinsics [ { byte-array } "default-output-classes" set-word-prop ] each
  74
  75 : scalar-output-class ( rep -- class )
  76     dup literal?>> [
  77         literal>> scalar-rep-of {
  78             { float-rep [ float ] }
  79             { double-rep [ float ] }
  80             [ drop integer ]
  81         } case
  82     ] [ drop real ] if
  83     <class-info> ;
  84
  85 \ (simd-sum) [ nip scalar-output-class ] "outputs" set-word-prop
  86
  87 \ (simd-v.) [ 2nip scalar-output-class ] "outputs" set-word-prop
  88
  89 {
  90     (simd-vany?)
  91     (simd-vall?)
  92     (simd-vnone?)
  93 } [ { boolean } "default-output-classes" set-word-prop ] each
  94
  95 \ (simd-select) [ 2nip scalar-output-class ] "outputs" set-word-prop
  96
  97 \ assert-positive [
  98     real [0,inf] <class/interval-info> value-info-intersect
  99 ] "outputs" set-word-prop
 100
 101 : try-intrinsic ( node intrinsic-quot -- ? )
 102     '[ [ _ call( node -- ) ] { } make drop t ] [ 2drop f ] recover ;
 103
 104 : inline-unless-intrinsic ( word -- )
 105     dup '[
 106         _ swap over "intrinsic" word-prop
 107         ! word node intrinsic
 108         [ try-intrinsic [ drop f ] [ def>> ] if ]
 109         [ def>> ] if*
 110     ]
 111     "custom-inlining" set-word-prop ;
 112
 113 vector-intrinsics [ inline-unless-intrinsic ] each