aboutsummaryrefslogtreecommitdiffstats
path: root/src/floatfns.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/floatfns.c')
-rw-r--r--src/floatfns.c67
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
379static EMACS_INT 374static 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
426static double 424static double
427double_identity (double d) 425emacs_trunc (double d)
428{ 426{
429 return d; 427 return (d < 0 ? ceil : floor) (d);
430} 428}
429#endif
431 430
432DEFUN ("ceiling", Fceiling, Sceiling, 1, 2, 0, 431DEFUN ("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.
466With optional DIVISOR, truncate ARG/DIVISOR. */) 465With 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