x86 float>fixnum and fixnum>float intrinsics

TODO.FACTOR.txt

@@ -1,8 +1,7 @@
 + 0.87:
 
-- amd64 structs-by-value bug
+- claim: if module fails to load, reloading it doesn't work?
 - intrinsic fixnum>float float>fixnum
-- compiled call traces
 
 - fix search unit test
 - these things are "Too Slow":
@@ -37,6 +36,12 @@
 - robustify stepper -- see if step back past a throw works
 - httpd crash
 - fep when closing window
+- compiled call traces needs work:
+  - :trace is kind of slow
+  - should be independent of whenever the runtime was built with
+    -fomit-frame-pointer or not
+  - doesn't show #labels
+  - we don't know if signal handlers run with the same stack or not
 
 + ui:
 
@@ -62,6 +67,7 @@
 
 + compiler/ffi:
 
+- amd64 structs-by-value bug
 - %allot-bignum-signed-2 is broken on both platforms
 - we may be able to remove the dlsym primitive
 - [ [ dup call ] dup call ] infer hangs

library/compiler/pentium4/intrinsics.factor

@@ -39,3 +39,21 @@ M: float-regs (%replace) drop swap %allot-float ;
 } [
     first2 define-float-jump
 ] each
+
+\ float>fixnum [
+    "out" operand "in" operand CVTSD2SI
+    "out" operand tag-bits SHL
+] H{
+    { +input+ { { float "in" } } }
+    { +scratch+ { { f "out" } } }
+    { +output+ { "out" } }
+} define-intrinsic
+
+\ fixnum>float [
+    "in" operand tag-bits SAR
+    "out" operand "in" operand CVTSI2SD
+] H{
+    { +input+ { { f "in" } } }
+    { +scratch+ { { float "out" } } }
+    { +output+ { "out" } }
+} define-intrinsic

library/compiler/x86/assembler.factor

@@ -391,13 +391,18 @@ M: integer IMUL2 swap dup reg-code t HEX: 69 immediate-1/4 ;
 
 ! SSE multimedia instructions
 
-: 2-operand-sse ( dst src op1 op2 -- )
-    #! We swap the operands here to make everything consistent
-    #! with the integer instructions.
-    swap , pick register-128? [ swapd ] [ 1 bitor ] if
+: (2-operand-sse)
     >r 2dup t prefix HEX: 0f , r>
     , reg-code swap addressing ;
 
+: 2-operand-sse ( dst src op1 op2 -- )
+    swap , pick register-128? [ swapd ] [ 1 bitor ] if
+    (2-operand-sse) ;
+
+: 2-operand-int/sse ( dst src op1 op2 -- )
+    swap , over register-128? [ swapd ] [ 1 bitor ] if
+    (2-operand-sse) ;
+
 : MOVSS ( dest src -- ) HEX: f3 HEX: 10 2-operand-sse ;
 : MOVSD ( dest src -- ) HEX: f2 HEX: 10 2-operand-sse ;
 : ADDSD ( dest src -- ) HEX: f2 HEX: 58 2-operand-sse ;
@@ -408,4 +413,4 @@ M: integer IMUL2 swap dup reg-code t HEX: 69 immediate-1/4 ;
 : UCOMISD ( dest src -- ) HEX: 66 HEX: 2e 2-operand-sse ;
 : COMISD ( dest src -- ) HEX: 66 HEX: 2f 2-operand-sse ;
 : CVTSI2SD ( dest src -- ) HEX: f2 HEX: 2a 2-operand-sse ;
-: CVTSD2SI ( dest src -- ) HEX: f2 HEX: 2d 2-operand-sse ;
+: CVTSD2SI ( dest src -- ) HEX: f2 HEX: 2d 2-operand-int/sse ;