bignums are done

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 836ccd78b1e2707679df5f1509e7c5b2ea25a08b..b6cacd1dd572d285e98e6c02687934f3268d1b5c 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,11 +1,7 @@
 + bignums:\r
 \r
-- change shift< and shift> to ash\r
 - cached 0/-1/1 should be cross compiled in image\r
 - bignum cross compiling\r
-- upgrading fixnums does not work with shift</shift>\r
-- ash is inefficient: arg 2 is upgraded to bignum then back\r
-  to long\r
 - move some s48_ functions into bignum.c\r
 - remove unused functions\r
 - clean up type coercions in arithmetic.c\r
@@ -17,6 +13,7 @@
 \r
 + docs:\r
 \r
+- USE: arithmetic in numbers game\r
 - numbers section\r
 - examples of assoc usage\r
 - unparse examples, and difference from prettyprint\r

diff --git a/factor/math/FactorMath.java b/factor/math/FactorMath.java
index ff2b4819521145ed9174bba1cce07dee388d36bc..16a2ed1f51e4a86962d606a4a5d0188cc902f739 100644 (file)
--- a/factor/math/FactorMath.java
+++ b/factor/math/FactorMath.java
@@ -172,11 +172,17 @@ public class FactorMath
        } //}}}
 
        //{{{ shiftLeft() method
-       public static Number shiftLeft(Number x, int by)
+       public static Number shift(Number x, int by)
        {
                if(by < 0)
-                       throw new ArithmeticException("Cannot shift by negative amount");
+                       return shiftRight(x,-by);
+               else
+                       return shiftLeft(x,by);
+       } //}}}
 
+       //{{{ shiftLeft() method
+       public static Number shiftLeft(Number x, int by)
+       {
                if(x instanceof BigInteger)
                        return ((BigInteger)x).shiftLeft(by);
                else if(x instanceof Integer)
@@ -185,7 +191,7 @@ public class FactorMath
                        if(by >= 32)
                                return BigInteger.valueOf(ix).shiftLeft(by);
                        else
-                               return longToNumber(ix << by);
+                               return longToNumber((long)ix << by);
                }
                else
                        return BigInteger.valueOf(x.longValue()).shiftLeft(by);
@@ -194,27 +200,12 @@ public class FactorMath
        //{{{ shiftRight() method
        public static Number shiftRight(Number x, int by)
        {
-               if(by < 0)
-                       throw new ArithmeticException("Cannot shift by negative amount");
-
                if(x instanceof BigInteger)
                        return ((BigInteger)x).shiftRight(by);
                else
                        return longToNumber(x.longValue() >> by);
        } //}}}
 
-       //{{{ shiftRightUnsigned() method
-       public static Number shiftRightUnsigned(Number x, int by)
-       {
-               if(by < 0)
-                       throw new ArithmeticException("Cannot shift by negative amount");
-
-               if(x instanceof BigInteger)
-                       throw new RuntimeException();
-               else
-                       return longToNumber(x.longValue() >>> by);
-       } //}}}
-
        //{{{ _divide() method
        /**
         * Truncating division.

diff --git a/library/cross-compiler.factor b/library/cross-compiler.factor
index 24dabb7b1962233a080ae52668bba91041432040..4e3cfbf39a0923f49f857bc4481dce48d80c9571 100644 (file)
--- a/library/cross-compiler.factor
+++ b/library/cross-compiler.factor
@@ -172,8 +172,7 @@ IN: cross-compiler
         bitor
         bitxor
         bitnot
-        shift<
-        shift>
+        shift
         <
         <=
         >

diff --git a/library/image.factor b/library/image.factor
index 916466e6a27d8da0488688d01c8bb1ec86e455f4..60035a2b12cea29f2f032495466fc8cc113861c0 100644 (file)
--- a/library/image.factor
+++ b/library/image.factor
@@ -50,7 +50,7 @@ USE: words
 
 : lo/hi64 ( long -- hi lo )
     dup
-    32 shift>
+    -32 shift
     HEX: ffffffff bitand
     swap
     HEX: ffffffff bitand ;
@@ -92,7 +92,7 @@ USE: words
 : bignum-type 13 ;
 : float-type  14 ;
 
-: immediate ( x tag -- tagged ) swap tag-bits shift< bitor ;
+: immediate ( x tag -- tagged ) swap tag-bits shift bitor ;
 : >header ( id -- tagged ) header-tag immediate ;
 
 ( Image header )
@@ -214,7 +214,7 @@ DEFER: '
 ( Strings )
 
 : pack ( n n -- )
-    "big-endian" get [ swap ] when 16 shift< bitor emit ;
+    "big-endian" get [ swap ] when 16 shift bitor emit ;
 
 : pack-at ( n str -- )
     2dup str-nth rot succ rot str-nth pack ;

diff --git a/library/platform/jvm/arithmetic.factor b/library/platform/jvm/arithmetic.factor
index 3e3ecf60d2e8aee643413b14c4f6e517b87fae73..57d959e344241812b56d1d0ceae0b63aa435ad42 100644 (file)
--- a/library/platform/jvm/arithmetic.factor
+++ b/library/platform/jvm/arithmetic.factor
@@ -122,23 +122,10 @@ USE: stack
     "factor.math.FactorMath" "not"
     jinvoke-static ; inline
 
-: shift< ( x by -- )
+: shift ( x by -- )
     #! Shift 'by' bits to the left.
     [ "java.lang.Number" "int" ]
-    "factor.math.FactorMath" "shiftLeft"
-    jinvoke-static ; inline
-
-: shift> ( x by -- )
-    #! Shift 'by' bits to the right.
-    [ "java.lang.Number" "int" ]
-    "factor.math.FactorMath" "shiftRight"
-    jinvoke-static ; inline
-
-: shift>> ( x by -- )
-    #! Shift 'by' bits to the right, without performing sign
-    #! extension.
-    [ "java.lang.Number" "int" ]
-    "factor.math.FactorMath" "shiftRightUnsigned"
+    "factor.math.FactorMath" "shift"
     jinvoke-static ; inline
 
 : rem ( x y -- remainder )

diff --git a/library/platform/native/random.factor b/library/platform/native/random.factor
index 57d9edd464d1a0772d94b484545185fa7d667e18..278ebfdbb138974b18396fc2aeffd275686e4b57 100644 (file)
--- a/library/platform/native/random.factor
+++ b/library/platform/native/random.factor
@@ -42,7 +42,7 @@ USE: stack
 
 : random-int-0 ( max -- n )
     succ dup power-of-2? [
-        (random-int) * 31 shift>
+        (random-int) * -31 shift
     ] [
         (random-int) 2dup swap mod (random-int-0)
     ] ifte ;

diff --git a/library/platform/native/unparser.factor b/library/platform/native/unparser.factor
index 26d2129943b505dd86e9e966dba836b94e9e0e55..a5429efad0e4e66e581092572f56f725a5129d60 100644 (file)
--- a/library/platform/native/unparser.factor
+++ b/library/platform/native/unparser.factor
@@ -51,8 +51,8 @@ USE: words
 
 : >base ( num radix -- string )
     #! Convert a number to a string in a certain base.
-    <% dup 0 < [
-        neg integer% CHAR: - %
+    <% over 0 < [
+        swap neg swap integer% CHAR: - %
     ] [
         integer%
     ] ifte reverse%> ;

diff --git a/library/stdio-binary.factor b/library/stdio-binary.factor
index 8fac1e211e56fa93a6697ca6e880b2dd995958a0..1e9ae23cb471cb319f32a49fb4aaa4c77386d289 100644 (file)
--- a/library/stdio-binary.factor
+++ b/library/stdio-binary.factor
@@ -33,19 +33,19 @@ USE: strings
 
 : read-little-endian-32 ( -- word )
     read1
-    read1 8  shift< bitor
-    read1 16 shift< bitor
-    read1 24 shift< bitor ;
+    read1 8  shift bitor
+    read1 16 shift bitor
+    read1 24 shift bitor ;
 
 : read-big-endian-32 ( -- word )
-    read1 24 shift<
-    read1 16 shift< bitor
-    read1 8  shift< bitor
-    read1           bitor ;
+    read1 24 shift
+    read1 16 shift bitor
+    read1 8  shift bitor
+    read1          bitor ;
 
-: byte3 ( num -- byte ) 24 shift> HEX: ff bitand ;
-: byte2 ( num -- byte ) 16 shift> HEX: ff bitand ;
-: byte1 ( num -- byte )  8 shift> HEX: ff bitand ;
+: byte3 ( num -- byte ) -24 shift HEX: ff bitand ;
+: byte2 ( num -- byte ) -16 shift HEX: ff bitand ;
+: byte1 ( num -- byte )  -8 shift HEX: ff bitand ;
 : byte0 ( num -- byte )           HEX: ff bitand ;
 
 : write-little-endian-32 ( word -- )

diff --git a/library/stdio.factor b/library/stdio.factor
index 91608a1b2339461ca9e958b23ae93cc8924f0180..55a6b5c86c4656050714b5fa495fb5102b1ff0c8 100644 (file)
--- a/library/stdio.factor
+++ b/library/stdio.factor
@@ -66,7 +66,7 @@ USE: streams
     "stdio" get fwrite-attr ;
 
 : print ( string -- )
-    "stdio" get tuck fprint fflush ;
+    "stdio" get fprint ;
 
 : edit ( string -- )
     "stdio" get fedit ;

diff --git a/library/test/math/bignum.factor b/library/test/math/bignum.factor
index cfb2fd194e6f8636d5a10fd6060bb2a79bd88c90..124653e8c032fae6e0de1ec9a48dba03c4b1c23c 100644 (file)
--- a/library/test/math/bignum.factor
+++ b/library/test/math/bignum.factor
@@ -9,3 +9,11 @@ USE: unparser
 [ "8589934592" ]
 [ 134217728 dup + dup + dup + dup + dup + dup + unparse ]
 unit-test
+
+[ 256 ] [ 65536 -8 shift ] unit-test
+[ 256 ] [ 65536 >bignum -8 shift ] unit-test
+[ 256 ] [ 65536 -8 >bignum shift ] unit-test
+[ 256 ] [ 65536 >bignum -8 >bignum shift ] unit-test
+[ 4294967296 ] [ 1 16 shift 16 shift ] unit-test
+[ 4294967296 ] [ 1 32 shift ] unit-test
+[ 1267650600228229401496703205376 ] [ 1 100 shift ] unit-test

diff --git a/library/test/math/rational.factor b/library/test/math/rational.factor
index 0cc14158e3d2c88e3af829810bcf52ba6a9d7e4c..b9228d7c34c879a23423815fa18c8c64d808f42b 100644 (file)
--- a/library/test/math/rational.factor
+++ b/library/test/math/rational.factor
@@ -3,6 +3,9 @@ USE: arithmetic
 USE: kernel
 USE: stack
 USE: test
+USE: unparser
+
+[ "-8" ] [ -8 unparse ] unit-test
 
 [ t ] [ 0 fixnum? ] unit-test
 [ t ] [ 31415 number? ] unit-test

diff --git a/native/arithmetic.c b/native/arithmetic.c
index 7c726f77f256ba60580c292fc04fdd1f388d17b7..8a724db56b7c2c4c1b06647fa0c5a44bb41fe306 100644 (file)
--- a/native/arithmetic.c
+++ b/native/arithmetic.c
@@ -179,13 +179,7 @@ BINARY_OP_INTEGER_ONLY(xor)
 BINARY_OP_NUMBER_ONLY(xor)
 BINARY_OP(xor)
 
-BINARY_OP_INTEGER_ONLY(shiftleft)
-BINARY_OP_NUMBER_ONLY(shiftleft)
-BINARY_OP(shiftleft)
-
-BINARY_OP_INTEGER_ONLY(shiftright)
-BINARY_OP_NUMBER_ONLY(shiftright)
-BINARY_OP(shiftright)
+BINARY_OP_FIXNUM(shift)
 
 BINARY_OP_NUMBER_ONLY(less)
 BINARY_OP(less)

diff --git a/native/arithmetic.h b/native/arithmetic.h
index 63ffe38d55b55f3aad5990771405fa885dcae966..841ce90f6f2a004dbbc4e74dcff63d0333457fb0 100644 (file)
--- a/native/arithmetic.h
+++ b/native/arithmetic.h
@@ -42,6 +42,27 @@ void primitive_##OP(void) \
        dpush(OP(x,y)); \
 }
 
+#define BINARY_OP_FIXNUM(OP) \
+CELL OP(CELL x, FIXNUM y) \
+{ \
+       switch(type_of(x)) \
+       { \
+       case FIXNUM_TYPE: \
+               return OP##_fixnum(x,y); \
+       case BIGNUM_TYPE: \
+               return OP##_bignum(to_bignum(x),y); \
+       default: \
+               type_error(INTEGER_TYPE,x); \
+               return F; \
+       } \
+} \
+\
+void primitive_##OP(void) \
+{ \
+       CELL y = dpop(), x = dpop(); \
+       dpush(OP(x,to_fixnum(y))); \
+}
+
 #define BINARY_OP_INTEGER_ONLY(OP) \
 \
 CELL OP##_ratio(RATIO* x, RATIO* y) \
@@ -164,9 +185,7 @@ CELL or(CELL x, CELL y);
 void primitive_or(void);
 CELL xor(CELL x, CELL y);
 void primitive_xor(void);
-CELL shiftleft(CELL x, CELL y);
-void primitive_shiftleft(void);
-CELL shiftright(CELL x, CELL y);
-void primitive_shiftright(void);
+CELL shift(CELL x, FIXNUM y);
+void primitive_shift(void);
 CELL gcd(CELL x, CELL y);
 void primitive_gcd(void);

diff --git a/native/bignum.c b/native/bignum.c
index d7ce2e7c97b4b2f313673127bbbeaf688bdaed94..7129ff861cb9545baea2195d32559d6143b277fc 100644 (file)
--- a/native/bignum.c
+++ b/native/bignum.c
@@ -166,16 +166,9 @@ CELL xor_bignum(ARRAY* x, ARRAY* y)
        return tag_object(s48_bignum_bitwise_xor(x,y));
 }
 
-CELL shiftleft_bignum(ARRAY* x, ARRAY* y)
+CELL shift_bignum(ARRAY* x, FIXNUM y)
 {
-       return tag_object(s48_bignum_arithmetic_shift(x,
-               s48_bignum_to_long(y)));
-}
-
-CELL shiftright_bignum(ARRAY* x, ARRAY* y)
-{
-       return tag_object(s48_bignum_arithmetic_shift(x,
-               -s48_bignum_to_long(y)));
+       return tag_object(s48_bignum_arithmetic_shift(x,y));
 }
 
 CELL less_bignum(ARRAY* x, ARRAY* y)

diff --git a/native/bignum.h b/native/bignum.h
index 0fa23f4a31ebfb9c3401c08f9b1cd40ffa16a1ad..84efe04f3719fd19ed552302c6feb8d10488c70d 100644 (file)
--- a/native/bignum.h
+++ b/native/bignum.h
@@ -25,8 +25,7 @@ CELL mod_bignum(ARRAY* x, ARRAY* y);
 CELL and_bignum(ARRAY* x, ARRAY* y);
 CELL or_bignum(ARRAY* x, ARRAY* y);
 CELL xor_bignum(ARRAY* x, ARRAY* y);
-CELL shiftleft_bignum(ARRAY* x, ARRAY* y);
-CELL shiftright_bignum(ARRAY* x, ARRAY* y);
+CELL shift_bignum(ARRAY* x, FIXNUM y);
 CELL less_bignum(ARRAY* x, ARRAY* y);
 CELL lesseq_bignum(ARRAY* x, ARRAY* y);
 CELL greater_bignum(ARRAY* x, ARRAY* y);

diff --git a/native/fixnum.c b/native/fixnum.c
index 2c6703b3f175fe778820d12d40a862ce99e1f610..cfd7545dd585f21a1cc989c455dda3b262b4bf1c 100644 (file)
--- a/native/fixnum.c
+++ b/native/fixnum.c
@@ -161,18 +161,21 @@ CELL xor_fixnum(CELL x, CELL y)
        return x ^ y;
 }
 
-CELL shiftleft_fixnum(CELL x, CELL y)
+CELL shift_fixnum(CELL _x, FIXNUM y)
 {
-       /* BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
-               << (BIGNUM_2)untag_fixnum_fast(y)); */
-       return F;
-}
+       FIXNUM x = untag_fixnum_fast(_x);
+       if(y > CELLS * -8 && y < CELLS * 8)
+       {
+               long long result = (y < 0
+                       ? (long long)x >> -y
+                       : (long long)x << y);
 
-CELL shiftright_fixnum(CELL x, CELL y)
-{
-       /* BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
-               >> (BIGNUM_2)untag_fixnum_fast(y)); */
-       return F;
+               if(result >= FIXNUM_MIN && result <= FIXNUM_MAX)
+                       return tag_fixnum(result);
+       }
+
+       return tag_object(s48_bignum_arithmetic_shift(
+               s48_long_to_bignum(x),y));
 }
 
 CELL less_fixnum(CELL x, CELL y)

diff --git a/native/fixnum.h b/native/fixnum.h
index e3bf99e502bd56a410fa531c154e6b0918db7537..b5d87018b397a9ac5bf95ba47914246df3afb982 100644 (file)
--- a/native/fixnum.h
+++ b/native/fixnum.h
@@ -32,8 +32,7 @@ CELL mod_fixnum(CELL x, CELL y);
 CELL and_fixnum(CELL x, CELL y);
 CELL or_fixnum(CELL x, CELL y);
 CELL xor_fixnum(CELL x, CELL y);
-CELL shiftleft_fixnum(CELL x, CELL y);
-CELL shiftright_fixnum(CELL x, CELL y);
+CELL shift_fixnum(CELL x, FIXNUM y);
 CELL less_fixnum(CELL x, CELL y);
 CELL lesseq_fixnum(CELL x, CELL y);
 CELL greater_fixnum(CELL x, CELL y);

diff --git a/native/float.c b/native/float.c
index 766d1bd04a27836ad0ffc90301ee92a13cac0b54..a795eaa5f4d82617de2d936b79e55b3ce11d37d5 100644 (file)
--- a/native/float.c
+++ b/native/float.c
@@ -51,7 +51,7 @@ void primitive_float_to_bits(void)
 {
        double f = untag_float(dpeek());
        long long f_raw = *(long long*)&f;
-       drepl(tag_object(s48_long_to_bignum(f_raw)));
+       drepl(tag_object(s48_long_long_to_bignum(f_raw)));
 }
 
 CELL number_eq_float(FLOAT* x, FLOAT* y)

diff --git a/native/primitives.c b/native/primitives.c
index 489417f97322b87cb5c86554d8f44882b7178782..63f3cc4100f777546b110e757642c6ba27cce385 100644 (file)
--- a/native/primitives.c
+++ b/native/primitives.c
@@ -68,8 +68,7 @@ XT primitives[] = {
        primitive_or,
        primitive_xor,
        primitive_not,
-       primitive_shiftleft,
-       primitive_shiftright,
+       primitive_shift,
        primitive_less,
        primitive_lesseq,
        primitive_greater,

diff --git a/native/primitives.h b/native/primitives.h
index e9789ccce84c2d3d3982ba2fcb1a0791758a6eb5..9990a9d11ebe2ee9c1cf058d020ac954e1329d3b 100644 (file)
--- a/native/primitives.h
+++ b/native/primitives.h
@@ -1,4 +1,4 @@
 extern XT primitives[];
-#define PRIMITIVE_COUNT 142
+#define PRIMITIVE_COUNT 141
 
 CELL primitive_to_xt(CELL primitive);

diff --git a/native/s48_bignum.c b/native/s48_bignum.c
index a273e76bc6ae5ddb272ba15b0062b1e4282918d3..4f795a9315997792f3eb5caa6f08e783368de4bd 100644 (file)
--- a/native/s48_bignum.c
+++ b/native/s48_bignum.c
@@ -388,6 +388,36 @@ s48_long_to_bignum(long n)
   }
 }
 
+bignum_type
+s48_long_long_to_bignum(long long n)
+{
+  int negative_p;
+  bignum_digit_type result_digits [BIGNUM_DIGITS_FOR_LONG_LONG];
+  bignum_digit_type * end_digits = result_digits;
+  /* Special cases win when these small constants are cached. */
+  if (n == 0) return (BIGNUM_ZERO ());
+  if (n == 1) return (BIGNUM_ONE (0));
+  if (n == -1) return (BIGNUM_ONE (1));
+  {
+    unsigned long long accumulator = ((negative_p = (n < 0)) ? (-n) : n);
+    do
+      {
+       (*end_digits++) = (accumulator & BIGNUM_DIGIT_MASK);
+       accumulator >>= BIGNUM_DIGIT_LENGTH;
+      }
+    while (accumulator != 0);
+  }
+  {
+    bignum_type result =
+      (bignum_allocate ((end_digits - result_digits), negative_p));
+    bignum_digit_type * scan_digits = result_digits;
+    bignum_digit_type * scan_result = (BIGNUM_START_PTR (result));
+    while (scan_digits < end_digits)
+      (*scan_result++) = (*scan_digits++);
+    return (result);
+  }
+}
+
 long
 s48_bignum_to_long(bignum_type bignum)
 {

diff --git a/native/s48_bignum.h b/native/s48_bignum.h
index 4bdea671c2e5a94d1a3ea232d4137f738a7b01ee..416d0122174d67219460ba80e8649b5789324bdf 100644 (file)
--- a/native/s48_bignum.h
+++ b/native/s48_bignum.h
@@ -65,6 +65,7 @@ int s48_bignum_divide(bignum_type numerator, bignum_type denominator,
 bignum_type s48_bignum_quotient(bignum_type, bignum_type);
 bignum_type s48_bignum_remainder(bignum_type, bignum_type);
 bignum_type s48_long_to_bignum(long);
+bignum_type s48_long_long_to_bignum(long long n);
 bignum_type s48_ulong_to_bignum(unsigned long);
 long s48_bignum_to_long(bignum_type);
 unsigned long s48_bignum_to_ulong(bignum_type);

diff --git a/native/s48_bignumint.h b/native/s48_bignumint.h
index 5593926da413fc3c4d6a0c25b308e242f18cbdf5..2d7f89dde23a10de64bece2fa5611bcef4e7f021 100644 (file)
--- a/native/s48_bignumint.h
+++ b/native/s48_bignumint.h
@@ -118,6 +118,9 @@ extern ARRAY* shrink_array(ARRAY* array, CELL capacity);
 #define BIGNUM_DIGITS_FOR_LONG                                         \
   (BIGNUM_BITS_TO_DIGITS ((sizeof (long)) * CHAR_BIT))
 
+#define BIGNUM_DIGITS_FOR_LONG_LONG                                    \
+  (BIGNUM_BITS_TO_DIGITS ((sizeof (long long)) * CHAR_BIT))
+
 #ifndef BIGNUM_DISABLE_ASSERTION_CHECKS
 
 #define BIGNUM_ASSERT(expression)                                      \