--- a/lisp/ChangeLog	Sun Aug 16 20:55:49 2009 +0100
+++ b/lisp/ChangeLog	Tue Aug 11 17:59:23 2009 +0100
@@ -12,6 +12,14 @@
 
 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. 
+
+2009-08-11  Aidan Kehoe  <kehoea@parhasard.net>
+
 	* bytecomp.el :
 	Update this file to support full C-level multiple values. This
 	involves:

--- a/lisp/cl-compat.el	Sun Aug 16 20:55:49 2009 +0100
+++ b/lisp/cl-compat.el	Tue Aug 11 17:59:23 2009 +0100
@@ -82,12 +82,11 @@
     (if test-not (not (funcall test-not item elt))
       (funcall (or test 'eql) item elt))))
 
-;;; Rounding functions with old-style multiple value returns.
-
-(defun cl-floor (a &optional b) (values-list (floor* a b)))
-(defun cl-ceiling (a &optional b) (values-list (ceiling* a b)))
-(defun cl-round (a &optional b) (values-list (round* a b)))
-(defun cl-truncate (a &optional b) (values-list (truncate* a b)))
+;; The rounding functions in C now have all the functionality this package
+;; used to:
+(loop
+  for symbol in '(floor ceiling round truncate)
+  do (defalias (intern (format "cl-%s" symbol)) symbol))
 
 (defun safe-idiv (a b)
   (let* ((q (/ (abs a) (abs b)))

--- a/lisp/cl-extra.el	Sun Aug 16 20:55:49 2009 +0100
+++ b/lisp/cl-extra.el	Tue Aug 11 17:59:23 2009 +0100
@@ -394,56 +394,41 @@
 (or (and (fboundp 'expt) (subrp (symbol-function 'expt)))
     (defalias 'expt 'cl-expt))
 
-(defun floor* (x &optional y)
-  "Return a list of the floor of X and the fractional part of X.
-With two arguments, return floor and remainder of their quotient."
-  (let ((q (floor x y)))
-    (list q (- x (if y (* y q) q)))))
-
-(defun ceiling* (x &optional y)
-  "Return a list of the ceiling of X and the fractional part of X.
-With two arguments, return ceiling and remainder of their quotient."
-  (let ((res (floor* x y)))
-    (if (= (car (cdr res)) 0) res
-      (list (1+ (car res)) (- (car (cdr res)) (or y 1))))))
+;; We can't use macrolet in this file; whence the literal macro
+;; definition-and-call:
+((macro . (lambda (&rest symbols)
+   "Make some old CL package truncate and round functions available.
 
-(defun truncate* (x &optional y)
-  "Return a list of the integer part of X and the fractional part of X.
-With two arguments, return truncation and remainder of their quotient."
-  (if (eq (>= x 0) (or (null y) (>= y 0)))
-      (floor* x y) (ceiling* x y)))
-
-(defun round* (x &optional y)
-  "Return a list of X rounded to the nearest integer and the remainder.
-With two arguments, return rounding and remainder of their quotient."
-  (if y
-      (if (and (integerp x) (integerp y))
-	  (let* ((hy (/ y 2))
-		 (res (floor* (+ x hy) y)))
-	    (if (and (= (car (cdr res)) 0)
-		     (= (+ hy hy) y)
-		     (/= (% (car res) 2) 0))
-		(list (1- (car res)) hy)
-	      (list (car res) (- (car (cdr res)) hy))))
-	(let ((q (round (/ x y))))
-	  (list q (- x (* q y)))))
-    (if (integerp x) (list x 0)
-      (let ((q (round x)))
-	(list q (- x q))))))
+These functions are now implemented in C; their Lisp implementations in this
+XEmacs are trivial, so we provide them and mark them obsolete."
+   (let (symbol result)
+     (while symbols
+       (setq symbol (car symbols)
+	     symbols (cdr symbols))
+       (push `(make-obsolete ',(intern (format "%s*" symbol))
+	       ',symbol "21.5.29")
+	     result) 
+       (push
+	`(defun ,(intern (format "%s*" symbol)) (number &optional divisor)
+	  ,(format "See `%s'. This returns a list, not multiple values."
+		   symbol)
+	  (multiple-value-list (,symbol number divisor)))
+	result))
+     (cons 'progn result))))
+ ceiling floor round truncate)
 
 (defun mod* (x y)
   "The remainder of X divided by Y, with the same sign as Y."
-  (nth 1 (floor* x y)))
+  (nth-value 1 (floor x y)))
 
 (defun rem* (x y)
   "The remainder of X divided by Y, with the same sign as X."
-  (nth 1 (truncate* x y)))
+  (nth-value 1 (truncate x y)))
 
 (defun signum (a)
   "Return 1 if A is positive, -1 if negative, 0 if zero."
   (cond ((> a 0) 1) ((< a 0) -1) (t 0)))
 
-
 ;; Random numbers.
 
 (defvar *random-state*)

--- a/man/ChangeLog	Sun Aug 16 20:55:49 2009 +0100
+++ b/man/ChangeLog	Tue Aug 11 17:59:23 2009 +0100
@@ -1,3 +1,9 @@
+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).
+
 2009-08-11  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* cl.texi (Organization): 

--- a/man/lispref/numbers.texi	Sun Aug 16 20:55:49 2009 +0100
+++ b/man/lispref/numbers.texi	Tue Aug 11 17:59:23 2009 +0100
@@ -410,7 +410,8 @@
 
 It is possible to make bigfloat the default floating point format by
 setting @code{default-float-precision} to a non-zero value.  Precision
-is given in bits, with a maximum precision of @code{bigfloat-max-prec}.
+is given in bits, with a maximum precision of
+@code{bigfloat-maximum-precision}.
 @c #### is this true?
 Bigfloats are created automatically when a number with yes
 

--- a/src/ChangeLog	Sun Aug 16 20:55:49 2009 +0100
+++ b/src/ChangeLog	Tue Aug 11 17:59:23 2009 +0100
@@ -1,3 +1,50 @@
+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.
+
 2009-08-11  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* bytecode.c (enum Opcode /* Byte codes */): 

--- a/src/bytecode.c	Sun Aug 16 20:55:49 2009 +0100
+++ b/src/bytecode.c	Tue Aug 11 17:59:23 2009 +0100
@@ -301,8 +301,8 @@
 #ifdef HAVE_RATIO
   if (RATIOP (obj)) RATIO_ARITH_RETURN (obj, neg);
 #endif
-#ifdef HAVE_BIG_FLOAT
-  if (BIGFLOAT_P (obj)) BIGFLOAT_ARITH_RETURN (obj, neg);
+#ifdef HAVE_BIGFLOAT
+  if (BIGFLOATP (obj)) BIGFLOAT_ARITH_RETURN (obj, neg);
 #endif
 
   obj = wrong_type_argument (Qnumber_char_or_marker_p, obj);

--- a/src/doprnt.c	Sun Aug 16 20:55:49 2009 +0100
+++ b/src/doprnt.c	Tue Aug 11 17:59:23 2009 +0100
@@ -638,7 +638,7 @@
 	      else
 		{
 		  if (FLOATP (obj))
-		    obj = Ftruncate (obj);
+		    obj = Ftruncate (obj, Qnil);
 #ifdef HAVE_BIGFLOAT
 		  else if (BIGFLOATP (obj))
 		    {

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

--- a/src/lisp.h	Sun Aug 16 20:55:49 2009 +0100
+++ b/src/lisp.h	Tue Aug 11 17:59:23 2009 +0100
@@ -4705,7 +4705,7 @@
 void unlock_buffer (struct buffer *);
 
 /* Defined in floatfns.c */
-EXFUN (Ftruncate, 1);
+EXFUN (Ftruncate, 2);
 
 double extract_float (Lisp_Object);
 

--- a/src/number.c	Sun Aug 16 20:55:49 2009 +0100
+++ b/src/number.c	Tue Aug 11 17:59:23 2009 +0100
@@ -41,7 +41,7 @@
 bignum scratch_bignum, scratch_bignum2;
 #endif
 #ifdef HAVE_RATIO
-ratio scratch_ratio;
+ratio scratch_ratio, scratch_ratio2;
 #endif
 #ifdef HAVE_BIGFLOAT
 bigfloat scratch_bigfloat, scratch_bigfloat2;
@@ -561,7 +561,7 @@
       switch (type)
 	{
 	case FIXNUM_T:
-	  return Ftruncate (number);
+	  return Ftruncate (number, Qnil);
 	case BIGNUM_T:
 #ifdef HAVE_BIGNUM
 	  bignum_set_double (scratch_bignum, XFLOAT_DATA (number));
@@ -853,6 +853,7 @@
 
 #ifdef HAVE_RATIO
       ratio_init (scratch_ratio);
+      ratio_init (scratch_ratio2);
 #endif
 
 #ifdef HAVE_BIGFLOAT

--- a/src/number.h	Sun Aug 16 20:55:49 2009 +0100
+++ b/src/number.h	Tue Aug 11 17:59:23 2009 +0100
@@ -195,7 +195,7 @@
 extern Lisp_Object make_ratio (long, unsigned long);
 extern Lisp_Object make_ratio_bg (bignum, bignum);
 extern Lisp_Object make_ratio_rt (ratio);
-extern ratio scratch_ratio;
+extern ratio scratch_ratio, scratch_ratio2;
 
 #else /* !HAVE_RATIO */
 
@@ -251,16 +251,16 @@
 #define XBIGFLOAT_GET_PREC(x) bigfloat_get_prec (XBIGFLOAT_DATA (x))
 #define XBIGFLOAT_SET_PREC(x,p) bigfloat_set_prec (XBIGFLOAT_DATA (x), p)
 
-#define BIGFLOAT_ARITH_RETURN(f,op) do				\
-{								\
-  Lisp_Object retval = make_bigfloat_bf (f);			\
+#define BIGFLOAT_ARITH_RETURN(f,op) do					\
+{									\
+  Lisp_Object retval = make_bigfloat (0.0, bigfloat_get_default_prec()); \
   bigfloat_##op (XBIGFLOAT_DATA (retval), XBIGFLOAT_DATA (f));	\
   return retval;						\
 } while (0)
 
 #define BIGFLOAT_ARITH_RETURN1(f,op,arg) do				\
 {									\
-  Lisp_Object retval = make_bigfloat_bf (f);				\
+  Lisp_Object retval = make_bigfloat (0.0, bigfloat_get_default_prec()); \
   bigfloat_##op (XBIGFLOAT_DATA (retval), XBIGFLOAT_DATA (f), arg);	\
   return retval;							\
 } while (0)

--- a/tests/ChangeLog	Sun Aug 16 20:55:49 2009 +0100
+++ b/tests/ChangeLog	Tue Aug 11 17:59:23 2009 +0100
@@ -1,3 +1,11 @@
+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. 
+
 2009-08-10  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/mule-tests.el: 

--- a/tests/automated/lisp-tests.el	Sun Aug 16 20:55:49 2009 +0100
+++ b/tests/automated/lisp-tests.el	Tue Aug 11 17:59:23 2009 +0100
@@ -1368,5 +1368,574 @@
    (load test-file-name nil t nil)
    (delete-file test-file-name))
 
+(flet ((cl-floor (x &optional y)
+	 (let ((q (floor x y)))
+	   (list q (- x (if y (* y q) q)))))
+       (cl-ceiling (x &optional y)
+	 (let ((res (cl-floor x y)))
+	   (if (= (car (cdr res)) 0) res
+	     (list (1+ (car res)) (- (car (cdr res)) (or y 1))))))
+       (cl-truncate (x &optional y)
+	 (if (eq (>= x 0) (or (null y) (>= y 0)))
+	     (cl-floor x y) (cl-ceiling x y)))
+       (cl-round (x &optional y)
+	 (if y
+	     (if (and (integerp x) (integerp y))
+		 (let* ((hy (/ y 2))
+			(res (cl-floor (+ x hy) y)))
+		   (if (and (= (car (cdr res)) 0)
+			    (= (+ hy hy) y)
+			    (/= (% (car res) 2) 0))
+		       (list (1- (car res)) hy)
+		     (list (car res) (- (car (cdr res)) hy))))
+	       (let ((q (round (/ x y))))
+		 (list q (- x (* q y)))))
+	   (if (integerp x) (list x 0)
+	     (let ((q (round x)))
+	       (list q (- x q))))))
+       (Assert-rounding (first second &key
+			 one-floor-result two-floor-result 
+			 one-ffloor-result two-ffloor-result 
+			 one-ceiling-result two-ceiling-result
+			 one-fceiling-result two-fceiling-result
+			 one-round-result two-round-result
+			 one-fround-result two-fround-result
+			 one-truncate-result two-truncate-result
+			 one-ftruncate-result two-ftruncate-result)
+	 (Assert (equal one-floor-result (multiple-value-list
+					  (floor first)))
+		 (format "checking (floor %S) gives %S"
+			 first one-floor-result))
+	 (Assert (equal one-floor-result (multiple-value-list
+					  (floor first 1)))
+		 (format "checking (floor %S 1) gives %S"
+			 first one-floor-result))
+	 (Check-Error arith-error (floor first 0))
+	 (Check-Error arith-error (floor first 0.0))
+	 (Assert (equal two-floor-result (multiple-value-list
+					  (floor first second)))
+		 (format
+		  "checking (floor %S %S) gives %S"
+		  first second two-floor-result))
+	 (Assert (equal (cl-floor first second)
+			(multiple-value-list (floor first second)))
+		 (format
+		  "checking (floor %S %S) gives the same as the old code"
+		  first second))
+	 (Assert (equal one-ffloor-result (multiple-value-list
+					   (ffloor first)))
+		 (format "checking (ffloor %S) gives %S"
+			 first one-ffloor-result))
+	 (Assert (equal one-ffloor-result (multiple-value-list
+					   (ffloor first 1)))
+		 (format "checking (ffloor %S 1) gives %S"
+			 first one-ffloor-result))
+	 (Check-Error arith-error (ffloor first 0))
+	 (Check-Error arith-error (ffloor first 0.0))
+	 (Assert (equal two-ffloor-result (multiple-value-list
+					   (ffloor first second)))
+		 (format "checking (ffloor %S %S) gives %S"
+			 first second two-ffloor-result))
+	 (Assert (equal one-ceiling-result (multiple-value-list
+					    (ceiling first)))
+		 (format "checking (ceiling %S) gives %S"
+			 first one-ceiling-result))
+	 (Assert (equal one-ceiling-result (multiple-value-list
+					    (ceiling first 1)))
+		 (format "checking (ceiling %S 1) gives %S"
+			 first one-ceiling-result))
+	 (Check-Error arith-error (ceiling first 0))
+	 (Check-Error arith-error (ceiling first 0.0))
+	 (Assert (equal two-ceiling-result (multiple-value-list
+					    (ceiling first second)))
+		 (format "checking (ceiling %S %S) gives %S"
+			 first second two-ceiling-result))
+	 (Assert (equal (cl-ceiling first second)
+			(multiple-value-list (ceiling first second)))
+		 (format
+		  "checking (ceiling %S %S) gives the same as the old code"
+		  first second))
+	 (Assert (equal one-fceiling-result (multiple-value-list
+					     (fceiling first)))
+		 (format "checking (fceiling %S) gives %S"
+			 first one-fceiling-result))
+	 (Assert (equal one-fceiling-result (multiple-value-list
+					     (fceiling first 1)))
+		 (format "checking (fceiling %S 1) gives %S"
+			 first one-fceiling-result))
+	 (Check-Error arith-error (fceiling first 0))
+	 (Check-Error arith-error (fceiling first 0.0))
+	 (Assert (equal two-fceiling-result (multiple-value-list
+					  (fceiling first second)))
+		 (format "checking (fceiling %S %S) gives %S"
+			 first second two-fceiling-result))
+	 (Assert (equal one-round-result (multiple-value-list
+					  (round first)))
+		 (format "checking (round %S) gives %S"
+			 first one-round-result))
+	 (Assert (equal one-round-result (multiple-value-list
+					  (round first 1)))
+		 (format "checking (round %S 1) gives %S, types %S, actual %S, types %S"
+			 first one-round-result (mapcar #'type-of one-round-result)
+			 (multiple-value-list (round first 1))
+			 (mapcar #'type-of (multiple-value-list (round first 1)))))
 
+	 (Check-Error arith-error (round first 0))
+	 (Check-Error arith-error (round first 0.0))
+	 (Assert (equal two-round-result (multiple-value-list
+					  (round first second)))
+		 (format "checking (round %S %S) gives %S"
+			 first second two-round-result))
+	 (Assert (equal one-fround-result (multiple-value-list
+					   (fround first)))
+		 (format "checking (fround %S) gives %S"
+			 first one-fround-result))
+	 (Assert (equal one-fround-result (multiple-value-list
+					   (fround first 1)))
+		 (format "checking (fround %S 1) gives %S"
+			 first one-fround-result))
+	 (Check-Error arith-error (fround first 0))
+	 (Check-Error arith-error (fround first 0.0))
+	 (Assert (equal two-fround-result (multiple-value-list
+					   (fround first second)))
+		 (format "checking (fround %S %S) gives %S"
+			 first second two-fround-result))
+	 (Assert (equal (cl-round first second)
+			(multiple-value-list (round first second)))
+		 (format
+		  "checking (round %S %S) gives the same as the old code"
+		  first second))
+	 (Assert (equal one-truncate-result (multiple-value-list
+					     (truncate first)))
+		 (format "checking (truncate %S) gives %S"
+			 first one-truncate-result))
+	 (Assert (equal one-truncate-result (multiple-value-list
+					     (truncate first 1)))
+		 (format "checking (truncate %S 1) gives %S"
+			 first one-truncate-result))
+	 (Check-Error arith-error (truncate first 0))
+	 (Check-Error arith-error (truncate first 0.0))
+	 (Assert (equal two-truncate-result (multiple-value-list
+					     (truncate first second)))
+		 (format "checking (truncate %S %S) gives %S"
+			 first second two-truncate-result))
+	 (Assert (equal (cl-truncate first second)
+			(multiple-value-list (truncate first second)))
+		 (format
+		  "checking (truncate %S %S) gives the same as the old code"
+		  first second))
+	 (Assert (equal one-ftruncate-result (multiple-value-list
+					      (ftruncate first)))
+		 (format "checking (ftruncate %S) gives %S"
+			 first one-ftruncate-result))
+	 (Assert (equal one-ftruncate-result (multiple-value-list
+					      (ftruncate first 1)))
+		 (format "checking (ftruncate %S 1) gives %S"
+			 first one-ftruncate-result))
+	 (Check-Error arith-error (ftruncate first 0))
+	 (Check-Error arith-error (ftruncate first 0.0))
+	 (Assert (equal two-ftruncate-result (multiple-value-list
+					      (ftruncate first second)))
+		 (format "checking (ftruncate %S %S) gives %S"
+			 first second two-ftruncate-result)))
+       (Assert-rounding-floating (pie ee)
+	 (let ((pie-type (type-of pie)))
+	   (assert (eq pie-type (type-of ee)) t
+		   "This code assumes the two arguments have the same type.")
+	   (Assert-rounding pie ee
+  	    :one-floor-result (list 3 (- pie 3))
+            :two-floor-result (list 1 (- pie (* 1 ee)))
+            :one-ffloor-result (list (coerce 3 pie-type) (- pie 3.0))
+            :two-ffloor-result (list (coerce 1 pie-type) (- pie (* 1.0 ee)))
+            :one-ceiling-result (list 4 (- pie 4))
+            :two-ceiling-result (list 2 (- pie (* 2 ee)))
+            :one-fceiling-result (list (coerce 4 pie-type) (- pie 4.0))
+            :two-fceiling-result (list (coerce 2 pie-type) (- pie (* 2.0 ee)))
+            :one-round-result (list 3 (- pie 3))
+            :two-round-result (list 1 (- pie (* 1 ee)))
+            :one-fround-result (list (coerce 3 pie-type) (- pie 3.0))
+            :two-fround-result (list (coerce 1 pie-type) (- pie (* 1.0 ee)))
+            :one-truncate-result (list 3 (- pie 3))
+            :two-truncate-result (list 1 (- pie (* 1 ee)))
+            :one-ftruncate-result (list (coerce 3 pie-type) (- pie 3.0))
+            :two-ftruncate-result (list (coerce 1 pie-type)
+					(- pie (* 1.0 ee))))
+  	 (Assert-rounding pie (- ee)
+            :one-floor-result (list 3 (- pie 3))
+            :two-floor-result (list -2 (- pie (* -2 (- ee))))
+            :one-ffloor-result (list (coerce 3 pie-type) (- pie 3.0))
+            :two-ffloor-result (list (coerce -2 pie-type)
+				     (- pie (* -2.0 (- ee))))
+            :one-ceiling-result (list 4 (- pie 4))
+            :two-ceiling-result (list -1 (- pie (* -1 (- ee))))
+            :one-fceiling-result (list (coerce 4 pie-type) (- pie 4.0))
+            :two-fceiling-result (list (coerce -1 pie-type)
+				       (- pie (* -1.0 (- ee))))
+            :one-round-result (list 3 (- pie 3))
+            :two-round-result (list -1 (- pie (* -1 (- ee))))
+            :one-fround-result (list (coerce 3 pie-type) (- pie 3.0))
+            :two-fround-result (list (coerce -1 pie-type)
+				     (- pie (* -1.0 (- ee))))
+            :one-truncate-result (list 3 (- pie 3))
+            :two-truncate-result (list -1 (- pie (* -1 (- ee))))
+            :one-ftruncate-result (list (coerce 3 pie-type) (- pie 3.0))
+            :two-ftruncate-result (list (coerce -1 pie-type)
+					(- pie (* -1.0 (- ee)))))
+  	 (Assert-rounding (- pie) ee
+            :one-floor-result (list -4 (- (- pie) -4))
+            :two-floor-result (list -2 (- (- pie) (* -2 ee)))
+            :one-ffloor-result (list (coerce -4 pie-type) (- (- pie) -4.0))
+            :two-ffloor-result (list (coerce -2 pie-type)
+				     (- (- pie) (* -2.0 ee)))
+            :one-ceiling-result (list -3 (- (- pie) -3))
+            :two-ceiling-result (list -1 (- (- pie) (* -1 ee)))
+            :one-fceiling-result (list (coerce -3 pie-type) (- (- pie) -3.0))
+            :two-fceiling-result (list (coerce -1 pie-type)
+				       (- (- pie) (* -1.0 ee)))
+            :one-round-result (list -3 (- (- pie) -3))
+            :two-round-result (list -1 (- (- pie) (* -1 ee)))
+            :one-fround-result (list (coerce -3 pie-type) (- (- pie) -3.0))
+            :two-fround-result (list (coerce -1 pie-type)
+				     (- (- pie) (* -1.0 ee)))
+            :one-truncate-result (list -3 (- (- pie) -3))
+            :two-truncate-result (list -1 (- (- pie) (* -1 ee)))
+            :one-ftruncate-result (list (coerce -3 pie-type) (- (- pie) -3.0))
+            :two-ftruncate-result (list (coerce -1 pie-type)
+					(- (- pie) (* -1.0 ee))))
+  	 (Assert-rounding (- pie) (- ee)
+            :one-floor-result (list -4 (- (- pie) -4))
+            :two-floor-result (list 1 (- (- pie) (* 1 (- ee))))
+            :one-ffloor-result (list (coerce -4 pie-type) (- (- pie) -4.0))
+            :two-ffloor-result (list (coerce 1 pie-type)
+				     (- (- pie) (* 1.0 (- ee))))
+            :one-ceiling-result (list -3 (- (- pie) -3))
+            :two-ceiling-result (list 2 (- (- pie) (* 2 (- ee))))
+            :one-fceiling-result (list (coerce -3 pie-type) (- (- pie) -3.0))
+            :two-fceiling-result (list (coerce 2 pie-type)
+				       (- (- pie) (* 2.0 (- ee))))
+            :one-round-result (list -3 (- (- pie) -3))
+            :two-round-result (list 1 (- (- pie) (* 1 (- ee))))
+            :one-fround-result (list (coerce -3 pie-type) (- (- pie) -3.0))
+            :two-fround-result (list (coerce 1 pie-type)
+				     (- (- pie) (* 1.0 (- ee))))
+            :one-truncate-result (list -3 (- (- pie) -3))
+            :two-truncate-result (list 1 (- (- pie) (* 1 (- ee))))
+            :one-ftruncate-result (list (coerce -3 pie-type) (- (- pie) -3.0))
+            :two-ftruncate-result (list (coerce 1 pie-type)
+					(- (- pie) (* 1.0 (- ee)))))
+  	 (Assert-rounding ee pie
+            :one-floor-result (list 2 (- ee 2))
+            :two-floor-result (list 0 ee)
+            :one-ffloor-result (list (coerce 2 pie-type) (- ee 2.0))
+            :two-ffloor-result (list (coerce 0 pie-type) ee)
+            :one-ceiling-result (list 3 (- ee 3))
+            :two-ceiling-result (list 1 (- ee pie))
+            :one-fceiling-result (list (coerce 3 pie-type) (- ee 3.0))
+            :two-fceiling-result (list (coerce 1 pie-type) (- ee pie))
+            :one-round-result (list 3 (- ee 3))
+            :two-round-result (list 1 (- ee (* 1 pie)))
+            :one-fround-result (list (coerce 3 pie-type) (- ee 3.0))
+            :two-fround-result (list (coerce 1 pie-type) (- ee (* 1.0 pie)))
+            :one-truncate-result (list 2 (- ee 2))
+            :two-truncate-result (list 0 ee)
+            :one-ftruncate-result (list (coerce 2 pie-type) (- ee 2.0))
+            :two-ftruncate-result (list (coerce 0 pie-type) ee))
+  	 (Assert-rounding ee (- pie)
+            :one-floor-result (list 2 (- ee 2))
+            :two-floor-result (list -1 (- ee (* -1 (- pie))))
+            :one-ffloor-result (list (coerce 2 pie-type) (- ee 2.0))
+            :two-ffloor-result (list (coerce -1 pie-type)
+				     (- ee (* -1.0 (- pie))))
+            :one-ceiling-result (list 3 (- ee 3))
+            :two-ceiling-result (list 0 ee)
+            :one-fceiling-result (list (coerce 3 pie-type) (- ee 3.0))
+            :two-fceiling-result (list (coerce 0 pie-type) ee)
+            :one-round-result (list 3 (- ee 3))
+            :two-round-result (list -1 (- ee (* -1 (- pie))))
+            :one-fround-result (list (coerce 3 pie-type) (- ee 3.0))
+            :two-fround-result (list (coerce -1 pie-type)
+				     (- ee (* -1.0 (- pie))))
+            :one-truncate-result (list 2 (- ee 2))
+            :two-truncate-result (list 0 ee)
+            :one-ftruncate-result (list (coerce 2 pie-type) (- ee 2.0))
+            :two-ftruncate-result (list (coerce 0 pie-type) ee)))))
+    ;; First, two integers: 
+  (Assert-rounding 27 8 :one-floor-result '(27 0) :two-floor-result '(3 3)
+    :one-ffloor-result '(27.0 0) :two-ffloor-result '(3.0 3)
+    :one-ceiling-result '(27 0) :two-ceiling-result '(4 -5)
+    :one-fceiling-result '(27.0 0) :two-fceiling-result '(4.0 -5)
+    :one-round-result '(27 0) :two-round-result '(3 3)
+    :one-fround-result '(27.0 0) :two-fround-result '(3.0 3)
+    :one-truncate-result '(27 0) :two-truncate-result '(3 3)
+    :one-ftruncate-result '(27.0 0) :two-ftruncate-result '(3.0 3))
+  (Assert-rounding 27 -8 :one-floor-result '(27 0)  :two-floor-result '(-4 -5)
+    :one-ffloor-result '(27.0 0) :two-ffloor-result '(-4.0 -5) 
+    :one-ceiling-result '(27 0) :two-ceiling-result '(-3 3)
+    :one-fceiling-result '(27.0 0)  :two-fceiling-result '(-3.0 3)
+    :one-round-result '(27 0) :two-round-result '(-3 3)
+    :one-fround-result '(27.0 0) :two-fround-result '(-3.0 3)
+    :one-truncate-result '(27 0) :two-truncate-result '(-3 3)
+    :one-ftruncate-result '(27.0 0)  :two-ftruncate-result '(-3.0 3))
+  (Assert-rounding -27 8
+    :one-floor-result '(-27 0) :two-floor-result '(-4 5)
+    :one-ffloor-result '(-27.0 0) :two-ffloor-result '(-4.0 5)
+    :one-ceiling-result '(-27 0) :two-ceiling-result '(-3 -3)
+    :one-fceiling-result '(-27.0 0) :two-fceiling-result '(-3.0 -3)
+    :one-round-result '(-27 0) :two-round-result '(-3 -3)
+    :one-fround-result '(-27.0 0) :two-fround-result '(-3.0 -3)
+    :one-truncate-result '(-27 0) :two-truncate-result '(-3 -3)
+    :one-ftruncate-result '(-27.0 0) :two-ftruncate-result '(-3.0 -3))
+  (Assert-rounding -27 -8
+    :one-floor-result '(-27 0) :two-floor-result '(3 -3)
+    :one-ffloor-result '(-27.0 0) :two-ffloor-result '(3.0 -3)
+    :one-ceiling-result '(-27 0) :two-ceiling-result '(4 5)
+    :one-fceiling-result '(-27.0 0) :two-fceiling-result '(4.0 5)
+    :one-round-result '(-27 0) :two-round-result '(3 -3)
+    :one-fround-result '(-27.0 0) :two-fround-result '(3.0 -3)
+    :one-truncate-result '(-27 0) :two-truncate-result '(3 -3)
+    :one-ftruncate-result '(-27.0 0) :two-ftruncate-result '(3.0 -3))
+  (Assert-rounding 8 27
+    :one-floor-result '(8 0) :two-floor-result '(0 8)
+    :one-ffloor-result '(8.0 0) :two-ffloor-result '(0.0 8)
+    :one-ceiling-result '(8 0) :two-ceiling-result '(1 -19)
+    :one-fceiling-result '(8.0 0) :two-fceiling-result '(1.0 -19)
+    :one-round-result '(8 0) :two-round-result '(0 8)
+    :one-fround-result '(8.0 0) :two-fround-result '(0.0 8)
+    :one-truncate-result '(8 0) :two-truncate-result '(0 8)
+    :one-ftruncate-result '(8.0 0) :two-ftruncate-result '(0.0 8))
+  (Assert-rounding 8 -27
+    :one-floor-result '(8 0) :two-floor-result '(-1 -19)
+    :one-ffloor-result '(8.0 0) :two-ffloor-result '(-1.0 -19)
+    :one-ceiling-result '(8 0) :two-ceiling-result '(0 8)
+    :one-fceiling-result '(8.0 0) :two-fceiling-result '(0.0 8)
+    :one-round-result '(8 0) :two-round-result '(0 8)
+    :one-fround-result '(8.0 0) :two-fround-result '(0.0 8)
+    :one-truncate-result '(8 0) :two-truncate-result '(0 8)
+    :one-ftruncate-result '(8.0 0) :two-ftruncate-result '(0.0 8))
+  (Assert-rounding -8 27
+    :one-floor-result '(-8 0) :two-floor-result '(-1 19)
+    :one-ffloor-result '(-8.0 0) :two-ffloor-result '(-1.0 19)
+    :one-ceiling-result '(-8 0) :two-ceiling-result '(0 -8)
+    :one-fceiling-result '(-8.0 0) :two-fceiling-result '(0.0 -8)
+    :one-round-result '(-8 0) :two-round-result '(0 -8)
+    :one-fround-result '(-8.0 0) :two-fround-result '(0.0 -8)
+    :one-truncate-result '(-8 0) :two-truncate-result '(0 -8)
+    :one-ftruncate-result '(-8.0 0) :two-ftruncate-result '(0.0 -8))
+  (Assert-rounding -8 -27
+    :one-floor-result '(-8 0) :two-floor-result '(0 -8)
+    :one-ffloor-result '(-8.0 0) :two-ffloor-result '(0.0 -8)
+    :one-ceiling-result '(-8 0) :two-ceiling-result '(1 19)
+    :one-fceiling-result '(-8.0 0) :two-fceiling-result '(1.0 19)
+    :one-round-result '(-8 0) :two-round-result '(0 -8)
+    :one-fround-result '(-8.0 0) :two-fround-result '(0.0 -8)
+    :one-truncate-result '(-8 0) :two-truncate-result '(0 -8)
+    :one-ftruncate-result '(-8.0 0) :two-ftruncate-result '(0.0 -8))
+  (Assert-rounding 32 4
+    :one-floor-result '(32 0) :two-floor-result '(8 0)
+    :one-ffloor-result '(32.0 0) :two-ffloor-result '(8.0 0)
+    :one-ceiling-result '(32 0) :two-ceiling-result '(8 0)
+    :one-fceiling-result '(32.0 0) :two-fceiling-result '(8.0 0)
+    :one-round-result '(32 0) :two-round-result '(8 0)
+    :one-fround-result '(32.0 0) :two-fround-result '(8.0 0)
+    :one-truncate-result '(32 0) :two-truncate-result '(8 0)
+    :one-ftruncate-result '(32.0 0) :two-ftruncate-result '(8.0 0))
+  (Assert-rounding 32 -4
+    :one-floor-result '(32 0) :two-floor-result '(-8 0)
+    :one-ffloor-result '(32.0 0) :two-ffloor-result '(-8.0 0)
+    :one-ceiling-result '(32 0) :two-ceiling-result '(-8 0)
+    :one-fceiling-result '(32.0 0) :two-fceiling-result '(-8.0 0)
+    :one-round-result '(32 0) :two-round-result '(-8 0)
+    :one-fround-result '(32.0 0) :two-fround-result '(-8.0 0)
+    :one-truncate-result '(32 0) :two-truncate-result '(-8 0)
+    :one-ftruncate-result '(32.0 0) :two-ftruncate-result '(-8.0 0))
+  (Assert-rounding 12 9
+    :one-floor-result '(12 0) :two-floor-result '(1 3)
+    :one-ffloor-result '(12.0 0) :two-ffloor-result '(1.0 3)
+    :one-ceiling-result '(12 0) :two-ceiling-result '(2 -6)
+    :one-fceiling-result '(12.0 0) :two-fceiling-result '(2.0 -6)
+    :one-round-result '(12 0) :two-round-result '(1 3)
+    :one-fround-result '(12.0 0) :two-fround-result '(1.0 3)
+    :one-truncate-result '(12 0) :two-truncate-result '(1 3)
+    :one-ftruncate-result '(12.0 0) :two-ftruncate-result '(1.0 3))
+  (Assert-rounding 10 4
+    :one-floor-result '(10 0) :two-floor-result '(2 2)
+    :one-ffloor-result '(10.0 0) :two-ffloor-result '(2.0 2)
+    :one-ceiling-result '(10 0) :two-ceiling-result '(3 -2)
+    :one-fceiling-result '(10.0 0) :two-fceiling-result '(3.0 -2)
+    :one-round-result '(10 0) :two-round-result '(2 2)
+    :one-fround-result '(10.0 0) :two-fround-result '(2.0 2)
+    :one-truncate-result '(10 0) :two-truncate-result '(2 2)
+    :one-ftruncate-result '(10.0 0) :two-ftruncate-result '(2.0 2))
+  (Assert-rounding 14 4
+    :one-floor-result '(14 0) :two-floor-result '(3 2)
+    :one-ffloor-result '(14.0 0) :two-ffloor-result '(3.0 2)
+    :one-ceiling-result '(14 0) :two-ceiling-result '(4 -2)
+    :one-fceiling-result '(14.0 0) :two-fceiling-result '(4.0 -2)
+    :one-round-result '(14 0) :two-round-result '(4 -2)
+    :one-fround-result '(14.0 0) :two-fround-result '(4.0 -2)
+    :one-truncate-result '(14 0) :two-truncate-result '(3 2)
+    :one-ftruncate-result '(14.0 0) :two-ftruncate-result '(3.0 2))
+  ;; Now, two floats:
+  (Assert-rounding-floating pi e)
+  (when (featurep 'bigfloat)
+    (Assert-rounding-floating (coerce pi 'bigfloat) (coerce e 'bigfloat)))
+  (when (featurep 'bignum)
+    (assert (not (evenp most-positive-fixnum)) t
+      "In the unlikely event that most-positive-fixnum is even, rewrite this.")
+    (Assert-rounding (1+ most-positive-fixnum) (* 2 most-positive-fixnum)
+      :one-floor-result `(,(1+ most-positive-fixnum) 0)
+      :two-floor-result `(0 ,(1+ most-positive-fixnum))
+      :one-ffloor-result `(,(float (1+ most-positive-fixnum)) 0)
+      :two-ffloor-result `(0.0 ,(1+ most-positive-fixnum))
+      :one-ceiling-result `(,(1+ most-positive-fixnum) 0)
+      :two-ceiling-result `(1 ,(1+ (- most-positive-fixnum)))
+      :one-fceiling-result `(,(float (1+ most-positive-fixnum)) 0)
+      :two-fceiling-result `(1.0 ,(1+ (- most-positive-fixnum)))
+      :one-round-result `(,(1+ most-positive-fixnum) 0)
+      :two-round-result `(1 ,(1+ (- most-positive-fixnum)))
+      :one-fround-result `(,(float (1+ most-positive-fixnum)) 0)
+      :two-fround-result `(1.0 ,(1+ (- most-positive-fixnum)))
+      :one-truncate-result `(,(1+ most-positive-fixnum) 0)
+      :two-truncate-result `(0 ,(1+ most-positive-fixnum))
+      :one-ftruncate-result `(,(float (1+ most-positive-fixnum)) 0)
+      :two-ftruncate-result `(0.0 ,(1+ most-positive-fixnum)))
+    (Assert-rounding (1+ most-positive-fixnum) (- (* 2 most-positive-fixnum))
+      :one-floor-result `(,(1+ most-positive-fixnum) 0)
+      :two-floor-result `(-1 ,(1+ (- most-positive-fixnum)))
+      :one-ffloor-result `(,(float (1+ most-positive-fixnum)) 0)
+      :two-ffloor-result `(-1.0 ,(1+ (- most-positive-fixnum)))
+      :one-ceiling-result `(,(1+ most-positive-fixnum) 0)
+      :two-ceiling-result `(0 ,(1+ most-positive-fixnum))
+      :one-fceiling-result `(,(float (1+ most-positive-fixnum)) 0)
+      :two-fceiling-result `(0.0 ,(1+ most-positive-fixnum))
+      :one-round-result `(,(1+ most-positive-fixnum) 0)
+      :two-round-result `(-1 ,(1+ (- most-positive-fixnum)))
+      :one-fround-result `(,(float (1+ most-positive-fixnum)) 0)
+      :two-fround-result `(-1.0 ,(1+ (- most-positive-fixnum)))
+      :one-truncate-result `(,(1+ most-positive-fixnum) 0)
+      :two-truncate-result `(0 ,(1+ most-positive-fixnum))
+      :one-ftruncate-result `(,(float (1+ most-positive-fixnum)) 0)
+      :two-ftruncate-result `(0.0 ,(1+ most-positive-fixnum)))
+    (Assert-rounding (- (1+ most-positive-fixnum)) (* 2 most-positive-fixnum)
+      :one-floor-result `(,(- (1+ most-positive-fixnum)) 0)
+      :two-floor-result `(-1 ,(1- most-positive-fixnum))
+      :one-ffloor-result `(,(float (- (1+ most-positive-fixnum))) 0)
+      :two-ffloor-result `(-1.0 ,(1- most-positive-fixnum))
+      :one-ceiling-result `(,(- (1+ most-positive-fixnum)) 0)
+      :two-ceiling-result `(0 ,(- (1+ most-positive-fixnum)))
+      :one-fceiling-result `(,(float (- (1+ most-positive-fixnum))) 0)
+      :two-fceiling-result `(0.0 ,(- (1+ most-positive-fixnum)))
+      :one-round-result `(,(- (1+ most-positive-fixnum)) 0)
+      :two-round-result `(-1 ,(1- most-positive-fixnum))
+      :one-fround-result `(,(float (- (1+ most-positive-fixnum))) 0)
+      :two-fround-result `(-1.0 ,(1- most-positive-fixnum))
+      :one-truncate-result `(,(- (1+ most-positive-fixnum)) 0)
+      :two-truncate-result `(0 ,(- (1+ most-positive-fixnum)))
+      :one-ftruncate-result `(,(float (- (1+ most-positive-fixnum))) 0)
+      :two-ftruncate-result `(0.0 ,(- (1+ most-positive-fixnum))))
+    ;; Test the handling of values with .5: 
+    (Assert-rounding (1+ (* 2 most-positive-fixnum)) 2
+      :one-floor-result `(,(1+ (* 2 most-positive-fixnum)) 0)
+      :two-floor-result `(,most-positive-fixnum 1)
+      :one-ffloor-result `(,(float (1+ (* 2 most-positive-fixnum))) 0)
+      ;; We can't just call #'float here; we must use code that converts a
+      ;; bignum with value most-positive-fixnum (the creation of which is
+      ;; not directly possible in Lisp) to a float, not code that converts
+      ;; the fixnum with value most-positive-fixnum to a float. The eval is
+      ;; to avoid compile-time optimisation that can break this.
+      :two-ffloor-result `(,(eval '(- (1+ most-positive-fixnum) 1 0.0)) 1)
+      :one-ceiling-result `(,(1+ (* 2 most-positive-fixnum)) 0)
+      :two-ceiling-result `(,(1+ most-positive-fixnum) -1)
+      :one-fceiling-result `(,(float (1+ (* 2 most-positive-fixnum))) 0)
+      :two-fceiling-result `(,(float (1+ most-positive-fixnum)) -1)
+      :one-round-result `(,(1+ (* 2 most-positive-fixnum)) 0)
+      :two-round-result `(,(1+ most-positive-fixnum) -1)
+      :one-fround-result `(,(float (1+ (* 2 most-positive-fixnum))) 0)
+      :two-fround-result `(,(float (1+ most-positive-fixnum)) -1)
+      :one-truncate-result `(,(1+ (* 2 most-positive-fixnum)) 0)
+      :two-truncate-result `(,most-positive-fixnum 1)
+      :one-ftruncate-result `(,(float (1+ (* 2 most-positive-fixnum))) 0)
+      ;; See the comment above on :two-ffloor-result:
+      :two-ftruncate-result `(,(eval '(- (1+ most-positive-fixnum) 1 0.0)) 1))
+    (Assert-rounding (1+ (* 2 (1- most-positive-fixnum))) 2
+      :one-floor-result `(,(1+ (* 2 (1- most-positive-fixnum))) 0)
+      :two-floor-result `(,(1- most-positive-fixnum) 1)
+      :one-ffloor-result `(,(float (1+ (* 2 (1- most-positive-fixnum)))) 0)
+      ;; See commentary above on float conversions.
+      :two-ffloor-result `(,(eval '(- (1+ most-positive-fixnum) 2 0.0)) 1)
+      :one-ceiling-result `(,(1+ (* 2 (1- most-positive-fixnum))) 0)
+      :two-ceiling-result `(,most-positive-fixnum -1)
+      :one-fceiling-result `(,(float (1+ (* 2 (1- most-positive-fixnum)))) 0)
+      :two-fceiling-result `(,(eval '(- (1+ most-positive-fixnum) 1 0.0)) -1)
+      :one-round-result `(,(1+ (* 2 (1- most-positive-fixnum))) 0)
+      :two-round-result `(,(1- most-positive-fixnum) 1)
+      :one-fround-result `(,(float (1+ (* 2 (1- most-positive-fixnum)))) 0)
+      :two-fround-result `(,(eval '(- (1+ most-positive-fixnum) 2 0.0)) 1)
+      :one-truncate-result `(,(1+ (* 2 (1- most-positive-fixnum))) 0)
+      :two-truncate-result `(,(1- most-positive-fixnum) 1)
+      :one-ftruncate-result `(,(float (1+ (* 2 (1- most-positive-fixnum)))) 0)
+      ;; See commentary above
+      :two-ftruncate-result `(,(eval '(- (1+ most-positive-fixnum) 2 0.0))
+			      1)))
+  (when (featurep 'ratio)
+    (Assert-rounding (read "4/3") (read "8/7")
+     :one-floor-result '(1 1/3) :two-floor-result '(1 4/21)
+     :one-ffloor-result '(1.0 1/3) :two-ffloor-result '(1.0 4/21)
+     :one-ceiling-result '(2 -2/3) :two-ceiling-result '(2 -20/21)
+     :one-fceiling-result '(2.0 -2/3) :two-fceiling-result '(2.0 -20/21)
+     :one-round-result '(1 1/3) :two-round-result '(1 4/21)
+     :one-fround-result '(1.0 1/3) :two-fround-result '(1.0 4/21)
+     :one-truncate-result '(1 1/3) :two-truncate-result '(1 4/21)
+     :one-ftruncate-result '(1.0 1/3) :two-ftruncate-result '(1.0 4/21))
+    (Assert-rounding (read "-4/3") (read "8/7")
+     :one-floor-result '(-2 2/3) :two-floor-result '(-2 20/21)
+     :one-ffloor-result '(-2.0 2/3) :two-ffloor-result '(-2.0 20/21)
+     :one-ceiling-result '(-1 -1/3) :two-ceiling-result '(-1 -4/21)
+     :one-fceiling-result '(-1.0 -1/3) :two-fceiling-result '(-1.0 -4/21)
+     :one-round-result '(-1 -1/3) :two-round-result '(-1 -4/21)
+     :one-fround-result '(-1.0 -1/3) :two-fround-result '(-1.0 -4/21)
+     :one-truncate-result '(-1 -1/3) :two-truncate-result '(-1 -4/21)
+     :one-ftruncate-result '(-1.0 -1/3) :two-ftruncate-result '(-1.0 -4/21))))
 
+;; Run this function in a Common Lisp with two arguments to get results that
+;; we should compare against, above. Though note the dancing-around with the
+;; bigfloats and bignums above, too; you can't necessarily just use the
+;; output here.
+
+(defun generate-rounding-output (first second)
+  (let ((print-readably t))
+    (princ first)
+    (princ " ")
+    (princ second)
+    (princ " :one-floor-result ")
+    (princ (list 'quote (multiple-value-list (floor first))))
+    (princ " :two-floor-result ")
+    (princ (list 'quote (multiple-value-list (floor first second))))
+    (princ " :one-ffloor-result ")
+    (princ (list 'quote (multiple-value-list (ffloor first))))
+    (princ " :two-ffloor-result ")
+    (princ (list 'quote (multiple-value-list (ffloor first second))))
+    (princ " :one-ceiling-result ")
+    (princ (list 'quote (multiple-value-list (ceiling first))))
+    (princ " :two-ceiling-result ")
+    (princ (list 'quote (multiple-value-list (ceiling first second))))
+    (princ " :one-fceiling-result ")
+    (princ (list 'quote (multiple-value-list (fceiling first))))
+    (princ " :two-fceiling-result ")
+    (princ (list 'quote (multiple-value-list (fceiling first second))))
+    (princ " :one-round-result ")
+    (princ (list 'quote (multiple-value-list (round first))))
+    (princ " :two-round-result ")
+    (princ (list 'quote (multiple-value-list (round first second))))
+    (princ " :one-fround-result ")
+    (princ (list 'quote (multiple-value-list (fround first))))
+    (princ " :two-fround-result ")
+    (princ (list 'quote (multiple-value-list (fround first second))))
+    (princ " :one-truncate-result ")
+    (princ (list 'quote (multiple-value-list (truncate first))))
+    (princ " :two-truncate-result ")
+    (princ (list 'quote (multiple-value-list (truncate first second))))
+    (princ " :one-ftruncate-result ")
+    (princ (list 'quote (multiple-value-list (ftruncate first))))
+    (princ " :two-ftruncate-result ")
+    (princ (list 'quote (multiple-value-list (ftruncate first second))))))