From 89b85307d657b23ff99bd55bc4eb55955b2a5af3 Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Fri, 10 Nov 2006 08:33:07 +0000
Subject: [PATCH] x86 intrinsic fixnum>bignum bignum>fixnum

---
 TODO.FACTOR.txt                        |  2 +-
 library/compiler/x86/intrinsics.factor | 47 ++++++++++++++++++++++++++
 2 files changed, 48 insertions(+), 1 deletion(-)

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index b30c33587f..4826560c40 100644
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -44,7 +44,7 @@
 - cross-word type inference
 - callback scheduling issue
 - amd64 structs-by-value bug
-- intrinsic fixnum>float float>fixnum fixnum>bignum bignum>fixnum
+- intrinsic fixnum>float float>fixnum
 - we may be able to remove the dlsym primitive
 - [ [ dup call ] dup call ] infer hangs
 - stdcall callbacks
diff --git a/library/compiler/x86/intrinsics.factor b/library/compiler/x86/intrinsics.factor
index 00dc9c2660..780f2f0858 100644
--- a/library/compiler/x86/intrinsics.factor
+++ b/library/compiler/x86/intrinsics.factor
@@ -246,6 +246,53 @@ IN: compiler
     first2 define-fixnum-jump
 ] each
 
+\ fixnum>bignum [
+    "nonzero" define-label
+    "end" define-label
+    "x" operand 0 CMP ! is it zero?
+    "nonzero" get JNE
+    0 >bignum "x" get load-literal
+    "end" get JMP
+    "nonzero" resolve-label
+    "x" operand tag-bits SAR
+    "x" operand dup %allot-bignum-signed-1
+    "end" resolve-label
+] H{
+    { +input+ { { f "x" } } }
+    { +output+ { "x" } }
+} define-intrinsic
+
+\ bignum>fixnum [
+    "nonzero" define-label
+    "positive" define-label
+    "end" define-label
+    "x" operand %untag
+    "y" operand "x" operand cell [+] MOV
+     ! if the length is 1, its just the sign and nothing else,
+     ! so output 0
+    "y" operand 1 tag-bits shift CMP
+    "nonzero" get JMP
+    "y" operand 0 MOV
+    "end" get JMP
+    "nonzero" resolve-label
+    ! load the value
+    "y" operand "x" operand 3 cells [+] MOV
+    ! load the sign
+    "x" operand "x" operand 2 cells [+] MOV
+    ! is the sign negative?
+    "x" operand 0 CMP
+    "positive" get JMP
+    "y" operand -1 IMUL2
+    "positive" resolve-label
+    "y" operand 3 SHL
+    "end" resolve-label
+] H{
+    { +input+ { { f "x" } } }
+    { +scratch+ { { f "y" } } }
+    { +clobber+ { "x" } }
+    { +output+ { "y" } }
+} define-intrinsic
+
 ! User environment
 : %userenv ( -- )
     "x" operand 0 MOV