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, 51 insertions, 19 deletions

diff --git a/lib.c b/lib.c
index 96b0e3c6..d99d16e2 100644
--- a/lib.c
+++ b/lib.c
@@ -33,6 +33,7 @@
 #include <stdarg.h>
 #include <dirent.h>
 #include <setjmp.h>
+#include <errno.h>
 #include <wchar.h>
 #include "config.h"
 #ifdef HAVE_GETENVIRONMENTSTRINGS
@@ -41,6 +42,7 @@
 #endif
 #include "lib.h"
 #include "gc.h"
+#include "arith.h"
 #include "hash.h"
 #include "unwind.h"
 #include "stream.h"
@@ -55,9 +57,9 @@ val packages;
 
 val system_package, keyword_package, user_package;
 
-val null, t, cons_s, str_s, chr_s, num_s, sym_s, pkg_s, fun_s, vec_s;
+val null, t, cons_s, str_s, chr_s, fixnum_s, sym_s, pkg_s, fun_s, vec_s;
 val stream_s, hash_s, hash_iter_s, lcons_s, lstr_s, cobj_s, cptr_s;
-val env_s;
+val env_s, bignum_s;
 val var_s, expr_s, regex_s, chset_s, set_s, cset_s, wild_s, oneplus_s;
 val nongreedy_s, compiled_regex_s;
 val quote_s, qquote_s, unquote_s, splice_s;
@@ -99,7 +101,7 @@ static val code2type(int code)
   case STR: return str_s;
   case LIT: return str_s;
   case CHR: return chr_s;
-  case NUM: return num_s;
+  case NUM: return fixnum_s;
   case SYM: return sym_s;
   case PKG: return pkg_s;
   case FUN: return fun_s;
@@ -108,6 +110,7 @@ static val code2type(int code)
   case LSTR: return lstr_s;
   case COBJ: return cobj_s;
   case ENV: return env_s;
+  case BGNUM: return bignum_s;
   }
   return nil;
 }
@@ -116,7 +119,7 @@ val typeof(val obj)
 {
   switch (tag(obj)) {
   case TAG_NUM:
-    return num_s;
+    return fixnum_s;
   case TAG_CHR:
     return chr_s;
   case TAG_LIT:
@@ -494,6 +497,8 @@ val eql(val left, val right)
   /* eql is same as eq for now, but when we get bignums,
      eql will compare different bignum objects which are
      the same number as equal. */
+  if (is_ptr(left) && type(left) == BGNUM)
+    return equal(left, right);
   return eq(left, right);
 }
 
@@ -597,6 +602,10 @@ val equal(val left, val right)
       break;
     }
     return nil;
+  case BGNUM:
+    if (type(right) == BGNUM && mp_cmp(mp(left), mp(right)) == MP_EQ)
+      return t;
+    return nil;
   case COBJ:
     if (type(right) == COBJ)
       return left->co.ops->equal(left, right);
@@ -619,6 +628,16 @@ mem_t *chk_malloc(size_t size)
   return ptr;
 }
 
+mem_t *chk_calloc(size_t n, size_t size)
+{
+  mem_t *ptr = (mem_t *) calloc(n, size);
+  if (size && ptr == 0) {
+    ptr = (mem_t *) oom_realloc(0, size);
+    memset(ptr, 0, n * size);
+  }
+  return ptr;
+}
+
 mem_t *chk_realloc(mem_t *old, size_t size)
 {
   mem_t *newptr = (mem_t *) realloc(old, size);
@@ -799,24 +818,18 @@ cnum c_num(val num)
   case TAG_CHR: case TAG_NUM:
     return ((cnum) num) >> TAG_SHIFT;
   default:
-    type_mismatch(lit("~s is not a number"), num, nao);
+    type_mismatch(lit("~s is not a fixnum"), num, nao);
   }
 }
 
-val nump(val num)
+val fixnump(val num)
 {
   return (is_num(num)) ? t : nil;
 }
 
-val plus(val anum, val bnum)
+val bignump(val num)
 {
-  cnum a = c_num(anum);
-  cnum b = c_num(bnum);
-
-  numeric_assert (a <= 0 || b <= 0 || NUM_MAX - b >= a);
-  numeric_assert (a >= 0 || b >= 0 || NUM_MIN - b <= a);
-
-  return num(a + b);
+  return (is_ptr(num) && type(num) == BGNUM) ? t : nil;
 }
 
 val plusv(val nlist)
@@ -1449,12 +1462,27 @@ val int_str(val str, val base)
   const wchar_t *wcs = c_str(str);
   wchar_t *ptr;
   cnum b = c_num(base);
+
   /* TODO: detect if we have wcstoll */
-  long val = wcstol(wcs, &ptr, b);
-  if (val == 0 && ptr == wcs)
+  long value = wcstol(wcs, &ptr, b ? b : 10);
+  if (value == 0 && ptr == wcs)
     return nil;
-  numeric_assert (val >= NUM_MIN && val <= NUM_MAX);
-  return num(val);
+  if (((value == LONG_MAX || value == LONG_MIN) && errno == ERANGE) ||
+      (value < NUM_MIN || value > NUM_MAX))
+  {
+    val bignum = make_bignum();
+    unsigned char *ucs = utf8_dup_to_uc(wcs);
+    mp_err err = mp_read_radix(mp(bignum), ucs, b);
+
+    free(ucs); /* TODO: make wchar_t version of mp_read_radix. */
+
+    if (err != MP_OKAY)
+      return nil;
+
+    return bignum;
+  }
+
+  return num(value);
 }
 
 val chrp(val chr)
@@ -3057,7 +3085,7 @@ static void obj_init(void)
   cons_s = intern(lit("cons"), user_package);
   str_s = intern(lit("str"), user_package);
   chr_s = intern(lit("chr"), user_package);
-  num_s = intern(lit("num"), user_package);
+  fixnum_s = intern(lit("fixnum"), user_package);
   sym_s = intern(lit("sym"), user_package);
   pkg_s = intern(lit("pkg"), user_package);
   fun_s = intern(lit("fun"), user_package);
@@ -3070,6 +3098,7 @@ static void obj_init(void)
   cobj_s = intern(lit("cobj"), user_package);
   cptr_s = intern(lit("cptr"), user_package);
   env_s = intern(lit("env"), user_package);
+  bignum_s = intern(lit("bignum"), user_package);
   var_s = intern(lit("var"), system_package);
   expr_s = intern(lit("expr"), system_package);
   regex_s = intern(lit("regex"), system_package);
@@ -3241,6 +3270,7 @@ val obj_print(val obj, val out)
     }
     return obj;
   case NUM:
+  case BGNUM:
     format(out, lit("~s"), obj, nao);
     return obj;
   case SYM:
@@ -3335,6 +3365,7 @@ val obj_pprint(val obj, val out)
     put_char(out, obj);
     return obj;
   case NUM:
+  case BGNUM:
     format(out, lit("~s"), obj, nao);
     return obj;
   case SYM:
@@ -3384,6 +3415,7 @@ void init(const wchar_t *pn, mem_t *(*oom)(mem_t *, size_t),
   oom_realloc = oom;
   gc_init(stack_bottom);
   obj_init();
+  arith_init();
   uw_init();
   stream_init();
   eval_init();