diff options
Diffstat (limited to 'src/floatfns.c')
| -rw-r--r-- | src/floatfns.c | 67 |
1 files changed, 33 insertions, 34 deletions
diff --git a/src/floatfns.c b/src/floatfns.c index c476627b33b..96711faff62 100644 --- a/src/floatfns.c +++ b/src/floatfns.c | |||
| @@ -36,7 +36,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 36 | isnormal, isunordered, lgamma, log1p, *log2 [via (log X 2)], *logb | 36 | isnormal, isunordered, lgamma, log1p, *log2 [via (log X 2)], *logb |
| 37 | (approximately), lrint/llrint, lround/llround, nan, nearbyint, | 37 | (approximately), lrint/llrint, lround/llround, nan, nearbyint, |
| 38 | nextafter, nexttoward, remainder, remquo, *rint, round, scalbln, | 38 | nextafter, nexttoward, remainder, remquo, *rint, round, scalbln, |
| 39 | scalbn, signbit, tgamma, trunc. | 39 | scalbn, signbit, tgamma, *trunc. |
| 40 | */ | 40 | */ |
| 41 | 41 | ||
| 42 | #include <config.h> | 42 | #include <config.h> |
| @@ -333,47 +333,42 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, | |||
| 333 | { | 333 | { |
| 334 | CHECK_NUMBER_OR_FLOAT (arg); | 334 | CHECK_NUMBER_OR_FLOAT (arg); |
| 335 | 335 | ||
| 336 | if (! NILP (divisor)) | 336 | double d; |
| 337 | if (NILP (divisor)) | ||
| 338 | { | ||
| 339 | if (! FLOATP (arg)) | ||
| 340 | return arg; | ||
| 341 | d = XFLOAT_DATA (arg); | ||
| 342 | } | ||
| 343 | else | ||
| 337 | { | 344 | { |
| 338 | EMACS_INT i1, i2; | ||
| 339 | |||
| 340 | CHECK_NUMBER_OR_FLOAT (divisor); | 345 | CHECK_NUMBER_OR_FLOAT (divisor); |
| 341 | 346 | if (!FLOATP (arg) && !FLOATP (divisor)) | |
| 342 | if (FLOATP (arg) || FLOATP (divisor)) | ||
| 343 | { | 347 | { |
| 344 | double f1, f2; | 348 | if (XINT (divisor) == 0) |
| 345 | |||
| 346 | f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XINT (arg); | ||
| 347 | f2 = (FLOATP (divisor) ? XFLOAT_DATA (divisor) : XINT (divisor)); | ||
| 348 | if (! IEEE_FLOATING_POINT && f2 == 0) | ||
| 349 | xsignal0 (Qarith_error); | 349 | xsignal0 (Qarith_error); |
| 350 | 350 | return make_number (int_round2 (XINT (arg), XINT (divisor))); | |
| 351 | f1 = (*double_round) (f1 / f2); | ||
| 352 | if (FIXNUM_OVERFLOW_P (f1)) | ||
| 353 | xsignal3 (Qrange_error, build_string (name), arg, divisor); | ||
| 354 | arg = make_number (f1); | ||
| 355 | return arg; | ||
| 356 | } | 351 | } |
| 357 | 352 | ||
| 358 | i1 = XINT (arg); | 353 | double f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XINT (arg); |
| 359 | i2 = XINT (divisor); | 354 | double f2 = FLOATP (divisor) ? XFLOAT_DATA (divisor) : XINT (divisor); |
| 360 | 355 | if (! IEEE_FLOATING_POINT && f2 == 0) | |
| 361 | if (i2 == 0) | ||
| 362 | xsignal0 (Qarith_error); | 356 | xsignal0 (Qarith_error); |
| 363 | 357 | d = f1 / f2; | |
| 364 | XSETINT (arg, (*int_round2) (i1, i2)); | ||
| 365 | return arg; | ||
| 366 | } | 358 | } |
| 367 | 359 | ||
| 368 | if (FLOATP (arg)) | 360 | /* Round, coarsely test for fixnum overflow before converting to |
| 361 | EMACS_INT (to avoid undefined C behavior), and then exactly test | ||
| 362 | for overflow after converting (as FIXNUM_OVERFLOW_P is inaccurate | ||
| 363 | on floats). */ | ||
| 364 | double dr = double_round (d); | ||
| 365 | if (fabs (dr) < 2 * (MOST_POSITIVE_FIXNUM + 1)) | ||
| 369 | { | 366 | { |
| 370 | double d = (*double_round) (XFLOAT_DATA (arg)); | 367 | EMACS_INT ir = dr; |
| 371 | if (FIXNUM_OVERFLOW_P (d)) | 368 | if (! FIXNUM_OVERFLOW_P (ir)) |
| 372 | xsignal2 (Qrange_error, build_string (name), arg); | 369 | return make_number (ir); |
| 373 | arg = make_number (d); | ||
| 374 | } | 370 | } |
| 375 | 371 | xsignal2 (Qrange_error, build_string (name), arg); | |
| 376 | return arg; | ||
| 377 | } | 372 | } |
| 378 | 373 | ||
| 379 | static EMACS_INT | 374 | static EMACS_INT |
| @@ -423,11 +418,15 @@ emacs_rint (double d) | |||
| 423 | } | 418 | } |
| 424 | #endif | 419 | #endif |
| 425 | 420 | ||
| 421 | #ifdef HAVE_TRUNC | ||
| 422 | #define emacs_trunc trunc | ||
| 423 | #else | ||
| 426 | static double | 424 | static double |
| 427 | double_identity (double d) | 425 | emacs_trunc (double d) |
| 428 | { | 426 | { |
| 429 | return d; | 427 | return (d < 0 ? ceil : floor) (d); |
| 430 | } | 428 | } |
| 429 | #endif | ||
| 431 | 430 | ||
| 432 | DEFUN ("ceiling", Fceiling, Sceiling, 1, 2, 0, | 431 | DEFUN ("ceiling", Fceiling, Sceiling, 1, 2, 0, |
| 433 | doc: /* Return the smallest integer no less than ARG. | 432 | doc: /* Return the smallest integer no less than ARG. |
| @@ -466,7 +465,7 @@ Rounds ARG toward zero. | |||
| 466 | With optional DIVISOR, truncate ARG/DIVISOR. */) | 465 | With optional DIVISOR, truncate ARG/DIVISOR. */) |
| 467 | (Lisp_Object arg, Lisp_Object divisor) | 466 | (Lisp_Object arg, Lisp_Object divisor) |
| 468 | { | 467 | { |
| 469 | return rounding_driver (arg, divisor, double_identity, truncate2, | 468 | return rounding_driver (arg, divisor, emacs_trunc, truncate2, |
| 470 | "truncate"); | 469 | "truncate"); |
| 471 | } | 470 | } |
| 472 | 471 | ||