diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 1dcfb4fd64..97a5cd13c6 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -410,12 +410,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 diff --git a/basis/compiler/cfg/intrinsics/simd/simd.factor b/basis/compiler/cfg/intrinsics/simd/simd.factor index d41d001159..7604b731d7 100644 --- a/basis/compiler/cfg/intrinsics/simd/simd.factor +++ b/basis/compiler/cfg/intrinsics/simd/simd.factor @@ -77,7 +77,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 ) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 8503ac83ea..f290e9cc3b 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -387,24 +387,24 @@ M:: ppc %box-displaced-alien ( dst displacement base displacement' base' base-cl "end" resolve-label ] with-scope ; -M: ppc %alien-unsigned-1 0 LBZ ; -M: ppc %alien-unsigned-2 0 LHZ ; +M: ppc %alien-unsigned-1 LBZ ; +M: ppc %alien-unsigned-2 LHZ ; -M: ppc %alien-signed-1 dupd 0 LBZ dup EXTSB ; -M: ppc %alien-signed-2 0 LHA ; +M: ppc %alien-signed-1 [ dup ] 2dip LBZ dup EXTSB ; +M: ppc %alien-signed-2 LHA ; -M: ppc %alien-cell 0 LWZ ; +M: ppc %alien-cell LWZ ; -M: ppc %alien-float 0 LFS ; -M: ppc %alien-double 0 LFD ; +M: ppc %alien-float LFS ; +M: ppc %alien-double LFD ; -M: ppc %set-alien-integer-1 swap 0 STB ; -M: ppc %set-alien-integer-2 swap 0 STH ; +M: ppc %set-alien-integer-1 swapd STB ; +M: ppc %set-alien-integer-2 swapd STH ; -M: ppc %set-alien-cell swap 0 STW ; +M: ppc %set-alien-cell swapd STW ; -M: ppc %set-alien-float swap 0 STFS ; -M: ppc %set-alien-double swap 0 STFD ; +M: ppc %set-alien-float swapd STFS ; +M: ppc %set-alien-double swapd STFD ; : load-zone-ptr ( reg -- ) "nursery" %load-vm-field-addr ; diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 414ba2b6de..14b9f275e5 100644 --- a/basis/cpu/x86/x86.factor +++ b/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 ; @@ -1056,8 +1056,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 ; diff --git a/basis/math/vectors/simd/simd-tests.factor b/basis/math/vectors/simd/simd-tests.factor index ce17736d75..c676b9fe98 100644 --- a/basis/math/vectors/simd/simd-tests.factor +++ b/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 } ] [ diff --git a/basis/math/vectors/specialization/specialization.factor b/basis/math/vectors/specialization/specialization.factor index 21d024a50e..5d2c6b7a5a 100644 --- a/basis/math/vectors/specialization/specialization.factor +++ b/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 ; @@ -137,7 +137,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 -- ) @@ -148,13 +148,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 [ diff --git a/basis/random/random-docs.factor b/basis/random/random-docs.factor index 79e38ec3b6..cd645750db 100755 --- a/basis/random/random-docs.factor +++ b/basis/random/random-docs.factor @@ -34,7 +34,7 @@ HELP: random } ; HELP: random-32 -{ $values { "elt" "a 32-bit random integer" } } +{ $values { "n" "a 32-bit random integer" } } { $description "Outputs 32 random bits. This word is more efficient than calling " { $link random } " because no scaling is done on the output." } ; HELP: random-bytes