Bignum division implemented. More portability bugs found in MPI:

code like 1 << n, where n exceeds the width of the type int.

* arith.c (trunc): New function, reimplementation of removed
trunc from lib.c.

* lib.c (trunc): Removed.

* mpi-patches/fix-bad-shifts: New file.

4 files changed, 122 insertions, 14 deletions

diff --git a/ChangeLog b/ChangeLog
index 980a5fc2..6902db1a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,17 @@
 2011-12-11  Kaz Kylheku  <kaz@kylheku.com>
 
+	Bignum division implemented. More portability bugs found in MPI:
+	code like 1 << n, where n exceeds the width of the type int.
+
+	* arith.c (trunc): New function, reimplementation of removed
+	trunc from lib.c.
+
+	* lib.c (trunc): Removed.
+
+	* mpi-patches/fix-bad-shifts: New file.
+
+2011-12-11  Kaz Kylheku  <kaz@kylheku.com>
+
 	* arith.c (ABS): New macro.
 	(plus, minus): Bugfix: must not pass signed values to mp_add_d and
 	mp_sub_d functions.
diff --git a/arith.c b/arith.c
index f87c5693..89907332 100644
--- a/arith.c
+++ b/arith.c
@@ -497,6 +497,67 @@ val mul(val anum, val bnum)
   abort();
 }
 
+val trunc(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);
+      cnum ap = ABS(a);
+      cnum bp = ABS(b);
+      int neg = ((a < 0 && b > 0) || (a > 0 && b < 0));
+
+      if (b == 0)
+        uw_throw(numeric_error_s, lit("division by zero"));
+
+      {
+        cnum quot = ap / bp;
+        return num(neg ? -quot : quot);
+      }
+    }
+  case TAG_PAIR(TAG_NUM, TAG_PTR):
+    type_check(bnum, BGNUM);
+    return zero;
+  case TAG_PAIR(TAG_PTR, TAG_NUM):
+    {
+      val n;
+      type_check(anum, BGNUM);
+      n = make_bignum();
+      if (sizeof (int_ptr_t) <= sizeof (mp_digit)) {
+        cnum b = c_num(bnum);
+        cnum bp = ABS(b);
+        if (mp_div_d(mp(anum), bp, mp(n), 0) != MP_OKAY)
+          uw_throw(numeric_error_s, lit("division by zero"));
+        if (b < 0)
+          mp_neg(mp(n), mp(n));
+      } else {
+        mp_int tmp;
+        mp_init(&tmp);
+        mp_set_intptr(&tmp, c_num(bnum));
+        if (mp_div(mp(anum), &tmp, mp(n), 0) != MP_OKAY)
+          uw_throw(numeric_error_s, lit("division by zero"));
+      }
+      return normalize(n);
+    }
+  case TAG_PAIR(TAG_PTR, TAG_PTR):
+    {
+      val n;
+      type_check(anum, BGNUM);
+      type_check(bnum, BGNUM);
+      n = make_bignum();
+      if (mp_div(mp(anum), mp(bnum), mp(n), 0) != MP_OKAY)
+          uw_throw(numeric_error_s, lit("division by zero"));
+      return normalize(n);
+    }
+  }
+  uw_throwf(error_s, lit("trunc: invalid operands ~s ~s"), anum, bnum, nao);
+  abort();
+}
+
 void arith_init(void)
 {
   mp_init(&NUM_MAX_MP);
diff --git a/lib.c b/lib.c
index 1c510fd2..cd9d8edd 100644
--- a/lib.c
+++ b/lib.c
@@ -857,20 +857,6 @@ val mulv(val nlist)
   return reduce_left(func_n2(mul), cdr(nlist), car(nlist), nil);
 }
 
-val trunc(val anum, val bnum)
-{
-  cnum a = c_num(anum);
-  cnum b = c_num(bnum);
-
-  numeric_assert (b != 0);
-
-  {
-    cnum result = a / b;
-    numeric_assert (result <= NUM_MAX);
-    return num(result);
-  } 
-}
-
 val mod(val anum, val bnum)
 {
   cnum a = c_num(anum);
diff --git a/mpi-patches/fix-bad-shifts b/mpi-patches/fix-bad-shifts
new file mode 100644
index 00000000..f6e7c979
--- /dev/null
+++ b/mpi-patches/fix-bad-shifts
@@ -0,0 +1,49 @@
+Index: mpi-1.8.6/mpi.c
+===================================================================
+--- mpi-1.8.6.orig/mpi.c	2011-12-11 19:52:15.000000000 -0800
++++ mpi-1.8.6/mpi.c	2011-12-11 19:53:09.000000000 -0800
+@@ -764,7 +764,7 @@
+   if((pow = s_mp_ispow2d(d)) >= 0) {
+     mp_digit  mask;
+ 
+-    mask = (1 << pow) - 1;
++    mask = ((mp_digit) 1 << pow) - 1;
+     rem = DIGIT(a, 0) & mask;
+ 
+     if(q) {
+@@ -3068,7 +3068,7 @@
+     return;
+ 
+   /* Flush all the bits above 2^d in its digit */
+-  dmask = (1 << nbit) - 1;
++  dmask = ((mp_digit) 1 << nbit) - 1;
+   dp[ndig] &= dmask;
+ 
+   /* Flush all digits above the one with 2^d in it */
+@@ -3101,7 +3101,7 @@
+   dp = DIGITS(mp); used = USED(mp);
+   d %= DIGIT_BIT;
+ 
+-  mask = (1 << d) - 1;
++  mask = ((mp_digit) 1 << d) - 1;
+ 
+   /* If the shift requires another digit, make sure we've got one to
+      work with */
+@@ -3149,7 +3149,7 @@
+   s_mp_rshd(mp, d / DIGIT_BIT);
+   d %= DIGIT_BIT;
+ 
+-  mask = (1 << d) - 1;
++  mask = ((mp_digit) 1 << d) - 1;
+ 
+   save = 0;
+   for(ix = USED(mp) - 1; ix >= 0; ix--) {
+@@ -3829,7 +3829,7 @@
+   if((res = s_mp_pad(a, dig + 1)) != MP_OKAY)
+     return res;
+   
+-  DIGIT(a, dig) |= (1 << bit);
++  DIGIT(a, dig) |= ((mp_digit) 1 << bit);
+ 
+   return MP_OKAY;
+