From acbbacbe534d4b537ab6ecc242e4f0edd681fe7f Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 11 Jan 1997 17:44:06 +0000 Subject: [PATCH] (rounding_driver): New function for systematic support of 2-argument rounding functions, so that `floor' isn't the only one that supports 2 arguments. (Fceiling, Ffloor, Fround, Ftruncate): Use it. (ceiling2, floor2, round2, truncate2, double_identity): New functions. (syms_of_floatfns): Define ceiling, round, and truncate even if LISP_FLOAT_TYPE is not defined. --- src/floatfns.c | 182 +++++++++++++++++++++++++++++-------------------- 1 file changed, 107 insertions(+), 75 deletions(-) diff --git a/src/floatfns.c b/src/floatfns.c index 452bdc2ea54..1518006c5b2 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -722,34 +722,17 @@ This is the same as the exponent of a float.") return val; } -/* the rounding functions */ - -DEFUN ("ceiling", Fceiling, Sceiling, 1, 1, 0, - "Return the smallest integer no less than ARG. (Round toward +inf.)") - (arg) - register Lisp_Object arg; -{ - CHECK_NUMBER_OR_FLOAT (arg, 0); - - if (FLOATP (arg)) - { - double d; - - IN_FLOAT (d = ceil (XFLOAT (arg)->data), "ceiling", arg); - FLOAT_TO_INT (d, arg, "ceiling", arg); - } - - return arg; -} - #endif /* LISP_FLOAT_TYPE */ -DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0, - "Return the largest integer no greater than ARG. (Round towards -inf.)\n\ -With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR.") - (arg, divisor) +/* the rounding functions */ + +static Lisp_Object +rounding_driver (arg, divisor, double_round, int_round2, name) register Lisp_Object arg, divisor; + double (*double_round) (); + EMACS_INT (*int_round2) (); + char *name; { CHECK_NUMBER_OR_FLOAT (arg, 0); @@ -769,8 +752,8 @@ With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR.") if (! IEEE_FLOATING_POINT && f2 == 0) Fsignal (Qarith_error, Qnil); - IN_FLOAT2 (f1 = floor (f1 / f2), "floor", arg, divisor); - FLOAT_TO_INT2 (f1, arg, "floor", arg, divisor); + IN_FLOAT2 (f1 = (*double_round) (f1 / f2), name, arg, divisor); + FLOAT_TO_INT2 (f1, arg, name, arg, divisor); return arg; } #endif @@ -781,13 +764,7 @@ With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR.") if (i2 == 0) Fsignal (Qarith_error, Qnil); - /* With C's /, the result is implementation-defined if either operand - is negative, so use only nonnegative operands. */ - i1 = (i2 < 0 - ? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2)) - : (i1 < 0 ? -1 - ((-1 - i1) / i2) : i1 / i2)); - - XSETINT (arg, i1); + XSETINT (arg, (*int_round2) (i1, i2)); return arg; } @@ -795,14 +772,107 @@ With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR.") if (FLOATP (arg)) { double d; - IN_FLOAT (d = floor (XFLOAT (arg)->data), "floor", arg); - FLOAT_TO_INT (d, arg, "floor", arg); + + IN_FLOAT (d = (*double_round) (XFLOAT (arg)->data), name, arg); + FLOAT_TO_INT (d, arg, name, arg); } #endif return arg; } +/* With C's /, the result is implementation-defined if either operand + is negative, so take care with negative operands in the following + integer functions. */ + +static EMACS_INT +ceiling2 (i1, i2) + EMACS_INT i1, i2; +{ + return (i2 < 0 + ? (i1 < 0 ? ((-1 - i1) / -i2) + 1 : - (i1 / -i2)) + : (i1 <= 0 ? - (-i1 / i2) : ((i1 - 1) / i2) + 1)); +} + +static EMACS_INT +floor2 (i1, i2) + EMACS_INT i1, i2; +{ + return (i2 < 0 + ? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2)) + : (i1 < 0 ? -1 - ((-1 - i1) / i2) : i1 / i2)); +} + +static EMACS_INT +truncate2 (i1, i2) + EMACS_INT i1, i2; +{ + return (i2 < 0 + ? (i1 < 0 ? -i1 / -i2 : - (i1 / -i2)) + : (i1 < 0 ? - (-i1 / i2) : i1 / i2)); +} + +static EMACS_INT +round2 (i1, i2) + EMACS_INT i1, i2; +{ + /* The C language's division operator gives us one remainder R, but + we want the remainder R1 on the other side of 0 if R1 is closer + to 0 than R is; because we want to round to even, we also want R1 + if R and R1 are the same distance from 0 and if C's quotient is + odd. */ + EMACS_INT q = i1 / i2; + EMACS_INT r = i1 % i2; + EMACS_INT abs_r = r < 0 ? -r : r; + EMACS_INT abs_r1 = (i2 < 0 ? -i2 : i2) - abs_r; + return q + (abs_r + (q & 1) <= abs_r1 ? 0 : (i2 ^ r) < 0 ? -1 : 1); +} + +static double +double_identity (d) + double d; +{ + return d; +} + +DEFUN ("ceiling", Fceiling, Sceiling, 1, 2, 0, + "Return the smallest integer no less than ARG. (Round toward +inf.)\n\ +With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR.") + (arg, divisor) + Lisp_Object arg, divisor; +{ + return rounding_driver (arg, divisor, ceil, ceiling2, "ceiling"); +} + +DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0, + "Return the largest integer no greater than ARG. (Round towards -inf.)\n\ +With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR.") + (arg, divisor) + Lisp_Object arg, divisor; +{ + return rounding_driver (arg, divisor, floor, floor2, "floor"); +} + +DEFUN ("round", Fround, Sround, 1, 2, 0, + "Return the nearest integer to ARG.\n\ +With optional DIVISOR, return the nearest integer to ARG/DIVISOR.") + (arg, divisor) + Lisp_Object arg, divisor; +{ + return rounding_driver (arg, divisor, rint, round2, "round"); +} + +DEFUN ("truncate", Ftruncate, Struncate, 1, 2, 0, + "Truncate a floating point number to an int.\n\ +Rounds ARG toward zero.\n\ +With optional DIVISOR, truncate ARG/DIVISOR.") + (arg, divisor) + Lisp_Object arg, divisor; +{ + return rounding_driver (arg, divisor, double_identity, truncate2, + "truncate"); +} + #ifdef LISP_FLOAT_TYPE Lisp_Object @@ -823,44 +893,6 @@ fmod_float (x, y) "mod", x, y); return make_float (f1); } - -DEFUN ("round", Fround, Sround, 1, 1, 0, - "Return the nearest integer to ARG.") - (arg) - register Lisp_Object arg; -{ - CHECK_NUMBER_OR_FLOAT (arg, 0); - - if (FLOATP (arg)) - { - double d; - - /* Screw the prevailing rounding mode. */ - IN_FLOAT (d = rint (XFLOAT (arg)->data), "round", arg); - FLOAT_TO_INT (d, arg, "round", arg); - } - - return arg; -} - -DEFUN ("truncate", Ftruncate, Struncate, 1, 1, 0, - "Truncate a floating point number to an int.\n\ -Rounds the value toward zero.") - (arg) - register Lisp_Object arg; -{ - CHECK_NUMBER_OR_FLOAT (arg, 0); - - if (FLOATP (arg)) - { - double d; - - d = XFLOAT (arg)->data; - FLOAT_TO_INT (d, arg, "truncate", arg); - } - - return arg; -} /* It's not clear these are worth adding. */ @@ -1024,9 +1056,9 @@ syms_of_floatfns () defsubr (&Sabs); defsubr (&Sfloat); defsubr (&Slogb); +#endif /* LISP_FLOAT_TYPE */ defsubr (&Sceiling); + defsubr (&Sfloor); defsubr (&Sround); defsubr (&Struncate); -#endif /* LISP_FLOAT_TYPE */ - defsubr (&Sfloor); } -- 2.39.2