Bignum support, here we go!

Bignums, based on Michael Fromberger's MPI library, are integrated
into the input syntax, stream output, equality testing, the garbage
collector, and hashing.

The plus operation handles transitions between fixnums and bignums.
Other operations are still fixnum only.

* Makefile (CFLAGS): Add mpi directory to include file search.
(OBJS): Include new arith.o module and all of MPI_OBJS.
(MPI_OBJS, MPI_OBJS_BASE): New variables.

* configure (mpi_version, have_quilt, have_patch): New variables.
Script detects whether patch and quilt are available. Unpacks
mpi library, applies patches. Detects 128 bit integer type.
Records more information in config.h about the sizes of types.

* dep.mk: Updated.

* depend.txr: Make work with paths that have directory components.

* eval.c (eval_init): Rename of nump to fixnump.

* gc.c (finalize, mark_obj): Handle BGNUM case.

* hash.c: (hash_c_str): Changed to return unsigned long
instead of long.
(equal_hash): Handle BGNUM case.
(eql_hash): Handle bignums with equal-hash, but other
objects as eq.

* lib.c (num_s): Variable renamed to fixnum_s.
(bignum_s): New symbol variable.
(code2type): Follow rename of num_s. Handle BGNUM case.
(typeof): Follow rename of num_s.
(eql): Handle bignums using equal, and other types using eq.
(equal): Handle BGNUM case.
(chk_calloc): New function.
(c_num): Wording change in error message: is not a fixnum.
(nump): Renamed to fixnump.
(bignump): New function.
(plus): Function removed, reimplemented in arith.c.
(int_str): Handle integers which are too large for wcstol
using bignum conversion. Base 0 is no longer passed to
wcstol but converted to 10 because the special semantics
for 0 would be inconsistent for bignums.
(obj_init): Follow rename of num_s. Initialize bignum_s.

1 files changed, 58 insertions, 14 deletions

diff --git a/stream.c b/stream.c
index a7ddbb66..9f0b282f 100644
--- a/stream.c
+++ b/stream.c
@@ -837,11 +837,11 @@ val vformat(val stream, val fmtstr, va_list vl)
     int left = 0, zeropad = 0;
     cnum value;
     void *ptr;
-    char num_buf[64];
 
     for (;;) {
       val obj;
       wchar_t ch = *fmt++;
+      char num_buf[64], *pnum = num_buf;
 
       switch (state) {
       case vf_init:
@@ -951,24 +951,45 @@ val vformat(val stream, val fmtstr, va_list vl)
         switch (ch) {
         case 'x':
           obj = va_arg(vl, val);
-          value = c_num(obj);
-          sprintf(num_buf, num_fmt->hex, value);
+          if (bignump(obj)) {
+            int nchars = mp_radix_size(mp(obj), 16); 
+            if (nchars >= (int) sizeof (num_buf))
+              pnum = (char *) chk_malloc(nchars + 1);
+            mp_toradix_case(mp(obj), (unsigned char *) pnum, 16, 1);
+          } else {
+            value = c_num(obj);
+            sprintf(num_buf, num_fmt->hex, value);
+          }
           goto output_num;
         case 'X':
           obj = va_arg(vl, val);
-          value = c_num(obj);
-          sprintf(num_buf, num_fmt->HEX, value);
+          if (bignump(obj)) {
+            int nchars = mp_radix_size(mp(obj), 16); 
+            if (nchars >= (int) sizeof (num_buf))
+              pnum = (char *) chk_malloc(nchars + 1);
+            mp_toradix_case(mp(obj), (unsigned char *) pnum, 16, 0);
+          } else {
+            value = c_num(obj);
+            sprintf(num_buf, num_fmt->HEX, value);
+          }
           goto output_num;
         case 'o':
           obj = va_arg(vl, val);
-          value = c_num(obj);
-          sprintf(num_buf, num_fmt->oct, value);
+          if (bignump(obj)) {
+            int nchars = mp_radix_size(mp(obj), 8); 
+            if (nchars >= (int) sizeof (num_buf))
+              pnum = (char *) chk_malloc(nchars + 1);
+            mp_toradix(mp(obj), (unsigned char *) pnum, 8);
+          } else {
+            value = c_num(obj);
+            sprintf(num_buf, num_fmt->oct, value);
+          }
           goto output_num;
         case 'a':
           obj = va_arg(vl, val);
           if (obj == nao)
             goto premature;
-          if (nump(obj)) {
+          if (fixnump(obj)) {
             value = c_num(obj);
             sprintf(num_buf, num_fmt->dec, value);
             goto output_num;
@@ -976,6 +997,12 @@ val vformat(val stream, val fmtstr, va_list vl)
             if (!vformat_str(stream, obj, width, left, precision))
               return nil;
             continue;
+          } else if (bignump(obj)) {
+            int nchars = mp_radix_size(mp(obj), 10); 
+            if (nchars >= (int) sizeof (num_buf))
+              pnum = (char *) chk_malloc(nchars + 1);
+            mp_toradix(mp(obj), (unsigned char *) pnum, 10);
+            goto output_num;
           }
           obj_pprint(obj, stream);
           continue;
@@ -983,12 +1010,24 @@ val vformat(val stream, val fmtstr, va_list vl)
           obj = va_arg(vl, val);
           if (obj == nao)
             goto premature;
-          if (nump(obj)) {
+          if (fixnump(obj)) {
             value = c_num(obj);
             sprintf(num_buf, num_fmt->dec, value);
             if (!vformat_num(stream, num_buf, 0, 0, 0, 0))
               return nil;
             continue;
+          } else if (bignump(obj)) {
+            int nchars = mp_radix_size(mp(obj), 10); 
+            val res;
+            if (nchars >= (int) sizeof (num_buf))
+              pnum = (char *) chk_malloc(nchars + 1);
+            mp_toradix(mp(obj), (unsigned char *) pnum, 10);
+            res = vformat_num(stream, pnum, 0, 0, 0, 0);
+            if (pnum != num_buf)
+              free(pnum);
+            if (!res)
+              return nil;
+            continue;
           }
           obj_print(obj, stream);
           continue;
@@ -1001,11 +1040,16 @@ val vformat(val stream, val fmtstr, va_list vl)
         default:
           abort();
         output_num:
-          if (!vformat_num(stream, num_buf, width, left,
-                           precision ? 0 : zeropad,
-                           precision ? precision : 1))
-            return nil;
-          continue;
+          {
+            val res = vformat_num(stream, pnum, width, left,
+                                  precision ? 0 : zeropad,
+                                  precision ? precision : 1);
+            if (pnum != num_buf)
+              free(pnum);
+            if (!res)
+              return nil;
+            continue;
+          }
         }
         continue;
       }