Commit a0f2adbf authored by Tom Tromey's avatar Tom Tromey
Browse files

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) <Lisp_Misc_Bignum>: 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.
parent 7cb45cd2
......@@ -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. */
......
......@@ -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);
......
......@@ -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++;
......
......@@ -30,6 +30,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <float.h>
#include <inttypes.h>
#include <limits.h>
#ifdef HAVE_GMP
#include <gmp.h>
#else
#include "mini-gmp.h"
#endif
#include <intprops.h>
#include <verify.h>
......@@ -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
......
......@@ -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;
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment