basis/cpu/x86/x87/x87.factor

   1 ! Copyright (C) 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien.c-types alien.data combinators kernel locals system
   4 namespaces compiler.codegen.labels compiler.codegen.relocation
   5 compiler.constants compiler.cfg.comparisons
   6 compiler.cfg.intrinsics cpu.architecture cpu.x86
   7 cpu.x86.assembler cpu.x86.assembler.operands ;
   8 IN: cpu.x86.x87
   9
  10 ! x87 unit is only used if SSE2 is not available.
  11
  12 : copy-register-x87 ( dst src -- )
  13     2dup eq? [ 2drop ] [ FLD shuffle-down FSTP ] if ;
  14
  15 M: float-rep copy-register* drop copy-register-x87 ;
  16 M: double-rep copy-register* drop copy-register-x87 ;
  17
  18 : load-x87 ( dst src rep -- )
  19     {
  20         { float-rep [ FLDS shuffle-down FSTP ] }
  21         { double-rep [ FLDL shuffle-down FSTP ] }
  22     } case ;
  23
  24 : store-x87 ( dst src rep -- )
  25     {
  26         { float-rep [ FLD FSTPS ] }
  27         { double-rep [ FLD FSTPL ] }
  28     } case ;
  29
  30 : copy-memory-x87 ( dst src rep -- )
  31     {
  32         { [ pick register? ] [ load-x87 ] }
  33         { [ over register? ] [ store-x87 ] }
  34     } cond ;
  35
  36 M: float-rep copy-memory* copy-memory-x87 ;
  37 M: double-rep copy-memory* copy-memory-x87 ;
  38
  39 M: x86 %load-float
  40     0 [] FLDS
  41     float <ref> rc-absolute rel-binary-literal
  42     shuffle-down FSTP ;
  43
  44 M: x86 %load-double
  45     0 [] FLDL
  46     double <ref> rc-absolute rel-binary-literal
  47     shuffle-down FSTP ;
  48
  49 :: binary-op ( dst src1 src2 quot -- )
  50     src1 FLD
  51     ST0 src2 shuffle-down quot call
  52     dst shuffle-down FSTP ; inline
  53
  54 M: x86 %add-float [ FADD ] binary-op ;
  55 M: x86 %sub-float [ FSUB ] binary-op ;
  56 M: x86 %mul-float [ FMUL ] binary-op ;
  57 M: x86 %div-float [ FDIV ] binary-op ;
  58
  59 M: x86 %sqrt FLD FSQRT shuffle-down FSTP ;
  60
  61 M: x86 %single>double-float copy-register-x87 ;
  62 M: x86 %double>single-float copy-register-x87 ;
  63
  64 M: x86 integer-float-needs-stack-frame? t ;
  65
  66 M:: x86 %integer>float ( dst src -- )
  67     4 stack@ src MOV
  68     4 stack@ FILDD
  69     dst shuffle-down FSTP ;
  70
  71 M:: x86 %float>integer ( dst src -- )
  72     src FLD
  73     8 stack@ EAX MOV
  74     0 stack@ FNSTCW
  75     AX 0 stack@ MOV
  76     AH 12 <byte> MOV
  77     2 stack@ AX MOV
  78     2 stack@ FLDCW
  79     4 stack@ FISTPD
  80     0 stack@ FLDCW
  81     EAX 8 stack@ MOV
  82     dst 4 stack@ MOV ;
  83
  84 :: compare-op ( src1 src2 quot -- )
  85     src1 FLD
  86     src2 shuffle-down quot call
  87     ST0 FSTP ; inline
  88
  89 M: x86 %compare-float-ordered
  90     [ [ FCOMI ] compare-op ] (%compare-float) ;
  91
  92 M: x86 %compare-float-unordered
  93     [ [ FUCOMI ] compare-op ] (%compare-float) ;
  94
  95 M: x86 %compare-float-ordered-branch
  96     [ [ FCOMI ] compare-op ] (%compare-float-branch) ;
  97
  98 M: x86 %compare-float-unordered-branch
  99     [ [ FUCOMI ] compare-op ] (%compare-float-branch) ;