steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

math.vectors.simd.intrinsics: the syntax for declaring simd intrinsics 

isn't needed so it can be removed afaict
db4
Björn Lindqvist 2016-03-11 07:11:47 +01:00
parent 2f1e963587
commit a0dba498aa
1 changed files with 65 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

146
basis/math/vectors/simd/intrinsics/intrinsics.factor
View File

@ -1,11 +1,9 @@
! (c)2009 Slava Pestov, Joe Groff bsd license ! (c)2009 Slava Pestov, Joe Groff bsd license
USING: accessors alien alien.data combinators USING: accessors alien alien.data combinators cpu.architecture fry
sequences.cords cpu.architecture fry generalizations grouping grouping kernel libc locals math math.libm math.order math.ranges
kernel libc locals macros math math.libm math.order sequences sequences.cords sequences.generalizations sequences.private
math.ranges math.vectors sequences sequences.generalizations sequences.unrolled sequences.unrolled.private specialized-arrays
sequences.private sequences.unrolled sequences.unrolled.private vocabs ;
specialized-arrays vocabs words effects.parser locals.parser
math.bitwise ;
QUALIFIED-WITH: alien.c-types c QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAYS: SPECIALIZED-ARRAYS:
c:char c:short c:int c:longlong c:char c:short c:int c:longlong
@ -13,20 +11,6 @@ SPECIALIZED-ARRAYS:
c:float c:double ; c:float c:double ;
IN: math.vectors.simd.intrinsics IN: math.vectors.simd.intrinsics
<<
: simd-intrinsic-body ( def effect -- def' )
'[ _ _ call-effect ] ;
: define-simd-intrinsic ( word def effect -- )
[ simd-intrinsic-body ] keep define-declared ;
SYNTAX: SIMD-INTRINSIC:
(:) define-declared ;
SYNTAX: SIMD-INTRINSIC::
(::) define-declared ;
>>
: assert-positive ( x -- y ) ; : assert-positive ( x -- y ) ;
<PRIVATE <PRIVATE
@ -157,10 +141,10 @@ M: float native/ /f ; inline
PRIVATE> PRIVATE>
SIMD-INTRINSIC: (simd-v+) ( a b rep -- c ) [ + ] components-2map ; : (simd-v+) ( a b rep -- c ) [ + ] components-2map ;
SIMD-INTRINSIC: (simd-v-) ( a b rep -- c ) [ - ] components-2map ; : (simd-v-) ( a b rep -- c ) [ - ] components-2map ;
SIMD-INTRINSIC: (simd-vneg) ( a rep -- c ) [ neg ] components-map ; : (simd-vneg) ( a rep -- c ) [ neg ] components-map ;
SIMD-INTRINSIC:: (simd-v+-) ( a b rep -- c ) :: (simd-v+-) ( a b rep -- c )
a b rep 2byte>rep-array :> ( a' b' ) a b rep 2byte>rep-array :> ( a' b' )
rep <rep-array> :> c' rep <rep-array> :> c'
0 rep rep-length [ 1 - 2 <range> ] [ 2 /i ] bi [| n | 0 rep rep-length [ 1 - 2 <range> ] [ 2 /i ] bi [| n |
@ -171,16 +155,16 @@ SIMD-INTRINSIC:: (simd-v+-) ( a b rep -- c )
n 1 + c' set-nth-unsafe n 1 + c' set-nth-unsafe
] unrolled-each-unsafe ] unrolled-each-unsafe
c' underlying>> ; c' underlying>> ;
SIMD-INTRINSIC: (simd-vs+) ( a b rep -- c ) : (simd-vs+) ( a b rep -- c )
dup rep-component-type '[ + _ c:c-type-clamp ] components-2map ; dup rep-component-type '[ + _ c:c-type-clamp ] components-2map ;
SIMD-INTRINSIC: (simd-vs-) ( a b rep -- c ) : (simd-vs-) ( a b rep -- c )
dup rep-component-type '[ - _ c:c-type-clamp ] components-2map ; dup rep-component-type '[ - _ c:c-type-clamp ] components-2map ;
SIMD-INTRINSIC: (simd-vs*) ( a b rep -- c ) : (simd-vs*) ( a b rep -- c )
dup rep-component-type '[ * _ c:c-type-clamp ] components-2map ; dup rep-component-type '[ * _ c:c-type-clamp ] components-2map ;
SIMD-INTRINSIC: (simd-v*) ( a b rep -- c ) [ * ] components-2map ; : (simd-v*) ( a b rep -- c ) [ * ] components-2map ;
SIMD-INTRINSIC: (simd-v*high) ( a b rep -- c ) : (simd-v*high) ( a b rep -- c )
dup rep-component-type c:heap-size -8 * '[ * _ shift ] components-2map ; dup rep-component-type c:heap-size -8 * '[ * _ shift ] components-2map ;
SIMD-INTRINSIC:: (simd-v*hs+) ( a b rep -- c ) :: (simd-v*hs+) ( a b rep -- c )
rep { char-16-rep uchar-16-rep } member-eq? rep { char-16-rep uchar-16-rep } member-eq?
[ uchar-16-rep char-16-rep ] [ uchar-16-rep char-16-rep ]
[ rep rep ] if :> ( a-rep b-rep ) [ rep rep ] if :> ( a-rep b-rep )
@ -193,41 +177,41 @@ SIMD-INTRINSIC:: (simd-v*hs+) ( a b rep -- c )
[ [ second ] bi@ * ] 2bi + [ [ second ] bi@ * ] 2bi +
wide-type c:c-type-clamp wide-type c:c-type-clamp
] wide-rep <rep-array> unrolled-2map-as-unsafe underlying>> ; ] wide-rep <rep-array> unrolled-2map-as-unsafe underlying>> ;
SIMD-INTRINSIC: (simd-v/) ( a b rep -- c ) [ native/ ] components-2map ; : (simd-v/) ( a b rep -- c ) [ native/ ] components-2map ;
SIMD-INTRINSIC: (simd-vavg) ( a b rep -- c ) : (simd-vavg) ( a b rep -- c )
[ + dup integer? [ 1 + -1 shift ] [ 0.5 * ] if ] components-2map ; [ + dup integer? [ 1 + -1 shift ] [ 0.5 * ] if ] components-2map ;
SIMD-INTRINSIC: (simd-vmin) ( a b rep -- c ) [ min ] components-2map ; : (simd-vmin) ( a b rep -- c ) [ min ] components-2map ;
SIMD-INTRINSIC: (simd-vmax) ( a b rep -- c ) [ max ] components-2map ; : (simd-vmax) ( a b rep -- c ) [ max ] components-2map ;
! XXX ! XXX
SIMD-INTRINSIC: (simd-v.) ( a b rep -- n ) : (simd-v.) ( a b rep -- n )
[ 2byte>rep-array [ [ first ] bi@ * ] 2keep ] keep [ 2byte>rep-array [ [ first ] bi@ * ] 2keep ] keep
1 swap rep-length [a,b) [ '[ _ swap nth-unsafe ] bi@ * + ] 2with each ; 1 swap rep-length [a,b) [ '[ _ swap nth-unsafe ] bi@ * + ] 2with each ;
SIMD-INTRINSIC: (simd-vsqrt) ( a rep -- c ) [ fsqrt ] components-map ; : (simd-vsqrt) ( a rep -- c ) [ fsqrt ] components-map ;
SIMD-INTRINSIC: (simd-vsad) ( a b rep -- c ) 2byte>rep-array [ - abs ] [ + ] 2map-reduce ; : (simd-vsad) ( a b rep -- c ) 2byte>rep-array [ - abs ] [ + ] 2map-reduce ;
SIMD-INTRINSIC: (simd-sum) ( a rep -- n ) [ + ] components-reduce ; : (simd-sum) ( a rep -- n ) [ + ] components-reduce ;
SIMD-INTRINSIC: (simd-vabs) ( a rep -- c ) [ abs ] components-map ; : (simd-vabs) ( a rep -- c ) [ abs ] components-map ;
SIMD-INTRINSIC: (simd-vbitand) ( a b rep -- c ) [ bitand ] bitwise-components-2map ; : (simd-vbitand) ( a b rep -- c ) [ bitand ] bitwise-components-2map ;
SIMD-INTRINSIC: (simd-vbitandn) ( a b rep -- c ) [ [ bitnot ] dip bitand ] bitwise-components-2map ; : (simd-vbitandn) ( a b rep -- c ) [ [ bitnot ] dip bitand ] bitwise-components-2map ;
SIMD-INTRINSIC: (simd-vbitor) ( a b rep -- c ) [ bitor ] bitwise-components-2map ; : (simd-vbitor) ( a b rep -- c ) [ bitor ] bitwise-components-2map ;
SIMD-INTRINSIC: (simd-vbitxor) ( a b rep -- c ) [ bitxor ] bitwise-components-2map ; : (simd-vbitxor) ( a b rep -- c ) [ bitxor ] bitwise-components-2map ;
SIMD-INTRINSIC: (simd-vbitnot) ( a rep -- c ) [ bitnot ] bitwise-components-map ; : (simd-vbitnot) ( a rep -- c ) [ bitnot ] bitwise-components-map ;
SIMD-INTRINSIC: (simd-vand) ( a b rep -- c ) [ bitand ] bitwise-components-2map ; : (simd-vand) ( a b rep -- c ) [ bitand ] bitwise-components-2map ;
SIMD-INTRINSIC: (simd-vandn) ( a b rep -- c ) [ [ bitnot ] dip bitand ] bitwise-components-2map ; : (simd-vandn) ( a b rep -- c ) [ [ bitnot ] dip bitand ] bitwise-components-2map ;
SIMD-INTRINSIC: (simd-vor) ( a b rep -- c ) [ bitor ] bitwise-components-2map ; : (simd-vor) ( a b rep -- c ) [ bitor ] bitwise-components-2map ;
SIMD-INTRINSIC: (simd-vxor) ( a b rep -- c ) [ bitxor ] bitwise-components-2map ; : (simd-vxor) ( a b rep -- c ) [ bitxor ] bitwise-components-2map ;
SIMD-INTRINSIC: (simd-vnot) ( a rep -- c ) [ bitnot ] bitwise-components-map ; : (simd-vnot) ( a rep -- c ) [ bitnot ] bitwise-components-map ;
SIMD-INTRINSIC: (simd-vlshift) ( a n rep -- c ) swap '[ _ shift ] bitwise-components-map ; : (simd-vlshift) ( a n rep -- c ) swap '[ _ shift ] bitwise-components-map ;
SIMD-INTRINSIC: (simd-vrshift) ( a n rep -- c ) swap '[ _ neg shift ] bitwise-components-map ; : (simd-vrshift) ( a n rep -- c ) swap '[ _ neg shift ] bitwise-components-map ;
! XXX ! XXX
SIMD-INTRINSIC: (simd-hlshift) ( a n rep -- c ) : (simd-hlshift) ( a n rep -- c )
drop head-slice* 16 0 pad-head ; drop head-slice* 16 0 pad-head ;
! XXX ! XXX
SIMD-INTRINSIC: (simd-hrshift) ( a n rep -- c ) : (simd-hrshift) ( a n rep -- c )
drop tail-slice 16 0 pad-tail ; drop tail-slice 16 0 pad-tail ;
SIMD-INTRINSIC: (simd-vshuffle-elements) ( a n rep -- c ) [ rep-length 0 pad-tail ] keep (vshuffle) ; : (simd-vshuffle-elements) ( a n rep -- c ) [ rep-length 0 pad-tail ] keep (vshuffle) ;
SIMD-INTRINSIC: (simd-vshuffle2-elements) ( a b n rep -- c ) [ rep-length 0 pad-tail ] keep (vshuffle2) ; : (simd-vshuffle2-elements) ( a b n rep -- c ) [ rep-length 0 pad-tail ] keep (vshuffle2) ;
SIMD-INTRINSIC: (simd-vshuffle-bytes) ( a b rep -- c ) drop uchar-16-rep (vshuffle) ; : (simd-vshuffle-bytes) ( a b rep -- c ) drop uchar-16-rep (vshuffle) ;
SIMD-INTRINSIC:: (simd-vmerge-head) ( a b rep -- c ) :: (simd-vmerge-head) ( a b rep -- c )
a b rep 2byte>rep-array :> ( a' b' ) a b rep 2byte>rep-array :> ( a' b' )
rep <rep-array> :> c' rep <rep-array> :> c'
rep rep-length 2 /i [| n | rep rep-length 2 /i [| n |
@ -235,7 +219,7 @@ SIMD-INTRINSIC:: (simd-vmerge-head) ( a b rep -- c )
n b' nth-unsafe n 2 * 1 + c' set-nth-unsafe n b' nth-unsafe n 2 * 1 + c' set-nth-unsafe
] unrolled-each-integer ] unrolled-each-integer
c' underlying>> ; c' underlying>> ;
SIMD-INTRINSIC:: (simd-vmerge-tail) ( a b rep -- c ) :: (simd-vmerge-tail) ( a b rep -- c )
a b rep 2byte>rep-array :> ( a' b' ) a b rep 2byte>rep-array :> ( a' b' )
rep <rep-array> :> c' rep <rep-array> :> c'
rep rep-length 2 /i :> len rep rep-length 2 /i :> len
@ -244,54 +228,54 @@ SIMD-INTRINSIC:: (simd-vmerge-tail) ( a b rep -- c )
n len + b' nth-unsafe n 2 * 1 + c' set-nth-unsafe n len + b' nth-unsafe n 2 * 1 + c' set-nth-unsafe
] unrolled-each-integer ] unrolled-each-integer
c' underlying>> ; c' underlying>> ;
SIMD-INTRINSIC: (simd-v<=) ( a b rep -- c ) : (simd-v<=) ( a b rep -- c )
dup rep-tf-values '[ <= _ _ ? ] components-2map ; dup rep-tf-values '[ <= _ _ ? ] components-2map ;
SIMD-INTRINSIC: (simd-v<) ( a b rep -- c ) : (simd-v<) ( a b rep -- c )
dup rep-tf-values '[ < _ _ ? ] components-2map ; dup rep-tf-values '[ < _ _ ? ] components-2map ;
SIMD-INTRINSIC: (simd-v=) ( a b rep -- c ) : (simd-v=) ( a b rep -- c )
dup rep-tf-values '[ = _ _ ? ] components-2map ; dup rep-tf-values '[ = _ _ ? ] components-2map ;
SIMD-INTRINSIC: (simd-v>) ( a b rep -- c ) : (simd-v>) ( a b rep -- c )
dup rep-tf-values '[ > _ _ ? ] components-2map ; dup rep-tf-values '[ > _ _ ? ] components-2map ;
SIMD-INTRINSIC: (simd-v>=) ( a b rep -- c ) : (simd-v>=) ( a b rep -- c )
dup rep-tf-values '[ >= _ _ ? ] components-2map ; dup rep-tf-values '[ >= _ _ ? ] components-2map ;
SIMD-INTRINSIC: (simd-vunordered?) ( a b rep -- c ) : (simd-vunordered?) ( a b rep -- c )
dup rep-tf-values '[ unordered? _ _ ? ] components-2map ; dup rep-tf-values '[ unordered? _ _ ? ] components-2map ;
SIMD-INTRINSIC: (simd-vany?) ( a rep -- ? ) [ bitor ] bitwise-components-reduce zero? not ; : (simd-vany?) ( a rep -- ? ) [ bitor ] bitwise-components-reduce zero? not ;
SIMD-INTRINSIC: (simd-vall?) ( a rep -- ? ) [ bitand ] bitwise-components-reduce zero? not ; : (simd-vall?) ( a rep -- ? ) [ bitand ] bitwise-components-reduce zero? not ;
SIMD-INTRINSIC: (simd-vnone?) ( a rep -- ? ) [ bitor ] bitwise-components-reduce zero? ; : (simd-vnone?) ( a rep -- ? ) [ bitor ] bitwise-components-reduce zero? ;
SIMD-INTRINSIC: (simd-vgetmask) ( a rep -- n ) : (simd-vgetmask) ( a rep -- n )
{ float-4-rep double-2-rep } member? { float-4-rep double-2-rep } member?
[ uint-4-rep ((vgetmask)) ] [ uchar-16-rep ((vgetmask)) ] if ; [ uint-4-rep ((vgetmask)) ] [ uchar-16-rep ((vgetmask)) ] if ;
SIMD-INTRINSIC: (simd-v>float) ( a rep -- c ) : (simd-v>float) ( a rep -- c )
[ [ byte>rep-array ] [ rep-length ] bi [ >float ] ] [ [ byte>rep-array ] [ rep-length ] bi [ >float ] ]
[ >float-vector-rep <rep-array> ] bi unrolled-map-as-unsafe underlying>> ; [ >float-vector-rep <rep-array> ] bi unrolled-map-as-unsafe underlying>> ;
SIMD-INTRINSIC: (simd-v>integer) ( a rep -- c ) : (simd-v>integer) ( a rep -- c )
[ [ byte>rep-array ] [ rep-length ] bi [ >integer ] ] [ [ byte>rep-array ] [ rep-length ] bi [ >integer ] ]
[ >int-vector-rep <rep-array> ] bi unrolled-map-as-unsafe underlying>> ; [ >int-vector-rep <rep-array> ] bi unrolled-map-as-unsafe underlying>> ;
SIMD-INTRINSIC: (simd-vpack-signed) ( a b rep -- c ) : (simd-vpack-signed) ( a b rep -- c )
[ [ 2byte>rep-array cord-append ] [ rep-length 2 * ] bi ] [ [ 2byte>rep-array cord-append ] [ rep-length 2 * ] bi ]
[ narrow-vector-rep [ <rep-array> ] [ rep-component-type ] bi ] bi [ narrow-vector-rep [ <rep-array> ] [ rep-component-type ] bi ] bi
'[ _ c:c-type-clamp ] swap unrolled-map-as-unsafe underlying>> ; '[ _ c:c-type-clamp ] swap unrolled-map-as-unsafe underlying>> ;
SIMD-INTRINSIC: (simd-vpack-unsigned) ( a b rep -- c ) : (simd-vpack-unsigned) ( a b rep -- c )
[ [ 2byte>rep-array cord-append ] [ rep-length 2 * ] bi ] [ [ 2byte>rep-array cord-append ] [ rep-length 2 * ] bi ]
[ narrow-vector-rep >uint-vector-rep [ <rep-array> ] [ rep-component-type ] bi ] bi [ narrow-vector-rep >uint-vector-rep [ <rep-array> ] [ rep-component-type ] bi ] bi
'[ _ c:c-type-clamp ] swap unrolled-map-as-unsafe underlying>> ; '[ _ c:c-type-clamp ] swap unrolled-map-as-unsafe underlying>> ;
SIMD-INTRINSIC: (simd-vunpack-head) ( a rep -- c ) : (simd-vunpack-head) ( a rep -- c )
[ byte>rep-array ] [ widen-vector-rep [ rep-length ] [ '[ _ >rep-array ] ] bi ] bi [ byte>rep-array ] [ widen-vector-rep [ rep-length ] [ '[ _ >rep-array ] ] bi ] bi
[ head-slice ] dip call( a' -- c' ) underlying>> ; [ head-slice ] dip call( a' -- c' ) underlying>> ;
SIMD-INTRINSIC: (simd-vunpack-tail) ( a rep -- c ) : (simd-vunpack-tail) ( a rep -- c )
[ byte>rep-array ] [ widen-vector-rep [ rep-length ] [ '[ _ >rep-array ] ] bi ] bi [ byte>rep-array ] [ widen-vector-rep [ rep-length ] [ '[ _ >rep-array ] ] bi ] bi
[ tail-slice ] dip call( a' -- c' ) underlying>> ; [ tail-slice ] dip call( a' -- c' ) underlying>> ;
SIMD-INTRINSIC: (simd-with) ( n rep -- v ) : (simd-with) ( n rep -- v )
[ rep-length swap '[ _ ] ] [ <rep-array> ] bi replicate-as [ rep-length swap '[ _ ] ] [ <rep-array> ] bi replicate-as
underlying>> ; underlying>> ;
SIMD-INTRINSIC: (simd-gather-2) ( m n rep -- v ) <rep-array> [ 2 set-firstn-unsafe ] keep underlying>> ; : (simd-gather-2) ( m n rep -- v ) <rep-array> [ 2 set-firstn-unsafe ] keep underlying>> ;
SIMD-INTRINSIC: (simd-gather-4) ( m n o p rep -- v ) <rep-array> [ 4 set-firstn-unsafe ] keep underlying>> ; : (simd-gather-4) ( m n o p rep -- v ) <rep-array> [ 4 set-firstn-unsafe ] keep underlying>> ;
SIMD-INTRINSIC: (simd-select) ( a n rep -- x ) swapd byte>rep-array nth-unsafe ; : (simd-select) ( a n rep -- x ) swapd byte>rep-array nth-unsafe ;
SIMD-INTRINSIC: alien-vector ( c-ptr n rep -- value ) : alien-vector ( c-ptr n rep -- value )
[ swap <displaced-alien> ] dip rep-size memory>byte-array ; [ swap <displaced-alien> ] dip rep-size memory>byte-array ;
SIMD-INTRINSIC: set-alien-vector ( value c-ptr n rep -- ) : set-alien-vector ( value c-ptr n rep -- )
[ swap <displaced-alien> swap ] dip rep-size memcpy ; [ swap <displaced-alien> swap ] dip rep-size memcpy ;
"compiler.cfg.intrinsics.simd" require "compiler.cfg.intrinsics.simd" require