Extend infrastructure for double_intptr_t.

We support an unsigned version of the type, and add functions
for converting between Lisp values and both types.

* arith.c (bignum_dbl_uipt): New function, unsigned companion
to existing bignum_dbl_ipt.
(c_dbl_num, c_dbl_unum): New functions.

* arith.h (bignum_dbl_uipt, c_dbl_num, c_dbl_unum): Declared.

* configure (superulong_t, SIZEOF_DOUBLE_INTPTR,
DOUBLE_INTPTR_MAX, DOUBLE_INTPTR_MIN, DOUBLE_UINTPTR_MAX,
double_uintptr_t): New definitions going into config.h.

* lib.h (dbl_cnum, dbl_ucnum): New typedefs: double-sized
analogs of cnum and ucnum.

* mpi/mpi.c (mp_set_double_uintptr, mp_get_double_uintptr,
mp_get_double_intptr): New functions.
(s_mp_in_big_range): New static function.
(mp_in_double_intptr_range, mp_in_double_uintptr_range): New
functions.

* mpi/mpi.h (mp_set_double_uintptr,
mp_get_double_intptr, mp_get_double_uintptr,
mp_in_double_intptr_range, mp_in_double_uintptr_range):
Declared.

6 files changed, 151 insertions, 1 deletions

diff --git a/arith.c b/arith.c
index f349b57a..7289836e 100644
--- a/arith.c
+++ b/arith.c
@@ -158,6 +158,13 @@ val bignum_dbl_ipt(double_intptr_t di)
   return n;
 }
 
+val bignum_dbl_uipt(double_uintptr_t dui)
+{
+  val n = make_bignum();
+  mp_set_double_uintptr(mp(n), dui);
+  return n;
+}
+
 #endif
 
 val normalize(val bignum)
@@ -207,6 +214,46 @@ val unum(ucnum u)
   }
 }
 
+#if HAVE_DOUBLE_INTPTR_T
+
+dbl_cnum c_dbl_num(val n)
+{
+  switch (type(n)) {
+  case CHR: case NUM:
+    return coerce(cnum, n) >> TAG_SHIFT;
+  case BGNUM:
+    if (mp_in_double_intptr_range(mp(n))) {
+      double_intptr_t out;
+      mp_get_double_intptr(mp(n), &out);
+      return out;
+    }
+    uw_throwf(error_s, lit("~s is out of signed ~a bit range"),
+              n, num_fast(SIZEOF_DOUBLE_INTPTR * CHAR_BIT), nao);
+  default:
+    type_mismatch(lit("~s is not an integer"), n, nao);
+  }
+}
+
+dbl_ucnum c_dbl_unum(val n)
+{
+  switch (type(n)) {
+  case CHR: case NUM:
+    return coerce(cnum, n) >> TAG_SHIFT;
+  case BGNUM:
+    if (mp_in_double_uintptr_range(mp(n))) {
+      double_uintptr_t out;
+      mp_get_double_uintptr(mp(n), &out);
+      return out;
+    }
+    uw_throwf(error_s, lit("~s is out of unsigned ~a bit range"),
+              n, num_fast(SIZEOF_DOUBLE_INTPTR * CHAR_BIT), nao);
+  default:
+    type_mismatch(lit("~s is not an integer"), n, nao);
+  }
+}
+
+#endif
+
 val bignum_len(val num)
 {
   switch (type(num)) {
diff --git a/arith.h b/arith.h
index 919de83c..e57c368e 100644
--- a/arith.h
+++ b/arith.h
@@ -35,10 +35,15 @@ int highest_bit(int_ptr_t n);
 val normalize(val bignum);
 #if HAVE_DOUBLE_INTPTR_T
 val bignum_dbl_ipt(double_intptr_t di);
+val bignum_dbl_uipt(double_uintptr_t dui);
 #endif
 val in_int_ptr_range(val bignum);
 ucnum c_unum(val num);
 val unum(ucnum u);
+#if HAVE_DOUBLE_INTPTR_T
+double_intptr_t c_dbl_num(val num);
+double_uintptr_t c_dbl_unum(val num);
+#endif
 val bignum_len(val num);
 val cum_norm_dist(val x);
 val inv_cum_norm(val p);
diff --git a/configure b/configure
index b9bbd9a4..02c3f55c 100755
--- a/configure
+++ b/configure
@@ -1102,6 +1102,7 @@ if [ -n "$superlong" ] ; then
   printf '"%s"\n' "$superlong"
   printf "#define HAVE_SUPERLONG_T 1\n" >> config.h
   printf "typedef $superlong superlong_t;\n" >> config.h
+  printf "typedef $(echo $superlong | sed -e s/int/uint/) superulong_t;\n" >> config.h
 else
   printf "none\n"
 fi
@@ -1245,15 +1246,22 @@ intptr_max_expr="((((convert(int_ptr_t, 1) << $((SIZEOF_PTR * SIZEOF_BYTE - 2)))
 printf "#define INT_PTR_MAX %s\n" "$intptr_max_expr" >> config.h
 printf "#define INT_PTR_MIN (-INT_PTR_MAX)\n" >> config.h
 printf "#define UINT_PTR_MAX (convert(uint_ptr_t, -1))\n" >> config.h
+double_intptr_max_expr="((((convert(double_intptr_t, 1) << $((2 * SIZEOF_PTR * SIZEOF_BYTE - 2))) - 1) << 1) + 1)"
+printf "#define SIZEOF_DOUBLE_INTPTR (2*SIZEOF_PTR)\n" >> config.h
+printf "#define DOUBLE_INTPTR_MAX %s\n" "$double_intptr_max_expr" >> config.h
+printf "#define DOUBLE_INTPTR_MIN (-DOUBLE_INTPTR_MAX)\n" >> config.h
+printf "#define DOUBLE_UINTPTR_MAX (convert(double_uintptr_t, -1))\n" >> config.h
 
 if [ -n "$longlong" ] && [ $SIZEOF_LONGLONG_T -eq $(( 2 * SIZEOF_PTR )) ]
 then
   printf "#define HAVE_DOUBLE_INTPTR_T 1\n" >> config.h
   printf "typedef longlong_t double_intptr_t;\n" >> config.h
+  printf "typedef ulonglong_t double_uintptr_t;\n" >> config.h
 elif [ -n "$superlong" ] && [ $SIZEOF_SUPERLONG_T -eq $(( 2 * SIZEOF_PTR )) ]
 then
   printf "#define HAVE_DOUBLE_INTPTR_T 1\n" >> config.h
   printf "typedef superlong_t double_intptr_t;\n" >> config.h
+  printf "typedef superulong_t double_uintptr_t;\n" >> config.h
 fi
 
 #if HAVE_LONGLONG_T && 
diff --git a/lib.h b/lib.h
index 04ba947b..64a08e3d 100644
--- a/lib.h
+++ b/lib.h
@@ -30,6 +30,11 @@
 typedef int_ptr_t cnum;
 typedef uint_ptr_t ucnum;
 
+#ifdef HAVE_DOUBLE_INTPTR_T
+typedef double_intptr_t dbl_cnum;
+typedef double_uintptr_t dbl_ucnum;
+#endif
+
 #ifdef __cplusplus
 #define strip_qual(TYPE, EXPR) (const_cast<TYPE>(EXPR))
 #define convert(TYPE, EXPR) (static_cast<TYPE>(EXPR))
diff --git a/mpi/mpi.c b/mpi/mpi.c
index 2097b574..6aa905bb 100644
--- a/mpi/mpi.c
+++ b/mpi/mpi.c
@@ -471,7 +471,7 @@ mp_err mp_get_intptr(mp_int *mp, int_ptr_t *z)
 
 int mp_in_range(mp_int *mp, uint_ptr_t lim, int unsig)
 {
-  const int ptrnd = (SIZEOF_PTR + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT;
+  const unsigned ptrnd = (SIZEOF_PTR + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT;
   mp_size nd = USED(mp);
 
   if (unsig && ISNEG(mp))
@@ -501,6 +501,7 @@ int mp_in_uintptr_range(mp_int *mp)
 }
 
 #ifdef HAVE_DOUBLE_INTPTR_T
+
 mp_err mp_set_double_intptr(mp_int *mp, double_intptr_t z)
 {
   mp_size ix, shift;
@@ -530,6 +531,85 @@ mp_err mp_set_double_intptr(mp_int *mp, double_intptr_t z)
 
   return MP_OKAY;
 }
+
+mp_err mp_set_double_uintptr(mp_int *mp, double_uintptr_t v)
+{
+  mp_size ix, shift;
+  const mp_size nd = (sizeof v + sizeof (mp_digit) - 1) / sizeof (mp_digit);
+
+  ARGCHK(mp != NULL, MP_BADARG);
+
+  mp_zero(mp);
+
+  if (v == 0)
+    return MP_OKAY; /* shortcut for zero */
+
+  s_mp_grow(mp, nd);
+
+  USED(mp) = nd;
+
+  for (ix = 0, shift = 0; ix < nd; ix++, shift += MP_DIGIT_BIT)
+  {
+    DIGIT(mp, ix) = (v >> shift) & MP_DIGIT_MAX;
+  }
+
+  s_mp_clamp(mp);
+
+  return MP_OKAY;
+}
+
+mp_err mp_get_double_uintptr(mp_int *mp, double_uintptr_t *z)
+{
+  double_uintptr_t out = 0;
+  mp_size ix;
+  mp_size nd = USED(mp);
+  for (ix = 0; ix < nd; ix++, out <<= MP_DIGIT_BIT)
+    out |= DIGIT(mp, ix);
+
+  *z = (SIGN(mp) == MP_NEG) ? -out : out;
+  return MP_OKAY;
+}
+
+mp_err mp_get_double_intptr(mp_int *mp, double_intptr_t *z)
+{
+  double_uintptr_t tmp = 0;
+  mp_get_double_uintptr(mp, &tmp);
+  /* Reliance on bitwise unsigned to two's complement conversion */
+  *z = convert(int_ptr_t, tmp);
+  return MP_OKAY;
+}
+
+static int s_mp_in_big_range(mp_int *mp, double_uintptr_t lim, int unsig)
+{
+  const unsigned ptrnd = (SIZEOF_DOUBLE_INTPTR + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT;
+  mp_size nd = USED(mp);
+
+  if (unsig && ISNEG(mp))
+    return 0;
+
+  if (nd < ptrnd)
+    return 1;
+
+  if (nd > ptrnd)
+    return 0;
+
+  {
+    mp_digit top = DIGITS(mp)[ptrnd - 1];
+    lim >>= ((ptrnd - 1) * MP_DIGIT_BIT);
+    return top <= lim;
+  }
+}
+
+int mp_in_double_intptr_range(mp_int *mp)
+{
+  return s_mp_in_big_range(mp, DOUBLE_INTPTR_MAX, 0);
+}
+
+int mp_in_double_uintptr_range(mp_int *mp)
+{
+  return s_mp_in_big_range(mp, DOUBLE_UINTPTR_MAX, 1);
+}
+
 #endif
 
 mp_err mp_set_word(mp_int *mp, mp_word w, int sign)
diff --git a/mpi/mpi.h b/mpi/mpi.h
index 71e08055..cce283b0 100644
--- a/mpi/mpi.h
+++ b/mpi/mpi.h
@@ -90,6 +90,11 @@ int mp_in_intptr_range(mp_int *mp);
 int mp_in_uintptr_range(mp_int *mp);
 #ifdef HAVE_DOUBLE_INTPTR_T
 mp_err mp_set_double_intptr(mp_int *mp, double_intptr_t z);
+mp_err mp_set_double_uintptr(mp_int *mp, double_uintptr_t z);
+mp_err mp_get_double_intptr(mp_int *mp, double_intptr_t *z);
+mp_err mp_get_double_uintptr(mp_int *mp, double_uintptr_t *z);
+int mp_in_double_intptr_range(mp_int *mp);
+int mp_in_double_uintptr_range(mp_int *mp);
 #endif
 mp_err mp_set_word(mp_int *mp, mp_word w, int sign);