]> gitweb.factorcode.org Git - factor.git/commitdiff
fix simd intrinsic compilation
authorJoe Groff <arcata@gmail.com>
Tue, 24 Nov 2009 19:37:28 +0000 (11:37 -0800)
committerJoe Groff <arcata@gmail.com>
Tue, 24 Nov 2009 19:37:28 +0000 (11:37 -0800)
basis/compiler/cfg/builder/builder.factor
basis/compiler/cfg/intrinsics/simd/backend/backend.factor
basis/compiler/cfg/intrinsics/simd/simd.factor
basis/compiler/tree/propagation/simd/simd.factor

index cf6215c5cde14b77708e56f963d58cf7552d5460..f1b3447fc7339e66f7d2f039b82949dd77e12dd4 100755 (executable)
@@ -45,6 +45,12 @@ SYMBOL: loops
         end-stack-analysis
     ] 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 -- )
 
 : emit-nodes ( nodes -- )
index 1a229672b993ca6eeea4015b315e30fe9fd357fc..cf61a560d240089c85760b33c0d38f4ea1a6e18c 100644 (file)
@@ -151,6 +151,8 @@ MACRO: check-elements ( quots -- )
     [ length 1 - \ and <repetition> [ ] like ]
     tri 3append ;
 
+ERROR: bad-simd-intrinsic node ;
+
 MACRO: if-literals-match ( quots -- )
     [ length ] [ ] [ length ] tri
     ! n quots n
@@ -165,7 +167,7 @@ MACRO: if-literals-match ( quots -- )
             ! node literals quot
             [ _ firstn ] dip call
             drop
-        ] [ 2drop emit-primitive ] if
+        ] [ 2drop bad-simd-intrinsic ] if
     ] ;
 
 CONSTANT: [unary]       [ ds-drop  ds-pop ]
index 5f4b71a8465edba47d0dfe09dfc03e9e438c119b..a96a0b7cb31f7a11ac31e0ccc95c1298ccfd1301 100644 (file)
@@ -77,14 +77,6 @@ IN: compiler.cfg.intrinsics.simd
         [ [ ^^fill-vector ] [ ^^xor-vector ] bi ]
     } 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 )
     {cc,swap} first2 :> ( cc swap? )
     swap?
@@ -107,6 +99,14 @@ IN: compiler.cfg.intrinsics.simd
         not? [ rep ^not-vector ] when
     ] 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) ]
index 93eb2a8ecc95c498b7568c78167dc300a9606d5b..6002b15c1c2907a1a9103e00c3f4109a59400c83 100644 (file)
@@ -1,8 +1,9 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors byte-arrays combinators continuations fry sequences
-compiler.tree.propagation.info cpu.architecture kernel words make math
-math.intervals math.vectors.simd.intrinsics ;
+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 ;
 IN: compiler.tree.propagation.simd
 
 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
 ] "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 -- ? )
-    '[ [ _ call( node -- ) ] { } make drop t ] [ 2drop f ] recover ;
+    '[
+        _ clone-with-value-infos
+        _ with-dummy-cfg-builder
+        t
+    ] [ drop f ] recover ;
 
 : inline-unless-intrinsic ( word -- )
     dup '[