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

db4
Joe Groff 2009-12-05 11:32:31 -08:00
parent 9f79cb0002
commit 1845915dc6
4 changed files with 36 additions and 0 deletions

View File

@ -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 ;

View File

@ -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

View File

@ -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

View File

@ -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' )