diff options
| author | Paul Eggert | 2018-09-05 00:21:02 -0700 |
|---|---|---|
| committer | Paul Eggert | 2018-09-05 00:23:49 -0700 |
| commit | baa6ae8724fd4cd7631164a89bf8eed4ff79cfc0 (patch) | |
| tree | c57f4a6e7a764baee33dbacb5fc58f7ef0269725 /src/floatfns.c | |
| parent | ccb3891ff5446b578b9306aec0fd9c5ec3ed8e98 (diff) | |
| download | emacs-baa6ae8724fd4cd7631164a89bf8eed4ff79cfc0.tar.gz emacs-baa6ae8724fd4cd7631164a89bf8eed4ff79cfc0.zip | |
Improve (round FIXNUM FIXNUM) performance
* src/floatfns.c (rounding_driver):
New arg fixnum_divide. All callers changed.
(ceiling2, floor2, truncate2, round2): New functions.
Not that new, actually; these are essentially taken from Emacs 26.
(Fceiling, Ffloor, Fround, Ftruncate): Use them.
Diffstat (limited to 'src/floatfns.c')
| -rw-r--r-- | src/floatfns.c | 74 |
1 files changed, 52 insertions, 22 deletions
diff --git a/src/floatfns.c b/src/floatfns.c index 13ab7b0359f..dc7236353c0 100644 --- a/src/floatfns.c +++ b/src/floatfns.c | |||
| @@ -339,6 +339,7 @@ static Lisp_Object | |||
| 339 | rounding_driver (Lisp_Object arg, Lisp_Object divisor, | 339 | rounding_driver (Lisp_Object arg, Lisp_Object divisor, |
| 340 | double (*double_round) (double), | 340 | double (*double_round) (double), |
| 341 | void (*int_divide) (mpz_t, mpz_t const, mpz_t const), | 341 | void (*int_divide) (mpz_t, mpz_t const, mpz_t const), |
| 342 | EMACS_INT (*fixnum_divide) (EMACS_INT, EMACS_INT), | ||
| 342 | const char *name) | 343 | const char *name) |
| 343 | { | 344 | { |
| 344 | CHECK_NUMBER (arg); | 345 | CHECK_NUMBER (arg); |
| @@ -357,8 +358,14 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, | |||
| 357 | { | 358 | { |
| 358 | /* Divide as integers. Converting to double might lose | 359 | /* Divide as integers. Converting to double might lose |
| 359 | info, even for fixnums; also see the FIXME below. */ | 360 | info, even for fixnums; also see the FIXME below. */ |
| 360 | if (EQ (divisor, make_fixnum (0))) | 361 | if (FIXNUMP (divisor)) |
| 361 | xsignal0 (Qarith_error); | 362 | { |
| 363 | if (XFIXNUM (divisor) == 0) | ||
| 364 | xsignal0 (Qarith_error); | ||
| 365 | if (FIXNUMP (arg)) | ||
| 366 | return make_int (fixnum_divide (XFIXNUM (arg), | ||
| 367 | XFIXNUM (divisor))); | ||
| 368 | } | ||
| 362 | int_divide (mpz[0], | 369 | int_divide (mpz[0], |
| 363 | *bignum_integer (&mpz[0], arg), | 370 | *bignum_integer (&mpz[0], arg), |
| 364 | *bignum_integer (&mpz[1], divisor)); | 371 | *bignum_integer (&mpz[1], divisor)); |
| @@ -387,26 +394,47 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, | |||
| 387 | return double_to_bignum (dr); | 394 | return double_to_bignum (dr); |
| 388 | } | 395 | } |
| 389 | 396 | ||
| 390 | static void | 397 | static EMACS_INT |
| 391 | rounddiv_q (mpz_t q, mpz_t const n, mpz_t const d) | 398 | ceiling2 (EMACS_INT n, EMACS_INT d) |
| 392 | { | 399 | { |
| 393 | /* mpz_tdiv_qr gives us one remainder R, but we want the remainder | 400 | return n / d + ((n % d != 0) & ((n < 0) == (d < 0))); |
| 394 | R1 on the other side of 0 if R1 is closer to 0 than R is; because | 401 | } |
| 395 | we want to round to even, we also want R1 if R and R1 are the | ||
| 396 | same distance from 0 and if the quotient is odd. | ||
| 397 | 402 | ||
| 398 | If we were using EMACS_INT arithmetic instead of bignums, | 403 | static EMACS_INT |
| 399 | the following code could look something like this: | 404 | floor2 (EMACS_INT n, EMACS_INT d) |
| 405 | { | ||
| 406 | return n / d - ((n % d != 0) & ((n < 0) != (d < 0))); | ||
| 407 | } | ||
| 400 | 408 | ||
| 401 | q = n / d; | 409 | static EMACS_INT |
| 402 | r = n % d; | 410 | truncate2 (EMACS_INT n, EMACS_INT d) |
| 403 | neg_d = d < 0; | 411 | { |
| 404 | neg_r = r < 0; | 412 | return n / d; |
| 405 | abs_r = eabs (r); | 413 | } |
| 406 | abs_r1 = eabs (d) - abs_r; | ||
| 407 | if (abs_r1 < abs_r + (q & 1)) | ||
| 408 | q += neg_d == neg_r ? 1 : -1; */ | ||
| 409 | 414 | ||
| 415 | static EMACS_INT | ||
| 416 | round2 (EMACS_INT n, EMACS_INT d) | ||
| 417 | { | ||
| 418 | /* The C language's division operator gives us the remainder R | ||
| 419 | corresponding to truncated division, but we want the remainder R1 | ||
| 420 | on the other side of 0 if R1 is closer to 0 than R is; because we | ||
| 421 | want to round to even, we also want R1 if R and R1 are the same | ||
| 422 | distance from 0 and if the truncated quotient is odd. */ | ||
| 423 | EMACS_INT q = n / d; | ||
| 424 | EMACS_INT r = n % d; | ||
| 425 | bool neg_d = d < 0; | ||
| 426 | bool neg_r = r < 0; | ||
| 427 | EMACS_INT abs_r = eabs (r); | ||
| 428 | EMACS_INT abs_r1 = eabs (d) - abs_r; | ||
| 429 | if (abs_r1 < abs_r + (q & 1)) | ||
| 430 | q += neg_d == neg_r ? 1 : -1; | ||
| 431 | return q; | ||
| 432 | } | ||
| 433 | |||
| 434 | static void | ||
| 435 | rounddiv_q (mpz_t q, mpz_t const n, mpz_t const d) | ||
| 436 | { | ||
| 437 | /* Mimic the source code of round2, using mpz_t instead of EMACS_INT. */ | ||
| 410 | mpz_t *r = &mpz[2], *abs_r = r, *abs_r1 = &mpz[3]; | 438 | mpz_t *r = &mpz[2], *abs_r = r, *abs_r1 = &mpz[3]; |
| 411 | mpz_tdiv_qr (q, *r, n, d); | 439 | mpz_tdiv_qr (q, *r, n, d); |
| 412 | bool neg_d = mpz_sgn (d) < 0; | 440 | bool neg_d = mpz_sgn (d) < 0; |
| @@ -446,7 +474,7 @@ This rounds the value towards +inf. | |||
| 446 | With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR. */) | 474 | With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR. */) |
| 447 | (Lisp_Object arg, Lisp_Object divisor) | 475 | (Lisp_Object arg, Lisp_Object divisor) |
| 448 | { | 476 | { |
| 449 | return rounding_driver (arg, divisor, ceil, mpz_cdiv_q, "ceiling"); | 477 | return rounding_driver (arg, divisor, ceil, mpz_cdiv_q, ceiling2, "ceiling"); |
| 450 | } | 478 | } |
| 451 | 479 | ||
| 452 | DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0, | 480 | DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0, |
| @@ -455,7 +483,7 @@ This rounds the value towards -inf. | |||
| 455 | With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. */) | 483 | With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. */) |
| 456 | (Lisp_Object arg, Lisp_Object divisor) | 484 | (Lisp_Object arg, Lisp_Object divisor) |
| 457 | { | 485 | { |
| 458 | return rounding_driver (arg, divisor, floor, mpz_fdiv_q, "floor"); | 486 | return rounding_driver (arg, divisor, floor, mpz_fdiv_q, floor2, "floor"); |
| 459 | } | 487 | } |
| 460 | 488 | ||
| 461 | DEFUN ("round", Fround, Sround, 1, 2, 0, | 489 | DEFUN ("round", Fround, Sround, 1, 2, 0, |
| @@ -468,7 +496,8 @@ your machine. For example, (round 2.5) can return 3 on some | |||
| 468 | systems, but 2 on others. */) | 496 | systems, but 2 on others. */) |
| 469 | (Lisp_Object arg, Lisp_Object divisor) | 497 | (Lisp_Object arg, Lisp_Object divisor) |
| 470 | { | 498 | { |
| 471 | return rounding_driver (arg, divisor, emacs_rint, rounddiv_q, "round"); | 499 | return rounding_driver (arg, divisor, emacs_rint, rounddiv_q, round2, |
| 500 | "round"); | ||
| 472 | } | 501 | } |
| 473 | 502 | ||
| 474 | /* Since rounding_driver truncates anyway, no need to call 'trunc'. */ | 503 | /* Since rounding_driver truncates anyway, no need to call 'trunc'. */ |
| @@ -484,7 +513,8 @@ Rounds ARG toward zero. | |||
| 484 | With optional DIVISOR, truncate ARG/DIVISOR. */) | 513 | With optional DIVISOR, truncate ARG/DIVISOR. */) |
| 485 | (Lisp_Object arg, Lisp_Object divisor) | 514 | (Lisp_Object arg, Lisp_Object divisor) |
| 486 | { | 515 | { |
| 487 | return rounding_driver (arg, divisor, identity, mpz_tdiv_q, "truncate"); | 516 | return rounding_driver (arg, divisor, identity, mpz_tdiv_q, truncate2, |
| 517 | "truncate"); | ||
| 488 | } | 518 | } |
| 489 | 519 | ||
| 490 | 520 | ||