diff options
Diffstat (limited to 'arith.txr')
-rw-r--r-- | arith.txr | 115 |
1 files changed, 109 insertions, 6 deletions
@@ -42,6 +42,7 @@ #include <dirent.h> #include <setjmp.h> #include <wchar.h> +#include <limits.h> #include "config.h" #include "lib.h" #include "unwind.h" @@ -50,6 +51,7 @@ #define TAG_PAIR(A, B) ((A) << TAG_SHIFT | (B)) #define NOOP(A, B) +#define CNUM_BIT ((int) sizeof (cnum) * CHAR_BIT) static mp_int NUM_MAX_MP; @@ -61,6 +63,20 @@ val make_bignum(void) return n; } +static val bignum(cnum cn) +{ + val n = make_bignum(); + mp_set_intptr(mp(n), cn); + return n; +} + +static val bignum_dbl_ipt(double_intptr_t di) +{ + val n = make_bignum(); + mp_set_double_intptr(mp(n), di); + return n; +} + static val normalize(val bignum) { switch (mp_cmp_mag(mp(bignum), &NUM_MAX_MP)) { @@ -89,12 +105,8 @@ val @{add-fname}(val anum, val bnum) cnum b = c_num(bnum); cnum sum = a @{add-c-op} b; - if (sum < NUM_MIN || sum > NUM_MAX) { - val n = make_bignum(); - mp_set_intptr(mp(n), sum); - return n; - } - + if (sum < NUM_MIN || sum > NUM_MAX) + return bignum(sum); return num(sum); } case TAG_PAIR(TAG_NUM, TAG_PTR): @@ -155,6 +167,97 @@ val neg(val anum) } } +val mul(val anum, val bnum) +{ + int tag_a = tag(anum); + int tag_b = tag(bnum); + + switch (TAG_PAIR(tag_a, tag_b)) { + case TAG_PAIR(TAG_NUM, TAG_NUM): + { + cnum a = c_num(anum); + cnum b = c_num(bnum); +#if HAVE_DOUBLE_INTPTR_T + double_intptr_t product = a * (double_intptr_t) b; + if (product < NUM_MIN || product > NUM_MAX) + return bignum_dbl_ipt(product); + return num(product); +#else + cnum ap = (a < 0) ? -a : a; + cnum bp = (b < 0) ? -b : b; + int bit = CNUM_BIT - 3, amaxbit = 0, bmaxbit = 0; + cnum mask = (cnum) 1 << (CNUM_BIT - 4); + for (; mask && (ap || bp); mask >>= 1, bit--) { + if ((ap & mask)) { + amaxbit = bit; + ap = 0; + } + if ((bp & mask)) { + bmaxbit = bit; + bp = 0; + } + } + if (amaxbit + bmaxbit < CNUM_BIT - 1) { + cnum product = a * b; + if (product >= NUM_MIN && product <= NUM_MAX) + return num(a * b); + return bignum(a * b); + } else { + val n = make_bignum(); + mp_int tmpb; + mp_init(&tmpb); + mp_set_intptr(&tmpb, b); + mp_set_intptr(mp(n), a); + mp_mul(mp(n), &tmpb, mp(n)); + mp_clear(&tmpb); + return n; + } +#endif + } + case TAG_PAIR(TAG_NUM, TAG_PTR): + { + val n; + type_check(bnum, BGNUM); + n = make_bignum(); + if (sizeof (int_ptr_t) <= sizeof (mp_digit)) { + mp_mul_d(mp(bnum), c_num(anum), mp(n)); + } else { + mp_int tmp; + mp_init(&tmp); + mp_set_intptr(&tmp, c_num(anum)); + mp_mul(mp(bnum), &tmp, mp(n)); + } + return n; + } + case TAG_PAIR(TAG_PTR, TAG_NUM): + { + val n; + type_check(bnum, BGNUM); + n = make_bignum(); + if (sizeof (int_ptr_t) <= sizeof (mp_digit)) { + mp_mul_d(mp(anum), c_num(bnum), mp(n)); + } else { + mp_int tmp; + mp_init(&tmp); + mp_set_intptr(&tmp, c_num(bnum)); + mp_mul(mp(anum), &tmp, mp(n)); + } + return n; + } + case TAG_PAIR(TAG_PTR, TAG_PTR): + { + val n; + type_check(anum, BGNUM); + type_check(bnum, BGNUM); + n = make_bignum(); + mp_mul(mp(anum), mp(bnum), mp(n)); + return n; + } + } + uw_throwf(error_s, lit("mul: invalid operands ~s ~s"), anum, bnum, nao); + abort(); +} + void arith_init(void) { mp_init(&NUM_MAX_MP); |