diff options
Diffstat (limited to 'src/floatfns.c')
| -rw-r--r-- | src/floatfns.c | 95 |
1 files changed, 55 insertions, 40 deletions
diff --git a/src/floatfns.c b/src/floatfns.c index ea9000b90a0..c09fe9d6a5b 100644 --- a/src/floatfns.c +++ b/src/floatfns.c | |||
| @@ -357,10 +357,10 @@ This is the same as the exponent of a float. */) | |||
| 357 | static Lisp_Object | 357 | static Lisp_Object |
| 358 | rounding_driver (Lisp_Object arg, Lisp_Object divisor, | 358 | rounding_driver (Lisp_Object arg, Lisp_Object divisor, |
| 359 | double (*double_round) (double), | 359 | double (*double_round) (double), |
| 360 | EMACS_INT (*int_round2) (EMACS_INT, EMACS_INT), | 360 | void (*int_divide) (mpz_t, mpz_t const, mpz_t const), |
| 361 | const char *name) | 361 | const char *name) |
| 362 | { | 362 | { |
| 363 | CHECK_FIXNUM_OR_FLOAT (arg); | 363 | CHECK_NUMBER (arg); |
| 364 | 364 | ||
| 365 | double d; | 365 | double d; |
| 366 | if (NILP (divisor)) | 366 | if (NILP (divisor)) |
| @@ -371,12 +371,25 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, | |||
| 371 | } | 371 | } |
| 372 | else | 372 | else |
| 373 | { | 373 | { |
| 374 | CHECK_FIXNUM_OR_FLOAT (divisor); | 374 | CHECK_NUMBER (divisor); |
| 375 | if (!FLOATP (arg) && !FLOATP (divisor)) | 375 | if (!FLOATP (arg) && !FLOATP (divisor)) |
| 376 | { | 376 | { |
| 377 | if (XFIXNUM (divisor) == 0) | 377 | if (EQ (divisor, make_fixnum (0))) |
| 378 | xsignal0 (Qarith_error); | 378 | xsignal0 (Qarith_error); |
| 379 | return make_fixnum (int_round2 (XFIXNUM (arg), XFIXNUM (divisor))); | 379 | mpz_t d, q; |
| 380 | mpz_init (d); | ||
| 381 | mpz_init (q); | ||
| 382 | int_divide (q, | ||
| 383 | (FIXNUMP (arg) | ||
| 384 | ? (mpz_set_intmax (q, XFIXNUM (arg)), q) | ||
| 385 | : XBIGNUM (arg)->value), | ||
| 386 | (FIXNUMP (divisor) | ||
| 387 | ? (mpz_set_intmax (d, XFIXNUM (divisor)), d) | ||
| 388 | : XBIGNUM (divisor)->value)); | ||
| 389 | Lisp_Object result = make_number (q); | ||
| 390 | mpz_clear (d); | ||
| 391 | mpz_clear (q); | ||
| 392 | return result; | ||
| 380 | } | 393 | } |
| 381 | 394 | ||
| 382 | double f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XFIXNUM (arg); | 395 | double f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XFIXNUM (arg); |
| @@ -400,37 +413,39 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, | |||
| 400 | xsignal2 (Qrange_error, build_string (name), arg); | 413 | xsignal2 (Qrange_error, build_string (name), arg); |
| 401 | } | 414 | } |
| 402 | 415 | ||
| 403 | static EMACS_INT | 416 | static void |
| 404 | ceiling2 (EMACS_INT i1, EMACS_INT i2) | 417 | rounddiv_q (mpz_t q, mpz_t const n, mpz_t const d) |
| 405 | { | 418 | { |
| 406 | return i1 / i2 + ((i1 % i2 != 0) & ((i1 < 0) == (i2 < 0))); | 419 | /* mpz_tdiv_qr gives us one remainder R, but we want the remainder |
| 407 | } | 420 | R1 on the other side of 0 if R1 is closer to 0 than R is; because |
| 408 | 421 | we want to round to even, we also want R1 if R and R1 are the | |
| 409 | static EMACS_INT | 422 | same distance from 0 and if the quotient is odd. |
| 410 | floor2 (EMACS_INT i1, EMACS_INT i2) | 423 | |
| 411 | { | 424 | If we were using EMACS_INT arithmetic instead of bignums, |
| 412 | return i1 / i2 - ((i1 % i2 != 0) & ((i1 < 0) != (i2 < 0))); | 425 | the following code could look something like this: |
| 413 | } | 426 | |
| 414 | 427 | q = n / d; | |
| 415 | static EMACS_INT | 428 | r = n % d; |
| 416 | truncate2 (EMACS_INT i1, EMACS_INT i2) | 429 | neg_d = d < 0; |
| 417 | { | 430 | neg_r = r < 0; |
| 418 | return i1 / i2; | 431 | r = eabs (r); |
| 419 | } | 432 | abs_r1 = eabs (d) - r; |
| 420 | 433 | if (abs_r1 < r + (q & 1)) | |
| 421 | static EMACS_INT | 434 | q += neg_d == neg_r ? 1 : -1; */ |
| 422 | round2 (EMACS_INT i1, EMACS_INT i2) | 435 | |
| 423 | { | 436 | mpz_t r, abs_r1; |
| 424 | /* The C language's division operator gives us one remainder R, but | 437 | mpz_init (r); |
| 425 | we want the remainder R1 on the other side of 0 if R1 is closer | 438 | mpz_init (abs_r1); |
| 426 | to 0 than R is; because we want to round to even, we also want R1 | 439 | mpz_tdiv_qr (q, r, n, d); |
| 427 | if R and R1 are the same distance from 0 and if C's quotient is | 440 | bool neg_d = mpz_sgn (d) < 0; |
| 428 | odd. */ | 441 | bool neg_r = mpz_sgn (r) < 0; |
| 429 | EMACS_INT q = i1 / i2; | 442 | mpz_abs (r, r); |
| 430 | EMACS_INT r = i1 % i2; | 443 | mpz_abs (abs_r1, d); |
| 431 | EMACS_INT abs_r = eabs (r); | 444 | mpz_sub (abs_r1, abs_r1, r); |
| 432 | EMACS_INT abs_r1 = eabs (i2) - abs_r; | 445 | if (mpz_cmp (abs_r1, r) < (mpz_odd_p (q) != 0)) |
| 433 | return q + (abs_r + (q & 1) <= abs_r1 ? 0 : (i2 ^ r) < 0 ? -1 : 1); | 446 | (neg_d == neg_r ? mpz_add_ui : mpz_sub_ui) (q, q, 1); |
| 447 | mpz_clear (r); | ||
| 448 | mpz_clear (abs_r1); | ||
| 434 | } | 449 | } |
| 435 | 450 | ||
| 436 | /* The code uses emacs_rint, so that it works to undefine HAVE_RINT | 451 | /* The code uses emacs_rint, so that it works to undefine HAVE_RINT |
| @@ -461,7 +476,7 @@ This rounds the value towards +inf. | |||
| 461 | With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR. */) | 476 | With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR. */) |
| 462 | (Lisp_Object arg, Lisp_Object divisor) | 477 | (Lisp_Object arg, Lisp_Object divisor) |
| 463 | { | 478 | { |
| 464 | return rounding_driver (arg, divisor, ceil, ceiling2, "ceiling"); | 479 | return rounding_driver (arg, divisor, ceil, mpz_cdiv_q, "ceiling"); |
| 465 | } | 480 | } |
| 466 | 481 | ||
| 467 | DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0, | 482 | DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0, |
| @@ -470,7 +485,7 @@ This rounds the value towards -inf. | |||
| 470 | With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. */) | 485 | With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. */) |
| 471 | (Lisp_Object arg, Lisp_Object divisor) | 486 | (Lisp_Object arg, Lisp_Object divisor) |
| 472 | { | 487 | { |
| 473 | return rounding_driver (arg, divisor, floor, floor2, "floor"); | 488 | return rounding_driver (arg, divisor, floor, mpz_fdiv_q, "floor"); |
| 474 | } | 489 | } |
| 475 | 490 | ||
| 476 | DEFUN ("round", Fround, Sround, 1, 2, 0, | 491 | DEFUN ("round", Fround, Sround, 1, 2, 0, |
| @@ -483,7 +498,7 @@ your machine. For example, (round 2.5) can return 3 on some | |||
| 483 | systems, but 2 on others. */) | 498 | systems, but 2 on others. */) |
| 484 | (Lisp_Object arg, Lisp_Object divisor) | 499 | (Lisp_Object arg, Lisp_Object divisor) |
| 485 | { | 500 | { |
| 486 | return rounding_driver (arg, divisor, emacs_rint, round2, "round"); | 501 | return rounding_driver (arg, divisor, emacs_rint, rounddiv_q, "round"); |
| 487 | } | 502 | } |
| 488 | 503 | ||
| 489 | DEFUN ("truncate", Ftruncate, Struncate, 1, 2, 0, | 504 | DEFUN ("truncate", Ftruncate, Struncate, 1, 2, 0, |
| @@ -492,7 +507,7 @@ Rounds ARG toward zero. | |||
| 492 | With optional DIVISOR, truncate ARG/DIVISOR. */) | 507 | With optional DIVISOR, truncate ARG/DIVISOR. */) |
| 493 | (Lisp_Object arg, Lisp_Object divisor) | 508 | (Lisp_Object arg, Lisp_Object divisor) |
| 494 | { | 509 | { |
| 495 | return rounding_driver (arg, divisor, trunc, truncate2, "truncate"); | 510 | return rounding_driver (arg, divisor, trunc, mpz_tdiv_q, "truncate"); |
| 496 | } | 511 | } |
| 497 | 512 | ||
| 498 | 513 | ||