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 ;
10 : define-float-op ( word op -- )
11 [ "x" operand "y" operand ] swap suffix H{
12 { +input+ { { float "x" } { float "y" } } }
22 first2 define-float-op
25 : define-float-jump ( word op -- )
26 [ "x" operand "y" operand UCOMISD ] swap suffix
27 { { float "x" } { float "y" } } define-if-intrinsic ;
36 first2 define-float-jump
40 "out" operand "in" operand CVTTSD2SI
41 "out" operand tag-bits get SHL
43 { +input+ { { float "in" } } }
44 { +scratch+ { { f "out" } } }
45 { +output+ { "out" } }
49 "in" operand %untag-fixnum
50 "out" operand "in" operand CVTSI2SD
52 { +input+ { { f "in" } } }
53 { +scratch+ { { float "out" } } }
54 { +output+ { "out" } }
55 { +clobber+ { "in" } }
58 : alien-float-get-template
61 { unboxed-c-ptr "alien" c-ptr }
64 { +scratch+ { { float "value" } } }
65 { +output+ { "value" } }
66 { +clobber+ { "offset" } }
69 : alien-float-set-template
72 { float "value" float }
73 { unboxed-c-ptr "alien" c-ptr }
76 { +clobber+ { "offset" } }
79 : define-alien-float-intrinsics ( word get-quot word set-quot -- )
80 [ "value" operand swap %alien-accessor ] curry
81 alien-float-set-template
83 [ "value" operand swap %alien-accessor ] curry
84 alien-float-get-template
91 define-alien-float-intrinsics
94 [ dupd MOVSS dup CVTSS2SD ]
96 [ swap dup dup CVTSD2SS MOVSS ]
97 define-alien-float-intrinsics