]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/math/vectors/simd/simd.factor
factor: trim using lists
[factor.git] / basis / math / vectors / simd / simd.factor
index a0d949fb6860c5d6dcf00a0fcfdbb3b00cc8a5af..7870ed8db619eece9d06307477f9059fff7ae41e 100644 (file)
@@ -1,15 +1,13 @@
 USING: accessors alien arrays byte-arrays classes combinators
-cpu.architecture effects fry functors generalizations generic
-generic.parser kernel lexer literals locals macros math math.functions
-math.vectors math.vectors.private math.vectors.simd.intrinsics
-namespaces parser prettyprint.custom quotations sequences
-sequences.generalizations sequences.private vocabs vocabs.loader
-words ;
+cpu.architecture effects functors generalizations kernel lexer
+literals math math.bitwise math.vectors
+math.vectors.simd.intrinsics parser prettyprint.custom
+quotations sequences sequences.generalizations sequences.private
+vocabs.loader words ;
 QUALIFIED-WITH: alien.c-types c
 IN: math.vectors.simd
 
 ERROR: bad-simd-length got expected ;
-
 ERROR: bad-simd-vector obj ;
 
 <<
@@ -95,7 +93,7 @@ DEFER: simd-construct-op
 
 : (vvx->v-op) ( a b obj rep quot: ( (a) (b) obj rep -- (c) ) -- c )
     [ [ simd-unbox ] [ underlying>> ] bi* ] 3dip 2curry 2curry make-underlying ; inline
-    
+
 : vv->v-op ( a b rep quot: ( (a) (b) rep -- (c) ) fallback-quot -- c )
     [ '[ _ (vv->v-op) ] ] [ '[ drop @ ] ] bi* if-both-vectors-match ; inline
 
@@ -110,6 +108,21 @@ DEFER: simd-construct-op
 : vv->x-op ( a b rep quot: ( (a) (b) rep -- obj ) fallback-quot -- obj )
     [ '[ _ (vv->x-op) ] ] [ '[ drop @ ] ] bi* if-both-vectors-match ; inline
 
+: mask>count ( n rep -- n' )
+    [ bit-count ] dip {
+        { float-4-rep     [ ] }
+        { double-2-rep    [ -1 shift ] }
+        { uchar-16-rep    [ ] }
+        { char-16-rep     [ ] }
+        { ushort-8-rep    [ -1 shift ] }
+        { short-8-rep     [ -1 shift ] }
+        { ushort-8-rep    [ -1 shift ] }
+        { int-4-rep       [ -2 shift ] }
+        { uint-4-rep      [ -2 shift ] }
+        { longlong-2-rep  [ -3 shift ] }
+        { ulonglong-2-rep [ -3 shift ] }
+    } case ; inline
+
 PRIVATE>
 >>
 
@@ -132,97 +145,101 @@ M: simd-128 equal?
 ! SIMD primitive operations
 
 M: simd-128 v+
-    dup simd-rep [ (simd-v+)                ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-v+) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 v-
-    dup simd-rep [ (simd-v-)                ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-v-) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 vneg
-    dup simd-rep [ (simd-vneg)              ] [ call-next-method ] v->v-op  ; inline
+    dup simd-rep [ (simd-vneg) ] [ call-next-method ] v->v-op  ; inline
 M: simd-128 v+-
-    dup simd-rep [ (simd-v+-)               ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-v+-) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 vs+
-    dup simd-rep [ (simd-vs+)               ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-vs+) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 vs-
-    dup simd-rep [ (simd-vs-)               ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-vs-) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 vs*
-    dup simd-rep [ (simd-vs*)               ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-vs*) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 v*
-    dup simd-rep [ (simd-v*)                ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-v*) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 v*high
-    dup simd-rep [ (simd-v*high)            ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-v*high) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 v/
-    dup simd-rep [ (simd-v/)                ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-v/) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 vavg
-    dup simd-rep [ (simd-vavg)              ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-vavg) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 vmin
-    dup simd-rep [ (simd-vmin)              ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-vmin) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 vmax
-    dup simd-rep [ (simd-vmax)              ] [ call-next-method ] vv->v-op ; inline
-M: simd-128 v.
-    dup simd-rep [ (simd-v.)                ] [ call-next-method ] vv->x-op ; inline
+    dup simd-rep [ (simd-vmax) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 vdot
+    dup simd-rep [ (simd-vdot) ] [ call-next-method ] vv->x-op ; inline
 M: simd-128 vsad
-    dup simd-rep [ (simd-vsad)              ] [ call-next-method ] vv->x-op ; inline
+    dup simd-rep [ (simd-vsad) ] [ call-next-method ] vv->x-op ; inline
 M: simd-128 vsqrt
-    dup simd-rep [ (simd-vsqrt)             ] [ call-next-method ] v->v-op  ; inline
+    dup simd-rep [ (simd-vsqrt) ] [ call-next-method ] v->v-op  ; inline
 M: simd-128 sum
-    dup simd-rep [ (simd-sum)               ] [ call-next-method ] v->x-op  ; inline
+    dup simd-rep [ (simd-sum) ] [ call-next-method ] v->x-op  ; inline
 M: simd-128 vabs
-    dup simd-rep [ (simd-vabs)              ] [ call-next-method ] v->v-op  ; inline
+    dup simd-rep [ (simd-vabs) ] [ call-next-method ] v->v-op  ; inline
 M: simd-128 vbitand
-    dup simd-rep [ (simd-vbitand)           ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-vbitand) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 vbitandn
-    dup simd-rep [ (simd-vbitandn)          ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-vbitandn) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 vbitor
-    dup simd-rep [ (simd-vbitor)            ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-vbitor) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 vbitxor
-    dup simd-rep [ (simd-vbitxor)           ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-vbitxor) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 vbitnot
-    dup simd-rep [ (simd-vbitnot)           ] [ call-next-method ] v->v-op  ; inline
+    dup simd-rep [ (simd-vbitnot) ] [ call-next-method ] v->v-op  ; inline
 M: simd-128 vand
-    dup simd-rep [ (simd-vand)              ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-vand) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 vandn
-    dup simd-rep [ (simd-vandn)             ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-vandn) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 vor
-    dup simd-rep [ (simd-vor)               ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-vor) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 vxor
-    dup simd-rep [ (simd-vxor)              ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-vxor) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 vnot
-    dup simd-rep [ (simd-vnot)              ] [ call-next-method ] v->v-op  ; inline
+    dup simd-rep [ (simd-vnot) ] [ call-next-method ] v->v-op  ; inline
 M: simd-128 vlshift
-    over simd-rep [ (simd-vlshift)           ] [ call-next-method ] vn->v-op ; inline
+    over simd-rep [ (simd-vlshift) ] [ call-next-method ] vn->v-op ; inline
 M: simd-128 vrshift
-    over simd-rep [ (simd-vrshift)           ] [ call-next-method ] vn->v-op ; inline
+    over simd-rep [ (simd-vrshift) ] [ call-next-method ] vn->v-op ; inline
 M: simd-128 hlshift
-    over simd-rep [ (simd-hlshift)           ] [ call-next-method ] vn->v-op ; inline
+    over simd-rep [ (simd-hlshift) ] [ call-next-method ] vn->v-op ; inline
 M: simd-128 hrshift
-    over simd-rep [ (simd-hrshift)           ] [ call-next-method ] vn->v-op ; inline
+    over simd-rep [ (simd-hrshift) ] [ call-next-method ] vn->v-op ; inline
 M: simd-128 vshuffle-elements
     over simd-rep [ (simd-vshuffle-elements) ] [ call-next-method ] vx->v-op ; inline
 M: simd-128 vshuffle2-elements
     over simd-rep [ (simd-vshuffle2-elements) ] [ call-next-method ] vvx->v-op ; inline
 M: simd-128 vshuffle-bytes
-    dup simd-rep [ (simd-vshuffle-bytes)    ] [ call-next-method ] vv'->v-op ; inline
+    dup simd-rep [ (simd-vshuffle-bytes) ] [ call-next-method ] vv'->v-op ; inline
 M: simd-128 (vmerge-head)
-    dup simd-rep [ (simd-vmerge-head)       ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-vmerge-head) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 (vmerge-tail)
-    dup simd-rep [ (simd-vmerge-tail)       ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-vmerge-tail) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 v<=
-    dup simd-rep [ (simd-v<=)               ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-v<=) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 v<
-    dup simd-rep [ (simd-v<)                ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-v<) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 v=
-    dup simd-rep [ (simd-v=)                ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-v=) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 v>
-    dup simd-rep [ (simd-v>)                ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-v>) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 v>=
-    dup simd-rep [ (simd-v>=)               ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-v>=) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 vunordered?
-    dup simd-rep [ (simd-vunordered?)       ] [ call-next-method ] vv->v-op ; inline
+    dup simd-rep [ (simd-vunordered?) ] [ call-next-method ] vv->v-op ; inline
 M: simd-128 vany?
-    dup simd-rep [ (simd-vany?)             ] [ call-next-method ] v->x-op  ; inline
+    dup simd-rep [ (simd-vany?) ] [ call-next-method ] v->x-op  ; inline
 M: simd-128 vall?
-    dup simd-rep [ (simd-vall?)             ] [ call-next-method ] v->x-op  ; inline
+    dup simd-rep [ (simd-vall?) ] [ call-next-method ] v->x-op  ; inline
 M: simd-128 vnone?
-    dup simd-rep [ (simd-vnone?)            ] [ call-next-method ] v->x-op  ; inline
+    dup simd-rep [ (simd-vnone?) ] [ call-next-method ] v->x-op  ; inline
+M: simd-128 vcount
+    dup simd-rep
+    [ [ (simd-vgetmask) assert-positive ] [ call-next-method ] v->x-op ]
+    [ mask>count ] bi ; inline
 
 ! SIMD high-level specializations
 
@@ -235,7 +252,7 @@ M: simd-128 v+n over simd-with v+ ; inline
 M: simd-128 v-n over simd-with v- ; inline
 M: simd-128 v*n over simd-with v* ; inline
 M: simd-128 v/n over simd-with v/ ; inline
-M: simd-128 norm-sq dup v. assert-positive ; inline
+M: simd-128 norm-sq dup vdot assert-positive ; inline
 M: simd-128 distance v- norm ; inline
 
 M: simd-128 >pprint-sequence ;
@@ -245,7 +262,7 @@ M: simd-128 pprint* pprint-object ;
 
 ! SIMD concrete type functor
 
-FUNCTOR: define-simd-128 ( T -- )
+<FUNCTOR: define-simd-128 ( T -- )
 
 A      DEFINES-CLASS ${T}
 A-rep  IS            ${T}-rep
@@ -311,7 +328,7 @@ c:<c-type>
     A-rep >>rep
 \ A c:typedef
 
-;FUNCTOR
+;FUNCTOR>
 
 SYNTAX: SIMD-128:
     scan-token define-simd-128 ;
@@ -335,7 +352,7 @@ SIMD-128: double-2
 
 ! misc
 
-M: simd-128 vshuffle ( u perm -- v )
+M: simd-128 vshuffle
     vshuffle-bytes ; inline
 
 M: uchar-16 v*hs+