martin/emacs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

(rounding_driver): New function for systematic support of

Browse Source 
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.
This commit is contained in:
Paul Eggert
1997-01-11 17:44:06 +00:00
parent ec3bbd7d6b
commit acbbacbe53
1 changed files with 107 additions and 75 deletions
Download Patch File Download Diff File Expand all files Collapse all files

182
src/floatfns.c
View File

@@ -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);
}