[Guile-commits] 50/85: Reimplement scm_{to,from}_{int32,uint32}

[Andy Wingo]

wingo pushed a commit to branch main
in repository guile.

commit 717e787da6ae75bbaa53139c0ef3791cd758a9d8
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Thu Jan 6 21:04:23 2022 +0100

    Reimplement scm_{to,from}_{int32,uint32}
    
    * libguile/numbers.c (scm_to_int32, scm_from_int32, scm_to_uint32):
    (scm_from_uint32): Reimplement inline.
    * libguile/integers.c (make_bignum_2):
    (make_bignum_from_uint64):
    (negative_uint32_to_int32):
    (positive_uint32_to_int32):
    (bignum_to_int32):
    (bignum_to_uint32):
    (scm_integer_from_int32):
    (scm_integer_from_uint32):
    (scm_integer_to_int32_z):
    (scm_integer_to_uint32_z): Better int32 support for 32-bit machines.
---
 libguile/integers.c | 107 +++++++++++++++++++++++++++++++++++++++++++++++-----
 libguile/integers.h |   8 +++-
 libguile/numbers.c  |  81 ++++++++++++++++++++++++++++++++-------
 3 files changed, 171 insertions(+), 25 deletions(-)

diff --git a/libguile/integers.c b/libguile/integers.c
index 9ec42694f..f00885792 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -182,21 +182,25 @@ make_bignum_1 (int is_negative, mp_limb_t limb)
   return is_negative ? negate_bignum(z) : z;
 }
 
+#if SCM_SIZEOF_LONG == 4
+static struct scm_bignum *
+make_bignum_2 (int is_negative, mp_limb_t lo, mp_limb_t hi)
+{
+  struct scm_bignum *z = allocate_bignum (2);
+  z->limbs[0] = lo;
+  z->limbs[1] = hi;
+  return is_negative ? negate_bignum(z) : z;
+}
+#endif
+
 static struct scm_bignum *
 make_bignum_from_uint64 (uint64_t val)
 {
 #if SCM_SIZEOF_LONG == 4
-  mp_limb_t lo = val, hi = val >> 32;
-  struct scm_bignum *z = allocate_bignum (hi ? 2 : 1);
-  z->limbs[0] = lo;
-  if (hi)
-    z->limbs[1] = hi;
-  return z;
-#else
-  struct scm_bignum *z = allocate_bignum (1);
-  z->limbs[0] = val;
-  return z;
+  if (val > UINT32_MAX)
+    return make_bignum_2 (0, val, val >> 32);
 #endif
+  return make_bignum_1 (0, val);
 }
 
 static struct scm_bignum *
@@ -384,6 +388,59 @@ bignum_to_uint64 (struct scm_bignum *z, uint64_t *val)
     }
 }
 
+#if SCM_SIZEOF_LONG == 4
+static int
+negative_uint32_to_int32 (uint32_t magnitude, int32_t *val)
+{
+  if (magnitude > long_magnitude (INT32_MIN))
+    return 0;
+  *val = negative_long (magnitude);
+  return 1;
+}
+
+static int
+positive_uint32_to_int32 (uint32_t magnitude, int32_t *val)
+{
+  if (magnitude > INT32_MAX)
+    return 0;
+  *val = magnitude;
+  return 1;
+}
+
+static int
+bignum_to_int32 (struct scm_bignum *z, int32_t *val)
+{
+  switch (bignum_size (z))
+    {
+    case -1:
+      return negative_uint32_to_int32 (bignum_limbs (z)[0], val);
+    case 0:
+      *val = 0;
+      return 1;
+    case 1:
+      return positive_uint32_to_int32 (bignum_limbs (z)[0], val);
+    default:
+      return 0;
+    }
+}
+
+static int
+bignum_to_uint32 (struct scm_bignum *z, uint32_t *val)
+{
+  switch (bignum_size (z))
+    {
+    case 0:
+      *val = 0;
+      return 1;
+    case 1:
+      *val = bignum_limbs (z)[0];
+      return 1;
+    default:
+      return 0;
+    }
+}
+#endif
+
 static int
 bignum_cmp_long (struct scm_bignum *z, long l)
 {
@@ -2921,6 +2978,36 @@ scm_integer_exact_quotient_zz (struct scm_bignum *n, 
struct scm_bignum *d)
   return take_mpz (q);
 }
 
+#if SCM_SIZEOF_LONG == 4
+SCM
+scm_integer_from_int32 (int32_t n)
+{
+  if (SCM_FIXABLE (n))
+    return SCM_I_MAKINUM (n);
+  return scm_from_bignum (long_to_bignum (n));
+}
+
+SCM
+scm_integer_from_uint32 (uint32_t n)
+{
+  if (SCM_POSFIXABLE (n))
+    return SCM_I_MAKINUM (n);
+  return scm_from_bignum (ulong_to_bignum (n));
+}
+
+int
+scm_integer_to_int32_z (struct scm_bignum *z, int32_t *val)
+{
+  return bignum_to_int32 (z, val);
+}
+
+int
+scm_integer_to_uint32_z (struct scm_bignum *z, uint32_t *val)
+{
+  return bignum_to_uint32 (z, val);
+}
+#endif
+
 SCM
 scm_integer_from_int64 (int64_t n)
 {
diff --git a/libguile/integers.h b/libguile/integers.h
index 8bf91f567..f8d150119 100644
--- a/libguile/integers.h
+++ b/libguile/integers.h
@@ -199,9 +199,15 @@ SCM_INTERNAL SCM scm_integer_exact_quotient_zi (struct 
scm_bignum *n,
 SCM_INTERNAL SCM scm_integer_exact_quotient_zz (struct scm_bignum *n,
                                                 struct scm_bignum *d);
 
+#if SCM_SIZEOF_LONG == 4
+SCM_INTERNAL SCM scm_integer_from_int32 (int32_t n);
+SCM_INTERNAL SCM scm_integer_from_uint32 (uint32_t n);
+SCM_INTERNAL int scm_integer_to_int32_z (struct scm_bignum *z, int32_t *val);
+SCM_INTERNAL int scm_integer_to_uint32_z (struct scm_bignum *z, uint32_t *val);
+#endif
+
 SCM_INTERNAL int scm_integer_to_int64_z (struct scm_bignum *z, int64_t *val);
 SCM_INTERNAL int scm_integer_to_uint64_z (struct scm_bignum *z, uint64_t *val);
-
 SCM_INTERNAL SCM scm_integer_from_int64 (int64_t n);
 SCM_INTERNAL SCM scm_integer_from_uint64 (uint64_t n);
 
diff --git a/libguile/numbers.c b/libguile/numbers.c
index b1ef37752..22321ebb2 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -6958,21 +6958,74 @@ scm_from_uint16 (uint16_t arg)
   return SCM_I_MAKINUM (arg);
 }
 
-#define TYPE                     int32_t
-#define TYPE_MIN                 INT32_MIN
-#define TYPE_MAX                 INT32_MAX
-#define SIZEOF_TYPE              4
-#define SCM_TO_TYPE_PROTO(arg)   scm_to_int32 (arg)
-#define SCM_FROM_TYPE_PROTO(arg) scm_from_int32 (arg)
-#include "conv-integer.i.c"
+int32_t
+scm_to_int32 (SCM arg)
+{
+#if SCM_SIZEOF_LONG == 4
+  if (SCM_I_INUMP (arg))
+    return SCM_I_INUM (arg);
+  else if (!SCM_BIGP (arg))
+    scm_wrong_type_arg_msg (NULL, 0, arg, "exact integer");
+  int32_t ret;
+  if (scm_integer_to_int32_z (scm_bignum (arg), &ret))
+    return ret;
+  range_error (arg, scm_integer_from_int32 (INT32_MIN),
+               scm_integer_from_int32 (INT32_MAX));
+#elif SCM_SIZEOF_LONG == 8
+  return inum_in_range (arg, INT32_MIN, INT32_MAX);
+#else
+#error bad inum size
+#endif
+}
 
-#define TYPE                     uint32_t
-#define TYPE_MIN                 0
-#define TYPE_MAX                 UINT32_MAX
-#define SIZEOF_TYPE              4
-#define SCM_TO_TYPE_PROTO(arg)   scm_to_uint32 (arg)
-#define SCM_FROM_TYPE_PROTO(arg) scm_from_uint32 (arg)
-#include "conv-uinteger.i.c"
+SCM
+scm_from_int32 (int32_t arg)
+{
+#if SCM_SIZEOF_LONG == 4
+  return scm_integer_from_int32 (arg);
+#elif SCM_SIZEOF_LONG == 8
+  return SCM_I_MAKINUM (arg);
+#else
+#error bad inum size
+#endif
+}
+
+uint32_t
+scm_to_uint32 (SCM arg)
+{
+#if SCM_SIZEOF_LONG == 4
+  if (SCM_I_INUMP (arg))
+    {
+      if (SCM_I_INUM (arg) > 0)
+        return SCM_I_INUM (arg);
+    }
+  else if (SCM_BIGP (arg))
+    {
+      uint32_t ret;
+      if (scm_integer_to_uint32_z (scm_bignum (arg), &ret))
+        return ret;
+    }
+  else
+    scm_wrong_type_arg_msg (NULL, 0, arg, "exact integer");
+  range_error (arg, 0, scm_integer_from_uint32 (UINT32_MAX));
+#elif SCM_SIZEOF_LONG == 8
+  return inum_in_range (arg, 0, UINT32_MAX);
+#else
+#error bad inum size
+#endif
+}
+
+SCM
+scm_from_uint32 (uint32_t arg)
+{
+#if SCM_SIZEOF_LONG == 4
+  return scm_integer_from_uint32 (arg);
+#elif SCM_SIZEOF_LONG == 8
+  return SCM_I_MAKINUM (arg);
+#else
+#error bad inum size
+#endif
+}
 
 #define TYPE                     scm_t_wchar
 #define TYPE_MIN                 (int32_t)-1