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

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors byte-arrays fry cpu.architecture kernel
   4 sequences compiler.tree.propagation.info
   5 compiler.cfg.builder.blocks compiler.cfg.stacks
   6 compiler.cfg.stacks.local compiler.cfg.hats
   7 compiler.cfg.instructions compiler.cfg.registers
   8 compiler.cfg.intrinsics.alien ;
   9 IN: compiler.cfg.intrinsics.simd
  10
  11 : emit-vector-op ( node quot: ( rep -- ) -- )
  12     [ dup node-input-infos last literal>> ] dip over representation?
  13     [ [ drop ] 2dip call ] [ 2drop emit-primitive ] if ; inline
  14
  15 : emit-binary-vector-op ( node quot -- )
  16     '[ [ ds-drop 2inputs ] dip @ ds-push ] emit-vector-op ; inline
  17
  18 : emit-unary-vector-op ( node quot -- )
  19     '[ [ ds-drop ds-pop ] dip @ ds-push ] emit-vector-op ; inline
  20
  21 : emit-gather-vector-2 ( node -- )
  22     [ ^^gather-vector-2 ] emit-binary-vector-op ;
  23
  24 : emit-gather-vector-4 ( node -- )
  25     [
  26         ds-drop
  27         [
  28             D 3 peek-loc
  29             D 2 peek-loc
  30             D 1 peek-loc
  31             D 0 peek-loc
  32             -4 inc-d
  33         ] dip
  34         ^^gather-vector-4
  35         ds-push
  36     ] emit-vector-op ;
  37
  38 : emit-alien-vector ( node -- )
  39     dup [
  40         '[
  41             ds-drop prepare-alien-getter
  42             _ ^^alien-vector ds-push
  43         ]
  44         [ inline-alien-getter? ] inline-alien
  45     ] with emit-vector-op ;
  46
  47 : emit-set-alien-vector ( node -- )
  48     dup [
  49         '[
  50             ds-drop prepare-alien-setter ds-pop
  51             _ ##set-alien-vector
  52         ]
  53         [ byte-array inline-alien-setter? ]
  54         inline-alien
  55     ] with emit-vector-op ;