bignums (sort of)

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 270421b2008caae4ce4af845eb9b0a27cc8a8854..4eda8ac34eb2da72d93ce553315ef0ecc2c885a8 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,3 +1,18 @@
++ bignums:\r
+\r
+- -1 is broken, add a test to verify this in the future\r
+- gcd is broken\r
+- bignum/ is broken\r
+- change shift< and shift> to ash\r
+- gcd is broken\r
+- cached 0/-1/1 should be cross compiled in image\r
+- bignum cross compiling\r
+- upgrading fixnums does not work\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
+\r
 - add a socket timeout\r
 - >lower, >upper for strings\r
 - telnetd should use multitasking\r

diff --git a/library/image.factor b/library/image.factor
index 00aa136f4e10df726b6a303ceae55891718e1821..916466e6a27d8da0488688d01c8bb1ec86e455f4 100644 (file)
--- a/library/image.factor
+++ b/library/image.factor
@@ -139,13 +139,13 @@ USE: words
 ( Bignums )
 
 : 'bignum ( bignum -- tagged )
-    #! Very bad!
-    object-tag here-as >r
-    bignum-type >header emit
-    4 emit ( capacity )
-    0 emit ( sign XXXX )
-    0 emit ( pad XXXX )
-    ( bignum -- ) emit64 r> ;
+    'fixnum ;
+!    #! Very bad!
+!    object-tag here-as >r
+!    bignum-type >header emit
+!    1 emit ( capacity )
+!    0 emit ( sign XXXX )
+!    ( bignum -- ) emit r> ;
 
 ( Special objects )
 

diff --git a/native/arithmetic.c b/native/arithmetic.c
index c9200dd647afb1f1cac9507736ca04047ad4bc5e..7c726f77f256ba60580c292fc04fdd1f388d17b7 100644 (file)
--- a/native/arithmetic.c
+++ b/native/arithmetic.c
@@ -49,9 +49,9 @@ CELL upgraded_arithmetic_type(CELL type1, CELL type2)
        }
 }
 
-BIGNUM* fixnum_to_bignum(CELL n)
+ARRAY* fixnum_to_bignum(CELL n)
 {
-       return bignum((BIGNUM_2)untag_fixnum_fast(n));
+       return s48_long_to_bignum(untag_fixnum_fast(n));
 }
 
 RATIO* fixnum_to_ratio(CELL n)
@@ -66,7 +66,8 @@ FLOAT* fixnum_to_float(CELL n)
 
 FIXNUM bignum_to_fixnum(CELL tagged)
 {
-       return (FIXNUM)(((BIGNUM*)UNTAG(tagged))->n);
+       return (FIXNUM)s48_bignum_to_long(
+               (ARRAY*)UNTAG(tagged));
 }
 
 RATIO* bignum_to_ratio(CELL n)
@@ -76,7 +77,8 @@ RATIO* bignum_to_ratio(CELL n)
 
 FLOAT* bignum_to_float(CELL tagged)
 {
-       return make_float((double)((BIGNUM*)UNTAG(tagged))->n);
+       return make_float(s48_bignum_to_double(
+               (ARRAY*)UNTAG(tagged)));
 }
 
 FLOAT* ratio_to_float(CELL tagged)
@@ -118,7 +120,7 @@ bool zerop(CELL tagged)
        case FIXNUM_TYPE:
                return tagged == 0;
        case BIGNUM_TYPE:
-               return ((BIGNUM*)UNTAG(tagged))->n == 0;
+               return BIGNUM_ZERO_P((ARRAY*)UNTAG(tagged));
        case FLOAT_TYPE:
                return ((FLOAT*)UNTAG(tagged))->n == 0.0;
        case RATIO_TYPE:

diff --git a/native/arithmetic.h b/native/arithmetic.h
index 4c003ccf3f48795eac116972d4afaf20fadc20b3..f5abd94f0abcfe83c25e61cafca6b1169822cda0 100644 (file)
--- a/native/arithmetic.h
+++ b/native/arithmetic.h
@@ -1,7 +1,7 @@
 #include "factor.h"
 
 CELL upgraded_arithmetic_type(CELL type1, CELL type2);
-BIGNUM* fixnum_to_bignum(CELL n);
+ARRAY* fixnum_to_bignum(CELL n);
 RATIO* fixnum_to_ratio(CELL n);
 FLOAT* fixnum_to_float(CELL n);
 FIXNUM bignum_to_fixnum(CELL tagged);
@@ -11,17 +11,17 @@ FLOAT* ratio_to_float(CELL n);
 
 #define CELL_TO_INTEGER(result) \
        FIXNUM _result = (result); \
-       if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \
+       /* if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \
                return tag_object(fixnum_to_bignum(_result)); \
        else \
-               return tag_fixnum(_result);
+                */return tag_fixnum(_result);
 
 #define BIGNUM_2_TO_INTEGER(result) \
         BIGNUM_2 _result = (result); \
-        if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \
-                return tag_object(bignum(_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) \
@@ -89,7 +89,7 @@ CELL OP(CELL x) \
        case COMPLEX_TYPE: \
                return OP##_complex((COMPLEX*)UNTAG(x)); \
        case BIGNUM_TYPE: \
-               return OP##_bignum((BIGNUM*)UNTAG(x)); \
+               return OP##_bignum((ARRAY*)UNTAG(x)); \
        case FLOAT_TYPE: \
                return OP##_float((FLOAT*)UNTAG(x)); \
        default: \
@@ -136,9 +136,7 @@ void primitive_numberp(void);
 
 bool zerop(CELL tagged);
 
-FIXNUM to_fixnum(CELL tagged);
 void primitive_to_fixnum(void);
-BIGNUM* to_bignum(CELL tagged);
 void primitive_to_bignum(void);
 void primitive_to_integer(void);
 CELL number_eq(CELL x, CELL y);

diff --git a/native/bignum.c b/native/bignum.c
index b4c0358588a0817b6ebeca253ad5957892a5b07e..f62a06125b254e4e1f909701774de2ad02d41412 100644 (file)
--- a/native/bignum.c
+++ b/native/bignum.c
@@ -1,11 +1,22 @@
 #include "factor.h"
 
+void init_bignum(void)
+{
+       bignum_zero = bignum_allocate(0,0);
+
+       bignum_pos_one = bignum_allocate(1,0);
+       (BIGNUM_REF (bignum_pos_one, 0)) = 1;
+
+       bignum_neg_one = bignum_allocate(1,0);
+       (BIGNUM_REF (bignum_neg_one, 0)) = 1;
+}
+
 void primitive_bignump(void)
 {
        drepl(tag_boolean(typep(BIGNUM_TYPE,dpeek())));
 }
 
-BIGNUM* to_bignum(CELL tagged)
+ARRAY* to_bignum(CELL tagged)
 {
        RATIO* r;
        FLOAT* f;
@@ -15,13 +26,13 @@ BIGNUM* to_bignum(CELL tagged)
        case FIXNUM_TYPE:
                return fixnum_to_bignum(tagged);
        case BIGNUM_TYPE:
-               return (BIGNUM*)UNTAG(tagged);
+               return (ARRAY*)UNTAG(tagged);
        case RATIO_TYPE:
                r = (RATIO*)UNTAG(tagged);
                return to_bignum(divint(r->numerator,r->denominator));
        case FLOAT_TYPE:
                f = (FLOAT*)UNTAG(tagged);
-               return bignum((BIGNUM_2)f->n);
+               return s48_double_to_bignum(f->n);
        default:
                type_error(BIGNUM_TYPE,tagged);
                return NULL; /* can't happen */
@@ -33,24 +44,24 @@ void primitive_to_bignum(void)
        drepl(tag_object(to_bignum(dpeek())));
 }
 
-CELL number_eq_bignum(BIGNUM* x, BIGNUM* y)
+CELL number_eq_bignum(ARRAY* x, ARRAY* y)
 {
-       return tag_boolean(x->n == y->n);
+       return tag_boolean(s48_bignum_equal_p(x,y));
 }
 
-CELL add_bignum(BIGNUM* x, BIGNUM* y)
+CELL add_bignum(ARRAY* x, ARRAY* y)
 {
-       return tag_object(bignum(x->n + y->n));
+       return tag_object(s48_bignum_add(x,y));
 }
 
-CELL subtract_bignum(BIGNUM* x, BIGNUM* y)
+CELL subtract_bignum(ARRAY* x, ARRAY* y)
 {
-       return tag_object(bignum(x->n - y->n));
+       return tag_object(s48_bignum_subtract(x,y));
 }
 
-CELL multiply_bignum(BIGNUM* x, BIGNUM* y)
+CELL multiply_bignum(ARRAY* x, ARRAY* y)
 {
-       return tag_object(bignum(x->n * y->n));
+       return tag_object(s48_bignum_multiply(x,y));
 }
 
 BIGNUM_2 gcd_bignum(BIGNUM_2 x, BIGNUM_2 y)
@@ -80,15 +91,15 @@ BIGNUM_2 gcd_bignum(BIGNUM_2 x, BIGNUM_2 y)
        }
 }
 
-CELL divide_bignum(BIGNUM* x, BIGNUM* y)
+CELL divide_bignum(ARRAY* x, ARRAY* y)
 {
-       BIGNUM_2 _x = x->n;
+       /* BIGNUM_2 _x = x->n;
        BIGNUM_2 _y = y->n;
        BIGNUM_2 gcd;
 
        if(_y == 0)
        {
-               /* FIXME */
+               /* FIXME
                abort();
        }
        else if(_y < 0)
@@ -111,78 +122,116 @@ CELL divide_bignum(BIGNUM* x, BIGNUM* y)
                return tag_ratio(ratio(
                        tag_object(bignum(_x)),
                        tag_object(bignum(_y))));
-       }
+       } */
+       return F;
 }
 
-CELL divint_bignum(BIGNUM* x, BIGNUM* y)
+CELL divint_bignum(ARRAY* x, ARRAY* y)
 {
-       return tag_object(bignum(x->n / y->n));
+       ARRAY* q = s48_bignum_quotient(x,y);
+       if(q == NULL)
+               raise(SIGFPE);
+       return tag_object(q);
 }
 
-CELL divfloat_bignum(BIGNUM* x, BIGNUM* y)
+CELL divfloat_bignum(ARRAY* x, ARRAY* y)
 {
-       BIGNUM_2 _x = x->n;
-       BIGNUM_2 _y = y->n;
-       return tag_object(make_float((double)_x / (double)_y));
+       return tag_object(make_float(
+               s48_bignum_to_double(x) /
+               s48_bignum_to_double(y)));
 }
 
-CELL divmod_bignum(BIGNUM* x, BIGNUM* y)
+CELL divmod_bignum(ARRAY* x, ARRAY* y)
 {
-       dpush(tag_object(bignum(x->n / y->n)));
-       return tag_object(bignum(x->n % y->n));
+       ARRAY* q;
+       ARRAY* r;
+       if(s48_bignum_divide(x,y,&q,&r))
+               raise(SIGFPE);
+       dpush(tag_object(q));
+       return tag_object(r);
 }
 
-CELL mod_bignum(BIGNUM* x, BIGNUM* y)
+CELL mod_bignum(ARRAY* x, ARRAY* y)
 {
-       return tag_object(bignum(x->n % y->n));
+       ARRAY* r = s48_bignum_remainder(x,y);
+       if(r == NULL)
+               raise(SIGFPE);
+       return tag_object(r);
 }
 
-CELL and_bignum(BIGNUM* x, BIGNUM* y)
+CELL and_bignum(ARRAY* x, ARRAY* y)
 {
-       return tag_object(bignum(x->n & y->n));
+       return tag_object(s48_bignum_bitwise_and(x,y));
 }
 
-CELL or_bignum(BIGNUM* x, BIGNUM* y)
+CELL or_bignum(ARRAY* x, ARRAY* y)
 {
-       return tag_object(bignum(x->n | y->n));
+       return tag_object(s48_bignum_bitwise_ior(x,y));
 }
 
-CELL xor_bignum(BIGNUM* x, BIGNUM* y)
+CELL xor_bignum(ARRAY* x, ARRAY* y)
 {
-       return tag_object(bignum(x->n ^ y->n));
+       return tag_object(s48_bignum_bitwise_xor(x,y));
 }
 
-CELL shiftleft_bignum(BIGNUM* x, BIGNUM* y)
+CELL shiftleft_bignum(ARRAY* x, ARRAY* y)
 {
-       return tag_object(bignum(x->n << y->n));
+       return tag_object(s48_bignum_arithmetic_shift(x,
+               s48_bignum_to_long(y)));
 }
 
-CELL shiftright_bignum(BIGNUM* x, BIGNUM* y)
+CELL shiftright_bignum(ARRAY* x, ARRAY* y)
 {
-       return tag_object(bignum(x->n >> y->n));
+       return tag_object(s48_bignum_arithmetic_shift(x,
+               -s48_bignum_to_long(y)));
 }
 
-CELL less_bignum(BIGNUM* x, BIGNUM* y)
+CELL less_bignum(ARRAY* x, ARRAY* y)
 {
-       return tag_boolean(x->n < y->n);
+       return tag_boolean(
+               s48_bignum_compare(x,y)
+               == bignum_comparison_less);
 }
 
-CELL lesseq_bignum(BIGNUM* x, BIGNUM* y)
+CELL lesseq_bignum(ARRAY* x, ARRAY* y)
 {
-       return tag_boolean(x->n <= y->n);
+       switch(s48_bignum_compare(x,y))
+       {
+       case bignum_comparison_less:
+       case bignum_comparison_equal:
+               return T;
+       case bignum_comparison_greater:
+               return F;
+       }
 }
 
-CELL greater_bignum(BIGNUM* x, BIGNUM* y)
+CELL greater_bignum(ARRAY* x, ARRAY* y)
 {
-       return tag_boolean(x->n > y->n);
+       return tag_boolean(
+               s48_bignum_compare(x,y)
+               == bignum_comparison_greater);
+}
+
+CELL greatereq_bignum(ARRAY* x, ARRAY* y)
+{
+       switch(s48_bignum_compare(x,y))
+       {
+       case bignum_comparison_less:
+               return F;
+       case bignum_comparison_equal:
+       case bignum_comparison_greater:
+               return T;
+       }
 }
 
-CELL greatereq_bignum(BIGNUM* x, BIGNUM* y)
+CELL not_bignum(ARRAY* x)
 {
-       return tag_boolean(x->n >= y->n);
+       return tag_object(s48_bignum_bitwise_not(x));
 }
 
-CELL not_bignum(BIGNUM* x)
+void copy_bignum_constants(void)
 {
-       return tag_object(bignum(~(x->n)));
+       bignum_zero = copy_array(bignum_zero);
+       bignum_pos_one = copy_array(bignum_pos_one);
+       bignum_neg_one = copy_array(bignum_neg_one);
 }

diff --git a/native/bignum.h b/native/bignum.h
index ecf6468f0822fb57e26034c81fec6b7eb5955e4c..f57082842c6077e47ecd9361a5aacd728d15dcb6 100644 (file)
--- a/native/bignum.h
+++ b/native/bignum.h
@@ -1,54 +1,37 @@
 typedef long long BIGNUM_2;
 
-typedef struct {
-       CELL header;
-       CELL capacity;
-       CELL sign;
-       CELL fill; /* bad */
-       BIGNUM_2 n;
-} BIGNUM;
-
-/* untagged */
-INLINE BIGNUM* allot_bignum()
-{
-       /* Bignums are really retrofitted arrays */
-       return (BIGNUM*)allot_array(BIGNUM_TYPE,4);
-}
-
-/* untagged */
-INLINE BIGNUM* bignum(BIGNUM_2 n)
-{
-       BIGNUM* bignum = allot_bignum();
-       bignum->n = n;
-       return bignum;
-}
-
-INLINE BIGNUM* untag_bignum(CELL tagged)
+INLINE ARRAY* untag_bignum(CELL tagged)
 {
        type_check(BIGNUM_TYPE,tagged);
-       return (BIGNUM*)UNTAG(tagged);
+       return (ARRAY*)UNTAG(tagged);
 }
 
+ARRAY* bignum_zero;
+ARRAY* bignum_pos_one;
+ARRAY* bignum_neg_one;
+
+void init_bignum(void);
 void primitive_bignump(void);
-BIGNUM* to_bignum(CELL tagged);
+ARRAY* to_bignum(CELL tagged);
 void primitive_to_bignum(void);
-CELL number_eq_bignum(BIGNUM* x, BIGNUM* y);
-CELL add_bignum(BIGNUM* x, BIGNUM* y);
-CELL subtract_bignum(BIGNUM* x, BIGNUM* y);
-CELL multiply_bignum(BIGNUM* x, BIGNUM* y);
+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 divide_bignum(BIGNUM* x, BIGNUM* y);
-CELL divint_bignum(BIGNUM* x, BIGNUM* y);
-CELL divfloat_bignum(BIGNUM* x, BIGNUM* y);
-CELL divmod_bignum(BIGNUM* x, BIGNUM* y);
-CELL mod_bignum(BIGNUM* x, BIGNUM* y);
-CELL and_bignum(BIGNUM* x, BIGNUM* y);
-CELL or_bignum(BIGNUM* x, BIGNUM* y);
-CELL xor_bignum(BIGNUM* x, BIGNUM* y);
-CELL shiftleft_bignum(BIGNUM* x, BIGNUM* y);
-CELL shiftright_bignum(BIGNUM* x, BIGNUM* y);
-CELL less_bignum(BIGNUM* x, BIGNUM* y);
-CELL lesseq_bignum(BIGNUM* x, BIGNUM* y);
-CELL greater_bignum(BIGNUM* x, BIGNUM* y);
-CELL greatereq_bignum(BIGNUM* x, BIGNUM* y);
-CELL not_bignum(BIGNUM* x);
+CELL divide_bignum(ARRAY* x, ARRAY* y);
+CELL divint_bignum(ARRAY* x, ARRAY* y);
+CELL divfloat_bignum(ARRAY* x, ARRAY* y);
+CELL divmod_bignum(ARRAY* x, ARRAY* y);
+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 less_bignum(ARRAY* x, ARRAY* y);
+CELL lesseq_bignum(ARRAY* x, ARRAY* y);
+CELL greater_bignum(ARRAY* x, ARRAY* y);
+CELL greatereq_bignum(ARRAY* x, ARRAY* y);
+CELL not_bignum(ARRAY* x);
+void copy_bignum_constants(void);

diff --git a/native/factor.c b/native/factor.c
index 2bdf8c740453d5341947ff7f625f2b4ccd507f18..83372000dd5f5a1ee96414d9b226936d5540acbe 100644 (file)
--- a/native/factor.c
+++ b/native/factor.c
@@ -17,6 +17,7 @@ int main(int argc, char** argv)
        load_image(argv[1]);
        init_stacks();
        init_io();
+       init_bignum();
        init_signals();
 
        args = F;

diff --git a/native/float.c b/native/float.c
index 9982e3fce7573f797b759f03eb04705b5bc1d984..22e34dc31d141c9ee220707739ff14587244b91e 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());
        BIGNUM_2 f_raw = *(BIGNUM_2*)&f;
-       drepl(tag_object(bignum(f_raw)));
+       drepl(tag_object(s48_long_to_bignum(f_raw)));
 }
 
 CELL number_eq_float(FLOAT* x, FLOAT* y)

diff --git a/native/gc.c b/native/gc.c
index 9d58c98fe8ead9d8b66f244ef8012244af17cca2..ac2f96c2bbac6ecea7d87ed68087f4d15a736632 100644 (file)
--- a/native/gc.c
+++ b/native/gc.c
@@ -124,6 +124,7 @@ void collect_roots(void)
        copy_object(&T);
        gc_debug("t",T);
        copy_object(&callframe);
+       copy_bignum_constants();
 
        for(ptr = ds_bot; ptr < ds; ptr += CELLS)
                copy_object((void*)ptr);

diff --git a/native/misc.c b/native/misc.c
index 5581aa5eb9a43fa64f4f93ff22bf0c4b8e75b90d..aed48109fc6b323db7e554f9ad32261c6f9c679a 100644 (file)
--- a/native/misc.c
+++ b/native/misc.c
@@ -24,7 +24,8 @@ void primitive_millis(void)
 {
        struct timeval t;
        gettimeofday(&t,NULL);
-       dpush(tag_object(bignum(t.tv_sec * 1000 + t.tv_usec/1000)));
+       dpush(tag_object(s48_long_to_bignum(
+               t.tv_sec * 1000 + t.tv_usec/1000)));
 }
 
 void primitive_init_random(void)
@@ -40,7 +41,7 @@ void primitive_init_random(void)
 
 void primitive_random_int(void)
 {
-       dpush(tag_object(bignum(random())));
+       dpush(tag_object(s48_long_to_bignum(random())));
 }
 
 void primitive_dump(void)

diff --git a/native/s48_bignum.c b/native/s48_bignum.c
index 33520052f228ee52abc4ee68ba3bc01475786186..c93d807f3ea0fa492dd44a3f881b329b1488789c 100644 (file)
--- a/native/s48_bignum.c
+++ b/native/s48_bignum.c
@@ -51,84 +51,8 @@ MIT in each case. */
 #include <stdlib.h>    /* abort */
 #include <math.h>
 
-/* Forward references */
-static int bignum_equal_p_unsigned(bignum_type, bignum_type);
-static enum bignum_comparison bignum_compare_unsigned(bignum_type, bignum_type);
-static bignum_type bignum_add_unsigned(bignum_type, bignum_type, int);
-static bignum_type bignum_subtract_unsigned(bignum_type, bignum_type);
-static bignum_type bignum_multiply_unsigned(bignum_type, bignum_type, int);
-static bignum_type bignum_multiply_unsigned_small_factor
-  (bignum_type, bignum_digit_type, int);
-static void bignum_destructive_scale_up(bignum_type, bignum_digit_type);
-static void bignum_destructive_add(bignum_type, bignum_digit_type);
-static void bignum_divide_unsigned_large_denominator
-  (bignum_type, bignum_type, bignum_type *, bignum_type *, int, int);
-static void bignum_destructive_normalization(bignum_type, bignum_type, int);
-static void bignum_destructive_unnormalization(bignum_type, int);
-static void bignum_divide_unsigned_normalized(bignum_type, bignum_type, bignum_type);
-static bignum_digit_type bignum_divide_subtract
-  (bignum_digit_type *, bignum_digit_type *, bignum_digit_type,
-   bignum_digit_type *);
-static void bignum_divide_unsigned_medium_denominator
-  (bignum_type, bignum_digit_type, bignum_type *, bignum_type *, int, int);
-static bignum_digit_type bignum_digit_divide
-  (bignum_digit_type, bignum_digit_type, bignum_digit_type, bignum_digit_type *);
-static bignum_digit_type bignum_digit_divide_subtract
-  (bignum_digit_type, bignum_digit_type, bignum_digit_type, bignum_digit_type *);
-static void bignum_divide_unsigned_small_denominator
-  (bignum_type, bignum_digit_type, bignum_type *, bignum_type *, int, int);
-static bignum_digit_type bignum_destructive_scale_down
-  (bignum_type, bignum_digit_type);
-static bignum_type bignum_remainder_unsigned_small_denominator
-  (bignum_type, bignum_digit_type, int);
-static bignum_type bignum_digit_to_bignum(bignum_digit_type, int);
-static bignum_type bignum_allocate(bignum_length_type, int);
-static bignum_type bignum_allocate_zeroed(bignum_length_type, int);
-static bignum_type bignum_shorten_length(bignum_type, bignum_length_type);
-static bignum_type bignum_trim(bignum_type);
-static bignum_type bignum_copy(bignum_type);
-static bignum_type bignum_new_sign(bignum_type, int);
-static bignum_type bignum_maybe_new_sign(bignum_type, int);
-static void bignum_destructive_copy(bignum_type, bignum_type);
-/* Unused
-static void bignum_destructive_zero(bignum_type);
-*/
-
-/* Added for bitwise operations. */
-static bignum_type bignum_magnitude_ash(bignum_type arg1, long n);
-static bignum_type bignum_pospos_bitwise_op(int op, bignum_type, bignum_type);
-static bignum_type bignum_posneg_bitwise_op(int op, bignum_type, bignum_type);
-static bignum_type bignum_negneg_bitwise_op(int op, bignum_type, bignum_type);
-static void        bignum_negate_magnitude(bignum_type);
-static long        bignum_unsigned_logcount(bignum_type arg);
-static int         bignum_unsigned_logbitp(int shift, bignum_type bignum);
-
-static ARRAY* s48_bignum_zero;
-static ARRAY* s48_bignum_pos_one;
-static ARRAY* s48_bignum_neg_one;
-
 /* Exports */
 
-/*
- * We have to allocate the cached constants slightly differently because
- * they have to be registered with the GC, which requires that we have
- * tagged pointers to them.
- */
-
-void
-s48_bignum_make_cached_constants(void)
-{
-  bignum_type temp;
-  
-  s48_bignum_zero = bignum_allocate(0,0);
-
-  s48_bignum_pos_one = bignum_allocate(1,0);
-  (BIGNUM_REF (s48_bignum_pos_one, 0)) = 1;
-  
-  s48_bignum_neg_one = bignum_allocate(1,0);
-  (BIGNUM_REF (s48_bignum_neg_one, 0)) = 1;
-}
-
 int
 s48_bignum_equal_p(bignum_type x, bignum_type y)
 {
@@ -253,7 +177,7 @@ s48_bignum_multiply(bignum_type x, bignum_type y)
   return (bignum_multiply_unsigned (x, y, negative_p));
 }
 
-static int
+int
 bignum_divide(bignum_type numerator, bignum_type denominator,
                  bignum_type * quotient, bignum_type * remainder)
 {
@@ -674,7 +598,7 @@ s48_bignum_max_digit_stream_radix(void)
 
 /* Comparisons */
 
-static int
+int
 bignum_equal_p_unsigned(bignum_type x, bignum_type y)
 {
   bignum_length_type length = (BIGNUM_LENGTH (x));
@@ -692,7 +616,7 @@ bignum_equal_p_unsigned(bignum_type x, bignum_type y)
     }
 }
 
-static enum bignum_comparison
+enum bignum_comparison
 bignum_compare_unsigned(bignum_type x, bignum_type y)
 {
   bignum_length_type x_length = (BIGNUM_LENGTH (x));
@@ -720,7 +644,7 @@ bignum_compare_unsigned(bignum_type x, bignum_type y)
 
 /* Addition */
 
-static bignum_type
+bignum_type
 bignum_add_unsigned(bignum_type x, bignum_type y, int negative_p)
 {
   if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
@@ -783,7 +707,7 @@ bignum_add_unsigned(bignum_type x, bignum_type y, int negative_p)
 
 /* Subtraction */
 
-static bignum_type
+bignum_type
 bignum_subtract_unsigned(bignum_type x, bignum_type y)
 {
   int negative_p;
@@ -857,7 +781,7 @@ bignum_subtract_unsigned(bignum_type x, bignum_type y)
    Maximum value for carry: ((R * (R - 1)) + (R - 1))
        where R == BIGNUM_RADIX_ROOT */
 
-static bignum_type
+bignum_type
 bignum_multiply_unsigned(bignum_type x, bignum_type y, int negative_p)
 {
   if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
@@ -924,7 +848,7 @@ bignum_multiply_unsigned(bignum_type x, bignum_type y, int negative_p)
   }
 }
 
-static bignum_type
+bignum_type
 bignum_multiply_unsigned_small_factor(bignum_type x, bignum_digit_type y,
                                      int negative_p)
 {
@@ -936,7 +860,7 @@ bignum_multiply_unsigned_small_factor(bignum_type x, bignum_digit_type y,
   return (bignum_trim (p));
 }
 
-static void
+void
 bignum_destructive_scale_up(bignum_type bignum, bignum_digit_type factor)
 {
   bignum_digit_type carry = 0;
@@ -966,7 +890,7 @@ bignum_destructive_scale_up(bignum_type bignum, bignum_digit_type factor)
 #undef product_high
 }
 
-static void
+void
 bignum_destructive_add(bignum_type bignum, bignum_digit_type n)
 {
   bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
@@ -997,7 +921,7 @@ bignum_destructive_add(bignum_type bignum, bignum_digit_type n)
    volume 2, "Seminumerical Algorithms"
    section 4.3.1, "Multiple-Precision Arithmetic". */
 
-static void
+void
 bignum_divide_unsigned_large_denominator(bignum_type numerator,
                                         bignum_type denominator,
                                         bignum_type * quotient,
@@ -1047,7 +971,7 @@ bignum_divide_unsigned_large_denominator(bignum_type numerator,
   return;
 }
 
-static void
+void
 bignum_divide_unsigned_normalized(bignum_type u, bignum_type v, bignum_type q)
 {
   bignum_length_type u_length = (BIGNUM_LENGTH (u));
@@ -1122,7 +1046,7 @@ bignum_divide_unsigned_normalized(bignum_type u, bignum_type v, bignum_type q)
 #undef qj
 }
 
-static bignum_digit_type
+bignum_digit_type
 bignum_divide_subtract(bignum_digit_type * v_start,
                       bignum_digit_type * v_end,
                       bignum_digit_type guess,
@@ -1201,7 +1125,7 @@ bignum_divide_subtract(bignum_digit_type * v_start,
   return (guess - 1);
 }
 
-static void
+void
 bignum_divide_unsigned_medium_denominator(bignum_type numerator,
                                          bignum_digit_type denominator,
                                          bignum_type * quotient,
@@ -1261,7 +1185,7 @@ bignum_divide_unsigned_medium_denominator(bignum_type numerator,
   return;
 }
 
-static void
+void
 bignum_destructive_normalization(bignum_type source, bignum_type target,
                                 int shift_left)
 {
@@ -1286,7 +1210,7 @@ bignum_destructive_normalization(bignum_type source, bignum_type target,
   return;
 }
 
-static void
+void
 bignum_destructive_unnormalization(bignum_type bignum, int shift_right)
 {
   bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
@@ -1333,7 +1257,7 @@ bignum_destructive_unnormalization(bignum_type bignum, int shift_right)
   qn = (bignum_digit_divide_subtract (v1, v2, guess, (&u[j])));                \
 }
 
-static bignum_digit_type
+bignum_digit_type
 bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul,
                    bignum_digit_type v,
                    bignum_digit_type * q) /* return value */
@@ -1405,7 +1329,7 @@ bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul,
     }                                                                  \
 }
 
-static bignum_digit_type
+bignum_digit_type
 bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2,
                             bignum_digit_type guess, bignum_digit_type * u)
 {
@@ -1440,7 +1364,7 @@ bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2,
 #undef BDDS_MULSUB
 #undef BDDS_ADD
 
-static void
+void
 bignum_divide_unsigned_small_denominator(bignum_type numerator,
                                         bignum_digit_type denominator,
                                         bignum_type * quotient,
@@ -1460,7 +1384,7 @@ bignum_divide_unsigned_small_denominator(bignum_type numerator,
    (quotient_high < BIGNUM_RADIX_ROOT), after which it is easy to see
    that all digits are < BIGNUM_RADIX. */
 
-static bignum_digit_type
+bignum_digit_type
 bignum_destructive_scale_down(bignum_type bignum, bignum_digit_type denominator)
 {
   bignum_digit_type numerator;
@@ -1483,7 +1407,7 @@ bignum_destructive_scale_down(bignum_type bignum, bignum_digit_type denominator)
 #undef quotient_high
 }
 
-static bignum_type
+bignum_type
 bignum_remainder_unsigned_small_denominator(
        bignum_type n, bignum_digit_type d, int negative_p)
 {
@@ -1503,7 +1427,7 @@ bignum_remainder_unsigned_small_denominator(
   return (bignum_digit_to_bignum (r, negative_p));
 }
 
-static bignum_type
+bignum_type
 bignum_digit_to_bignum(bignum_digit_type digit, int negative_p)
 {
   if (digit == 0)
@@ -1518,7 +1442,7 @@ bignum_digit_to_bignum(bignum_digit_type digit, int negative_p)
 
 /* Allocation */
 
-static bignum_type
+bignum_type
 bignum_allocate(bignum_length_type length, int negative_p)
 {
   BIGNUM_ASSERT ((length >= 0) || (length < BIGNUM_RADIX));
@@ -1529,7 +1453,7 @@ bignum_allocate(bignum_length_type length, int negative_p)
   }
 }
 
-static bignum_type
+bignum_type
 bignum_allocate_zeroed(bignum_length_type length, int negative_p)
 {
   BIGNUM_ASSERT ((length >= 0) || (length < BIGNUM_RADIX));
@@ -1544,7 +1468,7 @@ bignum_allocate_zeroed(bignum_length_type length, int negative_p)
   }
 }
 
-static bignum_type
+bignum_type
 bignum_shorten_length(bignum_type bignum, bignum_length_type length)
 {
   bignum_length_type current_length = (BIGNUM_LENGTH (bignum));
@@ -1557,7 +1481,7 @@ bignum_shorten_length(bignum_type bignum, bignum_length_type length)
   return (bignum);
 }
 
-static bignum_type
+bignum_type
 bignum_trim(bignum_type bignum)
 {
   bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
@@ -1577,7 +1501,7 @@ bignum_trim(bignum_type bignum)
 
 /* Copying */
 
-static bignum_type
+bignum_type
 bignum_copy(bignum_type source)
 {
   bignum_type target =
@@ -1586,7 +1510,7 @@ bignum_copy(bignum_type source)
   return (target);
 }
 
-static bignum_type
+bignum_type
 bignum_new_sign(bignum_type bignum, int negative_p)
 {
   bignum_type result =
@@ -1595,7 +1519,7 @@ bignum_new_sign(bignum_type bignum, int negative_p)
   return (result);
 }
 
-static bignum_type
+bignum_type
 bignum_maybe_new_sign(bignum_type bignum, int negative_p)
 {
 #ifndef BIGNUM_FORCE_NEW_RESULTS
@@ -1611,7 +1535,7 @@ bignum_maybe_new_sign(bignum_type bignum, int negative_p)
     }
 }
 
-static void
+void
 bignum_destructive_copy(bignum_type source, bignum_type target)
 {
   bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
@@ -1624,7 +1548,7 @@ bignum_destructive_copy(bignum_type source, bignum_type target)
 }
 
 /* Unused
-static void
+void
 bignum_destructive_zero(bignum_type bignum)
 {
   bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
@@ -1729,7 +1653,7 @@ s48_bignum_bitwise_xor(bignum_type arg1, bignum_type arg2)
 
 /* ash for the magnitude */
 /* assume arg1 is a big number, n is a long */
-static bignum_type
+bignum_type
 bignum_magnitude_ash(bignum_type arg1, long n)
 {
   bignum_type result;
@@ -1788,7 +1712,7 @@ bignum_magnitude_ash(bignum_type arg1, long n)
   return (bignum_trim (result));
 }
 
-static bignum_type
+bignum_type
 bignum_pospos_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
 {
   bignum_type result;
@@ -1824,7 +1748,7 @@ bignum_pospos_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
   return bignum_trim(result);
 }
 
-static bignum_type
+bignum_type
 bignum_posneg_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
 {
   bignum_type result;
@@ -1874,7 +1798,7 @@ bignum_posneg_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
   return bignum_trim(result);
 }
 
-static bignum_type
+bignum_type
 bignum_negneg_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
 {
   bignum_type result;
@@ -1932,7 +1856,7 @@ bignum_negneg_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
   return bignum_trim(result);
 }
 
-static void
+void
 bignum_negate_magnitude(bignum_type arg)
 {
   bignum_digit_type *scan;
@@ -1960,7 +1884,7 @@ bignum_negate_magnitude(bignum_type arg)
   }
 }
 
-static long
+long
 bignum_unsigned_logcount(bignum_type arg)
 {
 
@@ -1995,7 +1919,7 @@ bignum_logbitp(int shift, bignum_type arg)
         : bignum_unsigned_logbitp (shift,arg));
 }
 
-static int
+int
 bignum_unsigned_logbitp(int shift, bignum_type bignum)
 {
   bignum_length_type len = (BIGNUM_LENGTH (bignum));

diff --git a/native/s48_bignum.h b/native/s48_bignum.h
index 8717f534b0818b82e56ebdcb2a50e303d5999796..4bdea671c2e5a94d1a3ea232d4137f738a7b01ee 100644 (file)
--- a/native/s48_bignum.h
+++ b/native/s48_bignum.h
@@ -53,42 +53,94 @@ enum bignum_comparison
 };
 
 typedef void * bignum_procedure_context;
-extern int s48_bignum_equal_p(bignum_type, bignum_type);
-extern enum bignum_comparison s48_bignum_test(bignum_type);
-extern enum bignum_comparison s48_bignum_compare(bignum_type, bignum_type);
-extern bignum_type s48_bignum_add(bignum_type, bignum_type);
-extern bignum_type s48_bignum_subtract(bignum_type, bignum_type);
-extern bignum_type s48_bignum_negate(bignum_type);
-extern bignum_type s48_bignum_multiply(bignum_type, bignum_type);
-extern int s48_bignum_divide(bignum_type numerator, bignum_type denominator,
+int s48_bignum_equal_p(bignum_type, bignum_type);
+enum bignum_comparison s48_bignum_test(bignum_type);
+enum bignum_comparison s48_bignum_compare(bignum_type, bignum_type);
+bignum_type s48_bignum_add(bignum_type, bignum_type);
+bignum_type s48_bignum_subtract(bignum_type, bignum_type);
+bignum_type s48_bignum_negate(bignum_type);
+bignum_type s48_bignum_multiply(bignum_type, bignum_type);
+int s48_bignum_divide(bignum_type numerator, bignum_type denominator,
                             void * quotient, void * remainder);
-extern bignum_type s48_bignum_quotient(bignum_type, bignum_type);
-extern bignum_type s48_bignum_remainder(bignum_type, bignum_type);
-extern bignum_type s48_long_to_bignum(long);
-extern bignum_type s48_ulong_to_bignum(unsigned long);
-extern long s48_bignum_to_long(bignum_type);
-extern unsigned long s48_bignum_to_ulong(bignum_type);
-extern bignum_type s48_double_to_bignum(double);
-extern double s48_bignum_to_double(bignum_type);
-extern int s48_bignum_fits_in_word_p(bignum_type, long word_length,
+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_ulong_to_bignum(unsigned long);
+long s48_bignum_to_long(bignum_type);
+unsigned long s48_bignum_to_ulong(bignum_type);
+bignum_type s48_double_to_bignum(double);
+double s48_bignum_to_double(bignum_type);
+int s48_bignum_fits_in_word_p(bignum_type, long word_length,
                                     int twos_complement_p);
-extern bignum_type s48_bignum_length_in_bits(bignum_type);
-extern bignum_type s48_bignum_length_upper_limit(void);
-extern bignum_type s48_digit_stream_to_bignum
+bignum_type s48_bignum_length_in_bits(bignum_type);
+bignum_type s48_bignum_length_upper_limit(void);
+bignum_type s48_digit_stream_to_bignum
        (unsigned int n_digits,
        unsigned int (*producer(bignum_procedure_context)),
        bignum_procedure_context context,
        unsigned int radix,
        int negative_p);
-extern long s48_bignum_max_digit_stream_radix(void);
+long s48_bignum_max_digit_stream_radix(void);
 
 /* Added bitwise operators. */
 
-extern bignum_type s48_bignum_bitwise_not(bignum_type),
+bignum_type s48_bignum_bitwise_not(bignum_type),
                    s48_bignum_arithmetic_shift(bignum_type, long),
                    s48_bignum_bitwise_and(bignum_type, bignum_type),
                    s48_bignum_bitwise_ior(bignum_type, bignum_type),
                    s48_bignum_bitwise_xor(bignum_type, bignum_type);
 
-extern int s48_bignum_oddp(bignum_type);
-extern long s48_bignum_bit_count(bignum_type);
+int s48_bignum_oddp(bignum_type);
+long s48_bignum_bit_count(bignum_type);
+
+/* Forward references */
+int bignum_equal_p_unsigned(bignum_type, bignum_type);
+enum bignum_comparison bignum_compare_unsigned(bignum_type, bignum_type);
+bignum_type bignum_add_unsigned(bignum_type, bignum_type, int);
+bignum_type bignum_subtract_unsigned(bignum_type, bignum_type);
+bignum_type bignum_multiply_unsigned(bignum_type, bignum_type, int);
+bignum_type bignum_multiply_unsigned_small_factor
+  (bignum_type, bignum_digit_type, int);
+void bignum_destructive_scale_up(bignum_type, bignum_digit_type);
+void bignum_destructive_add(bignum_type, bignum_digit_type);
+void bignum_divide_unsigned_large_denominator
+  (bignum_type, bignum_type, bignum_type *, bignum_type *, int, int);
+void bignum_destructive_normalization(bignum_type, bignum_type, int);
+void bignum_destructive_unnormalization(bignum_type, int);
+void bignum_divide_unsigned_normalized(bignum_type, bignum_type, bignum_type);
+bignum_digit_type bignum_divide_subtract
+  (bignum_digit_type *, bignum_digit_type *, bignum_digit_type,
+   bignum_digit_type *);
+void bignum_divide_unsigned_medium_denominator
+  (bignum_type, bignum_digit_type, bignum_type *, bignum_type *, int, int);
+bignum_digit_type bignum_digit_divide
+  (bignum_digit_type, bignum_digit_type, bignum_digit_type, bignum_digit_type *);
+bignum_digit_type bignum_digit_divide_subtract
+  (bignum_digit_type, bignum_digit_type, bignum_digit_type, bignum_digit_type *);
+void bignum_divide_unsigned_small_denominator
+  (bignum_type, bignum_digit_type, bignum_type *, bignum_type *, int, int);
+bignum_digit_type bignum_destructive_scale_down
+  (bignum_type, bignum_digit_type);
+bignum_type bignum_remainder_unsigned_small_denominator
+  (bignum_type, bignum_digit_type, int);
+bignum_type bignum_digit_to_bignum(bignum_digit_type, int);
+bignum_type bignum_allocate(bignum_length_type, int);
+bignum_type bignum_allocate_zeroed(bignum_length_type, int);
+bignum_type bignum_shorten_length(bignum_type, bignum_length_type);
+bignum_type bignum_trim(bignum_type);
+bignum_type bignum_copy(bignum_type);
+bignum_type bignum_new_sign(bignum_type, int);
+bignum_type bignum_maybe_new_sign(bignum_type, int);
+void bignum_destructive_copy(bignum_type, bignum_type);
+/* Unused
+void bignum_destructive_zero(bignum_type);
+*/
+
+/* Added for bitwise operations. */
+bignum_type bignum_magnitude_ash(bignum_type arg1, long n);
+bignum_type bignum_pospos_bitwise_op(int op, bignum_type, bignum_type);
+bignum_type bignum_posneg_bitwise_op(int op, bignum_type, bignum_type);
+bignum_type bignum_negneg_bitwise_op(int op, bignum_type, bignum_type);
+void        bignum_negate_magnitude(bignum_type);
+long        bignum_unsigned_logcount(bignum_type arg);
+int         bignum_unsigned_logbitp(int shift, bignum_type bignum);

diff --git a/native/s48_bignumint.h b/native/s48_bignumint.h
index a23ebf0ff21aa8675e55a08a1e23ddcec32115cc..743bc465e09360d117d7a95569c42824047584ed 100644 (file)
--- a/native/s48_bignumint.h
+++ b/native/s48_bignumint.h
@@ -57,7 +57,7 @@ typedef CELL bignum_length_type;
 /* BIGNUM_REDUCE_LENGTH allows the memory system to reclaim some
    space when a bignum's length is reduced from its original value. */
 #define BIGNUM_REDUCE_LENGTH(target, source, length)            \
-     target = shrink_array(source, length)
+     target = shrink_array(source, length + 1)
 extern ARRAY* shrink_array(ARRAY* array, CELL capacity);
 
 /* BIGNUM_DEALLOCATE is called when disposing of bignums which are
@@ -83,9 +83,9 @@ extern ARRAY* shrink_array(ARRAY* array, CELL capacity);
 #define BIGNUM_START_PTR(bignum)                                       \
   ((BIGNUM_TO_POINTER (bignum)) + 1)
 
-#define BIGNUM_LENGTH(bignum) (bignum->capacity - 1)
+#define BIGNUM_LENGTH(bignum) ((bignum)->capacity - 1)
 
-#define BIGNUM_NEGATIVE_P(bignum) (AREF(bignum,0) != 0)
+#define BIGNUM_NEGATIVE_P(bignum) (get(AREF(bignum,0)) != 0)
 #define BIGNUM_SET_NEGATIVE_P(bignum,neg) put(AREF(bignum,0),neg)
 
 #define BIGNUM_ZERO_P(bignum)                                          \
@@ -102,9 +102,9 @@ extern ARRAY* shrink_array(ARRAY* array, CELL capacity);
 
 /* These definitions are here to facilitate caching of the constants
    0, 1, and -1. */
-#define BIGNUM_ZERO() s48_bignum_zero
+#define BIGNUM_ZERO() bignum_zero
 #define BIGNUM_ONE(neg_p) \
-   (neg_p ? s48_bignum_pos_one : s48_bignum_neg_one)
+   (neg_p ? bignum_pos_one : bignum_neg_one)
 
 #define HD_LOW(digit) ((digit) & BIGNUM_HALF_DIGIT_MASK)
 #define HD_HIGH(digit) ((digit) >> BIGNUM_HALF_DIGIT_LENGTH)

diff --git a/native/string.c b/native/string.c
index f781779ec1af7a191f930031bb592730464a2c2c..e1e5336ea66d9a6357fbc55a4ffbecc5d20f143f 100644 (file)
--- a/native/string.c
+++ b/native/string.c
@@ -161,7 +161,8 @@ void primitive_string_eq(void)
 
 void primitive_string_hashcode(void)
 {
-       drepl(tag_object(bignum(untag_string(dpeek())->hashcode)));
+       drepl(tag_object(s48_long_to_bignum(
+               untag_string(dpeek())->hashcode)));
 }
 
 CELL index_of_ch(CELL index, STRING* string, CELL ch)