aboutsummaryrefslogtreecommitdiffstats
path: root/src/data.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/data.c')
-rw-r--r--src/data.c139
1 files changed, 71 insertions, 68 deletions
diff --git a/src/data.c b/src/data.c
index cf9f8e56133..1d9222e75a7 100644
--- a/src/data.c
+++ b/src/data.c
@@ -525,7 +525,7 @@ DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
525 (Lisp_Object object) 525 (Lisp_Object object)
526{ 526{
527 return ((FIXNUMP (object) ? 0 <= XFIXNUM (object) 527 return ((FIXNUMP (object) ? 0 <= XFIXNUM (object)
528 : BIGNUMP (object) && 0 <= mpz_sgn (XBIGNUM (object)->value)) 528 : BIGNUMP (object) && 0 <= mpz_sgn (*xbignum_val (object)))
529 ? Qt : Qnil); 529 ? Qt : Qnil);
530} 530}
531 531
@@ -771,10 +771,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
771 if (AUTOLOADP (function)) 771 if (AUTOLOADP (function))
772 Fput (symbol, Qautoload, XCDR (function)); 772 Fput (symbol, Qautoload, XCDR (function));
773 773
774 /* Convert to eassert or remove after GC bug is found. In the 774 eassert (valid_lisp_object_p (definition));
775 meantime, check unconditionally, at a slight perf hit. */
776 if (! valid_lisp_object_p (definition))
777 emacs_abort ();
778 775
779 set_symbol_function (symbol, definition); 776 set_symbol_function (symbol, definition);
780 777
@@ -2481,7 +2478,7 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
2481 else if (isnan (f1)) 2478 else if (isnan (f1))
2482 lt = eq = gt = false; 2479 lt = eq = gt = false;
2483 else 2480 else
2484 i2 = mpz_cmp_d (XBIGNUM (num2)->value, f1); 2481 i2 = mpz_cmp_d (*xbignum_val (num2), f1);
2485 } 2482 }
2486 else if (FIXNUMP (num1)) 2483 else if (FIXNUMP (num1))
2487 { 2484 {
@@ -2502,7 +2499,7 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
2502 i2 = XFIXNUM (num2); 2499 i2 = XFIXNUM (num2);
2503 } 2500 }
2504 else 2501 else
2505 i2 = mpz_sgn (XBIGNUM (num2)->value); 2502 i2 = mpz_sgn (*xbignum_val (num2));
2506 } 2503 }
2507 else if (FLOATP (num2)) 2504 else if (FLOATP (num2))
2508 { 2505 {
@@ -2510,12 +2507,12 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
2510 if (isnan (f2)) 2507 if (isnan (f2))
2511 lt = eq = gt = false; 2508 lt = eq = gt = false;
2512 else 2509 else
2513 i1 = mpz_cmp_d (XBIGNUM (num1)->value, f2); 2510 i1 = mpz_cmp_d (*xbignum_val (num1), f2);
2514 } 2511 }
2515 else if (FIXNUMP (num2)) 2512 else if (FIXNUMP (num2))
2516 i1 = mpz_sgn (XBIGNUM (num1)->value); 2513 i1 = mpz_sgn (*xbignum_val (num1));
2517 else 2514 else
2518 i1 = mpz_cmp (XBIGNUM (num1)->value, XBIGNUM (num2)->value); 2515 i1 = mpz_cmp (*xbignum_val (num1), *xbignum_val (num2));
2519 2516
2520 if (eq) 2517 if (eq)
2521 { 2518 {
@@ -3005,7 +3002,7 @@ usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */)
3005 return make_int (-XFIXNUM (a)); 3002 return make_int (-XFIXNUM (a));
3006 if (FLOATP (a)) 3003 if (FLOATP (a))
3007 return make_float (-XFLOAT_DATA (a)); 3004 return make_float (-XFLOAT_DATA (a));
3008 mpz_neg (mpz[0], XBIGNUM (a)->value); 3005 mpz_neg (mpz[0], *xbignum_val (a));
3009 return make_integer_mpz (); 3006 return make_integer_mpz ();
3010 } 3007 }
3011 return arith_driver (Asub, nargs, args, a); 3008 return arith_driver (Asub, nargs, args, a);
@@ -3058,58 +3055,67 @@ usage: (/ NUMBER &rest DIVISORS) */)
3058 return arith_driver (Adiv, nargs, args, a); 3055 return arith_driver (Adiv, nargs, args, a);
3059} 3056}
3060 3057
3061DEFUN ("%", Frem, Srem, 2, 2, 0, 3058/* Return NUM % DEN (or NUM mod DEN, if MODULO). NUM and DEN must be
3062 doc: /* Return remainder of X divided by Y. 3059 integers. */
3063Both must be integers or markers. */) 3060static Lisp_Object
3064 (register Lisp_Object x, Lisp_Object y) 3061integer_remainder (Lisp_Object num, Lisp_Object den, bool modulo)
3065{
3066 CHECK_INTEGER_COERCE_MARKER (x);
3067 CHECK_INTEGER_COERCE_MARKER (y);
3068
3069 /* A bignum can never be 0, so don't check that case. */
3070 if (EQ (y, make_fixnum (0)))
3071 xsignal0 (Qarith_error);
3072
3073 if (FIXNUMP (x) && FIXNUMP (y))
3074 return make_fixnum (XFIXNUM (x) % XFIXNUM (y));
3075 else
3076 {
3077 mpz_tdiv_r (mpz[0],
3078 *bignum_integer (&mpz[0], x),
3079 *bignum_integer (&mpz[1], y));
3080 return make_integer_mpz ();
3081 }
3082}
3083
3084/* Return X mod Y. Both must be integers and Y must be nonzero. */
3085Lisp_Object
3086integer_mod (Lisp_Object x, Lisp_Object y)
3087{ 3062{
3088 if (FIXNUMP (x) && FIXNUMP (y)) 3063 if (FIXNUMP (den))
3089 { 3064 {
3090 EMACS_INT i1 = XFIXNUM (x), i2 = XFIXNUM (y); 3065 EMACS_INT d = XFIXNUM (den);
3066 if (d == 0)
3067 xsignal0 (Qarith_error);
3091 3068
3092 i1 %= i2; 3069 EMACS_INT r;
3070 bool have_r = false;
3071 if (FIXNUMP (num))
3072 {
3073 r = XFIXNUM (num) % d;
3074 have_r = true;
3075 }
3076 else if (eabs (d) <= ULONG_MAX)
3077 {
3078 mpz_t const *n = xbignum_val (num);
3079 bool neg_n = mpz_sgn (*n) < 0;
3080 r = mpz_tdiv_ui (*n, eabs (d));
3081 if (neg_n)
3082 r = -r;
3083 have_r = true;
3084 }
3093 3085
3094 /* If the "remainder" comes out with the wrong sign, fix it. */ 3086 if (have_r)
3095 if (i2 < 0 ? i1 > 0 : i1 < 0) 3087 {
3096 i1 += i2; 3088 /* If MODULO and the remainder has the wrong sign, fix it. */
3089 if (modulo && (d < 0 ? r > 0 : r < 0))
3090 r += d;
3097 3091
3098 return make_fixnum (i1); 3092 return make_fixnum (r);
3093 }
3099 } 3094 }
3100 else
3101 {
3102 mpz_t const *ym = bignum_integer (&mpz[1], y);
3103 bool neg_y = mpz_sgn (*ym) < 0;
3104 mpz_mod (mpz[0], *bignum_integer (&mpz[0], x), *ym);
3105 3095
3106 /* Fix the sign if needed. */ 3096 mpz_t const *d = bignum_integer (&mpz[1], den);
3107 int sgn_r = mpz_sgn (mpz[0]); 3097 mpz_t *r = &mpz[0];
3108 if (neg_y ? sgn_r > 0 : sgn_r < 0) 3098 mpz_tdiv_r (*r, *bignum_integer (&mpz[0], num), *d);
3109 mpz_add (mpz[0], mpz[0], *ym);
3110 3099
3111 return make_integer_mpz (); 3100 if (modulo)
3101 {
3102 /* If the remainder has the wrong sign, fix it. */
3103 int sgn_r = mpz_sgn (*r);
3104 if (mpz_sgn (*d) < 0 ? sgn_r > 0 : sgn_r < 0)
3105 mpz_add (*r, *r, *d);
3112 } 3106 }
3107
3108 return make_integer_mpz ();
3109}
3110
3111DEFUN ("%", Frem, Srem, 2, 2, 0,
3112 doc: /* Return remainder of X divided by Y.
3113Both must be integers or markers. */)
3114 (register Lisp_Object x, Lisp_Object y)
3115{
3116 CHECK_INTEGER_COERCE_MARKER (x);
3117 CHECK_INTEGER_COERCE_MARKER (y);
3118 return integer_remainder (x, y, false);
3113} 3119}
3114 3120
3115DEFUN ("mod", Fmod, Smod, 2, 2, 0, 3121DEFUN ("mod", Fmod, Smod, 2, 2, 0,
@@ -3120,12 +3126,9 @@ Both X and Y must be numbers or markers. */)
3120{ 3126{
3121 CHECK_NUMBER_COERCE_MARKER (x); 3127 CHECK_NUMBER_COERCE_MARKER (x);
3122 CHECK_NUMBER_COERCE_MARKER (y); 3128 CHECK_NUMBER_COERCE_MARKER (y);
3123 3129 if (FLOATP (x) || FLOATP (y))
3124 /* A bignum can never be 0, so don't check that case. */ 3130 return fmod_float (x, y);
3125 if (EQ (y, make_fixnum (0))) 3131 return integer_remainder (x, y, true);
3126 xsignal0 (Qarith_error);
3127
3128 return (FLOATP (x) || FLOATP (y) ? fmod_float : integer_mod) (x, y);
3129} 3132}
3130 3133
3131static Lisp_Object 3134static Lisp_Object
@@ -3214,7 +3217,7 @@ representation. */)
3214 3217
3215 if (BIGNUMP (value)) 3218 if (BIGNUMP (value))
3216 { 3219 {
3217 mpz_t *nonneg = &XBIGNUM (value)->value; 3220 mpz_t const *nonneg = xbignum_val (value);
3218 if (mpz_sgn (*nonneg) < 0) 3221 if (mpz_sgn (*nonneg) < 0)
3219 { 3222 {
3220 mpz_com (mpz[0], *nonneg); 3223 mpz_com (mpz[0], *nonneg);
@@ -3245,10 +3248,10 @@ In this case, the sign bit is duplicated. */)
3245 { 3248 {
3246 if (EQ (value, make_fixnum (0))) 3249 if (EQ (value, make_fixnum (0)))
3247 return value; 3250 return value;
3248 if (mpz_sgn (XBIGNUM (count)->value) < 0) 3251 if (mpz_sgn (*xbignum_val (count)) < 0)
3249 { 3252 {
3250 EMACS_INT v = (FIXNUMP (value) ? XFIXNUM (value) 3253 EMACS_INT v = (FIXNUMP (value) ? XFIXNUM (value)
3251 : mpz_sgn (XBIGNUM (value)->value)); 3254 : mpz_sgn (*xbignum_val (value)));
3252 return make_fixnum (v < 0 ? -1 : 0); 3255 return make_fixnum (v < 0 ? -1 : 0);
3253 } 3256 }
3254 overflow_error (); 3257 overflow_error ();
@@ -3291,8 +3294,8 @@ expt_integer (Lisp_Object x, Lisp_Object y)
3291 if (TYPE_RANGED_FIXNUMP (unsigned long, y)) 3294 if (TYPE_RANGED_FIXNUMP (unsigned long, y))
3292 exp = XFIXNUM (y); 3295 exp = XFIXNUM (y);
3293 else if (MOST_POSITIVE_FIXNUM < ULONG_MAX && BIGNUMP (y) 3296 else if (MOST_POSITIVE_FIXNUM < ULONG_MAX && BIGNUMP (y)
3294 && mpz_fits_ulong_p (XBIGNUM (y)->value)) 3297 && mpz_fits_ulong_p (*xbignum_val (y)))
3295 exp = mpz_get_ui (XBIGNUM (y)->value); 3298 exp = mpz_get_ui (*xbignum_val (y));
3296 else 3299 else
3297 overflow_error (); 3300 overflow_error ();
3298 3301
@@ -3311,7 +3314,7 @@ Markers are converted to integers. */)
3311 return make_int (XFIXNUM (number) + 1); 3314 return make_int (XFIXNUM (number) + 1);
3312 if (FLOATP (number)) 3315 if (FLOATP (number))
3313 return (make_float (1.0 + XFLOAT_DATA (number))); 3316 return (make_float (1.0 + XFLOAT_DATA (number)));
3314 mpz_add_ui (mpz[0], XBIGNUM (number)->value, 1); 3317 mpz_add_ui (mpz[0], *xbignum_val (number), 1);
3315 return make_integer_mpz (); 3318 return make_integer_mpz ();
3316} 3319}
3317 3320
@@ -3326,7 +3329,7 @@ Markers are converted to integers. */)
3326 return make_int (XFIXNUM (number) - 1); 3329 return make_int (XFIXNUM (number) - 1);
3327 if (FLOATP (number)) 3330 if (FLOATP (number))
3328 return (make_float (-1.0 + XFLOAT_DATA (number))); 3331 return (make_float (-1.0 + XFLOAT_DATA (number)));
3329 mpz_sub_ui (mpz[0], XBIGNUM (number)->value, 1); 3332 mpz_sub_ui (mpz[0], *xbignum_val (number), 1);
3330 return make_integer_mpz (); 3333 return make_integer_mpz ();
3331} 3334}
3332 3335
@@ -3337,7 +3340,7 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0,
3337 CHECK_INTEGER (number); 3340 CHECK_INTEGER (number);
3338 if (FIXNUMP (number)) 3341 if (FIXNUMP (number))
3339 return make_fixnum (~XFIXNUM (number)); 3342 return make_fixnum (~XFIXNUM (number));
3340 mpz_com (mpz[0], XBIGNUM (number)->value); 3343 mpz_com (mpz[0], *xbignum_val (number));
3341 return make_integer_mpz (); 3344 return make_integer_mpz ();
3342} 3345}
3343 3346