diff --git a/basis/compiler/cfg/intrinsics/simd/simd.factor b/basis/compiler/cfg/intrinsics/simd/simd.factor index a96a0b7cb3..109ac6ce8e 100644 --- a/basis/compiler/cfg/intrinsics/simd/simd.factor +++ b/basis/compiler/cfg/intrinsics/simd/simd.factor @@ -253,14 +253,15 @@ IN: compiler.cfg.intrinsics.simd src rep ^unpack-vector-head :> head src rep ^unpack-vector-tail :> tail rep widen-vector-rep :> wide-rep - head tail wide-rep ^^add-vector wide-rep ^(sum-vector) + head tail wide-rep ^^add-vector wide-rep + ^(sum-vector) ] } } v-vector-op ; : shuffle? ( obj -- ? ) { [ array? ] [ [ integer? ] all? ] } 1&& ; -: ^shuffle-vector-imm ( src1 src2 rep -- dst ) - { +: ^shuffle-vector-imm ( src1 shuffle rep -- dst ) + [ rep-length 0 pad-tail ] keep { [ ^^shuffle-vector-imm ] [ [ ^load-immediate-shuffle ] [ ^^shuffle-vector ] bi ] } vl-vector-op ; @@ -358,7 +359,7 @@ IN: compiler.cfg.intrinsics.simd : emit-simd-v. ( node -- ) { [ ^^dot-vector ] - [ [ ^^mul-vector ] [ ^sum-vector ] bi ] + { float-vector-rep [ [ ^^mul-vector ] [ ^sum-vector ] bi ] } } emit-vv-vector-op ; : emit-simd-vsqrt ( node -- ) diff --git a/basis/math/vectors/simd/intrinsics/intrinsics.factor b/basis/math/vectors/simd/intrinsics/intrinsics.factor index a236db00c9..187c6db586 100644 --- a/basis/math/vectors/simd/intrinsics/intrinsics.factor +++ b/basis/math/vectors/simd/intrinsics/intrinsics.factor @@ -112,8 +112,8 @@ IN: math.vectors.simd.intrinsics a rep >rep-array :> a' rep :> c' elts [| from to | - from a' nth-unsafe - rep rep-length 1 - bitand + from rep rep-length 1 - bitand + a' nth-unsafe to c' set-nth-unsafe ] each-index c' underlying>> ; inline @@ -134,9 +134,12 @@ PRIVATE> n 1 + c' set-nth-unsafe ] each c' underlying>> ; -: (simd-vs+) ( a b rep -- c ) dup '[ + _ c-type-clamp ] components-2map ; -: (simd-vs-) ( a b rep -- c ) dup '[ - _ c-type-clamp ] components-2map ; -: (simd-vs*) ( a b rep -- c ) dup '[ - _ c-type-clamp ] components-2map ; +: (simd-vs+) ( a b rep -- c ) + dup rep-component-type '[ + _ c-type-clamp ] components-2map ; +: (simd-vs-) ( a b rep -- c ) + dup rep-component-type '[ - _ c-type-clamp ] components-2map ; +: (simd-vs*) ( a b rep -- c ) + dup rep-component-type '[ * _ c-type-clamp ] components-2map ; : (simd-v*) ( a b rep -- c ) [ * ] components-2map ; : (simd-v/) ( a b rep -- c ) [ / ] components-2map ; : (simd-vmin) ( a b rep -- c ) [ min ] components-2map ; @@ -160,9 +163,9 @@ PRIVATE> : (simd-vlshift) ( a n rep -- c ) swap '[ _ shift ] bitwise-components-map ; : (simd-vrshift) ( a n rep -- c ) swap '[ _ neg shift ] bitwise-components-map ; : (simd-hlshift) ( a n rep -- c ) - drop tail-slice 16 0 pad-tail ; + drop head-slice* 16 0 pad-head ; : (simd-hrshift) ( a n rep -- c ) - drop head-slice 16 0 pad-head ; + drop tail-slice 16 0 pad-tail ; : (simd-vshuffle-elements) ( a n rep -- c ) [ rep-length 0 pad-tail ] keep (vshuffle) ; : (simd-vshuffle-bytes) ( a b rep -- c ) drop uchar-16-rep (vshuffle) ; :: (simd-vmerge-head) ( a b rep -- c ) @@ -198,17 +201,17 @@ PRIVATE> : (simd-vall?) ( a rep -- ? ) [ bitand ] bitwise-components-reduce zero? not ; : (simd-vnone?) ( a rep -- ? ) [ bitor ] bitwise-components-reduce zero? ; : (simd-v>float) ( a rep -- c ) - [ >rep-array ] [ >float-vector-rep [>rep-array] ] bi call( i -- f ) ; + [ >rep-array ] [ >float-vector-rep [>rep-array] ] bi call( i -- f ) underlying>> ; : (simd-v>integer) ( a rep -- c ) - [ >rep-array ] [ >int-vector-rep [>rep-array] ] bi call( i -- f ) ; + [ >rep-array ] [ >int-vector-rep [>rep-array] ] bi call( i -- f ) underlying>> ; : (simd-vpack-signed) ( a b rep -- c ) [ 2>rep-array cord-append ] [ narrow-vector-rep [ [] ] [ rep-component-type ] bi ] bi - '[ _ c-type-clamp ] swap map-as ; + '[ _ c-type-clamp ] swap map-as underlying>> ; : (simd-vpack-unsigned) ( a b rep -- c ) [ 2>rep-array cord-append ] [ narrow-vector-rep >uint-vector-rep [ [] ] [ rep-component-type ] bi ] bi - '[ _ c-type-clamp ] swap map-as ; + '[ _ c-type-clamp ] swap map-as underlying>> ; : (simd-vunpack-head) ( a rep -- c ) [ >rep-array ] [ widen-vector-rep [ rep-length ] [ [>rep-array] ] bi ] bi [ head-slice ] dip call( a' -- c' ) underlying>> ; @@ -216,7 +219,8 @@ PRIVATE> [ >rep-array ] [ widen-vector-rep [ rep-length ] [ [>rep-array] ] bi ] bi [ tail-slice ] dip call( a' -- c' ) underlying>> ; : (simd-with) ( n rep -- v ) - [ rep-length iota swap '[ _ ] ] [ ] bi replicate-as ; + [ rep-length iota swap '[ _ ] ] [ ] bi replicate-as + underlying>> ; : (simd-gather-2) ( m n rep -- v ) [ 2 set-firstn ] keep underlying>> ; : (simd-gather-4) ( m n o p rep -- v ) [ 4 set-firstn ] keep underlying>> ; : (simd-select) ( a n rep -- x ) [ swap ] dip >rep-array nth-unsafe ; diff --git a/basis/math/vectors/simd/simd-tests.factor b/basis/math/vectors/simd/simd-tests.factor index 1fb947921c..b590589345 100644 --- a/basis/math/vectors/simd/simd-tests.factor +++ b/basis/math/vectors/simd/simd-tests.factor @@ -5,7 +5,8 @@ math.vectors.simd.private prettyprint random sequences system tools.test vocabs assocs compiler.cfg.debugger words locals combinators cpu.architecture namespaces byte-arrays alien specialized-arrays classes.struct eval classes.algebra sets -quotations math.constants compiler.units ; +quotations math.constants compiler.units splitting ; +FROM: math.vectors.simd.intrinsics => alien-vector set-alien-vector ; QUALIFIED-WITH: alien.c-types c SPECIALIZED-ARRAY: c:float IN: math.vectors.simd.tests @@ -261,8 +262,8 @@ simd-classes&reps [ : check-boolean-ops ( class elt-class compare-quot -- seq ) [ - [ boolean-ops [ dup word-schema ] { } map>assoc ] 2dip - '[ first2 inputs _ _ check-boolean-op ] + [ boolean-ops [ dup vector-words at ] { } map>assoc ] 2dip + '[ first2 vector-word-inputs _ _ check-boolean-op ] ] dip check-optimizer ; inline simd-classes&reps [ @@ -558,7 +559,7 @@ STRUCT: simd-struct [ ] [ char-16 new 1array stack. ] unit-test ! CSSA bug -[ 8000000 ] [ +[ 4000000 ] [ int-4{ 1000 1000 1000 1000 } [ { int-4 } declare dup [ * ] [ + ] 2map-reduce ] compile-call ] unit-test diff --git a/basis/math/vectors/simd/simd.factor b/basis/math/vectors/simd/simd.factor index 5289f3f393..bde69b5dbd 100644 --- a/basis/math/vectors/simd/simd.factor +++ b/basis/math/vectors/simd/simd.factor @@ -49,6 +49,9 @@ TUPLE: simd-128 GENERIC: simd-element-type ( obj -- c-type ) GENERIC: simd-rep ( simd -- rep ) +M: object simd-element-type drop f ; +M: object simd-rep drop f ; + << > ] bi ; inline @@ -74,6 +74,9 @@ DEFER: simd-construct-op : vn->v-op ( a n rep quot: ( (a) n 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 ) + drop [ underlying>> ] 3dip call ; inline + : v->n-op ( a rep quot: ( (a) rep -- n ) fallback-quot -- n ) drop [ underlying>> ] 2dip call ; inline @@ -95,9 +98,6 @@ DEFER: simd-construct-op PRIVATE> >> -DEFER: simd-with -DEFER: simd-cast - << A ] unless ; inline -: A-with ( n -- v ) \ A new simd-with ; inline -: A-cast ( v -- v' ) \ A new simd-cast ; inline +: A-with ( n -- v ) COERCER call \ A-rep (simd-with) \ A boa ; inline +: A-cast ( v -- v' ) underlying>> \ A boa ; inline ! SIMD vectors as sequences @@ -145,24 +146,7 @@ M: A hashcode* underlying>> hashcode* ; inline M: A clone [ clone ] change-underlying ; inline M: A length drop N ; inline M: A nth-unsafe - swap { - { 0 [ 0 \ A-rep (simd-select) ] } - { 1 [ 1 \ A-rep (simd-select) ] } - { 2 [ 2 \ A-rep (simd-select) ] } - { 3 [ 3 \ A-rep (simd-select) ] } - { 4 [ 4 \ A-rep (simd-select) ] } - { 5 [ 5 \ A-rep (simd-select) ] } - { 6 [ 6 \ A-rep (simd-select) ] } - { 7 [ 7 \ A-rep (simd-select) ] } - { 8 [ 8 \ A-rep (simd-select) ] } - { 9 [ 9 \ A-rep (simd-select) ] } - { 10 [ 10 \ A-rep (simd-select) ] } - { 11 [ 11 \ A-rep (simd-select) ] } - { 12 [ 12 \ A-rep (simd-select) ] } - { 13 [ 13 \ A-rep (simd-select) ] } - { 14 [ 14 \ A-rep (simd-select) ] } - { 15 [ 15 \ A-rep (simd-select) ] } - } case ; inline + swap \ A-rep [ (simd-select) ] [ call-next-method ] vn->n-op ; inline M: A c:byte-length drop 16 ; inline M: A new-sequence @@ -171,7 +155,7 @@ M: A new-sequence [ length bad-simd-length ] if ; inline M: A equal? - \ A [ drop v= vall? ] [ 3drop f ] if-both-vectors-match ; inline + \ A-rep [ drop v= vall? ] [ 3drop f ] if-both-vectors-match ; inline ! SIMD primitive operations @@ -205,7 +189,7 @@ M: A vrshift \ A-rep [ (simd-vrshift) ] [ call-next-method ] M: A hlshift \ A-rep [ (simd-hlshift) ] [ call-next-method ] vn->v-op ; inline M: A hrshift \ A-rep [ (simd-hrshift) ] [ call-next-method ] vn->v-op ; inline M: A vshuffle-elements \ A-rep [ (simd-vshuffle-elements) ] [ call-next-method ] vn->v-op ; inline -M: A vshuffle-bytes \ A-rep [ (simd-vshuffle-bytes) ] [ call-next-method ] vv->v-op ; inline +M: A vshuffle-bytes \ A-rep [ (simd-vshuffle-bytes) ] [ call-next-method ] vv'->v-op ; inline M: A (vmerge-head) \ A-rep [ (simd-vmerge-head) ] [ call-next-method ] vv->v-op ; inline M: A (vmerge-tail) \ A-rep [ (simd-vmerge-tail) ] [ call-next-method ] vv->v-op ; inline M: A v<= \ A-rep [ (simd-v<=) ] [ call-next-method ] vv->v-op ; inline @@ -220,15 +204,15 @@ M: A vnone? \ A-rep [ (simd-vnone?) ] [ call-next-method ] ! SIMD high-level specializations -M: A vbroadcast [ swap nth ] keep simd-with ; inline -M: A n+v [ simd-with ] keep v+ ; inline -M: A n-v [ simd-with ] keep v- ; inline -M: A n*v [ simd-with ] keep v* ; inline -M: A n/v [ simd-with ] keep v/ ; inline -M: A v+n over simd-with v+ ; inline -M: A v-n over simd-with v- ; inline -M: A v*n over simd-with v* ; inline -M: A v/n over simd-with v/ ; inline +M: A vbroadcast swap nth A-with ; inline +M: A n+v [ A-with ] dip v+ ; inline +M: A n-v [ A-with ] dip v- ; inline +M: A n*v [ A-with ] dip v* ; inline +M: A n/v [ A-with ] dip v/ ; inline +M: A v+n A-with v+ ; inline +M: A v-n A-with v- ; inline +M: A v*n A-with v* ; inline +M: A v/n A-with v/ ; inline M: A norm-sq dup v. assert-positive ; inline M: A norm norm-sq sqrt ; inline M: A distance v- norm ; inline @@ -236,11 +220,13 @@ M: A distance v- norm ; inline ! M: simd-128 >pprint-sequence ; ! M: simd-128 pprint* pprint-object ; -\ A-boa \ A new N { - { 2 [ '[ _ [ (simd-gather-2) ] simd-construct-op ] ] } - { 4 [ '[ _ [ (simd-gather-4) ] simd-construct-op ] ] } - [ swap '[ _ _ nsequence ] ] -} case BOA-EFFECT define-inline +\ A-boa +[ COERCER N napply ] N { + { 2 [ [ A-rep (simd-gather-2) A boa ] ] } + { 4 [ [ A-rep (simd-gather-4) A boa ] ] } + [ \ A new '[ _ _ nsequence ] ] +} case compose +BOA-EFFECT define-inline M: A pprint-delims drop \ A{ \ } ; SYNTAX: A{ \ } [ >A ] parse-literal ; @@ -248,7 +234,7 @@ SYNTAX: A{ \ } [ >A ] parse-literal ; c: byte-array >>class A >>boxed-class - [ A-rep alien-vector \ A boa ] >>getter + [ A-rep alien-vector A boa ] >>getter [ [ underlying>> ] 2dip A-rep set-alien-vector ] >>setter 16 >>size 16 >>align @@ -266,21 +252,6 @@ PRIVATE> INSTANCE: simd-128 sequence -! SIMD constructors - -: simd-with ( n seq -- v ) - [ (simd-with) ] simd-construct-op ; inline - -MACRO: simd-boa ( class -- ) - new dup length { - { 2 [ '[ _ [ (simd-gather-2) ] simd-construct-op ] ] } - { 4 [ '[ _ [ (simd-gather-4) ] simd-construct-op ] ] } - [ swap '[ _ _ nsequence ] ] - } case ; - -: simd-cast ( v seq -- v' ) - [ underlying>> ] dip new-underlying ; inline - ! SIMD instances SIMD-128: char-16 diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor index d524ba309f..c0b129e6d2 100644 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@ -108,10 +108,6 @@ M: object vshuffle-elements swap [ '[ _ nth ] ] keep map-as ; GENERIC# vshuffle-bytes 1 ( u perm -- v ) -M: object vshuffle-bytes - underlying>> [ - swap [ '[ 15 bitand _ nth ] ] keep map-as - ] curry change-underlying ; GENERIC: vshuffle ( u perm -- v ) M: array vshuffle ( u perm -- v ) @@ -123,9 +119,7 @@ GENERIC# vrshift 1 ( u n -- w ) M: object vrshift neg '[ _ shift ] map ; GENERIC# hlshift 1 ( u n -- w ) -M: object hlshift '[ _ prepend 16 head ] change-underlying ; GENERIC# hrshift 1 ( u n -- w ) -M: object hrshift '[ _ append 16 tail* ] change-underlying ; GENERIC: (vmerge-head) ( u v -- h ) M: object (vmerge-head) over length 2 /i '[ _ head-slice ] bi@ [ zip ] keep concat-as ;