From d44ef14827e771765b5c8a1e14bf1bdf9cd3bb87 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 26 Aug 2004 00:51:19 +0000 Subject: [PATCH] some bignum work --- TODO.FACTOR.txt | 10 ++--- library/cross-compiler.factor | 5 ++- library/platform/jvm/sbuf.factor | 4 ++ library/platform/native/kernel.factor | 4 +- library/platform/native/unparser.factor | 16 ++++--- library/sbuf.factor | 5 +++ library/test/benchmark/fac.factor | 6 +++ library/test/benchmark/fib.factor | 3 +- library/test/math/bignum.factor | 11 +++++ library/test/math/gcd.factor | 21 +++++++++ library/test/math/rational.factor | 9 ---- library/test/strings.factor | 4 ++ library/test/test.factor | 2 + library/vectors.factor | 2 +- native/arithmetic.h | 13 ++---- native/bignum.c | 60 +++++++++++-------------- native/bignum.h | 4 +- native/fixnum.c | 30 ++++++++----- native/float.c | 2 +- native/primitives.c | 3 +- native/primitives.h | 2 +- native/s48_bignum.c | 10 ++++- native/s48_bignumint.h | 4 +- native/sbuf.c | 17 ++++++- native/sbuf.h | 3 +- 25 files changed, 156 insertions(+), 94 deletions(-) create mode 100644 library/test/benchmark/fac.factor create mode 100644 library/test/math/bignum.factor create mode 100644 library/test/math/gcd.factor diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 4eda8ac34e..836ccd78b1 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,19 +1,16 @@ + bignums: -- -1 is broken, add a test to verify this in the future -- gcd is broken -- bignum/ is broken - change shift< and shift> to ash -- gcd is broken - cached 0/-1/1 should be cross compiled in image - bignum cross compiling -- upgrading fixnums does not work +- 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 - add a socket timeout + - >lower, >upper for strings - telnetd should use multitasking - accept multi-line input in listener @@ -62,7 +59,6 @@ + native: - is the profiler using correct stack depth? -- bignums - read1 - sbuf-hashcode - vector-hashcode diff --git a/library/cross-compiler.factor b/library/cross-compiler.factor index a7a44fddc4..24dabb7b19 100644 --- a/library/cross-compiler.factor +++ b/library/cross-compiler.factor @@ -58,7 +58,7 @@ IN: strings DEFER: str= DEFER: str-hashcode DEFER: sbuf= -DEFER: clone-sbuf +DEFER: sbuf-clone IN: io-internals DEFER: port? @@ -138,7 +138,8 @@ IN: cross-compiler set-sbuf-nth sbuf-append sbuf>str - clone-sbuf + sbuf-reverse + sbuf-clone sbuf= number? >fixnum diff --git a/library/platform/jvm/sbuf.factor b/library/platform/jvm/sbuf.factor index a511ac9274..ea12ab098e 100644 --- a/library/platform/jvm/sbuf.factor +++ b/library/platform/jvm/sbuf.factor @@ -54,3 +54,7 @@ USE: stack : sbuf>str ( sbuf -- str ) >str ; + +: sbuf-reverse ( sbuf -- ) + #! Destructively reverse a string buffer. + [ ] "java.lang.StringBuffer" "reverse" jinvoke drop ; diff --git a/library/platform/native/kernel.factor b/library/platform/native/kernel.factor index f194c5788f..5441dbfa2b 100644 --- a/library/platform/native/kernel.factor +++ b/library/platform/native/kernel.factor @@ -71,8 +71,8 @@ USE: vectors : clone ( obj -- obj ) [ [ cons? ] [ clone-list ] - [ vector? ] [ clone-vector ] - [ sbuf? ] [ clone-sbuf ] + [ vector? ] [ vector-clone ] + [ sbuf? ] [ sbuf-clone ] [ drop t ] [ ( return the object ) ] ] cond ; diff --git a/library/platform/native/unparser.factor b/library/platform/native/unparser.factor index 46eb95fa57..26d2129943 100644 --- a/library/platform/native/unparser.factor +++ b/library/platform/native/unparser.factor @@ -39,19 +39,23 @@ USE: stdio USE: strings USE: words -: integer% ( num -- ) - "base" get /mod swap dup 0 > [ - integer% +: integer% ( num radix -- ) + tuck /mod >digit % dup 0 > [ + swap integer% ] [ - drop - ] ifte >digit % ; + 2drop + ] ifte ; : integer- ( num -- num ) dup 0 < [ "-" % neg ] when ; : >base ( num radix -- string ) #! Convert a number to a string in a certain base. - [ "base" set <% integer- integer% %> ] with-scope ; + <% dup 0 < [ + neg integer% CHAR: - % + ] [ + integer% + ] ifte reverse%> ; : >dec ( num -- string ) #! Convert an integer to its decimal representation. diff --git a/library/sbuf.factor b/library/sbuf.factor index 3ec6d4ebe6..59bf760102 100644 --- a/library/sbuf.factor +++ b/library/sbuf.factor @@ -53,6 +53,11 @@ USE: stack #! stack. "string-buffer" get sbuf>str n> drop ; +: reverse%> ( -- str ) + #! Ends construction and pushes the *reversed*, constructed + #! text on the stack. + "string-buffer" get dup sbuf-reverse sbuf>str n> drop ; + : fill ( count char -- string ) #! Push a string that consists of the same character #! repeated. diff --git a/library/test/benchmark/fac.factor b/library/test/benchmark/fac.factor new file mode 100644 index 0000000000..55d14f0ef3 --- /dev/null +++ b/library/test/benchmark/fac.factor @@ -0,0 +1,6 @@ +IN: scratchpad +USE: math +USE: stack +USE: test + +[ 30000 fac drop ] time diff --git a/library/test/benchmark/fib.factor b/library/test/benchmark/fib.factor index 948d385e5c..9bcbc34b91 100644 --- a/library/test/benchmark/fib.factor +++ b/library/test/benchmark/fib.factor @@ -1,5 +1,6 @@ IN: scratchpad USE: math +USE: stack USE: test -[ 35 fib ] time +[ 35 fib drop ] time diff --git a/library/test/math/bignum.factor b/library/test/math/bignum.factor new file mode 100644 index 0000000000..cfb2fd194e --- /dev/null +++ b/library/test/math/bignum.factor @@ -0,0 +1,11 @@ +IN: scratchpad +USE: arithmetic +USE: stack +USE: test +USE: unparser + +[ -1 ] [ -1 >bignum >fixnum ] unit-test + +[ "8589934592" ] +[ 134217728 dup + dup + dup + dup + dup + dup + unparse ] +unit-test diff --git a/library/test/math/gcd.factor b/library/test/math/gcd.factor new file mode 100644 index 0000000000..fd738e69fb --- /dev/null +++ b/library/test/math/gcd.factor @@ -0,0 +1,21 @@ +IN: scratchpad +USE: arithmetic +USE: test + +[ 100 ] [ 100 100 gcd ] unit-test +[ 100 ] [ 1000 100 gcd ] unit-test +[ 100 ] [ 100 1000 gcd ] unit-test +[ 4 ] [ 132 64 gcd ] unit-test +[ 4 ] [ -132 64 gcd ] unit-test +[ 4 ] [ -132 -64 gcd ] unit-test +[ 4 ] [ 132 -64 gcd ] unit-test +[ 4 ] [ -132 -64 gcd ] unit-test + +[ 100 ] [ 100 >bignum 100 >bignum gcd ] unit-test +[ 100 ] [ 1000 >bignum 100 >bignum gcd ] unit-test +[ 100 ] [ 100 >bignum 1000 >bignum gcd ] unit-test +[ 4 ] [ 132 >bignum 64 >bignum gcd ] unit-test +[ 4 ] [ -132 >bignum 64 >bignum gcd ] unit-test +[ 4 ] [ -132 >bignum -64 >bignum gcd ] unit-test +[ 4 ] [ 132 >bignum -64 >bignum gcd ] unit-test +[ 4 ] [ -132 >bignum -64 >bignum gcd ] unit-test diff --git a/library/test/math/rational.factor b/library/test/math/rational.factor index 988d19dd5e..0cc14158e3 100644 --- a/library/test/math/rational.factor +++ b/library/test/math/rational.factor @@ -76,12 +76,3 @@ USE: test [ t ] [ 1000000000000/999999999999 1000000000001/999999999998 < ] unit-test - -[ 100 ] [ 100 100 gcd ] unit-test -[ 100 ] [ 1000 100 gcd ] unit-test -[ 100 ] [ 100 1000 gcd ] unit-test -[ 4 ] [ 132 64 gcd ] unit-test -[ 4 ] [ -132 64 gcd ] unit-test -[ 4 ] [ -132 -64 gcd ] unit-test -[ 4 ] [ 132 -64 gcd ] unit-test -[ 4 ] [ -132 -64 gcd ] unit-test diff --git a/library/test/strings.factor b/library/test/strings.factor index 75a312c470..86084eae6e 100644 --- a/library/test/strings.factor +++ b/library/test/strings.factor @@ -3,6 +3,7 @@ USE: arithmetic USE: combinators USE: kernel USE: namespaces +USE: stack USE: strings USE: test @@ -82,6 +83,9 @@ unit-test [ t ] [ "abc" "abd" str-compare 0 < ] unit-test [ t ] [ "z" "abd" str-compare 0 > ] unit-test +[ "fedcba" ] [ "abcdef" str>sbuf dup sbuf-reverse sbuf>str ] unit-test +[ "edcba" ] [ "abcde" str>sbuf dup sbuf-reverse sbuf>str ] unit-test + native? [ [ t ] [ "Foo" str>sbuf "Foo" str>sbuf = ] unit-test [ f ] [ "Foo" str>sbuf "Foob" str>sbuf = ] unit-test diff --git a/library/test/test.factor b/library/test/test.factor index d347b015fb..b250cea605 100644 --- a/library/test/test.factor +++ b/library/test/test.factor @@ -83,7 +83,9 @@ USE: unparser "words" "unparser" "random" + "math/bignum" "math/bitops" + "math/gcd" "math/rational" "math/float" "math/complex" diff --git a/library/vectors.factor b/library/vectors.factor index 48d861079e..058a3c7d79 100644 --- a/library/vectors.factor +++ b/library/vectors.factor @@ -62,6 +62,6 @@ USE: stack DEFER: vector-map -: clone-vector ( vector -- vector ) +: vector-clone ( vector -- vector ) #! Shallow copy of a vector. [ ] vector-map ; diff --git a/native/arithmetic.h b/native/arithmetic.h index f5abd94f0a..63ffe38d55 100644 --- a/native/arithmetic.h +++ b/native/arithmetic.h @@ -11,17 +11,10 @@ FLOAT* ratio_to_float(CELL n); #define CELL_TO_INTEGER(result) \ FIXNUM _result = (result); \ - /* if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \ - return tag_object(fixnum_to_bignum(_result)); \ + if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \ + return tag_object(s48_long_to_bignum(_result)); \ else \ - */return tag_fixnum(_result); - -#define BIGNUM_2_TO_INTEGER(result) \ - BIGNUM_2 _result = (result); \ - /* if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \ - return tag_object(s48_long_to_bignum(_result)); \ - else \ - */return tag_fixnum(_result); + return tag_fixnum(_result); #define BINARY_OP(OP) \ CELL OP(CELL x, CELL y) \ diff --git a/native/bignum.c b/native/bignum.c index f62a06125b..d7ce2e7c97 100644 --- a/native/bignum.c +++ b/native/bignum.c @@ -7,7 +7,7 @@ void init_bignum(void) bignum_pos_one = bignum_allocate(1,0); (BIGNUM_REF (bignum_pos_one, 0)) = 1; - bignum_neg_one = bignum_allocate(1,0); + bignum_neg_one = bignum_allocate(1,1); (BIGNUM_REF (bignum_neg_one, 0)) = 1; } @@ -64,16 +64,16 @@ CELL multiply_bignum(ARRAY* x, ARRAY* y) return tag_object(s48_bignum_multiply(x,y)); } -BIGNUM_2 gcd_bignum(BIGNUM_2 x, BIGNUM_2 y) +CELL gcd_bignum(ARRAY* x, ARRAY* y) { - BIGNUM_2 t; + ARRAY* t; - if(x < 0) - x = -x; - if(y < 0) - y = -y; + if(BIGNUM_NEGATIVE_P(x)) + x = s48_bignum_negate(x); + if(BIGNUM_NEGATIVE_P(y)) + y = s48_bignum_negate(y); - if(x > y) + if(s48_bignum_compare(x,y) == bignum_comparison_greater) { t = x; x = y; @@ -82,10 +82,10 @@ BIGNUM_2 gcd_bignum(BIGNUM_2 x, BIGNUM_2 y) for(;;) { - if(x == 0) - return y; + if(BIGNUM_ZERO_P(x)) + return tag_object(y); - t = y % x; + t = s48_bignum_remainder(y,x); y = x; x = t; } @@ -93,37 +93,29 @@ BIGNUM_2 gcd_bignum(BIGNUM_2 x, BIGNUM_2 y) CELL divide_bignum(ARRAY* x, ARRAY* y) { - /* BIGNUM_2 _x = x->n; - BIGNUM_2 _y = y->n; - BIGNUM_2 gcd; + ARRAY* gcd; - if(_y == 0) + if(BIGNUM_ZERO_P(y)) + raise(SIGFPE); + + if(BIGNUM_NEGATIVE_P(y)) { - /* FIXME - abort(); - } - else if(_y < 0) - { - _x = -_x; - _y = -_y; + x = s48_bignum_negate(x); + y = s48_bignum_negate(y); } - gcd = gcd_bignum(_x,_y); - if(gcd != 1) - { - _x /= gcd; - _y /= gcd; - } + gcd = (ARRAY*)UNTAG(gcd_bignum(x,y)); + x = s48_bignum_quotient(x,gcd); + y = s48_bignum_quotient(y,gcd); - if(_y == 1) - return tag_object(bignum(_x)); + if(BIGNUM_ONE_P(y,0)) + return tag_object(x); else { return tag_ratio(ratio( - tag_object(bignum(_x)), - tag_object(bignum(_y)))); - } */ - return F; + tag_object(x), + tag_object(y))); + } } CELL divint_bignum(ARRAY* x, ARRAY* y) diff --git a/native/bignum.h b/native/bignum.h index f57082842c..0fa23f4a31 100644 --- a/native/bignum.h +++ b/native/bignum.h @@ -1,5 +1,3 @@ -typedef long long BIGNUM_2; - INLINE ARRAY* untag_bignum(CELL tagged) { type_check(BIGNUM_TYPE,tagged); @@ -18,7 +16,7 @@ CELL number_eq_bignum(ARRAY* x, ARRAY* y); CELL add_bignum(ARRAY* x, ARRAY* y); CELL subtract_bignum(ARRAY* x, ARRAY* y); CELL multiply_bignum(ARRAY* x, ARRAY* y); -BIGNUM_2 gcd_bignum(BIGNUM_2 x, BIGNUM_2 y); +CELL gcd_bignum(ARRAY* x, ARRAY* y); CELL divide_bignum(ARRAY* x, ARRAY* y); CELL divint_bignum(ARRAY* x, ARRAY* y); CELL divfloat_bignum(ARRAY* x, ARRAY* y); diff --git a/native/fixnum.c b/native/fixnum.c index 041925e57e..2c6703b3f1 100644 --- a/native/fixnum.c +++ b/native/fixnum.c @@ -48,10 +48,19 @@ CELL subtract_fixnum(CELL x, CELL y) CELL_TO_INTEGER(untag_fixnum_fast(x) - untag_fixnum_fast(y)); } -CELL multiply_fixnum(CELL x, CELL y) +CELL multiply_fixnum(CELL _x, CELL _y) { - BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x) - * (BIGNUM_2)untag_fixnum_fast(y)); + FIXNUM x = untag_fixnum_fast(_x); + FIXNUM y = untag_fixnum_fast(_y); + long long result = (long long)x * (long long)y; + if(result < FIXNUM_MIN || result > FIXNUM_MAX) + { + return tag_object(s48_bignum_multiply( + s48_long_to_bignum(x), + s48_long_to_bignum(y))); + } + else + return tag_fixnum(result); } CELL divint_fixnum(CELL x, CELL y) @@ -117,10 +126,7 @@ CELL divide_fixnum(CELL x, CELL y) FIXNUM gcd; if(_y == 0) - { - /* FIXME */ - abort(); - } + raise(SIGFPE); else if(_y < 0) { _x = -_x; @@ -157,14 +163,16 @@ CELL xor_fixnum(CELL x, CELL y) CELL shiftleft_fixnum(CELL x, CELL y) { - BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x) - << (BIGNUM_2)untag_fixnum_fast(y)); + /* BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x) + << (BIGNUM_2)untag_fixnum_fast(y)); */ + return F; } CELL shiftright_fixnum(CELL x, CELL y) { - BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x) - >> (BIGNUM_2)untag_fixnum_fast(y)); + /* BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x) + >> (BIGNUM_2)untag_fixnum_fast(y)); */ + return F; } CELL less_fixnum(CELL x, CELL y) diff --git a/native/float.c b/native/float.c index 22e34dc31d..766d1bd04a 100644 --- a/native/float.c +++ b/native/float.c @@ -50,7 +50,7 @@ void primitive_float_to_str(void) void primitive_float_to_bits(void) { double f = untag_float(dpeek()); - BIGNUM_2 f_raw = *(BIGNUM_2*)&f; + long long f_raw = *(long long*)&f; drepl(tag_object(s48_long_to_bignum(f_raw))); } diff --git a/native/primitives.c b/native/primitives.c index 57b553afef..489417f973 100644 --- a/native/primitives.c +++ b/native/primitives.c @@ -34,7 +34,8 @@ XT primitives[] = { primitive_set_sbuf_nth, primitive_sbuf_append, primitive_sbuf_to_string, - primitive_clone_sbuf, + primitive_sbuf_reverse, + primitive_sbuf_clone, primitive_sbuf_eq, primitive_numberp, primitive_to_fixnum, diff --git a/native/primitives.h b/native/primitives.h index 9990a9d11e..e9789ccce8 100644 --- a/native/primitives.h +++ b/native/primitives.h @@ -1,4 +1,4 @@ extern XT primitives[]; -#define PRIMITIVE_COUNT 141 +#define PRIMITIVE_COUNT 142 CELL primitive_to_xt(CELL primitive); diff --git a/native/s48_bignum.c b/native/s48_bignum.c index c93d807f3e..a273e76bc6 100644 --- a/native/s48_bignum.c +++ b/native/s48_bignum.c @@ -259,7 +259,10 @@ bignum_type s48_bignum_quotient(bignum_type numerator, bignum_type denominator) { if (BIGNUM_ZERO_P (denominator)) - return (BIGNUM_OUT_OF_BAND); + { + raise(SIGFPE); + return (BIGNUM_OUT_OF_BAND); + } if (BIGNUM_ZERO_P (numerator)) return (BIGNUM_MAYBE_COPY (numerator)); { @@ -308,7 +311,10 @@ bignum_type s48_bignum_remainder(bignum_type numerator, bignum_type denominator) { if (BIGNUM_ZERO_P (denominator)) - return (BIGNUM_OUT_OF_BAND); + { + raise(SIGFPE); + return (BIGNUM_OUT_OF_BAND); + } if (BIGNUM_ZERO_P (numerator)) return (BIGNUM_MAYBE_COPY (numerator)); switch (bignum_compare_unsigned (numerator, denominator)) diff --git a/native/s48_bignumint.h b/native/s48_bignumint.h index 743bc465e0..5593926da4 100644 --- a/native/s48_bignumint.h +++ b/native/s48_bignumint.h @@ -104,7 +104,9 @@ extern ARRAY* shrink_array(ARRAY* array, CELL capacity); 0, 1, and -1. */ #define BIGNUM_ZERO() bignum_zero #define BIGNUM_ONE(neg_p) \ - (neg_p ? bignum_pos_one : bignum_neg_one) + (neg_p ? bignum_neg_one : bignum_pos_one) + +#define BIGNUM_ONE_P(bignum,negative_p) ((bignum) == BIGNUM_ONE(negative_p)) #define HD_LOW(digit) ((digit) & BIGNUM_HALF_DIGIT_MASK) #define HD_HIGH(digit) ((digit) >> BIGNUM_HALF_DIGIT_LENGTH) diff --git a/native/sbuf.c b/native/sbuf.c index 9a90008f17..f4d5862d87 100644 --- a/native/sbuf.c +++ b/native/sbuf.c @@ -114,7 +114,22 @@ void primitive_sbuf_to_string(void) drepl(tag_object(sbuf_to_string(untag_sbuf(dpeek())))); } -void primitive_clone_sbuf(void) +void primitive_sbuf_reverse(void) +{ + SBUF* sbuf = untag_sbuf(dpop()); + int i, j; + CHAR ch1, ch2; + for(i = 0; i < sbuf->top / 2; i++) + { + j = sbuf->top - i - 1; + ch1 = string_nth(sbuf->string,i); + ch2 = string_nth(sbuf->string,j); + set_string_nth(sbuf->string,j,ch1); + set_string_nth(sbuf->string,i,ch2); + } +} + +void primitive_sbuf_clone(void) { SBUF* s = untag_sbuf(dpeek()); SBUF* new_s = sbuf(s->top); diff --git a/native/sbuf.h b/native/sbuf.h index d5ba1cb6e0..782b6ccff2 100644 --- a/native/sbuf.h +++ b/native/sbuf.h @@ -27,7 +27,8 @@ void sbuf_append_string(SBUF* sbuf, STRING* string); void primitive_sbuf_append(void); STRING* sbuf_to_string(SBUF* sbuf); void primitive_sbuf_to_string(void); -void primitive_clone_sbuf(void); +void primitive_sbuf_reverse(void); +void primitive_sbuf_clone(void); bool sbuf_eq(SBUF* s1, SBUF* s2); void primitive_sbuf_eq(void); void fixup_sbuf(SBUF* sbuf);