aboutsummaryrefslogtreecommitdiffstats
path: root/src/floatfns.c
diff options
context:
space:
mode:
authorPaul Eggert2018-09-05 00:21:02 -0700
committerPaul Eggert2018-09-05 00:23:49 -0700
commitbaa6ae8724fd4cd7631164a89bf8eed4ff79cfc0 (patch)
treec57f4a6e7a764baee33dbacb5fc58f7ef0269725 /src/floatfns.c
parentccb3891ff5446b578b9306aec0fd9c5ec3ed8e98 (diff)
downloademacs-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.c74
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
339rounding_driver (Lisp_Object arg, Lisp_Object divisor, 339rounding_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
390static void 397static EMACS_INT
391rounddiv_q (mpz_t q, mpz_t const n, mpz_t const d) 398ceiling2 (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, 403static EMACS_INT
399 the following code could look something like this: 404floor2 (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; 409static EMACS_INT
402 r = n % d; 410truncate2 (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
415static EMACS_INT
416round2 (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
434static void
435rounddiv_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.
446With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR. */) 474With 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
452DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0, 480DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0,
@@ -455,7 +483,7 @@ This rounds the value towards -inf.
455With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. */) 483With 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
461DEFUN ("round", Fround, Sround, 1, 2, 0, 489DEFUN ("round", Fround, Sround, 1, 2, 0,
@@ -468,7 +496,8 @@ your machine. For example, (round 2.5) can return 3 on some
468systems, but 2 on others. */) 496systems, 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.
484With optional DIVISOR, truncate ARG/DIVISOR. */) 513With 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