diff --git a/basis/math/vectors/simd/intrinsics/intrinsics.factor b/basis/math/vectors/simd/intrinsics/intrinsics.factor index eb0e7b1dc8..5e6c74812e 100644 --- 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 :> a' + b rep >rep-array 2 :> b' + a' b' [ + [ [ first ] bi@ * ] + [ [ second ] bi@ * ] 2bi + + wide-type c-type-clamp + ] wide-rep 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 b7b244de12..39baa284c6 100644 --- 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 15b034a694..3b8dac2f1c 100644 --- 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 ) + + [ first2 + ] map ; +: (h-) ( u -- w ) 2 [ 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 ; +