-USING: accessors alien.c-types arrays byte-arrays classes combinators
-cpu.architecture effects fry functors generalizations generic
-generic.parser kernel lexer literals macros math math.functions
-math.vectors math.vectors.private namespaces parser
-prettyprint.custom quotations sequences sequences.private vocabs
+USING: accessors alien arrays byte-arrays classes combinators
+cpu.architecture effects functors generalizations kernel lexer
+literals math math.bitwise math.vectors
+math.vectors.simd.intrinsics parser prettyprint.custom
+quotations sequences sequences.generalizations sequences.private
vocabs.loader words ;
QUALIFIED-WITH: alien.c-types c
IN: math.vectors.simd
-DEFER: vconvert
-DEFER: simd-with
-DEFER: simd-boa
-DEFER: simd-cast
-
-ERROR: bad-simd-call word ;
ERROR: bad-simd-length got expected ;
+ERROR: bad-simd-vector obj ;
<<
<PRIVATE
<PRIVATE
-! SIMD intrinsics
-
-: (simd-v+) ( a b rep -- c ) \ v+ bad-simd-call ;
-: (simd-v-) ( a b rep -- c ) \ v- bad-simd-call ;
-: (simd-vneg) ( a rep -- c ) \ vneg bad-simd-call ;
-: (simd-v+-) ( a b rep -- c ) \ v+- bad-simd-call ;
-: (simd-vs+) ( a b rep -- c ) \ vs+ bad-simd-call ;
-: (simd-vs-) ( a b rep -- c ) \ vs- bad-simd-call ;
-: (simd-vs*) ( a b rep -- c ) \ vs* bad-simd-call ;
-: (simd-v*) ( a b rep -- c ) \ v* bad-simd-call ;
-: (simd-v/) ( a b rep -- c ) \ v/ bad-simd-call ;
-: (simd-vmin) ( a b rep -- c ) \ vmin bad-simd-call ;
-: (simd-vmax) ( a b rep -- c ) \ vmax bad-simd-call ;
-: (simd-v.) ( a b rep -- n ) \ v. bad-simd-call ;
-: (simd-vsqrt) ( a rep -- c ) \ vsqrt bad-simd-call ;
-: (simd-sum) ( a rep -- n ) \ sum bad-simd-call ;
-: (simd-vabs) ( a rep -- c ) \ vabs bad-simd-call ;
-: (simd-vbitand) ( a b rep -- c ) \ vbitand bad-simd-call ;
-: (simd-vbitandn) ( a b rep -- c ) \ vbitandn bad-simd-call ;
-: (simd-vbitor) ( a b rep -- c ) \ vbitor bad-simd-call ;
-: (simd-vbitxor) ( a b rep -- c ) \ vbitxor bad-simd-call ;
-: (simd-vbitnot) ( a rep -- c ) \ vbitnot bad-simd-call ;
-: (simd-vand) ( a b rep -- c ) \ vand bad-simd-call ;
-: (simd-vandn) ( a b rep -- c ) \ vandn bad-simd-call ;
-: (simd-vor) ( a b rep -- c ) \ vor bad-simd-call ;
-: (simd-vxor) ( a b rep -- c ) \ vxor bad-simd-call ;
-: (simd-vnot) ( a rep -- c ) \ vnot bad-simd-call ;
-: (simd-vlshift) ( a n rep -- c ) \ vlshift bad-simd-call ;
-: (simd-vrshift) ( a n rep -- c ) \ vrshift bad-simd-call ;
-: (simd-hlshift) ( a n rep -- c ) \ hlshift bad-simd-call ;
-: (simd-hrshift) ( a n rep -- c ) \ hrshift bad-simd-call ;
-: (simd-vshuffle-elements) ( a n rep -- c ) \ vshuffle-elements bad-simd-call ;
-: (simd-vshuffle-bytes) ( a b rep -- c ) \ vshuffle-bytes bad-simd-call ;
-: (simd-vmerge-head) ( a b rep -- c ) \ (vmerge-head) bad-simd-call ;
-: (simd-vmerge-tail) ( a b rep -- c ) \ (vmerge-tail) bad-simd-call ;
-: (simd-v<=) ( a b rep -- c ) \ v<= bad-simd-call ;
-: (simd-v<) ( a b rep -- c ) \ v< bad-simd-call ;
-: (simd-v=) ( a b rep -- c ) \ v= bad-simd-call ;
-: (simd-v>) ( a b rep -- c ) \ v> bad-simd-call ;
-: (simd-v>=) ( a b rep -- c ) \ v>= bad-simd-call ;
-: (simd-vunordered?) ( a b rep -- c ) \ vunordered? bad-simd-call ;
-: (simd-vany?) ( a rep -- ? ) \ vany? bad-simd-call ;
-: (simd-vall?) ( a rep -- ? ) \ vall? bad-simd-call ;
-: (simd-vnone?) ( a rep -- ? ) \ vnone? bad-simd-call ;
-: (simd-v>float) ( a rep -- c ) \ vconvert bad-simd-call ;
-: (simd-v>integer) ( a rep -- c ) \ vconvert bad-simd-call ;
-: (simd-vpack-signed) ( a b rep -- c ) \ vconvert bad-simd-call ;
-: (simd-vpack-unsigned) ( a b rep -- c ) \ vconvert bad-simd-call ;
-: (simd-vunpack-head) ( a rep -- c ) \ vconvert bad-simd-call ;
-: (simd-vunpack-tail) ( a rep -- c ) \ vconvert bad-simd-call ;
-: (simd-with) ( n rep -- v ) \ simd-with bad-simd-call ;
-: (simd-gather-2) ( m n rep -- v ) \ simd-boa bad-simd-call ;
-: (simd-gather-4) ( m n o p rep -- v ) \ simd-boa bad-simd-call ;
-: (simd-select) ( a n rep -- n ) \ nth bad-simd-call ;
-
-PRIVATE>
-
-: alien-vector ( c-ptr n rep -- value ) \ alien-vector bad-simd-call ;
-: set-alien-vector ( value c-ptr n rep -- ) \ set-alien-vector bad-simd-call ;
-
-<PRIVATE
-
! Helper for boolean vector literals
: vector-true-value ( class -- value )
GENERIC: simd-element-type ( obj -- c-type )
GENERIC: simd-rep ( simd -- rep )
+GENERIC: simd-with ( n exemplar -- v )
-<<
-: rep-length ( rep -- n )
- 16 swap rep-component-type heap-size /i ; foldable
+M: object simd-element-type drop f ;
+M: object simd-rep drop f ;
+<<
<PRIVATE
DEFER: simd-construct-op
-! SIMD concrete type functor
+! Unboxers for SIMD operations
+: if-both-vectors ( a b rep t f -- )
+ [ 2over [ simd-128? ] both? ] 2dip if ; inline
-FUNCTOR: define-simd-128 ( T -- )
+: if-both-vectors-match ( a b rep t f -- )
+ [ 3dup [ drop [ simd-128? ] both? ] [ '[ simd-rep _ eq? ] both? ] 3bi and ]
+ 2dip if ; inline
-A DEFINES-CLASS ${T}
-A-rep IS ${T}-rep
->A DEFINES >${T}
-A-boa DEFINES ${T}-boa
-A-with DEFINES ${T}-with
-A-cast DEFINES ${T}-cast
-A{ DEFINES ${T}{
+: simd-unbox ( a -- a (a) )
+ [ ] [ underlying>> ] bi ; inline
-ELT [ A-rep rep-component-type ]
-N [ A-rep rep-length ]
+: v->v-op ( a rep quot: ( (a) rep -- (c) ) fallback-quot -- c )
+ drop [ simd-unbox ] 2dip 2curry make-underlying ; inline
-SET-NTH [ ELT dup c:c-setter c:array-accessor ]
+: vx->v-op ( a obj rep quot: ( (a) obj rep -- (c) ) fallback-quot -- c )
+ drop [ simd-unbox ] 3dip 3curry make-underlying ; inline
-BOA-EFFECT [ N "n" <repetition> >array { "v" } <effect> ]
+: vn->v-op ( a n rep quot: ( (a) n rep -- (c) ) fallback-quot -- c )
+ drop [ [ simd-unbox ] [ >fixnum ] bi* ] 2dip 3curry make-underlying ; inline
-WHERE
+: vx->x-op ( a obj rep quot: ( (a) obj rep -- obj ) fallback-quot -- obj )
+ drop [ underlying>> ] 3dip call ; inline
-TUPLE: A < simd-128 ;
+: v->x-op ( a rep quot: ( (a) rep -- obj ) fallback-quot -- obj )
+ drop [ underlying>> ] 2dip call ; inline
-M: A new-underlying drop \ A boa ; inline
-M: A simd-rep drop A-rep ; inline
-M: A simd-element-type drop ELT ; inline
+: (vv->v-op) ( a b rep quot: ( (a) (b) rep -- (c) ) -- c )
+ [ [ simd-unbox ] [ underlying>> ] bi* ] 2dip 3curry make-underlying ; inline
-M: A set-nth-unsafe
- [ ELT boolean>element ] 2dip
- underlying>> SET-NTH call ; inline
+: (vv->x-op) ( a b rep quot: ( (a) (b) rep -- n ) -- n )
+ [ [ underlying>> ] bi@ ] 2dip 3curry call ; inline
-: >A ( seq -- simd ) \ A new clone-like ; inline
+: (vvx->v-op) ( a b obj rep quot: ( (a) (b) obj rep -- (c) ) -- c )
+ [ [ simd-unbox ] [ underlying>> ] bi* ] 3dip 2curry 2curry make-underlying ; inline
-M: A like drop dup \ A instance? [ >A ] unless ; inline
+: vv->v-op ( a b rep quot: ( (a) (b) rep -- (c) ) fallback-quot -- c )
+ [ '[ _ (vv->v-op) ] ] [ '[ drop @ ] ] bi* if-both-vectors-match ; inline
-: A-with ( n -- v ) \ A new simd-with ; inline
-: A-cast ( v -- v' ) \ A new simd-cast ; inline
+:: vvx->v-op ( a b obj rep quot: ( (a) (b) obj rep -- (c) ) fallback-quot -- c )
+ a b rep
+ [ obj swap quot (vvx->v-op) ]
+ [ drop obj fallback-quot call ] if-both-vectors-match ; inline
-\ A-boa \ A new N {
- { 2 [ '[ _ [ (simd-gather-2) ] simd-construct-op ] ] }
- { 4 [ '[ _ [ (simd-gather-4) ] simd-construct-op ] ] }
- [ swap '[ _ _ nsequence ] ]
-} case BOA-EFFECT define-inline
+: vv'->v-op ( a b rep quot: ( (a) (b) rep -- (c) ) fallback-quot -- c )
+ [ '[ _ (vv->v-op) ] ] [ '[ drop @ ] ] bi* if-both-vectors ; inline
-M: A pprint-delims drop \ A{ \ } ;
-SYNTAX: A{ \ } [ >A ] parse-literal ;
+: vv->x-op ( a b rep quot: ( (a) (b) rep -- obj ) fallback-quot -- obj )
+ [ '[ _ (vv->x-op) ] ] [ '[ drop @ ] ] bi* if-both-vectors-match ; inline
-c:<c-type>
- byte-array >>class
- A >>boxed-class
- [ A-rep alien-vector \ A boa ] >>getter
- [ [ underlying>> ] 2dip A-rep set-alien-vector ] >>setter
- 16 >>size
- 16 >>align
- A-rep >>rep
-\ A c:typedef
-
-;FUNCTOR
-
-SYNTAX: SIMD-128:
- scan define-simd-128 ;
+: mask>count ( n rep -- n' )
+ [ bit-count ] dip {
+ { float-4-rep [ ] }
+ { double-2-rep [ -1 shift ] }
+ { uchar-16-rep [ ] }
+ { char-16-rep [ ] }
+ { ushort-8-rep [ -1 shift ] }
+ { short-8-rep [ -1 shift ] }
+ { ushort-8-rep [ -1 shift ] }
+ { int-4-rep [ -2 shift ] }
+ { uint-4-rep [ -2 shift ] }
+ { longlong-2-rep [ -3 shift ] }
+ { ulonglong-2-rep [ -3 shift ] }
+ } case ; inline
PRIVATE>
-
>>
-: assert-positive ( x -- y ) ;
+<<
! SIMD vectors as sequences
M: simd-128 hashcode* underlying>> hashcode* ; inline
M: simd-128 clone [ clone ] change-underlying ; inline
-M: simd-128 length simd-rep rep-length ; inline
-M: simd-128 nth-unsafe [ nip ] 2keep simd-rep (simd-select) ; inline
-M: simd-128 c:byte-length drop 16 ; inline
+M: simd-128 byte-length drop 16 ; inline
M: simd-128 new-sequence
2dup length =
[ nip [ 16 (byte-array) ] make-underlying ]
[ length bad-simd-length ] if ; inline
-! M: simd-128 >pprint-sequence ;
-! M: simd-128 pprint* pprint-object ;
+M: simd-128 equal?
+ dup simd-rep [ drop v= vall? ] [ 3drop f ] if-both-vectors-match ; inline
-INSTANCE: simd-128 sequence
+! SIMD primitive operations
-! Unboxers for SIMD operations
-<<
-<PRIVATE
+M: simd-128 v+
+ dup simd-rep [ (simd-v+) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 v-
+ dup simd-rep [ (simd-v-) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 vneg
+ dup simd-rep [ (simd-vneg) ] [ call-next-method ] v->v-op ; inline
+M: simd-128 v+-
+ dup simd-rep [ (simd-v+-) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 vs+
+ dup simd-rep [ (simd-vs+) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 vs-
+ dup simd-rep [ (simd-vs-) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 vs*
+ dup simd-rep [ (simd-vs*) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 v*
+ dup simd-rep [ (simd-v*) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 v*high
+ dup simd-rep [ (simd-v*high) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 v/
+ dup simd-rep [ (simd-v/) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 vavg
+ dup simd-rep [ (simd-vavg) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 vmin
+ dup simd-rep [ (simd-vmin) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 vmax
+ dup simd-rep [ (simd-vmax) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 vdot
+ dup simd-rep [ (simd-vdot) ] [ call-next-method ] vv->x-op ; inline
+M: simd-128 vsad
+ dup simd-rep [ (simd-vsad) ] [ call-next-method ] vv->x-op ; inline
+M: simd-128 vsqrt
+ dup simd-rep [ (simd-vsqrt) ] [ call-next-method ] v->v-op ; inline
+M: simd-128 sum
+ dup simd-rep [ (simd-sum) ] [ call-next-method ] v->x-op ; inline
+M: simd-128 vabs
+ dup simd-rep [ (simd-vabs) ] [ call-next-method ] v->v-op ; inline
+M: simd-128 vbitand
+ dup simd-rep [ (simd-vbitand) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 vbitandn
+ dup simd-rep [ (simd-vbitandn) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 vbitor
+ dup simd-rep [ (simd-vbitor) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 vbitxor
+ dup simd-rep [ (simd-vbitxor) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 vbitnot
+ dup simd-rep [ (simd-vbitnot) ] [ call-next-method ] v->v-op ; inline
+M: simd-128 vand
+ dup simd-rep [ (simd-vand) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 vandn
+ dup simd-rep [ (simd-vandn) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 vor
+ dup simd-rep [ (simd-vor) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 vxor
+ dup simd-rep [ (simd-vxor) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 vnot
+ dup simd-rep [ (simd-vnot) ] [ call-next-method ] v->v-op ; inline
+M: simd-128 vlshift
+ over simd-rep [ (simd-vlshift) ] [ call-next-method ] vn->v-op ; inline
+M: simd-128 vrshift
+ over simd-rep [ (simd-vrshift) ] [ call-next-method ] vn->v-op ; inline
+M: simd-128 hlshift
+ over simd-rep [ (simd-hlshift) ] [ call-next-method ] vn->v-op ; inline
+M: simd-128 hrshift
+ over simd-rep [ (simd-hrshift) ] [ call-next-method ] vn->v-op ; inline
+M: simd-128 vshuffle-elements
+ over simd-rep [ (simd-vshuffle-elements) ] [ call-next-method ] vx->v-op ; inline
+M: simd-128 vshuffle2-elements
+ over simd-rep [ (simd-vshuffle2-elements) ] [ call-next-method ] vvx->v-op ; inline
+M: simd-128 vshuffle-bytes
+ dup simd-rep [ (simd-vshuffle-bytes) ] [ call-next-method ] vv'->v-op ; inline
+M: simd-128 (vmerge-head)
+ dup simd-rep [ (simd-vmerge-head) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 (vmerge-tail)
+ dup simd-rep [ (simd-vmerge-tail) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 v<=
+ dup simd-rep [ (simd-v<=) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 v<
+ dup simd-rep [ (simd-v<) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 v=
+ dup simd-rep [ (simd-v=) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 v>
+ dup simd-rep [ (simd-v>) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 v>=
+ dup simd-rep [ (simd-v>=) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 vunordered?
+ dup simd-rep [ (simd-vunordered?) ] [ call-next-method ] vv->v-op ; inline
+M: simd-128 vany?
+ dup simd-rep [ (simd-vany?) ] [ call-next-method ] v->x-op ; inline
+M: simd-128 vall?
+ dup simd-rep [ (simd-vall?) ] [ call-next-method ] v->x-op ; inline
+M: simd-128 vnone?
+ dup simd-rep [ (simd-vnone?) ] [ call-next-method ] v->x-op ; inline
+M: simd-128 vcount
+ dup simd-rep
+ [ [ (simd-vgetmask) assert-positive ] [ call-next-method ] v->x-op ]
+ [ mask>count ] bi ; inline
-: if-both-vectors ( a b t f -- )
- [ 2dup [ simd-128? ] both? ] 2dip if ; inline
+! SIMD high-level specializations
-: if-both-vectors-match ( a b t f -- )
- [ 2dup [ [ simd-128? ] both? ] [ [ simd-rep ] bi@ eq? ] 2bi and ]
- 2dip if ; inline
+M: simd-128 vbroadcast swap [ nth ] [ simd-with ] bi ; inline
+M: simd-128 n+v [ simd-with ] keep v+ ; inline
+M: simd-128 n-v [ simd-with ] keep v- ; inline
+M: simd-128 n*v [ simd-with ] keep v* ; inline
+M: simd-128 n/v [ simd-with ] keep v/ ; inline
+M: simd-128 v+n over simd-with v+ ; inline
+M: simd-128 v-n over simd-with v- ; inline
+M: simd-128 v*n over simd-with v* ; inline
+M: simd-128 v/n over simd-with v/ ; inline
+M: simd-128 norm-sq dup vdot assert-positive ; inline
+M: simd-128 distance v- norm ; inline
-: simd-construct-op ( exemplar quot: ( rep -- v ) -- v )
- [ dup simd-rep ] dip curry make-underlying ; inline
+M: simd-128 >pprint-sequence ;
+M: simd-128 pprint* pprint-object ;
-: simd-unbox ( a -- a (a) a-rep )
- [ ] [ underlying>> ] [ simd-rep ] tri ; inline
+<PRIVATE
-: simd-v->v-op ( a quot: ( (a) rep -- (c) ) -- c )
- [ simd-unbox ] dip 2curry make-underlying ; inline
+! SIMD concrete type functor
-: simd-vn->v-op ( a n quot: ( (a) n rep -- (c) ) -- c )
- [ simd-unbox ] [ swap ] [ 3curry ] tri* make-underlying ; inline
+<FUNCTOR: define-simd-128 ( T -- )
-: simd-v->n-op ( a quot: ( (a) rep -- n ) -- n )
- [ [ underlying>> ] [ simd-rep ] bi ] dip call ; inline
+A DEFINES-CLASS ${T}
+A-rep IS ${T}-rep
+>A DEFINES >${T}
+A-boa DEFINES ${T}-boa
+A-with DEFINES ${T}-with
+A-cast DEFINES ${T}-cast
+A{ DEFINES ${T}{
-: ((simd-vv->v-op)) ( a b quot: ( (a) (b) rep -- (c) ) -- c )
- [ simd-unbox ] [ underlying>> swap ] [ 3curry ] tri* make-underlying ; inline
+ELT [ A-rep rep-component-type ]
+N [ A-rep rep-length ]
+COERCER [ ELT c:c-type-class "coercer" word-prop [ ] or ]
-: ((simd-vv->n-op)) ( a b quot: ( (a) (b) rep -- n ) -- n )
- [ [ underlying>> ] [ simd-rep ] bi ]
- [ underlying>> swap ] [ ] tri* call ; inline
-
-: (simd-vv->v-op) ( a b quot: ( (a) (b) rep -- (c) ) fallback-quot -- c )
- [ '[ _ ((simd-vv->v-op)) ] ] dip if-both-vectors-match ; inline
+BOA-EFFECT [ N "n" <array> { "v" } <effect> ]
-: (simd-vv'->v-op) ( a b quot: ( (a) (b) rep -- (c) ) fallback-quot -- c )
- [ '[ _ ((simd-vv->v-op)) ] ] dip if-both-vectors ; inline
+WHERE
-: (simd-vv->n-op) ( a b quot: ( (a) (b) rep -- n ) fallback-quot -- n )
- [ '[ _ ((simd-vv->n-op)) ] ] dip if-both-vectors-match ; inline
+TUPLE: A < simd-128 ; final
-: (simd-method-fallback) ( accum word -- accum )
- [ current-method get literalize \ (call-next-method) [ ] 2sequence suffix! ]
- dip suffix! ;
+M: A new-underlying drop \ A boa ; inline
+M: A simd-rep drop A-rep ; inline
+M: A simd-element-type drop ELT ; inline
+M: A simd-with drop A-with ; inline
-SYNTAX: simd-vv->v-op
- \ (simd-vv->v-op) (simd-method-fallback) ;
-SYNTAX: simd-vv'->v-op
- \ (simd-vv'->v-op) (simd-method-fallback) ;
-SYNTAX: simd-vv->n-op
- \ (simd-vv->n-op) (simd-method-fallback) ;
+M: A nth-unsafe
+ swap \ A-rep [ (simd-select) ] [ call-next-method ] vx->x-op ; inline
+M: A set-nth-unsafe
+ [ ELT boolean>element ] 2dip
+ underlying>> ELT c:set-alien-element ; inline
-PRIVATE>
->>
+: >A ( seq -- simd ) \ A new clone-like ; inline
-M: simd-128 equal?
- [ v= vall? ] [ 2drop f ] if-both-vectors-match ; inline
+M: A like drop dup \ A instance? [ >A ] unless ; inline
-! SIMD constructors
+: A-with ( n -- v ) COERCER call \ A-rep (simd-with) \ A boa ; inline
+: A-cast ( v -- v' ) underlying>> \ A boa ; inline
-: simd-with ( n seq -- v )
- [ (simd-with) ] simd-construct-op ; inline
+M: A length drop N ; inline
-MACRO: simd-boa ( class -- )
- new dup length {
- { 2 [ '[ _ [ (simd-gather-2) ] simd-construct-op ] ] }
- { 4 [ '[ _ [ (simd-gather-4) ] simd-construct-op ] ] }
- [ swap '[ _ _ nsequence ] ]
- } case ;
+\ A-boa
+[ COERCER N napply ] N {
+ { 2 [ [ A-rep (simd-gather-2) A boa ] ] }
+ { 4 [ [ A-rep (simd-gather-4) A boa ] ] }
+ [ \ A new '[ _ _ nsequence ] ]
+} case compose
+BOA-EFFECT define-inline
-: simd-cast ( v seq -- v' )
- [ underlying>> ] dip new-underlying ; inline
+M: A pprint-delims drop \ A{ \ } ;
+SYNTAX: A{ \ } [ >A ] parse-literal ;
-! SIMD primitive operations
+INSTANCE: A sequence
-M: simd-128 v+ [ (simd-v+) ] simd-vv->v-op ; inline
-M: simd-128 v- [ (simd-v-) ] simd-vv->v-op ; inline
-M: simd-128 vneg [ (simd-vneg) ] simd-v->v-op ; inline
-M: simd-128 v+- [ (simd-v+-) ] simd-vv->v-op ; inline
-M: simd-128 vs+ [ (simd-vs+) ] simd-vv->v-op ; inline
-M: simd-128 vs- [ (simd-vs-) ] simd-vv->v-op ; inline
-M: simd-128 vs* [ (simd-vs*) ] simd-vv->v-op ; inline
-M: simd-128 v* [ (simd-v*) ] simd-vv->v-op ; inline
-M: simd-128 v/ [ (simd-v/) ] simd-vv->v-op ; inline
-M: simd-128 vmin [ (simd-vmin) ] simd-vv->v-op ; inline
-M: simd-128 vmax [ (simd-vmax) ] simd-vv->v-op ; inline
-M: simd-128 v. [ (simd-v.) ] simd-vv->n-op ; inline
-M: simd-128 vsqrt [ (simd-vsqrt) ] simd-v->v-op ; inline
-M: simd-128 sum [ (simd-sum) ] simd-v->n-op ; inline
-M: simd-128 vabs [ (simd-vabs) ] simd-v->v-op ; inline
-M: simd-128 vbitand [ (simd-vbitand) ] simd-vv->v-op ; inline
-M: simd-128 vbitandn [ (simd-vbitandn) ] simd-vv->v-op ; inline
-M: simd-128 vbitor [ (simd-vbitor) ] simd-vv->v-op ; inline
-M: simd-128 vbitxor [ (simd-vbitxor) ] simd-vv->v-op ; inline
-M: simd-128 vbitnot [ (simd-vbitnot) ] simd-v->v-op ; inline
-M: simd-128 vand [ (simd-vand) ] simd-vv->v-op ; inline
-M: simd-128 vandn [ (simd-vandn) ] simd-vv->v-op ; inline
-M: simd-128 vor [ (simd-vor) ] simd-vv->v-op ; inline
-M: simd-128 vxor [ (simd-vxor) ] simd-vv->v-op ; inline
-M: simd-128 vnot [ (simd-vnot) ] simd-v->v-op ; inline
-M: simd-128 vlshift [ (simd-vlshift) ] simd-vn->v-op ; inline
-M: simd-128 vrshift [ (simd-vrshift) ] simd-vn->v-op ; inline
-M: simd-128 hlshift [ (simd-hlshift) ] simd-vn->v-op ; inline
-M: simd-128 hrshift [ (simd-hrshift) ] simd-vn->v-op ; inline
-M: simd-128 vshuffle-elements [ (simd-vshuffle-elements) ] simd-vn->v-op ; inline
-M: simd-128 vshuffle-bytes [ (simd-vshuffle-bytes) ] simd-vv->v-op ; inline
-M: simd-128 (vmerge-head) [ (simd-vmerge-head) ] simd-vv->v-op ; inline
-M: simd-128 (vmerge-tail) [ (simd-vmerge-tail) ] simd-vv->v-op ; inline
-M: simd-128 v<= [ (simd-v<=) ] simd-vv->v-op ; inline
-M: simd-128 v< [ (simd-v<) ] simd-vv->v-op ; inline
-M: simd-128 v= [ (simd-v=) ] simd-vv->v-op ; inline
-M: simd-128 v> [ (simd-v>) ] simd-vv->v-op ; inline
-M: simd-128 v>= [ (simd-v>=) ] simd-vv->v-op ; inline
-M: simd-128 vunordered? [ (simd-vunordered?) ] simd-vv->v-op ; inline
-M: simd-128 vany? [ (simd-vany?) ] simd-v->n-op ; inline
-M: simd-128 vall? [ (simd-vall?) ] simd-v->n-op ; inline
-M: simd-128 vnone? [ (simd-vnone?) ] simd-v->n-op ; inline
+c:<c-type>
+ byte-array >>class
+ A >>boxed-class
+ { A-rep alien-vector A boa } >quotation >>getter
+ {
+ [ dup simd-128? [ bad-simd-vector ] unless underlying>> ] 2dip
+ A-rep set-alien-vector
+ } >quotation >>setter
+ 16 >>size
+ 16 >>align
+ A-rep >>rep
+\ A c:typedef
-! SIMD high-level specializations
+;FUNCTOR>
-M: simd-128 vbroadcast [ swap nth ] keep simd-with ; inline
-M: simd-128 n+v [ simd-with ] keep v+ ; inline
-M: simd-128 n-v [ simd-with ] keep v- ; inline
-M: simd-128 n*v [ simd-with ] keep v* ; inline
-M: simd-128 n/v [ simd-with ] keep v/ ; inline
-M: simd-128 v+n over simd-with v+ ; inline
-M: simd-128 v-n over simd-with v- ; inline
-M: simd-128 v*n over simd-with v* ; inline
-M: simd-128 v/n over simd-with v/ ; inline
-M: simd-128 norm-sq dup v. assert-positive ; inline
-M: simd-128 norm norm-sq sqrt ; inline
-M: simd-128 distance v- norm ; inline
+SYNTAX: SIMD-128:
+ scan-token define-simd-128 ;
+
+PRIVATE>
+
+>>
! SIMD instances
! misc
-M: simd-128 vshuffle ( u perm -- v )
+M: simd-128 vshuffle
vshuffle-bytes ; inline
-"compiler.tree.propagation.simd" require
-"compiler.cfg.intrinsics.simd" require
-"compiler.cfg.value-numbering.simd" require
-
-"mirrors" vocab [
- "math.vectors.simd.mirrors" require
-] when
+M: uchar-16 v*hs+
+ uchar-16-rep [ (simd-v*hs+) ] [ call-next-method ] vv->v-op short-8-cast ; inline
+M: ushort-8 v*hs+
+ ushort-8-rep [ (simd-v*hs+) ] [ call-next-method ] vv->v-op uint-4-cast ; inline
+M: uint-4 v*hs+
+ uint-4-rep [ (simd-v*hs+) ] [ call-next-method ] vv->v-op ulonglong-2-cast ; inline
+M: char-16 v*hs+
+ char-16-rep [ (simd-v*hs+) ] [ call-next-method ] vv->v-op short-8-cast ; inline
+M: short-8 v*hs+
+ short-8-rep [ (simd-v*hs+) ] [ call-next-method ] vv->v-op int-4-cast ; inline
+M: int-4 v*hs+
+ int-4-rep [ (simd-v*hs+) ] [ call-next-method ] vv->v-op longlong-2-cast ; inline
+
+{ "math.vectors.simd" "mirrors" } "math.vectors.simd.mirrors" require-when
projects / factor.git / blobdiff