Merge branch 'master' of git://factorcode.org/git/factor

basis/compiler/cfg/instructions/instructions.factor

@@ -277,6 +277,11 @@ literal: rep ;
 
 PURE-INSN: ##shuffle-vector
 def: dst
+use: src shuffle
+literal: rep ;
+
+PURE-INSN: ##shuffle-vector-imm
+def: dst
 use: src
 literal: shuffle rep ;
 

basis/compiler/cfg/intrinsics/intrinsics.factor

@@ -194,7 +194,8 @@ IN: compiler.cfg.intrinsics
         { math.vectors.simd.intrinsics:(simd-with) [ [ ^^with-vector ] emit-unary-vector-op ] }
         { math.vectors.simd.intrinsics:(simd-gather-2) [ emit-gather-vector-2 ] }
         { math.vectors.simd.intrinsics:(simd-gather-4) [ emit-gather-vector-4 ] }
-        { math.vectors.simd.intrinsics:(simd-vshuffle) [ emit-shuffle-vector ] }
+        { math.vectors.simd.intrinsics:(simd-vshuffle-elements) [ emit-shuffle-vector ] }
+        { math.vectors.simd.intrinsics:(simd-vshuffle-bytes) [ emit-shuffle-vector-var ] }
         { math.vectors.simd.intrinsics:(simd-(vmerge-head)) [ [ ^^merge-vector-head ] emit-binary-vector-op ] }
         { math.vectors.simd.intrinsics:(simd-(vmerge-tail)) [ [ ^^merge-vector-tail ] emit-binary-vector-op ] }
         { math.vectors.simd.intrinsics:(simd-(v>float)) [ [ ^^integer>float-vector ] emit-unary-vector-op ] }

basis/compiler/cfg/intrinsics/simd/simd.factor

@@ -1,15 +1,16 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors byte-arrays fry cpu.architecture kernel math
+USING: accessors alien byte-arrays fry classes.algebra
-sequences math.vectors.simd.intrinsics macros generalizations
+cpu.architecture kernel math sequences math.vectors
-combinators combinators.short-circuit arrays locals
+math.vectors.simd.intrinsics macros generalizations combinators
+combinators.short-circuit arrays locals
 compiler.tree.propagation.info compiler.cfg.builder.blocks
 compiler.cfg.comparisons
 compiler.cfg.stacks compiler.cfg.stacks.local compiler.cfg.hats
 compiler.cfg.instructions compiler.cfg.registers
 compiler.cfg.intrinsics.alien
 specialized-arrays ;
-FROM: alien.c-types => float double ;
+FROM: alien.c-types => heap-size char uchar float double ;
 SPECIALIZED-ARRAYS: float double ;
 IN: compiler.cfg.intrinsics.simd
 
@@ -21,7 +22,7 @@ MACRO: check-elements ( quots -- )
 
 MACRO: if-literals-match ( quots -- )
     [ length ] [ ] [ length ] tri
-    ! n quots n n
+    ! n quots n
     '[
         ! node quot
         [
@@ -77,15 +78,41 @@ MACRO: if-literals-match ( quots -- )
 
 : shuffle? ( obj -- ? ) { [ array? ] [ [ integer? ] all? ] } 1&& ;
 
-: emit-shuffle-vector ( node -- )
+: >variable-shuffle ( shuffle rep -- shuffle' )
-    ! Pad the permutation with zeroes if its too short, since we
+    rep-component-type heap-size
+    [ dup <repetition> >byte-array ]
+    [ iota >byte-array ] bi
+    '[ _ n*v _ v+ ] map concat ;
+
+: generate-shuffle-vector-imm ( src shuffle rep -- dst )
+    dup %shuffle-vector-imm-reps member?
+    [ ^^shuffle-vector-imm ]
+    [
+        [ >variable-shuffle ^^load-constant ] keep
+        ^^shuffle-vector
+    ] if ;
+
+: emit-shuffle-vector-imm ( node -- )
+    ! Pad the permutation with zeroes if it's too short, since we
     ! can't throw an error at this point.
-    [ [ rep-components 0 pad-tail ] keep ^^shuffle-vector ] [unary/param]
+    [ [ rep-components 0 pad-tail ] keep generate-shuffle-vector-imm ] [unary/param]
     { [ shuffle? ] [ representation? ] } if-literals-match ;
 
+: emit-shuffle-vector-var ( node -- )
+    [ ^^shuffle-vector ] [binary]
+    { [ %shuffle-vector-reps member? ] } if-literals-match ;
+
+: emit-shuffle-vector ( node -- )
+    dup node-input-infos {
+        [ length 3 = ]
+        [ first  class>> byte-array class<= ]
+        [ second class>> byte-array class<= ]
+        [ third  literal>> representation?  ]
+    } 1&& [ emit-shuffle-vector-var ] [ emit-shuffle-vector-imm ] if ;
+
 : ^^broadcast-vector ( src n rep -- dst )
     [ rep-components swap <array> ] keep
-    ^^shuffle-vector ;
+    generate-shuffle-vector-imm ;
 
 : emit-broadcast-vector ( node -- )
     [ ^^broadcast-vector ] [unary/param]
@@ -101,6 +128,9 @@ MACRO: if-literals-match ( quots -- )
     [ ^^select-vector ] [unary/param]
     { [ integer? ] [ representation? ] } if-literals-match ; inline
 
+: emit-alien-vector-op ( node quot: ( rep -- ) -- )
+    { [ %alien-vector-reps member? ] } if-literals-match ; inline
+
 : emit-alien-vector ( node -- )
     dup [
         '[
@@ -108,7 +138,7 @@ MACRO: if-literals-match ( quots -- )
             _ ^^alien-vector ds-push
         ]
         [ inline-alien-getter? ] inline-alien
-    ] with emit-vector-op ;
+    ] with emit-alien-vector-op ;
 
 : emit-set-alien-vector ( node -- )
     dup [
@@ -118,7 +148,7 @@ MACRO: if-literals-match ( quots -- )
         ]
         [ byte-array inline-alien-setter? ]
         inline-alien
-    ] with emit-vector-op ;
+    ] with emit-alien-vector-op ;
 
 : generate-not-vector ( src rep -- dst )
     dup %not-vector-reps member?

basis/compiler/cfg/value-numbering/rewrite/rewrite.factor

@@ -450,26 +450,26 @@ M: ##set-alien-vector rewrite rewrite-alien-addressing ;
 ! Some lame constant folding for SIMD intrinsics. Eventually this
 ! should be redone completely.
 
-: rewrite-shuffle-vector ( insn expr -- insn' )
+: rewrite-shuffle-vector-imm ( insn expr -- insn' )
     2dup [ rep>> ] bi@ eq? [
         [ [ dst>> ] [ src>> vn>vreg ] bi* ]
         [ [ shuffle>> ] bi@ nths ]
         [ drop rep>> ]
-        2tri \ ##shuffle-vector new-insn
+        2tri \ ##shuffle-vector-imm new-insn
     ] [ 2drop f ] if ;
 
-: (fold-shuffle-vector) ( shuffle bytes -- bytes' )
+: (fold-shuffle-vector-imm) ( shuffle bytes -- bytes' )
     2dup length swap length /i group nths concat ;
 
-: fold-shuffle-vector ( insn expr -- insn' )
+: fold-shuffle-vector-imm ( insn expr -- insn' )
     [ [ dst>> ] [ shuffle>> ] bi ] dip value>>
-    (fold-shuffle-vector) \ ##load-constant new-insn ;
+    (fold-shuffle-vector-imm) \ ##load-constant new-insn ;
 
-M: ##shuffle-vector rewrite
+M: ##shuffle-vector-imm rewrite
     dup src>> vreg>expr {
-        { [ dup shuffle-vector-expr? ] [ rewrite-shuffle-vector ] }
+        { [ dup shuffle-vector-imm-expr? ] [ rewrite-shuffle-vector-imm ] }
-        { [ dup reference-expr? ] [ fold-shuffle-vector ] }
+        { [ dup reference-expr? ] [ fold-shuffle-vector-imm ] }
-        { [ dup constant-expr? ] [ fold-shuffle-vector ] }
+        { [ dup constant-expr? ] [ fold-shuffle-vector-imm ] }
         [ 2drop f ]
     } cond ;
 

basis/compiler/cfg/value-numbering/simplify/simplify.factor

@@ -136,7 +136,7 @@ M: scalar>vector-expr simplify*
         [ drop f ]
     } cond ;
 
-M: shuffle-vector-expr simplify*
+M: shuffle-vector-imm-expr simplify*
     [ src>> ] [ shuffle>> ] [ rep>> rep-components iota ] tri
     sequence= [ drop f ] unless ;
 

basis/compiler/cfg/value-numbering/value-numbering-tests.factor

@@ -1215,31 +1215,31 @@ cell 8 = [
     }
 ] [
     {
-        T{ ##shuffle-vector f 1 0 { 0 1 2 3 } float-4-rep }
+        T{ ##shuffle-vector-imm f 1 0 { 0 1 2 3 } float-4-rep }
     } value-numbering-step
 ] unit-test
 
 [
     {
-        T{ ##shuffle-vector f 1 0 { 1 2 3 0 } float-4-rep }
+        T{ ##shuffle-vector-imm f 1 0 { 1 2 3 0 } float-4-rep }
-        T{ ##shuffle-vector f 2 0 { 0 2 3 1 } float-4-rep }
+        T{ ##shuffle-vector-imm f 2 0 { 0 2 3 1 } float-4-rep }
     }
 ] [
     {
-        T{ ##shuffle-vector f 1 0 { 1 2 3 0 } float-4-rep }
+        T{ ##shuffle-vector-imm f 1 0 { 1 2 3 0 } float-4-rep }
-        T{ ##shuffle-vector f 2 1 { 3 1 2 0 } float-4-rep }
+        T{ ##shuffle-vector-imm f 2 1 { 3 1 2 0 } float-4-rep }
     } value-numbering-step
 ] unit-test
 
 [
     {
-        T{ ##shuffle-vector f 1 0 { 1 2 3 0 } float-4-rep }
+        T{ ##shuffle-vector-imm f 1 0 { 1 2 3 0 } float-4-rep }
-        T{ ##shuffle-vector f 2 1 { 1 0 } double-2-rep }
+        T{ ##shuffle-vector-imm f 2 1 { 1 0 } double-2-rep }
     }
 ] [
     {
-        T{ ##shuffle-vector f 1 0 { 1 2 3 0 } float-4-rep }
+        T{ ##shuffle-vector-imm f 1 0 { 1 2 3 0 } float-4-rep }
-        T{ ##shuffle-vector f 2 1 { 1 0 } double-2-rep }
+        T{ ##shuffle-vector-imm f 2 1 { 1 0 } double-2-rep }
     } value-numbering-step
 ] unit-test
 
@@ -1253,7 +1253,7 @@ cell 8 = [
     {
         T{ ##load-constant f 0 $[ 55 tag-fixnum ] }
         T{ ##scalar>vector f 1 0 int-4-rep }
-        T{ ##shuffle-vector f 2 1 { 0 0 0 0 } float-4-rep }
+        T{ ##shuffle-vector-imm f 2 1 { 0 0 0 0 } float-4-rep }
     } value-numbering-step
 ] unit-test
 
@@ -1267,7 +1267,7 @@ cell 8 = [
     {
         T{ ##load-constant f 0 1.25 }
         T{ ##scalar>vector f 1 0 float-4-rep }
-        T{ ##shuffle-vector f 2 1 { 0 0 0 0 } float-4-rep }
+        T{ ##shuffle-vector-imm f 2 1 { 0 0 0 0 } float-4-rep }
     } value-numbering-step
 ] unit-test
 

basis/compiler/codegen/codegen.factor

@@ -154,6 +154,7 @@ CODEGEN: ##zero-vector %zero-vector
 CODEGEN: ##fill-vector %fill-vector
 CODEGEN: ##gather-vector-2 %gather-vector-2
 CODEGEN: ##gather-vector-4 %gather-vector-4
+CODEGEN: ##shuffle-vector-imm %shuffle-vector-imm
 CODEGEN: ##shuffle-vector %shuffle-vector
 CODEGEN: ##tail>head-vector %tail>head-vector
 CODEGEN: ##merge-vector-head %merge-vector-head

basis/compiler/tests/optimizer.factor

@@ -413,5 +413,35 @@ M: object bad-dispatch-position-test* ;
     ] with-compilation-unit
 ] unit-test
 
+[ 16 ] [
+    [
+        0 2
+        [
+            nip
+            [
+                1 + {
+                    [ 16 ]
+                    [ 16 ]
+                    [ 16 ]
+                } dispatch
+            ] [
+                {
+                    [ ]
+                    [ ]
+                    [ ]
+                } dispatch
+            ] bi
+        ] each-integer
+    ] compile-call
+] unit-test
+
+: dispatch-branch-problem ( a b c -- d )
+    dup 0 < [ "boo" throw ] when
+    1 + { [ + ] [ - ] [ * ] } dispatch ;
+
+[ 3 4 -1 dispatch-branch-problem ] [ "boo" = ] must-fail-with
+[ -1 ] [ 3 4 0 dispatch-branch-problem ] unit-test
+[ 12 ] [ 3 4 1 dispatch-branch-problem ] unit-test
+
 ! Not sure if I want to fix this...
 ! [ t [ [ f ] [ 3 ] if >fixnum ] compile-call ] [ no-method? ] must-fail-with

basis/compiler/tree/propagation/branches/branches.factor

@@ -1,8 +1,8 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry kernel sequences assocs accessors namespaces
 math.intervals arrays classes.algebra combinators columns
-stack-checker.branches locals
+stack-checker.branches locals math
 compiler.utilities
 compiler.tree
 compiler.tree.combinators
@@ -21,6 +21,9 @@ M: #if child-constraints
 M: #dispatch child-constraints
     children>> length f <repetition> ;
 
+! There is an important invariant here, either no flags are set
+! in live-branches, exactly one is set, or all are set.
+
 GENERIC: live-branches ( #branch -- indices )
 
 M: #if live-branches
@@ -32,8 +35,12 @@ M: #if live-branches
     } cond nip ;
 
 M: #dispatch live-branches
-    [ children>> length ] [ in-d>> first value-info interval>> ] bi
+    [ children>> ] [ in-d>> first value-info ] bi {
-    '[ _ interval-contains? ] map ;
+        { [ dup class>> null-class? ] [ drop length f <array> ] }
+        { [ dup literal>> integer? not ] [ drop length t <array> ] }
+        { [ 2dup literal>> swap bounds-check? not ] [ drop length t <array> ] }
+        [ literal>> swap length f <array> [ [ t ] 2dip set-nth ] keep ]
+    } cond ;
 
 : live-children ( #branch -- children )
     [ children>> ] [ live-branches>> ] bi select-children ;

basis/compiler/tree/propagation/simd/simd.factor

@@ -31,7 +31,8 @@ IN: compiler.tree.propagation.simd
     (simd-vrshift)
     (simd-hlshift)
     (simd-hrshift)
-    (simd-vshuffle)
+    (simd-vshuffle-bytes)
+    (simd-vshuffle-elements)
     (simd-(vmerge-head))
     (simd-(vmerge-tail))
     (simd-(v>float))

basis/cpu/architecture/architecture.factor

@@ -242,6 +242,7 @@ HOOK: %fill-vector cpu ( dst rep -- )
 HOOK: %gather-vector-2 cpu ( dst src1 src2 rep -- )
 HOOK: %gather-vector-4 cpu ( dst src1 src2 src3 src4 rep -- )
 HOOK: %shuffle-vector cpu ( dst src shuffle rep -- )
+HOOK: %shuffle-vector-imm cpu ( dst src shuffle rep -- )
 HOOK: %tail>head-vector cpu ( dst src rep -- )
 HOOK: %merge-vector-head cpu ( dst src1 src2 rep -- )
 HOOK: %merge-vector-tail cpu ( dst src1 src2 rep -- )
@@ -288,7 +289,9 @@ HOOK: %zero-vector-reps cpu ( -- reps )
 HOOK: %fill-vector-reps cpu ( -- reps )
 HOOK: %gather-vector-2-reps cpu ( -- reps )
 HOOK: %gather-vector-4-reps cpu ( -- reps )
+HOOK: %alien-vector-reps cpu ( -- reps )
 HOOK: %shuffle-vector-reps cpu ( -- reps )
+HOOK: %shuffle-vector-imm-reps cpu ( -- reps )
 HOOK: %merge-vector-reps cpu ( -- reps )
 HOOK: %signed-pack-vector-reps cpu ( -- reps )
 HOOK: %unsigned-pack-vector-reps cpu ( -- reps )
@@ -328,7 +331,9 @@ M: object %zero-vector-reps { } ;
 M: object %fill-vector-reps { } ;
 M: object %gather-vector-2-reps { } ;
 M: object %gather-vector-4-reps { } ;
+M: object %alien-vector-reps { } ;
 M: object %shuffle-vector-reps { } ;
+M: object %shuffle-vector-imm-reps { } ;
 M: object %merge-vector-reps { } ;
 M: object %signed-pack-vector-reps { } ;
 M: object %unsigned-pack-vector-reps { } ;

basis/cpu/x86/x86.factor

@@ -562,6 +562,12 @@ MACRO: available-reps ( alist -- )
     reverse [ { } ] suffix
     '[ _ cond ] ;
 
+M: x86 %alien-vector-reps
+    {
+        { sse? { float-4-rep } }
+        { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
+    } available-reps ;
+
 M: x86 %zero-vector
     {
         { double-2-rep [ dup XORPD ] }
@@ -673,11 +679,9 @@ M: x86 %gather-vector-2-reps
         [ dupd SHUFPD ]
     } case ;
 
-: float-4-shuffle ( dst shuffle -- )
+: sse1-float-4-shuffle ( dst shuffle -- )
     {
         { { 0 1 2 3 } [ drop ] }
-        { { 0 0 2 2 } [ dup MOVSLDUP ] }
-        { { 1 1 3 3 } [ dup MOVSHDUP ] }
         { { 0 1 0 1 } [ dup MOVLHPS ] }
         { { 2 3 2 3 } [ dup MOVHLPS ] }
         { { 0 0 1 1 } [ dup UNPCKLPS ] }
@@ -685,6 +689,15 @@ M: x86 %gather-vector-2-reps
         [ dupd SHUFPS ]
     } case ;
 
+: float-4-shuffle ( dst shuffle -- )
+    sse3? [
+        {
+            { { 0 0 2 2 } [ dup MOVSLDUP ] }
+            { { 1 1 3 3 } [ dup MOVSHDUP ] }
+            [ sse1-float-4-shuffle ]
+        } case
+    ] [ sse1-float-4-shuffle ] if ;
+
 : int-4-shuffle ( dst shuffle -- )
     {
         { { 0 1 2 3 } [ drop ] }
@@ -698,7 +711,7 @@ M: x86 %gather-vector-2-reps
 : longlong-2-shuffle ( dst shuffle -- )
     first2 [ 2 * dup 1 + ] bi@ 4array int-4-shuffle ;
 
-M:: x86 %shuffle-vector ( dst src shuffle rep -- )
+M:: x86 %shuffle-vector-imm ( dst src shuffle rep -- )
     dst src rep %copy
     dst shuffle rep unsign-rep {
         { double-2-rep [ double-2-shuffle ] }
@@ -707,12 +720,20 @@ M:: x86 %shuffle-vector ( dst src shuffle rep -- )
         { longlong-2-rep [ longlong-2-shuffle ] }
     } case ;
 
-M: x86 %shuffle-vector-reps
+M: x86 %shuffle-vector-imm-reps
     {
         { sse? { float-4-rep } }
         { sse2? { double-2-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
     } available-reps ;
 
+M: x86 %shuffle-vector ( dst src shuffle rep -- )
+    two-operand PSHUFB ;
+
+M: x86 %shuffle-vector-reps
+    {
+        { ssse3? { float-4-rep double-2-rep longlong-2-rep ulonglong-2-rep int-4-rep uint-4-rep short-8-rep ushort-8-rep char-16-rep uchar-16-rep } }
+    } available-reps ;
+
 M: x86 %merge-vector-head
     [ two-operand ] keep
     unsign-rep {
@@ -790,8 +811,6 @@ M: x86 %unpack-vector-head-reps ( -- reps )
         { sse4.1? { char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep } }
     } available-reps ;
 
-M: x86 %unpack-vector-tail-reps ( -- reps ) { } ;
-
 M: x86 %integer>float-vector ( dst src rep -- )
     {
         { int-4-rep [ CVTDQ2PS ] }
@@ -1037,10 +1056,6 @@ M: x86 %mul-vector-reps
         { sse4.1? { int-4-rep uint-4-rep } }
     } available-reps ;
 
-M: x86 %saturated-mul-vector-reps
-    ! No multiplication with saturation on x86
-    { } ;
-
 M: x86 %div-vector ( dst src1 src2 rep -- )
     [ two-operand ] keep
     {
@@ -1223,8 +1238,6 @@ M: x86 %xor-vector-reps
         { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
     } available-reps ;
 
-M: x86 %not-vector-reps { } ;
-
 M: x86 %shl-vector ( dst src1 src2 rep -- )
     [ two-operand ] keep
     {
@@ -1271,6 +1284,30 @@ M:: x86 %scalar>integer ( dst src rep -- )
         { uint-scalar-rep [
             dst 32-bit-version-of src MOVD
         ] }
+        { short-scalar-rep [
+            dst 32-bit-version-of src MOVD
+            dst dst 16-bit-version-of MOVSX
+        ] }
+        { ushort-scalar-rep [
+            dst 32-bit-version-of src MOVD
+            dst dst 16-bit-version-of MOVZX
+        ] }
+        { char-scalar-rep [
+            dst 32-bit-version-of src MOVD
+            dst { } 8 [| tmp-dst |
+                tmp-dst dst int-rep %copy
+                tmp-dst tmp-dst 8-bit-version-of MOVSX
+                dst tmp-dst int-rep %copy
+            ] with-small-register
+        ] }
+        { uchar-scalar-rep [
+            dst 32-bit-version-of src MOVD
+            dst { } 8 [| tmp-dst |
+                tmp-dst dst int-rep %copy
+                tmp-dst tmp-dst 8-bit-version-of MOVZX
+                dst tmp-dst int-rep %copy
+            ] with-small-register
+        ] }
     } case ;
 
 M: x86 %vector>scalar %copy ;

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

@@ -60,7 +60,7 @@ MACRO: simd-boa ( rep class -- simd-array )
     [ rep-components ] [ new ] [ '[ _ ] ] tri* swap replicate-as ; inline
 
 : simd-with/nth-fast? ( rep -- ? )
-    [ \ (simd-vshuffle) supported-simd-op? ]
+    [ \ (simd-vshuffle-elements) supported-simd-op? ]
     [ rep-component-type can-be-unboxed? ]
     bi and ;
 
@@ -184,6 +184,8 @@ WHERE
 TUPLE: A
 { underlying byte-array read-only initial: $[ 16 <byte-array> ] } ;
 
+INSTANCE: A simd-128
+
 M: A clone underlying>> clone \ A boa ; inline
 
 M: A length drop N ; inline
@@ -315,7 +317,7 @@ SLOT: underlying2
     class c:typedef ;
 
 : (define-simd-256) ( simd -- )
-    simd-ops get { vshuffle hlshift hrshift } unique assoc-diff >>ops
+    simd-ops get { vshuffle-elements vshuffle-bytes hlshift hrshift } unique assoc-diff >>ops
     [ define-simd ]
     [ [ class>> ] [ rep>> ] bi define-simd-256-type ] bi ;
 
@@ -362,6 +364,8 @@ TUPLE: A
 { underlying1 byte-array initial: $[ 16 <byte-array> ] read-only }
 { underlying2 byte-array initial: $[ 16 <byte-array> ] read-only } ;
 
+INSTANCE: A simd-256
+
 M: A clone
     [ underlying1>> clone ] [ underlying2>> clone ] bi
     \ A boa ; inline

basis/math/vectors/simd/intrinsics/intrinsics.factor

@@ -67,7 +67,8 @@ SIMD-OP: vlshift
 SIMD-OP: vrshift
 SIMD-OP: hlshift
 SIMD-OP: hrshift
-SIMD-OP: vshuffle
+SIMD-OP: vshuffle-elements
+SIMD-OP: vshuffle-bytes
 SIMD-OP: (vmerge-head)
 SIMD-OP: (vmerge-tail)
 SIMD-OP: v<=
@@ -148,6 +149,9 @@ GENERIC# supported-simd-op? 1 ( rep intrinsic -- ? )
     union
     { uchar-16-rep ushort-8-rep uint-4-rep ulonglong-2-rep } union ;
 
+: (%shuffle-imm-reps) ( -- reps )
+    %shuffle-vector-reps %shuffle-vector-imm-reps union ;
+
 M: vector-rep supported-simd-op?
     {
         { \ (simd-v+)            [ %add-vector-reps            ] }
@@ -179,7 +183,8 @@ M: vector-rep supported-simd-op?
         { \ (simd-vrshift)       [ %shr-vector-reps            ] }
         { \ (simd-hlshift)       [ %horizontal-shl-vector-reps ] }
         { \ (simd-hrshift)       [ %horizontal-shr-vector-reps ] }
-        { \ (simd-vshuffle)      [ %shuffle-vector-reps        ] }
+        { \ (simd-vshuffle-elements) [ (%shuffle-imm-reps)         ] }
+        { \ (simd-vshuffle-bytes)    [ %shuffle-vector-reps        ] }
         { \ (simd-(vmerge-head)) [ %merge-vector-reps          ] }
         { \ (simd-(vmerge-tail)) [ %merge-vector-reps          ] }
         { \ (simd-(v>float))        [ %integer>float-vector-reps ] }

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

@@ -174,7 +174,7 @@ CONSTANT: simd-classes
 : remove-special-words ( alist -- alist' )
     ! These have their own tests later
     {
-        hlshift hrshift vshuffle vbroadcast
+        hlshift hrshift vshuffle-bytes vshuffle-elements vbroadcast
         vany? vall? vnone?
         (v>float) (v>integer)
         (vpack-signed) (vpack-unsigned)
@@ -360,6 +360,23 @@ simd-classes [
     ] unit-test
 ] each
 
+"== Checking variable shuffles" print
+
+: random-shift-vector ( class -- vec )
+    new [ drop 16 random ] map ;
+
+:: test-shift-vector ( class -- ? )
+    class random-int-vector :> src
+    char-16 random-shift-vector :> perm
+    { class char-16 } :> decl
+
+    src perm vshuffle
+    src perm [ decl declare vshuffle ] compile-call
+    = ; inline
+
+{ char-16 uchar-16 short-8 ushort-8 int-4 uint-4 longlong-2 ulonglong-2 }
+[ 10 swap '[ [ t ] [ _ test-shift-vector ] unit-test ] times ] each
+
 "== Checking vector tests" print
 
 :: test-vector-tests-bool ( vector declaration -- none? any? all? )
@@ -512,38 +529,38 @@ SYMBOL: !!inconsistent!!
 
 STRUCT: simd-struct
 { x float-4 }
-{ y double-2 }
+{ y longlong-2 }
 { z double-4 }
-{ w float-8 } ;
+{ w int-8 } ;
 
 [ t ] [ [ simd-struct <struct> ] compile-call >c-ptr [ 0 = ] all? ] unit-test
 
 [
     float-4{ 1 2 3 4 }
-    double-2{ 2 1 }
+    longlong-2{ 2 1 }
     double-4{ 4 3 2 1 }
-    float-8{ 1 2 3 4 5 6 7 8 }
+    int-8{ 1 2 3 4 5 6 7 8 }
 ] [
     simd-struct <struct>
     float-4{ 1 2 3 4 } >>x
-    double-2{ 2 1 } >>y
+    longlong-2{ 2 1 } >>y
     double-4{ 4 3 2 1 } >>z
-    float-8{ 1 2 3 4 5 6 7 8 } >>w
+    int-8{ 1 2 3 4 5 6 7 8 } >>w
     { [ x>> ] [ y>> ] [ z>> ] [ w>> ] } cleave
 ] unit-test
 
 [
     float-4{ 1 2 3 4 }
-    double-2{ 2 1 }
+    longlong-2{ 2 1 }
     double-4{ 4 3 2 1 }
-    float-8{ 1 2 3 4 5 6 7 8 }
+    int-8{ 1 2 3 4 5 6 7 8 }
 ] [
     [
         simd-struct <struct>
         float-4{ 1 2 3 4 } >>x
-        double-2{ 2 1 } >>y
+        longlong-2{ 2 1 } >>y
         double-4{ 4 3 2 1 } >>z
-        float-8{ 1 2 3 4 5 6 7 8 } >>w
+        int-8{ 1 2 3 4 5 6 7 8 } >>w
         { [ x>> ] [ y>> ] [ z>> ] [ w>> ] } cleave
     ] compile-call
 ] unit-test

basis/math/vectors/specialization/specialization.factor

@@ -98,7 +98,8 @@ H{
     { vrshift { +vector+ +scalar+ -> +vector+ } }
     { hlshift { +vector+ +literal+ -> +vector+ } }
     { hrshift { +vector+ +literal+ -> +vector+ } }
-    { vshuffle { +vector+ +literal+ -> +vector+ } }
+    { vshuffle-elements { +vector+ +literal+ -> +vector+ } }
+    { vshuffle-bytes    { +vector+ +vector+  -> +vector+ } }
     { vbroadcast { +vector+ +literal+ -> +vector+ } }
     { (vmerge-head) { +vector+ +vector+ -> +vector+ } }
     { (vmerge-tail) { +vector+ +vector+ -> +vector+ } }
@@ -162,7 +163,7 @@ ERROR: bad-vector-word word ;
     } cond
     ! Don't specialize horizontal shifts, shuffles, and conversions at all, they're only for SIMD
     {
-        hlshift hrshift vshuffle vbroadcast
+        hlshift hrshift vshuffle-elements vshuffle-bytes vbroadcast
         (v>integer) (v>float)
         (vpack-signed) (vpack-unsigned)
         (vunpack-head) (vunpack-tail)

basis/math/vectors/vectors.factor

@@ -6,6 +6,9 @@ locals ;
 QUALIFIED-WITH: alien.c-types c
 IN: math.vectors
 
+MIXIN: simd-128
+MIXIN: simd-256
+
 GENERIC: element-type ( obj -- c-type )
 M: object element-type drop f ; inline
 
@@ -83,7 +86,20 @@ PRIVATE>
 : vbitnot ( u -- w ) dup '[ _ [ bitnot ] fp-bitwise-unary ] map ;
 
 :: vbroadcast ( u n -- v ) u length n u nth <repetition> u like ;
-: vshuffle ( u perm -- v ) swap [ '[ _ nth ] ] keep map-as ;
+
+: vshuffle-elements ( u perm -- v )
+    swap [ '[ _ nth ] ] keep map-as ;
+
+: vshuffle-bytes ( u perm -- v )
+    underlying>> [
+        swap [ '[ _ nth ] ] keep map-as
+    ] curry change-underlying ;
+
+GENERIC: vshuffle ( u perm -- v )
+M: array vshuffle ( u perm -- v )
+    vshuffle-elements ; inline
+M: simd-128 vshuffle ( u perm -- v )
+    vshuffle-bytes ; inline
 
 : vlshift ( u n -- w ) '[ _ shift ] map ;
 : vrshift ( u n -- w ) neg '[ _ shift ] map ;
@@ -107,9 +123,9 @@ PRIVATE>
 : vxor ( u v -- w )  over '[ [ _ element>bool ] bi@ xor ] 2map ;
 : vnot ( u -- w )    dup '[ _ element>bool not ] map ;
 
-: vall? ( v -- ? ) [ ] all? ;
+: vall? ( v -- ? ) dup '[ _ element>bool ] all? ;
-: vany? ( v -- ? ) [ ] any? ;
+: vany? ( v -- ? ) dup '[ _ element>bool ] any? ;
-: vnone? ( v -- ? ) [ not ] all? ;
+: vnone? ( v -- ? ) dup '[ _ element>bool not ] all? ;
 
 : v<  ( u v -- w ) [ <   ] 2map ;
 : v<= ( u v -- w ) [ <=  ] 2map ;

basis/specialized-arrays/specialized-arrays.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types alien.data alien.parser
 assocs byte-arrays classes compiler.units functors kernel lexer
-libc math math.vectors math.vectors.specialization namespaces
+libc math math.vectors math.vectors.private
+math.vectors.specialization namespaces
 parser prettyprint.custom sequences sequences.private strings
 summary vocabs vocabs.loader vocabs.parser vocabs.generated
 words fry combinators present ;
@@ -68,6 +69,8 @@ TUPLE: A
     [ drop \ T bad-byte-array-length ] unless
     <direct-A> ; inline
 
+M: A new-underlying drop byte-array>A ;
+
 M: A clone [ underlying>> clone ] [ length>> ] bi <direct-A> ; inline
 
 M: A length length>> ; inline