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

fix simd intrinsic compilation

db4
Joe Groff 2009-11-24 11:37:28 -08:00
parent d94ffe6d78
commit 65d8060075
4 changed files with 29 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/compiler/cfg/builder/builder.factor
View File

@ -45,6 +45,12 @@ SYMBOL: loops
end-stack-analysis end-stack-analysis
] with-scope ; inline ] with-scope ; inline
: with-dummy-cfg-builder ( node quot -- )
[
[ V{ } clone procedures ] 2dip
'[ _ t t [ _ call( node -- ) ] with-cfg-builder ] with-variable
] { } make drop ;
GENERIC: emit-node ( node -- ) GENERIC: emit-node ( node -- )
: emit-nodes ( nodes -- ) : emit-nodes ( nodes -- )

4
basis/compiler/cfg/intrinsics/simd/backend/backend.factor
View File

@ -151,6 +151,8 @@ MACRO: check-elements ( quots -- )
[ length 1 - \ and <repetition> [ ] like ] [ length 1 - \ and <repetition> [ ] like ]
tri 3append ; tri 3append ;
ERROR: bad-simd-intrinsic node ;
MACRO: if-literals-match ( quots -- ) MACRO: if-literals-match ( quots -- )
[ length ] [ ] [ length ] tri [ length ] [ ] [ length ] tri
! n quots n ! n quots n
@ -165,7 +167,7 @@ MACRO: if-literals-match ( quots -- )
! node literals quot ! node literals quot
[ _ firstn ] dip call [ _ firstn ] dip call
drop drop
] [ 2drop emit-primitive ] if ] [ 2drop bad-simd-intrinsic ] if
] ; ] ;
CONSTANT: [unary] [ ds-drop ds-pop ] CONSTANT: [unary] [ ds-drop ds-pop ]

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

@ -77,14 +77,6 @@ IN: compiler.cfg.intrinsics.simd
[ [ ^^fill-vector ] [ ^^xor-vector ] bi ] [ [ ^^fill-vector ] [ ^^xor-vector ] bi ]
} v-vector-op ; } v-vector-op ;
:: ^minmax-compare-vector ( src1 src2 rep cc -- dst )
cc order-cc {
{ cc< [ src1 src2 rep ^^max-vector src1 rep cc/= ^^compare-vector ] }
{ cc<= [ src1 src2 rep ^^min-vector src1 rep cc= ^^compare-vector ] }
{ cc> [ src1 src2 rep ^^min-vector src1 rep cc/= ^^compare-vector ] }
{ cc>= [ src1 src2 rep ^^max-vector src1 rep cc= ^^compare-vector ] }
} case ;
:: ^((compare-vector)) ( src1 src2 rep {cc,swap} -- dst ) :: ^((compare-vector)) ( src1 src2 rep {cc,swap} -- dst )
{cc,swap} first2 :> ( cc swap? ) {cc,swap} first2 :> ( cc swap? )
swap? swap?
@ -107,6 +99,14 @@ IN: compiler.cfg.intrinsics.simd
not? [ rep ^not-vector ] when not? [ rep ^not-vector ] when
] if ; ] if ;
:: ^minmax-compare-vector ( src1 src2 rep cc -- dst )
cc order-cc {
{ cc< [ src1 src2 rep ^^max-vector src1 rep cc/= ^(compare-vector) ] }
{ cc<= [ src1 src2 rep ^^min-vector src1 rep cc= ^(compare-vector) ] }
{ cc> [ src1 src2 rep ^^min-vector src1 rep cc/= ^(compare-vector) ] }
{ cc>= [ src1 src2 rep ^^max-vector src1 rep cc= ^(compare-vector) ] }
} case ;
: ^compare-vector ( src1 src2 rep cc -- dst ) : ^compare-vector ( src1 src2 rep cc -- dst )
{ {
[ ^(compare-vector) ] [ ^(compare-vector) ]

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

@ -1,8 +1,9 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors byte-arrays combinators continuations fry sequences USING: accessors assocs byte-arrays combinators compiler.cfg.builder
compiler.tree.propagation.info cpu.architecture kernel words make math continuations fry sequences compiler.tree.propagation.info
math.intervals math.vectors.simd.intrinsics ; cpu.architecture kernel words make math math.intervals
math.vectors.simd.intrinsics ;
IN: compiler.tree.propagation.simd IN: compiler.tree.propagation.simd
CONSTANT: vector>vector-intrinsics CONSTANT: vector>vector-intrinsics
@ -98,8 +99,15 @@ vector>vector-intrinsics [ { byte-array } "default-output-classes" set-word-prop
real [0,inf] <class/interval-info> value-info-intersect real [0,inf] <class/interval-info> value-info-intersect
] "outputs" set-word-prop ] "outputs" set-word-prop
: clone-with-value-infos ( node -- node' )
clone dup in-d>> [ dup value-info ] H{ } map>assoc >>info ;
: try-intrinsic ( node intrinsic-quot -- ? ) : try-intrinsic ( node intrinsic-quot -- ? )
'[ [ _ call( node -- ) ] { } make drop t ] [ 2drop f ] recover ; '[
_ clone-with-value-infos
_ with-dummy-cfg-builder
t
] [ drop f ] recover ;
: inline-unless-intrinsic ( word -- ) : inline-unless-intrinsic ( word -- )
dup '[ dup '[