Disable fixnum* intrinsic for now

diff --git a/library/compiler/pentium4/intrinsics.factor b/library/compiler/pentium4/intrinsics.factor
index cc8b2d6db17b2b0d763db8f66d4092d4f6c5d292..9e4f49ca6ae37d7b4892e3546a5a643e2dadf3b8 100644 (file)
--- a/library/compiler/pentium4/intrinsics.factor
+++ b/library/compiler/pentium4/intrinsics.factor
@@ -11,7 +11,6 @@ M: float-regs (%peek)
 
 M: float-regs (%replace) drop swap %allot-float ;
 
-! Floats
 : define-float-op ( word op -- )
     [ "x" operand "y" operand ] swap add H{
         { +input+ { { float "x" } { float "y" } } }

diff --git a/library/compiler/ppc/intrinsics.factor b/library/compiler/ppc/intrinsics.factor
index e69b124770f4686373b6426a3ebd76af6b315a71..eece3f85458015b372859853f78260ed67512c2f 100644 (file)
--- a/library/compiler/ppc/intrinsics.factor
+++ b/library/compiler/ppc/intrinsics.factor
@@ -216,22 +216,22 @@ math-internals namespaces sequences words ;
     { +clobber+ { "y" } }
 } define-intrinsic
 
-! \ fixnum>bignum [
-!     "nonzero" define-label
-!     "end" define-label
-!     0 "x" operand 0 CMPI ! is it zero?
-!     "nonzero" get BNE
-!     0 >bignum "x" get load-literal
-!     "end" get B
-!     "nonzero" resolve-label
-!     "x" operand dup %untag-fixnum
-!     "x" operand %allot-bignum-signed-1
-!     "end" resolve-label
-! ] H{
-!     { +input+ { { f "x" } } }
-!     { +output+ { "x" } }
-! } define-intrinsic
-! 
+\ fixnum>bignum [
+    "nonzero" define-label
+    "end" define-label
+    0 "x" operand 0 CMPI ! is it zero?
+    "nonzero" get BNE
+    0 >bignum "x" get load-literal
+    "end" get B
+    "nonzero" resolve-label
+    "x" operand dup %untag-fixnum
+    "x" operand %allot-bignum-signed-1
+    "end" resolve-label
+] H{
+    { +input+ { { f "x" } } }
+    { +output+ { "x" } }
+} define-intrinsic
+
 ! \ bignum>fixnum [
 !     "nonzero" define-label
 !     "end" define-label

diff --git a/library/compiler/x86/allot.factor b/library/compiler/x86/allot.factor
index 26de9994e38b4104e3dacfbf803695da514bb819..eab550dd0f4815aa5a383e7264467b997c5b8670 100644 (file)
--- a/library/compiler/x86/allot.factor
+++ b/library/compiler/x86/allot.factor
@@ -69,15 +69,33 @@ USING: kernel assembler kernel-internals namespaces math ;
         ] %allot-bignum
     ] with-scope ;
 
+: bignum-radix-mask 1 cell 2 - shift 1- ;
+
 : %allot-bignum-signed-2 ( reg1 reg2 -- )
-    #! on entry, reg1 and reg2 together form a signed 64-bit
-    #! quantity.
+    #! this word has some hairy restrictions; its really only
+    #! intended to be used by fixnum*.
+    #! - reg1 and reg2 together form a 60-bit signed quantity
+    #!   (product of two 29-bit fixnums cannot exceed this)
+    #! - the quantity must be non-zero
+    #!   (if the product of two fixnums is zero, there's no
+    #!   overflow so this word won't be called in that case)
     #! exits with tagged ptr to bignum in reg1
     [
+        "positive" define-label
+        "end" define-label
         2 [
-            ! todo: neg
-            allot-tmp-reg 2 cells [+] 0 MOV ! positive sign
+            0 pick CMP
+            "positive" get JGE
+            allot-tmp-reg 2 cells [+] 1 MOV
+            over NOT
+            dup -1 IMUL
+            "end" get JMP
+            "positive" resolve-label
+            allot-tmp-reg 2 cells [+] 0 MOV
+            "end" resolve-label
+            dup bignum-radix-mask AND
             allot-tmp-reg 3 cells [+] swap MOV
+            dup bignum-radix-mask AND
             allot-tmp-reg 4 cells [+] over MOV
             allot-tmp-reg bignum-tag OR
             allot-tmp-reg MOV

diff --git a/library/compiler/x86/intrinsics.factor b/library/compiler/x86/intrinsics.factor
index 3fd6a502cb92db679fd60208052da7f775454241..00dc9c2660c70f1177a0388f1035ca8b117e1d2a 100644 (file)
--- a/library/compiler/x86/intrinsics.factor
+++ b/library/compiler/x86/intrinsics.factor
@@ -189,24 +189,24 @@ IN: compiler
     "x" operand "y" operand %allot-bignum-signed-1 ! Yes, box bignum
     ;
 
-\ fixnum* [
-    "overflow-1" define-label
-    "overflow-2" define-label
-    "end" define-label
-    { "y" "x" } %untag-fixnums
-    "y" operand IMUL
-    "overflow-1" get JNO
-    "x" operand "r" operand %allot-bignum-signed-2
-    "end" get JMP
-    "overflow-1" resolve-label
-    %tag-overflow
-    "end" resolve-label
-] H{
-    { +input+ { { 0 "x" } { 1 "y" } } }
-    { +output+ { "x" } }
-    { +scratch+ { { 2 "r" } } }
-    { +clobber+ { "y" } }
-} define-intrinsic
+! \ fixnum* [
+!     "overflow-1" define-label
+!     "overflow-2" define-label
+!     "end" define-label
+!     { "y" "x" } %untag-fixnums
+!     "y" operand IMUL
+!     "overflow-1" get JNO
+!     "x" operand "r" operand %allot-bignum-signed-2
+!     "end" get JMP
+!     "overflow-1" resolve-label
+!     %tag-overflow
+!     "end" resolve-label
+! ] H{
+!     { +input+ { { 0 "x" } { 1 "y" } } }
+!     { +output+ { "x" } }
+!     { +scratch+ { { 2 "r" } } }
+!     { +clobber+ { "y" } }
+! } define-intrinsic
 
 : generate-fixnum/mod
     #! The same code is used for fixnum/i and fixnum/mod.