diff --git a/basis/compiler/cfg/comparisons/comparisons.factor b/basis/compiler/cfg/comparisons/comparisons.factor index e7c19e7206..0b4a6f2f02 100644 --- a/basis/compiler/cfg/comparisons/comparisons.factor +++ b/basis/compiler/cfg/comparisons/comparisons.factor @@ -9,6 +9,9 @@ SYMBOLS: cc< cc<= cc= cc> cc>= cc<> cc<>= cc/< cc/<= cc/= cc/> cc/>= cc/<> cc/<>= ; +SYMBOLS: + vcc-all vcc-notall vcc-any vcc-none ; + : negate-cc ( cc -- cc' ) H{ { cc< cc/< } @@ -27,6 +30,14 @@ SYMBOLS: { cc/<>= cc<>= } } at ; +: negate-vcc ( cc -- cc' ) + H{ + { vcc-all vcc-notall } + { vcc-any vcc-none } + { vcc-none vcc-any } + { vcc-notall vcc-all } + } at ; + : swap-cc ( cc -- cc' ) H{ { cc< cc> } diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 7b2d8ef9b8..6f4b6cb35b 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -276,6 +276,28 @@ def: dst use: src literal: shuffle rep ; +PURE-INSN: ##compare-vector +def: dst +use: src1 src2 +literal: rep cc ; + +PURE-INSN: ##test-vector +def: dst/int-rep +use: src1 +temp: temp/int-rep +literal: rep vcc ; + +INSN: ##test-vector-branch +use: src1 +temp: temp/int-rep +literal: rep vcc ; + +INSN: _test-vector-branch +literal: label +use: src1 +temp: temp/int-rep +literal: rep vcc ; + PURE-INSN: ##add-vector def: dst use: src1 src2 diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor index 76dace1f28..d8f34b4164 100644 --- a/basis/compiler/cfg/intrinsics/intrinsics.factor +++ b/basis/compiler/cfg/intrinsics/intrinsics.factor @@ -171,6 +171,10 @@ IN: compiler.cfg.intrinsics { math.vectors.simd.intrinsics:(simd-vbitandn) [ [ ^^andn-vector ] emit-binary-vector-op ] } { math.vectors.simd.intrinsics:(simd-vbitor) [ [ ^^or-vector ] emit-binary-vector-op ] } { math.vectors.simd.intrinsics:(simd-vbitxor) [ [ ^^xor-vector ] emit-binary-vector-op ] } + { math.vectors.simd.intrinsics:(simd-v=) [ [ cc= ^^compare-vector ] emit-binary-vector-op ] } + { math.vectors.simd.intrinsics:(simd-vany?) [ [ vcc-any ^^test-vector ] emit-unary-vector-op ] } + { math.vectors.simd.intrinsics:(simd-vall?) [ [ vcc-all ^^test-vector ] emit-unary-vector-op ] } + { math.vectors.simd.intrinsics:(simd-vnone?) [ [ vcc-none ^^test-vector ] emit-unary-vector-op ] } { math.vectors.simd.intrinsics:(simd-vlshift) [ [ ^^shl-vector ] emit-binary-vector-op ] } { math.vectors.simd.intrinsics:(simd-vrshift) [ [ ^^shr-vector ] emit-binary-vector-op ] } { math.vectors.simd.intrinsics:(simd-hlshift) [ [ ^^horizontal-shl-vector ] emit-horizontal-shift ] } diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor index 66ac1addb0..31a4247206 100755 --- a/basis/compiler/cfg/linearization/linearization.factor +++ b/basis/compiler/cfg/linearization/linearization.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel math accessors sequences namespaces make combinators assocs arrays locals layouts hashtables -cpu.architecture +cpu.architecture generalizations compiler.cfg compiler.cfg.comparisons compiler.cfg.stack-frame @@ -42,14 +42,26 @@ M: ##branch linearize-insn : successors ( bb -- first second ) successors>> first2 ; inline +:: conditional ( bb insn n conditional-quot negate-cc-quot -- bb successor label ... ) + bb insn + conditional-quot + [ drop dup successors>> second useless-branch? ] 2bi + [ [ swap block-number ] n ndip ] + [ [ block-number ] n ndip negate-cc-quot call ] if ; inline + : (binary-conditional) ( bb insn -- bb successor1 successor2 src1 src2 cc ) [ dup successors ] [ [ src1>> ] [ src2>> ] [ cc>> ] tri ] bi* ; inline : binary-conditional ( bb insn -- bb successor label2 src1 src2 cc ) - [ (binary-conditional) ] - [ drop dup successors>> second useless-branch? ] 2bi - [ [ swap block-number ] 3dip ] [ [ block-number ] 3dip negate-cc ] if ; + 3 [ (binary-conditional) ] [ negate-cc ] conditional ; + +: (test-vector-conditional) ( bb insn -- bb successor1 successor2 src1 temp rep vcc ) + [ dup successors ] + [ { [ src1>> ] [ temp>> ] [ rep>> ] [ vcc>> ] } cleave ] bi* ; inline + +: test-vector-conditional ( bb insn -- bb successor label src1 temp rep vcc ) + 4 [ (test-vector-conditional) ] [ negate-vcc ] conditional ; M: ##compare-branch linearize-insn binary-conditional _compare-branch emit-branch ; @@ -63,6 +75,9 @@ M: ##compare-float-ordered-branch linearize-insn M: ##compare-float-unordered-branch linearize-insn binary-conditional _compare-float-unordered-branch emit-branch ; +M: ##test-vector-branch linearize-insn + test-vector-conditional _test-vector-branch emit-branch ; + : overflow-conditional ( bb insn -- bb successor label2 dst src1 src2 ) [ dup successors block-number ] [ [ dst>> ] [ src1>> ] [ src2>> ] tri ] bi* ; inline diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor index 8e5e013606..9827e02bf5 100755 --- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor +++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor @@ -40,6 +40,7 @@ M: insn rewrite drop f ; [ compare-imm-expr? ] [ compare-float-unordered-expr? ] [ compare-float-ordered-expr? ] + [ test-vector-expr? ] } 1|| ; : rewrite-boolean-comparison? ( insn -- ? ) @@ -53,12 +54,21 @@ M: insn rewrite drop f ; : >compare-imm-expr< ( expr -- in1 in2 cc ) [ src1>> vn>vreg ] [ src2>> vn>constant ] [ cc>> ] tri ; inline +: >test-vector-expr< ( expr -- src1 temp rep vcc ) + { + [ src1>> vn>vreg ] + [ drop next-vreg ] + [ rep>> ] + [ vcc>> ] + } cleave ; inline + : rewrite-boolean-comparison ( expr -- insn ) src1>> vreg>expr { { [ dup compare-expr? ] [ >compare-expr< \ ##compare-branch new-insn ] } { [ dup compare-imm-expr? ] [ >compare-imm-expr< \ ##compare-imm-branch new-insn ] } { [ dup compare-float-unordered-expr? ] [ >compare-expr< \ ##compare-float-unordered-branch new-insn ] } { [ dup compare-float-ordered-expr? ] [ >compare-expr< \ ##compare-float-ordered-branch new-insn ] } + { [ dup test-vector-expr? ] [ >test-vector-expr< \ ##test-vector-branch new-insn ] } } cond ; : tag-fixnum-expr? ( expr -- ? ) diff --git a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor index f81a672108..00e2d33fb4 100644 --- a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor +++ b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor @@ -14,6 +14,8 @@ IN: compiler.cfg.value-numbering.tests [ ##compare-imm? ] [ ##compare-float-unordered? ] [ ##compare-float-ordered? ] + [ ##test-vector? ] + [ ##test-vector-branch? ] } 1|| [ f >>temp ] when ] map ; @@ -137,6 +139,22 @@ IN: compiler.cfg.value-numbering.tests } value-numbering-step trim-temps ] unit-test +[ + { + T{ ##peek f 1 D -1 } + T{ ##unbox-vector f 1111 1 float-4-rep } + T{ ##test-vector f 1 1111 f float-4-rep vcc-any } + T{ ##test-vector-branch f 1111 f float-4-rep vcc-any } + } +] [ + { + T{ ##peek f 1 D -1 } + T{ ##unbox-vector f 1111 1 float-4-rep } + T{ ##test-vector f 1 1111 2 float-4-rep vcc-any } + T{ ##compare-imm-branch f 1 5 cc/= } + } value-numbering-step trim-temps +] unit-test + ! Immediate operand conversion [ { diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 7689862347..6352401bfd 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -163,6 +163,8 @@ CODEGEN: ##zero-vector %zero-vector CODEGEN: ##gather-vector-2 %gather-vector-2 CODEGEN: ##gather-vector-4 %gather-vector-4 CODEGEN: ##shuffle-vector %shuffle-vector +CODEGEN: ##compare-vector %compare-vector +CODEGEN: ##test-vector %test-vector CODEGEN: ##add-vector %add-vector CODEGEN: ##saturated-add-vector %saturated-add-vector CODEGEN: ##add-sub-vector %add-sub-vector @@ -229,6 +231,7 @@ CODEGEN: _compare-branch %compare-branch CODEGEN: _compare-imm-branch %compare-imm-branch CODEGEN: _compare-float-ordered-branch %compare-float-ordered-branch CODEGEN: _compare-float-unordered-branch %compare-float-unordered-branch +CODEGEN: _test-vector-branch %test-vector-branch CODEGEN: _dispatch %dispatch CODEGEN: _spill %spill CODEGEN: _reload %reload diff --git a/basis/compiler/tree/propagation/simd/simd.factor b/basis/compiler/tree/propagation/simd/simd.factor index e2c2b15f2d..c8be614886 100644 --- a/basis/compiler/tree/propagation/simd/simd.factor +++ b/basis/compiler/tree/propagation/simd/simd.factor @@ -25,6 +25,7 @@ IN: compiler.tree.propagation.simd (simd-hlshift) (simd-hrshift) (simd-vshuffle) + (simd-v=) (simd-with) (simd-gather-2) (simd-gather-4) @@ -45,6 +46,12 @@ IN: compiler.tree.propagation.simd \ (simd-v.) [ 2nip scalar-output-class ] "outputs" set-word-prop +{ + (simd-vany?) + (simd-vall?) + (simd-vnone?) +} [ { boolean } "default-output-classes" set-word-prop ] each + \ (simd-select) [ 2nip scalar-output-class ] "outputs" set-word-prop \ assert-positive [ diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index dc1c2eeb0c..eecfd13e66 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -217,6 +217,9 @@ HOOK: %zero-vector cpu ( dst rep -- ) HOOK: %gather-vector-2 cpu ( dst src1 src2 rep -- ) HOOK: %gather-vector-4 cpu ( dst src1 src2 src3 src4 rep -- ) HOOK: %shuffle-vector cpu ( dst src shuffle rep -- ) +HOOK: %compare-vector cpu ( dst src1 src2 rep cc -- ) +HOOK: %test-vector cpu ( dst src1 temp rep vcc -- ) +HOOK: %test-vector-branch cpu ( label src1 temp rep vcc -- ) HOOK: %add-vector cpu ( dst src1 src2 rep -- ) HOOK: %saturated-add-vector cpu ( dst src1 src2 rep -- ) HOOK: %add-sub-vector cpu ( dst src1 src2 rep -- ) @@ -250,6 +253,8 @@ HOOK: %zero-vector-reps cpu ( -- reps ) HOOK: %gather-vector-2-reps cpu ( -- reps ) HOOK: %gather-vector-4-reps cpu ( -- reps ) HOOK: %shuffle-vector-reps cpu ( -- reps ) +HOOK: %compare-vector-reps cpu ( -- reps ) +HOOK: %test-vector-reps cpu ( -- reps ) HOOK: %add-vector-reps cpu ( -- reps ) HOOK: %saturated-add-vector-reps cpu ( -- reps ) HOOK: %add-sub-vector-reps cpu ( -- reps ) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 67a65b8ecd..7336d22544 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -261,6 +261,8 @@ M: ppc %zero-vector-reps { } ; M: ppc %gather-vector-2-reps { } ; M: ppc %gather-vector-4-reps { } ; M: ppc %shuffle-vector-reps { } ; +M: ppc %compare-vector-reps { } ; +M: ppc %test-vector-reps { } ; M: ppc %add-vector-reps { } ; M: ppc %saturated-add-vector-reps { } ; M: ppc %add-sub-vector-reps { } ; diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 71d76a1ce5..48c97e9322 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -708,6 +708,65 @@ M: x86 %shuffle-vector-reps { sse2? { double-2-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } } } available-reps ; +: %compare-vector-equal ( dst src rep -- ) + unsign-rep { + { double-2-rep [ CMPEQPD ] } + { float-4-rep [ CMPEQPS ] } + { longlong-2-rep [ PCMPEQQ ] } + { int-4-rep [ PCMPEQD ] } + { short-8-rep [ PCMPEQW ] } + { char-16-rep [ PCMPEQB ] } + } case ; + +M: x86 %compare-vector ( dst src1 src2 rep cc -- ) + [ [ two-operand ] keep ] dip { + { cc= [ %compare-vector-equal ] } + } case ; + +M: x86 %compare-vector-reps + { + { sse? { float-4-rep } } + { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep } } + { sse4.1? { longlong-2-rep ulonglong-2-rep } } + } available-reps ; + +:: %test-vector-mask ( dst temp mask vcc -- ) + vcc { + { vcc-any [ dst dst TEST dst temp \ CMOVNE %boolean ] } + { vcc-none [ dst dst TEST dst temp \ CMOVE %boolean ] } + { vcc-all [ dst mask CMP dst temp \ CMOVE %boolean ] } + { vcc-notall [ dst mask CMP dst temp \ CMOVNE %boolean ] } + } case ; + +: %move-vector-mask ( dst src rep -- mask ) + { + { double-2-rep [ MOVMSKPD HEX: 3 ] } + { float-4-rep [ MOVMSKPS HEX: f ] } + [ drop PMOVMSKB HEX: ffff ] + } case ; + +M:: x86 %test-vector ( dst src temp rep vcc -- ) + dst src rep %move-vector-mask :> mask + dst temp mask vcc %test-vector-mask ; + +:: %test-vector-mask-branch ( label temp mask vcc -- ) + vcc { + { vcc-any [ temp temp TEST label JNE ] } + { vcc-none [ temp temp TEST label JE ] } + { vcc-all [ temp mask CMP label JE ] } + { vcc-notall [ temp mask CMP label JNE ] } + } case ; + +M:: x86 %test-vector-branch ( label src temp rep vcc -- ) + temp src rep %move-vector-mask :> mask + label temp mask vcc %test-vector-mask-branch ; + +M: x86 %test-vector-reps + { + { sse? { float-4-rep } } + { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } } + } available-reps ; + M: x86 %add-vector ( dst src1 src2 rep -- ) [ two-operand ] keep { diff --git a/basis/math/vectors/simd/functor/functor.factor b/basis/math/vectors/simd/functor/functor.factor index ad45a2c902..878d4aea70 100644 --- a/basis/math/vectors/simd/functor/functor.factor +++ b/basis/math/vectors/simd/functor/functor.factor @@ -1,17 +1,37 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs byte-arrays classes effects fry +USING: accessors assocs byte-arrays classes classes.algebra effects fry functors generalizations kernel literals locals math math.functions math.vectors math.vectors.private math.vectors.simd.intrinsics math.vectors.specialization parser prettyprint.custom sequences sequences.private strings words definitions macros cpu.architecture -namespaces arrays quotations combinators sets layouts ; +namespaces arrays quotations combinators combinators.short-circuit sets +layouts ; QUALIFIED-WITH: alien.c-types c QUALIFIED: math.private IN: math.vectors.simd.functor ERROR: bad-length got expected ; +: vector-true-value ( class -- value ) + { + { [ dup integer class<= ] [ drop -1 ] } + { [ dup float class<= ] [ drop -1 bits>double ] } + } cond ; foldable + +: vector-false-value ( class -- value ) + { + { [ dup integer class<= ] [ drop 0 ] } + { [ dup float class<= ] [ drop 0.0 ] } + } cond ; foldable + +: boolean>element ( bool/elt class -- elt ) + swap { + { t [ vector-true-value ] } + { f [ vector-false-value ] } + [ nip ] + } case ; inline + MACRO: simd-boa ( rep class -- simd-array ) [ rep-components ] [ new ] bi* '[ _ _ nsequence ] ; @@ -72,14 +92,17 @@ MACRO: simd-nth ( rep -- x ) '[ nip _ swap supported-simd-op? ] assoc-filter '[ drop _ key? ] assoc-filter ; -ERROR: bad-schema schema ; +ERROR: bad-schema op schema ; -: low-level-ops ( simd-ops alist -- alist' ) - '[ - 1quotation - over word-schema _ ?at [ bad-schema ] unless - [ ] 2sequence - ] assoc-map ; +:: op-wrapper ( op specials schemas -- wrapper ) + op { + [ specials at ] + [ word-schema schemas at ] + [ dup word-schema bad-schema ] + } 1|| ; + +: low-level-ops ( simd-ops specials schemas -- alist ) + '[ 1quotation over _ _ op-wrapper [ ] 2sequence ] assoc-map ; :: high-level-ops ( ctor elt-class -- assoc ) ! Some SIMD operations are defined in terms of others. @@ -103,14 +126,14 @@ ERROR: bad-schema schema ; ! in the general case. elt-class float = [ { distance [ v- norm ] } suffix ] when ; -TUPLE: simd class elt-class ops wrappers ctor rep ; +TUPLE: simd class elt-class ops special-wrappers schema-wrappers ctor rep ; : define-simd ( simd -- ) dup rep>> rep-component-type c:c-type-boxed-class >>elt-class { [ class>> ] [ elt-class>> ] - [ [ ops>> ] [ wrappers>> ] bi low-level-ops ] + [ [ ops>> ] [ special-wrappers>> ] [ schema-wrappers>> ] tri low-level-ops ] [ rep>> supported-simd-ops ] [ [ ctor>> ] [ elt-class>> ] bi high-level-ops assoc-union ] } cleave @@ -152,6 +175,8 @@ A-vv->n-op DEFINES-PRIVATE ${A}-vv->n-op A-v->v-op DEFINES-PRIVATE ${A}-v->v-op A-v->n-op DEFINES-PRIVATE ${A}-v->n-op +A-element-class [ A-rep rep-component-type c:c-type-boxed-class ] + WHERE TUPLE: A @@ -161,9 +186,14 @@ M: A clone underlying>> clone \ A boa ; inline M: A length drop N ; inline +M: A equal? + over \ A instance? [ v= vall? ] [ 2drop f ] if ; + M: A nth-unsafe underlying>> A-rep simd-nth ; inline -M: A set-nth-unsafe underlying>> SET-NTH call ; inline +M: A set-nth-unsafe + [ A-element-class boolean>element ] 2dip + underlying>> SET-NTH call ; inline : >A ( seq -- simd-array ) \ A new clone-like ; @@ -177,8 +207,6 @@ M: A new-sequence [ N bad-length ] if ; inline -M: A equal? over \ A instance? [ sequence= ] [ 2drop f ] if ; - M: A c:byte-length underlying>> length ; inline M: A element-type drop A-rep rep-component-type ; @@ -235,7 +263,7 @@ simd new { { +vector+ -> +vector+ } A-v->v-op } { { +vector+ -> +scalar+ } A-v->n-op } { { +vector+ -> +nonnegative+ } A-v->n-op } - } >>wrappers + } >>schema-wrappers (define-simd-128) PRIVATE> @@ -291,9 +319,12 @@ A-deref DEFINES-PRIVATE ${A}-deref A-rep [ A/2 name>> "-rep" append "cpu.architecture" lookup ] A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op A-vn->v-op DEFINES-PRIVATE ${A}-vn->v-op -A-vv->n-op DEFINES-PRIVATE ${A}-vv->n-op A-v->v-op DEFINES-PRIVATE ${A}-v->v-op -A-v->n-op DEFINES-PRIVATE ${A}-v->n-op +A-v.-op DEFINES-PRIVATE ${A}-v.-op +(A-v->n-op) DEFINES-PRIVATE (${A}-v->v-op) +A-sum-op DEFINES-PRIVATE ${A}-sum-op +A-vany-op DEFINES-PRIVATE ${A}-vany-op +A-vall-op DEFINES-PRIVATE ${A}-vall-op WHERE @@ -310,6 +341,9 @@ M: A clone M: A length drop N ; inline +M: A equal? + over \ A instance? [ v= vall? ] [ 2drop f ] if ; + : A-deref ( n seq -- n' seq' ) over N/2 < [ underlying1>> ] [ [ N/2 - ] dip underlying2>> ] if \ A/2 boa ; inline @@ -327,8 +361,6 @@ M: A new-sequence [ N bad-length ] if ; inline -M: A equal? over \ A instance? [ sequence= ] [ 2drop f ] if ; - M: A c:byte-length drop 32 ; inline M: A element-type drop A-rep rep-component-type ; @@ -366,32 +398,44 @@ INSTANCE: A sequence [ [ [ underlying2>> ] dip A-rep ] dip call ] 3bi \ A boa ; inline -: A-vv->n-op ( v1 v2 quot -- v3 ) - [ [ [ underlying1>> ] bi@ A-rep ] dip call ] - [ [ [ underlying2>> ] bi@ A-rep ] dip call ] 3bi - + ; inline - : A-v->v-op ( v1 combine-quot -- v2 ) [ [ underlying1>> A-rep ] dip call ] [ [ underlying2>> A-rep ] dip call ] 2bi \ A boa ; inline -: A-v->n-op ( v1 combine-quot -- v2 ) - [ [ underlying1>> ] [ underlying2>> ] bi A-rep (simd-v+) A-rep ] dip call ; inline +: A-v.-op ( v1 v2 quot -- n ) + [ [ [ underlying1>> ] bi@ A-rep ] dip call ] + [ [ [ underlying2>> ] bi@ A-rep ] dip call ] 3bi + + ; inline + +: (A-v->n-op) ( v1 quot reduce-quot -- n ) + '[ [ underlying1>> ] [ underlying2>> ] bi A-rep @ A-rep ] dip call ; inline + +: A-sum-op ( v1 quot -- n ) + [ (simd-v+) ] (A-v->n-op) ; inline + +: A-vany-op ( v1 quot -- n ) + [ (simd-vbitor) ] (A-v->n-op) ; inline +: A-vall-op ( v1 quot -- n ) + [ (simd-vbitand) ] (A-v->n-op) ; inline simd new \ A >>class \ A-with >>ctor \ A-rep >>rep + { + { v. A-v.-op } + { sum A-sum-op } + { vnone? A-vany-op } + { vany? A-vany-op } + { vall? A-vall-op } + } >>special-wrappers { { { +vector+ +vector+ -> +vector+ } A-vv->v-op } { { +vector+ +scalar+ -> +vector+ } A-vn->v-op } { { +vector+ +literal+ -> +vector+ } A-vn->v-op } - { { +vector+ +vector+ -> +scalar+ } A-vv->n-op } { { +vector+ -> +vector+ } A-v->v-op } - { { +vector+ -> +scalar+ } A-v->n-op } - { { +vector+ -> +nonnegative+ } A-v->n-op } - } >>wrappers + } >>schema-wrappers (define-simd-256) ;FUNCTOR diff --git a/basis/math/vectors/simd/intrinsics/intrinsics.factor b/basis/math/vectors/simd/intrinsics/intrinsics.factor index 6008a20844..cbdbade222 100644 --- a/basis/math/vectors/simd/intrinsics/intrinsics.factor +++ b/basis/math/vectors/simd/intrinsics/intrinsics.factor @@ -49,6 +49,10 @@ SIMD-OP: vrshift SIMD-OP: hlshift SIMD-OP: hrshift SIMD-OP: vshuffle +SIMD-OP: v= +SIMD-OP: vany? +SIMD-OP: vall? +SIMD-OP: vnone? : (simd-with) ( x rep -- v ) bad-simd-call ; : (simd-gather-2) ( a b rep -- v ) bad-simd-call ; @@ -126,6 +130,10 @@ M: vector-rep supported-simd-op? { \ (simd-hlshift) [ %horizontal-shl-vector-reps ] } { \ (simd-hrshift) [ %horizontal-shr-vector-reps ] } { \ (simd-vshuffle) [ %shuffle-vector-reps ] } + { \ (simd-v=) [ %compare-vector-reps ] } { \ (simd-gather-2) [ %gather-vector-2-reps ] } { \ (simd-gather-4) [ %gather-vector-4-reps ] } + { \ (simd-vany?) [ %test-vector-reps ] } + { \ (simd-vall?) [ %test-vector-reps ] } + { \ (simd-vnone?) [ %test-vector-reps ] } } case member? ; diff --git a/basis/math/vectors/simd/simd-tests.factor b/basis/math/vectors/simd/simd-tests.factor index c676b9fe98..7f43124d59 100644 --- a/basis/math/vectors/simd/simd-tests.factor +++ b/basis/math/vectors/simd/simd-tests.factor @@ -161,7 +161,10 @@ CONSTANT: simd-classes : remove-special-words ( alist -- alist' ) ! These have their own tests later - { hlshift hrshift vshuffle vbroadcast } unique assoc-diff ; + { + hlshift hrshift vshuffle vbroadcast + v= vany? vall? vnone? + } unique assoc-diff ; : ops-to-check ( elt-class -- alist ) [ vector-words >alist ] dip @@ -281,6 +284,141 @@ simd-classes [ ] unit-test ] each +"== Checking element tests" print + +[ short-8{ t f t f f f t f } ] +[ short-8{ 1 2 3 4 5 6 7 8 } short-8{ 1 0 3 -1 -2 -3 7 -4 } v= ] unit-test + +[ short-8{ t f t f f f t f } ] +[ short-8{ 1 2 3 4 5 6 7 8 } short-8{ 1 0 3 -1 -2 -3 7 -4 } [ { short-8 short-8 } declare v= ] compile-call ] unit-test + +[ int-8{ t f t f f f t f } ] +[ int-8{ 1 2 3 4 5 6 7 8 } int-8{ 1 0 3 -1 -2 -3 7 -4 } v= ] unit-test + +[ int-8{ t f t f f f t f } ] +[ int-8{ 1 2 3 4 5 6 7 8 } int-8{ 1 0 3 -1 -2 -3 7 -4 } [ { int-8 int-8 } declare v= ] compile-call ] unit-test + +[ int-4{ t f t f } ] +[ int-4{ 1 2 3 4 } int-4{ 1 0 3 -1 } [ { int-4 int-4 } declare v= ] compile-call ] unit-test + +[ int-4{ t f t f } ] +[ int-4{ 1 2 3 4 } int-4{ 1 0 3 -1 } v= ] unit-test + +[ int-4{ t f t f } ] +[ int-4{ 1 2 3 4 } int-4{ 1 0 3 -1 } [ { int-4 int-4 } declare v= ] compile-call ] unit-test + +[ t ] +[ + float-4{ t f t f } + float-4{ 1.0 0/0. 3.0 4.0 } float-4{ 1.0 0/0. 3.0 -1.0 } v= + exact= +] unit-test + +[ t ] +[ + float-4{ t f t f } + float-4{ 1.0 0/0. 3.0 4.0 } float-4{ 1.0 0/0. 3.0 -1.0 } [ { float-4 float-4 } declare v= ] compile-call + exact= +] unit-test + +[ t ] +[ + float-8{ t f t f f t t t } + float-8{ 1.0 0/0. 3.0 4.0 5.0 6.0 7.0 8.0 } float-8{ 1.0 0/0. 3.0 -1.0 -2.0 6.0 7.0 8.0 } v= + exact= +] unit-test + +[ t ] +[ + float-8{ t f t f f t t t } + float-8{ 1.0 0/0. 3.0 4.0 5.0 6.0 7.0 8.0 } float-8{ 1.0 0/0. 3.0 -1.0 -2.0 6.0 7.0 8.0 } [ { float-8 float-8 } declare v= ] compile-call + exact= +] unit-test + +[ t ] +[ + double-2{ f t } + double-2{ 0/0. 3.0 } double-2{ 0/0. 3.0 } v= + exact= +] unit-test + +[ t ] +[ + double-2{ f t } + double-2{ 0/0. 3.0 } double-2{ 0/0. 3.0 } [ { double-2 double-2 } declare v= ] compile-call + exact= +] unit-test + +:: test-vector-tests-bool ( vector declaration -- none? any? all? ) + vector + [ [ declaration declare vnone? ] compile-call ] + [ [ declaration declare vany? ] compile-call ] + [ [ declaration declare vall? ] compile-call ] tri ; inline + +: yes ( -- x ) t ; +: no ( -- x ) f ; + +:: test-vector-tests-branch ( vector declaration -- none? any? all? ) + vector + [ [ declaration declare vnone? [ yes ] [ no ] if ] compile-call ] + [ [ declaration declare vany? [ yes ] [ no ] if ] compile-call ] + [ [ declaration declare vall? [ yes ] [ no ] if ] compile-call ] tri ; inline + +SYMBOL: !!inconsistent!! + +: ?inconsistent ( a b -- ab/inconsistent ) + 2dup = [ drop ] [ 2drop !!inconsistent!! ] if ; + +:: test-vector-tests ( vector decl -- none? any? all? ) + vector decl test-vector-tests-bool :> bool-all :> bool-any :> bool-none + vector decl test-vector-tests-branch :> branch-all :> branch-any :> branch-none + + bool-none branch-none ?inconsistent + bool-any branch-any ?inconsistent + bool-all branch-all ?inconsistent ; inline + +[ f t t ] +[ float-4{ t t t t } { float-4 } test-vector-tests ] unit-test +[ f t f ] +[ float-4{ f t t t } { float-4 } test-vector-tests ] unit-test +[ t f f ] +[ float-4{ f f f f } { float-4 } test-vector-tests ] unit-test + +[ f t t ] +[ double-2{ t t } { double-2 } test-vector-tests ] unit-test +[ f t f ] +[ double-2{ f t } { double-2 } test-vector-tests ] unit-test +[ t f f ] +[ double-2{ f f } { double-2 } test-vector-tests ] unit-test + +[ f t t ] +[ int-4{ t t t t } { int-4 } test-vector-tests ] unit-test +[ f t f ] +[ int-4{ f t t t } { int-4 } test-vector-tests ] unit-test +[ t f f ] +[ int-4{ f f f f } { int-4 } test-vector-tests ] unit-test + +[ f t t ] +[ float-8{ t t t t t t t t } { float-8 } test-vector-tests ] unit-test +[ f t f ] +[ float-8{ f t t t t f t t } { float-8 } test-vector-tests ] unit-test +[ t f f ] +[ float-8{ f f f f f f f f } { float-8 } test-vector-tests ] unit-test + +[ f t t ] +[ double-4{ t t t t } { double-4 } test-vector-tests ] unit-test +[ f t f ] +[ double-4{ f t t f } { double-4 } test-vector-tests ] unit-test +[ t f f ] +[ double-4{ f f f f } { double-4 } test-vector-tests ] unit-test + +[ f t t ] +[ int-8{ t t t t t t t t } { int-8 } test-vector-tests ] unit-test +[ f t f ] +[ int-8{ f t t t t f f f } { int-8 } test-vector-tests ] unit-test +[ t f f ] +[ int-8{ f f f f f f f f } { int-8 } test-vector-tests ] unit-test + "== Checking element access" print ! Test element access -- it should box bignums for int-4 on x86 diff --git a/basis/math/vectors/specialization/specialization.factor b/basis/math/vectors/specialization/specialization.factor index b07615bfc9..ffb148f55d 100644 --- a/basis/math/vectors/specialization/specialization.factor +++ b/basis/math/vectors/specialization/specialization.factor @@ -92,6 +92,10 @@ H{ { hrshift { +vector+ +literal+ -> +vector+ } } { vshuffle { +vector+ +literal+ -> +vector+ } } { vbroadcast { +vector+ +literal+ -> +vector+ } } + { v= { +vector+ +vector+ -> +vector+ } } + { vany? { +vector+ -> +scalar+ } } + { vall? { +vector+ -> +scalar+ } } + { vnone? { +vector+ -> +scalar+ } } } PREDICATE: vector-word < word vector-words key? ; @@ -162,4 +166,4 @@ ERROR: bad-vector-word word ; vector-words keys [ [ vector-word-custom-inlining ] "custom-inlining" set-word-prop -] each \ No newline at end of file +] each diff --git a/basis/math/vectors/vectors-docs.factor b/basis/math/vectors/vectors-docs.factor index 1d323822bd..547021afdb 100644 --- a/basis/math/vectors/vectors-docs.factor +++ b/basis/math/vectors/vectors-docs.factor @@ -61,8 +61,11 @@ ARTICLE: "math-vectors-logic" "Vector componentwise logic" { $subsection vand } { $subsection vor } { $subsection vxor } -{ $subsection vmask } { $subsection v? } +"Entire vector tests:" +{ $subsection vall? } +{ $subsection vany? } +{ $subsection vnone? } "Element shuffling:" { $subsection vshuffle } ; @@ -338,13 +341,21 @@ HELP: vnot { $values { "u" "a sequence of booleans" } { "w" "a sequence of booleans" } } { $description "Takes the logical NOT of each element of " { $snippet "u" } "." } ; -HELP: vmask -{ $values { "u" "a sequence of numbers" } { "?" "a sequence of booleans" } { "u'" "a sequence of numbers" } } -{ $description "Returns a copy of " { $snippet "u" } " with the elements for which the corresponding element of " { $snippet "?" } " is false replaced by zero." } ; - HELP: v? -{ $values { "?" "a sequence of booleans" } { "true" "a sequence of numbers" } { "false" "a sequence of numbers" } { "w" "a sequence of numbers" } } -{ $description "Creates a new sequence by selecting elements from the " { $snippet "true" } " and " { $snippet "false" } " sequences based on whether the corresponding element of the " { $snippet "?" } " sequence is true or false." } ; +{ $values { "mask" "a sequence of booleans" } { "true" "a sequence of numbers" } { "false" "a sequence of numbers" } { "w" "a sequence of numbers" } } +{ $description "Creates a new sequence by selecting elements from the " { $snippet "true" } " and " { $snippet "false" } " sequences based on whether the corresponding bits of the " { $snippet "mask" } " sequence are set or not." } ; + +HELP: vany? +{ $values { "v" "a sequence of booleans" } { "?" "a boolean" } } +{ $description "Returns true if any element of " { $snippet "v" } " is true." } ; + +HELP: vall? +{ $values { "v" "a sequence of booleans" } { "?" "a boolean" } } +{ $description "Returns true if every element of " { $snippet "v" } " is true." } ; + +HELP: vnone? +{ $values { "v" "a sequence of booleans" } { "?" "a boolean" } } +{ $description "Returns true if every element of " { $snippet "v" } " is false." } ; { 2map v+ v- v* v/ } related-words @@ -352,6 +363,6 @@ HELP: v? { vs+ vs- vs* } related-words -{ v< v<= v= v> v>= vunordered? vand vor vxor vnot vmask v? } related-words +{ v< v<= v= v> v>= vunordered? vand vor vxor vnot vany? vall? vnone? v? } related-words { vbitand vbitandn vbitor vbitxor vbitnot } related-words diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor index a3d51752bd..302380cd09 100644 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@ -92,16 +92,19 @@ PRIVATE> : vxor ( u v -- w ) [ xor ] 2map ; : vnot ( u -- w ) [ not ] map ; -: v< ( u v -- w ) [ < ] { } 2map-as ; -: v<= ( u v -- w ) [ <= ] { } 2map-as ; -: v>= ( u v -- w ) [ >= ] { } 2map-as ; -: v> ( u v -- w ) [ > ] { } 2map-as ; -: vunordered? ( u v -- w ) [ unordered? ] { } 2map-as ; -: v= ( u v -- w ) [ = ] { } 2map-as ; +: vall? ( v -- ? ) [ ] all? ; +: vany? ( v -- ? ) [ ] any? ; +: vnone? ( v -- ? ) [ not ] all? ; -: v? ( ? true false -- w ) [ ? ] pick 3map-as ; +: v< ( u v -- w ) [ < ] 2map ; +: v<= ( u v -- w ) [ <= ] 2map ; +: v>= ( u v -- w ) [ >= ] 2map ; +: v> ( u v -- w ) [ > ] 2map ; +: vunordered? ( u v -- w ) [ unordered? ] 2map ; +: v= ( u v -- w ) [ = ] 2map ; -: vmask ( u ? -- u' ) swap dup dup vbitxor v? ; +: v? ( mask true false -- w ) + [ vbitand ] [ vbitandn ] bi-curry* bi vbitor ; inline : vfloor ( u -- v ) [ floor ] map ; : vceiling ( u -- v ) [ ceiling ] map ; diff --git a/extra/math/matrices/simd/simd-tests.factor b/extra/math/matrices/simd/simd-tests.factor index 5bd61adefd..60b37f5371 100644 --- a/extra/math/matrices/simd/simd-tests.factor +++ b/extra/math/matrices/simd/simd-tests.factor @@ -53,6 +53,19 @@ IN: math.matrices.simd.tests 1.0e-7 m~ ] unit-test +[ t ] [ + float-4{ 0.0 1.0 0.0 1.0 } pi 1/2. * rotation-matrix4 + S{ matrix4 f + float-4-array{ + float-4{ 0.0 0.0 1.0 0.0 } + float-4{ 0.0 1.0 0.0 0.0 } + float-4{ -1.0 0.0 0.0 0.0 } + float-4{ 0.0 0.0 0.0 1.0 } + } + } + 1.0e-7 m~ +] unit-test + [ S{ matrix4 f float-4-array{ diff --git a/extra/math/matrices/simd/simd.factor b/extra/math/matrices/simd/simd.factor index 0c4c3e1866..16960993b6 100644 --- a/extra/math/matrices/simd/simd.factor +++ b/extra/math/matrices/simd/simd.factor @@ -95,6 +95,17 @@ TYPED:: m4. ( a: matrix4 b: matrix4 -- c: matrix4 ) c set-rows ; +TYPED:: v.m4 ( a: float-4 b: matrix4 -- c: float-4 ) + b rows :> b4 :> b3 :> b2 :> b1 + + a first b1 n*v + a second b2 n*v v+ + a third b3 n*v v+ + a fourth b4 n*v v+ ; + +TYPED:: m4.v ( a: matrix4 b: float-4 -- c: float-4 ) + a rows [ b v. ] 4 napply float-4-boa ; + CONSTANT: identity-matrix4 S{ matrix4 f float-4-array{ @@ -121,7 +132,7 @@ TYPED:: m4^n ( m: matrix4 n: fixnum -- m^n: matrix4 ) TYPED:: scale-matrix4 ( factors: float-4 -- matrix: matrix4 ) matrix4 (struct) :> c - factors { t t t f } vmask :> factors' + factors float-4{ t t t f } vbitand :> factors' factors' { 0 3 3 3 } vshuffle factors' { 3 1 3 3 } vshuffle @@ -137,11 +148,11 @@ TYPED:: translation-matrix4 ( offset: float-4 -- matrix: matrix4 ) matrix4 (struct) :> c float-4{ 0.0 0.0 0.0 1.0 } :> c4 - { t t t f } offset c4 v? :> offset' + float-4{ t t t f } offset c4 v? :> offset' - offset' { 3 3 3 0 } vshuffle { t f f t } vmask - offset' { 3 3 3 1 } vshuffle { f t f t } vmask - offset' { 3 3 3 2 } vshuffle { f f t t } vmask + offset' { 3 3 3 0 } vshuffle float-4{ t f f t } vbitand + offset' { 3 3 3 1 } vshuffle float-4{ f t f t } vbitand + offset' { 3 3 3 2 } vshuffle float-4{ f f t t } vbitand c4 c set-rows ; @@ -165,17 +176,17 @@ TYPED:: rotation-matrix4 ( axis: float-4 theta: float -- matrix: matrix4 ) axis2 cc ones axis2 v- v* v+ :> diagonal - axis { 0 0 1 3 } vshuffle axis { 1 2 2 3 } vshuffle v* 1-c v* - { t t t f } vmask :> triangle-a - ss { 2 1 0 3 } vshuffle triangle-sign v* :> triangle-b + axis { 1 0 0 3 } vshuffle axis { 2 2 1 3 } vshuffle v* 1-c v* + float-4{ t t t f } vbitand :> triangle-a + ss axis v* triangle-sign v* :> triangle-b triangle-a triangle-b v+ :> triangle-lo triangle-a triangle-b v- :> triangle-hi diagonal scale-matrix4 :> diagonal-m - triangle-hi { 3 0 1 3 } vshuffle - triangle-hi { 3 3 2 3 } vshuffle triangle-lo { 0 3 3 3 } vshuffle v+ - triangle-lo { 1 2 3 3 } vshuffle + triangle-hi { 3 2 1 3 } vshuffle + triangle-hi { 3 3 0 3 } vshuffle triangle-lo { 2 3 3 3 } vshuffle v+ + triangle-lo { 1 0 3 3 } vshuffle float-4 new triangle-m set-rows drop @@ -186,12 +197,12 @@ TYPED:: frustum-matrix4 ( xy: float-4 near: float far: float -- matrix: matrix4 matrix4 (struct) :> c near near near far + 2 near far * * float-4-boa :> num - { t t f f } xy near far - float-4-with v? :> denom + float-4{ t t f f } xy near far - float-4-with v? :> denom num denom v/ :> fov - fov { 0 0 0 0 } vshuffle { t f f f } vmask - fov { 1 1 1 1 } vshuffle { f t f f } vmask - fov { 2 2 2 3 } vshuffle { f f t t } vmask + fov { 0 0 0 0 } vshuffle float-4{ t f f f } vbitand + fov { 1 1 1 1 } vshuffle float-4{ f t f f } vbitand + fov { 2 2 2 3 } vshuffle float-4{ f f t t } vbitand float-4{ 0.0 0.0 -1.0 0.0 } c set-rows ; diff --git a/misc/vim/syntax/factor.vim b/misc/vim/syntax/factor.vim index 52e5825c7c..9161c14e12 100644 --- a/misc/vim/syntax/factor.vim +++ b/misc/vim/syntax/factor.vim @@ -23,7 +23,7 @@ else set iskeyword=!,@,33-35,%,$,38-64,A-Z,91-96,a-z,123-126,128-255 endif -syn cluster factorCluster contains=factorComment,factorKeyword,factorRepeat,factorConditional,factorBoolean,factorCompileDirective,factorString,factorTriString,factorSbuf,@factorNumber,@factorNumErr,factorDelimiter,factorChar,factorCharErr,factorBackslash,@factorWordOps,factorAlien,factorTuple,factorStruct +syn cluster factorCluster contains=factorComment,factorFryDirective,factorKeyword,factorRepeat,factorConditional,factorBoolean,factorCompileDirective,factorString,factorTriString,factorSbuf,@factorNumber,@factorNumErr,factorDelimiter,factorChar,factorCharErr,factorBackslash,@factorWordOps,factorAlien,factorTuple,factorStruct syn match factorTodo /\(TODO\|FIXME\|XXX\):\=/ contained syn match factorComment /\<#!\>.*/ contains=factorTodo @@ -44,9 +44,11 @@ syn region factorPGenericN matchgroup=factorPGenericNDelims start=/\/ end=/\\>/ contains=@factorDefnContents,factorPrivateDefn,factorPrivateMethod,factorPGeneric,factorPGenericN -syn keyword factorBoolean boolean f general-t t +syn keyword factorBoolean f t +syn match factorFryDirective /\<\(@\|_\)\>/ contained syn keyword factorCompileDirective inline foldable recursive +syn keyword factorKeyword boolean syn keyword factorKeyword or tuck 2bi 2tri while wrapper nip 4dip wrapper? bi* callstack>array both? hashcode die dupd callstack callstack? 3dup tri@ pick curry build ?execute 3bi prepose >boolean ?if clone eq? tri* ? = swapd call-clear 2over 2keep 3keep clear 2dup when not tuple? dup 2bi* 2tri* call tri-curry object bi@ do unless* if* loop bi-curry* drop when* assert= retainstack assert? -rot execute 2bi@ 2tri@ boa with either? 3drop bi curry? datastack until 3dip over 3curry roll tri-curry* swap tri-curry@ 2nip and throw set-retainstack bi-curry (clone) hashcode* compose spin 2dip if 3tri unless compose? tuple keep 2curry equal? set-datastack assert tri 2drop most boolean? identity-tuple? null new set-callstack dip bi-curry@ rot -roll xor identity-tuple boolean syn keyword factorKeyword ?at assoc? assoc-clone-like assoc= delete-at* assoc-partition extract-keys new-assoc value? assoc-size map>assoc push-at assoc-like key? assoc-intersect assoc-refine update assoc-union assoc-combine at* assoc-empty? at+ set-at assoc-all? assoc-subset? assoc-hashcode change-at assoc-each assoc-diff zip values value-at rename-at inc-at enum? at cache assoc>map assoc assoc-map enum value-at* remove-all assoc-map-as >alist assoc-filter-as substitute-here clear-assoc assoc-stack maybe-set-at substitute assoc-filter 2cache delete-at assoc-find keys assoc-any? unzip syn keyword factorKeyword case execute-effect no-cond no-case? 3cleave>quot 2cleave cond>quot wrong-values? no-cond? cleave>quot no-case case>quot 3cleave wrong-values to-fixed-point alist>quot case-find cond cleave call-effect 2cleave>quot recursive-hashcode linear-case-quot spread spread>quot @@ -190,6 +192,7 @@ if version >= 508 || !exists("did_factor_syn_inits") HiLink factorConditional Conditional HiLink factorKeyword Keyword HiLink factorOperator Operator + HiLink factorFryDirective Operator HiLink factorBoolean Boolean HiLink factorDefnDelims Typedef HiLink factorMethodDelims Typedef