basis/compiler/cfg/intrinsics/simd/backend/backend.factor

   1 ! (c)2009 Joe Groff bsd license
   2 USING: accessors arrays classes combinators
   3 compiler.cfg.instructions compiler.cfg.registers
   4 compiler.cfg.stacks compiler.cfg.stacks.local
   5 compiler.tree.propagation.info cpu.architecture fry
   6 generalizations kernel locals macros make math quotations
   7 sequences sequences.generalizations ;
   8 IN: compiler.cfg.intrinsics.simd.backend
   9
  10 ! Selection of implementation based on available CPU instructions
  11
  12 GENERIC: insn-available? ( ## -- reps )
  13
  14 M: object insn-available? drop t ;
  15
  16 M: ##zero-vector insn-available? rep>> %zero-vector-reps member? ;
  17 M: ##fill-vector insn-available? rep>> %fill-vector-reps member? ;
  18 M: ##gather-vector-2 insn-available? rep>> %gather-vector-2-reps member? ;
  19 M: ##gather-vector-4 insn-available? rep>> %gather-vector-4-reps member? ;
  20 M: ##gather-int-vector-2 insn-available? rep>> %gather-int-vector-2-reps member? ;
  21 M: ##gather-int-vector-4 insn-available? rep>> %gather-int-vector-4-reps member? ;
  22 M: ##select-vector insn-available? rep>> %select-vector-reps member? ;
  23 M: ##store-memory-imm insn-available? rep>> %alien-vector-reps member? ;
  24 M: ##shuffle-vector insn-available? rep>> %shuffle-vector-reps member? ;
  25 M: ##shuffle-vector-imm insn-available? rep>> %shuffle-vector-imm-reps member? ;
  26 M: ##shuffle-vector-halves-imm insn-available? rep>> %shuffle-vector-halves-imm-reps member? ;
  27 M: ##merge-vector-head insn-available? rep>> %merge-vector-reps member? ;
  28 M: ##merge-vector-tail insn-available? rep>> %merge-vector-reps member? ;
  29 M: ##float-pack-vector insn-available? rep>> %float-pack-vector-reps member? ;
  30 M: ##signed-pack-vector insn-available? rep>> %signed-pack-vector-reps member? ;
  31 M: ##unsigned-pack-vector insn-available? rep>> %unsigned-pack-vector-reps member? ;
  32 M: ##unpack-vector-head insn-available? rep>> %unpack-vector-head-reps member? ;
  33 M: ##unpack-vector-tail insn-available? rep>> %unpack-vector-tail-reps member? ;
  34 M: ##tail>head-vector insn-available? rep>> %unpack-vector-head-reps member? ;
  35 M: ##integer>float-vector insn-available? rep>> %integer>float-vector-reps member? ;
  36 M: ##float>integer-vector insn-available? rep>> %float>integer-vector-reps member? ;
  37 M: ##compare-vector insn-available? [ rep>> ] [ cc>> ] bi %compare-vector-reps member? ;
  38 M: ##move-vector-mask insn-available? rep>> %move-vector-mask-reps member? ;
  39 M: ##test-vector insn-available? rep>> %test-vector-reps member? ;
  40 M: ##add-vector insn-available? rep>> %add-vector-reps member? ;
  41 M: ##saturated-add-vector insn-available? rep>> %saturated-add-vector-reps member? ;
  42 M: ##add-sub-vector insn-available? rep>> %add-sub-vector-reps member? ;
  43 M: ##sub-vector insn-available? rep>> %sub-vector-reps member? ;
  44 M: ##saturated-sub-vector insn-available? rep>> %saturated-sub-vector-reps member? ;
  45 M: ##mul-vector insn-available? rep>> %mul-vector-reps member? ;
  46 M: ##mul-high-vector insn-available? rep>> %mul-high-vector-reps member? ;
  47 M: ##mul-horizontal-add-vector insn-available? rep>> %mul-horizontal-add-vector-reps member? ;
  48 M: ##saturated-mul-vector insn-available? rep>> %saturated-mul-vector-reps member? ;
  49 M: ##div-vector insn-available? rep>> %div-vector-reps member? ;
  50 M: ##min-vector insn-available? rep>> %min-vector-reps member? ;
  51 M: ##max-vector insn-available? rep>> %max-vector-reps member? ;
  52 M: ##avg-vector insn-available? rep>> %avg-vector-reps member? ;
  53 M: ##dot-vector insn-available? rep>> %dot-vector-reps member? ;
  54 M: ##sad-vector insn-available? rep>> %sad-vector-reps member? ;
  55 M: ##sqrt-vector insn-available? rep>> %sqrt-vector-reps member? ;
  56 M: ##horizontal-add-vector insn-available? rep>> %horizontal-add-vector-reps member? ;
  57 M: ##horizontal-sub-vector insn-available? rep>> %horizontal-sub-vector-reps member? ;
  58 M: ##abs-vector insn-available? rep>> %abs-vector-reps member? ;
  59 M: ##and-vector insn-available? rep>> %and-vector-reps member? ;
  60 M: ##andn-vector insn-available? rep>> %andn-vector-reps member? ;
  61 M: ##or-vector insn-available? rep>> %or-vector-reps member? ;
  62 M: ##xor-vector insn-available? rep>> %xor-vector-reps member? ;
  63 M: ##not-vector insn-available? rep>> %not-vector-reps member? ;
  64 M: ##shl-vector insn-available? rep>> %shl-vector-reps member? ;
  65 M: ##shr-vector insn-available? rep>> %shr-vector-reps member? ;
  66 M: ##shl-vector-imm insn-available? rep>> %shl-vector-imm-reps member? ;
  67 M: ##shr-vector-imm insn-available? rep>> %shr-vector-imm-reps member? ;
  68 M: ##horizontal-shl-vector-imm insn-available? rep>> %horizontal-shl-vector-imm-reps member? ;
  69 M: ##horizontal-shr-vector-imm insn-available? rep>> %horizontal-shr-vector-imm-reps member? ;
  70
  71 : [vector-op-checked] ( #dup quot -- quot )
  72     '[ _ ndup [ @ ] { } make dup [ insn-available? ] all? ] ;
  73
  74 GENERIC# >vector-op-cond 2 ( quot #pick #dup -- quotpair )
  75 M:: callable >vector-op-cond ( quot #pick #dup -- quotpair )
  76     #dup quot [vector-op-checked] '[ 2drop @ ]
  77     #dup '[ % _ nnip ]
  78     2array ;
  79
  80 M:: pair >vector-op-cond ( pair #pick #dup -- quotpair )
  81     pair first2 :> ( class quot )
  82     #pick class #dup quot [vector-op-checked]
  83     '[ 2drop _ npick _ instance? _ [ f f f ] if ]
  84     #dup '[ % _ nnip ]
  85     2array ;
  86
  87 MACRO: v-vector-op ( trials -- quot )
  88     [ 1 2 >vector-op-cond ] map '[ f f _ cond ] ;
  89 MACRO: vl-vector-op ( trials -- quot )
  90     [ 1 3 >vector-op-cond ] map '[ f f _ cond ] ;
  91 MACRO: vvl-vector-op ( trials -- quot )
  92     [ 1 4 >vector-op-cond ] map '[ f f _ cond ] ;
  93 MACRO: vv-vector-op ( trials -- quot )
  94     [ 1 3 >vector-op-cond ] map '[ f f _ cond ] ;
  95 MACRO: vv-cc-vector-op ( trials -- quot )
  96     [ 2 4 >vector-op-cond ] map '[ f f _ cond ] ;
  97 MACRO: vvvv-vector-op ( trials -- quot )
  98     [ 1 5 >vector-op-cond ] map '[ f f _ cond ] ;
  99
 100 ! Intrinsic code emission
 101
 102 MACRO: check-elements ( quots -- quot )
 103     [ length '[ _ firstn ] ]
 104     [ '[ _ spread ] ]
 105     [ length 1 - \ and <repetition> [ ] like ]
 106     tri 3append ;
 107
 108 ERROR: bad-simd-intrinsic node ;
 109
 110 MACRO: if-literals-match ( quots -- quot )
 111     [ length ] [ ] [ length ] tri
 112     ! n quots n
 113     '[
 114         ! node quot
 115         [
 116             dup node-input-infos
 117             _ tail-slice* [ literal>> ] map
 118             dup _ check-elements
 119         ] dip
 120         swap [
 121             ! node literals quot
 122             [ _ firstn ] dip call
 123             drop
 124         ] [ 2drop bad-simd-intrinsic ] if
 125     ] ;
 126
 127 CONSTANT: [unary]        [ ds-drop  ds-pop ]
 128 CONSTANT: [unary/param]  [ [ -2 <ds-loc> inc-stack ds-pop ] dip ]
 129 CONSTANT: [binary]       [ ds-drop 2inputs ]
 130 CONSTANT: [binary/param] [ [ -2 <ds-loc> inc-stack 2inputs ] dip ]
 131 CONSTANT: [quaternary]
 132     [
 133         ds-drop
 134         D 3 peek-loc
 135         D 2 peek-loc
 136         D 1 peek-loc
 137         D 0 peek-loc
 138         -4 <ds-loc> inc-stack
 139     ]
 140
 141 :: [emit-vector-op] ( trials params-quot op-quot literal-preds -- quot )
 142     params-quot trials op-quot literal-preds
 143     '[ [ _ dip _ @ ds-push ] _ if-literals-match ] ;
 144
 145 MACRO: emit-v-vector-op ( trials -- quot )
 146     [unary] [ v-vector-op ] { [ representation? ] } [emit-vector-op] ;
 147 MACRO: emit-vl-vector-op ( trials literal-pred -- quot )
 148     [ [unary/param] [ vl-vector-op ] { [ representation? ] } ] dip prefix [emit-vector-op] ;
 149 MACRO: emit-vv-vector-op ( trials -- quot )
 150     [binary] [ vv-vector-op ] { [ representation? ] } [emit-vector-op] ;
 151 MACRO: emit-vvl-vector-op ( trials literal-pred -- quot )
 152     [ [binary/param] [ vvl-vector-op ] { [ representation? ] } ] dip prefix [emit-vector-op] ;
 153 MACRO: emit-vvvv-vector-op ( trials -- quot )
 154     [quaternary] [ vvvv-vector-op ] { [ representation? ] } [emit-vector-op] ;
 155
 156 MACRO:: emit-vv-or-vl-vector-op ( var-trials imm-trials literal-pred -- quot )
 157     literal-pred imm-trials literal-pred var-trials
 158     '[
 159         dup node-input-infos 2 tail-slice* first literal>> @
 160         [ _ _ emit-vl-vector-op ]
 161         [ _   emit-vv-vector-op ] if
 162     ] ;