From b31ffdfcb4daafbfa640e04424d8620a9f95a770 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 30 Oct 2011 21:49:23 -0700 Subject: [PATCH] math.vectors.simd: vlshift, vrshift, hlshift and hrshift were being miscompiled if the shift count was a bignum. Fixes #264 --- basis/math/vectors/simd/simd-tests.factor | 26 ++++++++++++-- basis/math/vectors/simd/simd.factor | 43 +++++++++++++---------- 2 files changed, 48 insertions(+), 21 deletions(-) diff --git a/basis/math/vectors/simd/simd-tests.factor b/basis/math/vectors/simd/simd-tests.factor index 264dbbce59..79c9047a0e 100644 --- a/basis/math/vectors/simd/simd-tests.factor +++ b/basis/math/vectors/simd/simd-tests.factor @@ -124,7 +124,14 @@ CONSTANT: vector-words : boa-ctors ( -- seq ) simd-classes [ [ name>> "-boa" append ] [ vocabulary>> ] bi lookup ] map ; -: check-optimizer ( seq quot eq-quot -- failures ) +: check-optimizer ( seq test-quot eq-quot -- failures ) + #! Use test-quot to generate a bunch of test cases from the + #! given inputs. Run each test case optimized and + #! unoptimized. Compare results with eq-quot. + #! + #! seq: sequence of inputs + #! test-quot: ( input -- input-quot: ( -- values ) code-quot: ( values -- result ) ) + #! eq-quot: ( result1 result2 -- ? ) dup '[ @ [ dup [ class-of ] { } map-as ] dip '[ _ declare @ ] @@ -320,6 +327,9 @@ simd-classes&reps [ [ char-16{ 0 1 2 4 8 1 2 4 8 1 2 4 8 1 2 4 } ] [ char-16{ 1 2 4 8 1 2 4 8 1 2 4 8 1 2 4 8 } [ { char-16 } declare 1 hlshift ] compile-call ] unit-test +[ char-16{ 0 1 2 4 8 1 2 4 8 1 2 4 8 1 2 4 } ] +[ char-16{ 1 2 4 8 1 2 4 8 1 2 4 8 1 2 4 8 } [ { char-16 } declare 1 >bignum hlshift ] compile-call ] unit-test + [ char-16{ 0 1 2 4 8 1 2 4 8 1 2 4 8 1 2 4 } ] [ char-16{ 1 2 4 8 1 2 4 8 1 2 4 8 1 2 4 8 } 1 [ { char-16 fixnum } declare hlshift ] compile-call ] unit-test @@ -329,9 +339,21 @@ simd-classes&reps [ [ char-16{ 2 4 8 1 2 4 8 1 2 4 8 1 2 4 8 0 } ] [ char-16{ 1 2 4 8 1 2 4 8 1 2 4 8 1 2 4 8 } [ { char-16 } declare 1 hrshift ] compile-call ] unit-test +[ char-16{ 2 4 8 1 2 4 8 1 2 4 8 1 2 4 8 0 } ] +[ char-16{ 1 2 4 8 1 2 4 8 1 2 4 8 1 2 4 8 } [ { char-16 } declare 1 >bignum hrshift ] compile-call ] unit-test + [ char-16{ 2 4 8 1 2 4 8 1 2 4 8 1 2 4 8 0 } ] [ char-16{ 1 2 4 8 1 2 4 8 1 2 4 8 1 2 4 8 } 1 [ { char-16 fixnum } declare hrshift ] compile-call ] unit-test +[ int-4{ 4 8 12 16 } ] +[ int-4{ 1 2 3 4 } 2 vlshift ] unit-test + +[ int-4{ 4 8 12 16 } ] +[ int-4{ 1 2 3 4 } 2 [ { int-4 fixnum } declare vlshift ] compile-call ] unit-test + +[ int-4{ 4 8 12 16 } ] +[ int-4{ 1 2 3 4 } 2 >bignum [ { int-4 bignum } declare vlshift ] 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 @@ -510,7 +532,7 @@ TUPLE: inconsistent-vector-test bool branch ; ! Test element access -- it should box bignums for int-4 on x86 : test-accesses ( seq -- failures ) - [ length iota >array ] keep + [ length iota dup [ >bignum ] map append ] keep '[ [ _ 1quotation ] dip '[ _ swap nth ] ] [ = ] check-optimizer ; inline [ { } ] [ float-4{ 1.0 2.0 3.0 4.0 } test-accesses ] unit-test diff --git a/basis/math/vectors/simd/simd.factor b/basis/math/vectors/simd/simd.factor index dcd200ee08..a0d949fb68 100644 --- a/basis/math/vectors/simd/simd.factor +++ b/basis/math/vectors/simd/simd.factor @@ -75,35 +75,40 @@ DEFER: simd-construct-op : v->v-op ( a rep quot: ( (a) rep -- (c) ) fallback-quot -- c ) drop [ simd-unbox ] 2dip 2curry make-underlying ; inline -: vn->v-op ( a n rep quot: ( (a) n rep -- (c) ) fallback-quot -- c ) +: vx->v-op ( a obj rep quot: ( (a) obj rep -- (c) ) fallback-quot -- c ) drop [ simd-unbox ] 3dip 3curry make-underlying ; inline -: vn->n-op ( a n rep quot: ( (a) n rep -- n ) fallback-quot -- n ) +: vn->v-op ( a n rep quot: ( (a) n rep -- (c) ) fallback-quot -- c ) + drop [ [ simd-unbox ] [ >fixnum ] bi* ] 2dip 3curry make-underlying ; inline + +: vx->x-op ( a obj rep quot: ( (a) obj rep -- obj ) fallback-quot -- obj ) drop [ underlying>> ] 3dip call ; inline -: v->n-op ( a rep quot: ( (a) rep -- n ) fallback-quot -- n ) +: v->x-op ( a rep quot: ( (a) rep -- obj ) fallback-quot -- obj ) drop [ underlying>> ] 2dip call ; inline : (vv->v-op) ( a b rep quot: ( (a) (b) rep -- (c) ) -- c ) [ [ simd-unbox ] [ underlying>> ] bi* ] 2dip 3curry make-underlying ; inline -: (vv->n-op) ( a b rep quot: ( (a) (b) rep -- n ) -- n ) + +: (vv->x-op) ( a b rep quot: ( (a) (b) rep -- n ) -- n ) [ [ underlying>> ] bi@ ] 2dip 3curry call ; inline -: (vvn->v-op) ( a b n rep quot: ( (a) (b) n rep -- (c) ) -- c ) + +: (vvx->v-op) ( a b obj rep quot: ( (a) (b) obj rep -- (c) ) -- c ) [ [ simd-unbox ] [ underlying>> ] bi* ] 3dip 2curry 2curry make-underlying ; inline : vv->v-op ( a b rep quot: ( (a) (b) rep -- (c) ) fallback-quot -- c ) [ '[ _ (vv->v-op) ] ] [ '[ drop @ ] ] bi* if-both-vectors-match ; inline -:: vvn->v-op ( a b n rep quot: ( (a) (b) n rep -- (c) ) fallback-quot -- c ) +:: vvx->v-op ( a b obj rep quot: ( (a) (b) obj rep -- (c) ) fallback-quot -- c ) a b rep - [ n swap quot (vvn->v-op) ] - [ drop n fallback-quot call ] if-both-vectors-match ; inline + [ obj swap quot (vvx->v-op) ] + [ drop obj fallback-quot call ] if-both-vectors-match ; inline : vv'->v-op ( a b rep quot: ( (a) (b) rep -- (c) ) fallback-quot -- c ) [ '[ _ (vv->v-op) ] ] [ '[ drop @ ] ] bi* if-both-vectors ; inline -: vv->n-op ( a b rep quot: ( (a) (b) rep -- n ) fallback-quot -- n ) - [ '[ _ (vv->n-op) ] ] [ '[ drop @ ] ] bi* if-both-vectors-match ; inline +: vv->x-op ( a b rep quot: ( (a) (b) rep -- obj ) fallback-quot -- obj ) + [ '[ _ (vv->x-op) ] ] [ '[ drop @ ] ] bi* if-both-vectors-match ; inline PRIVATE> >> @@ -153,13 +158,13 @@ M: simd-128 vmin M: simd-128 vmax dup simd-rep [ (simd-vmax) ] [ call-next-method ] vv->v-op ; inline M: simd-128 v. - dup simd-rep [ (simd-v.) ] [ call-next-method ] vv->n-op ; inline + dup simd-rep [ (simd-v.) ] [ call-next-method ] vv->x-op ; inline M: simd-128 vsad - dup simd-rep [ (simd-vsad) ] [ call-next-method ] vv->n-op ; inline + dup simd-rep [ (simd-vsad) ] [ call-next-method ] vv->x-op ; inline M: simd-128 vsqrt dup simd-rep [ (simd-vsqrt) ] [ call-next-method ] v->v-op ; inline M: simd-128 sum - dup simd-rep [ (simd-sum) ] [ call-next-method ] v->n-op ; inline + dup simd-rep [ (simd-sum) ] [ call-next-method ] v->x-op ; inline M: simd-128 vabs dup simd-rep [ (simd-vabs) ] [ call-next-method ] v->v-op ; inline M: simd-128 vbitand @@ -191,9 +196,9 @@ M: simd-128 hlshift M: simd-128 hrshift over simd-rep [ (simd-hrshift) ] [ call-next-method ] vn->v-op ; inline M: simd-128 vshuffle-elements - over simd-rep [ (simd-vshuffle-elements) ] [ call-next-method ] vn->v-op ; inline + over simd-rep [ (simd-vshuffle-elements) ] [ call-next-method ] vx->v-op ; inline M: simd-128 vshuffle2-elements - over simd-rep [ (simd-vshuffle2-elements) ] [ call-next-method ] vvn->v-op ; inline + over simd-rep [ (simd-vshuffle2-elements) ] [ call-next-method ] vvx->v-op ; inline M: simd-128 vshuffle-bytes dup simd-rep [ (simd-vshuffle-bytes) ] [ call-next-method ] vv'->v-op ; inline M: simd-128 (vmerge-head) @@ -213,11 +218,11 @@ M: simd-128 v>= M: simd-128 vunordered? dup simd-rep [ (simd-vunordered?) ] [ call-next-method ] vv->v-op ; inline M: simd-128 vany? - dup simd-rep [ (simd-vany?) ] [ call-next-method ] v->n-op ; inline + dup simd-rep [ (simd-vany?) ] [ call-next-method ] v->x-op ; inline M: simd-128 vall? - dup simd-rep [ (simd-vall?) ] [ call-next-method ] v->n-op ; inline + dup simd-rep [ (simd-vall?) ] [ call-next-method ] v->x-op ; inline M: simd-128 vnone? - dup simd-rep [ (simd-vnone?) ] [ call-next-method ] v->n-op ; inline + dup simd-rep [ (simd-vnone?) ] [ call-next-method ] v->x-op ; inline ! SIMD high-level specializations @@ -266,7 +271,7 @@ M: A simd-element-type drop ELT ; inline M: A simd-with drop A-with ; inline M: A nth-unsafe - swap \ A-rep [ (simd-select) ] [ call-next-method ] vn->n-op ; inline + swap \ A-rep [ (simd-select) ] [ call-next-method ] vx->x-op ; inline M: A set-nth-unsafe [ ELT boolean>element ] 2dip underlying>> ELT c:set-alien-element ; inline