1 ! (c)Joe Groff bsd license
2 USING: accessors alien arrays assocs classes combinators
3 combinators.short-circuit fry kernel locals math math.vectors
4 math.vectors.simd math.vectors.simd.intrinsics sequences ;
6 char uchar short ushort int uint longlong ulonglong
7 float double heap-size ;
8 IN: math.vectors.conversion
10 ERROR: bad-vconvert from-type to-type ;
11 ERROR: bad-vconvert-input value expected-type ;
15 : float-type? ( c-type -- ? )
16 { float double } member-eq? ;
17 : unsigned-type? ( c-type -- ? )
18 { uchar ushort uint ulonglong } member-eq? ;
20 : check-vconvert-type ( value expected-type -- value )
21 2dup instance? [ drop ] [ bad-vconvert-input ] if ; inline
23 :: [vconvert] ( from-element to-element from-size to-size from-type to-type -- quot )
26 [ from-element to-element eq? ]
30 [ from-element to-element [ float-type? not ] both? ]
31 [ [ underlying>> to-type boa ] ]
34 [ from-element float-type? ]
35 [ from-type new simd-rep '[ underlying>> _ (simd-v>integer) to-type boa ] ]
38 [ to-element float-type? ]
39 [ from-type new simd-rep '[ underlying>> _ (simd-v>float) to-type boa ] ]
42 [ from-type check-vconvert-type ] prepose ;
44 :: check-vpack ( from-element to-element from-type to-type steps -- )
47 [ from-element to-element [ float-type? ] bi@ xor ]
48 [ from-element unsigned-type? to-element unsigned-type? not and ]
49 } 0|| [ from-type to-type bad-vconvert ] when ;
51 :: [[vpack-unsigned]] ( from-type to-type -- quot )
52 from-type new simd-rep
54 [ from-type check-vconvert-type underlying>> ] bi@
55 _ (simd-vpack-unsigned) to-type boa
58 :: [[vpack-signed]] ( from-type to-type -- quot )
59 from-type new simd-rep
61 [ from-type check-vconvert-type underlying>> ] bi@
62 _ (simd-vpack-signed) to-type boa
65 :: [vpack] ( from-element to-element from-size to-size from-type to-type -- quot )
66 from-size to-size /i log2 :> steps
68 from-element to-element from-type to-type steps check-vpack
70 from-type to-type to-element unsigned-type?
71 [ [[vpack-unsigned]] ] [ [[vpack-signed]] ] if ;
73 :: check-vunpack ( from-element to-element from-type to-type steps -- )
76 [ from-element to-element [ float-type? ] bi@ xor ]
77 [ from-element unsigned-type? not to-element unsigned-type? and ]
78 } 0|| [ from-type to-type bad-vconvert ] when ;
80 :: [[vunpack]] ( from-type to-type -- quot )
81 from-type new simd-rep
83 from-type check-vconvert-type underlying>> _
84 [ (simd-vunpack-head) to-type boa ]
85 [ (simd-vunpack-tail) to-type boa ] 2bi
88 :: [vunpack] ( from-element to-element from-size to-size from-type to-type -- quot )
89 to-size from-size /i log2 :> steps
90 from-element to-element from-type to-type steps check-vunpack
91 from-type to-type [[vunpack]] ;
95 MACRO:: vconvert ( from-type to-type -- )
96 from-type new [ simd-element-type ] [ byte-length ] bi :> ( from-element from-length )
97 to-type new [ simd-element-type ] [ byte-length ] bi :> ( to-element to-length )
98 from-element heap-size :> from-size
99 to-element heap-size :> to-size
101 from-length to-length = [ from-type to-type bad-vconvert ] unless
103 from-element to-element from-size to-size from-type to-type {
104 { [ from-size to-size < ] [ [vunpack] ] }
105 { [ from-size to-size = ] [ [vconvert] ] }
106 { [ from-size to-size > ] [ [vpack] ] }