aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorTom Tromey2018-07-06 10:12:14 -0600
committerTom Tromey2018-07-12 22:12:27 -0600
commit5875fbaa2dfd919a2ba22db1d20ffa6c4c6e13bd (patch)
tree5814c2b640831eb2d90a7bdaf23afa2c5f84b13d /src
parenteefa65e90392df9bab287b0de5dedf73b40ca0fc (diff)
downloademacs-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.c129
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
2812static void
2813free_mpz_value (void *value_ptr)
2814{
2815 mpz_clear (*(mpz_t *) value_ptr);
2816}
2817
2812static Lisp_Object float_arith_driver (double, ptrdiff_t, enum arithop, 2818static Lisp_Object float_arith_driver (double, ptrdiff_t, enum arithop,
2813 ptrdiff_t, Lisp_Object *); 2819 ptrdiff_t, Lisp_Object *);
2820
2814static Lisp_Object 2821static Lisp_Object
2815arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) 2822arith_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. */