math.vectors.simd.functor: don't open-code simd-nth and simd-with if we cannot generate double precision FP code. Should fix illegal instruction trap on CPUs with only SSE1

db4
Slava Pestov 2009-10-01 07:36:50 -05:00
parent 0e97398da8
commit 0db97d536f
1 changed files with 6 additions and 10 deletions

View File

@ -7,6 +7,7 @@ math.vectors.specialization parser prettyprint.custom sequences
sequences.private strings words definitions macros cpu.architecture sequences.private strings words definitions macros cpu.architecture
namespaces arrays quotations combinators sets layouts ; namespaces arrays quotations combinators sets layouts ;
QUALIFIED-WITH: alien.c-types c QUALIFIED-WITH: alien.c-types c
QUALIFIED: math.private
IN: math.vectors.simd.functor IN: math.vectors.simd.functor
ERROR: bad-length got expected ; ERROR: bad-length got expected ;
@ -16,8 +17,8 @@ MACRO: simd-boa ( rep class -- simd-array )
: can-be-unboxed? ( type -- ? ) : can-be-unboxed? ( type -- ? )
{ {
{ c:float [ t ] } { c:float [ \ math.private:float+ "intrinsic" word-prop ] }
{ c:double [ t ] } { c:double [ \ math.private:float+ "intrinsic" word-prop ] }
[ c:heap-size cell < ] [ c:heap-size cell < ]
} case ; } case ;
@ -37,7 +38,7 @@ MACRO: simd-boa ( rep class -- simd-array )
: simd-with ( rep class x -- simd-array ) : simd-with ( rep class x -- simd-array )
[ rep-components ] [ new ] [ '[ _ ] ] tri* swap replicate-as ; inline [ rep-components ] [ new ] [ '[ _ ] ] tri* swap replicate-as ; inline
: simd-with-fast? ( rep -- ? ) : simd-with/nth-fast? ( rep -- ? )
[ \ (simd-vshuffle) supported-simd-op? ] [ \ (simd-vshuffle) supported-simd-op? ]
[ rep-component-type can-be-unboxed? ] [ rep-component-type can-be-unboxed? ]
bi and ; bi and ;
@ -45,16 +46,11 @@ MACRO: simd-boa ( rep class -- simd-array )
:: define-with-custom-inlining ( word rep class -- ) :: define-with-custom-inlining ( word rep class -- )
word [ word [
drop drop
rep simd-with-fast? [ rep simd-with/nth-fast? [
[ rep rep-coerce rep (simd-with) class boa ] [ rep rep-coerce rep (simd-with) class boa ]
] [ word def>> ] if ] [ word def>> ] if
] "custom-inlining" set-word-prop ; ] "custom-inlining" set-word-prop ;
: simd-nth-fast? ( rep -- ? )
[ \ (simd-vshuffle) supported-simd-op? ]
[ rep-component-type can-be-unboxed? ]
bi and ;
: simd-nth-fast ( rep -- quot ) : simd-nth-fast ( rep -- quot )
[ rep-components ] keep [ rep-components ] keep
'[ swap _ '[ _ _ (simd-select) ] 2array ] map-index '[ swap _ '[ _ _ (simd-select) ] 2array ] map-index
@ -64,7 +60,7 @@ MACRO: simd-boa ( rep class -- simd-array )
rep-component-type dup c:c-type-getter-boxer c:array-accessor ; rep-component-type dup c:c-type-getter-boxer c:array-accessor ;
MACRO: simd-nth ( rep -- x ) MACRO: simd-nth ( rep -- x )
dup simd-nth-fast? [ simd-nth-fast ] [ simd-nth-slow ] if ; dup simd-with/nth-fast? [ simd-nth-fast ] [ simd-nth-slow ] if ;
: boa-effect ( rep n -- effect ) : boa-effect ( rep n -- effect )
[ rep-components ] dip * [ rep-components ] dip *