1 ! Copyright (C) 2009 Joe Groff.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien arrays assocs classes combinators
4 combinators.short-circuit fry kernel locals math math.vectors
5 math.vectors.simd math.vectors.simd.intrinsics sequences ;
7 char uchar short ushort int uint longlong ulonglong
8 float double heap-size ;
9 IN: math.vectors.conversion
11 ERROR: bad-vconvert from-type to-type ;
12 ERROR: bad-vconvert-input value expected-type ;
16 : float-type? ( c-type -- ? )
17 { float double } member-eq? ;
18 : unsigned-type? ( c-type -- ? )
19 { uchar ushort uint ulonglong } member-eq? ;
21 : check-vconvert-type ( value expected-type -- value )
22 2dup instance? [ drop ] [ bad-vconvert-input ] if ; inline
24 :: [vconvert] ( from-element to-element from-size to-size from-type to-type -- quot )
27 [ from-element to-element eq? ]
31 [ from-element to-element [ float-type? not ] both? ]
32 [ [ underlying>> to-type boa ] ]
35 [ from-element float-type? ]
36 [ from-type new simd-rep '[ underlying>> _ (simd-v>integer) to-type boa ] ]
39 [ to-element float-type? ]
40 [ from-type new simd-rep '[ underlying>> _ (simd-v>float) to-type boa ] ]
43 [ from-type check-vconvert-type ] prepose ;
45 :: check-vpack ( from-element to-element from-type to-type steps -- )
48 [ from-element to-element [ float-type? ] bi@ xor ]
49 [ from-element unsigned-type? to-element unsigned-type? not and ]
50 } 0|| [ from-type to-type bad-vconvert ] when ;
52 :: ([vpack-unsigned]) ( from-type to-type -- quot )
53 from-type new simd-rep
55 [ from-type check-vconvert-type underlying>> ] bi@
56 _ (simd-vpack-unsigned) to-type boa
59 :: ([vpack-signed]) ( from-type to-type -- quot )
60 from-type new simd-rep
62 [ from-type check-vconvert-type underlying>> ] bi@
63 _ (simd-vpack-signed) to-type boa
66 :: [vpack] ( from-element to-element from-size to-size from-type to-type -- quot )
67 from-size to-size /i log2 :> steps
69 from-element to-element from-type to-type steps check-vpack
71 from-type to-type to-element unsigned-type?
72 [ ([vpack-unsigned]) ] [ ([vpack-signed]) ] if ;
74 :: check-vunpack ( from-element to-element from-type to-type steps -- )
77 [ from-element to-element [ float-type? ] bi@ xor ]
78 [ from-element unsigned-type? not to-element unsigned-type? and ]
79 } 0|| [ from-type to-type bad-vconvert ] when ;
81 :: ([vunpack]) ( from-type to-type -- quot )
82 from-type new simd-rep
84 from-type check-vconvert-type underlying>> _
85 [ (simd-vunpack-head) to-type boa ]
86 [ (simd-vunpack-tail) to-type boa ] 2bi
89 :: [vunpack] ( from-element to-element from-size to-size from-type to-type -- quot )
90 to-size from-size /i log2 :> steps
91 from-element to-element from-type to-type steps check-vunpack
92 from-type to-type ([vunpack]) ;
96 MACRO:: vconvert ( from-type to-type -- quot )
97 from-type new [ simd-element-type ] [ byte-length ] bi :> ( from-element from-length )
98 to-type new [ simd-element-type ] [ byte-length ] bi :> ( to-element to-length )
99 from-element heap-size :> from-size
100 to-element heap-size :> to-size
102 from-length to-length = [ from-type to-type bad-vconvert ] unless
104 from-element to-element from-size to-size from-type to-type {
105 { [ from-size to-size < ] [ [vunpack] ] }
106 { [ from-size to-size = ] [ [vconvert] ] }
107 { [ from-size to-size > ] [ [vpack] ] }