Merge branch 'master' of git://factorcode.org/git/factor into improved-aa
Slava Pestov
commit
bcbdc9e0c8
|
|
@ -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> }
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ] }
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 -- ? )
|
||||
|
|
|
|||
|
|
@ -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
|
||||
[
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 [
|
||||
|
|
|
|||
|
|
@ -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 )
|
||||
|
|
|
|||
|
|
@ -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 { } ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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? ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
] each
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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{
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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=/\<GENERIC#\s\
|
|||
syn region None matchgroup=factorPrivate start=/\<<PRIVATE\>/ end=/\<PRIVATE>\>/ 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 <wrapper> 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 <enum> 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
|
||||
|
|
|
|||
Loading…
Reference in New Issue