152 lines
6.8 KiB
Factor
152 lines
6.8 KiB
Factor
! (c)2009 Joe Groff bsd license
|
|
USING: accessors arrays assocs classes combinators
|
|
combinators.short-circuit compiler.cfg.builder.blocks
|
|
compiler.cfg.registers compiler.cfg.stacks
|
|
compiler.cfg.stacks.local compiler.tree.propagation.info
|
|
compiler.cfg.instructions
|
|
cpu.architecture effects fry generalizations
|
|
kernel locals macros make math namespaces quotations sequences
|
|
splitting stack-checker words ;
|
|
IN: compiler.cfg.intrinsics.simd.backend
|
|
|
|
! Selection of implementation based on available CPU instructions
|
|
|
|
GENERIC: insn-available? ( ## -- reps )
|
|
|
|
M: object insn-available? drop t ;
|
|
|
|
M: ##zero-vector insn-available? rep>> %zero-vector-reps member? ;
|
|
M: ##fill-vector insn-available? rep>> %fill-vector-reps member? ;
|
|
M: ##gather-vector-2 insn-available? rep>> %gather-vector-2-reps member? ;
|
|
M: ##gather-vector-4 insn-available? rep>> %gather-vector-4-reps member? ;
|
|
M: ##alien-vector insn-available? rep>> %alien-vector-reps member? ;
|
|
M: ##shuffle-vector insn-available? rep>> %shuffle-vector-reps member? ;
|
|
M: ##shuffle-vector-imm insn-available? rep>> %shuffle-vector-imm-reps member? ;
|
|
M: ##merge-vector-head insn-available? rep>> %merge-vector-reps member? ;
|
|
M: ##merge-vector-tail insn-available? rep>> %merge-vector-reps member? ;
|
|
M: ##signed-pack-vector insn-available? rep>> %signed-pack-vector-reps member? ;
|
|
M: ##unsigned-pack-vector insn-available? rep>> %unsigned-pack-vector-reps member? ;
|
|
M: ##unpack-vector-head insn-available? rep>> %unpack-vector-head-reps member? ;
|
|
M: ##unpack-vector-tail insn-available? rep>> %unpack-vector-tail-reps member? ;
|
|
M: ##tail>head-vector insn-available? rep>> %unpack-vector-head-reps member? ;
|
|
M: ##integer>float-vector insn-available? rep>> %integer>float-vector-reps member? ;
|
|
M: ##float>integer-vector insn-available? rep>> %float>integer-vector-reps member? ;
|
|
M: ##compare-vector insn-available? [ rep>> ] [ cc>> ] bi %compare-vector-reps member? ;
|
|
M: ##test-vector insn-available? rep>> %test-vector-reps member? ;
|
|
M: ##add-vector insn-available? rep>> %add-vector-reps member? ;
|
|
M: ##saturated-add-vector insn-available? rep>> %saturated-add-vector-reps member? ;
|
|
M: ##add-sub-vector insn-available? rep>> %add-sub-vector-reps member? ;
|
|
M: ##sub-vector insn-available? rep>> %sub-vector-reps member? ;
|
|
M: ##saturated-sub-vector insn-available? rep>> %saturated-sub-vector-reps member? ;
|
|
M: ##mul-vector insn-available? rep>> %mul-vector-reps member? ;
|
|
M: ##mul-high-vector insn-available? rep>> %mul-high-vector-reps member? ;
|
|
M: ##mul-horizontal-add-vector insn-available? rep>> %mul-horizontal-add-vector-reps member? ;
|
|
M: ##saturated-mul-vector insn-available? rep>> %saturated-mul-vector-reps member? ;
|
|
M: ##div-vector insn-available? rep>> %div-vector-reps member? ;
|
|
M: ##min-vector insn-available? rep>> %min-vector-reps member? ;
|
|
M: ##max-vector insn-available? rep>> %max-vector-reps member? ;
|
|
M: ##avg-vector insn-available? rep>> %avg-vector-reps member? ;
|
|
M: ##dot-vector insn-available? rep>> %dot-vector-reps member? ;
|
|
M: ##sad-vector insn-available? rep>> %sad-vector-reps member? ;
|
|
M: ##sqrt-vector insn-available? rep>> %sqrt-vector-reps member? ;
|
|
M: ##horizontal-add-vector insn-available? rep>> %horizontal-add-vector-reps member? ;
|
|
M: ##horizontal-sub-vector insn-available? rep>> %horizontal-sub-vector-reps member? ;
|
|
M: ##abs-vector insn-available? rep>> %abs-vector-reps member? ;
|
|
M: ##and-vector insn-available? rep>> %and-vector-reps member? ;
|
|
M: ##andn-vector insn-available? rep>> %andn-vector-reps member? ;
|
|
M: ##or-vector insn-available? rep>> %or-vector-reps member? ;
|
|
M: ##xor-vector insn-available? rep>> %xor-vector-reps member? ;
|
|
M: ##not-vector insn-available? rep>> %not-vector-reps member? ;
|
|
M: ##shl-vector insn-available? rep>> %shl-vector-reps member? ;
|
|
M: ##shr-vector insn-available? rep>> %shr-vector-reps member? ;
|
|
M: ##shl-vector-imm insn-available? rep>> %shl-vector-imm-reps member? ;
|
|
M: ##shr-vector-imm insn-available? rep>> %shr-vector-imm-reps member? ;
|
|
M: ##horizontal-shl-vector-imm insn-available? rep>> %horizontal-shl-vector-imm-reps member? ;
|
|
M: ##horizontal-shr-vector-imm insn-available? rep>> %horizontal-shr-vector-imm-reps member? ;
|
|
|
|
GENERIC# >vector-op-cond 2 ( quot #pick #dup -- quotpair )
|
|
M:: callable >vector-op-cond ( quot #pick #dup -- quotpair )
|
|
#dup quot '[ 2drop _ ndup [ @ ] { } make dup [ insn-available? ] all? ]
|
|
#dup '[ % _ nnip ]
|
|
2array ;
|
|
|
|
M:: pair >vector-op-cond ( pair #pick #dup -- quotpair )
|
|
pair first2 :> ( class quot )
|
|
#pick class #dup quot
|
|
'[ 2drop _ npick _ instance? [ _ ndup [ @ ] { } make dup [ insn-available? ] all? ] [ f f f ] if ]
|
|
#dup '[ % _ nnip ]
|
|
2array ;
|
|
|
|
MACRO: v-vector-op ( trials -- )
|
|
[ 1 2 >vector-op-cond ] map '[ f f _ cond ] ;
|
|
MACRO: vl-vector-op ( trials -- )
|
|
[ 1 3 >vector-op-cond ] map '[ f f _ cond ] ;
|
|
MACRO: vv-vector-op ( trials -- )
|
|
[ 1 3 >vector-op-cond ] map '[ f f _ cond ] ;
|
|
MACRO: vv-cc-vector-op ( trials -- )
|
|
[ 2 4 >vector-op-cond ] map '[ f f _ cond ] ;
|
|
MACRO: vvvv-vector-op ( trials -- )
|
|
[ 1 5 >vector-op-cond ] map '[ f f _ cond ] ;
|
|
|
|
! Intrinsic code emission
|
|
|
|
MACRO: check-elements ( quots -- )
|
|
[ length '[ _ firstn ] ]
|
|
[ '[ _ spread ] ]
|
|
[ length 1 - \ and <repetition> [ ] like ]
|
|
tri 3append ;
|
|
|
|
ERROR: bad-simd-intrinsic node ;
|
|
|
|
MACRO: if-literals-match ( quots -- )
|
|
[ length ] [ ] [ length ] tri
|
|
! n quots n
|
|
'[
|
|
! node quot
|
|
[
|
|
dup node-input-infos
|
|
_ tail-slice* [ literal>> ] map
|
|
dup _ check-elements
|
|
] dip
|
|
swap [
|
|
! node literals quot
|
|
[ _ firstn ] dip call
|
|
drop
|
|
] [ 2drop bad-simd-intrinsic ] if
|
|
] ;
|
|
|
|
CONSTANT: [unary] [ ds-drop ds-pop ]
|
|
CONSTANT: [unary/param] [ [ -2 inc-d ds-pop ] dip ]
|
|
CONSTANT: [binary] [ ds-drop 2inputs ]
|
|
CONSTANT: [quaternary]
|
|
[
|
|
ds-drop
|
|
D 3 peek-loc
|
|
D 2 peek-loc
|
|
D 1 peek-loc
|
|
D 0 peek-loc
|
|
-4 inc-d
|
|
]
|
|
|
|
:: [emit-vector-op] ( trials params-quot op-quot literal-preds -- quot )
|
|
params-quot trials op-quot literal-preds
|
|
'[ [ _ dip _ @ ds-push ] _ if-literals-match ] ;
|
|
|
|
MACRO: emit-v-vector-op ( trials -- )
|
|
[unary] [ v-vector-op ] { [ representation? ] } [emit-vector-op] ;
|
|
MACRO: emit-vl-vector-op ( trials literal-pred -- )
|
|
[ [unary/param] [ vl-vector-op ] { [ representation? ] } ] dip prefix [emit-vector-op] ;
|
|
MACRO: emit-vv-vector-op ( trials -- )
|
|
[binary] [ vv-vector-op ] { [ representation? ] } [emit-vector-op] ;
|
|
MACRO: emit-vvvv-vector-op ( trials -- )
|
|
[quaternary] [ vvvv-vector-op ] { [ representation? ] } [emit-vector-op] ;
|
|
|
|
MACRO:: emit-vv-or-vl-vector-op ( var-trials imm-trials literal-pred -- )
|
|
literal-pred imm-trials literal-pred var-trials
|
|
'[
|
|
dup node-input-infos 2 tail-slice* first literal>> @
|
|
[ _ _ emit-vl-vector-op ]
|
|
[ _ emit-vv-vector-op ] if
|
|
] ;
|
|
|