1 USING: accessors alien.c-types arrays byte-arrays classes combinators
2 cpu.architecture effects fry functors generalizations generic
3 generic.parser kernel lexer literals macros math math.functions
4 math.vectors math.vectors.private math.vectors.simd.intrinsics namespaces parser
5 prettyprint.custom quotations sequences sequences.private vocabs
7 QUALIFIED-WITH: alien.c-types c
10 ERROR: bad-simd-length got expected ;
14 ! Primitive SIMD constructors
16 GENERIC: new-underlying ( underlying seq -- seq' )
18 : make-underlying ( seq quot -- seq' )
19 dip new-underlying ; inline
20 : change-underlying ( seq quot -- seq' )
21 '[ underlying>> @ ] keep new-underlying ; inline
27 ! Helper for boolean vector literals
29 : vector-true-value ( class -- value )
30 { c:float c:double } member? [ -1 bits>double ] [ -1 ] if ; foldable
32 : vector-false-value ( type -- value )
33 { c:float c:double } member? [ 0.0 ] [ 0 ] if ; foldable
35 : boolean>element ( bool/elt type -- elt )
37 { t [ vector-true-value ] }
38 { f [ vector-false-value ] }
47 { underlying byte-array read-only initial: $[ 16 <byte-array> ] } ;
49 GENERIC: simd-element-type ( obj -- c-type )
50 GENERIC: simd-rep ( simd -- rep )
52 M: object simd-element-type drop f ;
53 M: object simd-rep drop f ;
58 DEFER: simd-construct-op
60 ! Unboxers for SIMD operations
61 : if-both-vectors ( a b rep t f -- )
62 [ 2over [ simd-128? ] both? ] 2dip if ; inline
64 : if-both-vectors-match ( a b rep t f -- )
65 [ 3dup [ drop [ simd-128? ] both? ] [ '[ simd-rep _ eq? ] both? ] 3bi and ]
68 : simd-unbox ( a -- a (a) )
69 [ ] [ underlying>> ] bi ; inline
71 : v->v-op ( a rep quot: ( (a) rep -- (c) ) fallback-quot -- c )
72 drop [ simd-unbox ] 2dip 2curry make-underlying ; inline
74 : vn->v-op ( a n rep quot: ( (a) n rep -- (c) ) fallback-quot -- c )
75 drop [ simd-unbox ] 3dip 3curry make-underlying ; inline
77 : vn->n-op ( a n rep quot: ( (a) n rep -- n ) fallback-quot -- n )
78 drop [ underlying>> ] 3dip call ; inline
80 : v->n-op ( a rep quot: ( (a) rep -- n ) fallback-quot -- n )
81 drop [ underlying>> ] 2dip call ; inline
83 : (vv->v-op) ( a b rep quot: ( (a) (b) rep -- (c) ) -- c )
84 [ [ simd-unbox ] [ underlying>> ] bi* ] 2dip 3curry make-underlying ; inline
86 : (vv->n-op) ( a b rep quot: ( (a) (b) rep -- n ) -- n )
87 [ [ underlying>> ] bi@ ] 2dip 3curry call ; inline
89 : vv->v-op ( a b rep quot: ( (a) (b) rep -- (c) ) fallback-quot -- c )
90 [ '[ _ (vv->v-op) ] ] [ '[ drop @ ] ] bi* if-both-vectors-match ; inline
92 : vv'->v-op ( a b rep quot: ( (a) (b) rep -- (c) ) fallback-quot -- c )
93 [ '[ _ (vv->v-op) ] ] [ '[ drop @ ] ] bi* if-both-vectors ; inline
95 : vv->n-op ( a b rep quot: ( (a) (b) rep -- n ) fallback-quot -- n )
96 [ '[ _ (vv->n-op) ] ] [ '[ drop @ ] ] bi* if-both-vectors-match ; inline
104 ! SIMD concrete type functor
106 FUNCTOR: define-simd-128 ( T -- )
111 A-boa DEFINES ${T}-boa
112 A-with DEFINES ${T}-with
113 A-cast DEFINES ${T}-cast
116 ELT [ A-rep rep-component-type ]
117 N [ A-rep rep-length ]
118 COERCER [ ELT c-type-class "coercer" word-prop [ ] or ]
120 SET-NTH [ ELT dup c:c-setter c:array-accessor ]
122 BOA-EFFECT [ N "n" <repetition> >array { "v" } <effect> ]
126 TUPLE: A < simd-128 ;
128 M: A new-underlying drop \ A boa ; inline
129 M: A simd-rep drop A-rep ; inline
130 M: A simd-element-type drop ELT ; inline
133 [ ELT boolean>element ] 2dip
134 underlying>> SET-NTH call ; inline
136 : >A ( seq -- simd ) \ A new clone-like ; inline
138 M: A like drop dup \ A instance? [ >A ] unless ; inline
140 : A-with ( n -- v ) COERCER call \ A-rep (simd-with) \ A boa ; inline
141 : A-cast ( v -- v' ) underlying>> \ A boa ; inline
143 ! SIMD vectors as sequences
145 M: A hashcode* underlying>> hashcode* ; inline
146 M: A clone [ clone ] change-underlying ; inline
147 M: A length drop N ; inline
149 swap \ A-rep [ (simd-select) ] [ call-next-method ] vn->n-op ; inline
150 M: A c:byte-length drop 16 ; inline
154 [ nip [ 16 (byte-array) ] make-underlying ]
155 [ length bad-simd-length ] if ; inline
158 \ A-rep [ drop v= vall? ] [ 3drop f ] if-both-vectors-match ; inline
160 ! SIMD primitive operations
162 M: A v+ \ A-rep [ (simd-v+) ] [ call-next-method ] vv->v-op ; inline
163 M: A v- \ A-rep [ (simd-v-) ] [ call-next-method ] vv->v-op ; inline
164 M: A vneg \ A-rep [ (simd-vneg) ] [ call-next-method ] v->v-op ; inline
165 M: A v+- \ A-rep [ (simd-v+-) ] [ call-next-method ] vv->v-op ; inline
166 M: A vs+ \ A-rep [ (simd-vs+) ] [ call-next-method ] vv->v-op ; inline
167 M: A vs- \ A-rep [ (simd-vs-) ] [ call-next-method ] vv->v-op ; inline
168 M: A vs* \ A-rep [ (simd-vs*) ] [ call-next-method ] vv->v-op ; inline
169 M: A v* \ A-rep [ (simd-v*) ] [ call-next-method ] vv->v-op ; inline
170 M: A v*high \ A-rep [ (simd-v*high) ] [ call-next-method ] vv->v-op ; inline
171 M: A v/ \ A-rep [ (simd-v/) ] [ call-next-method ] vv->v-op ; inline
172 M: A vavg \ A-rep [ (simd-vavg) ] [ call-next-method ] vv->v-op ; inline
173 M: A vmin \ A-rep [ (simd-vmin) ] [ call-next-method ] vv->v-op ; inline
174 M: A vmax \ A-rep [ (simd-vmax) ] [ call-next-method ] vv->v-op ; inline
175 M: A v. \ A-rep [ (simd-v.) ] [ call-next-method ] vv->n-op ; inline
176 M: A vsad \ A-rep [ (simd-vsad) ] [ call-next-method ] vv->n-op ; inline
177 M: A vsqrt \ A-rep [ (simd-vsqrt) ] [ call-next-method ] v->v-op ; inline
178 M: A sum \ A-rep [ (simd-sum) ] [ call-next-method ] v->n-op ; inline
179 M: A vabs \ A-rep [ (simd-vabs) ] [ call-next-method ] v->v-op ; inline
180 M: A vbitand \ A-rep [ (simd-vbitand) ] [ call-next-method ] vv->v-op ; inline
181 M: A vbitandn \ A-rep [ (simd-vbitandn) ] [ call-next-method ] vv->v-op ; inline
182 M: A vbitor \ A-rep [ (simd-vbitor) ] [ call-next-method ] vv->v-op ; inline
183 M: A vbitxor \ A-rep [ (simd-vbitxor) ] [ call-next-method ] vv->v-op ; inline
184 M: A vbitnot \ A-rep [ (simd-vbitnot) ] [ call-next-method ] v->v-op ; inline
185 M: A vand \ A-rep [ (simd-vand) ] [ call-next-method ] vv->v-op ; inline
186 M: A vandn \ A-rep [ (simd-vandn) ] [ call-next-method ] vv->v-op ; inline
187 M: A vor \ A-rep [ (simd-vor) ] [ call-next-method ] vv->v-op ; inline
188 M: A vxor \ A-rep [ (simd-vxor) ] [ call-next-method ] vv->v-op ; inline
189 M: A vnot \ A-rep [ (simd-vnot) ] [ call-next-method ] v->v-op ; inline
190 M: A vlshift \ A-rep [ (simd-vlshift) ] [ call-next-method ] vn->v-op ; inline
191 M: A vrshift \ A-rep [ (simd-vrshift) ] [ call-next-method ] vn->v-op ; inline
192 M: A hlshift \ A-rep [ (simd-hlshift) ] [ call-next-method ] vn->v-op ; inline
193 M: A hrshift \ A-rep [ (simd-hrshift) ] [ call-next-method ] vn->v-op ; inline
194 M: A vshuffle-elements \ A-rep [ (simd-vshuffle-elements) ] [ call-next-method ] vn->v-op ; inline
195 M: A vshuffle-bytes \ A-rep [ (simd-vshuffle-bytes) ] [ call-next-method ] vv'->v-op ; inline
196 M: A (vmerge-head) \ A-rep [ (simd-vmerge-head) ] [ call-next-method ] vv->v-op ; inline
197 M: A (vmerge-tail) \ A-rep [ (simd-vmerge-tail) ] [ call-next-method ] vv->v-op ; inline
198 M: A v<= \ A-rep [ (simd-v<=) ] [ call-next-method ] vv->v-op ; inline
199 M: A v< \ A-rep [ (simd-v<) ] [ call-next-method ] vv->v-op ; inline
200 M: A v= \ A-rep [ (simd-v=) ] [ call-next-method ] vv->v-op ; inline
201 M: A v> \ A-rep [ (simd-v>) ] [ call-next-method ] vv->v-op ; inline
202 M: A v>= \ A-rep [ (simd-v>=) ] [ call-next-method ] vv->v-op ; inline
203 M: A vunordered? \ A-rep [ (simd-vunordered?) ] [ call-next-method ] vv->v-op ; inline
204 M: A vany? \ A-rep [ (simd-vany?) ] [ call-next-method ] v->n-op ; inline
205 M: A vall? \ A-rep [ (simd-vall?) ] [ call-next-method ] v->n-op ; inline
206 M: A vnone? \ A-rep [ (simd-vnone?) ] [ call-next-method ] v->n-op ; inline
208 ! SIMD high-level specializations
210 M: A vbroadcast swap nth A-with ; inline
211 M: A n+v [ A-with ] dip v+ ; inline
212 M: A n-v [ A-with ] dip v- ; inline
213 M: A n*v [ A-with ] dip v* ; inline
214 M: A n/v [ A-with ] dip v/ ; inline
215 M: A v+n A-with v+ ; inline
216 M: A v-n A-with v- ; inline
217 M: A v*n A-with v* ; inline
218 M: A v/n A-with v/ ; inline
219 M: A norm-sq dup v. assert-positive ; inline
220 M: A distance v- norm ; inline
222 M: A >pprint-sequence ;
223 M: A pprint* pprint-object ;
226 [ COERCER N napply ] N {
227 { 2 [ [ A-rep (simd-gather-2) A boa ] ] }
228 { 4 [ [ A-rep (simd-gather-4) A boa ] ] }
229 [ \ A new '[ _ _ nsequence ] ]
231 BOA-EFFECT define-inline
233 M: A pprint-delims drop \ A{ \ } ;
234 SYNTAX: A{ \ } [ >A ] parse-literal ;
241 { A-rep alien-vector A boa } >quotation >>getter
242 { [ underlying>> ] 2dip A-rep set-alien-vector } >quotation >>setter
251 scan define-simd-128 ;
266 SIMD-128: ulonglong-2
272 M: simd-128 vshuffle ( u perm -- v )
273 vshuffle-bytes ; inline
276 uchar-16-rep [ (simd-v*hs+) ] [ call-next-method ] vv->v-op ushort-8-cast ; inline
278 ushort-8-rep [ (simd-v*hs+) ] [ call-next-method ] vv->v-op uint-4-cast ; inline
280 uint-4-rep [ (simd-v*hs+) ] [ call-next-method ] vv->v-op ulonglong-2-cast ; inline
282 char-16-rep [ (simd-v*hs+) ] [ call-next-method ] vv->v-op short-8-cast ; inline
284 short-8-rep [ (simd-v*hs+) ] [ call-next-method ] vv->v-op int-4-cast ; inline
286 int-4-rep [ (simd-v*hs+) ] [ call-next-method ] vv->v-op longlong-2-cast ; inline
289 "math.vectors.simd.mirrors" require