mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-04-30 02:02:38 -07:00
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.
This commit is contained in:
parent
bf1b147b55
commit
9abaf5f358
14 changed files with 299 additions and 206 deletions
|
|
@ -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 \
|
||||
|
|
|
|||
78
src/alloc.c
78
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"
|
||||
|
|
@ -3727,83 +3728,6 @@ build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos)
|
|||
return make_lisp_ptr (m, Lisp_Vectorlike);
|
||||
}
|
||||
|
||||
|
||||
|
||||
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
|
||||
|
|
|
|||
161
src/bignum.c
Normal file
161
src/bignum.c
Normal file
|
|
@ -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);
|
||||
}
|
||||
70
src/bignum.h
Normal file
70
src/bignum.h
Normal file
|
|
@ -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 */
|
||||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
38
src/data.c
38
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
|
||||
|
|
|
|||
|
|
@ -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';
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
72
src/lisp.h
72
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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue