comparison src/floatfns.c @ 16857:bdafa1f28a64

(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.

16856:f838ff9a4d39

    }
  XSETINT (val, value);
  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)
     register Lisp_Object arg, divisor;
{
  CHECK_NUMBER_OR_FLOAT (arg, 0);

  if (! NILP (divisor))
    {
      EMACS_INT i1, i2;

      CHECK_NUMBER_OR_FLOAT (divisor, 1);

#ifdef LISP_FLOAT_TYPE
      if (FLOATP (arg) || FLOATP (divisor))
	{
	  double f1, f2;

	  f1 = FLOATP (arg) ? XFLOAT (arg)->data : XINT (arg);
	  f2 = (FLOATP (divisor) ? XFLOAT (divisor)->data : XINT (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);
	  return arg;
	}
#endif

      i1 = XINT (arg);
      i2 = XINT (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);
      return arg;
    }

#ifdef LISP_FLOAT_TYPE
  if (FLOATP (arg))
    {
      double d;
      IN_FLOAT (d = floor (XFLOAT (arg)->data), "floor", arg);
      FLOAT_TO_INT (d, arg, "floor", arg);
    }
#endif

  return arg;
}

#ifdef LISP_FLOAT_TYPE

Lisp_Object

  /* If the "remainder" comes out with the wrong sign, fix it.  */
  IN_FLOAT2 ((f1 = fmod (f1, f2),
	      f1 = (f2 < 0 ? f1 > 0 : f1 < 0) ? f1 + f2 : f1),
	     "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.  */

DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0,

  defsubr (&Ssqrt);

  defsubr (&Sabs);
  defsubr (&Sfloat);
  defsubr (&Slogb);
  defsubr (&Sceiling);
  defsubr (&Sround);
  defsubr (&Struncate);
#endif /* LISP_FLOAT_TYPE */
  defsubr (&Sfloor);
}

16857:bdafa1f28a64

    }
  XSETINT (val, value);
  return val;
}

#endif /* LISP_FLOAT_TYPE */


/* 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);

  if (! NILP (divisor))
    {
      EMACS_INT i1, i2;

      CHECK_NUMBER_OR_FLOAT (divisor, 1);

#ifdef LISP_FLOAT_TYPE
      if (FLOATP (arg) || FLOATP (divisor))
	{
	  double f1, f2;

	  f1 = FLOATP (arg) ? XFLOAT (arg)->data : XINT (arg);
	  f2 = (FLOATP (divisor) ? XFLOAT (divisor)->data : XINT (divisor));
	  if (! IEEE_FLOATING_POINT && f2 == 0)
	    Fsignal (Qarith_error, Qnil);

	  IN_FLOAT2 (f1 = (*double_round) (f1 / f2), name, arg, divisor);
	  FLOAT_TO_INT2 (f1, arg, name, arg, divisor);
	  return arg;
	}
#endif

      i1 = XINT (arg);
      i2 = XINT (divisor);

      if (i2 == 0)
	Fsignal (Qarith_error, Qnil);

      XSETINT (arg, (*int_round2) (i1, i2));
      return arg;
    }

#ifdef LISP_FLOAT_TYPE
  if (FLOATP (arg))
    {
      double d;

      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

  /* If the "remainder" comes out with the wrong sign, fix it.  */
  IN_FLOAT2 ((f1 = fmod (f1, f2),
	      f1 = (f2 < 0 ? f1 > 0 : f1 < 0) ? f1 + f2 : f1),
	     "mod", x, y);
  return make_float (f1);
}

/* It's not clear these are worth adding.  */

DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0,

  defsubr (&Ssqrt);

  defsubr (&Sabs);
  defsubr (&Sfloat);
  defsubr (&Slogb);
#endif /* LISP_FLOAT_TYPE */
  defsubr (&Sceiling);
  defsubr (&Sfloor);
  defsubr (&Sround);
  defsubr (&Struncate);
}