From a0f2adbfc9cb1b69415f551a5e529f7e1162b9c7 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Sat, 7 Jul 2018 14:52:09 -0600 Subject: [PATCH] Introduce the bignum type * src/alloc.c (mark_object): Handle Lisp_Misc_Bignum. (sweep_misc): Call mpz_clear for Lisp_Misc_Bignum. * src/data.c (Ftype_of): Handle Lisp_Misc_Bignum. (Fintegerp, Finteger_or_marker_p, Fnatnump, Fnumberp) (Fnumber_or_marker_p): Update for bignum. (Ffixnump, Fbignump): New defuns. (syms_of_data): Update. * src/emacs.c (xrealloc_for_gmp, xfree_for_gmp): New functions. (main): Call mp_set_memory_functions. * src/lisp.h (enum Lisp_Misc_Type) : New constant. (struct Lisp_Bignum): New. (union Lisp_Misc): Add u_bignum. (BIGNUMP, XBIGNUM, INTEGERP, NATNUMP, NUMBERP, CHECK_NUMBER) (CHECK_INTEGER, CHECK_NUMBER_COERCE_MARKER): New functions. * src/print.c (print_object): Handle Lisp_Misc_Bignum. --- src/alloc.c | 3 +++ src/data.c | 31 +++++++++++++++++++++---- src/emacs.c | 16 +++++++++++++ src/lisp.h | 66 +++++++++++++++++++++++++++++++++++++++++++++++++++++ src/print.c | 9 ++++++++ 5 files changed, 121 insertions(+), 4 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 91c5152ca84..8ebf3e05d69 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6554,6 +6554,7 @@ mark_object (Lisp_Object arg) break; case Lisp_Misc_Ptr: + case Lisp_Misc_Bignum: XMISCANY (obj)->gcmarkbit = true; break; @@ -6973,6 +6974,8 @@ sweep_misc (void) uptr->finalizer (uptr->p); } #endif + else if (mblk->markers[i].m.u_any.type == Lisp_Misc_Bignum) + mpz_clear (mblk->markers[i].m.u_bignum.value); /* Set the type of the freed object to Lisp_Misc_Free. We could leave the type alone, since nobody checks it, but this might catch bugs faster. */ diff --git a/src/data.c b/src/data.c index aad57084647..efcffbbf6ab 100644 --- a/src/data.c +++ b/src/data.c @@ -234,6 +234,8 @@ for example, (type-of 1) returns `integer'. */) case Lisp_Misc_User_Ptr: return Quser_ptr; #endif + case Lisp_Misc_Bignum: + return Qinteger; default: emacs_abort (); } @@ -514,6 +516,16 @@ DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0, doc: /* Return t if OBJECT is an integer. */ attributes: const) (Lisp_Object object) +{ + if (INTEGERP (object)) + return Qt; + return Qnil; +} + +DEFUN ("fixnump", Ffixnump, Sfixnump, 1, 1, 0, + doc: /* Return t if OBJECT is an fixnum. */ + attributes: const) + (Lisp_Object object) { if (FIXNUMP (object)) return Qt; @@ -524,7 +536,7 @@ DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, doc: /* Return t if OBJECT is an integer or a marker (editor pointer). */) (register Lisp_Object object) { - if (MARKERP (object) || FIXNUMP (object)) + if (MARKERP (object) || INTEGERP (object)) return Qt; return Qnil; } @@ -534,7 +546,7 @@ DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0, attributes: const) (Lisp_Object object) { - if (FIXNATP (object)) + if (NATNUMP (object)) return Qt; return Qnil; } @@ -544,7 +556,7 @@ DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0, attributes: const) (Lisp_Object object) { - if (FIXED_OR_FLOATP (object)) + if (NUMBERP (object)) return Qt; else return Qnil; @@ -555,7 +567,7 @@ DEFUN ("number-or-marker-p", Fnumber_or_marker_p, doc: /* Return t if OBJECT is a number or a marker. */) (Lisp_Object object) { - if (FIXED_OR_FLOATP (object) || MARKERP (object)) + if (NUMBERP (object) || MARKERP (object)) return Qt; return Qnil; } @@ -597,6 +609,15 @@ DEFUN ("condition-variable-p", Fcondition_variable_p, Scondition_variable_p, return Qt; return Qnil; } + +DEFUN ("bignump", Fbignump, Sbignump, 1, 1, 0, + doc: /* Return t if OBJECT is a bignum. */) + (Lisp_Object object) +{ + if (BIGNUMP (object)) + return Qt; + return Qnil; +} /* Extract and set components of lists. */ @@ -3745,6 +3766,7 @@ syms_of_data (void) defsubr (&Sconsp); defsubr (&Satom); defsubr (&Sintegerp); + defsubr (&Sfixnump); defsubr (&Sinteger_or_marker_p); defsubr (&Snumberp); defsubr (&Snumber_or_marker_p); @@ -3770,6 +3792,7 @@ syms_of_data (void) defsubr (&Sthreadp); defsubr (&Smutexp); defsubr (&Scondition_variable_p); + defsubr (&Sbignump); defsubr (&Scar); defsubr (&Scdr); defsubr (&Scar_safe); diff --git a/src/emacs.c b/src/emacs.c index 2c1311b846d..aef4f93d02b 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -673,6 +673,20 @@ close_output_streams (void) _exit (EXIT_FAILURE); } +/* Wrapper function for GMP. */ +static void * +xrealloc_for_gmp (void *ptr, size_t ignore, size_t size) +{ + return xrealloc (ptr, size); +} + +/* Wrapper function for GMP. */ +static void +xfree_for_gmp (void *ptr, size_t ignore) +{ + xfree (ptr); +} + /* ARGSUSED */ int main (int argc, char **argv) @@ -771,6 +785,8 @@ main (int argc, char **argv) init_standard_fds (); atexit (close_output_streams); + mp_set_memory_functions (xmalloc, xrealloc_for_gmp, xfree_for_gmp); + sort_args (argc, argv); argc = 0; while (argv[argc]) argc++; diff --git a/src/lisp.h b/src/lisp.h index 9cf10c19629..37e43b0c5a1 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -30,6 +30,11 @@ along with GNU Emacs. If not, see . */ #include #include #include +#ifdef HAVE_GMP +#include +#else +#include "mini-gmp.h" +#endif #include #include @@ -516,6 +521,7 @@ enum Lisp_Misc_Type #ifdef HAVE_MODULES Lisp_Misc_User_Ptr, #endif + Lisp_Misc_Bignum, /* This is not a type code. It is for range checking. */ Lisp_Misc_Limit }; @@ -2456,6 +2462,14 @@ struct Lisp_Free union Lisp_Misc *chain; }; +struct Lisp_Bignum + { + ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Bignum */ + bool_bf gcmarkbit : 1; + unsigned spacer : 15; + mpz_t value; + }; + /* To get the type field of a union Lisp_Misc, use XMISCTYPE. It uses one of these struct subtypes to get the type field. */ @@ -2470,6 +2484,7 @@ union Lisp_Misc #ifdef HAVE_MODULES struct Lisp_User_Ptr u_user_ptr; #endif + struct Lisp_Bignum u_bignum; }; INLINE union Lisp_Misc * @@ -2519,6 +2534,25 @@ XUSER_PTR (Lisp_Object a) } #endif +INLINE bool +BIGNUMP (Lisp_Object x) +{ + return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Bignum; +} + +INLINE struct Lisp_Bignum * +XBIGNUM (Lisp_Object a) +{ + eassert (BIGNUMP (a)); + return XUNTAG (a, Lisp_Misc, struct Lisp_Bignum); +} + +INLINE bool +INTEGERP (Lisp_Object x) +{ + return FIXNUMP (x) || BIGNUMP (x); +} + /* Forwarding pointer to an int variable. This is allowed only in the value cell of a symbol, @@ -2734,6 +2768,18 @@ FIXNATP (Lisp_Object x) { return FIXNUMP (x) && 0 <= XINT (x); } +INLINE bool +NATNUMP (Lisp_Object x) +{ + if (BIGNUMP (x)) + return mpz_cmp_si (XBIGNUM (x)->value, 0) >= 0; + return FIXNUMP (x) && 0 <= XINT (x); +} +INLINE bool +NUMBERP (Lisp_Object x) +{ + return INTEGERP (x) || FLOATP (x) || BIGNUMP (x); +} INLINE bool RANGED_FIXNUMP (intmax_t lo, Lisp_Object x, intmax_t hi) @@ -2882,6 +2928,18 @@ CHECK_FIXNUM_OR_FLOAT (Lisp_Object x) CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumberp, x); } +INLINE void +CHECK_NUMBER (Lisp_Object x) +{ + CHECK_TYPE (NUMBERP (x), Qnumberp, x); +} + +INLINE void +CHECK_INTEGER (Lisp_Object x) +{ + CHECK_TYPE (INTEGERP (x), Qnumberp, x); +} + #define CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER(x) \ do { \ if (MARKERP (x)) \ @@ -2890,6 +2948,14 @@ CHECK_FIXNUM_OR_FLOAT (Lisp_Object x) CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumber_or_marker_p, x); \ } while (false) +#define CHECK_NUMBER_COERCE_MARKER(x) \ + do { \ + if (MARKERP (x)) \ + XSETFASTINT (x, marker_position (x)); \ + else \ + CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x); \ + } while (false) + /* Since we can't assign directly to the CAR or CDR fields of a cons cell, use these when checking that those fields contain numbers. */ INLINE void diff --git a/src/print.c b/src/print.c index 1327ef303b7..2b1d1fec726 100644 --- a/src/print.c +++ b/src/print.c @@ -2185,6 +2185,15 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) } break; + case Lisp_Misc_Bignum: + { + struct Lisp_Bignum *b = XBIGNUM (obj); + char *str = mpz_get_str (NULL, 10, b->value); + record_unwind_protect_ptr (xfree, str); + print_c_string (str, printcharfun); + } + break; + default: goto badtype; } -- 2.39.2