diff options
| author | Tom Tromey | 2018-07-07 14:52:09 -0600 |
|---|---|---|
| committer | Tom Tromey | 2018-07-12 22:12:27 -0600 |
| commit | a0f2adbfc9cb1b69415f551a5e529f7e1162b9c7 (patch) | |
| tree | b6bf597a851b4ce521097802071361b7c78c4931 /src | |
| parent | 7cb45cd25e510cf3c20adeb9ac11c0c3ea1dd340 (diff) | |
| download | emacs-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.c | 3 | ||||
| -rw-r--r-- | src/data.c | 31 | ||||
| -rw-r--r-- | src/emacs.c | 16 | ||||
| -rw-r--r-- | src/lisp.h | 66 | ||||
| -rw-r--r-- | 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) | |||
| 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 | |||
| 525 | DEFUN ("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 | |||
| 613 | DEFUN ("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. */ | ||
| 677 | static void * | ||
| 678 | xrealloc_for_gmp (void *ptr, size_t ignore, size_t size) | ||
| 679 | { | ||
| 680 | return xrealloc (ptr, size); | ||
| 681 | } | ||
| 682 | |||
| 683 | /* Wrapper function for GMP. */ | ||
| 684 | static void | ||
| 685 | xfree_for_gmp (void *ptr, size_t ignore) | ||
| 686 | { | ||
| 687 | xfree (ptr); | ||
| 688 | } | ||
| 689 | |||
| 676 | /* ARGSUSED */ | 690 | /* ARGSUSED */ |
| 677 | int | 691 | int |
| 678 | main (int argc, char **argv) | 692 | main (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 | ||
| 2465 | struct 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 | ||
| 2475 | INLINE union Lisp_Misc * | 2490 | INLINE union Lisp_Misc * |
| @@ -2519,6 +2534,25 @@ XUSER_PTR (Lisp_Object a) | |||
| 2519 | } | 2534 | } |
| 2520 | #endif | 2535 | #endif |
| 2521 | 2536 | ||
| 2537 | INLINE bool | ||
| 2538 | BIGNUMP (Lisp_Object x) | ||
| 2539 | { | ||
| 2540 | return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Bignum; | ||
| 2541 | } | ||
| 2542 | |||
| 2543 | INLINE struct Lisp_Bignum * | ||
| 2544 | XBIGNUM (Lisp_Object a) | ||
| 2545 | { | ||
| 2546 | eassert (BIGNUMP (a)); | ||
| 2547 | return XUNTAG (a, Lisp_Misc, struct Lisp_Bignum); | ||
| 2548 | } | ||
| 2549 | |||
| 2550 | INLINE bool | ||
| 2551 | INTEGERP (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 | } |
| 2771 | INLINE bool | ||
| 2772 | NATNUMP (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 | } | ||
| 2778 | INLINE bool | ||
| 2779 | NUMBERP (Lisp_Object x) | ||
| 2780 | { | ||
| 2781 | return INTEGERP (x) || FLOATP (x) || BIGNUMP (x); | ||
| 2782 | } | ||
| 2737 | 2783 | ||
| 2738 | INLINE bool | 2784 | INLINE bool |
| 2739 | RANGED_FIXNUMP (intmax_t lo, Lisp_Object x, intmax_t hi) | 2785 | RANGED_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 | ||
| 2931 | INLINE void | ||
| 2932 | CHECK_NUMBER (Lisp_Object x) | ||
| 2933 | { | ||
| 2934 | CHECK_TYPE (NUMBERP (x), Qnumberp, x); | ||
| 2935 | } | ||
| 2936 | |||
| 2937 | INLINE void | ||
| 2938 | CHECK_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. */ |
| 2895 | INLINE void | 2961 | 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) | |||
| 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 | } |