math.vectors.simd: add intrinsic for int-4-boa, uint-4-boa, fix tests for C type parser change, fix software fallback for horizontal shifts

basis/cpu/x86/x86.factor

@@ -592,9 +592,9 @@ M: x86 %broadcast-vector-reps
     } available-reps ;
 
 M:: x86 %gather-vector-4 ( dst src1 src2 src3 src4 rep -- )
-    rep {
     {
-            float-4-rep
+        {
+            [ rep float-4-rep eq? ]
             [
                 dst src1 float-4-rep %copy
                 dst src2 UNPCKLPS
@@ -602,13 +602,22 @@ M:: x86 %gather-vector-4 ( dst src1 src2 src3 src4 rep -- )
                 dst src3 MOVLHPS
             ]
         }
-    } case ;
+        {
+            [ rep { int-4-rep uint-4-rep } memq? ]
+            [
+                dst src1 int-4-rep %copy
+                dst src2 PUNPCKLDQ
+                src3 src4 PUNPCKLDQ
+                dst src3 PUNPCKLQDQ
+            ]
+        }
+    } cond ;
 
 M: x86 %gather-vector-4-reps
     {
         ! Can't do this with sse1 since it will want to unbox
         ! double-precision floats and convert to single precision
-        { sse2? { float-4-rep } }
+        { sse2? { float-4-rep int-4-rep uint-4-rep } }
     } available-reps ;
 
 M:: x86 %gather-vector-2 ( dst src1 src2 rep -- )

basis/math/vectors/simd/functor/functor.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types assocs byte-arrays classes
+USING: accessors alien.c-types assocs byte-arrays classes effects fry
-effects fry functors generalizations kernel literals locals
+functors generalizations kernel literals locals math math.functions
-math math.functions math.vectors math.vectors.simd.intrinsics
+math.vectors math.vectors.private math.vectors.simd.intrinsics
 math.vectors.specialization parser prettyprint.custom sequences
 sequences.private strings words definitions macros cpu.architecture
 namespaces arrays quotations ;
@@ -141,6 +141,8 @@ M: A set-nth-unsafe underlying>> SET-NTH call ; inline
 
 M: A like drop dup \ A instance? [ >A ] unless ; inline
 
+M: A new-underlying drop \ A boa ; inline
+
 M: A new-sequence
     drop dup N =
     [ drop 16 <byte-array> \ A boa ]

basis/math/vectors/simd/simd-tests.factor

@@ -6,18 +6,18 @@ tools.test vocabs assocs compiler.cfg.debugger words
 locals math.vectors.specialization combinators cpu.architecture
 math.vectors.simd.intrinsics namespaces byte-arrays alien
 specialized-arrays classes.struct eval ;
-FROM: alien.c-types => c-type-boxed-class ;
+QUALIFIED-WITH: alien.c-types c
-SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: c:float
-SIMD: char
+SIMD: c:char
-SIMD: uchar
+SIMD: c:uchar
-SIMD: short
+SIMD: c:short
-SIMD: ushort
+SIMD: c:ushort
-SIMD: int
+SIMD: c:int
-SIMD: uint
+SIMD: c:uint
-SIMD: longlong
+SIMD: c:longlong
-SIMD: ulonglong
+SIMD: c:ulonglong
-SIMD: float
+SIMD: c:float
-SIMD: double
+SIMD: c:double
 IN: math.vectors.simd.tests
 
 ! Make sure the functor doesn't generate bogus vocabularies

basis/math/vectors/simd/simd.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types combinators fry kernel lexer math math.parser
+USING: alien.c-types combinators fry kernel parser math math.parser
 math.vectors.simd.functor sequences splitting vocabs.generated
-vocabs.loader vocabs.parser words ;
+vocabs.loader vocabs.parser words accessors ;
 QUALIFIED-WITH: alien.c-types c
 IN: math.vectors.simd
 
@@ -11,22 +11,11 @@ ERROR: bad-base-type type ;
 <PRIVATE
 
 : simd-vocab ( base-type -- vocab )
-    "math.vectors.simd.instances." prepend ;
+    name>> "math.vectors.simd.instances." prepend ;
 
-: parse-base-type ( string -- c-type )
+: parse-base-type ( c-type -- c-type )
-    {
+    dup { c:char c:uchar c:short c:ushort c:int c:uint c:longlong c:ulonglong c:float c:double } memq?
-        { "char" [ c:char ] }
+    [ bad-base-type ] unless ;
-        { "uchar" [ c:uchar ] }
-        { "short" [ c:short ] }
-        { "ushort" [ c:ushort ] }
-        { "int" [ c:int ] }
-        { "uint" [ c:uint ] }
-        { "longlong" [ c:longlong ] }
-        { "ulonglong" [ c:ulonglong ] }
-        { "float" [ c:float ] }
-        { "double" [ c:double ] }
-        [ bad-base-type ]
-    } case ;
 
 PRIVATE>
 
@@ -38,4 +27,4 @@ PRIVATE>
     ] generate-vocab ;
 
 SYNTAX: SIMD:
-    scan define-simd-vocab use-vocab ;
+    scan-word define-simd-vocab use-vocab ;

basis/math/vectors/vectors.factor

@@ -64,6 +64,8 @@ PRIVATE>
 
 : bitandn ( x y -- z ) [ bitnot ] dip bitand ; inline
 
+GENERIC: new-underlying ( underlying seq -- seq' )
+
 PRIVATE>
 
 : vbitand ( u v -- w ) over '[ _ [ bitand ] fp-bitwise-op ] 2map ;
@@ -90,12 +92,10 @@ PRIVATE>
 : vrshift ( u n -- w ) neg '[ _ shift ] map ;
 
 : hlshift ( u n -- w )
-    [ clone ] dip
+    [ [ underlying>> ] dip <byte-array> prepend 16 head ] [ drop ] 2bi new-underlying ;
-    '[ _ <byte-array> append 16 tail* ] change-underlying ;
 
 : hrshift ( u n -- w )
-    [ clone ] dip
+    [ [ underlying>> ] dip <byte-array> append 16 tail* ] [ drop ] 2bi new-underlying ;
-    '[ _ <byte-array> prepend 16 head* ] change-underlying ;
 
 : vfloor    ( u -- v ) [ floor ] map ;
 : vceiling  ( u -- v ) [ ceiling ] map ;