basis/math/vectors/simd/alien/alien-tests.factor

   1 USING: cpu.architecture math.vectors.simd
   2 math.vectors.simd.intrinsics accessors math.vectors.simd.alien
   3 kernel classes.struct tools.test compiler sequences byte-arrays
   4 alien math kernel.private specialized-arrays combinators ;
   5 SPECIALIZED-ARRAY: float
   6 IN: math.vectors.simd.alien.tests
   7
   8 ! Vector alien intrinsics
   9 [ float-4{ 1 2 3 4 } ] [
  10     [
  11         float-4{ 1 2 3 4 }
  12         underlying>> 0 float-4-rep alien-vector
  13     ] compile-call float-4 boa
  14 ] unit-test
  15
  16 [ B{ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 } ] [
  17     16 [ 1 ] B{ } replicate-as 16 <byte-array>
  18     [
  19         0 [
  20             { byte-array c-ptr fixnum } declare
  21             float-4-rep set-alien-vector
  22         ] compile-call
  23     ] keep
  24 ] unit-test
  25
  26 [ float-array{ 1 2 3 4 } ] [
  27     [
  28         float-array{ 1 2 3 4 } underlying>>
  29         float-array{ 4 3 2 1 } clone
  30         [ underlying>> 0 float-4-rep set-alien-vector ] keep
  31     ] compile-call
  32 ] unit-test
  33
  34 STRUCT: simd-struct
  35 { x float-4 }
  36 { y double-2 }
  37 { z double-4 }
  38 { w float-8 } ;
  39
  40 [ t ] [ [ simd-struct <struct> ] compile-call >c-ptr [ 0 = ] all? ] unit-test
  41
  42 [
  43     float-4{ 1 2 3 4 }
  44     double-2{ 2 1 }
  45     double-4{ 4 3 2 1 }
  46     float-8{ 1 2 3 4 5 6 7 8 }
  47 ] [
  48     simd-struct <struct>
  49     float-4{ 1 2 3 4 } >>x
  50     double-2{ 2 1 } >>y
  51     double-4{ 4 3 2 1 } >>z
  52     float-8{ 1 2 3 4 5 6 7 8 } >>w
  53     { [ x>> ] [ y>> ] [ z>> ] [ w>> ] } cleave
  54 ] unit-test
  55
  56 [
  57     float-4{ 1 2 3 4 }
  58     double-2{ 2 1 }
  59     double-4{ 4 3 2 1 }
  60     float-8{ 1 2 3 4 5 6 7 8 }
  61 ] [
  62     [
  63         simd-struct <struct>
  64         float-4{ 1 2 3 4 } >>x
  65         double-2{ 2 1 } >>y
  66         double-4{ 4 3 2 1 } >>z
  67         float-8{ 1 2 3 4 5 6 7 8 } >>w
  68         { [ x>> ] [ y>> ] [ z>> ] [ w>> ] } cleave
  69     ] compile-call
  70 ] unit-test