diff src/floatfns.c @ 4678:b5e1d4f6b66f

Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp. lisp/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (ceiling*, floor*, round*, truncate*): Implement these in terms of the C functions; mark them as obsolete. (mod*, rem*): Use #'nth-value with the C functions, not #'nth with the CL emulation functions. man/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * lispref/numbers.texi (Bigfloat Basics): Correct this documentation (ignoring for the moment that it breaks off in mid-sentence). tests/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Test the new Common Lisp-compatible rounding functions available in C. (generate-rounding-output): Provide a function useful for generating the data for the rounding functions tests. src/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * floatfns.c (ROUNDING_CONVERT, CONVERT_WITH_NUMBER_TYPES) (CONVERT_WITHOUT_NUMBER_TYPES, MAYBE_TWO_ARGS_BIGNUM) (MAYBE_ONE_ARG_BIGNUM, MAYBE_TWO_ARGS_RATIO) (MAYBE_ONE_ARG_RATIO, MAYBE_TWO_ARGS_BIGFLOAT) (MAYBE_ONE_ARG_BIGFLOAT, MAYBE_EFF, MAYBE_CHAR_OR_MARKER): New macros, used in the implementation of the rounding functions. (ceiling_two_fixnum, ceiling_two_bignum, ceiling_two_ratio) (ceiling_two_bigfloat, ceiling_one_ratio, ceiling_one_bigfloat) (ceiling_two_float, ceiling_one_float, ceiling_one_mundane_arg) (floor_two_fixnum, floor_two_bignum, floor_two_ratio) (floor_two_bigfloat, floor_one_ratio, floor_one_bigfloat) (floor_two_float, floor_one_mundane_arg, round_two_fixnum) (round_two_bignum_1, round_two_bignum, round_two_ratio) (round_one_bigfloat_1, round_two_bigfloat, round_one_ratio) (round_one_bigfloat, round_two_float, round_one_float) (round_one_mundane_arg, truncate_two_fixnum) (truncate_two_bignum, truncate_two_ratio, truncate_two_bigfloat) (truncate_one_ratio, truncate_one_bigfloat, truncate_two_float) (truncate_one_float, truncate_one_mundane_arg): New functions, used in the implementation of the rounding functions. (Fceiling, Ffloor, Fround, Ftruncate, Ffceiling, Fffloor) (Ffround, Fftruncate): Revise to fully support Common Lisp conventions. This means: -- All functions have optional DIVISOR arguments -- All functions return multiple values; see #'values -- All functions do their arithmetic with the correct number types according to the contamination rules. -- #'round and #'fround always round towards the even number in ambiguous cases. * doprnt.c (emacs_doprnt_1): * number.c (internal_coerce_number): Call Ftruncate with two arguments, not one. * floatfns.c (Ffloat): Correct this, if NUMBER is a bignum. * lisp.h: Declare Ftruncate as taking two arguments. * number.c: Provide scratch_ratio2, init it appropriately. * number.h: Make scratch_ratio2 available. * number.h (BIGFLOAT_ARITH_RETURN): * number.h (BIGFLOAT_ARITH_RETURN1): Correct these functions.
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 11 Aug 2009 17:59:23 +0100
parents 04bc9d2f42c7
children fcc7e89d5e68
line wrap: on
line diff
--- a/src/floatfns.c	Sun Aug 16 20:55:49 2009 +0100
+++ b/src/floatfns.c	Tue Aug 11 17:59:23 2009 +0100
@@ -769,7 +769,7 @@
     return make_float ((double) XINT (number));
 
 #ifdef HAVE_BIGNUM
-  if (BIGFLOATP (number))
+  if (BIGNUMP (number))
     {
 #ifdef HAVE_BIGFLOAT
       if (ZEROP (Vdefault_float_precision))
@@ -848,347 +848,1602 @@
 #endif /* ! HAVE_LOGB */
 }
 
-DEFUN ("ceiling", Fceiling, 1, 1, 0, /*
-Return the smallest integer no less than NUMBER.  (Round toward +inf.)
-*/
-       (number))
+#ifdef WITH_NUMBER_TYPES
+#define ROUNDING_CONVERT(conversion, return_float)      \
+  CONVERT_WITH_NUMBER_TYPES(conversion, return_float)
+#else
+#define ROUNDING_CONVERT(conversion, return_float)      \
+  CONVERT_WITHOUT_NUMBER_TYPES(conversion, return_float)
+#endif
+
+#define CONVERT_WITH_NUMBER_TYPES(conversion, return_float)     \
+  if (!NILP (divisor))                                          \
+    {                                                           \
+      switch (promote_args (&number, &divisor))                 \
+        {                                                       \
+        case FIXNUM_T:                                          \
+          return conversion##_two_fixnum (number, divisor,      \
+                                          return_float);        \
+          MAYBE_TWO_ARGS_WITH_NUMBER_TYPES (conversion,         \
+                                            BIGNUM,             \
+                                            return_float);      \
+          MAYBE_TWO_ARGS_WITH_NUMBER_TYPES (conversion,         \
+                                            RATIO,              \
+                                            return_float);      \
+          MAYBE_TWO_ARGS_WITH_NUMBER_TYPES (conversion,         \
+                                            BIGFLOAT,           \
+                                            return_float);      \
+          default: /* FLOAT_T */                                \
+            return conversion##_two_float (number,divisor,      \
+                                           return_float);       \
+        }                                                       \
+     }                                                          \
+                                                                \
+  /* Try this first, the arg is probably a float:  */           \
+  if (FLOATP (number))                                          \
+    return conversion##_one_float (number, return_float);       \
+                                                                \
+  MAYBE_ONE_ARG_WITH_NUMBER_TYPES (conversion,                  \
+                                   RATIO, return_float);        \
+  MAYBE_ONE_ARG_WITH_NUMBER_TYPES (conversion,                  \
+                                   BIGFLOAT, return_float);     \
+  return conversion##_one_mundane_arg (number, divisor,         \
+                                       return_float)
+      
+
+#define CONVERT_WITHOUT_NUMBER_TYPES(conversion, return_float)  \
+  if (!NILP (divisor))						\
+    {                                                           \
+      /* The promote_args call if number types are available    \
+         does these conversions, we do them too for symmetry: */\
+      if (CHARP (number))                                       \
+        {                                                       \
+          number = make_int (XCHAR (number));                   \
+        }                                                       \
+      else if (MARKERP (number))				\
+        {                                                       \
+          number = make_int (marker_position (number));         \
+        }                                                       \
+                                                                \
+      if (CHARP (divisor))                                      \
+        {                                                       \
+          divisor = make_int (XCHAR (divisor));                 \
+        }                                                       \
+      else if (MARKERP (divisor))				\
+        {                                                       \
+          divisor = make_int (marker_position (divisor));       \
+        }                                                       \
+                                                                \
+      CHECK_INT_OR_FLOAT (divisor);                             \
+      if (INTP (number) && INTP (divisor))                      \
+        {                                                       \
+          return conversion##_two_fixnum (number, divisor,      \
+                                        return_float);          \
+        }                                                       \
+      else                                                      \
+        {                                                       \
+          return conversion##_two_float (number, divisor,       \
+                                           return_float);       \
+        }                                                       \
+    }                                                           \
+                                                                \
+  /* Try this first, the arg is probably a float:  */           \
+  if (FLOATP (number))                                          \
+    return conversion##_one_float (number, return_float);       \
+                                                                \
+  return conversion##_one_mundane_arg (number, divisor,		\
+				       return_float)		\
+
+#ifdef WITH_NUMBER_TYPES
+
+#ifdef HAVE_BIGNUM
+#define MAYBE_TWO_ARGS_BIGNUM(conversion, return_float)               \
+  case BIGNUM_T:                                                      \
+  return conversion##_two_bignum (number, divisor, return_float)
+
+#define MAYBE_ONE_ARG_BIGNUM(converse, return_float)                \
+  if (BIGNUM_P (number))                                            \
+    return conversion##_one_bignum (number, divisor, return_float) 
+#else
+#define MAYBE_TWO_ARGS_BIGNUM(conversion, return_float)
+#define MAYBE_ONE_ARG_BIGNUM(converse, return_float) 
+#endif
+
+#ifdef HAVE_RATIO 
+#define MAYBE_TWO_ARGS_RATIO(conversion, return_float)          \
+  case RATIO_T:                                                 \
+  return conversion##_two_ratio (number, divisor, return_float)
+
+#define MAYBE_ONE_ARG_RATIO(conversion, return_float)               \
+  if (RATIOP (number))                                              \
+    return conversion##_one_ratio (number, divisor, return_float) 
+#else
+#define MAYBE_TWO_ARGS_RATIO(conversion, return_float)
+#define MAYBE_ONE_ARG_RATIO(converse, return_float) 
+#endif
+
+#ifdef HAVE_BIGFLOAT
+#define MAYBE_TWO_ARGS_BIGFLOAT(conversion, return_float)           \
+  case BIGFLOAT_T:                                                  \
+  return conversion##_two_bigfloat (number, divisor, return_float)
+
+#define MAYBE_ONE_ARG_BIGFLOAT(conversion, return_float)            \
+  if (BIGFLOATP (number))                                           \
+    return conversion##_one_bigfloat (number, divisor, return_float) 
+#else
+#define MAYBE_TWO_ARGS_BIGFLOAT(conversion, return_float)
+#define MAYBE_ONE_ARG_BIGFLOAT(converse, return_float) 
+#endif
+
+#define MAYBE_TWO_ARGS_WITH_NUMBER_TYPES(convers, upcase, return_float) \
+  MAYBE_TWO_ARGS_##upcase(convers, return_float)
+
+#define MAYBE_ONE_ARG_WITH_NUMBER_TYPES(convers, upcase, return_float) \
+  MAYBE_ONE_ARG_##upcase(convers, return_float)
+
+#endif /* WITH_NUMBER_TYPES */
+
+#define MAYBE_EFF(str) (return_float ? "f" str : str)
+
+/* The WITH_NUMBER_TYPES code calls promote_args, which accepts chars and
+   markers as equivalent to ints. This block does the same for
+   single-argument calls. */
+#define MAYBE_CHAR_OR_MARKER(conversion) do {                           \
+  if (CHARP (number))                                                   \
+    {                                                                   \
+      return conversion##_one_mundane_arg (make_int (XCHAR (number)),   \
+                                           divisor, return_float);      \
+    }                                                                   \
+                                                                        \
+  if (MARKERP (number))                                                 \
+    {                                                                   \
+      return conversion##_one_mundane_arg (make_int                     \
+                                           (marker_position(number)),   \
+                                           divisor, return_float);      \
+    }                                                                   \
+  } while (0)
+
+
+/* The guts of the implementations of the various rounding functions: */
+
+static Lisp_Object
+ceiling_two_fixnum (Lisp_Object number, Lisp_Object divisor,
+		    int return_float)
 {
-  if (FLOATP (number))
+  EMACS_INT i1 = XREALINT (number);
+  EMACS_INT i2 = XREALINT (divisor);
+  EMACS_INT i3 = 0, i4 = 0;
+
+  if (i2 == 0)
+    Fsignal (Qarith_error, Qnil);
+
+  /* With C89's integer /, the result is implementation-defined if either
+     operand is negative, so use only nonnegative operands. Here we do
+     basically the opposite of what floor_two_fixnum does, we add one in the
+     non-negative case: */
+
+  /* Make sure we use the same signs for the modulus calculation as for the
+     quotient calculation: */
+  if (i2 < 0)
+    {
+      if (i1 <= 0)
+	{
+	  i3 = -i1 / -i2;
+	  /* Quotient is positive; add one to give the figure for
+	     ceiling. */
+	  if (0 != (-i1 % -i2))
+	    {
+	      ++i3;
+	    }
+	}
+      else
+	{
+	  /* Quotient is negative; no need to add one. */
+	  i3 = -(i1 / -i2);
+	}
+    }
+  else
+    {
+      if (i1 < 0)
+	{
+	  /* Quotient is negative; no need to add one. */
+	  i3 = -(-i1 / i2);
+	}
+      else
+	{
+	  i3 = i1 / i2;
+	  /* Quotient is positive; add one to give the figure for
+	     ceiling. */
+	  if (0 != (i1 % i2))
+	    {
+	      ++i3;
+	    }
+	}
+    }
+
+  i4 = i1 - (i3 * i2);
+
+  if (!return_float)
+    {
+      return values2 (make_int (i3), make_int (i4));
+    }
+
+  return values2 (make_float ((double)i3),
+		  make_int (i4));
+}
+
+#ifdef HAVE_BIGNUM
+static Lisp_Object
+ceiling_two_bignum (Lisp_Object number, Lisp_Object divisor,
+		    int return_float)
+{
+  Lisp_Object res0, res1;
+
+  if (bignum_sign (XBIGNUM_DATA (divisor)) == 0)
+    {
+      Fsignal (Qarith_error, Qnil);
+    }
+
+  bignum_ceil (scratch_bignum, XBIGNUM_DATA (number), XBIGNUM_DATA (divisor));
+
+  res0 = return_float ? make_float (bignum_to_double (scratch_bignum)) :
+	  Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+
+  if (bignum_divisible_p (XBIGNUM_DATA (number), XBIGNUM_DATA (divisor)))
+    {
+      res1 = Qzero;
+    }
+  else
     {
-      double d;
-      IN_FLOAT ((d = ceil (XFLOAT_DATA (number))), "ceiling", number);
-      return (float_to_int (d, "ceiling", number, Qunbound));
+      bignum_mul (scratch_bignum, scratch_bignum, XBIGNUM_DATA (divisor));
+      bignum_sub (scratch_bignum, XBIGNUM_DATA (number), scratch_bignum);
+      res1 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+    }
+
+  return values2 (res0, res1);
+}
+#endif /* HAVE_BIGNUM */
+
+#ifdef HAVE_RATIO
+static Lisp_Object
+ceiling_two_ratio (Lisp_Object number, Lisp_Object divisor,
+		   int return_float)
+{
+  Lisp_Object res0, res1;
+
+  if (ratio_sign (XRATIO_DATA (divisor)) == 0)
+    {
+      Fsignal (Qarith_error, Qnil);
+    }
+
+  ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor));
+
+  bignum_ceil (scratch_bignum, ratio_numerator (scratch_ratio),
+	       ratio_denominator (scratch_ratio));
+
+  res0 = return_float ? make_float (bignum_to_double (scratch_bignum)) :
+	  Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+
+  if (bignum_divisible_p (ratio_numerator (scratch_ratio),
+			  ratio_denominator (scratch_ratio)))
+    {
+      res1 = Qzero;
+    }
+  else
+    {
+      ratio_set_bignum (scratch_ratio, scratch_bignum);
+      ratio_mul (scratch_ratio2, scratch_ratio, XRATIO_DATA (divisor));
+      ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio2);
+      res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio));
+    }
+
+  return values2 (res0, res1);
+}
+#endif /* HAVE_RATIO */
+
+#ifdef HAVE_BIGFLOAT
+static Lisp_Object
+ceiling_two_bigfloat (Lisp_Object number, Lisp_Object divisor,
+		      int return_float)
+{
+  Lisp_Object res0;
+
+  if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0)
+    {
+      Fsignal (Qarith_error, Qnil);
+    }
+
+  bigfloat_set_prec (scratch_bigfloat, max (XBIGFLOAT_GET_PREC (number),
+					    XBIGFLOAT_GET_PREC (divisor)));
+  bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (number),
+		XBIGFLOAT_DATA (divisor));
+  bigfloat_ceil (scratch_bigfloat, scratch_bigfloat);
+
+  if (return_float)
+    {
+      res0 = make_bigfloat_bf (scratch_bigfloat);
+    }
+  else
+    {
+#ifdef HAVE_BIGNUM
+      bignum_set_bigfloat (scratch_bignum, scratch_bigfloat);
+      res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+#else
+      res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
+#endif /* HAVE_BIGNUM */
+    }
+
+  bigfloat_mul (scratch_bigfloat, scratch_bigfloat, XBIGFLOAT_DATA (divisor));
+  bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number), scratch_bigfloat);
+  return values2 (res0,
+		  Fcanonicalize_number (make_bigfloat_bf (scratch_bigfloat)));
+}
+#endif /* HAVE_BIGFLOAT */
+
+#ifdef HAVE_RATIO
+static Lisp_Object
+ceiling_one_ratio (Lisp_Object number, Lisp_Object UNUSED (divisor),
+		   int return_float)
+{
+  Lisp_Object res0, res1;
+
+  bignum_ceil (scratch_bignum, XRATIO_NUMERATOR (number),
+	       XRATIO_DENOMINATOR (number));
+
+  res0 = return_float ? make_float (bignum_to_double (scratch_bignum)) :
+	  Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+
+  if (bignum_divisible_p (XRATIO_NUMERATOR (number),
+			  XRATIO_DENOMINATOR (number)))
+    {
+      res1 = Qzero;
+    }
+  else
+    {
+      ratio_set_bignum (scratch_ratio2, scratch_bignum);
+      ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio2);
+      res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio));
     }
 
+  return values2 (res0, res1);
+}
+#endif /* HAVE_RATIO */
+
+#ifdef HAVE_BIGFLOAT
+static Lisp_Object
+ceiling_one_bigfloat (Lisp_Object number, Lisp_Object UNUSED (divisor),
+		      int return_float)
+{
+  Lisp_Object res0, res1;
+
+  bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number));
+  bigfloat_ceil (scratch_bigfloat, XBIGFLOAT_DATA (number));
+
+  if (return_float)
+    {
+      res0 = make_bigfloat_bf (scratch_bigfloat);
+    }
+  else
+    {
+#ifdef HAVE_BIGNUM
+      bignum_set_bigfloat (scratch_bignum, scratch_bigfloat);
+      res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+#else
+      res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
+#endif /* HAVE_BIGNUM */
+    }
+
+  bigfloat_sub (scratch_bigfloat2, XBIGFLOAT_DATA (number), scratch_bigfloat);
+
+  res1 = make_bigfloat_bf (scratch_bigfloat2);
+  return values2 (res0, res1);
+}
+#endif /* HAVE_BIGFLOAT */
+
+static Lisp_Object
+ceiling_two_float (Lisp_Object number, Lisp_Object divisor,
+		   int return_float)
+{
+  double f1 = extract_float (number);
+  double f2 = extract_float (divisor);
+  double f0, remain;
+  Lisp_Object res0;
+	    
+  if (f2 == 0.0)
+    {
+      Fsignal (Qarith_error, Qnil);
+    }
+	    
+  IN_FLOAT2 (f0 = ceil (f1 / f2), MAYBE_EFF("ceiling"), number, divisor);
+  IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF("ceiling"), number, divisor);
+
+  if (return_float)
+    {
+      res0 = make_float(f0);
+    }
+  else
+    {
+      res0 = float_to_int (f0, MAYBE_EFF("ceiling"), number, divisor);
+    }
+
+  return values2 (res0, make_float (remain));
+}
+
+static Lisp_Object
+ceiling_one_float (Lisp_Object number, int return_float)
+{
+  double d, remain;
+  Lisp_Object res0;
+
+  IN_FLOAT ((d = ceil (XFLOAT_DATA (number))), MAYBE_EFF("ceiling"), number);
+  IN_FLOAT ((remain = XFLOAT_DATA (number) - d), MAYBE_EFF("ceiling"), number);
+
+  if (return_float)
+    {
+      res0 = make_float (d);
+    }
+  else
+    {
+      res0 = float_to_int (d, MAYBE_EFF("ceiling"), number, Qunbound);
+    }
+  return values2 (res0, make_float (remain));
+}
+
+EXFUN (Fceiling, 2);
+EXFUN (Ffceiling, 2);
+
+static Lisp_Object
+ceiling_one_mundane_arg (Lisp_Object number, Lisp_Object divisor,
+			 int return_float)
+{
+
+  if (return_float)
+    {
+      if (INTP (number))
+	{
+	  return values2 (make_float ((double) XINT (number)), Qzero);
+	}
+#ifdef HAVE_BIGNUM
+      else if (BIGNUMP (number))
+	{
+	  return values2 (make_float 
+			  (bignum_to_double (XBIGNUM_DATA (number))),
+			  Qzero);
+	}
+#endif
+    }
+  else
+    {
+#ifdef HAVE_BIGNUM
+      if (INTEGERP (number))
+#else
+      if (INTP (number))
+#endif
+	{
+	  return values2 (number, Qzero);
+	}
+    }
+  
+  MAYBE_CHAR_OR_MARKER (ceiling);
+
+  return Ffceiling (wrong_type_argument (Qnumberp, number), divisor);
+}
+
+static Lisp_Object
+floor_two_fixnum (Lisp_Object number, Lisp_Object divisor,
+		  int return_float)
+{
+  EMACS_INT i1 = XREALINT (number);
+  EMACS_INT i2 = XREALINT (divisor);
+  EMACS_INT i3 = 0, i4 = 0;
+  Lisp_Object res0;
+
+  if (i2 == 0)
+    {
+      Fsignal (Qarith_error, Qnil);
+    }
+
+  /* With C89's integer /, the result is implementation-defined if either
+     operand is negative, so use only nonnegative operands. Notice also that
+     we're forcing the quotient of any negative numbers towards minus
+     infinity. */
+  i3 = (i2 < 0
+	? (i1 <= 0  ?  -i1 / -i2  :  -1 - ((i1 - 1) / -i2))
+	: (i1 < 0  ?  -1 - ((-1 - i1) / i2)  :  i1 / i2));
+
+  i4 = i1 - (i3 * i2);
+
+  if (return_float)
+    {
+      res0 = make_float ((double)i3);
+    }
+  else
+    {
+      res0 = make_int (i3);
+    }
+
+  return values2 (res0, make_int (i4));
+}
+
+#ifdef HAVE_BIGNUM
+static Lisp_Object
+floor_two_bignum (Lisp_Object number, Lisp_Object divisor,
+		  int return_float)
+{
+  Lisp_Object res0, res1;
+
+  if (bignum_sign (XBIGNUM_DATA (divisor)) == 0)
+    {
+      Fsignal (Qarith_error, Qnil);
+    }
+
+  bignum_floor (scratch_bignum, XBIGNUM_DATA (number),
+		XBIGNUM_DATA (divisor));
+
+  if (return_float)
+    {
+      res0 = make_float (bignum_to_double (scratch_bignum));
+    }
+  else
+    {
+      res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+    }
+
+  if (bignum_divisible_p (XBIGNUM_DATA (number), XBIGNUM_DATA (divisor)))
+    {
+      res1 = Qzero;
+    }
+  else
+    {
+      bignum_mul (scratch_bignum, scratch_bignum, XBIGNUM_DATA (divisor));
+      bignum_sub (scratch_bignum, XBIGNUM_DATA (number), scratch_bignum);
+      res1 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+    }
+
+  return values2 (res0, res1);
+}
+#endif /* HAVE_BIGNUM */
+
+#ifdef HAVE_RATIO
+static Lisp_Object
+floor_two_ratio (Lisp_Object number, Lisp_Object divisor,
+		 int return_float)
+{
+  Lisp_Object res0, res1;
+
+  if (ratio_sign (XRATIO_DATA (divisor)) == 0)
+    {
+      Fsignal (Qarith_error, Qnil);
+    }
+
+  ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor));
+
+  bignum_floor (scratch_bignum, ratio_numerator (scratch_ratio),
+		ratio_denominator (scratch_ratio));
+
+  res0 = return_float ? make_float (bignum_to_double (scratch_bignum)) :
+	  Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+
+  if (bignum_divisible_p (ratio_numerator (scratch_ratio),
+			  ratio_denominator (scratch_ratio)))
+    {
+      res1 = Qzero;
+    }
+  else
+    {
+      ratio_set_bignum (scratch_ratio, scratch_bignum);
+      ratio_mul (scratch_ratio, scratch_ratio, XRATIO_DATA (divisor));
+      ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio);
+      res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio));
+    }
+
+  return values2 (res0, res1);
+}
+#endif /* HAVE_RATIO */
+
+#ifdef HAVE_BIGFLOAT
+static Lisp_Object
+floor_two_bigfloat (Lisp_Object number, Lisp_Object divisor,
+		    int return_float)
+{
+  Lisp_Object res0;
+
+  if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0)
+    {
+      Fsignal (Qarith_error, Qnil);
+    }
+
+  bigfloat_set_prec (scratch_bigfloat, max (XBIGFLOAT_GET_PREC (number),
+					    XBIGFLOAT_GET_PREC (divisor)));
+  bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (number),
+		XBIGFLOAT_DATA (divisor));
+  bigfloat_floor (scratch_bigfloat, scratch_bigfloat);
+
+  if (return_float)
+    {
+      res0 = make_bigfloat_bf (scratch_bigfloat);
+    }
+  else
+    {
+#ifdef HAVE_BIGNUM
+      bignum_set_bigfloat (scratch_bignum, scratch_bigfloat);
+      res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+#else
+      res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
+#endif /* HAVE_BIGNUM */
+    }
+
+  bigfloat_mul (scratch_bigfloat2, scratch_bigfloat,
+		XBIGFLOAT_DATA (divisor));
+  bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number), scratch_bigfloat2);
+
+  return values2 (res0, make_bigfloat_bf (scratch_bigfloat));
+}
+#endif /* HAVE_BIGFLOAT */
+
+#ifdef HAVE_RATIO
+static Lisp_Object
+floor_one_ratio (Lisp_Object number, Lisp_Object UNUSED (divisor),
+		 int return_float)
+{
+  Lisp_Object res0, res1;
+
+  bignum_floor (scratch_bignum, XRATIO_NUMERATOR (number),
+		XRATIO_DENOMINATOR (number));
+
+  res0 = return_float ? make_float (bignum_to_double (scratch_bignum)) :
+	  Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+
+  if (bignum_divisible_p (XRATIO_NUMERATOR (number),
+			  XRATIO_DENOMINATOR (number)))
+    {
+      res1 = Qzero;
+    }
+  else
+    {
+      ratio_set_bignum (scratch_ratio2, scratch_bignum);
+      ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio2);
+      res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio));
+    }
+
+  return values2 (res0, res1);
+}
+#endif /* HAVE_RATIO */
+
+#ifdef HAVE_BIGFLOAT
+static Lisp_Object
+floor_one_bigfloat (Lisp_Object number, Lisp_Object UNUSED (divisor),
+		    int return_float)
+{
+  Lisp_Object res0;
+
+  bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number));
+  bigfloat_floor (scratch_bigfloat, XBIGFLOAT_DATA (number));
+
+  if (return_float)
+    {
+      res0 = make_bigfloat_bf (scratch_bigfloat);
+    }
+  else
+    {
+#ifdef HAVE_BIGNUM
+      bignum_set_bigfloat (scratch_bignum, scratch_bigfloat);
+      res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+#else
+      res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
+#endif /* HAVE_BIGNUM */
+    }
+
+  bigfloat_sub (scratch_bigfloat2, XBIGFLOAT_DATA (number), scratch_bigfloat);
+  return values2 (res0, make_bigfloat_bf (scratch_bigfloat2));
+}
+#endif /* HAVE_BIGFLOAT */
+
+static Lisp_Object
+floor_two_float (Lisp_Object number, Lisp_Object divisor,
+		 int return_float)
+{
+  double f1 = extract_float (number);
+  double f2 = extract_float (divisor);
+  double f0, remain;
+	    
+  if (f2 == 0.0)
+    {
+      Fsignal (Qarith_error, Qnil);
+    }
+	    
+  IN_FLOAT2 (f0 = floor (f1 / f2), MAYBE_EFF ("floor"), number, divisor);
+  IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF ("floor"), number, divisor);
+
+  if (return_float)
+    {
+      return values2 (make_float (f0), make_float (remain));
+    }
+
+  return values2 (float_to_int (f0, MAYBE_EFF ("floor"), number, divisor),
+		  make_float (remain));
+}
+
+static Lisp_Object
+floor_one_float (Lisp_Object number, int return_float)
+{
+  double d, d1;
+
+  IN_FLOAT ((d = floor (XFLOAT_DATA (number))), MAYBE_EFF ("floor"), number);
+  IN_FLOAT ((d1 = XFLOAT_DATA (number) - d), MAYBE_EFF ("floor"), number);
+
+  if (return_float)
+    {
+      return values2 (make_float (d), make_float (d1));
+    }
+  else
+    {
+      return values2 (float_to_int (d, MAYBE_EFF ("floor"), number, Qunbound),
+                      make_float (d1));
+    }
+}
+
+EXFUN (Ffloor, 2);
+EXFUN (Fffloor, 2);
+
+static Lisp_Object
+floor_one_mundane_arg (Lisp_Object number, Lisp_Object divisor,
+		       int return_float)
+{
 #ifdef HAVE_BIGNUM
   if (INTEGERP (number))
 #else
   if (INTP (number))
 #endif
-    return number;
-
-#ifdef HAVE_RATIO
-  if (RATIOP (number))
     {
-      bignum_ceil (scratch_bignum, XRATIO_NUMERATOR (number),
-		   XRATIO_DENOMINATOR (number));
-      return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+      if (return_float)
+	{
+	  return values2 (make_float (extract_float (number)), Qzero);
+	}
+      else
+	{
+	  return values2 (number, Qzero);
+	}
     }
-#endif
+
+  MAYBE_CHAR_OR_MARKER (floor);
+
+  if (return_float)
+    {
+      return Fffloor (wrong_type_argument (Qnumberp, number), divisor);
+    }
+  else
+    {
+      return Ffloor (wrong_type_argument (Qnumberp, number), divisor);
+    }
+}
 
-#ifdef HAVE_BIGFLOAT
-  if (BIGFLOATP (number))
+/* Algorithm taken from cl-extra.el, now to be found as cl-round in
+   tests/automated/lisp-tests.el.  */
+static Lisp_Object
+round_two_fixnum (Lisp_Object number, Lisp_Object divisor, 
+		  int return_float)
+{
+  EMACS_INT i1 = XREALINT (number);
+  EMACS_INT i2 = XREALINT (divisor);
+  EMACS_INT i0, hi2, flooring, floored, flsecond;
+
+  if (i2 == 0)
     {
-      bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number));
-      bigfloat_ceil (scratch_bigfloat, XBIGFLOAT_DATA (number));
-#ifdef HAVE_BIGNUM
-      bignum_set_bigfloat (scratch_bignum, scratch_bigfloat);
-      return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
-#else
-      return make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
-#endif /* HAVE_BIGNUM */
+      Fsignal (Qarith_error, Qnil);
     }
-#endif /* HAVE_BIGFLOAT */
+
+  hi2 = i2 < 0 ? -( -i2 / 2) : i2 / 2;
+
+  flooring = hi2 + i1;
+
+  floored = (i2 < 0
+	? (flooring <= 0  ?  -flooring / -i2  :  -1 - ((flooring - 1) / -i2))
+	: (flooring < 0  ?  -1 - ((-1 - flooring) / i2)  :  flooring / i2));
+
+  flsecond = flooring - (floored * i2);
 
-  return Fceiling (wrong_type_argument (Qnumberp, number));
+  if (0 == flsecond
+      && (i2 == (hi2 + hi2))
+      && (0 != (floored % 2)))
+    {
+      i0 = floored - 1;
+      return values2 (return_float ? make_float ((double)i0) :
+		      make_int (i0), make_int (hi2));
+    }
+  else
+    {
+      return values2 (return_float ? make_float ((double)floored) :
+		      make_int (floored),
+		      make_int (flsecond - hi2));
+    }
 }
 
+#ifdef HAVE_BIGNUM
+static void
+round_two_bignum_1 (bignum number, bignum divisor,
+		    Lisp_Object *res, Lisp_Object *remain)
+{
+  bignum flooring, floored, hi2, flsecond;
 
-DEFUN ("floor", Ffloor, 1, 2, 0, /*
-Return the largest integer no greater than NUMBER.  (Round towards -inf.)
-With optional second argument DIVISOR, return the largest integer no
-greater than NUMBER/DIVISOR.
-*/
-       (number, divisor))
-{
-#ifdef WITH_NUMBER_TYPES
-  CHECK_REAL (number);
-  if (NILP (divisor))
+  if (bignum_divisible_p (number, divisor))
     {
-      if (FLOATP (number))
-	{
-	  double d;
-	  IN_FLOAT ((d = floor (XFLOAT_DATA (number))), "floor", number);
-	  return (float_to_int (d, "floor", number, Qunbound));
-	}
-#ifdef HAVE_RATIO
-      else if (RATIOP (number))
-	{
-	  bignum_floor (scratch_bignum, XRATIO_NUMERATOR (number),
-			XRATIO_DENOMINATOR (number));
-	  return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
-	}
-#endif
-#ifdef HAVE_BIGFLOAT
-      else if (BIGFLOATP (number))
-	{
-	  bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number));
-	  bigfloat_floor (scratch_bigfloat, XBIGFLOAT_DATA (number));
-	  return make_bigfloat_bf (scratch_bigfloat);
-	}
-#endif
-      return number;
+      bignum_div (scratch_bignum, number, divisor);
+      *res = make_bignum_bg (scratch_bignum);
+      *remain = Qzero;
+      return;
+    }
+
+  bignum_set_long (scratch_bignum, 2);
+
+  bignum_div (scratch_bignum2, divisor, scratch_bignum);
+
+  bignum_init (hi2);
+  bignum_set (hi2, scratch_bignum2);
+
+  bignum_add (scratch_bignum, scratch_bignum2, number);
+  bignum_init (flooring);
+  bignum_set (flooring, scratch_bignum);
+
+  bignum_floor (scratch_bignum, flooring, divisor);
+  bignum_init (floored);
+  bignum_set (floored, scratch_bignum);
+
+  bignum_mul (scratch_bignum2, scratch_bignum, divisor);
+  bignum_sub (scratch_bignum, flooring, scratch_bignum2);
+  bignum_init (flsecond);
+  bignum_set (flsecond, scratch_bignum);
+
+  bignum_set_long (scratch_bignum, 2);
+  bignum_mul (scratch_bignum2, scratch_bignum, hi2);
+
+  if (bignum_sign (flsecond) == 0
+      && bignum_eql (divisor, scratch_bignum2)
+      && (1 == bignum_testbit (floored, 0)))
+    {
+      bignum_set_long (scratch_bignum, 1);
+      bignum_sub (floored, floored, scratch_bignum);
+      *res = make_bignum_bg (floored);
+      *remain = make_bignum_bg (hi2);
+    }
+  else
+    {
+      bignum_sub (scratch_bignum, flsecond,
+		  hi2);
+      *res = make_bignum_bg (floored);
+      *remain = make_bignum_bg (scratch_bignum);
+    }
+}
+
+static Lisp_Object
+round_two_bignum (Lisp_Object number, Lisp_Object divisor, 
+		  int return_float)
+{
+  Lisp_Object res0, res1;
+
+  if (bignum_sign (XBIGNUM_DATA (divisor)) == 0)
+    {
+      Fsignal (Qarith_error, Qnil);
+    }
+
+  round_two_bignum_1 (XBIGNUM_DATA (number), XBIGNUM_DATA (divisor),
+		      &res0, &res1);
+
+  if (return_float)
+    {
+      res0 = make_float (bignum_to_double (XBIGNUM_DATA (res0)));
     }
   else
     {
-      CHECK_REAL (divisor);
-      switch (promote_args (&number, &divisor))
-	{
-	case FIXNUM_T:
-	  {
-	    EMACS_INT i1 = XREALINT (number);
-	    EMACS_INT i2 = XREALINT (divisor);
+      res0 = Fcanonicalize_number (res0);
+    }
+
+  return values2 (res0, Fcanonicalize_number (res1));
+}
+#endif /* HAVE_BIGNUM */
 
-	    if (i2 == 0)
-	      Fsignal (Qarith_error, Qnil);
+#ifdef HAVE_RATIO
+static Lisp_Object
+round_two_ratio (Lisp_Object number, Lisp_Object divisor,
+		 int return_float)
+{
+  Lisp_Object res0, res1;
 
-	    /* 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));
+  if (ratio_sign (XRATIO_DATA (divisor)) == 0)
+    {
+      Fsignal (Qarith_error, Qnil);
+    }
 
-	    return make_int (i1);
-	  }
-#ifdef HAVE_BIGNUM
-	case BIGNUM_T:
-	  if (bignum_sign (XBIGNUM_DATA (divisor)) == 0)
-	    Fsignal (Qarith_error, Qnil);
-	  bignum_floor (scratch_bignum, XBIGNUM_DATA (number),
-			XBIGNUM_DATA (divisor));
-	  return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
-#endif
-#ifdef HAVE_RATIO
-	case RATIO_T:
-	  if (ratio_sign (XRATIO_DATA (divisor)) == 0)
-	    Fsignal (Qarith_error, Qnil);
-	  ratio_div (scratch_ratio, XRATIO_DATA (number),
-		     XRATIO_DATA (divisor));
-	  bignum_floor (scratch_bignum, ratio_numerator (scratch_ratio),
-			ratio_denominator (scratch_ratio));
-	  return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
-#endif
+  ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor));
+  
+  round_two_bignum_1 (ratio_numerator (scratch_ratio),
+		      ratio_denominator (scratch_ratio), &res0, &res1);
+
+  if (!ZEROP (res1))
+    {
+      /* The numerator and denominator don't round exactly, calculate a
+	 ratio remainder: */
+      ratio_set_bignum (scratch_ratio2, XBIGNUM_DATA (res0));
+      ratio_mul (scratch_ratio, scratch_ratio2, XRATIO_DATA (divisor));
+      ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio);
+      
+      res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio));
+    }
+
+  res0 = return_float ?
+    make_float ((double)bignum_to_double(XBIGNUM_DATA (res0))) :
+    Fcanonicalize_number (res0);
+
+  return values2 (res0, res1);
+}
+#endif /* HAVE_RATIO */
+
 #ifdef HAVE_BIGFLOAT
-	case BIGFLOAT_T:
-	  if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0)
-	    Fsignal (Qarith_error, Qnil);
-	  bigfloat_set_prec (scratch_bigfloat,
-			     max (XBIGFLOAT_GET_PREC (number),
-				  XBIGFLOAT_GET_PREC (divisor)));
-	  bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (number),
-			XBIGFLOAT_DATA (divisor));
-	  bigfloat_floor (scratch_bigfloat, scratch_bigfloat);
-	  return make_bigfloat_bf (scratch_bigfloat);
-#endif
-	default: /* FLOAT_T */
+/* This is the logic of emacs_rint above, no more and no less. */
+static Lisp_Object
+round_one_bigfloat_1 (bigfloat number)
+{
+  Lisp_Object res0;
+  unsigned long prec = bigfloat_get_prec (number);
+
+  assert ((bigfloat *)(&number) != (bigfloat *)&scratch_bigfloat
+	  && (bigfloat *)(&number) != (bigfloat *)(&scratch_bigfloat2));
+
+  bigfloat_set_prec (scratch_bigfloat, prec);
+  bigfloat_set_prec (scratch_bigfloat2, prec);
+
+  bigfloat_set_double (scratch_bigfloat, 0.5);
+  bigfloat_add (scratch_bigfloat2, scratch_bigfloat, number);
+  bigfloat_floor (scratch_bigfloat, scratch_bigfloat2);
+  res0 = make_bigfloat_bf (scratch_bigfloat);
+
+  bigfloat_sub (scratch_bigfloat2, scratch_bigfloat, number);
+  bigfloat_abs (scratch_bigfloat, scratch_bigfloat2);
+
+  bigfloat_set_double (scratch_bigfloat2, 0.5);
+
+  do {
+    if (!bigfloat_ge (scratch_bigfloat, scratch_bigfloat2))
+      {
+	break;
+      }
+
+    if (!bigfloat_gt (scratch_bigfloat, scratch_bigfloat2))
+      {
+	bigfloat_set_double (scratch_bigfloat2, 2.0);
+	bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (res0),
+		      scratch_bigfloat2);
+	bigfloat_floor (scratch_bigfloat2, scratch_bigfloat);
+	bigfloat_set_double (scratch_bigfloat, 2.0);
+	bigfloat_mul (scratch_bigfloat2, scratch_bigfloat2,
+		      scratch_bigfloat);
+	if (bigfloat_eql (scratch_bigfloat2, XBIGFLOAT_DATA (res0)))
 	  {
-	    double f1 = extract_float (number);
-	    double f2 = extract_float (divisor);
-	    
-	    if (f2 == 0.0)
-	      Fsignal (Qarith_error, Qnil);
-	    
-	    IN_FLOAT2 (f1 = floor (f1 / f2), "floor", number, divisor);
-	    return float_to_int (f1, "floor", number, divisor);
+	    break;
 	  }
-	}
-    }
-#else /* !WITH_NUMBER_TYPES */
-  CHECK_INT_OR_FLOAT (number);
+      }
+
+    if (bigfloat_lt (XBIGFLOAT_DATA (res0), number))
+      {
+	bigfloat_set_double (scratch_bigfloat2, 1.0);
+      }
+    else
+      {
+	bigfloat_set_double (scratch_bigfloat2, -1.0);
+      }
+
+    bigfloat_set (scratch_bigfloat, XBIGFLOAT_DATA (res0));
+
+    bigfloat_add (XBIGFLOAT_DATA (res0), scratch_bigfloat2,
+		  scratch_bigfloat);
 
-  if (! NILP (divisor))
+  } while (0);
+
+  return res0;
+}
+
+static Lisp_Object
+round_two_bigfloat (Lisp_Object number, Lisp_Object divisor,
+		    int return_float)
+{
+  Lisp_Object res0, res1;
+  bigfloat divided;
+
+  unsigned long prec = max (XBIGFLOAT_GET_PREC (number),
+			    XBIGFLOAT_GET_PREC (divisor));
+
+  if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0)
     {
-      EMACS_INT i1, i2;
-
-      CHECK_INT_OR_FLOAT (divisor);
-
-      if (FLOATP (number) || FLOATP (divisor))
-	{
-	  double f1 = extract_float (number);
-	  double f2 = extract_float (divisor);
-
-	  if (f2 == 0)
-	    Fsignal (Qarith_error, Qnil);
-
-	  IN_FLOAT2 (f1 = floor (f1 / f2), "floor", number, divisor);
-	  return float_to_int (f1, "floor", number, divisor);
-	}
-
-      i1 = XINT (number);
-      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));
-
-      return (make_int (i1));
+      Fsignal (Qarith_error, Qnil);
     }
 
-  if (FLOATP (number))
+  bigfloat_init (divided);
+  bigfloat_set_prec (divided, prec);
+
+  bigfloat_div (divided, XBIGFLOAT_DATA (number), XBIGFLOAT_DATA (divisor));
+
+  res0 = round_one_bigfloat_1 (divided);
+
+  bigfloat_set_prec (scratch_bigfloat, prec);
+  bigfloat_set_prec (scratch_bigfloat2, prec);
+            
+  bigfloat_mul (scratch_bigfloat, XBIGFLOAT_DATA (res0),
+		XBIGFLOAT_DATA (divisor));
+  bigfloat_sub (scratch_bigfloat2, XBIGFLOAT_DATA (number),
+		scratch_bigfloat);
+
+  res1 = make_bigfloat_bf (scratch_bigfloat2);
+
+  if (!return_float)
     {
-      double d;
-      IN_FLOAT ((d = floor (XFLOAT_DATA (number))), "floor", number);
-      return (float_to_int (d, "floor", number, Qunbound));
+#ifdef HAVE_BIGNUM
+      bignum_set_bigfloat (scratch_bignum, XBIGFLOAT_DATA (res0));
+      res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+#else
+      res0 = make_int ((EMACS_INT) bigfloat_to_long (XBIGFLOAT_DATA (res0)));
+#endif /* HAVE_BIGNUM */
+    }
+
+  return values2 (res0, res1);
+}
+#endif /* HAVE_BIGFLOAT */
+
+#ifdef HAVE_RATIO
+static Lisp_Object
+round_one_ratio (Lisp_Object number, Lisp_Object UNUSED (divisor),
+		 int return_float)
+{
+  Lisp_Object res0, res1;
+
+  round_two_bignum_1 (XRATIO_NUMERATOR (number), XRATIO_DENOMINATOR (number),
+		      &res0, &res1);
+
+  if (!ZEROP (res1))
+    {
+      ratio_set_bignum (scratch_ratio2, XBIGNUM_DATA (res0));
+      ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio2);
+      res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio));
     }
 
-  return number;
-#endif /* WITH_NUMBER_TYPES */
+  res0 = return_float ?
+    make_float ((double)bignum_to_double(XBIGNUM_DATA (res0))) :
+    Fcanonicalize_number (res0);
+
+  return values2 (res0, res1);
+}
+#endif /* HAVE_RATIO */
+
+#ifdef HAVE_BIGFLOAT
+static Lisp_Object
+round_one_bigfloat (Lisp_Object number, Lisp_Object UNUSED (divisor),
+		    int return_float)
+{
+  Lisp_Object res0 = round_one_bigfloat_1 (XBIGFLOAT_DATA (number));
+  Lisp_Object res1;
+
+  bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number), 
+		XBIGFLOAT_DATA (res0));
+
+  res1 = make_bigfloat_bf (scratch_bigfloat);
+
+  if (!return_float)
+    {
+#ifdef HAVE_BIGNUM
+      bignum_set_bigfloat (scratch_bignum, XBIGFLOAT_DATA (res0));
+      res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+#else
+      res0 = make_int ((EMACS_INT) bigfloat_to_long
+		       (XBIGFLOAT_DATA (res0)));
+#endif /* HAVE_BIGNUM */
+    }
+
+  return values2 (res0, res1);
+}
+#endif /* HAVE_BIGFLOAT */
+
+static Lisp_Object
+round_two_float (Lisp_Object number, Lisp_Object divisor,
+		 int return_float)
+{
+  double f1 = extract_float (number);
+  double f2 = extract_float (divisor);
+  double f0, remain;
+	    
+  if (f2 == 0.0)
+    Fsignal (Qarith_error, Qnil);
+
+  IN_FLOAT2 ((f0 = emacs_rint (f1 / f2)), MAYBE_EFF ("round"), number,
+	     divisor); 
+  IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF ("round"), number, divisor);
+
+  if (return_float)
+    {
+      return values2 (make_float (f0), make_float (remain));
+    }
+  else
+    {
+      return values2 (float_to_int (f0, MAYBE_EFF("round"), number, divisor),
+		      make_float (remain));
+    }
 }
 
-DEFUN ("round", Fround, 1, 1, 0, /*
-Return the nearest integer to NUMBER.
-*/
-       (number))
+static Lisp_Object
+round_one_float (Lisp_Object number, int return_float)
 {
-  if (FLOATP (number))
+  double d;
+  /* Screw the prevailing rounding mode.  */
+  IN_FLOAT ((d = emacs_rint (XFLOAT_DATA (number))), MAYBE_EFF ("round"),
+    	number);
+
+  if (return_float)
+    {
+      return values2 (make_float (d), make_float (XFLOAT_DATA (number) - d));
+    }
+  else
     {
-      double d;
-      /* Screw the prevailing rounding mode.  */
-      IN_FLOAT ((d = emacs_rint (XFLOAT_DATA (number))), "round", number);
-      return (float_to_int (d, "round", number, Qunbound));
+      return values2 ((float_to_int (d, MAYBE_EFF ("round"), number,
+				     Qunbound)), 
+		      make_float (XFLOAT_DATA (number) - d));
     }
+}
 
+EXFUN (Fround, 2);
+EXFUN (Ffround, 2);
+
+static Lisp_Object
+round_one_mundane_arg (Lisp_Object number, Lisp_Object divisor,
+		       int return_float)
+{
 #ifdef HAVE_BIGNUM
   if (INTEGERP (number))
 #else
   if (INTP (number))
 #endif
-    return number;
-
-#ifdef HAVE_RATIO
-  if (RATIOP (number))
     {
-      if (bignum_divisible_p (XRATIO_NUMERATOR (number),
-			      XRATIO_DENOMINATOR (number)))
+      if (return_float)
 	{
-	  bignum_div (scratch_bignum, XRATIO_NUMERATOR (number),
-		      XRATIO_DENOMINATOR (number));
+	  return values2 (make_float (extract_float (number)), Qzero);
 	}
       else
 	{
-	  bignum_add (scratch_bignum2, XRATIO_NUMERATOR (number),
-		      XRATIO_DENOMINATOR (number));
-	  bignum_div (scratch_bignum, scratch_bignum2,
-		      XRATIO_DENOMINATOR (number));
+	  return values2 (number, Qzero);
 	}
-      return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+    }
+
+  MAYBE_CHAR_OR_MARKER (round);
+
+  if (return_float)
+    {
+      return Ffround (wrong_type_argument (Qnumberp, number), divisor);  
+    }
+  else
+    {
+      return Fround (wrong_type_argument (Qnumberp, number), divisor);  
+    }
+}
+
+static Lisp_Object
+truncate_two_fixnum (Lisp_Object number, Lisp_Object divisor,
+		     int return_float)
+{
+  EMACS_INT i1 = XREALINT (number);
+  EMACS_INT i2 = XREALINT (divisor);
+  EMACS_INT i0;
+
+  if (i2 == 0)
+    Fsignal (Qarith_error, Qnil);
+
+  /* We're truncating towards zero, so apart from avoiding the C89
+     implementation-defined behaviour with truncation and negative numbers,
+     we don't need to do anything further: */
+  i0 = (i2 < 0
+	? (i1 <= 0  ?  -i1 / -i2  :  -(i1 / -i2))
+	: (i1 < 0  ?  -(-i1 / i2)  :  i1 / i2));
+
+  if (return_float)
+    {
+      return values2 (make_float ((double)i0), make_int (i1 - (i0 * i2)));
+    }
+  else
+    {
+      return values2 (make_int (i0), make_int (i1 - (i0 * i2)));
+    }
+}
+
+#ifdef HAVE_BIGNUM
+static Lisp_Object
+truncate_two_bignum (Lisp_Object number, Lisp_Object divisor,
+		     int return_float)
+{
+  Lisp_Object res0;
+
+  if (bignum_sign (XBIGNUM_DATA (divisor)) == 0)
+    {
+      Fsignal (Qarith_error, Qnil);
     }
+
+  bignum_div (scratch_bignum, XBIGNUM_DATA (number),
+	      XBIGNUM_DATA (divisor));
+
+  if (return_float)
+    {
+      res0 = make_float (bignum_to_double (scratch_bignum));
+    }
+  else
+    {
+      res0 = make_bignum_bg (scratch_bignum);
+    }
+
+  if (bignum_divisible_p (XBIGNUM_DATA (number),
+			  XBIGNUM_DATA (divisor)))
+    {
+      return values2 (Fcanonicalize_number (res0), Qzero);
+    }
+
+  bignum_mul (scratch_bignum2, scratch_bignum, XBIGNUM_DATA (divisor));
+  bignum_sub (scratch_bignum, XBIGNUM_DATA (number), scratch_bignum2);
+
+  return values2 (Fcanonicalize_number (res0),
+		  Fcanonicalize_number (make_bignum_bg (scratch_bignum)));
+}
+#endif /* HAVE_BIGNUM */
+
+#ifdef HAVE_RATIO
+static Lisp_Object
+truncate_two_ratio (Lisp_Object number, Lisp_Object divisor,
+		    int return_float)
+{
+  Lisp_Object res0;
+
+  if (ratio_sign (XRATIO_DATA (divisor)) == 0)
+    {
+      Fsignal (Qarith_error, Qnil);
+    }
+
+  ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor));
+
+  bignum_div (scratch_bignum, ratio_numerator (scratch_ratio),
+	      ratio_denominator (scratch_ratio));
+
+  if (return_float)
+    {
+      res0 = make_float (bignum_to_double (scratch_bignum));
+    }
+  else
+    {
+      res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+    }
+
+  if (bignum_divisible_p (ratio_numerator (scratch_ratio),
+			  ratio_denominator (scratch_ratio)))
+    {
+      return values2 (res0, Qzero);
+    }
+
+  ratio_set_bignum (scratch_ratio2, scratch_bignum);
+  ratio_mul (scratch_ratio, scratch_ratio2, XRATIO_DATA (divisor));
+  ratio_sub (scratch_ratio2, XRATIO_DATA (number), scratch_ratio);
+
+  return values2 (res0, Fcanonicalize_number (make_ratio_rt(scratch_ratio2)));
+}
 #endif
 
 #ifdef HAVE_BIGFLOAT
-  if (BIGFLOATP (number))
+static Lisp_Object
+truncate_two_bigfloat (Lisp_Object number, Lisp_Object divisor,
+		       int return_float)
+{
+  Lisp_Object res0;
+  unsigned long prec = max (XBIGFLOAT_GET_PREC (number),
+			    XBIGFLOAT_GET_PREC (divisor));
+
+  if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0)
     {
-      unsigned long prec = XBIGFLOAT_GET_PREC (number);
-      bigfloat_set_prec (scratch_bigfloat, prec);
-      bigfloat_set_prec (scratch_bigfloat2, prec);
-      bigfloat_set_double (scratch_bigfloat2,
-			   bigfloat_sign (XBIGFLOAT_DATA (number)) * 0.5);
-      bigfloat_floor (scratch_bigfloat, scratch_bigfloat2);
+      Fsignal (Qarith_error, Qnil);
+    }
+
+  bigfloat_set_prec (scratch_bigfloat, prec);
+  bigfloat_set_prec (scratch_bigfloat2, prec);
+
+  bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (number),
+		XBIGFLOAT_DATA (divisor));
+  bigfloat_trunc (scratch_bigfloat, scratch_bigfloat);
+
+  if (return_float)
+    {
+      res0 = make_bigfloat_bf (scratch_bigfloat);
+    }
+  else
+    {
 #ifdef HAVE_BIGNUM
       bignum_set_bigfloat (scratch_bignum, scratch_bigfloat);
-      return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+      res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
 #else
-      return make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
+      res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
 #endif /* HAVE_BIGNUM */
     }
+            
+  bigfloat_mul (scratch_bigfloat2, scratch_bigfloat, XBIGFLOAT_DATA (divisor));
+  bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number), scratch_bigfloat2);
+
+  return values2 (res0, make_bigfloat_bf (scratch_bigfloat));
+}
 #endif /* HAVE_BIGFLOAT */
 
-  return Fround (wrong_type_argument (Qnumberp, number));
+#ifdef HAVE_RATIO
+static Lisp_Object
+truncate_one_ratio (Lisp_Object number, Lisp_Object UNUSED (divisor),
+		   int return_float)
+{
+  Lisp_Object res0;
+
+  if (ratio_sign (XRATIO_DATA (number)) == 0)
+    {
+      Fsignal (Qarith_error, Qnil);
+    }
+
+  bignum_div (scratch_bignum, XRATIO_NUMERATOR (number),
+	      XRATIO_DENOMINATOR (number));
+  if (return_float)
+    {
+      res0 = make_float (bignum_to_double (scratch_bignum));
+    }
+  else
+    {
+      res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+    }
+
+  if (bignum_divisible_p (XRATIO_NUMERATOR (number),
+			  XRATIO_DENOMINATOR (number)))
+    {
+      return values2 (res0, Qzero);
+    }
+
+  ratio_set_bignum (scratch_ratio2, scratch_bignum);
+  ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio2);
+
+  return values2 (res0, Fcanonicalize_number (make_ratio_rt (scratch_ratio)));
+}
+#endif /* HAVE_RATIO */
+
+#ifdef HAVE_BIGFLOAT
+static Lisp_Object
+truncate_one_bigfloat (Lisp_Object number, Lisp_Object UNUSED (divisor),
+		       int return_float)
+{
+  Lisp_Object res0;
+
+  bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number));
+  bigfloat_set_prec (scratch_bigfloat2, XBIGFLOAT_GET_PREC (number));
+  bigfloat_trunc (scratch_bigfloat, XBIGFLOAT_DATA (number));
+
+  if (return_float)
+    {
+      res0 = make_bigfloat_bf (scratch_bigfloat);
+    }
+  else
+    {
+#ifdef HAVE_BIGNUM
+      bignum_set_bigfloat (scratch_bignum, scratch_bigfloat);
+      res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+#else
+      res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
+#endif /* HAVE_BIGNUM */
+    }
+
+  bigfloat_sub (scratch_bigfloat2, XBIGFLOAT_DATA (number), scratch_bigfloat);
+
+  return
+    values2 (res0, 
+	     Fcanonicalize_number (make_bigfloat_bf (scratch_bigfloat2)));
+}
+#endif /* HAVE_BIGFLOAT */
+
+static Lisp_Object
+truncate_two_float (Lisp_Object number, Lisp_Object divisor,
+		    int return_float)
+{
+  double f1 = extract_float (number);
+  double f2 = extract_float (divisor);
+  double f0, remain;
+  Lisp_Object res0;
+	    
+  if (f2 == 0.0)
+    {
+      Fsignal (Qarith_error, Qnil);
+    }
+
+  res0 = float_to_int (f1 / f2, MAYBE_EFF ("truncate"), number, Qunbound);
+  f0 = extract_float (res0);
+
+  IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF ("truncate"), number, divisor);
+
+  if (return_float)
+    {
+      res0 = make_float (f0);
+    }
+
+  return values2 (res0, make_float (remain));
 }
 
-DEFUN ("truncate", Ftruncate, 1, 1, 0, /*
-Truncate a floating point number to an integer.
-Rounds the value toward zero.
-*/
-       (number))
+static Lisp_Object
+truncate_one_float (Lisp_Object number, int return_float)
 {
-  if (FLOATP (number))
-    return float_to_int (XFLOAT_DATA (number), "truncate", number, Qunbound);
+  Lisp_Object res0
+    = float_to_int (XFLOAT_DATA (number), MAYBE_EFF ("truncate"),
+		    number, Qunbound);
+  if (return_float)
+    {
+      res0 = make_float ((double)XINT(res0));
+      return values2 (res0, make_float ((XFLOAT_DATA (number)
+					 - XFLOAT_DATA (res0))));
+    }
+  else
+    {
+      return values2 (res0, make_float (XFLOAT_DATA (number)
+					- XREALINT (res0)));
+    }
+}
 
+EXFUN (Fftruncate, 2);
+
+static Lisp_Object
+truncate_one_mundane_arg (Lisp_Object number, Lisp_Object divisor,
+			  int return_float)
+{
 #ifdef HAVE_BIGNUM
   if (INTEGERP (number))
 #else
   if (INTP (number))
 #endif
-    return number;
+    {
+      if (return_float)
+	{
+	  return values2 (make_float (extract_float (number)), Qzero);
+	}
+      else
+	{
+	  return values2 (number, Qzero);
+	}
+    }
 
-#ifdef HAVE_RATIO
-  if (RATIOP (number))
+  MAYBE_CHAR_OR_MARKER (truncate);
+
+  if (return_float)
+    {
+      return Fftruncate (wrong_type_argument (Qnumberp, number), divisor);
+    }
+  else
     {
-      bignum_div (scratch_bignum, XRATIO_NUMERATOR (number),
-		  XRATIO_DENOMINATOR (number));
-      return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+      return Ftruncate (wrong_type_argument (Qnumberp, number), divisor);
     }
-#endif
+}
+
+/* Rounding functions that will not necessarily return floats: */
+
+DEFUN ("ceiling", Fceiling, 1, 2, 0, /*
+Return the smallest integer no less than NUMBER.  (Round toward +inf.)
+
+With optional argument DIVISOR, return the smallest integer no less than
+the quotient of NUMBER and DIVISOR. 
+
+This function returns multiple values; see `multiple-value-bind' and
+`multiple-value-call'.  The second returned value is the remainder in the
+calculation, which will be one minus the fractional part of NUMBER if DIVISOR
+is omitted or one.
+*/
+       (number, divisor))
+{
+  ROUNDING_CONVERT(ceiling, 0);
+}
 
-#ifdef HAVE_BIGFLOAT
-  if (BIGFLOATP (number))
-    {
-      bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number));
-      bigfloat_trunc (scratch_bigfloat, XBIGFLOAT_DATA (number));
-#ifdef HAVE_BIGNUM
-      bignum_set_bigfloat (scratch_bignum, scratch_bigfloat);
-      return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
-#else
-      return make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
-#endif /* HAVE_BIGNUM */
-    }
-#endif /* HAVE_BIGFLOAT */
+DEFUN ("floor", Ffloor, 1, 2, 0, /*
+Return the largest integer no greater than NUMBER.  (Round towards -inf.)
+With optional second argument DIVISOR, return the largest integer no
+greater than the quotient of NUMBER and DIVISOR.
+
+This function returns multiple values; see `multiple-value-call' and
+`multiple-value-bind'.  The second returned value is the remainder in the
+calculation, which will just be the fractional part if DIVISOR is omitted or
+one.
+*/
+       (number, divisor))
+{
+  ROUNDING_CONVERT(floor, 0);
+}
+
+DEFUN ("round", Fround, 1, 2, 0, /*
+Return the nearest integer to NUMBER.
+If NUMBER is exactly halfway between two integers, return the one that
+is even.
 
-  return Ftruncate (wrong_type_argument (Qnumberp, number));
+Optional argument DIVISOR means return the nearest integer to NUMBER
+divided by DIVISOR.
+
+This function returns multiple values; see `multiple-value-call' and
+`multiple-value-bind'.  The second returned value is the remainder
+in the calculation.
+*/
+       (number, divisor))
+{
+  ROUNDING_CONVERT(round, 0);
+}
+
+DEFUN ("truncate", Ftruncate, 1, 2, 0, /*
+Truncate a floating point number to an integer.
+Rounds the value toward zero.
+
+Optional argument DIVISOR means truncate NUMBER divided by DIVISOR.
+
+This function returns multiple values; see `multiple-value-call' and
+`multiple-value-bind'.  The second returned value is the remainder.
+*/
+       (number, divisor))
+{
+  ROUNDING_CONVERT(truncate, 0);
 }
 
 /* Float-rounding functions. */
 
-DEFUN ("fceiling", Ffceiling, 1, 1, 0, /*
+DEFUN ("fceiling", Ffceiling, 1, 2, 0, /*
 Return the smallest integer no less than NUMBER, as a float.
 \(Round toward +inf.\)
+
+With optional argument DIVISOR, return the smallest integer no less than the
+quotient of NUMBER and DIVISOR, as a float.
+
+This function returns multiple values; the second value is the remainder in
+the calculation.
 */
-       (number))
+       (number, divisor))
 {
-  double d = extract_float (number);
-  IN_FLOAT (d = ceil (d), "fceiling", number);
-  return make_float (d);
+  ROUNDING_CONVERT(ceiling, 1);
 }
 
-DEFUN ("ffloor", Fffloor, 1, 1, 0, /*
+DEFUN ("ffloor", Fffloor, 1, 2, 0, /*
 Return the largest integer no greater than NUMBER, as a float.
 \(Round towards -inf.\)
+
+With optional argument DIVISOR, return the largest integer no greater than
+the quotient of NUMBER and DIVISOR, as a float.
+
+This function returns multiple values; the second value is the remainder in
+the calculation.
 */
-       (number))
+       (number, divisor))
 {
-  double d = extract_float (number);
-  IN_FLOAT (d = floor (d), "ffloor", number);
-  return make_float (d);
+  ROUNDING_CONVERT(floor, 1);
 }
 
-DEFUN ("fround", Ffround, 1, 1, 0, /*
+DEFUN ("fround", Ffround, 1, 2, 0, /*
 Return the nearest integer to NUMBER, as a float.
+If NUMBER is exactly halfway between two integers, return the one that is
+even.
+
+With optional argument DIVISOR, return the nearest integer to the quotient
+of NUMBER and DIVISOR, as a float.
+
+This function returns multiple values; the second value is the remainder in
+the calculation.
 */
-       (number))
+       (number, divisor))
 {
-  double d = extract_float (number);
-  IN_FLOAT (d = emacs_rint (d), "fround", number);
-  return make_float (d);
+  ROUNDING_CONVERT(round, 1);
 }
 
-DEFUN ("ftruncate", Fftruncate, 1, 1, 0, /*
+DEFUN ("ftruncate", Fftruncate, 1, 2, 0, /*
 Truncate a floating point number to an integral float value.
 Rounds the value toward zero.
+
+With optional argument DIVISOR, truncate the quotient of NUMBER and DIVISOR,
+to an integral float value.
+
+This function returns multiple values; the second value is the remainder in
+the calculation.
 */
-       (number))
+       (number, divisor))
 {
-  double d = extract_float (number);
-  if (d >= 0.0)
-    IN_FLOAT (d = floor (d), "ftruncate", number);
-  else
-    IN_FLOAT (d = ceil (d), "ftruncate", number);
-  return make_float (d);
+  ROUNDING_CONVERT(truncate, 1);
 }
 
 #ifdef FLOAT_CATCH_SIGILL