]> gitweb.factorcode.org Git - factor.git/commitdiff
fix fixnum+ and fixnum- overflow
authorSlava Pestov <slava@factorcode.org>
Tue, 10 May 2005 04:09:16 +0000 (04:09 +0000)
committerSlava Pestov <slava@factorcode.org>
Tue, 10 May 2005 04:09:16 +0000 (04:09 +0000)
library/compiler/x86/fixnum.factor
library/compiler/x86/generator.factor
library/test/compiler/intrinsics.factor

index 4baffd5de6d581fdc0f46735dea637a1f4eb7cef..ad588a56072624cd147913de042548484da523d2 100644 (file)
@@ -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
index 9a26c2649314048c13d3a4161143a9527d326db3..31c4fd04bd04659cd0415ead22867881770f850d 100644 (file)
@@ -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 )
index 72e20a2766ca2c426efc316eb17a5b862440d2e5..2e04847bea4baf6c0147c18fadab1580bfa33ac9 100644 (file)
@@ -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