diff --git a/bignum-test.scm b/bignum-test.scm new file mode 100644 index 00000000..69fbcd7c --- /dev/null +++ b/bignum-test.scm @@ -0,0 +1,22 @@ +;; A temporary test file +;; TODO: create a test suite +(import (scheme base) (scheme write)) + +(define x (exact (expt 2 29))) +(write (bignum? x)) +(write (bignum? (+ x x))) +(write (+ x x)) +(newline) +(set! x (+ x x)) +(write + (list x (+ x ) (+ 1 x))) +(newline) +(write + (list + x + (+ 1.0 x ) + (+ x x) + (+ x 1.0) + (+ x 1) + )) +(newline) diff --git a/include/cyclone/types.h b/include/cyclone/types.h index 47a75b57..542b4cbf 100644 --- a/include/cyclone/types.h +++ b/include/cyclone/types.h @@ -378,6 +378,12 @@ typedef struct { n.tag = bignum_tag; \ mp_init(&(n.bn)); /* TODO: check return value of mp_init */ +#define assign_empty_bignum(pobj) \ + ((bignum_type *)pobj)->hdr.mark = gc_color_red; \ + ((bignum_type *)pobj)->hdr.grayed = 0; \ + ((bignum_type *)pobj)->tag = bignum_tag; \ + mp_init(&(((bignum_type *)pobj)->bn)); +/* TODO: check return value of mp_init */ typedef struct { gc_header_type hdr; diff --git a/runtime.c b/runtime.c index f49fa1d2..63944b3d 100644 --- a/runtime.c +++ b/runtime.c @@ -2531,8 +2531,17 @@ object FUNC_OP(void *data, common_type *x, object y) { \ if (INT_OP(x->integer_t.value, obj_obj2int(y), &result) == 0) { \ x->integer_t.value = result; \ } else { \ - fprintf(stderr, "integer overflow or underflow detected\n"); \ - exit(1); \ + mp_init(&bn_tmp); \ + mp_init(&bn_tmp2); \ + Cyc_int2bignum(x->integer_t.value, &bn_tmp); \ + Cyc_int2bignum(obj_obj2int(y), &bn_tmp2); \ + x->bignum_t.hdr.mark = gc_color_red; \ + x->bignum_t.hdr.grayed = 0; \ + x->bignum_t.tag = bignum_tag; \ + mp_init(&(x->bignum_t.bn)); \ + BN_OP(&bn_tmp, &bn_tmp2, &(x->bignum_t.bn)); \ + mp_clear(&bn_tmp); \ + mp_clear(&bn_tmp2); \ } \ } else if (tx == double_tag && ty == -1) { \ x->double_t.value = x->double_t.value OP (obj_obj2int(y)); \ @@ -2555,6 +2564,7 @@ object FUNC_OP(void *data, common_type *x, object y) { \ x->bignum_t.tag = bignum_tag; \ mp_init(&(x->bignum_t.bn)); \ BN_OP(&bn_tmp2, &bignum_value(y), &(x->bignum_t.bn)); \ + mp_clear(&bn_tmp2); \ } else if (tx == double_tag && ty == bignum_tag) { \ x->double_t.value = x->double_t.value OP mp_get_double(&bignum_value(y)); \ } else if (tx == bignum_tag && ty == -1) { \ @@ -2562,6 +2572,7 @@ object FUNC_OP(void *data, common_type *x, object y) { \ Cyc_int2bignum(obj_obj2int(y), &bn_tmp2); \ mp_init_copy(&bn_tmp, &(x->bignum_t.bn)); \ BN_OP(&bn_tmp, &bn_tmp2, &(x->bignum_t.bn)); \ + mp_clear(&bn_tmp2); \ } else if (tx == bignum_tag && ty == double_tag) { \ x->double_t.hdr.mark = gc_color_red; \ x->double_t.hdr.grayed = 0; \ @@ -2613,14 +2624,31 @@ object Cyc_fast_sum(void *data, object ptr, object x, object y) { if (Cyc_checked_add(xx, yy, &z) == 0) { return obj_int2obj(z); } else { - // TODO: no, use bignum instead - assign_double(ptr, (double)xx + (double)yy); + //// TODO: no, use bignum instead + //assign_double(ptr, (double)xx + (double)yy); + //return ptr; + mp_int tmp, tmp2; + mp_init(&tmp); + mp_init(&tmp2); + Cyc_int2bignum(xx, &tmp); + Cyc_int2bignum(yy, &tmp2); + assign_empty_bignum(ptr) + mp_add(&tmp, &tmp2, &bignum_value(ptr)); + mp_clear(&tmp); + mp_clear(&tmp2); return ptr; } } else if (is_object_type(y) && type_of(y) == double_tag) { assign_double(ptr, (double)(obj_obj2int(x)) + double_value(y)); return ptr; } else if (is_object_type(y) && type_of(y) == bignum_tag) { + mp_int tmp; + mp_init(&tmp); + Cyc_int2bignum(obj_obj2int(x), &tmp); + assign_empty_bignum(ptr) + mp_add(&tmp, &bignum_value(y), &bignum_value(ptr)); + mp_clear(&tmp); + return ptr; } } // x is double @@ -2632,17 +2660,27 @@ object Cyc_fast_sum(void *data, object ptr, object x, object y) { assign_double(ptr, double_value(x) + double_value(y)); return ptr; } else if (is_object_type(y) && type_of(y) == bignum_tag) { + assign_double(ptr, double_value(x) + mp_get_double(&bignum_value(y))); + return ptr; } } // x is bignum if (is_object_type(x) && type_of(x) == bignum_tag) { if (obj_is_int(y)){ - //assign_double(ptr, double_value(x) + (double)(obj_obj2int(y))); - //return ptr; + mp_int tmp; + mp_init(&tmp); + Cyc_int2bignum(obj_obj2int(y), &tmp); + assign_empty_bignum(ptr) + mp_add(&bignum_value(x), &tmp, &bignum_value(ptr)); + mp_clear(&tmp); + return ptr; } else if (is_object_type(y) && type_of(y) == double_tag) { - //assign_double(ptr, double_value(x) + double_value(y)); - //return ptr; + assign_double(ptr, mp_get_double(&bignum_value(x)) + double_value(y)); + return ptr; } else if (is_object_type(y) && type_of(y) == bignum_tag) { + assign_empty_bignum(ptr) + mp_add(&bignum_value(x), &bignum_value(y), &bignum_value(ptr)); + return ptr; } } // still here, raise an error diff --git a/scheme/base.sld b/scheme/base.sld index 55966b9e..df8128a8 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -41,6 +41,7 @@ odd? complex? rational? + bignum? gcd lcm quotient