[PATCH 2/2] Add module functions to convert from and to big integers.

[Philipp Stephani]

* src/module-env-27.h: Add new module functions to convert big
integers.

* src/emacs-module.c (module_required_bytes)
(module_extract_big_integer, module_make_big_integer): New functions.
(initialize_environment): Use them.
(syms_of_module): Define needed symbols.

* test/data/emacs-module/mod-test.c (signal_memory_full): New helper
function.
(Fmod_test_double): New test function.
(emacs_module_init): Define it.

* test/src/emacs-module-tests.el (mod-test-double): New unit test.

* doc/lispref/internals.texi (Module Values): Document new functions.
---
 doc/lispref/internals.texi        |  26 +++++++
 etc/NEWS                          |   4 ++
 src/emacs-module.c                | 108 ++++++++++++++++++++++++++++++
 src/module-env-27.h               |   9 +++
 test/data/emacs-module/mod-test.c |  48 +++++++++++++
 test/src/emacs-module-tests.el    |   7 ++
 6 files changed, 202 insertions(+)

diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index c2969d2cd1..17f56907c5 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -1382,6 +1382,23 @@ Module Values
 @code{overflow-error}.
 @end deftypefn
 
address@hidden Function bool extract_big_integer (emacs_env address@hidden, 
emacs_value @var{arg}, int address@hidden, ptrdiff_t address@hidden, unsigned 
char address@hidden)
+This function, which is available since Emacs 27, extracts the
+integral value of @var{arg}.  If @var{sign} is not @code{NULL}, it
+stores the sign of @var{arg} (-1, 0, or +1) into @code{*sign}.  The
+magnitude is stored into @var{magnitude} as follows.  If @var{size}
+and @var{magnitude} are bot address@hidden, then @var{magnitude} must
+point to an array of at least @code{*size} bytes.  If @var{magnitude}
+is large enough to hold the magnitude of @var{arg}, then this function
+writes the magnitude into the @var{magnitude} array in little-endian
+form, stores the number of bytes written into @code{*size}, and
+returns @code{true}.  If @var{magnitude} is not large enough, it
+stores the required size into @code{*size}, signals an error, and
+returns @code{false}.  If @var{size} is not @code{NULL} and
address@hidden is @code{NULL}, then the function stores the required
+size into @code{*size} and returns @code{true}.
address@hidden deftypefn
+
 @deftypefn Function double extract_float (emacs_env address@hidden, 
emacs_value @var{arg})
 This function returns the value of a Lisp float specified by
 @var{arg}, as a C @code{double} value.
@@ -1456,6 +1473,15 @@ Module Values
 @code{most-positive-fixnum} (@pxref{Integer Basics}).
 @end deftypefn
 
address@hidden Function emacs_value make_big_integer (emacs_env address@hidden, 
int sign, ptrdiff_t size, unsigned char *magnitude)
+This function, which is available since Emacs 27, takes an
+arbitrary-sized integer argument and returns a corresponding
address@hidden object.  The @var{sign} argument gives the sign of
+the return value.  If @var{sign} is nonzero, then @var{magnitude} must
+point to an array of at least @var{size} bytes specifying the
+little-endian magnitude of the return value.
address@hidden deftypefn
+
 @deftypefn Function emacs_value make_float (emacs_env address@hidden, double 
@var{d})
 This function takes a @code{double} argument @var{d} and returns the
 corresponding Emacs floating-point value.
diff --git a/etc/NEWS b/etc/NEWS
index 2534262b62..a0b764217f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1913,6 +1913,10 @@ case.
 ** New module environment functions 'make_time' and 'extract_time' to
 convert between timespec structures and Emacs time values.
 
+** New module environment functions 'make_big_integer' and
+'extract_big_integer' to create and extract arbitrary-size integer
+values.
+
 
 * Changes in Emacs 27.1 on Non-Free Operating Systems
 
diff --git a/src/emacs-module.c b/src/emacs-module.c
index fc5a912d85..bdc5370978 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -77,6 +77,7 @@ To add a new module function, proceed as follows:
 #include <time.h>
 
 #include "lisp.h"
+#include "bignum.h"
 #include "dynlib.h"
 #include "coding.h"
 #include "keyboard.h"
@@ -748,6 +749,108 @@ module_make_time (emacs_env *env, struct timespec time)
   return lisp_to_value (env, make_lisp_time (time));
 }
 
+/* Return the number of bytes needed to represent U.  */
+
+static ptrdiff_t
+module_required_bytes (EMACS_UINT u)
+{
+  if (u == 0)
+    return 0;
+  for (ptrdiff_t i = 0; i < sizeof u; ++i)
+    if (u <= 0xFFu << (8 * i))
+      return i + 1;
+  return sizeof u;
+}
+
+enum
+{
+  /* Constants for mpz_import and mpz_export.  */
+  module_bigint_order = -1,
+  module_bigint_size = 1,
+  module_bigint_endian = -1,
+  module_bigint_nails = 0,
+};
+
+static bool
+module_extract_big_integer (emacs_env *env, emacs_value value,
+                            int *sign, ptrdiff_t *size,
+                            unsigned char *magnitude)
+{
+  MODULE_FUNCTION_BEGIN (false);
+  Lisp_Object o = value_to_lisp (value);
+  CHECK_INTEGER (o);
+  if (size == NULL && magnitude != NULL)
+    wrong_type_argument (Qnull, Qmagnitude);
+  if (FIXNUMP (o))
+    {
+      EMACS_INT x = XFIXNUM (o);
+      if (sign != NULL)
+        *sign = (0 < x) - (x < 0);
+      if (size != NULL)
+        {
+          eassert (-EMACS_INT_MAX <= x);  /* Verify -x is defined. */
+          EMACS_UINT u = x < 0 ? -x : x;
+          verify (UCHAR_MAX == 0xFF);
+          verify (CHAR_BIT == 8);
+          ptrdiff_t required = module_required_bytes (u);
+          if (magnitude != NULL)
+            {
+              if (*size < required)
+                args_out_of_range_3 (make_int (*size), make_int (required),
+                                     make_int (PTRDIFF_MAX));
+              for (ptrdiff_t i = 0; i < required; ++i)
+                magnitude[i] = (u >> (8 * i)) & 0xFFu;
+            }
+          *size = required;
+        }
+    }
+  else
+    {
+      struct Lisp_Bignum *x = XBIGNUM (o);
+      if (sign != NULL)
+        *sign = mpz_sgn (x->value);
+      if (size != NULL)
+        {
+          /* See the remark at the end of the Info node
+             `(gmp) Integer Import and Export'.  */
+          ptrdiff_t required = (mpz_sizeinbase (x->value, 2) + 7) / 8;
+          if (magnitude != NULL)
+            {
+              if (*size < required)
+                args_out_of_range_3 (make_int (*size), make_int (required),
+                                     make_int (PTRDIFF_MAX));
+              verify (sizeof *magnitude == module_bigint_size);
+              size_t written;
+              mpz_export (magnitude, &written, module_bigint_order,
+                          module_bigint_size, module_bigint_endian,
+                          module_bigint_nails, x->value);
+              eassert (written == required);
+            }
+          *size = required;
+        }
+    }
+  return true;
+}
+
+static emacs_value
+module_make_big_integer (emacs_env *env, int sign, ptrdiff_t size,
+                         const unsigned char *magnitude)
+{
+  MODULE_FUNCTION_BEGIN (NULL);
+  if (sign != 0 && size == 0)
+    wrong_type_argument (Qnatnump, Qsize);
+  if (size != 0 && magnitude == NULL)
+    wrong_type_argument (Qarrayp, Qmagnitude);
+  if (sign == 0)
+    return lisp_to_value (env, make_fixed_natnum (0));
+  verify (sizeof *magnitude == module_bigint_size);
+  mpz_import (mpz[0], size, module_bigint_order, module_bigint_size,
+              module_bigint_endian, module_bigint_nails, magnitude);
+  if (sign < 0)
+    mpz_neg (mpz[0], mpz[0]);
+  return lisp_to_value (env, make_integer_mpz ());
+}
+
 
 /* Subroutines.  */
 
@@ -1153,6 +1256,8 @@ initialize_environment (emacs_env *env, struct 
emacs_env_private *priv)
   env->process_input = module_process_input;
   env->extract_time = module_extract_time;
   env->make_time = module_make_time;
+  env->extract_big_integer = module_extract_big_integer;
+  env->make_big_integer = module_make_big_integer;
   Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments);
   return env;
 }
@@ -1316,6 +1421,9 @@ syms_of_module (void)
 
   DEFSYM (Qmodule_function_p, "module-function-p");
   DEFSYM (Qtimep, "timep");
+  DEFSYM (Qnull, "null");
+
+  DEFSYM (Qmagnitude, "magnitude");
 
   defsubr (&Smodule_load);
 }
diff --git a/src/module-env-27.h b/src/module-env-27.h
index e63843f8d6..b4ecea2902 100644
--- a/src/module-env-27.h
+++ b/src/module-env-27.h
@@ -8,3 +8,12 @@
 
   emacs_value (*make_time) (emacs_env *env, struct timespec time)
     EMACS_ATTRIBUTE_NONNULL (1);
+
+  bool (*extract_big_integer) (emacs_env *env, emacs_value value,
+                               int *sign, ptrdiff_t *size,
+                               unsigned char *magnitude)
+    EMACS_ATTRIBUTE_NONNULL (1);
+
+  emacs_value (*make_big_integer) (emacs_env *env, int sign, ptrdiff_t size,
+                                   const unsigned char *magnitude)
+    EMACS_ATTRIBUTE_NONNULL (1);
diff --git a/test/data/emacs-module/mod-test.c 
b/test/data/emacs-module/mod-test.c
index 44a28fa18f..b0c25717e8 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -329,6 +329,17 @@ signal_errno (emacs_env *env, const char *function)
   env->non_local_exit_signal (env, symbol, data);
 }
 
+static void
+signal_memory_full (emacs_env *env)
+{
+  emacs_value symbol = env->intern (env, "error");
+  const char *message = "Out of memory";
+  emacs_value message_value = env->make_string (env, message, strlen 
(message));
+  emacs_value data
+    = env->funcall (env, env->intern (env, "list"), 1, &message_value);
+  env->non_local_exit_signal (env, symbol, data);
+}
+
 /* A long-running operation that occasionally calls `should_quit' or
    `process_input'.  */
 
@@ -378,6 +389,42 @@ Fmod_test_add_nanosecond (emacs_env *env, ptrdiff_t nargs, 
emacs_value *args,
   return env->make_time (env, time);
 }
 
+static emacs_value
+Fmod_test_double (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
+                  void *data)
+{
+  assert (nargs == 1);
+  emacs_value arg = args[0];
+  ptrdiff_t size;
+  if (!env->extract_big_integer (env, arg, NULL, &size, NULL))
+    return NULL;
+  unsigned char *magnitude = malloc (size + 1);
+  if (magnitude == NULL)
+    {
+      signal_memory_full (env);
+      return NULL;
+    }
+  int sign;
+  emacs_value result = NULL;
+  if (!env->extract_big_integer (env, arg, &sign, &size, magnitude))
+    goto out;
+  unsigned int carry = 0;
+  for (ptrdiff_t i = 0; i < size; ++i)
+    {
+      static_assert (UCHAR_MAX == 0xFF, "UCHAR_MAX != 0xFF");
+      static_assert (CHAR_BIT == 8, "CHAR_BIT != 8");
+      static_assert (UINT_MAX >= 2u * UCHAR_MAX, "unsigned int is too small");
+      unsigned int value = 2u * magnitude[i] + carry;
+      magnitude[i] = value & 0xFF;
+      carry = value >> 8;
+      assert (carry <= 1);
+    }
+  magnitude[size] = carry;
+  result = env->make_big_integer (env, sign, size + 1, magnitude);
+ out: free (magnitude);
+  return result;
+}
+
 /* Lisp utilities for easier readability (simple wrappers).  */
 
 /* Provide FEATURE to Emacs.  */
@@ -447,6 +494,7 @@ emacs_module_init (struct emacs_runtime *ert)
          NULL, NULL);
   DEFUN ("mod-test-sleep-until", Fmod_test_sleep_until, 2, 2, NULL, NULL);
   DEFUN ("mod-test-add-nanosecond", Fmod_test_add_nanosecond, 1, 1, NULL, 
NULL);
+  DEFUN ("mod-test-double", Fmod_test_double, 1, 1, NULL, NULL);
 
 #undef DEFUN
 
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 6b986a96e2..c160ae50b0 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -335,4 +335,11 @@ module--test-assertion
     (ert-info ((format "input: %s" input))
       (should-error (mod-test-add-nanosecond input)))))
 
+(ert-deftest mod-test-double ()
+  (dolist (input (list 0 1 2 -1 42 12345678901234567890
+                       most-positive-fixnum (1+ most-positive-fixnum)
+                       most-negative-fixnum (1- most-negative-fixnum)))
+    (ert-info ((format "input: %d" input))
+      (should (= (mod-test-double input) (* 2 input))))))
+
 ;;; emacs-module-tests.el ends here
-- 
2.20.1 (Apple Git-117)