[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH 2/2] Add module functions to convert from and to big integers.
From: |
Philipp Stephani |
Subject: |
[PATCH 2/2] Add module functions to convert from and to big integers. |
Date: |
Tue, 23 Apr 2019 15:17:42 +0200 |
* 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)
Re: [PATCH 1/2] Add conversions to and from struct timespec to module interface., Paul Eggert, 2019/04/23