1 ! Copyright (C) 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien.c-types combinators kernel locals system namespaces
4 compiler.codegen.fixup compiler.constants
5 compiler.cfg.comparisons compiler.cfg.intrinsics
6 cpu.architecture cpu.x86 cpu.x86.assembler
7 cpu.x86.assembler.operands ;
10 ! x87 unit is only used if SSE2 is not available.
12 : copy-register-x87 ( dst src -- )
13 2dup eq? [ 2drop ] [ FLD shuffle-down FSTP ] if ;
15 M: float-rep copy-register* drop copy-register-x87 ;
16 M: double-rep copy-register* drop copy-register-x87 ;
18 : load-x87 ( dst src rep -- )
20 { float-rep [ FLDS shuffle-down FSTP ] }
21 { double-rep [ FLDL shuffle-down FSTP ] }
24 : store-x87 ( dst src rep -- )
26 { float-rep [ FLD FSTPS ] }
27 { double-rep [ FLD FSTPL ] }
30 : copy-memory-x87 ( dst src rep -- )
32 { [ pick register? ] [ load-x87 ] }
33 { [ over register? ] [ store-x87 ] }
36 M: float-rep copy-memory* copy-memory-x87 ;
37 M: double-rep copy-memory* copy-memory-x87 ;
41 float <ref> rc-absolute rel-binary-literal
46 double <ref> rc-absolute rel-binary-literal
49 :: binary-op ( dst src1 src2 quot -- )
51 ST0 src2 shuffle-down quot call
52 dst shuffle-down FSTP ; inline
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 ;
59 M: x86 %sqrt FLD FSQRT shuffle-down FSTP ;
61 M: x86 %single>double-float copy-register-x87 ;
62 M: x86 %double>single-float copy-register-x87 ;
64 M: x86 integer-float-needs-stack-frame? t ;
66 M:: x86 %integer>float ( dst src -- )
69 dst shuffle-down FSTP ;
71 M:: x86 %float>integer ( dst src -- )
84 :: compare-op ( src1 src2 quot -- )
86 src2 shuffle-down quot call
89 M: x86 %compare-float-ordered ( dst src1 src2 cc temp -- )
90 [ [ FCOMI ] compare-op ] (%compare-float) ;
92 M: x86 %compare-float-unordered ( dst src1 src2 cc temp -- )
93 [ [ FUCOMI ] compare-op ] (%compare-float) ;
95 M: x86 %compare-float-ordered-branch ( label src1 src2 cc -- )
96 [ [ FCOMI ] compare-op ] (%compare-float-branch) ;
98 M: x86 %compare-float-unordered-branch ( label src1 src2 cc -- )
99 [ [ FUCOMI ] compare-op ] (%compare-float-branch) ;
101 enable-float-intrinsics