basis/cpu/x86/sse2/sse2.factor

   1 ! Copyright (C) 2005, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien alien.accessors arrays cpu.x86.assembler
   4 cpu.x86.architecture cpu.x86.intrinsics generic kernel
   5 kernel.private math math.private memory namespaces sequences
   6 words compiler.generator compiler.generator.registers
   7 cpu.architecture math.floats.private layouts quotations ;
   8 IN: cpu.x86.sse2
   9
  10 : define-float-op ( word op -- )
  11     [ "x" operand "y" operand ] swap suffix H{
  12         { +input+ { { float "x" } { float "y" } } }
  13         { +output+ { "x" } }
  14     } define-intrinsic ;
  15
  16 {
  17     { float+ ADDSD }
  18     { float- SUBSD }
  19     { float* MULSD }
  20     { float/f DIVSD }
  21 } [
  22     first2 define-float-op
  23 ] each
  24
  25 : define-float-jump ( word op -- )
  26     [ "x" operand "y" operand UCOMISD ] swap suffix
  27     { { float "x" } { float "y" } } define-if-intrinsic ;
  28
  29 {
  30     { float< JAE }
  31     { float<= JA }
  32     { float> JBE }
  33     { float>= JB }
  34     { float= JNE }
  35 } [
  36     first2 define-float-jump
  37 ] each
  38
  39 \ float>fixnum [
  40     "out" operand "in" operand CVTTSD2SI
  41     "out" operand tag-bits get SHL
  42 ] H{
  43     { +input+ { { float "in" } } }
  44     { +scratch+ { { f "out" } } }
  45     { +output+ { "out" } }
  46 } define-intrinsic
  47
  48 \ fixnum>float [
  49     "in" operand %untag-fixnum
  50     "out" operand "in" operand CVTSI2SD
  51 ] H{
  52     { +input+ { { f "in" } } }
  53     { +scratch+ { { float "out" } } }
  54     { +output+ { "out" } }
  55     { +clobber+ { "in" } }
  56 } define-intrinsic
  57
  58 : alien-float-get-template
  59     H{
  60         { +input+ {
  61             { unboxed-c-ptr "alien" c-ptr }
  62             { f "offset" fixnum }
  63         } }
  64         { +scratch+ { { float "value" } } }
  65         { +output+ { "value" } }
  66         { +clobber+ { "offset" } }
  67     } ;
  68
  69 : alien-float-set-template
  70     H{
  71         { +input+ {
  72             { float "value" float }
  73             { unboxed-c-ptr "alien" c-ptr }
  74             { f "offset" fixnum }
  75         } }
  76         { +clobber+ { "offset" } }
  77     } ;
  78
  79 : define-alien-float-intrinsics ( word get-quot word set-quot -- )
  80     [ "value" operand swap %alien-accessor ] curry
  81     alien-float-set-template
  82     define-intrinsic
  83     [ "value" operand swap %alien-accessor ] curry
  84     alien-float-get-template
  85     define-intrinsic ;
  86
  87 \ alien-double
  88 [ MOVSD ]
  89 \ set-alien-double
  90 [ swap MOVSD ]
  91 define-alien-float-intrinsics
  92
  93 \ alien-float
  94 [ dupd MOVSS dup CVTSS2SD ]
  95 \ set-alien-float
  96 [ swap dup dup CVTSD2SS MOVSS ]
  97 define-alien-float-intrinsics