1 files changed, 109 insertions, 6 deletions

diff --git a/arith.txr b/arith.txr
index 9c746802..fc1bc8f6 100644
--- a/arith.txr
+++ b/arith.txr
@@ -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);