Commit 9abaf5f3 authored by Paul Eggert's avatar Paul Eggert

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.
parent bf1b147b
......@@ -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 \
......
......@@ -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
......
/* 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);
}
/* 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
......
......@@ -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))
......