From a7dd4ad5cce4e54c44b159e9ae63ac8215945add Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 30 Sep 2009 18:22:59 -0500 Subject: [PATCH 1/3] cpu.ppc: update for alien intrinsic changes --- basis/cpu/ppc/ppc.factor | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 006d38f384..de37cd6ee3 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -386,24 +386,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 ; From 129b74143722edf3c69942365d216a2ca2a8d478 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 30 Sep 2009 18:52:01 -0500 Subject: [PATCH 2/3] fix the help lints --- basis/random/random-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 From 2384b630b2ce98fa094e1809e796dacfddaefd51 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 30 Sep 2009 20:04:37 -0500 Subject: [PATCH 3/3] 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 --- .../cfg/instructions/instructions.factor | 4 +-- .../compiler/cfg/intrinsics/simd/simd.factor | 4 ++- basis/cpu/x86/x86.factor | 34 +++++++++++++------ basis/math/vectors/simd/simd-tests.factor | 21 +++++++++++- .../specialization/specialization.factor | 11 +++--- 5 files changed, 55 insertions(+), 19 deletions(-) diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index cf0f668db3..aefa155ec5 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/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 diff --git a/basis/compiler/cfg/intrinsics/simd/simd.factor b/basis/compiler/cfg/intrinsics/simd/simd.factor index 51eced4e35..62ee1cf019 100644 --- a/basis/compiler/cfg/intrinsics/simd/simd.factor +++ b/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 ) diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index eaaab19662..3c20064313 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 ; @@ -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 ; 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 ea9947a0c5..b07615bfc9 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 ; @@ -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 [