From ce985afd8970fa4997d41a274de00564e3ab75c2 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Tue, 10 May 2005 04:09:16 +0000
Subject: [PATCH] fix fixnum+ and fixnum- overflow

---
 library/compiler/x86/fixnum.factor      | 36 ++++++++++++++++++-------
 library/compiler/x86/generator.factor   |  2 +-
 library/test/compiler/intrinsics.factor |  3 +++
 3 files changed, 30 insertions(+), 11 deletions(-)

diff --git a/library/compiler/x86/fixnum.factor b/library/compiler/x86/fixnum.factor
index 4baffd5de6..ad588a5607 100644
--- a/library/compiler/x86/fixnum.factor
+++ b/library/compiler/x86/fixnum.factor
@@ -4,17 +4,33 @@ IN: compiler-backend
 USING: assembler compiler errors kernel math math-internals
 memory namespaces words ;
 
-: simple-overflow ( dest -- )
+: literal-overflow
+    #! If the src operand is a literal.
+    ! Untag the operand.
+    over tag-bits SAR
+    tag-bits neg shift ;
+
+: computed-overflow
+    #! If the src operand is a register.
+    ! Untag both operands.
+    2dup  tag-bits SAR  tag-bits SAR ;
+
+: simple-overflow ( dest src inv word -- )
     #! If the previous arithmetic operation overflowed, then we
-    #! turn the result into a bignum and leave it in EAX. This
-    #! does not trigger a GC if memory is full -- is that bad?
+    #! turn the result into a bignum and leave it in EAX.
+    >r >r
     <label> "end" set
     "end" get JNO
-    ! There was an overflow. Untag the fixnum and add the carry.
-    ! Thanks to Dazhbog for figuring out this trick.
-    dup 1 RCR
-    dup 2 SAR
-    ! Create a bignum
+    ! There was an overflow. Recompute the original operand.
+    2dup r> execute
+    dup integer? [
+        literal-overflow
+    ] [
+        computed-overflow
+    ] ifte
+    ! Compute a result, this time it will fit.
+    dupd r> execute
+    ! Create a bignum.
     PUSH
     "s48_long_to_bignum" f compile-c-call
     ! An untagged pointer to the bignum is now in EAX; tag it
@@ -23,10 +39,10 @@ memory namespaces words ;
     "end" get save-xt ;
 
 M: %fixnum+ generate-node ( vop -- )
-    dest/src dupd ADD  simple-overflow ;
+    dest/src 2dup ADD  \ SUB \ ADD simple-overflow ;
 
 M: %fixnum- generate-node ( vop -- )
-    dest/src dupd SUB  simple-overflow ;
+    dest/src 2dup SUB  \ ADD \ SUB simple-overflow ;
 
 M: %fixnum* generate-node ( vop -- )
     drop
diff --git a/library/compiler/x86/generator.factor b/library/compiler/x86/generator.factor
index 9a26c26493..31c4fd04bd 100644
--- a/library/compiler/x86/generator.factor
+++ b/library/compiler/x86/generator.factor
@@ -5,7 +5,7 @@ USING: alien assembler compiler inference kernel
 kernel-internals lists math memory namespaces sequences words ;
 
 GENERIC: v>operand
-M: integer v>operand address ;
+M: integer v>operand tag-bits shift ;
 M: vreg v>operand vreg-n { EAX ECX EDX } nth ;
 
 : dest/src ( vop -- dest src )
diff --git a/library/test/compiler/intrinsics.factor b/library/test/compiler/intrinsics.factor
index 72e20a2766..2e04847bea 100644
--- a/library/test/compiler/intrinsics.factor
+++ b/library/test/compiler/intrinsics.factor
@@ -48,6 +48,9 @@ math-internals test words ;
 [ 11 ] [ 12 [ 7 fixnum-bitxor ] compile-1 ] unit-test
 [ 11 ] [ [ 12 7 fixnum-bitxor ] compile-1 ] unit-test
 
+[ HEX: 10000000 ] [ HEX: -10000000 >fixnum [ 0 swap fixnum- ] compile-1 ] unit-test
+[ HEX: 10000000 ] [ HEX: -fffffff >fixnum [ 1 swap fixnum- ] compile-1 ] unit-test
+
 [ 4294967296 ] [ 1 32 [ fixnum-shift ] compile-1 ] unit-test
 [ 4294967296 ] [ 1 [ 32 fixnum-shift ] compile-1 ] unit-test
 [ 4294967296 ] [ 1 [ 16 fixnum-shift 16 fixnum-shift ] compile-1 ] unit-test