steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix buggy simd intrinsics

db4
Joe Groff 2009-11-26 13:28:40 -08:00
parent ac5d3d5652
commit 66d0cafa94
5 changed files with 15 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/alien/c-types/c-types.factor
View File

@ -553,4 +553,6 @@ M: double-2-rep rep-component-type drop double ;
{ [ dup { uchar ushort uint ulong ulonglong } member-eq? ] [ unsigned-interval ] }
} cond ; foldable
: c-type-clamp ( value c-type -- value' ) c-type-interval clamp ; inline
: c-type-clamp ( value c-type -- value' )
dup { float double } member-eq?
[ drop ] [ c-type-interval clamp ] if ; inline

6
basis/compiler/cfg/intrinsics/simd/simd.factor
View File

@ -247,7 +247,7 @@ IN: compiler.cfg.intrinsics.simd
] [ ^^vector>scalar ] bi ;
: ^sum-vector ( src rep -- dst )
signed-rep {
{
{ float-vector-rep [ ^(sum-vector) ] }
{ int-vector-rep [| src rep |
src rep ^unpack-vector-head :> head
@ -290,8 +290,8 @@ IN: compiler.cfg.intrinsics.simd
: emit-simd-vneg ( node -- )
{
{ float-vector-rep [ [ ^load-neg-zero-vector ] [ ^^sub-vector ] bi ] }
{ int-vector-rep [ [ ^^zero-vector ] [ ^^sub-vector ] bi ] }
{ float-vector-rep [ [ ^load-neg-zero-vector swap ] [ ^^sub-vector ] bi ] }
{ int-vector-rep [ [ ^^zero-vector swap ] [ ^^sub-vector ] bi ] }
} emit-v-vector-op ;
: emit-simd-v+- ( node -- )

5
basis/compiler/tree/propagation/simd/simd.factor
View File

@ -3,7 +3,7 @@
USING: accessors assocs byte-arrays combinators compiler.cfg.builder
continuations fry sequences compiler.tree.propagation.info
cpu.architecture kernel words make math math.intervals
math.vectors.simd.intrinsics ;
math.vectors.simd.intrinsics namespaces ;
IN: compiler.tree.propagation.simd
CONSTANT: vector>vector-intrinsics
@ -112,9 +112,10 @@ vector>vector-intrinsics [ { byte-array } "default-output-classes" set-word-prop
: inline-unless-intrinsic ( word -- )
dup '[
_ swap over "intrinsic" word-prop
"always-inline-simd-intrinsics" get not swap and
! word node intrinsic
[ try-intrinsic [ drop f ] [ def>> ] if ]
[ def>> ] if*
[ drop def>> ] if*
]
"custom-inlining" set-word-prop ;

6
basis/math/vectors/simd/intrinsics/intrinsics.factor
View File

@ -126,7 +126,7 @@ PRIVATE>
:: (simd-v+-) ( a b rep -- c )
a b rep 2>rep-array :> ( a' b' )
rep <rep-array> :> c'
0 rep length 1 - 2 <range> [| n |
0 rep rep-length 1 - 2 <range> [| n |
n a' nth-unsafe n b' nth-unsafe -
n c' set-nth-unsafe
@ -151,12 +151,12 @@ PRIVATE>
: (simd-sum) ( a rep -- n ) [ + ] components-reduce ;
: (simd-vabs) ( a rep -- c ) [ abs ] components-map ;
: (simd-vbitand) ( a b rep -- c ) [ bitand ] bitwise-components-2map ;
: (simd-vbitandn) ( a b rep -- c ) [ [ not ] dip bitand ] bitwise-components-2map ;
: (simd-vbitandn) ( a b rep -- c ) [ [ bitnot ] dip bitand ] bitwise-components-2map ;
: (simd-vbitor) ( a b rep -- c ) [ bitor ] bitwise-components-2map ;
: (simd-vbitxor) ( a b rep -- c ) [ bitxor ] bitwise-components-2map ;
: (simd-vbitnot) ( a rep -- c ) [ bitnot ] bitwise-components-map ;
: (simd-vand) ( a b rep -- c ) [ bitand ] bitwise-components-2map ;
: (simd-vandn) ( a b rep -- c ) [ [ not ] dip bitand ] bitwise-components-2map ;
: (simd-vandn) ( a b rep -- c ) [ [ bitnot ] dip bitand ] bitwise-components-2map ;
: (simd-vor) ( a b rep -- c ) [ bitor ] bitwise-components-2map ;
: (simd-vxor) ( a b rep -- c ) [ bitxor ] bitwise-components-2map ;
: (simd-vnot) ( a rep -- c ) [ bitnot ] bitwise-components-map ;

5
basis/math/vectors/simd/simd-tests.factor
View File

@ -120,7 +120,7 @@ CONSTANT: vector-words
simd-classes [ [ name>> "-boa" append ] [ vocabulary>> ] bi lookup ] map ;
: check-optimizer ( seq quot eq-quot -- failures )
'[
dup '[
@
[ dup [ class ] { } map-as ] dip '[ _ declare @ ]
{
@ -128,8 +128,9 @@ CONSTANT: vector-words
[ "print-checks" get [ [ . ] bi@ ] [ 2drop ] if ]
[ [ [ call ] dip call ] call( quot quot -- result ) ]
[ [ [ call ] dip compile-call ] call( quot quot -- result ) ]
[ [ t "always-inline-simd-intrinsics" [ [ call ] dip compile-call ] with-variable ] call( quot quot -- result ) ]
} 2cleave
@ not
[ drop @ ] [ nip @ ] 3bi and not
] filter ; inline
"== Checking -new constructors" print