aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/bignum.c71
-rw-r--r--src/bignum.h19
-rw-r--r--src/data.c669
-rw-r--r--src/emacs.c1
-rw-r--r--src/floatfns.c44
-rw-r--r--src/fns.c12
6 files changed, 340 insertions, 476 deletions
diff --git a/src/bignum.c b/src/bignum.c
index b18ceccb59d..2ce7412d06c 100644
--- a/src/bignum.c
+++ b/src/bignum.c
@@ -25,6 +25,22 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
25 25
26#include <stdlib.h> 26#include <stdlib.h>
27 27
28/* mpz global temporaries. Making them global saves the trouble of
29 properly using mpz_init and mpz_clear on temporaries even when
30 storage is exhausted. Admittedly this is not ideal. An mpz value
31 in a temporary is made permanent by mpz_swapping it with a bignum's
32 value. Although typically at most two temporaries are needed,
33 rounding_driver and rounddiv_q need four altogther. */
34
35mpz_t mpz[4];
36
37void
38init_bignum_once (void)
39{
40 for (int i = 0; i < ARRAYELTS (mpz); i++)
41 mpz_init (mpz[i]);
42}
43
28/* Return the value of the Lisp bignum N, as a double. */ 44/* Return the value of the Lisp bignum N, as a double. */
29double 45double
30bignum_to_double (Lisp_Object n) 46bignum_to_double (Lisp_Object n)
@@ -36,17 +52,14 @@ bignum_to_double (Lisp_Object n)
36Lisp_Object 52Lisp_Object
37double_to_bignum (double d) 53double_to_bignum (double d)
38{ 54{
39 mpz_t z; 55 mpz_set_d (mpz[0], d);
40 mpz_init_set_d (z, d); 56 return make_integer_mpz ();
41 Lisp_Object result = make_integer (z);
42 mpz_clear (z);
43 return result;
44} 57}
45 58
46/* Return a Lisp integer equal to OP, which has BITS bits and which 59/* Return a Lisp integer equal to mpz[0], which has BITS bits and which
47 must not be in fixnum range. */ 60 must not be in fixnum range. Set mpz[0] to a junk value. */
48static Lisp_Object 61static Lisp_Object
49make_bignum_bits (mpz_t const op, size_t bits) 62make_bignum_bits (size_t bits)
50{ 63{
51 /* The documentation says integer-width should be nonnegative, so 64 /* The documentation says integer-width should be nonnegative, so
52 a single comparison suffices even though 'bits' is unsigned. */ 65 a single comparison suffices even though 'bits' is unsigned. */
@@ -55,18 +68,17 @@ make_bignum_bits (mpz_t const op, size_t bits)
55 68
56 struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, 69 struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value,
57 PVEC_BIGNUM); 70 PVEC_BIGNUM);
58 /* We could mpz_init + mpz_swap here, to avoid a copy, but the 71 mpz_init (b->value);
59 resulting API seemed possibly confusing. */ 72 mpz_swap (b->value, mpz[0]);
60 mpz_init_set (b->value, op);
61
62 return make_lisp_ptr (b, Lisp_Vectorlike); 73 return make_lisp_ptr (b, Lisp_Vectorlike);
63} 74}
64 75
65/* Return a Lisp integer equal to OP, which must not be in fixnum range. */ 76/* Return a Lisp integer equal to mpz[0], which must not be in fixnum range.
77 Set mpz[0] to a junk value. */
66static Lisp_Object 78static Lisp_Object
67make_bignum (mpz_t const op) 79make_bignum (void)
68{ 80{
69 return make_bignum_bits (op, mpz_sizeinbase (op, 2)); 81 return make_bignum_bits (mpz_sizeinbase (mpz[0], 2));
70} 82}
71 83
72static void mpz_set_uintmax_slow (mpz_t, uintmax_t); 84static void mpz_set_uintmax_slow (mpz_t, uintmax_t);
@@ -86,30 +98,23 @@ Lisp_Object
86make_bigint (intmax_t n) 98make_bigint (intmax_t n)
87{ 99{
88 eassert (FIXNUM_OVERFLOW_P (n)); 100 eassert (FIXNUM_OVERFLOW_P (n));
89 mpz_t z; 101 mpz_set_intmax (mpz[0], n);
90 mpz_init (z); 102 return make_bignum ();
91 mpz_set_intmax (z, n);
92 Lisp_Object result = make_bignum (z);
93 mpz_clear (z);
94 return result;
95} 103}
96Lisp_Object 104Lisp_Object
97make_biguint (uintmax_t n) 105make_biguint (uintmax_t n)
98{ 106{
99 eassert (FIXNUM_OVERFLOW_P (n)); 107 eassert (FIXNUM_OVERFLOW_P (n));
100 mpz_t z; 108 mpz_set_uintmax (mpz[0], n);
101 mpz_init (z); 109 return make_bignum ();
102 mpz_set_uintmax (z, n);
103 Lisp_Object result = make_bignum (z);
104 mpz_clear (z);
105 return result;
106} 110}
107 111
108/* Return a Lisp integer with value taken from OP. */ 112/* Return a Lisp integer with value taken from mpz[0].
113 Set mpz[0] to a junk value. */
109Lisp_Object 114Lisp_Object
110make_integer (mpz_t const op) 115make_integer_mpz (void)
111{ 116{
112 size_t bits = mpz_sizeinbase (op, 2); 117 size_t bits = mpz_sizeinbase (mpz[0], 2);
113 118
114 if (bits <= FIXNUM_BITS) 119 if (bits <= FIXNUM_BITS)
115 { 120 {
@@ -118,20 +123,20 @@ make_integer (mpz_t const op)
118 123
119 do 124 do
120 { 125 {
121 EMACS_INT limb = mpz_getlimbn (op, i++); 126 EMACS_INT limb = mpz_getlimbn (mpz[0], i++);
122 v += limb << shift; 127 v += limb << shift;
123 shift += GMP_NUMB_BITS; 128 shift += GMP_NUMB_BITS;
124 } 129 }
125 while (shift < bits); 130 while (shift < bits);
126 131
127 if (mpz_sgn (op) < 0) 132 if (mpz_sgn (mpz[0]) < 0)
128 v = -v; 133 v = -v;
129 134
130 if (!FIXNUM_OVERFLOW_P (v)) 135 if (!FIXNUM_OVERFLOW_P (v))
131 return make_fixnum (v); 136 return make_fixnum (v);
132 } 137 }
133 138
134 return make_bignum_bits (op, bits); 139 return make_bignum_bits (bits);
135} 140}
136 141
137/* Set RESULT to V. This code is for when intmax_t is wider than long. */ 142/* Set RESULT to V. This code is for when intmax_t is wider than long. */
diff --git a/src/bignum.h b/src/bignum.h
index a368333d77e..07622a37af4 100644
--- a/src/bignum.h
+++ b/src/bignum.h
@@ -41,7 +41,10 @@ struct Lisp_Bignum
41 mpz_t value; 41 mpz_t value;
42}; 42};
43 43
44extern Lisp_Object make_integer (mpz_t const) ARG_NONNULL ((1)); 44extern mpz_t mpz[4];
45
46extern void init_bignum_once (void);
47extern Lisp_Object make_integer_mpz (void);
45extern void mpz_set_intmax_slow (mpz_t, intmax_t) ARG_NONNULL ((1)); 48extern void mpz_set_intmax_slow (mpz_t, intmax_t) ARG_NONNULL ((1));
46 49
47INLINE_HEADER_BEGIN 50INLINE_HEADER_BEGIN
@@ -65,6 +68,20 @@ mpz_set_intmax (mpz_t result, intmax_t v)
65 mpz_set_intmax_slow (result, v); 68 mpz_set_intmax_slow (result, v);
66} 69}
67 70
71/* Return a pointer to an mpz_t that is equal to the Lisp integer I.
72 If I is a bignum this returns a pointer to I's representation;
73 otherwise this sets *TMP to I's value and returns TMP. */
74INLINE mpz_t *
75bignum_integer (mpz_t *tmp, Lisp_Object i)
76{
77 if (FIXNUMP (i))
78 {
79 mpz_set_intmax (*tmp, XFIXNUM (i));
80 return tmp;
81 }
82 return &XBIGNUM (i)->value;
83}
84
68INLINE_HEADER_END 85INLINE_HEADER_END
69 86
70#endif /* BIGNUM_H */ 87#endif /* BIGNUM_H */
diff --git a/src/data.c b/src/data.c
index 6afda1e6fb9..7be2052362b 100644
--- a/src/data.c
+++ b/src/data.c
@@ -2832,232 +2832,186 @@ enum arithop
2832 Alogior, 2832 Alogior,
2833 Alogxor 2833 Alogxor
2834 }; 2834 };
2835 2835static bool
2836enum { FIXNUMS_FIT_IN_LONG = (LONG_MIN <= MOST_NEGATIVE_FIXNUM 2836floating_point_op (enum arithop code)
2837 && MOST_POSITIVE_FIXNUM <= LONG_MAX) };
2838
2839static void
2840free_mpz_value (void *value_ptr)
2841{ 2837{
2842 mpz_clear (*(mpz_t *) value_ptr); 2838 return code <= Adiv;
2843} 2839}
2844 2840
2845static Lisp_Object float_arith_driver (double, ptrdiff_t, enum arithop, 2841/* Return the result of applying the floating-point operation CODE to
2846 ptrdiff_t, Lisp_Object *); 2842 the NARGS arguments starting at ARGS. If ARGNUM is positive,
2843 ARGNUM of the arguments were already consumed, yielding ACCUM.
2844 0 <= ARGNUM < NARGS, 2 <= NARGS, and NEXT is the value of
2845 ARGS[ARGSNUM], converted to double. */
2847 2846
2848static Lisp_Object 2847static Lisp_Object
2849arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) 2848floatop_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args,
2849 ptrdiff_t argnum, double accum, double next)
2850{ 2850{
2851 Lisp_Object val = Qnil; 2851 if (argnum == 0)
2852 ptrdiff_t argnum;
2853 ptrdiff_t count = SPECPDL_INDEX ();
2854 mpz_t accum;
2855
2856 mpz_init (accum);
2857 record_unwind_protect_ptr (free_mpz_value, &accum);
2858
2859 switch (code)
2860 { 2852 {
2861 case Alogior: 2853 accum = next;
2862 case Alogxor: 2854 goto next_arg;
2863 case Aadd:
2864 case Asub:
2865 /* ACCUM is already 0. */
2866 break;
2867 case Amult:
2868 case Adiv:
2869 mpz_set_si (accum, 1);
2870 break;
2871 case Alogand:
2872 mpz_set_si (accum, -1);
2873 break;
2874 default:
2875 break;
2876 } 2855 }
2877 2856
2878 for (argnum = 0; argnum < nargs; argnum++) 2857 while (true)
2879 { 2858 {
2880 /* Using args[argnum] as argument to CHECK_NUMBER... */
2881 val = args[argnum];
2882 CHECK_NUMBER_COERCE_MARKER (val);
2883
2884 if (FLOATP (val))
2885 return unbind_to (count,
2886 float_arith_driver (mpz_get_d (accum), argnum, code,
2887 nargs, args));
2888 switch (code) 2859 switch (code)
2889 { 2860 {
2890 case Aadd: 2861 case Aadd : accum += next; break;
2891 if (BIGNUMP (val)) 2862 case Asub : accum -= next; break;
2892 mpz_add (accum, accum, XBIGNUM (val)->value); 2863 case Amult: accum *= next; break;
2893 else if (! FIXNUMS_FIT_IN_LONG)
2894 {
2895 mpz_t tem;
2896 mpz_init (tem);
2897 mpz_set_intmax (tem, XFIXNUM (val));
2898 mpz_add (accum, accum, tem);
2899 mpz_clear (tem);
2900 }
2901 else if (XFIXNUM (val) < 0)
2902 mpz_sub_ui (accum, accum, - XFIXNUM (val));
2903 else
2904 mpz_add_ui (accum, accum, XFIXNUM (val));
2905 break;
2906 case Asub:
2907 if (! argnum)
2908 {
2909 if (BIGNUMP (val))
2910 mpz_set (accum, XBIGNUM (val)->value);
2911 else
2912 mpz_set_intmax (accum, XFIXNUM (val));
2913 if (nargs == 1)
2914 mpz_neg (accum, accum);
2915 }
2916 else if (BIGNUMP (val))
2917 mpz_sub (accum, accum, XBIGNUM (val)->value);
2918 else if (! FIXNUMS_FIT_IN_LONG)
2919 {
2920 mpz_t tem;
2921 mpz_init (tem);
2922 mpz_set_intmax (tem, XFIXNUM (val));
2923 mpz_sub (accum, accum, tem);
2924 mpz_clear (tem);
2925 }
2926 else if (XFIXNUM (val) < 0)
2927 mpz_add_ui (accum, accum, - XFIXNUM (val));
2928 else
2929 mpz_sub_ui (accum, accum, XFIXNUM (val));
2930 break;
2931 case Amult:
2932 if (BIGNUMP (val))
2933 emacs_mpz_mul (accum, accum, XBIGNUM (val)->value);
2934 else if (! FIXNUMS_FIT_IN_LONG)
2935 {
2936 mpz_t tem;
2937 mpz_init (tem);
2938 mpz_set_intmax (tem, XFIXNUM (val));
2939 emacs_mpz_mul (accum, accum, tem);
2940 mpz_clear (tem);
2941 }
2942 else
2943 mpz_mul_si (accum, accum, XFIXNUM (val));
2944 break;
2945 case Adiv: 2864 case Adiv:
2946 if (! (argnum || nargs == 1)) 2865 if (! IEEE_FLOATING_POINT && next == 0)
2947 { 2866 xsignal0 (Qarith_error);
2948 if (BIGNUMP (val)) 2867 accum /= next;
2949 mpz_set (accum, XBIGNUM (val)->value);
2950 else
2951 mpz_set_intmax (accum, XFIXNUM (val));
2952 }
2953 else
2954 {
2955 /* Note that a bignum can never be 0, so we don't need
2956 to check that case. */
2957 if (BIGNUMP (val))
2958 mpz_tdiv_q (accum, accum, XBIGNUM (val)->value);
2959 else if (XFIXNUM (val) == 0)
2960 xsignal0 (Qarith_error);
2961 else if (ULONG_MAX < -MOST_NEGATIVE_FIXNUM)
2962 {
2963 mpz_t tem;
2964 mpz_init (tem);
2965 mpz_set_intmax (tem, XFIXNUM (val));
2966 mpz_tdiv_q (accum, accum, tem);
2967 mpz_clear (tem);
2968 }
2969 else
2970 {
2971 EMACS_INT value = XFIXNUM (val);
2972 mpz_tdiv_q_ui (accum, accum, eabs (value));
2973 if (value < 0)
2974 mpz_neg (accum, accum);
2975 }
2976 }
2977 break;
2978 case Alogand:
2979 if (BIGNUMP (val))
2980 mpz_and (accum, accum, XBIGNUM (val)->value);
2981 else
2982 {
2983 mpz_t tem;
2984 mpz_init (tem);
2985 mpz_set_intmax (tem, XFIXNUM (val));
2986 mpz_and (accum, accum, tem);
2987 mpz_clear (tem);
2988 }
2989 break;
2990 case Alogior:
2991 if (BIGNUMP (val))
2992 mpz_ior (accum, accum, XBIGNUM (val)->value);
2993 else
2994 {
2995 mpz_t tem;
2996 mpz_init (tem);
2997 mpz_set_intmax (tem, XFIXNUM (val));
2998 mpz_ior (accum, accum, tem);
2999 mpz_clear (tem);
3000 }
3001 break;
3002 case Alogxor:
3003 if (BIGNUMP (val))
3004 mpz_xor (accum, accum, XBIGNUM (val)->value);
3005 else
3006 {
3007 mpz_t tem;
3008 mpz_init (tem);
3009 mpz_set_intmax (tem, XFIXNUM (val));
3010 mpz_xor (accum, accum, tem);
3011 mpz_clear (tem);
3012 }
3013 break; 2868 break;
2869 default: eassume (false);
3014 } 2870 }
2871
2872 next_arg:
2873 argnum++;
2874 if (argnum == nargs)
2875 return make_float (accum);
2876 Lisp_Object val = args[argnum];
2877 CHECK_NUMBER_COERCE_MARKER (val);
2878 next = XFLOATINT (val);
3015 } 2879 }
2880}
2881
2882/* Like floatop_arith_driver, except CODE might not be a floating-point
2883 operation, and NEXT is a Lisp float rather than a C double. */
3016 2884
3017 return unbind_to (count, make_integer (accum)); 2885static Lisp_Object
2886float_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args,
2887 ptrdiff_t argnum, double accum, Lisp_Object next)
2888{
2889 if (! floating_point_op (code))
2890 wrong_type_argument (Qinteger_or_marker_p, next);
2891 return floatop_arith_driver (code, nargs, args, argnum, accum,
2892 XFLOAT_DATA (next));
3018} 2893}
3019 2894
2895/* Return the result of applying the arithmetic operation CODE to the
2896 NARGS arguments starting at ARGS. If ARGNUM is positive, ARGNUM of
2897 the arguments were already consumed, yielding IACCUM. 0 <= ARGNUM
2898 < NARGS, 2 <= NARGS, and VAL is the value of ARGS[ARGSNUM],
2899 converted to integer. */
2900
3020static Lisp_Object 2901static Lisp_Object
3021float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code, 2902bignum_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args,
3022 ptrdiff_t nargs, Lisp_Object *args) 2903 ptrdiff_t argnum, intmax_t iaccum, Lisp_Object val)
3023{ 2904{
3024 for (; argnum < nargs; argnum++) 2905 mpz_t *accum;
2906 if (argnum == 0)
3025 { 2907 {
3026 Lisp_Object val = args[argnum]; 2908 accum = bignum_integer (&mpz[0], val);
3027 CHECK_NUMBER_COERCE_MARKER (val); 2909 goto next_arg;
3028 double next = (FIXNUMP (val) ? XFIXNUM (val) 2910 }
3029 : FLOATP (val) ? XFLOAT_DATA (val) 2911 mpz_set_intmax (mpz[0], iaccum);
3030 : mpz_get_d (XBIGNUM (val)->value)); 2912 accum = &mpz[0];
2913
2914 while (true)
2915 {
2916 mpz_t *next = bignum_integer (&mpz[1], val);
3031 2917
3032 switch (code) 2918 switch (code)
3033 { 2919 {
3034 case Aadd: 2920 case Aadd : mpz_add (mpz[0], *accum, *next); break;
3035 accum += next; 2921 case Asub : mpz_sub (mpz[0], *accum, *next); break;
3036 break; 2922 case Amult : emacs_mpz_mul (mpz[0], *accum, *next); break;
3037 case Asub: 2923 case Alogand: mpz_and (mpz[0], *accum, *next); break;
3038 accum = argnum ? accum - next : nargs == 1 ? - next : next; 2924 case Alogior: mpz_ior (mpz[0], *accum, *next); break;
3039 break; 2925 case Alogxor: mpz_xor (mpz[0], *accum, *next); break;
3040 case Amult:
3041 accum *= next;
3042 break;
3043 case Adiv: 2926 case Adiv:
3044 if (! (argnum || nargs == 1)) 2927 if (mpz_sgn (*next) == 0)
3045 accum = next; 2928 xsignal0 (Qarith_error);
3046 else 2929 mpz_tdiv_q (mpz[0], *accum, *next);
3047 {
3048 if (! IEEE_FLOATING_POINT && next == 0)
3049 xsignal0 (Qarith_error);
3050 accum /= next;
3051 }
3052 break; 2930 break;
3053 case Alogand: 2931 default:
3054 case Alogior: 2932 eassume (false);
3055 case Alogxor:
3056 wrong_type_argument (Qinteger_or_marker_p, val);
3057 } 2933 }
2934 accum = &mpz[0];
2935
2936 next_arg:
2937 argnum++;
2938 if (argnum == nargs)
2939 return make_integer_mpz ();
2940 val = args[argnum];
2941 CHECK_NUMBER_COERCE_MARKER (val);
2942 if (FLOATP (val))
2943 float_arith_driver (code, nargs, args, argnum,
2944 mpz_get_d (*accum), val);
3058 } 2945 }
2946}
2947
2948/* Return the result of applying the arithmetic operation CODE to the
2949 NARGS arguments starting at ARGS, with the first argument being the
2950 number VAL. 2 <= NARGS. Check that the remaining arguments are
2951 numbers or markers. */
2952
2953static Lisp_Object
2954arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args,
2955 Lisp_Object val)
2956{
2957 eassume (2 <= nargs);
2958
2959 ptrdiff_t argnum = 0;
2960 /* Set ACCUM to VAL's value if it is a fixnum, otherwise to some
2961 ignored value to avoid using an uninitialized variable later. */
2962 intmax_t accum = XFIXNUM (val);
2963
2964 if (FIXNUMP (val))
2965 while (true)
2966 {
2967 argnum++;
2968 if (argnum == nargs)
2969 return make_int (accum);
2970 val = args[argnum];
2971 CHECK_NUMBER_COERCE_MARKER (val);
2972
2973 /* Set NEXT to the next value if it fits, else exit the loop. */
2974 intmax_t next;
2975 if (FIXNUMP (val))
2976 next = XFIXNUM (val);
2977 else if (FLOATP (val))
2978 break;
2979 else
2980 {
2981 next = bignum_to_intmax (val);
2982 if (next == 0)
2983 break;
2984 }
2985
2986 /* Set ACCUM to the next operation's result if it fits,
2987 else exit the loop. */
2988 bool overflow = false;
2989 intmax_t a;
2990 switch (code)
2991 {
2992 case Aadd : overflow = INT_ADD_WRAPV (accum, next, &a); break;
2993 case Amult: overflow = INT_MULTIPLY_WRAPV (accum, next, &a); break;
2994 case Asub : overflow = INT_SUBTRACT_WRAPV (accum, next, &a); break;
2995 case Adiv:
2996 if (next == 0)
2997 xsignal0 (Qarith_error);
2998 overflow = INT_DIVIDE_OVERFLOW (accum, next);
2999 if (!overflow)
3000 a = accum / next;
3001 break;
3002 case Alogand: accum &= next; continue;
3003 case Alogior: accum |= next; continue;
3004 case Alogxor: accum ^= next; continue;
3005 default: eassume (false);
3006 }
3007 if (overflow)
3008 break;
3009 accum = a;
3010 }
3059 3011
3060 return make_float (accum); 3012 return (FLOATP (val)
3013 ? float_arith_driver (code, nargs, args, argnum, accum, val)
3014 : bignum_arith_driver (code, nargs, args, argnum, accum, val));
3061} 3015}
3062 3016
3063 3017
@@ -3066,7 +3020,11 @@ DEFUN ("+", Fplus, Splus, 0, MANY, 0,
3066usage: (+ &rest NUMBERS-OR-MARKERS) */) 3020usage: (+ &rest NUMBERS-OR-MARKERS) */)
3067 (ptrdiff_t nargs, Lisp_Object *args) 3021 (ptrdiff_t nargs, Lisp_Object *args)
3068{ 3022{
3069 return arith_driver (Aadd, nargs, args); 3023 if (nargs == 0)
3024 return make_fixnum (0);
3025 Lisp_Object a = args[0];
3026 CHECK_NUMBER_COERCE_MARKER (a);
3027 return nargs == 1 ? a : arith_driver (Aadd, nargs, args, a);
3070} 3028}
3071 3029
3072DEFUN ("-", Fminus, Sminus, 0, MANY, 0, 3030DEFUN ("-", Fminus, Sminus, 0, MANY, 0,
@@ -3076,7 +3034,20 @@ subtracts all but the first from the first.
3076usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */) 3034usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */)
3077 (ptrdiff_t nargs, Lisp_Object *args) 3035 (ptrdiff_t nargs, Lisp_Object *args)
3078{ 3036{
3079 return arith_driver (Asub, nargs, args); 3037 if (nargs == 0)
3038 return make_fixnum (0);
3039 Lisp_Object a = args[0];
3040 CHECK_NUMBER_COERCE_MARKER (a);
3041 if (nargs == 1)
3042 {
3043 if (FIXNUMP (a))
3044 return make_int (-XFIXNUM (a));
3045 if (FLOATP (a))
3046 return make_float (-XFLOAT_DATA (a));
3047 mpz_neg (mpz[0], XBIGNUM (a)->value);
3048 return make_integer_mpz ();
3049 }
3050 return arith_driver (Asub, nargs, args, a);
3080} 3051}
3081 3052
3082DEFUN ("*", Ftimes, Stimes, 0, MANY, 0, 3053DEFUN ("*", Ftimes, Stimes, 0, MANY, 0,
@@ -3084,7 +3055,11 @@ DEFUN ("*", Ftimes, Stimes, 0, MANY, 0,
3084usage: (* &rest NUMBERS-OR-MARKERS) */) 3055usage: (* &rest NUMBERS-OR-MARKERS) */)
3085 (ptrdiff_t nargs, Lisp_Object *args) 3056 (ptrdiff_t nargs, Lisp_Object *args)
3086{ 3057{
3087 return arith_driver (Amult, nargs, args); 3058 if (nargs == 0)
3059 return make_fixnum (1);
3060 Lisp_Object a = args[0];
3061 CHECK_NUMBER_COERCE_MARKER (a);
3062 return nargs == 1 ? a : arith_driver (Amult, nargs, args, a);
3088} 3063}
3089 3064
3090DEFUN ("/", Fquo, Squo, 1, MANY, 0, 3065DEFUN ("/", Fquo, Squo, 1, MANY, 0,
@@ -3095,11 +3070,31 @@ The arguments must be numbers or markers.
3095usage: (/ NUMBER &rest DIVISORS) */) 3070usage: (/ NUMBER &rest DIVISORS) */)
3096 (ptrdiff_t nargs, Lisp_Object *args) 3071 (ptrdiff_t nargs, Lisp_Object *args)
3097{ 3072{
3098 ptrdiff_t argnum; 3073 Lisp_Object a = args[0];
3099 for (argnum = 2; argnum < nargs; argnum++) 3074 CHECK_NUMBER_COERCE_MARKER (a);
3075 if (nargs == 1)
3076 {
3077 if (FIXNUMP (a))
3078 {
3079 if (XFIXNUM (a) == 0)
3080 xsignal0 (Qarith_error);
3081 return make_fixnum (1 / XFIXNUM (a));
3082 }
3083 if (FLOATP (a))
3084 {
3085 if (! IEEE_FLOATING_POINT && XFLOAT_DATA (a) == 0)
3086 xsignal0 (Qarith_error);
3087 return make_float (1 / XFLOAT_DATA (a));
3088 }
3089 /* Dividing 1 by any bignum yields 0. */
3090 return make_fixnum (0);
3091 }
3092
3093 /* Do all computation in floating-point if any arg is a float. */
3094 for (ptrdiff_t argnum = 2; argnum < nargs; argnum++)
3100 if (FLOATP (args[argnum])) 3095 if (FLOATP (args[argnum]))
3101 return float_arith_driver (0, 0, Adiv, nargs, args); 3096 return floatop_arith_driver (Adiv, nargs, args, 0, 0, XFLOATINT (a));
3102 return arith_driver (Adiv, nargs, args); 3097 return arith_driver (Adiv, nargs, args, a);
3103} 3098}
3104 3099
3105DEFUN ("%", Frem, Srem, 2, 2, 0, 3100DEFUN ("%", Frem, Srem, 2, 2, 0,
@@ -3107,52 +3102,22 @@ DEFUN ("%", Frem, Srem, 2, 2, 0,
3107Both must be integers or markers. */) 3102Both must be integers or markers. */)
3108 (register Lisp_Object x, Lisp_Object y) 3103 (register Lisp_Object x, Lisp_Object y)
3109{ 3104{
3110 Lisp_Object val;
3111
3112 CHECK_INTEGER_COERCE_MARKER (x); 3105 CHECK_INTEGER_COERCE_MARKER (x);
3113 CHECK_INTEGER_COERCE_MARKER (y); 3106 CHECK_INTEGER_COERCE_MARKER (y);
3114 3107
3115 /* Note that a bignum can never be 0, so we don't need to check that 3108 /* A bignum can never be 0, so don't check that case. */
3116 case. */
3117 if (FIXNUMP (y) && XFIXNUM (y) == 0) 3109 if (FIXNUMP (y) && XFIXNUM (y) == 0)
3118 xsignal0 (Qarith_error); 3110 xsignal0 (Qarith_error);
3119 3111
3120 if (FIXNUMP (x) && FIXNUMP (y)) 3112 if (FIXNUMP (x) && FIXNUMP (y))
3121 XSETINT (val, XFIXNUM (x) % XFIXNUM (y)); 3113 return make_fixnum (XFIXNUM (x) % XFIXNUM (y));
3122 else 3114 else
3123 { 3115 {
3124 mpz_t xm, ym, *xmp, *ymp; 3116 mpz_tdiv_r (mpz[0],
3125 mpz_t result; 3117 *bignum_integer (&mpz[0], x),
3126 3118 *bignum_integer (&mpz[1], y));
3127 if (BIGNUMP (x)) 3119 return make_integer_mpz ();
3128 xmp = &XBIGNUM (x)->value;
3129 else
3130 {
3131 mpz_init (xm);
3132 mpz_set_intmax (xm, XFIXNUM (x));
3133 xmp = &xm;
3134 }
3135
3136 if (BIGNUMP (y))
3137 ymp = &XBIGNUM (y)->value;
3138 else
3139 {
3140 mpz_init (ym);
3141 mpz_set_intmax (ym, XFIXNUM (y));
3142 ymp = &ym;
3143 }
3144
3145 mpz_init (result);
3146 mpz_tdiv_r (result, *xmp, *ymp);
3147 val = make_integer (result);
3148 mpz_clear (result);
3149
3150 if (xmp == &xm)
3151 mpz_clear (xm);
3152 if (ymp == &ym)
3153 mpz_clear (ym);
3154 } 3120 }
3155 return val;
3156} 3121}
3157 3122
3158DEFUN ("mod", Fmod, Smod, 2, 2, 0, 3123DEFUN ("mod", Fmod, Smod, 2, 2, 0,
@@ -3161,9 +3126,6 @@ The result falls between zero (inclusive) and Y (exclusive).
3161Both X and Y must be numbers or markers. */) 3126Both X and Y must be numbers or markers. */)
3162 (register Lisp_Object x, Lisp_Object y) 3127 (register Lisp_Object x, Lisp_Object y)
3163{ 3128{
3164 Lisp_Object val;
3165 EMACS_INT i1, i2;
3166
3167 CHECK_NUMBER_COERCE_MARKER (x); 3129 CHECK_NUMBER_COERCE_MARKER (x);
3168 CHECK_NUMBER_COERCE_MARKER (y); 3130 CHECK_NUMBER_COERCE_MARKER (y);
3169 3131
@@ -3177,8 +3139,7 @@ Both X and Y must be numbers or markers. */)
3177 3139
3178 if (FIXNUMP (x) && FIXNUMP (y)) 3140 if (FIXNUMP (x) && FIXNUMP (y))
3179 { 3141 {
3180 i1 = XFIXNUM (x); 3142 EMACS_INT i1 = XFIXNUM (x), i2 = XFIXNUM (y);
3181 i2 = XFIXNUM (y);
3182 3143
3183 if (i2 == 0) 3144 if (i2 == 0)
3184 xsignal0 (Qarith_error); 3145 xsignal0 (Qarith_error);
@@ -3189,51 +3150,21 @@ Both X and Y must be numbers or markers. */)
3189 if (i2 < 0 ? i1 > 0 : i1 < 0) 3150 if (i2 < 0 ? i1 > 0 : i1 < 0)
3190 i1 += i2; 3151 i1 += i2;
3191 3152
3192 XSETINT (val, i1); 3153 return make_fixnum (i1);
3193 } 3154 }
3194 else 3155 else
3195 { 3156 {
3196 mpz_t xm, ym, *xmp, *ymp; 3157 mpz_t *ym = bignum_integer (&mpz[1], y);
3197 mpz_t result; 3158 bool neg_y = mpz_sgn (*ym) < 0;
3198 int cmpr, cmpy; 3159 mpz_mod (mpz[0], *bignum_integer (&mpz[0], x), *ym);
3199
3200 if (BIGNUMP (x))
3201 xmp = &XBIGNUM (x)->value;
3202 else
3203 {
3204 mpz_init (xm);
3205 mpz_set_intmax (xm, XFIXNUM (x));
3206 xmp = &xm;
3207 }
3208
3209 if (BIGNUMP (y))
3210 ymp = &XBIGNUM (y)->value;
3211 else
3212 {
3213 mpz_init (ym);
3214 mpz_set_intmax (ym, XFIXNUM (y));
3215 ymp = &ym;
3216 }
3217
3218 mpz_init (result);
3219 mpz_mod (result, *xmp, *ymp);
3220 3160
3221 /* Fix the sign if needed. */ 3161 /* Fix the sign if needed. */
3222 cmpr = mpz_sgn (result); 3162 int sgn_r = mpz_sgn (mpz[0]);
3223 cmpy = mpz_sgn (*ymp); 3163 if (neg_y ? sgn_r > 0 : sgn_r < 0)
3224 if (cmpy < 0 ? cmpr > 0 : cmpr < 0) 3164 mpz_add (mpz[0], mpz[0], *ym);
3225 mpz_add (result, result, *ymp);
3226
3227 val = make_integer (result);
3228 mpz_clear (result);
3229
3230 if (xmp == &xm)
3231 mpz_clear (xm);
3232 if (ymp == &ym)
3233 mpz_clear (ym);
3234 }
3235 3165
3236 return val; 3166 return make_integer_mpz ();
3167 }
3237} 3168}
3238 3169
3239static Lisp_Object 3170static Lisp_Object
@@ -3278,7 +3209,11 @@ Arguments may be integers, or markers converted to integers.
3278usage: (logand &rest INTS-OR-MARKERS) */) 3209usage: (logand &rest INTS-OR-MARKERS) */)
3279 (ptrdiff_t nargs, Lisp_Object *args) 3210 (ptrdiff_t nargs, Lisp_Object *args)
3280{ 3211{
3281 return arith_driver (Alogand, nargs, args); 3212 if (nargs == 0)
3213 return make_fixnum (-1);
3214 Lisp_Object a = args[0];
3215 CHECK_INTEGER_COERCE_MARKER (a);
3216 return nargs == 1 ? a : arith_driver (Alogand, nargs, args, a);
3282} 3217}
3283 3218
3284DEFUN ("logior", Flogior, Slogior, 0, MANY, 0, 3219DEFUN ("logior", Flogior, Slogior, 0, MANY, 0,
@@ -3287,7 +3222,11 @@ Arguments may be integers, or markers converted to integers.
3287usage: (logior &rest INTS-OR-MARKERS) */) 3222usage: (logior &rest INTS-OR-MARKERS) */)
3288 (ptrdiff_t nargs, Lisp_Object *args) 3223 (ptrdiff_t nargs, Lisp_Object *args)
3289{ 3224{
3290 return arith_driver (Alogior, nargs, args); 3225 if (nargs == 0)
3226 return make_fixnum (0);
3227 Lisp_Object a = args[0];
3228 CHECK_INTEGER_COERCE_MARKER (a);
3229 return nargs == 1 ? a : arith_driver (Alogior, nargs, args, a);
3291} 3230}
3292 3231
3293DEFUN ("logxor", Flogxor, Slogxor, 0, MANY, 0, 3232DEFUN ("logxor", Flogxor, Slogxor, 0, MANY, 0,
@@ -3296,7 +3235,11 @@ Arguments may be integers, or markers converted to integers.
3296usage: (logxor &rest INTS-OR-MARKERS) */) 3235usage: (logxor &rest INTS-OR-MARKERS) */)
3297 (ptrdiff_t nargs, Lisp_Object *args) 3236 (ptrdiff_t nargs, Lisp_Object *args)
3298{ 3237{
3299 return arith_driver (Alogxor, nargs, args); 3238 if (nargs == 0)
3239 return make_fixnum (0);
3240 Lisp_Object a = args[0];
3241 CHECK_INTEGER_COERCE_MARKER (a);
3242 return nargs == 1 ? a : arith_driver (Alogxor, nargs, args, a);
3300} 3243}
3301 3244
3302DEFUN ("logcount", Flogcount, Slogcount, 1, 1, 0, 3245DEFUN ("logcount", Flogcount, Slogcount, 1, 1, 0,
@@ -3310,14 +3253,13 @@ representation. */)
3310 3253
3311 if (BIGNUMP (value)) 3254 if (BIGNUMP (value))
3312 { 3255 {
3313 if (mpz_sgn (XBIGNUM (value)->value) >= 0) 3256 mpz_t *nonneg = &XBIGNUM (value)->value;
3314 return make_fixnum (mpz_popcount (XBIGNUM (value)->value)); 3257 if (mpz_sgn (*nonneg) < 0)
3315 mpz_t tem; 3258 {
3316 mpz_init (tem); 3259 mpz_com (mpz[0], *nonneg);
3317 mpz_com (tem, XBIGNUM (value)->value); 3260 nonneg = &mpz[0];
3318 Lisp_Object result = make_fixnum (mpz_popcount (tem)); 3261 }
3319 mpz_clear (tem); 3262 return make_fixnum (mpz_popcount (*nonneg));
3320 return result;
3321 } 3263 }
3322 3264
3323 eassume (FIXNUMP (value)); 3265 eassume (FIXNUMP (value));
@@ -3335,8 +3277,6 @@ If COUNT is negative, shifting is actually to the right.
3335In this case, the sign bit is duplicated. */) 3277In this case, the sign bit is duplicated. */)
3336 (Lisp_Object value, Lisp_Object count) 3278 (Lisp_Object value, Lisp_Object count)
3337{ 3279{
3338 Lisp_Object val;
3339
3340 /* The negative of the minimum value of COUNT that fits into a fixnum, 3280 /* The negative of the minimum value of COUNT that fits into a fixnum,
3341 such that mpz_fdiv_q_exp supports -COUNT. */ 3281 such that mpz_fdiv_q_exp supports -COUNT. */
3342 EMACS_INT minus_count_min = min (-MOST_NEGATIVE_FIXNUM, 3282 EMACS_INT minus_count_min = min (-MOST_NEGATIVE_FIXNUM,
@@ -3344,48 +3284,27 @@ In this case, the sign bit is duplicated. */)
3344 CHECK_INTEGER (value); 3284 CHECK_INTEGER (value);
3345 CHECK_RANGED_INTEGER (count, - minus_count_min, TYPE_MAXIMUM (mp_bitcnt_t)); 3285 CHECK_RANGED_INTEGER (count, - minus_count_min, TYPE_MAXIMUM (mp_bitcnt_t));
3346 3286
3347 if (BIGNUMP (value)) 3287 if (XFIXNUM (count) <= 0)
3348 { 3288 {
3349 if (XFIXNUM (count) == 0) 3289 if (XFIXNUM (count) == 0)
3350 return value; 3290 return value;
3351 mpz_t result;
3352 mpz_init (result);
3353 if (XFIXNUM (count) > 0)
3354 emacs_mpz_mul_2exp (result, XBIGNUM (value)->value, XFIXNUM (count));
3355 else
3356 mpz_fdiv_q_2exp (result, XBIGNUM (value)->value, - XFIXNUM (count));
3357 val = make_integer (result);
3358 mpz_clear (result);
3359 }
3360 else if (XFIXNUM (count) <= 0)
3361 {
3362 /* This code assumes that signed right shifts are arithmetic. */
3363 verify ((EMACS_INT) -1 >> 1 == -1);
3364
3365 EMACS_INT shift = -XFIXNUM (count);
3366 EMACS_INT result = (shift < EMACS_INT_WIDTH ? XFIXNUM (value) >> shift
3367 : XFIXNUM (value) < 0 ? -1 : 0);
3368 val = make_fixnum (result);
3369 }
3370 else
3371 {
3372 /* Just do the work as bignums to make the code simpler. */
3373 mpz_t result;
3374 eassume (FIXNUMP (value));
3375 mpz_init (result);
3376
3377 mpz_set_intmax (result, XFIXNUM (value));
3378
3379 if (XFIXNUM (count) >= 0)
3380 emacs_mpz_mul_2exp (result, result, XFIXNUM (count));
3381 else
3382 mpz_fdiv_q_2exp (result, result, - XFIXNUM (count));
3383 3291
3384 val = make_integer (result); 3292 if ((EMACS_INT) -1 >> 1 == -1 && FIXNUMP (value))
3385 mpz_clear (result); 3293 {
3294 EMACS_INT shift = -XFIXNUM (count);
3295 EMACS_INT result
3296 = (shift < EMACS_INT_WIDTH ? XFIXNUM (value) >> shift
3297 : XFIXNUM (value) < 0 ? -1 : 0);
3298 return make_fixnum (result);
3299 }
3386 } 3300 }
3387 3301
3388 return val; 3302 mpz_t *zval = bignum_integer (&mpz[0], value);
3303 if (XFIXNUM (count) < 0)
3304 mpz_fdiv_q_2exp (mpz[0], *zval, - XFIXNUM (count));
3305 else
3306 emacs_mpz_mul_2exp (mpz[0], *zval, XFIXNUM (count));
3307 return make_integer_mpz ();
3389} 3308}
3390 3309
3391/* Return X ** Y as an integer. X and Y must be integers, and Y must 3310/* Return X ** Y as an integer. X and Y must be integers, and Y must
@@ -3403,16 +3322,8 @@ expt_integer (Lisp_Object x, Lisp_Object y)
3403 else 3322 else
3404 range_error (); 3323 range_error ();
3405 3324
3406 mpz_t val; 3325 emacs_mpz_pow_ui (mpz[0], *bignum_integer (&mpz[0], x), exp);
3407 mpz_init (val); 3326 return make_integer_mpz ();
3408 emacs_mpz_pow_ui (val,
3409 (FIXNUMP (x)
3410 ? (mpz_set_intmax (val, XFIXNUM (x)), val)
3411 : XBIGNUM (x)->value),
3412 exp);
3413 Lisp_Object res = make_integer (val);
3414 mpz_clear (val);
3415 return res;
3416} 3327}
3417 3328
3418DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0, 3329DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0,
@@ -3422,32 +3333,12 @@ Markers are converted to integers. */)
3422{ 3333{
3423 CHECK_NUMBER_COERCE_MARKER (number); 3334 CHECK_NUMBER_COERCE_MARKER (number);
3424 3335
3336 if (FIXNUMP (number))
3337 return make_int (XFIXNUM (number) + 1);
3425 if (FLOATP (number)) 3338 if (FLOATP (number))
3426 return (make_float (1.0 + XFLOAT_DATA (number))); 3339 return (make_float (1.0 + XFLOAT_DATA (number)));
3427 3340 mpz_add_ui (mpz[0], XBIGNUM (number)->value, 1);
3428 if (BIGNUMP (number)) 3341 return make_integer_mpz ();
3429 {
3430 mpz_t num;
3431 mpz_init (num);
3432 mpz_add_ui (num, XBIGNUM (number)->value, 1);
3433 number = make_integer (num);
3434 mpz_clear (num);
3435 }
3436 else
3437 {
3438 eassume (FIXNUMP (number));
3439 if (XFIXNUM (number) < MOST_POSITIVE_FIXNUM)
3440 XSETINT (number, XFIXNUM (number) + 1);
3441 else
3442 {
3443 mpz_t num;
3444 mpz_init (num);
3445 mpz_set_intmax (num, XFIXNUM (number) + 1);
3446 number = make_integer (num);
3447 mpz_clear (num);
3448 }
3449 }
3450 return number;
3451} 3342}
3452 3343
3453DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0, 3344DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0,
@@ -3457,32 +3348,12 @@ Markers are converted to integers. */)
3457{ 3348{
3458 CHECK_NUMBER_COERCE_MARKER (number); 3349 CHECK_NUMBER_COERCE_MARKER (number);
3459 3350
3351 if (FIXNUMP (number))
3352 return make_int (XFIXNUM (number) - 1);
3460 if (FLOATP (number)) 3353 if (FLOATP (number))
3461 return (make_float (-1.0 + XFLOAT_DATA (number))); 3354 return (make_float (-1.0 + XFLOAT_DATA (number)));
3462 3355 mpz_sub_ui (mpz[0], XBIGNUM (number)->value, 1);
3463 if (BIGNUMP (number)) 3356 return make_integer_mpz ();
3464 {
3465 mpz_t num;
3466 mpz_init (num);
3467 mpz_sub_ui (num, XBIGNUM (number)->value, 1);
3468 number = make_integer (num);
3469 mpz_clear (num);
3470 }
3471 else
3472 {
3473 eassume (FIXNUMP (number));
3474 if (XFIXNUM (number) > MOST_NEGATIVE_FIXNUM)
3475 XSETINT (number, XFIXNUM (number) - 1);
3476 else
3477 {
3478 mpz_t num;
3479 mpz_init (num);
3480 mpz_set_intmax (num, XFIXNUM (number) - 1);
3481 number = make_integer (num);
3482 mpz_clear (num);
3483 }
3484 }
3485 return number;
3486} 3357}
3487 3358
3488DEFUN ("lognot", Flognot, Slognot, 1, 1, 0, 3359DEFUN ("lognot", Flognot, Slognot, 1, 1, 0,
@@ -3490,20 +3361,10 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0,
3490 (register Lisp_Object number) 3361 (register Lisp_Object number)
3491{ 3362{
3492 CHECK_INTEGER (number); 3363 CHECK_INTEGER (number);
3493 if (BIGNUMP (number)) 3364 if (FIXNUMP (number))
3494 { 3365 return make_fixnum (~XFIXNUM (number));
3495 mpz_t value; 3366 mpz_com (mpz[0], XBIGNUM (number)->value);
3496 mpz_init (value); 3367 return make_integer_mpz ();
3497 mpz_com (value, XBIGNUM (number)->value);
3498 number = make_integer (value);
3499 mpz_clear (value);
3500 }
3501 else
3502 {
3503 eassume (FIXNUMP (number));
3504 XSETINT (number, ~XFIXNUM (number));
3505 }
3506 return number;
3507} 3368}
3508 3369
3509DEFUN ("byteorder", Fbyteorder, Sbyteorder, 0, 0, 0, 3370DEFUN ("byteorder", Fbyteorder, Sbyteorder, 0, 0, 0,
diff --git a/src/emacs.c b/src/emacs.c
index 07a1aff9b06..5b399eca64f 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1209,6 +1209,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
1209 if (!initialized) 1209 if (!initialized)
1210 { 1210 {
1211 init_alloc_once (); 1211 init_alloc_once ();
1212 init_bignum_once ();
1212 init_threads_once (); 1213 init_threads_once ();
1213 init_obarray (); 1214 init_obarray ();
1214 init_eval_once (); 1215 init_eval_once ();
diff --git a/src/floatfns.c b/src/floatfns.c
index 77e20d5640b..2f33b8652b2 100644
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -270,11 +270,8 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0,
270 { 270 {
271 if (mpz_sgn (XBIGNUM (arg)->value) < 0) 271 if (mpz_sgn (XBIGNUM (arg)->value) < 0)
272 { 272 {
273 mpz_t val; 273 mpz_neg (mpz[0], XBIGNUM (arg)->value);
274 mpz_init (val); 274 arg = make_integer_mpz ();
275 mpz_neg (val, XBIGNUM (arg)->value);
276 arg = make_integer (val);
277 mpz_clear (val);
278 } 275 }
279 } 276 }
280 277
@@ -360,20 +357,10 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor,
360 { 357 {
361 if (EQ (divisor, make_fixnum (0))) 358 if (EQ (divisor, make_fixnum (0)))
362 xsignal0 (Qarith_error); 359 xsignal0 (Qarith_error);
363 mpz_t d, q; 360 int_divide (mpz[0],
364 mpz_init (d); 361 *bignum_integer (&mpz[0], arg),
365 mpz_init (q); 362 *bignum_integer (&mpz[1], divisor));
366 int_divide (q, 363 return make_integer_mpz ();
367 (FIXNUMP (arg)
368 ? (mpz_set_intmax (q, XFIXNUM (arg)), q)
369 : XBIGNUM (arg)->value),
370 (FIXNUMP (divisor)
371 ? (mpz_set_intmax (d, XFIXNUM (divisor)), d)
372 : XBIGNUM (divisor)->value));
373 Lisp_Object result = make_integer (q);
374 mpz_clear (d);
375 mpz_clear (q);
376 return result;
377 } 364 }
378 365
379 double f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XFIXNUM (arg); 366 double f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XFIXNUM (arg);
@@ -417,20 +404,15 @@ rounddiv_q (mpz_t q, mpz_t const n, mpz_t const d)
417 if (abs_r1 < abs_r + (q & 1)) 404 if (abs_r1 < abs_r + (q & 1))
418 q += neg_d == neg_r ? 1 : -1; */ 405 q += neg_d == neg_r ? 1 : -1; */
419 406
420 mpz_t r, abs_r1; 407 mpz_t *r = &mpz[2], *abs_r = r, *abs_r1 = &mpz[3];
421 mpz_init (r); 408 mpz_tdiv_qr (q, *r, n, d);
422 mpz_init (abs_r1);
423 mpz_tdiv_qr (q, r, n, d);
424 bool neg_d = mpz_sgn (d) < 0; 409 bool neg_d = mpz_sgn (d) < 0;
425 bool neg_r = mpz_sgn (r) < 0; 410 bool neg_r = mpz_sgn (*r) < 0;
426 mpz_t *abs_r = &r; 411 mpz_abs (*abs_r, *r);
427 mpz_abs (*abs_r, r); 412 mpz_abs (*abs_r1, d);
428 mpz_abs (abs_r1, d); 413 mpz_sub (*abs_r1, *abs_r1, *abs_r);
429 mpz_sub (abs_r1, abs_r1, *abs_r); 414 if (mpz_cmp (*abs_r1, *abs_r) < (mpz_odd_p (q) != 0))
430 if (mpz_cmp (abs_r1, *abs_r) < (mpz_odd_p (q) != 0))
431 (neg_d == neg_r ? mpz_add_ui : mpz_sub_ui) (q, q, 1); 415 (neg_d == neg_r ? mpz_add_ui : mpz_sub_ui) (q, q, 1);
432 mpz_clear (r);
433 mpz_clear (abs_r1);
434} 416}
435 417
436/* The code uses emacs_rint, so that it works to undefine HAVE_RINT 418/* The code uses emacs_rint, so that it works to undefine HAVE_RINT
diff --git a/src/fns.c b/src/fns.c
index 17a869e1abc..8b25492eaeb 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1468,19 +1468,17 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
1468 /* Undo any error introduced when LARGE_NUM was substituted for 1468 /* Undo any error introduced when LARGE_NUM was substituted for
1469 N, by adding N - LARGE_NUM to NUM, using arithmetic modulo 1469 N, by adding N - LARGE_NUM to NUM, using arithmetic modulo
1470 CYCLE_LENGTH. */ 1470 CYCLE_LENGTH. */
1471 mpz_t z; /* N mod CYCLE_LENGTH. */ 1471 /* Add N mod CYCLE_LENGTH to NUM. */
1472 mpz_init (z);
1473 if (cycle_length <= ULONG_MAX) 1472 if (cycle_length <= ULONG_MAX)
1474 num += mpz_mod_ui (z, XBIGNUM (n)->value, cycle_length); 1473 num += mpz_mod_ui (mpz[0], XBIGNUM (n)->value, cycle_length);
1475 else 1474 else
1476 { 1475 {
1477 mpz_set_intmax (z, cycle_length); 1476 mpz_set_intmax (mpz[0], cycle_length);
1478 mpz_mod (z, XBIGNUM (n)->value, z); 1477 mpz_mod (mpz[0], XBIGNUM (n)->value, mpz[0]);
1479 intptr_t iz; 1478 intptr_t iz;
1480 mpz_export (&iz, NULL, -1, sizeof iz, 0, 0, z); 1479 mpz_export (&iz, NULL, -1, sizeof iz, 0, 0, mpz[0]);
1481 num += iz; 1480 num += iz;
1482 } 1481 }
1483 mpz_clear (z);
1484 num += cycle_length - large_num % cycle_length; 1482 num += cycle_length - large_num % cycle_length;
1485 } 1483 }
1486 num %= cycle_length; 1484 num %= cycle_length;