diff --git a/basis/math/vectors/conversion/authors.txt b/basis/math/vectors/conversion/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/basis/math/vectors/conversion/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/basis/math/vectors/conversion/conversion-tests.factor b/basis/math/vectors/conversion/conversion-tests.factor new file mode 100644 index 0000000000..bd947e84b1 --- /dev/null +++ b/basis/math/vectors/conversion/conversion-tests.factor @@ -0,0 +1,128 @@ +! (c)Joe Groff bsd license +USING: accessors arrays compiler continuations generalizations +kernel kernel.private locals math.vectors.conversion math.vectors.simd +sequences stack-checker tools.test ; +FROM: alien.c-types => char uchar short ushort int uint longlong ulonglong float double ; +SIMD: uchar +SIMD: char +SIMD: ushort +SIMD: short +SIMD: uint +SIMD: int +SIMD: ulonglong +SIMD: longlong +SIMD: float +SIMD: double +IN: math.vectors.conversion.tests + +ERROR: optimized-vconvert-inconsistent + unoptimized-result + optimized-result ; + +MACRO:: test-vconvert ( from-type to-type -- ) + [ from-type to-type vconvert ] :> quot + quot infer :> effect + effect in>> length :> inputs + effect out>> length :> outputs + + inputs from-type :> declaration + + [ + inputs narray + [ quot with-datastack ] + [ [ [ declaration declare quot call ] compile-call ] with-datastack ] bi + 2dup = [ optimized-vconvert-inconsistent ] unless + drop outputs firstn + ] ; + +[ float-4{ -5.0 1.0 2.0 6.0 } ] +[ int-4{ -5 1 2 6 } int-4 float-4 test-vconvert ] unit-test + +[ int-4{ -5 1 2 6 } ] +[ float-4{ -5.0 1.0 2.0 6.0 } float-4 int-4 test-vconvert ] unit-test + +[ int-4{ -5 1 2 6 } ] +[ float-4{ -5.0 1.0 2.3 6.7 } float-4 int-4 test-vconvert ] unit-test + +[ double-2{ -5.0 1.0 } ] +[ longlong-2{ -5 1 } longlong-2 double-2 test-vconvert ] unit-test + +[ longlong-4{ -5 1 2 6 } ] +[ double-4{ -5.0 1.0 2.3 6.7 } double-4 longlong-4 test-vconvert ] unit-test + +! TODO we should be able to do double->int pack +! [ int-8{ -5 1 2 6 12 34 -56 78 } ] +[ double-4{ -5.0 1.0 2.0 6.0 } double-4{ 12.0 34.0 -56.0 78.0 } double-4 int-8 test-vconvert ] +[ error>> bad-vconvert? ] must-fail-with + +[ float-4{ -1.25 2.0 3.0 -4.0 } ] +[ double-2{ -1.25 2.0 } double-2{ 3.0 -4.0 } double-2 float-4 test-vconvert ] unit-test + +[ int-4{ -1 2 3 -4 } ] +[ longlong-2{ -1 2 } longlong-2{ 3 -4 } longlong-2 int-4 test-vconvert ] unit-test + +[ short-8{ -1 2 3 -32768 5 32767 -7 32767 } ] +[ int-4{ -1 2 3 -40000 } int-4{ 5 60000 -7 80000 } int-4 short-8 test-vconvert ] unit-test + +[ short-16{ -1 2 3 -32768 3 2 1 0 5 32767 -7 32767 7 6 5 4 } ] +[ + int-8{ -1 2 3 -40000 3 2 1 0 } + int-8{ 5 60000 -7 80000 7 6 5 4 } int-8 short-16 test-vconvert +] unit-test + +[ ushort-8{ 0 2 3 0 5 60000 0 65535 } ] +[ int-4{ -1 2 3 -40000 } int-4{ 5 60000 -7 80000 } int-4 ushort-8 test-vconvert ] unit-test + +[ ushort-8{ 65535 2 3 65535 5 60000 65535 65535 } ] +[ uint-4{ -1 2 3 -40000 } uint-4{ 5 60000 -7 80000 } uint-4 ushort-8 test-vconvert ] unit-test + +[ uint-4{ -1 2 3 -40000 } uint-4{ 5 60000 -7 80000 } uint-4 short-8 test-vconvert ] +[ error>> bad-vconvert? ] must-fail-with + +! TODO we should be able to do 256->128 pack +! [ float-4{ -1.25 2.0 3.0 -4.0 } ] +[ double-4{ -1.25 2.0 3.0 -4.0 } double-4 float-4 test-vconvert ] +[ error>> bad-vconvert? ] must-fail-with + +! [ int-4{ -1 2 3 -4 } ] +[ longlong-4{ -1 2 3 -4 } longlong-4 int-4 test-vconvert ] +[ error>> bad-vconvert? ] must-fail-with + +[ double-2{ -1.25 2.0 } double-2{ 3.0 -4.0 } ] +[ float-4{ -1.25 2.0 3.0 -4.0 } float-4 double-2 test-vconvert ] unit-test + +[ int-4{ -1 2 3 -4 } ] +[ int-4{ -1 2 3 -4 } int-4 int-4 test-vconvert ] unit-test + +[ longlong-2{ -1 2 } longlong-2{ 3 -4 } ] +[ int-4{ -1 2 3 -4 } int-4 longlong-2 test-vconvert ] unit-test + +[ int-4{ -1 2 3 -4 } int-4 ulonglong-2 test-vconvert ] +[ error>> bad-vconvert? ] must-fail-with + +[ ulonglong-2{ 1 2 } ulonglong-2{ 3 4 } ] +[ uint-4{ 1 2 3 4 } uint-4 ulonglong-2 test-vconvert ] unit-test + +[ longlong-4{ 1 2 3 4 } longlong-4{ 3 4 5 6 } ] +[ uint-8{ 1 2 3 4 3 4 5 6 } uint-8 longlong-4 test-vconvert ] unit-test + +! TODO we should be able to do 128->256 unpack +! [ longlong-4{ 1 2 3 4 } ] +[ uint-4{ 1 2 3 4 } uint-4 longlong-4 test-vconvert ] +[ error>> bad-vconvert? ] must-fail-with + +! TODO we should be able to do multi-tier pack/unpack +! [ longlong-2{ 1 2 } longlong-2{ 3 4 } longlong-2{ 5 6 } longlong-2{ 7 8 } ] +[ ushort-8{ 1 2 3 4 5 6 7 8 } ushort-8 longlong-2 test-vconvert ] +[ error>> bad-vconvert? ] must-fail-with + +! [ ushort-8{ 1 2 3 4 5 6 7 8 } ] +[ + longlong-2{ 1 2 } + longlong-2{ 3 4 } + longlong-2{ 5 6 } + longlong-2{ 7 8 } + longlong-2 ushort-8 test-vconvert +] +[ error>> bad-vconvert? ] must-fail-with + diff --git a/basis/math/vectors/conversion/conversion.factor b/basis/math/vectors/conversion/conversion.factor new file mode 100644 index 0000000000..14d5c9b712 --- /dev/null +++ b/basis/math/vectors/conversion/conversion.factor @@ -0,0 +1,89 @@ +! (c)Joe Groff bsd license +USING: accessors alien.c-types arrays assocs combinators +combinators.short-circuit cords fry kernel locals math +math.vectors sequences ; +FROM: alien.c-types => char uchar short ushort int uint longlong ulonglong float double ; +IN: math.vectors.conversion + +ERROR: bad-vconvert from-type to-type ; + +float) ( i to-type -- f ) + [ >float ] swap new map-as ; +: (v>integer) ( f to-type -- i ) + [ >integer ] swap new map-as ; +: (vpack-signed) ( a b to-type -- ab ) + [ cord-append [ ] ] dip new saturate-map-as ; +: (vpack-unsigned) ( a b to-type -- ab ) + [ cord-append [ ] ] dip new saturate-map-as ; +: (vunpack-head) ( ab to-type -- a ) + [ dup length 2 /i head-slice ] dip new like ; +: (vunpack-tail) ( ab to-type -- b ) + [ dup length 2 /i tail-slice ] dip new like ; + +: float-type? ( c-type -- ? ) + { float double } memq? ; +: unsigned-type? ( c-type -- ? ) + { uchar ushort uint ulonglong } memq? ; + +:: [vconvert] ( from-element to-element from-size to-size from-type to-type -- quot ) + { + { + [ from-element to-element eq? ] + [ [ ] ] + } + { + [ from-element to-element [ float-type? not ] both? ] + [ [ underlying>> to-type boa ] ] + } + { + [ from-element float-type? ] + [ [ to-type (v>integer) ] ] + } + { + [ to-element float-type? ] + [ [ to-type (v>float) ] ] + } + } cond ; + +:: [vpack] ( from-element to-element from-size to-size from-type to-type -- quot ) + from-size to-size /i log2 :> steps + + { + [ steps 1 = not ] + [ from-element to-element [ float-type? ] bi@ xor ] + [ from-element unsigned-type? to-element unsigned-type? not and ] + } 0|| [ from-type to-type bad-vconvert ] when + + to-type unsigned-type? [ to-type (vpack-unsigned) ] [ to-type (vpack-signed) ] ? ; + +:: [vunpack] ( from-element to-element from-size to-size from-type to-type -- quot ) + to-size from-size /i log2 :> steps + + { + [ steps 1 = not ] + [ from-element to-element [ float-type? ] bi@ xor ] + [ from-element unsigned-type? not to-element unsigned-type? and ] + } 0|| [ from-type to-type bad-vconvert ] when + + [ [ to-type (vunpack-head) ] [ to-type (vunpack-tail) ] bi ] ; + +PRIVATE> + +MACRO:: vconvert ( from-type to-type -- ) + from-type new [ element-type ] [ byte-length ] bi :> from-length :> from-element + to-type new [ element-type ] [ byte-length ] bi :> to-length :> to-element + from-element heap-size :> from-size + to-element heap-size :> to-size + + from-length to-length = [ from-type to-type bad-vconvert ] unless + + from-element to-element from-size to-size from-type to-type { + { [ from-size to-size < ] [ [vunpack] ] } + { [ from-size to-size = ] [ [vconvert] ] } + { [ from-size to-size > ] [ [vpack] ] } + } cond ; diff --git a/basis/math/vectors/conversion/summary.txt b/basis/math/vectors/conversion/summary.txt new file mode 100644 index 0000000000..15f4f0d396 --- /dev/null +++ b/basis/math/vectors/conversion/summary.txt @@ -0,0 +1 @@ +Conversion, packing, and unpacking of SIMD vectors