aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorTom Tromey2018-07-07 14:52:09 -0600
committerTom Tromey2018-07-12 22:12:27 -0600
commita0f2adbfc9cb1b69415f551a5e529f7e1162b9c7 (patch)
treeb6bf597a851b4ce521097802071361b7c78c4931 /src
parent7cb45cd25e510cf3c20adeb9ac11c0c3ea1dd340 (diff)
downloademacs-a0f2adbfc9cb1b69415f551a5e529f7e1162b9c7.tar.gz
emacs-a0f2adbfc9cb1b69415f551a5e529f7e1162b9c7.zip
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.
Diffstat (limited to 'src')
-rw-r--r--src/alloc.c3
-rw-r--r--src/data.c31
-rw-r--r--src/emacs.c16
-rw-r--r--src/lisp.h66
-rw-r--r--src/print.c9
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)
6554 break; 6554 break;
6555 6555
6556 case Lisp_Misc_Ptr: 6556 case Lisp_Misc_Ptr:
6557 case Lisp_Misc_Bignum:
6557 XMISCANY (obj)->gcmarkbit = true; 6558 XMISCANY (obj)->gcmarkbit = true;
6558 break; 6559 break;
6559 6560
@@ -6973,6 +6974,8 @@ sweep_misc (void)
6973 uptr->finalizer (uptr->p); 6974 uptr->finalizer (uptr->p);
6974 } 6975 }
6975#endif 6976#endif
6977 else if (mblk->markers[i].m.u_any.type == Lisp_Misc_Bignum)
6978 mpz_clear (mblk->markers[i].m.u_bignum.value);
6976 /* Set the type of the freed object to Lisp_Misc_Free. 6979 /* Set the type of the freed object to Lisp_Misc_Free.
6977 We could leave the type alone, since nobody checks it, 6980 We could leave the type alone, since nobody checks it,
6978 but this might catch bugs faster. */ 6981 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'. */)
234 case Lisp_Misc_User_Ptr: 234 case Lisp_Misc_User_Ptr:
235 return Quser_ptr; 235 return Quser_ptr;
236#endif 236#endif
237 case Lisp_Misc_Bignum:
238 return Qinteger;
237 default: 239 default:
238 emacs_abort (); 240 emacs_abort ();
239 } 241 }
@@ -515,6 +517,16 @@ DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0,
515 attributes: const) 517 attributes: const)
516 (Lisp_Object object) 518 (Lisp_Object object)
517{ 519{
520 if (INTEGERP (object))
521 return Qt;
522 return Qnil;
523}
524
525DEFUN ("fixnump", Ffixnump, Sfixnump, 1, 1, 0,
526 doc: /* Return t if OBJECT is an fixnum. */
527 attributes: const)
528 (Lisp_Object object)
529{
518 if (FIXNUMP (object)) 530 if (FIXNUMP (object))
519 return Qt; 531 return Qt;
520 return Qnil; 532 return Qnil;
@@ -524,7 +536,7 @@ DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1,
524 doc: /* Return t if OBJECT is an integer or a marker (editor pointer). */) 536 doc: /* Return t if OBJECT is an integer or a marker (editor pointer). */)
525 (register Lisp_Object object) 537 (register Lisp_Object object)
526{ 538{
527 if (MARKERP (object) || FIXNUMP (object)) 539 if (MARKERP (object) || INTEGERP (object))
528 return Qt; 540 return Qt;
529 return Qnil; 541 return Qnil;
530} 542}
@@ -534,7 +546,7 @@ DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
534 attributes: const) 546 attributes: const)
535 (Lisp_Object object) 547 (Lisp_Object object)
536{ 548{
537 if (FIXNATP (object)) 549 if (NATNUMP (object))
538 return Qt; 550 return Qt;
539 return Qnil; 551 return Qnil;
540} 552}
@@ -544,7 +556,7 @@ DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0,
544 attributes: const) 556 attributes: const)
545 (Lisp_Object object) 557 (Lisp_Object object)
546{ 558{
547 if (FIXED_OR_FLOATP (object)) 559 if (NUMBERP (object))
548 return Qt; 560 return Qt;
549 else 561 else
550 return Qnil; 562 return Qnil;
@@ -555,7 +567,7 @@ DEFUN ("number-or-marker-p", Fnumber_or_marker_p,
555 doc: /* Return t if OBJECT is a number or a marker. */) 567 doc: /* Return t if OBJECT is a number or a marker. */)
556 (Lisp_Object object) 568 (Lisp_Object object)
557{ 569{
558 if (FIXED_OR_FLOATP (object) || MARKERP (object)) 570 if (NUMBERP (object) || MARKERP (object))
559 return Qt; 571 return Qt;
560 return Qnil; 572 return Qnil;
561} 573}
@@ -597,6 +609,15 @@ DEFUN ("condition-variable-p", Fcondition_variable_p, Scondition_variable_p,
597 return Qt; 609 return Qt;
598 return Qnil; 610 return Qnil;
599} 611}
612
613DEFUN ("bignump", Fbignump, Sbignump, 1, 1, 0,
614 doc: /* Return t if OBJECT is a bignum. */)
615 (Lisp_Object object)
616{
617 if (BIGNUMP (object))
618 return Qt;
619 return Qnil;
620}
600 621
601/* Extract and set components of lists. */ 622/* Extract and set components of lists. */
602 623
@@ -3745,6 +3766,7 @@ syms_of_data (void)
3745 defsubr (&Sconsp); 3766 defsubr (&Sconsp);
3746 defsubr (&Satom); 3767 defsubr (&Satom);
3747 defsubr (&Sintegerp); 3768 defsubr (&Sintegerp);
3769 defsubr (&Sfixnump);
3748 defsubr (&Sinteger_or_marker_p); 3770 defsubr (&Sinteger_or_marker_p);
3749 defsubr (&Snumberp); 3771 defsubr (&Snumberp);
3750 defsubr (&Snumber_or_marker_p); 3772 defsubr (&Snumber_or_marker_p);
@@ -3770,6 +3792,7 @@ syms_of_data (void)
3770 defsubr (&Sthreadp); 3792 defsubr (&Sthreadp);
3771 defsubr (&Smutexp); 3793 defsubr (&Smutexp);
3772 defsubr (&Scondition_variable_p); 3794 defsubr (&Scondition_variable_p);
3795 defsubr (&Sbignump);
3773 defsubr (&Scar); 3796 defsubr (&Scar);
3774 defsubr (&Scdr); 3797 defsubr (&Scdr);
3775 defsubr (&Scar_safe); 3798 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)
673 _exit (EXIT_FAILURE); 673 _exit (EXIT_FAILURE);
674} 674}
675 675
676/* Wrapper function for GMP. */
677static void *
678xrealloc_for_gmp (void *ptr, size_t ignore, size_t size)
679{
680 return xrealloc (ptr, size);
681}
682
683/* Wrapper function for GMP. */
684static void
685xfree_for_gmp (void *ptr, size_t ignore)
686{
687 xfree (ptr);
688}
689
676/* ARGSUSED */ 690/* ARGSUSED */
677int 691int
678main (int argc, char **argv) 692main (int argc, char **argv)
@@ -771,6 +785,8 @@ main (int argc, char **argv)
771 init_standard_fds (); 785 init_standard_fds ();
772 atexit (close_output_streams); 786 atexit (close_output_streams);
773 787
788 mp_set_memory_functions (xmalloc, xrealloc_for_gmp, xfree_for_gmp);
789
774 sort_args (argc, argv); 790 sort_args (argc, argv);
775 argc = 0; 791 argc = 0;
776 while (argv[argc]) argc++; 792 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 <https://www.gnu.org/licenses/>. */
30#include <float.h> 30#include <float.h>
31#include <inttypes.h> 31#include <inttypes.h>
32#include <limits.h> 32#include <limits.h>
33#ifdef HAVE_GMP
34#include <gmp.h>
35#else
36#include "mini-gmp.h"
37#endif
33 38
34#include <intprops.h> 39#include <intprops.h>
35#include <verify.h> 40#include <verify.h>
@@ -516,6 +521,7 @@ enum Lisp_Misc_Type
516#ifdef HAVE_MODULES 521#ifdef HAVE_MODULES
517 Lisp_Misc_User_Ptr, 522 Lisp_Misc_User_Ptr,
518#endif 523#endif
524 Lisp_Misc_Bignum,
519 /* This is not a type code. It is for range checking. */ 525 /* This is not a type code. It is for range checking. */
520 Lisp_Misc_Limit 526 Lisp_Misc_Limit
521 }; 527 };
@@ -2456,6 +2462,14 @@ struct Lisp_Free
2456 union Lisp_Misc *chain; 2462 union Lisp_Misc *chain;
2457 }; 2463 };
2458 2464
2465struct Lisp_Bignum
2466 {
2467 ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Bignum */
2468 bool_bf gcmarkbit : 1;
2469 unsigned spacer : 15;
2470 mpz_t value;
2471 };
2472
2459/* To get the type field of a union Lisp_Misc, use XMISCTYPE. 2473/* To get the type field of a union Lisp_Misc, use XMISCTYPE.
2460 It uses one of these struct subtypes to get the type field. */ 2474 It uses one of these struct subtypes to get the type field. */
2461 2475
@@ -2470,6 +2484,7 @@ union Lisp_Misc
2470#ifdef HAVE_MODULES 2484#ifdef HAVE_MODULES
2471 struct Lisp_User_Ptr u_user_ptr; 2485 struct Lisp_User_Ptr u_user_ptr;
2472#endif 2486#endif
2487 struct Lisp_Bignum u_bignum;
2473 }; 2488 };
2474 2489
2475INLINE union Lisp_Misc * 2490INLINE union Lisp_Misc *
@@ -2519,6 +2534,25 @@ XUSER_PTR (Lisp_Object a)
2519} 2534}
2520#endif 2535#endif
2521 2536
2537INLINE bool
2538BIGNUMP (Lisp_Object x)
2539{
2540 return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Bignum;
2541}
2542
2543INLINE struct Lisp_Bignum *
2544XBIGNUM (Lisp_Object a)
2545{
2546 eassert (BIGNUMP (a));
2547 return XUNTAG (a, Lisp_Misc, struct Lisp_Bignum);
2548}
2549
2550INLINE bool
2551INTEGERP (Lisp_Object x)
2552{
2553 return FIXNUMP (x) || BIGNUMP (x);
2554}
2555
2522 2556
2523/* Forwarding pointer to an int variable. 2557/* Forwarding pointer to an int variable.
2524 This is allowed only in the value cell of a symbol, 2558 This is allowed only in the value cell of a symbol,
@@ -2734,6 +2768,18 @@ FIXNATP (Lisp_Object x)
2734{ 2768{
2735 return FIXNUMP (x) && 0 <= XINT (x); 2769 return FIXNUMP (x) && 0 <= XINT (x);
2736} 2770}
2771INLINE bool
2772NATNUMP (Lisp_Object x)
2773{
2774 if (BIGNUMP (x))
2775 return mpz_cmp_si (XBIGNUM (x)->value, 0) >= 0;
2776 return FIXNUMP (x) && 0 <= XINT (x);
2777}
2778INLINE bool
2779NUMBERP (Lisp_Object x)
2780{
2781 return INTEGERP (x) || FLOATP (x) || BIGNUMP (x);
2782}
2737 2783
2738INLINE bool 2784INLINE bool
2739RANGED_FIXNUMP (intmax_t lo, Lisp_Object x, intmax_t hi) 2785RANGED_FIXNUMP (intmax_t lo, Lisp_Object x, intmax_t hi)
@@ -2882,6 +2928,18 @@ CHECK_FIXNUM_OR_FLOAT (Lisp_Object x)
2882 CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumberp, x); 2928 CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumberp, x);
2883} 2929}
2884 2930
2931INLINE void
2932CHECK_NUMBER (Lisp_Object x)
2933{
2934 CHECK_TYPE (NUMBERP (x), Qnumberp, x);
2935}
2936
2937INLINE void
2938CHECK_INTEGER (Lisp_Object x)
2939{
2940 CHECK_TYPE (INTEGERP (x), Qnumberp, x);
2941}
2942
2885#define CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER(x) \ 2943#define CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER(x) \
2886 do { \ 2944 do { \
2887 if (MARKERP (x)) \ 2945 if (MARKERP (x)) \
@@ -2890,6 +2948,14 @@ CHECK_FIXNUM_OR_FLOAT (Lisp_Object x)
2890 CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumber_or_marker_p, x); \ 2948 CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumber_or_marker_p, x); \
2891 } while (false) 2949 } while (false)
2892 2950
2951#define CHECK_NUMBER_COERCE_MARKER(x) \
2952 do { \
2953 if (MARKERP (x)) \
2954 XSETFASTINT (x, marker_position (x)); \
2955 else \
2956 CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x); \
2957 } while (false)
2958
2893/* Since we can't assign directly to the CAR or CDR fields of a cons 2959/* Since we can't assign directly to the CAR or CDR fields of a cons
2894 cell, use these when checking that those fields contain numbers. */ 2960 cell, use these when checking that those fields contain numbers. */
2895INLINE void 2961INLINE 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)
2185 } 2185 }
2186 break; 2186 break;
2187 2187
2188 case Lisp_Misc_Bignum:
2189 {
2190 struct Lisp_Bignum *b = XBIGNUM (obj);
2191 char *str = mpz_get_str (NULL, 10, b->value);
2192 record_unwind_protect_ptr (xfree, str);
2193 print_c_string (str, printcharfun);
2194 }
2195 break;
2196
2188 default: 2197 default:
2189 goto badtype; 2198 goto badtype;
2190 } 2199 }