add v*high, v*hs+, vavg, and vsad operations to math.vectors
parent
9f79cb0002
commit
1845915dc6
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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' )
|
||||
|
|
Loading…
Reference in New Issue