diff options
| author | Tom Tromey | 2018-07-06 10:12:14 -0600 |
|---|---|---|
| committer | Tom Tromey | 2018-07-12 22:12:27 -0600 |
| commit | 5875fbaa2dfd919a2ba22db1d20ffa6c4c6e13bd (patch) | |
| tree | 5814c2b640831eb2d90a7bdaf23afa2c5f84b13d /src | |
| parent | eefa65e90392df9bab287b0de5dedf73b40ca0fc (diff) | |
| download | emacs-5875fbaa2dfd919a2ba22db1d20ffa6c4c6e13bd.tar.gz emacs-5875fbaa2dfd919a2ba22db1d20ffa6c4c6e13bd.zip | |
Make arithmetic work with bignums
* src/data.c (free_mpz_value): New function.
(arith_driver): Rewrite.
(float_arith_driver): Handle bignums.
Diffstat (limited to 'src')
| -rw-r--r-- | src/data.c | 129 |
1 files changed, 95 insertions, 34 deletions
diff --git a/src/data.c b/src/data.c index 97554c7e1d2..b49daabe85d 100644 --- a/src/data.c +++ b/src/data.c | |||
| @@ -2809,16 +2809,25 @@ enum arithop | |||
| 2809 | Alogxor | 2809 | Alogxor |
| 2810 | }; | 2810 | }; |
| 2811 | 2811 | ||
| 2812 | static void | ||
| 2813 | free_mpz_value (void *value_ptr) | ||
| 2814 | { | ||
| 2815 | mpz_clear (*(mpz_t *) value_ptr); | ||
| 2816 | } | ||
| 2817 | |||
| 2812 | static Lisp_Object float_arith_driver (double, ptrdiff_t, enum arithop, | 2818 | static Lisp_Object float_arith_driver (double, ptrdiff_t, enum arithop, |
| 2813 | ptrdiff_t, Lisp_Object *); | 2819 | ptrdiff_t, Lisp_Object *); |
| 2820 | |||
| 2814 | static Lisp_Object | 2821 | static Lisp_Object |
| 2815 | arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) | 2822 | arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) |
| 2816 | { | 2823 | { |
| 2817 | Lisp_Object val; | 2824 | Lisp_Object val = Qnil; |
| 2818 | ptrdiff_t argnum, ok_args; | 2825 | ptrdiff_t argnum; |
| 2819 | EMACS_INT accum = 0; | 2826 | ptrdiff_t count = SPECPDL_INDEX (); |
| 2820 | EMACS_INT next, ok_accum; | 2827 | mpz_t accum; |
| 2821 | bool overflow = 0; | 2828 | |
| 2829 | mpz_init (accum); | ||
| 2830 | record_unwind_protect_ptr (free_mpz_value, &accum); | ||
| 2822 | 2831 | ||
| 2823 | switch (code) | 2832 | switch (code) |
| 2824 | { | 2833 | { |
| @@ -2826,14 +2835,14 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) | |||
| 2826 | case Alogxor: | 2835 | case Alogxor: |
| 2827 | case Aadd: | 2836 | case Aadd: |
| 2828 | case Asub: | 2837 | case Asub: |
| 2829 | accum = 0; | 2838 | /* ACCUM is already 0. */ |
| 2830 | break; | 2839 | break; |
| 2831 | case Amult: | 2840 | case Amult: |
| 2832 | case Adiv: | 2841 | case Adiv: |
| 2833 | accum = 1; | 2842 | mpz_set_si (accum, 1); |
| 2834 | break; | 2843 | break; |
| 2835 | case Alogand: | 2844 | case Alogand: |
| 2836 | accum = -1; | 2845 | mpz_set_si (accum, -1); |
| 2837 | break; | 2846 | break; |
| 2838 | default: | 2847 | default: |
| 2839 | break; | 2848 | break; |
| @@ -2841,62 +2850,112 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) | |||
| 2841 | 2850 | ||
| 2842 | for (argnum = 0; argnum < nargs; argnum++) | 2851 | for (argnum = 0; argnum < nargs; argnum++) |
| 2843 | { | 2852 | { |
| 2844 | if (! overflow) | 2853 | /* Using args[argnum] as argument to CHECK_NUMBER... */ |
| 2845 | { | ||
| 2846 | ok_args = argnum; | ||
| 2847 | ok_accum = accum; | ||
| 2848 | } | ||
| 2849 | |||
| 2850 | /* Using args[argnum] as argument to CHECK_FIXNUM_... */ | ||
| 2851 | val = args[argnum]; | 2854 | val = args[argnum]; |
| 2852 | CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (val); | 2855 | CHECK_NUMBER (val); |
| 2853 | 2856 | ||
| 2854 | if (FLOATP (val)) | 2857 | if (FLOATP (val)) |
| 2855 | return float_arith_driver (ok_accum, ok_args, code, | 2858 | return unbind_to (count, |
| 2856 | nargs, args); | 2859 | float_arith_driver (mpz_get_d (accum), argnum, code, |
| 2857 | args[argnum] = val; | 2860 | nargs, args)); |
| 2858 | next = XINT (args[argnum]); | ||
| 2859 | switch (code) | 2861 | switch (code) |
| 2860 | { | 2862 | { |
| 2861 | case Aadd: | 2863 | case Aadd: |
| 2862 | overflow |= INT_ADD_WRAPV (accum, next, &accum); | 2864 | if (BIGNUMP (val)) |
| 2865 | mpz_add (accum, accum, XBIGNUM (val)->value); | ||
| 2866 | else if (XINT (val) < 0) | ||
| 2867 | mpz_sub_ui (accum, accum, - XINT (val)); | ||
| 2868 | else | ||
| 2869 | mpz_add_ui (accum, accum, XINT (val)); | ||
| 2863 | break; | 2870 | break; |
| 2864 | case Asub: | 2871 | case Asub: |
| 2865 | if (! argnum) | 2872 | if (! argnum) |
| 2866 | accum = nargs == 1 ? - next : next; | 2873 | { |
| 2874 | if (BIGNUMP (val)) | ||
| 2875 | mpz_set (accum, XBIGNUM (val)->value); | ||
| 2876 | else | ||
| 2877 | mpz_set_si (accum, XINT (val)); | ||
| 2878 | if (nargs == 1) | ||
| 2879 | mpz_neg (accum, accum); | ||
| 2880 | } | ||
| 2881 | else if (BIGNUMP (val)) | ||
| 2882 | mpz_sub (accum, accum, XBIGNUM (val)->value); | ||
| 2883 | else if (XINT (val) < 0) | ||
| 2884 | mpz_add_ui (accum, accum, - XINT (val)); | ||
| 2867 | else | 2885 | else |
| 2868 | overflow |= INT_SUBTRACT_WRAPV (accum, next, &accum); | 2886 | mpz_sub_ui (accum, accum, XINT (val)); |
| 2869 | break; | 2887 | break; |
| 2870 | case Amult: | 2888 | case Amult: |
| 2871 | overflow |= INT_MULTIPLY_WRAPV (accum, next, &accum); | 2889 | if (BIGNUMP (val)) |
| 2890 | mpz_mul (accum, accum, XBIGNUM (val)->value); | ||
| 2891 | else | ||
| 2892 | mpz_mul_si (accum, accum, XINT (val)); | ||
| 2872 | break; | 2893 | break; |
| 2873 | case Adiv: | 2894 | case Adiv: |
| 2874 | if (! (argnum || nargs == 1)) | 2895 | if (! (argnum || nargs == 1)) |
| 2875 | accum = next; | 2896 | { |
| 2897 | if (BIGNUMP (val)) | ||
| 2898 | mpz_set (accum, XBIGNUM (val)->value); | ||
| 2899 | else | ||
| 2900 | mpz_set_si (accum, XINT (val)); | ||
| 2901 | } | ||
| 2876 | else | 2902 | else |
| 2877 | { | 2903 | { |
| 2878 | if (next == 0) | 2904 | /* Note that a bignum can never be 0, so we don't need |
| 2905 | to check that case. */ | ||
| 2906 | if (FIXNUMP (val) && XINT (val) == 0) | ||
| 2879 | xsignal0 (Qarith_error); | 2907 | xsignal0 (Qarith_error); |
| 2880 | if (INT_DIVIDE_OVERFLOW (accum, next)) | 2908 | if (BIGNUMP (val)) |
| 2881 | overflow = true; | 2909 | mpz_tdiv_q (accum, accum, XBIGNUM (val)->value); |
| 2882 | else | 2910 | else |
| 2883 | accum /= next; | 2911 | { |
| 2912 | EMACS_INT value = XINT (val); | ||
| 2913 | bool negate = value < 0; | ||
| 2914 | if (negate) | ||
| 2915 | value = -value; | ||
| 2916 | mpz_tdiv_q_ui (accum, accum, value); | ||
| 2917 | if (negate) | ||
| 2918 | mpz_neg (accum, accum); | ||
| 2919 | } | ||
| 2884 | } | 2920 | } |
| 2885 | break; | 2921 | break; |
| 2886 | case Alogand: | 2922 | case Alogand: |
| 2887 | accum &= next; | 2923 | if (BIGNUMP (val)) |
| 2924 | mpz_and (accum, accum, XBIGNUM (val)->value); | ||
| 2925 | else | ||
| 2926 | { | ||
| 2927 | mpz_t tem; | ||
| 2928 | mpz_init_set_ui (tem, XUINT (val)); | ||
| 2929 | mpz_and (accum, accum, tem); | ||
| 2930 | mpz_clear (tem); | ||
| 2931 | } | ||
| 2888 | break; | 2932 | break; |
| 2889 | case Alogior: | 2933 | case Alogior: |
| 2890 | accum |= next; | 2934 | if (BIGNUMP (val)) |
| 2935 | mpz_ior (accum, accum, XBIGNUM (val)->value); | ||
| 2936 | else | ||
| 2937 | { | ||
| 2938 | mpz_t tem; | ||
| 2939 | mpz_init_set_ui (tem, XUINT (val)); | ||
| 2940 | mpz_ior (accum, accum, tem); | ||
| 2941 | mpz_clear (tem); | ||
| 2942 | } | ||
| 2891 | break; | 2943 | break; |
| 2892 | case Alogxor: | 2944 | case Alogxor: |
| 2893 | accum ^= next; | 2945 | if (BIGNUMP (val)) |
| 2946 | mpz_xor (accum, accum, XBIGNUM (val)->value); | ||
| 2947 | else | ||
| 2948 | { | ||
| 2949 | mpz_t tem; | ||
| 2950 | mpz_init_set_ui (tem, XUINT (val)); | ||
| 2951 | mpz_xor (accum, accum, tem); | ||
| 2952 | mpz_clear (tem); | ||
| 2953 | } | ||
| 2894 | break; | 2954 | break; |
| 2895 | } | 2955 | } |
| 2896 | } | 2956 | } |
| 2897 | 2957 | ||
| 2898 | XSETINT (val, accum); | 2958 | return unbind_to (count, make_number (accum)); |
| 2899 | return val; | ||
| 2900 | } | 2959 | } |
| 2901 | 2960 | ||
| 2902 | #ifndef isnan | 2961 | #ifndef isnan |
| @@ -2919,6 +2978,8 @@ float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code, | |||
| 2919 | { | 2978 | { |
| 2920 | next = XFLOAT_DATA (val); | 2979 | next = XFLOAT_DATA (val); |
| 2921 | } | 2980 | } |
| 2981 | else if (BIGNUMP (val)) | ||
| 2982 | next = mpz_get_d (XBIGNUM (val)->value); | ||
| 2922 | else | 2983 | else |
| 2923 | { | 2984 | { |
| 2924 | args[argnum] = val; /* runs into a compiler bug. */ | 2985 | args[argnum] = val; /* runs into a compiler bug. */ |