diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 836ccd78b1..b6cacd1dd5 100644 --- a/TODO.FACTOR.txt +++ b/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 -- 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 diff --git a/factor/math/FactorMath.java b/factor/math/FactorMath.java index ff2b481952..16a2ed1f51 100644 --- 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 24dabb7b19..4e3cfbf39a 100644 --- 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 916466e6a2..60035a2b12 100644 --- 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 3e3ecf60d2..57d959e344 100644 --- 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 57d9edd464..278ebfdbb1 100644 --- 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 26d2129943..a5429efad0 100644 --- 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 8fac1e211e..1e9ae23cb4 100644 --- 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 91608a1b23..55a6b5c86c 100644 --- 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 cfb2fd194e..124653e8c0 100644 --- 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 0cc14158e3..b9228d7c34 100644 --- 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 7c726f77f2..8a724db56b 100644 --- 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 63ffe38d55..841ce90f6f 100644 --- 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 d7ce2e7c97..7129ff861c 100644 --- 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 0fa23f4a31..84efe04f37 100644 --- 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 2c6703b3f1..cfd7545dd5 100644 --- 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 e3bf99e502..b5d87018b3 100644 --- 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 766d1bd04a..a795eaa5f4 100644 --- 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 489417f973..63f3cc4100 100644 --- 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 e9789ccce8..9990a9d11e 100644 --- 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 a273e76bc6..4f795a9315 100644 --- 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 4bdea671c2..416d012217 100644 --- 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 5593926da4..2d7f89dde2 100644 --- 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) \