[Emacs-diffs] feature/bignum a0f2adb 03/24: Introduce the bignum type

[Tom Tromey]

branch: feature/bignum
commit a0f2adbfc9cb1b69415f551a5e529f7e1162b9c7
Author: Tom Tromey <address@hidden>
Commit: Tom Tromey <address@hidden>

    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.
---
 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 91c5152..8ebf3e0 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 aad5708..efcffbb 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 ();
        }
@@ -515,6 +517,16 @@ DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0,
        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;
   return Qnil;
@@ -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 2c1311b..aef4f93 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 9cf10c1..37e43b0 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -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
diff --git a/src/print.c b/src/print.c
index 1327ef3..2b1d1fe 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;
        }