math.vectors.simd: use fallbacks for hlshift, hrshift, vshuffle if parameter is not a literal;al; element access in int-4 on x86-64 now sign-extends the value; don't throw error at compile time if parameter for vshuffle does not have enough elements

basis/compiler/cfg/instructions/instructions.factor

@@ -404,12 +404,12 @@ literal: rep ;
 
 PURE-INSN: ##shl-vector
 def: dst
-use: src1 src2/scalar-rep
+use: src1 src2/int-scalar-rep
 literal: rep ;
 
 PURE-INSN: ##shr-vector
 def: dst
-use: src1 src2/scalar-rep
+use: src1 src2/int-scalar-rep
 literal: rep ;
 
 ! Scalar/vector conversion

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

@@ -74,7 +74,9 @@ MACRO: if-literals-match ( quots -- )
 : shuffle? ( obj -- ? ) { [ array? ] [ [ integer? ] all? ] } 1&& ;
 
 : emit-shuffle-vector ( node -- )
-    [ ^^shuffle-vector ] [unary/param]
+    ! Pad the permutation with zeroes if its too short, since we
+    ! can't throw an error at this point.
+    [ [ rep-components 0 pad-tail ] keep ^^shuffle-vector ] [unary/param]
     { [ shuffle? ] [ representation? ] } if-literals-match ;
 
 : ^^broadcast-vector ( src n rep -- dst )

basis/cpu/x86/x86.factor

@@ -317,13 +317,19 @@ M:: x86 %set-string-nth-fast ( ch str index temp -- )
 : %alien-unsigned-getter ( dst src offset size -- )
     [ MOVZX ] %alien-integer-getter ; inline
 
+: %alien-signed-getter ( dst src offset size -- )
+    [ MOVSX ] %alien-integer-getter ; inline
+
+:: %alien-integer-setter ( ptr offset value size -- )
+    value { ptr } size [| new-value |
+        new-value value int-rep %copy
+        ptr offset [+] new-value size n-bit-version-of MOV
+    ] with-small-register ; inline
+
 M: x86 %alien-unsigned-1 8 %alien-unsigned-getter ;
 M: x86 %alien-unsigned-2 16 %alien-unsigned-getter ;
 M: x86 %alien-unsigned-4 32 [ 2drop ] %alien-integer-getter ;
 
-: %alien-signed-getter ( dst src offset size -- )
-    [ MOVSX ] %alien-integer-getter ; inline
-
 M: x86 %alien-signed-1 8 %alien-signed-getter ;
 M: x86 %alien-signed-2 16 %alien-signed-getter ;
 M: x86 %alien-signed-4 32 %alien-signed-getter ;
@@ -333,12 +339,6 @@ M: x86 %alien-float [+] MOVSS ;
 M: x86 %alien-double [+] MOVSD ;
 M: x86 %alien-vector [ [+] ] dip %copy ;
 
-:: %alien-integer-setter ( ptr offset value size -- )
-    value { ptr } size [| new-value |
-        new-value value int-rep %copy
-        ptr offset [+] new-value size n-bit-version-of MOV
-    ] with-small-register ; inline
-
 M: x86 %set-alien-integer-1 8 %alien-integer-setter ;
 M: x86 %set-alien-integer-2 16 %alien-integer-setter ;
 M: x86 %set-alien-integer-4 32 %alien-integer-setter ;
@@ -1045,8 +1045,20 @@ M: x86 %shr-vector-reps
 : scalar-sized-reg ( reg rep -- reg' )
     rep-size 8 * n-bit-version-of ;
 
-M: x86 %integer>scalar scalar-sized-reg MOVD ;
-M: x86 %scalar>integer swap [ scalar-sized-reg ] dip MOVD ;
+M: x86 %integer>scalar drop MOVD ;
+
+M:: x86 %scalar>integer ( dst src rep -- )
+    rep {
+        { int-scalar-rep [
+            dst 32-bit-version-of src MOVD
+            dst dst 32-bit-version-of
+            2dup eq? [ 2drop ] [ MOVSX ] if
+        ] }
+        { uint-scalar-rep [
+            dst 32-bit-version-of src MOVD
+        ] }
+    } case ;
+
 M: x86 %vector>scalar %copy ;
 M: x86 %scalar>vector %copy ;
 

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

@@ -6,7 +6,7 @@ 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 classes.algebra sets
-quotations math.constants ;
+quotations math.constants compiler.units ;
 QUALIFIED-WITH: alien.c-types c
 SPECIALIZED-ARRAY: c:float
 SIMD: c:char
@@ -216,12 +216,27 @@ simd-classes&reps [
 [ int-4{ 256 512 1024 2048 } ]
 [ int-4{ 1 2 4 8 } [ { int-4 } declare 1 hlshift ] compile-call ] unit-test
 
+[ int-4{ 256 512 1024 2048 } ]
+[ int-4{ 1 2 4 8 } 1 [ { int-4 fixnum } declare hlshift ] compile-call ] unit-test
+
 [ int-4{ 1 2 4 8 } ]
 [ int-4{ 256 512 1024 2048 } 1 hrshift ] unit-test
 
 [ int-4{ 1 2 4 8 } ]
 [ int-4{ 256 512 1024 2048 } [ { int-4 } declare 1 hrshift ] compile-call ] unit-test
 
+[ int-4{ 1 2 4 8 } ]
+[ int-4{ 256 512 1024 2048 } 1 [ { int-4 fixnum } declare hrshift ] compile-call ] unit-test
+
+! Invalid inputs should not cause the compiler to throw errors
+[ ] [
+    [ [ { int-4 } declare t hrshift ] (( a -- b )) define-temp drop ] with-compilation-unit
+] unit-test
+
+[ ] [
+    [ [ { int-4 } declare { 3 2 1 } vshuffle ] (( a -- b )) define-temp drop ] with-compilation-unit
+] unit-test
+
 ! Shuffles
 : shuffles-for ( n -- shuffles )
     {
@@ -278,6 +293,7 @@ simd-classes [
 [ { } ] [ uint-4{ HEX: ffffffff 2 3 4 } test-accesses ] unit-test
 
 [ HEX: 7fffffff ] [ int-4{ HEX: 7fffffff 3 4 -8 } first ] unit-test
+[ -8 ] [ int-4{ HEX: 7fffffff 3 4 -8 } last ] unit-test
 [ HEX: ffffffff ] [ uint-4{ HEX: ffffffff 2 3 4 } first ] unit-test
 
 [ { } ] [ double-2{ 1.0 2.0 } test-accesses ] unit-test
@@ -313,6 +329,9 @@ simd-classes [
 [ { } ] [ longlong-4{ 1 2 3 4 } test-broadcast ] unit-test
 [ { } ] [ ulonglong-4{ 1 2 3 4 } test-broadcast ] unit-test
 
+! Make sure we use the fallback in the correct situations
+[ int-4{ 3 3 3 3 } ] [ int-4{ 12 34 3 17 } 2 [ { int-4 fixnum } declare vbroadcast ] compile-call ] unit-test
+
 "== Checking alien operations" print
 
 [ float-4{ 1 2 3 4 } ] [

basis/math/vectors/specialization/specialization.factor

@@ -14,7 +14,7 @@ SYMBOLS: -> +vector+ +scalar+ +nonnegative+ +literal+ ;
             { +vector+ [ drop ] }
             { +scalar+ [ nip ] }
             { +nonnegative+ [ nip ] }
-            { +literal+ [ 2drop object ] }
+            { +literal+ [ 2drop f ] }
         } case
     ] with with map ;
 
@@ -136,7 +136,7 @@ ERROR: bad-vector-word word ;
         [ { } ]
     } cond
     ! Don't specialize horizontal shifts or shuffles at all, they're only for SIMD
-    { hlshift hrshift vshuffle } diff
+    { hlshift hrshift vshuffle vbroadcast } diff
     nip ;
 
 :: specialize-vector-words ( array-type elt-type simd -- )
@@ -147,13 +147,16 @@ ERROR: bad-vector-word word ;
         tri add-specialization
     ] each ;
 
+: specialization-matches? ( value-infos signature -- ? )
+    [ [ [ class>> ] dip class<= ] [ literal?>> ] if* ] 2all? ;
+
 : find-specialization ( classes word -- word/f )
     specializations
-    [ first [ class<= ] 2all? ] with find
+    [ first specialization-matches? ] with find
     swap [ second ] when ;
 
 : vector-word-custom-inlining ( #call -- word/f )
-    [ in-d>> [ value-info class>> ] map ] [ word>> ] bi
+    [ in-d>> [ value-info ] map ] [ word>> ] bi
     find-specialization ;
 
 vector-words keys [