bignums are done

TODO.FACTOR.txt

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

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.

library/cross-compiler.factor

@@ -172,8 +172,7 @@ IN: cross-compiler
         bitor
         bitxor
         bitnot
-        shift<
-        shift>
+        shift
         <
         <=
         >

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 ;

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 )

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 ;

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%> ;

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 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 -- )

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 ;

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

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

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)

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);

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)

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);

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)

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);

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)

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,

native/primitives.h

@@ -1,4 +1,4 @@
 extern XT primitives[];
-#define PRIMITIVE_COUNT 142
+#define PRIMITIVE_COUNT 141
 
 CELL primitive_to_xt(CELL primitive);

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)
 {

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);

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)					\