math.vectors.conversion vocab with primitive words (to be mapped to intrinsics soon) and a super all-in-one "vconvert" macro wrapping the whole thing
							parent
							
								
									882f40d88e
								
							
						
					
					
						commit
						166ea6bc10
					
				| 
						 | 
				
			
			@ -0,0 +1 @@
 | 
			
		|||
Joe Groff
 | 
			
		||||
| 
						 | 
				
			
			@ -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 <array> :> 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
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -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 ;
 | 
			
		||||
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
: saturate-map-as ( v quot result -- w )
 | 
			
		||||
    [ element-type '[ @ _ c-type-clamp ] ] keep map-as ; inline
 | 
			
		||||
 | 
			
		||||
: (v>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 ;
 | 
			
		||||
| 
						 | 
				
			
			@ -0,0 +1 @@
 | 
			
		|||
Conversion, packing, and unpacking of SIMD vectors
 | 
			
		||||
		Loading…
	
		Reference in New Issue