diff options
author | Paul Eggert <eggert@cs.ucla.edu> | 2018-08-27 21:27:50 -0700 |
---|---|---|
committer | Paul Eggert <eggert@cs.ucla.edu> | 2018-08-27 21:45:22 -0700 |
commit | 9abaf5f3581ecb76f30e8a6e7ee0e9633c133d1c (patch) | |
tree | c39260a6e26845b0a1307be98b38581468925c58 /src | |
parent | bf1b147b55e1328efca6e40181e79dd9a369895d (diff) | |
download | emacs-9abaf5f3581ecb76f30e8a6e7ee0e9633c133d1c.tar.gz |
Modularize bignums better
* src/bignum.c, src/bignum.h: New files. Only modules that
need to know how bignums are implemented should include
bignum.h. Currently these are alloc.c, bignum.c (of course),
data.c, emacs.c, emacs-module.c, floatfns.c, fns.c, print.c.
* src/Makefile.in (base_obj): Add bignum.o.
* src/alloc.c (make_bignum_str): Move to bignum.c.
(make_number): Remove; replaced by bignum.c’s make_integer.
All callers changed.
* src/conf_post.h (ARG_NONNULL): New macro.
* src/json.c (json_to_lisp): Use it.
* src/data.c (Fnatnump):
Move NATNUMP’s implementation here from lisp.h.
* src/data.c (Fnumber_to_string):
* src/editfns.c (styled_format):
Move conversion of string to bignum to bignum_to_string, and
call it here.
* src/emacs-module.c (module_make_integer):
* src/floatfns.c (Fabs):
Simplify by using make_int.
* src/emacs.c: Include bignum.h, to expand its inline fns.
* src/floatfns.c (Ffloat): Simplify by using XFLOATINT.
(rounding_driver): Simplify by using double_to_bignum.
(rounddiv_q): Clarify use of temporaries.
* src/lisp.h: Move decls that need to know bignum internals to
bignum.h. Do not include gmp.h or mini-gmp.h; that is now
bignum.h’s job.
(GMP_NUM_BITS, struct Lisp_Bignum, XBIGNUM, mpz_set_intmax):
Move to bignum.h.
(make_int): New function.
(NATNUMP): Remove; all callers changed to use Fnatnump.
(XFLOATINT): If arg is a bignum, use bignum_to_double, so that
bignum internals are not exposed here.
* src/print.c (print_vectorlike): Use SAFE_ALLOCA to avoid the
need for a record_unwind_protect_ptr.
Diffstat (limited to 'src')
-rw-r--r-- | src/Makefile.in | 2 | ||||
-rw-r--r-- | src/alloc.c | 78 | ||||
-rw-r--r-- | src/bignum.c | 161 | ||||
-rw-r--r-- | src/bignum.h | 70 | ||||
-rw-r--r-- | src/conf_post.h | 1 | ||||
-rw-r--r-- | src/data.c | 38 | ||||
-rw-r--r-- | src/editfns.c | 4 | ||||
-rw-r--r-- | src/emacs-module.c | 16 | ||||
-rw-r--r-- | src/emacs.c | 1 | ||||
-rw-r--r-- | src/floatfns.c | 50 | ||||
-rw-r--r-- | src/fns.c | 1 | ||||
-rw-r--r-- | src/json.c | 2 | ||||
-rw-r--r-- | src/lisp.h | 72 | ||||
-rw-r--r-- | src/print.c | 9 |
14 files changed, 299 insertions, 206 deletions
diff --git a/src/Makefile.in b/src/Makefile.in index 52ce7605f7b..7d9c2361a9b 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -392,7 +392,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ charset.o coding.o category.o ccl.o character.o chartab.o bidi.o \ $(CM_OBJ) term.o terminal.o xfaces.o $(XOBJ) $(GTK_OBJ) $(DBUS_OBJ) \ emacs.o keyboard.o macros.o keymap.o sysdep.o \ - buffer.o filelock.o insdel.o marker.o \ + bignum.o buffer.o filelock.o insdel.o marker.o \ minibuf.o fileio.o dired.o \ cmds.o casetab.o casefiddle.o indent.o search.o regex-emacs.o undo.o \ alloc.o data.o doc.o editfns.o callint.o \ diff --git a/src/alloc.c b/src/alloc.c index c9788ab4c6b..350b668ec61 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -31,6 +31,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #endif #include "lisp.h" +#include "bignum.h" #include "dispextern.h" #include "intervals.h" #include "ptr-bounds.h" @@ -3728,83 +3729,6 @@ build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos) } - -Lisp_Object -make_bignum_str (const char *num, int base) -{ - struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, - PVEC_BIGNUM); - mpz_init (b->value); - int check = mpz_set_str (b->value, num, base); - eassert (check == 0); - return make_lisp_ptr (b, Lisp_Vectorlike); -} - -/* Given an mpz_t, make a number. This may return a bignum or a - fixnum depending on VALUE. */ - -Lisp_Object -make_number (mpz_t value) -{ - size_t bits = mpz_sizeinbase (value, 2); - - if (bits <= FIXNUM_BITS) - { - EMACS_INT v = 0; - int i = 0, shift = 0; - - do - { - EMACS_INT limb = mpz_getlimbn (value, i++); - v += limb << shift; - shift += GMP_NUMB_BITS; - } - while (shift < bits); - - if (mpz_sgn (value) < 0) - v = -v; - - if (!FIXNUM_OVERFLOW_P (v)) - return make_fixnum (v); - } - - /* The documentation says integer-width should be nonnegative, so - a single comparison suffices even though 'bits' is unsigned. */ - if (integer_width < bits) - range_error (); - - struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, - PVEC_BIGNUM); - /* We could mpz_init + mpz_swap here, to avoid a copy, but the - resulting API seemed possibly confusing. */ - mpz_init_set (b->value, value); - - return make_lisp_ptr (b, Lisp_Vectorlike); -} - -void -mpz_set_intmax_slow (mpz_t result, intmax_t v) -{ - /* If V fits in long, a faster path is taken. */ - eassert (! (LONG_MIN <= v && v <= LONG_MAX)); - - bool complement = v < 0; - if (complement) - v = -1 - v; - - enum { nails = sizeof v * CHAR_BIT - INTMAX_WIDTH }; -# ifndef HAVE_GMP - /* mini-gmp requires NAILS to be zero, which is true for all - likely Emacs platforms. Sanity-check this. */ - verify (nails == 0); -# endif - - mpz_import (result, 1, -1, sizeof v, 0, nails, &v); - if (complement) - mpz_com (result, result); -} - - /* Return a newly created vector or string with specified arguments as elements. If all the arguments are characters that can fit in a string of events, make a string; otherwise, make a vector. diff --git a/src/bignum.c b/src/bignum.c new file mode 100644 index 00000000000..18f94e7ed63 --- /dev/null +++ b/src/bignum.c @@ -0,0 +1,161 @@ +/* Big numbers for Emacs. + +Copyright 2018 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#include <config.h> + +#include "bignum.h" + +#include "lisp.h" + +/* Return the value of the Lisp bignum N, as a double. */ +double +bignum_to_double (Lisp_Object n) +{ + return mpz_get_d (XBIGNUM (n)->value); +} + +/* Return D, converted to a bignum. Discard any fraction. */ +Lisp_Object +double_to_bignum (double d) +{ + mpz_t z; + mpz_init_set_d (z, d); + Lisp_Object result = make_integer (z); + mpz_clear (z); + return result; +} + +/* Return a Lisp integer equal to OP, which has BITS bits and which + must not be in fixnum range. */ +static Lisp_Object +make_bignum_bits (mpz_t const op, size_t bits) +{ + /* The documentation says integer-width should be nonnegative, so + a single comparison suffices even though 'bits' is unsigned. */ + if (integer_width < bits) + range_error (); + + struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, + PVEC_BIGNUM); + /* We could mpz_init + mpz_swap here, to avoid a copy, but the + resulting API seemed possibly confusing. */ + mpz_init_set (b->value, op); + + return make_lisp_ptr (b, Lisp_Vectorlike); +} + +/* Return a Lisp integer equal to OP, which must not be in fixnum range. */ +static Lisp_Object +make_bignum (mpz_t const op) +{ + return make_bignum_bits (op, mpz_sizeinbase (op, 2)); +} + +/* Return a Lisp integer equal to N, which must not be in fixnum range. */ +Lisp_Object +make_bigint (intmax_t n) +{ + eassert (FIXNUM_OVERFLOW_P (n)); + mpz_t z; + mpz_init (z); + mpz_set_intmax (z, n); + Lisp_Object result = make_bignum (z); + mpz_clear (z); + return result; +} + +/* Return a Lisp integer with value taken from OP. */ +Lisp_Object +make_integer (mpz_t const op) +{ + size_t bits = mpz_sizeinbase (op, 2); + + if (bits <= FIXNUM_BITS) + { + EMACS_INT v = 0; + int i = 0, shift = 0; + + do + { + EMACS_INT limb = mpz_getlimbn (op, i++); + v += limb << shift; + shift += GMP_NUMB_BITS; + } + while (shift < bits); + + if (mpz_sgn (op) < 0) + v = -v; + + if (!FIXNUM_OVERFLOW_P (v)) + return make_fixnum (v); + } + + return make_bignum_bits (op, bits); +} + +void +mpz_set_intmax_slow (mpz_t result, intmax_t v) +{ + bool complement = v < 0; + if (complement) + v = -1 - v; + + enum { nails = sizeof v * CHAR_BIT - INTMAX_WIDTH }; +# ifndef HAVE_GMP + /* mini-gmp requires NAILS to be zero, which is true for all + likely Emacs platforms. Sanity-check this. */ + verify (nails == 0); +# endif + + mpz_import (result, 1, -1, sizeof v, 0, nails, &v); + if (complement) + mpz_com (result, result); +} + +/* Convert NUM to a base-BASE Lisp string. */ + +Lisp_Object +bignum_to_string (Lisp_Object num, int base) +{ + ptrdiff_t n = mpz_sizeinbase (XBIGNUM (num)->value, base) - 1; + USE_SAFE_ALLOCA; + char *str = SAFE_ALLOCA (n + 3); + mpz_get_str (str, base, XBIGNUM (num)->value); + while (str[n]) + n++; + Lisp_Object result = make_unibyte_string (str, n); + SAFE_FREE (); + return result; +} + +/* Create a bignum by scanning NUM, with digits in BASE. + NUM must consist of an optional '-', a nonempty sequence + of base-BASE digits, and a terminating null byte, and + the represented number must not be in fixnum range. */ + +Lisp_Object +make_bignum_str (char const *num, int base) +{ + struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, + PVEC_BIGNUM); + mpz_init (b->value); + int check = mpz_set_str (b->value, num, base); + eassert (check == 0); + return make_lisp_ptr (b, Lisp_Vectorlike); +} diff --git a/src/bignum.h b/src/bignum.h new file mode 100644 index 00000000000..a368333d77e --- /dev/null +++ b/src/bignum.h @@ -0,0 +1,70 @@ +/* Big numbers for Emacs. + +Copyright 2018 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +/* Include this header only if access to bignum internals is needed. */ + +#ifndef BIGNUM_H +#define BIGNUM_H + +#ifdef HAVE_GMP +# include <gmp.h> +#else +# include "mini-gmp.h" +#endif + +#include "lisp.h" + +/* Number of data bits in a limb. */ +#ifndef GMP_NUMB_BITS +enum { GMP_NUMB_BITS = TYPE_WIDTH (mp_limb_t) }; +#endif + +struct Lisp_Bignum +{ + union vectorlike_header header; + mpz_t value; +}; + +extern Lisp_Object make_integer (mpz_t const) ARG_NONNULL ((1)); +extern void mpz_set_intmax_slow (mpz_t, intmax_t) ARG_NONNULL ((1)); + +INLINE_HEADER_BEGIN + +INLINE struct Lisp_Bignum * +XBIGNUM (Lisp_Object a) +{ + eassert (BIGNUMP (a)); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Bignum); +} + +INLINE void ARG_NONNULL ((1)) +mpz_set_intmax (mpz_t result, intmax_t v) +{ + /* mpz_set_si works in terms of long, but Emacs may use a wider + integer type, and so sometimes will have to construct the mpz_t + by hand. */ + if (LONG_MIN <= v && v <= LONG_MAX) + mpz_set_si (result, v); + else + mpz_set_intmax_slow (result, v); +} + +INLINE_HEADER_END + +#endif /* BIGNUM_H */ diff --git a/src/conf_post.h b/src/conf_post.h index f9838bc662a..683a96f9368 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -277,6 +277,7 @@ extern int emacs_setenv_TZ (char const *); #define ATTRIBUTE_FORMAT_PRINTF(string_index, first_to_check) \ ATTRIBUTE_FORMAT ((PRINTF_ARCHETYPE, string_index, first_to_check)) +#define ARG_NONNULL _GL_ARG_NONNULL #define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST #define ATTRIBUTE_UNUSED _GL_UNUSED diff --git a/src/data.c b/src/data.c index 170a74a6589..ece76a5bc6f 100644 --- a/src/data.c +++ b/src/data.c @@ -29,6 +29,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <intprops.h> #include "lisp.h" +#include "bignum.h" #include "puresize.h" #include "character.h" #include "buffer.h" @@ -525,9 +526,9 @@ DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0, attributes: const) (Lisp_Object object) { - if (NATNUMP (object)) - return Qt; - return Qnil; + return ((FIXNUMP (object) ? 0 <= XFIXNUM (object) + : BIGNUMP (object) && 0 <= mpz_sgn (XBIGNUM (object)->value)) + ? Qt : Qnil); } DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0, @@ -2400,7 +2401,7 @@ emacs_mpz_size (mpz_t const op) the library code aborts when a number is too large. These wrappers avoid the problem for functions that can return numbers much larger than their arguments. For slowly-growing numbers, the integer - width check in make_number should suffice. */ + width checks in bignum.c should suffice. */ static void emacs_mpz_mul (mpz_t rop, mpz_t const op1, mpz_t const op2) @@ -2770,12 +2771,7 @@ NUMBER may be an integer or a floating point number. */) int len; if (BIGNUMP (number)) - { - ptrdiff_t count = SPECPDL_INDEX (); - char *str = mpz_get_str (NULL, 10, XBIGNUM (number)->value); - record_unwind_protect_ptr (xfree, str); - return unbind_to (count, make_unibyte_string (str, strlen (str))); - } + return bignum_to_string (number, 10); CHECK_FIXNUM_OR_FLOAT (number); @@ -3011,7 +3007,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) } } - return unbind_to (count, make_number (accum)); + return unbind_to (count, make_integer (accum)); } static Lisp_Object @@ -3141,7 +3137,7 @@ Both must be integers or markers. */) mpz_init (result); mpz_tdiv_r (result, *xmp, *ymp); - val = make_number (result); + val = make_integer (result); mpz_clear (result); if (xmp == &xm) @@ -3221,7 +3217,7 @@ Both X and Y must be numbers or markers. */) if (cmpy < 0 ? cmpr > 0 : cmpr < 0) mpz_add (result, result, *ymp); - val = make_number (result); + val = make_integer (result); mpz_clear (result); if (xmp == &xm) @@ -3351,7 +3347,7 @@ In this case, the sign bit is duplicated. */) emacs_mpz_mul_2exp (result, XBIGNUM (value)->value, XFIXNUM (count)); else mpz_fdiv_q_2exp (result, XBIGNUM (value)->value, - XFIXNUM (count)); - val = make_number (result); + val = make_integer (result); mpz_clear (result); } else if (XFIXNUM (count) <= 0) @@ -3378,7 +3374,7 @@ In this case, the sign bit is duplicated. */) else mpz_fdiv_q_2exp (result, result, - XFIXNUM (count)); - val = make_number (result); + val = make_integer (result); mpz_clear (result); } @@ -3407,7 +3403,7 @@ expt_integer (Lisp_Object x, Lisp_Object y) ? (mpz_set_intmax (val, XFIXNUM (x)), val) : XBIGNUM (x)->value), exp); - Lisp_Object res = make_number (val); + Lisp_Object res = make_integer (val); mpz_clear (val); return res; } @@ -3427,7 +3423,7 @@ Markers are converted to integers. */) mpz_t num; mpz_init (num); mpz_add_ui (num, XBIGNUM (number)->value, 1); - number = make_number (num); + number = make_integer (num); mpz_clear (num); } else @@ -3440,7 +3436,7 @@ Markers are converted to integers. */) mpz_t num; mpz_init (num); mpz_set_intmax (num, XFIXNUM (number) + 1); - number = make_number (num); + number = make_integer (num); mpz_clear (num); } } @@ -3462,7 +3458,7 @@ Markers are converted to integers. */) mpz_t num; mpz_init (num); mpz_sub_ui (num, XBIGNUM (number)->value, 1); - number = make_number (num); + number = make_integer (num); mpz_clear (num); } else @@ -3475,7 +3471,7 @@ Markers are converted to integers. */) mpz_t num; mpz_init (num); mpz_set_intmax (num, XFIXNUM (number) - 1); - number = make_number (num); + number = make_integer (num); mpz_clear (num); } } @@ -3492,7 +3488,7 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0, mpz_t value; mpz_init (value); mpz_com (value, XBIGNUM (number)->value); - number = make_number (value); + number = make_integer (value); mpz_clear (value); } else diff --git a/src/editfns.c b/src/editfns.c index d2281d7e81c..9ca6f373e04 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4491,9 +4491,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) else if (conversion == 'X') base = -16; - char *str = mpz_get_str (NULL, base, XBIGNUM (arg)->value); - arg = make_unibyte_string (str, strlen (str)); - xfree (str); + arg = bignum_to_string (arg, base); conversion = 's'; } diff --git a/src/emacs-module.c b/src/emacs-module.c index f2844c40d0f..a1bed491b62 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -27,6 +27,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <stdio.h> #include "lisp.h" +#include "bignum.h" #include "dynlib.h" #include "coding.h" #include "keyboard.h" @@ -521,6 +522,8 @@ module_extract_integer (emacs_env *env, emacs_value n) CHECK_INTEGER (l); if (BIGNUMP (l)) { + /* FIXME: This can incorrectly signal overflow on platforms + where long is narrower than intmax_t. */ if (!mpz_fits_slong_p (XBIGNUM (l)->value)) xsignal1 (Qoverflow_error, l); return mpz_get_si (XBIGNUM (l)->value); @@ -531,19 +534,8 @@ module_extract_integer (emacs_env *env, emacs_value n) static emacs_value module_make_integer (emacs_env *env, intmax_t n) { - Lisp_Object obj; MODULE_FUNCTION_BEGIN (module_nil); - if (FIXNUM_OVERFLOW_P (n)) - { - mpz_t val; - mpz_init (val); - mpz_set_intmax (val, n); - obj = make_number (val); - mpz_clear (val); - } - else - obj = make_fixnum (n); - return lisp_to_value (env, obj); + return lisp_to_value (env, make_int (n)); } static double diff --git a/src/emacs.c b/src/emacs.c index 7d07ec85029..07a1aff9b06 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -66,6 +66,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include TERM_HEADER #endif /* HAVE_WINDOW_SYSTEM */ +#include "bignum.h" #include "intervals.h" #include "character.h" #include "buffer.h" diff --git a/src/floatfns.c b/src/floatfns.c index e7884864eef..8008929be61 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -42,6 +42,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <config.h> #include "lisp.h" +#include "bignum.h" #include <math.h> @@ -209,7 +210,7 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, /* Common Lisp spec: don't promote if both are integers, and if the result is not fractional. */ - if (INTEGERP (arg1) && NATNUMP (arg2)) + if (INTEGERP (arg1) && Fnatnump (arg2)) return expt_integer (arg1, arg2); return make_float (pow (XFLOATINT (arg1), XFLOATINT (arg2))); @@ -258,19 +259,7 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0, if (FIXNUMP (arg)) { if (XFIXNUM (arg) < 0) - { - EMACS_INT absarg = -XFIXNUM (arg); - if (absarg <= MOST_POSITIVE_FIXNUM) - arg = make_fixnum (absarg); - else - { - mpz_t val; - mpz_init (val); - mpz_set_intmax (val, absarg); - arg = make_number (val); - mpz_clear (val); - } - } + arg = make_int (-XFIXNUM (arg)); } else if (FLOATP (arg)) { @@ -284,7 +273,7 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0, mpz_t val; mpz_init (val); mpz_neg (val, XBIGNUM (arg)->value); - arg = make_number (val); + arg = make_integer (val); mpz_clear (val); } } @@ -297,13 +286,8 @@ DEFUN ("float", Ffloat, Sfloat, 1, 1, 0, (register Lisp_Object arg) { CHECK_NUMBER (arg); - - if (BIGNUMP (arg)) - return make_float (mpz_get_d (XBIGNUM (arg)->value)); - if (FIXNUMP (arg)) - return make_float ((double) XFIXNUM (arg)); - else /* give 'em the same float back */ - return arg; + /* If ARG is a float, give 'em the same float back. */ + return FLOATP (arg) ? arg : make_float (XFLOATINT (arg)); } static int @@ -386,7 +370,7 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, (FIXNUMP (divisor) ? (mpz_set_intmax (d, XFIXNUM (divisor)), d) : XBIGNUM (divisor)->value)); - Lisp_Object result = make_number (q); + Lisp_Object result = make_integer (q); mpz_clear (d); mpz_clear (q); return result; @@ -410,12 +394,7 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, if (! FIXNUM_OVERFLOW_P (ir)) return make_fixnum (ir); } - mpz_t drz; - mpz_init (drz); - mpz_set_d (drz, dr); - Lisp_Object rounded = make_number (drz); - mpz_clear (drz); - return rounded; + return double_to_bignum (dr); } static void @@ -433,9 +412,9 @@ rounddiv_q (mpz_t q, mpz_t const n, mpz_t const d) r = n % d; neg_d = d < 0; neg_r = r < 0; - r = eabs (r); - abs_r1 = eabs (d) - r; - if (abs_r1 < r + (q & 1)) + abs_r = eabs (r); + abs_r1 = eabs (d) - abs_r; + if (abs_r1 < abs_r + (q & 1)) q += neg_d == neg_r ? 1 : -1; */ mpz_t r, abs_r1; @@ -444,10 +423,11 @@ rounddiv_q (mpz_t q, mpz_t const n, mpz_t const d) mpz_tdiv_qr (q, r, n, d); bool neg_d = mpz_sgn (d) < 0; bool neg_r = mpz_sgn (r) < 0; - mpz_abs (r, r); + mpz_t *abs_r = &r; + mpz_abs (*abs_r, r); mpz_abs (abs_r1, d); - mpz_sub (abs_r1, abs_r1, r); - if (mpz_cmp (abs_r1, r) < (mpz_odd_p (q) != 0)) + mpz_sub (abs_r1, abs_r1, *abs_r); + if (mpz_cmp (abs_r1, *abs_r) < (mpz_odd_p (q) != 0)) (neg_d == neg_r ? mpz_add_ui : mpz_sub_ui) (q, q, 1); mpz_clear (r); mpz_clear (abs_r1); diff --git a/src/fns.c b/src/fns.c index b368ffd58f2..3f7dfeddb6e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -28,6 +28,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <errno.h> #include "lisp.h" +#include "bignum.h" #include "character.h" #include "coding.h" #include "composite.h" diff --git a/src/json.c b/src/json.c index 4e46640a0c6..d525d1b7577 100644 --- a/src/json.c +++ b/src/json.c @@ -709,7 +709,7 @@ usage: (json-insert OBJECT &rest ARGS) */) /* Convert a JSON object to a Lisp object. */ -static _GL_ARG_NONNULL ((1)) Lisp_Object +static Lisp_Object ARG_NONNULL ((1)) json_to_lisp (json_t *json, struct json_configuration *conf) { switch (json_typeof (json)) diff --git a/src/lisp.h b/src/lisp.h index fb11a11fda3..555496bc271 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -31,12 +31,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <inttypes.h> #include <limits.h> -#ifdef HAVE_GMP -# include <gmp.h> -#else -# include "mini-gmp.h" -#endif - #include <intprops.h> #include <verify.h> @@ -589,6 +583,10 @@ enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false }; INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, Lisp_Object); +/* Defined in bignum.c. */ +extern double bignum_to_double (Lisp_Object); +extern Lisp_Object make_bigint (intmax_t); + /* Defined in chartab.c. */ extern Lisp_Object char_table_ref (Lisp_Object, int); extern void char_table_set (Lisp_Object, int, Lisp_Object); @@ -1013,14 +1011,6 @@ enum More_Lisp_Bits #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) - -/* GMP-related limits. */ - -/* Number of data bits in a limb. */ -#ifndef GMP_NUMB_BITS -enum { GMP_NUMB_BITS = TYPE_WIDTH (mp_limb_t) }; -#endif - #if USE_LSB_TAG INLINE Lisp_Object @@ -2460,31 +2450,25 @@ XUSER_PTR (Lisp_Object a) } #endif -struct Lisp_Bignum -{ - union vectorlike_header header; - mpz_t value; -}; - INLINE bool BIGNUMP (Lisp_Object x) { return PSEUDOVECTORP (x, PVEC_BIGNUM); } -INLINE struct Lisp_Bignum * -XBIGNUM (Lisp_Object a) -{ - eassert (BIGNUMP (a)); - return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Bignum); -} - INLINE bool INTEGERP (Lisp_Object x) { return FIXNUMP (x) || BIGNUMP (x); } +/* Return a Lisp integer with value taken from n. */ +INLINE Lisp_Object +make_int (intmax_t n) +{ + return FIXNUM_OVERFLOW_P (n) ? make_bigint (n) : make_fixnum (n); +} + /* Forwarding pointer to an int variable. This is allowed only in the value cell of a symbol, @@ -2698,13 +2682,6 @@ FIXNATP (Lisp_Object x) return FIXNUMP (x) && 0 <= XFIXNUM (x); } INLINE bool -NATNUMP (Lisp_Object x) -{ - if (BIGNUMP (x)) - return mpz_sgn (XBIGNUM (x)->value) >= 0; - return FIXNUMP (x) && 0 <= XFIXNUM (x); -} -INLINE bool NUMBERP (Lisp_Object x) { return INTEGERP (x) || FLOATP (x); @@ -2848,9 +2825,9 @@ CHECK_FIXNAT (Lisp_Object x) INLINE double XFLOATINT (Lisp_Object n) { - if (BIGNUMP (n)) - return mpz_get_d (XBIGNUM (n)->value); - return FLOATP (n) ? XFLOAT_DATA (n) : XFIXNUM (n); + return (FIXNUMP (n) ? XFIXNUM (n) + : FLOATP (n) ? XFLOAT_DATA (n) + : bignum_to_double (n)); } INLINE void @@ -3310,6 +3287,11 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val) XSUB_CHAR_TABLE (table)->contents[idx] = val; } +/* Defined in bignum.c. */ +extern Lisp_Object bignum_to_string (Lisp_Object, int); +extern Lisp_Object make_bignum_str (char const *, int); +extern Lisp_Object double_to_bignum (double); + /* Defined in data.c. */ extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object); extern void notify_variable_watchers (Lisp_Object, Lisp_Object, @@ -3582,22 +3564,6 @@ extern Lisp_Object list5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, enum constype {CONSTYPE_HEAP, CONSTYPE_PURE}; extern Lisp_Object listn (enum constype, ptrdiff_t, Lisp_Object, ...); -extern Lisp_Object make_bignum_str (const char *num, int base); -extern Lisp_Object make_number (mpz_t value); -extern void mpz_set_intmax_slow (mpz_t result, intmax_t v); - -INLINE void -mpz_set_intmax (mpz_t result, intmax_t v) -{ - /* mpz_set_si works in terms of long, but Emacs may use a wider - integer type, and so sometimes will have to construct the mpz_t - by hand. */ - if (LONG_MIN <= v && v <= LONG_MAX) - mpz_set_si (result, v); - else - mpz_set_intmax_slow (result, v); -} - /* Build a frequently used 2/3/4-integer lists. */ INLINE Lisp_Object diff --git a/src/print.c b/src/print.c index 824f8d75779..49d9e38e7d3 100644 --- a/src/print.c +++ b/src/print.c @@ -23,6 +23,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "sysstdio.h" #include "lisp.h" +#include "bignum.h" #include "character.h" #include "coding.h" #include "buffer.h" @@ -1369,10 +1370,12 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, { case PVEC_BIGNUM: { - struct Lisp_Bignum *b = XBIGNUM (obj); - char *str = mpz_get_str (NULL, 10, b->value); - record_unwind_protect_ptr (xfree, str); + USE_SAFE_ALLOCA; + char *str = SAFE_ALLOCA (mpz_sizeinbase (XBIGNUM (obj)->value, 10) + + 2); + mpz_get_str (str, 10, XBIGNUM (obj)->value); print_c_string (str, printcharfun); + SAFE_FREE (); } break; |