add v*high, v*hs+, vavg, and vsad operations to math.vectors

diff --git a/basis/math/vectors/simd/intrinsics/intrinsics.factor b/basis/math/vectors/simd/intrinsics/intrinsics.factor
index eb0e7b1dc8f21228b108d931eeea8b2bb87d733a..5e6c74812ec7b21060150f45d23374b3e81cc4c9 100644 (file)
--- a/basis/math/vectors/simd/intrinsics/intrinsics.factor
+++ b/basis/math/vectors/simd/intrinsics/intrinsics.factor
@@ -141,13 +141,27 @@ PRIVATE>
 : (simd-vs*)               ( a b rep -- c )
     dup rep-component-type '[ * _ c-type-clamp ] components-2map ;
 : (simd-v*)                ( a b rep -- c ) [ * ] components-2map ;
+: (simd-v*high)            ( a b rep -- c )
+    dup rep-component-type heap-size -8 * '[ * _ shift ] components-2map ;
+:: (simd-v*hs+)            ( a b rep -- c )
+    rep widen-vector-rep signed-rep :> wide-rep
+    wide-rep rep-component-type :> wide-type
+    a rep >rep-array 2 <groups> :> a'
+    b rep >rep-array 2 <groups> :> b'
+    a' b' [
+        [ [ first  ] bi@ * ]
+        [ [ second ] bi@ * ] 2bi +
+        wide-type c-type-clamp
+    ] wide-rep <rep-array> 2map-as ;
 : (simd-v/)                ( a b rep -- c ) [ / ] components-2map ;
+: (simd-vavg)              ( a b rep -- c ) [ + 2 / ] components-2map ;
 : (simd-vmin)              ( a b rep -- c ) [ min ] components-2map ;
 : (simd-vmax)              ( a b rep -- c ) [ max ] components-2map ;
 : (simd-v.)                ( a b rep -- n )
     [ 2>rep-array [ [ first ] bi@ * ] 2keep ] keep
     1 swap rep-length [a,b) [ '[ _ swap nth-unsafe ] bi@ * + ] with with each ;
 : (simd-vsqrt)             ( a   rep -- c ) [ fsqrt ] components-map ;
+: (simd-vsad)              ( a b rep -- n ) 2>rep-array [ - abs ] [ + ] 2map-reduce ;
 : (simd-sum)               ( a   rep -- n ) [ + ] components-reduce ;
 : (simd-vabs)              ( a   rep -- c ) [ abs ] components-map ;
 : (simd-vbitand)           ( a b rep -- c ) [ bitand ] bitwise-components-2map ;

diff --git a/basis/math/vectors/simd/simd.factor b/basis/math/vectors/simd/simd.factor
index b7b244de124ce4f765a3c522edbacb674a3755ab..39baa284c67c5df6c548f068cf1b5e6626f912e0 100644 (file)
--- a/basis/math/vectors/simd/simd.factor
+++ b/basis/math/vectors/simd/simd.factor
@@ -167,10 +167,14 @@ M: A vs+               \ A-rep [ (simd-vs+)               ] [ call-next-method ]
 M: A vs-               \ A-rep [ (simd-vs-)               ] [ call-next-method ] vv->v-op ; inline
 M: A vs*               \ A-rep [ (simd-vs*)               ] [ call-next-method ] vv->v-op ; inline
 M: A v*                \ A-rep [ (simd-v*)                ] [ call-next-method ] vv->v-op ; inline
+M: A v*high            \ A-rep [ (simd-v*high)            ] [ call-next-method ] vv->v-op ; inline
+M: A v*hs+             \ A-rep [ (simd-v*hs+)             ] [ call-next-method ] vv->v-op ; inline
 M: A v/                \ A-rep [ (simd-v/)                ] [ call-next-method ] vv->v-op ; inline
+M: A vavg              \ A-rep [ (simd-vavg)              ] [ call-next-method ] vv->v-op ; inline
 M: A vmin              \ A-rep [ (simd-vmin)              ] [ call-next-method ] vv->v-op ; inline
 M: A vmax              \ A-rep [ (simd-vmax)              ] [ call-next-method ] vv->v-op ; inline
 M: A v.                \ A-rep [ (simd-v.)                ] [ call-next-method ] vv->n-op ; inline
+M: A vsad              \ A-rep [ (simd-vsad)              ] [ call-next-method ] vv->n-op ; inline
 M: A vsqrt             \ A-rep [ (simd-vsqrt)             ] [ call-next-method ] v->v-op  ; inline
 M: A sum               \ A-rep [ (simd-sum)               ] [ call-next-method ] v->n-op  ; inline
 M: A vabs              \ A-rep [ (simd-vabs)              ] [ call-next-method ] v->v-op  ; inline

diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor
index 15b034a694bcf3e98426b5cf820f553627a71a05..3b8dac2f1c79e72148aa437b230bf26b132226e4 100644 (file)
--- a/basis/math/vectors/vectors.factor
+++ b/basis/math/vectors/vectors.factor
@@ -45,6 +45,16 @@ M: object [v-] [ [-] ] 2map ;
 GENERIC: v* ( u v -- w )
 M: object v* [ * ] 2map ;
 
+GENERIC: v*high ( u v -- w )
+
+<PRIVATE
+: (h+) ( u -- w ) 2 <groups> [ first2 + ] map ;
+: (h-) ( u -- w ) 2 <groups> [ first2 - ] map ;
+PRIVATE>
+
+GENERIC: v*hs+ ( u v -- w )
+M: object v*hs+ [ * ] 2map (h+) ;
+
 GENERIC: v/ ( u v -- w )
 M: object v/ [ / ] 2map ;
 
@@ -55,6 +65,9 @@ M: object v/ [ / ] 2map ;
 
 PRIVATE>
 
+GENERIC: vavg ( u v -- w )
+M: object vavg [ + 2 / ] 2map ;
+
 GENERIC: vmax ( u v -- w )
 M: object vmax [ [ float-max ] [ max ] if-both-floats ] 2map ;
 
@@ -82,6 +95,9 @@ M: object vabs [ abs ] map ;
 GENERIC: vsqrt ( u -- v )
 M: object vsqrt [ >float fsqrt ] map ;
 
+GENERIC: vsad ( u v -- n )
+M: object vsad [ - abs ] [ + ] 2map-reduce ;
+
 <PRIVATE
 
 : bitandn ( x y -- z ) [ bitnot ] dip bitand ; inline

diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor
index 179cbe3cdc71491f05fa34c513f450c9a0fb8468..40d5d4c6a3733084f078befced7517b9b4f804a7 100644 (file)
--- a/basis/specialized-arrays/specialized-arrays.factor
+++ b/basis/specialized-arrays/specialized-arrays.factor
@@ -108,6 +108,8 @@ M: A vs+ [ + \ T c-type-clamp ] 2map ;
 M: A vs- [ - \ T c-type-clamp ] 2map ;
 M: A vs* [ * \ T c-type-clamp ] 2map ;
 
+M: A v*high [ * \ T heap-size neg shift ] 2map ;
+
 ;FUNCTOR
 
 GENERIC: (underlying-type) ( c-type -- c-type' )