Mercurial > emacs

--- a/src/floatfns.c	Wed Mar 10 05:24:42 1993 +0000
+++ b/src/floatfns.c	Wed Mar 10 05:33:40 1993 +0000
@@ -18,6 +18,31 @@
 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */


+/* ANSI C requires only these float functions:
+   acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod,
+   frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh.
+
+   Define HAVE_INVERSE_HYPERBOLIC if you have acosh, asinh, and atanh.
+   Define HAVE_CBRT if you have cbrt.
+   Define HAVE_RINT if you have rint.
+   If you don't define these, then the appropriate routines will be simulated.
+
+   Define HAVE_MATHERR if on a system supporting the SysV matherr callback.
+   (This should happen automatically.)
+
+   Define FLOAT_CHECK_ERRNO if the float library routines set errno.
+   This has no effect if HAVE_MATHERR is defined.
+
+   Define FLOAT_CATCH_SIGILL if the float library routines signal SIGILL.
+   (What systems actually do this?  Please let us know.)
+
+   Define FLOAT_CHECK_DOMAIN if the float library doesn't handle errors by
+   either setting errno, or signalling SIGFPE/SIGILL.  Otherwise, domain and
+   range checking will happen before calling the float routines.  This has
+   no effect if HAVE_MATHERR is defined (since matherr will be called when
+   a domain error occurs.)
+ */
+
 #include <signal.h>

 #include "config.h"
@@ -29,9 +54,32 @@
 #ifdef LISP_FLOAT_TYPE

 #include <math.h>
-#include <errno.h>
+
+#if defined(DOMAIN) && defined(SING) && defined(OVERFLOW)
+    /* If those are defined, then this is probably a `matherr' machine. */
+# ifndef HAVE_MATHERR
+#  define HAVE_MATHERR
+# endif
+#endif
+
+#ifdef HAVE_MATHERR
+# ifdef FLOAT_CHECK_ERRNO
+#  undef FLOAT_CHECK_ERRNO
+# endif
+# ifdef FLOAT_CHECK_DOMAIN
+#  undef FLOAT_CHECK_DOMAIN
+# endif
+#endif
+
+#ifndef NO_FLOAT_CHECK_ERRNO
+#define FLOAT_CHECK_ERRNO
+#endif
+
+#ifdef FLOAT_CHECK_ERRNO
+# include <errno.h>

 extern int errno;
+#endif

 /* Avoid traps on VMS from sinh and cosh.
    All the other functions set errno instead.  */
@@ -43,6 +91,10 @@
 #define sinh(x) ((exp(x)-exp(-x))*0.5)
 #endif /* VMS */

+#ifndef HAVE_RINT
+#define rint(x) (floor((x)+0.5))
+#endif
+
 static SIGTYPE float_error ();

 /* Nonzero while executing in floating point.
@@ -53,7 +105,9 @@
 /* If an argument is out of range for a mathematical function,
    here is the actual argument value to use in the error message.  */

-static Lisp_Object float_error_arg;
+static Lisp_Object float_error_arg, float_error_arg2;
+
+static char *float_error_fn_name;

 /* Evaluate the floating point expression D, recording NUM
    as the original argument for error messages.
@@ -64,10 +118,44 @@
    just cast the zero after the colon to (SIGTYPE) to make the types
    check properly.  */

-#define IN_FLOAT(D, NUM) \
-(in_float = 1, errno = 0, float_error_arg = NUM, (D),			\
- (errno == ERANGE || errno == EDOM ? (float_error (),0) : 0),		\
- in_float = 0)
+#ifdef FLOAT_CHECK_ERRNO
+#define IN_FLOAT(d, name, num)				\
+  do {							\
+    float_error_arg = num;				\
+    float_error_fn_name = name;				\
+    in_float = 1; errno = 0; (d); in_float = 0;		\
+    switch (errno) {					\
+    case 0: break;					\
+    case EDOM:	 domain_error (float_error_fn_name, float_error_arg);	\
+    case ERANGE: range_error (float_error_fn_name, float_error_arg);	\
+    default:	 arith_error (float_error_fn_name, float_error_arg);	\
+    }							\
+  } while (0)
+#define IN_FLOAT2(d, name, num, num2)			\
+  do {							\
+    float_error_arg = num;				\
+    float_error_arg2 = num2;				\
+    float_error_fn_name = name;				\
+    in_float = 1; errno = 0; (d); in_float = 0;		\
+    switch (errno) {					\
+    case 0: break;					\
+    case EDOM:	 domain_error (float_error_fn_name, float_error_arg);	\
+    case ERANGE: range_error (float_error_fn_name, float_error_arg);	\
+    default:	 arith_error (float_error_fn_name, float_error_arg);	\
+    }							\
+  } while (0)
+#else
+#define IN_FLOAT2(d, name, num, num2) (in_float = 1, (d), in_float = 0)
+#endif
+
+#define arith_error(op,arg) \
+  Fsignal (Qarith_error, Fcons (build_string ((op)), Fcons ((arg), Qnil)))
+#define range_error(op,arg) \
+  Fsignal (Qrange_error, Fcons (build_string ((op)), Fcons ((arg), Qnil)))
+#define domain_error(op,arg) \
+  Fsignal (Qdomain_error, Fcons (build_string ((op)), Fcons ((arg), Qnil)))
+#define domain_error2(op,a1,a2) \
+  Fsignal (Qdomain_error, Fcons (build_string ((op)), Fcons ((a1), Fcons ((a2), Qnil))))

 /* Extract a Lisp number as a `double', or signal an error.  */

@@ -86,61 +174,74 @@

 DEFUN ("acos", Facos, Sacos, 1, 1, 0,
   "Return the inverse cosine of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = acos (d), num);
+  double d = extract_float (arg);
+#ifdef FLOAT_CHECK_DOMAIN
+  if (d > 1.0 || d < -1.0)
+    domain_error ("acos", arg);
+#endif
+  IN_FLOAT (d = acos (d), "acos", arg);
   return make_float (d);
 }

 DEFUN ("asin", Fasin, Sasin, 1, 1, 0,
   "Return the inverse sine of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = asin (d), num);
+  double d = extract_float (arg);
+#ifdef FLOAT_CHECK_DOMAIN
+  if (d > 1.0 || d < -1.0)
+    domain_error ("asin", arg);
+#endif
+  IN_FLOAT (d = asin (d), "asin", arg);
   return make_float (d);
 }

 DEFUN ("atan", Fatan, Satan, 1, 1, 0,
   "Return the inverse tangent of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = atan (d), num);
+  double d = extract_float (arg);
+  IN_FLOAT (d = atan (d), "atan", arg);
   return make_float (d);
 }

 DEFUN ("cos", Fcos, Scos, 1, 1, 0,
   "Return the cosine of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = cos (d), num);
+  double d = extract_float (arg);
+  IN_FLOAT (d = cos (d), "cos", arg);
   return make_float (d);
 }

 DEFUN ("sin", Fsin, Ssin, 1, 1, 0,
   "Return the sine of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = sin (d), num);
+  double d = extract_float (arg);
+  IN_FLOAT (d = sin (d), "sin", arg);
   return make_float (d);
 }

 DEFUN ("tan", Ftan, Stan, 1, 1, 0,
   "Return the tangent of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = tan (d), num);
+  double d = extract_float (arg);
+  double c = cos (d);
+#ifdef FLOAT_CHECK_DOMAIN
+  if (c == 0.0)
+    domain_error ("tan", arg);
+#endif
+  IN_FLOAT (d = sin (d) / c, "tan", arg);
   return make_float (d);
 }

@@ -148,67 +249,67 @@

 DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0,
   "Return the bessel function j0 of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = j0 (d), num);
+  double d = extract_float (arg);
+  IN_FLOAT (d = j0 (d), "bessel-j0", arg);
   return make_float (d);
 }

 DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0,
   "Return the bessel function j1 of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = j1 (d), num);
+  double d = extract_float (arg);
+  IN_FLOAT (d = j1 (d), "bessel-j1", arg);
   return make_float (d);
 }

 DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0,
   "Return the order N bessel function output jn of ARG.\n\
 The first arg (the order) is truncated to an integer.")
-  (num1, num2)
-     register Lisp_Object num1, num2;
+  (arg1, arg2)
+     register Lisp_Object arg1, arg2;
 {
-  int i1 = extract_float (num1);
-  double f2 = extract_float (num2);
+  int i1 = extract_float (arg1);
+  double f2 = extract_float (arg2);

-  IN_FLOAT (f2 = jn (i1, f2), num1);
+  IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", arg1);
   return make_float (f2);
 }

 DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0,
   "Return the bessel function y0 of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = y0 (d), num);
+  double d = extract_float (arg);
+  IN_FLOAT (d = y0 (d), "bessel-y0", arg);
   return make_float (d);
 }

 DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0,
   "Return the bessel function y1 of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = y1 (d), num);
+  double d = extract_float (arg);
+  IN_FLOAT (d = y1 (d), "bessel-y0", arg);
   return make_float (d);
 }

 DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0,
   "Return the order N bessel function output yn of ARG.\n\
 The first arg (the order) is truncated to an integer.")
-  (num1, num2)
-     register Lisp_Object num1, num2;
+  (arg1, arg2)
+     register Lisp_Object arg1, arg2;
 {
-  int i1 = extract_float (num1);
-  double f2 = extract_float (num2);
+  int i1 = extract_float (arg1);
+  double f2 = extract_float (arg2);

-  IN_FLOAT (f2 = yn (i1, f2), num1);
+  IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", arg1);
   return make_float (f2);
 }

@@ -218,41 +319,48 @@

 DEFUN ("erf", Ferf, Serf, 1, 1, 0,
   "Return the mathematical error function of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = erf (d), num);
+  double d = extract_float (arg);
+  IN_FLOAT (d = erf (d), "erf", arg);
   return make_float (d);
 }

 DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0,
   "Return the complementary error function of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = erfc (d), num);
+  double d = extract_float (arg);
+  IN_FLOAT (d = erfc (d), "erfc", arg);
   return make_float (d);
 }

 DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0,
   "Return the log gamma of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = lgamma (d), num);
+  double d = extract_float (arg);
+  IN_FLOAT (d = lgamma (d), "log-gamma", arg);
   return make_float (d);
 }

-DEFUN ("cbrt", Fcbrt, Scbrt, 1, 1, 0,
+DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0,
   "Return the cube root of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = cbrt (d), num);
+  double d = extract_float (arg);
+#ifdef HAVE_CBRT
+  IN_FLOAT (d = cbrt (d), "cube-root", arg);
+#else
+  if (d >= 0.0)
+    IN_FLOAT (d = pow (d, 1.0/3.0), "cube-root", arg);
+  else
+    IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", arg);
+#endif
   return make_float (d);
 }

@@ -260,87 +368,130 @@

 DEFUN ("exp", Fexp, Sexp, 1, 1, 0,
   "Return the exponential base e of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = exp (d), num);
+  double d = extract_float (arg);
+#ifdef FLOAT_CHECK_DOMAIN
+  if (d > 709.7827)   /* Assume IEEE doubles here */
+    range_error ("exp", arg);
+  else if (d < -709.0)
+    return make_float (0.0);
+  else
+#endif
+    IN_FLOAT (d = exp (d), "exp", arg);
   return make_float (d);
 }

 DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
   "Return the exponential X ** Y.")
-  (num1, num2)
-     register Lisp_Object num1, num2;
+  (arg1, arg2)
+     register Lisp_Object arg1, arg2;
 {
   double f1, f2;

-  CHECK_NUMBER_OR_FLOAT (num1, 0);
-  CHECK_NUMBER_OR_FLOAT (num2, 0);
-  if ((XTYPE (num1) == Lisp_Int) && /* common lisp spec */
-      (XTYPE (num2) == Lisp_Int)) /* don't promote, if both are ints */
+  CHECK_NUMBER_OR_FLOAT (arg1, 0);
+  CHECK_NUMBER_OR_FLOAT (arg2, 0);
+  if ((XTYPE (arg1) == Lisp_Int) && /* common lisp spec */
+      (XTYPE (arg2) == Lisp_Int)) /* don't promote, if both are ints */
     {				/* this can be improved by pre-calculating */
       int acc, x, y;		/* some binary powers of x then acumulating */
       /* these, therby saving some time. -wsr */
-      x = XINT (num1);
-      y = XINT (num2);
+      x = XINT (arg1);
+      y = XINT (arg2);
       acc = 1;

       if (y < 0)
 	{
-	  for (; y < 0; y++)
-	    acc /= x;
+	  if (x == 1)
+	    acc = 1;
+	  else if (x == -1)
+	    acc = (y & 1) ? -1 : 1;
+	  else
+	    acc = 0;
 	}
       else
 	{
 	  for (; y > 0; y--)
-	    acc *= x;
+	  while (y > 0)
+	    {
+	      if (y & 1)
+		acc *= x;
+	      x *= x;
+	      y = (unsigned)y >> 1;
+	    }
 	}
-      XFASTINT (x) = acc;
+      XSET (x, Lisp_Int, acc);
       return x;
     }
-  f1 = (XTYPE (num1) == Lisp_Float) ? XFLOAT (num1)->data : XINT (num1);
-  f2 = (XTYPE (num2) == Lisp_Float) ? XFLOAT (num2)->data : XINT (num2);
-  IN_FLOAT (f1 = pow (f1, f2), num1);
+  f1 = (XTYPE (arg1) == Lisp_Float) ? XFLOAT (arg1)->data : XINT (arg1);
+  f2 = (XTYPE (arg2) == Lisp_Float) ? XFLOAT (arg2)->data : XINT (arg2);
+  /* Really should check for overflow, too */
+  if (f1 == 0.0 && f2 == 0.0)
+    f1 = 1.0;
+#ifdef FLOAT_CHECK_DOMAIN
+  else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor(f2)))
+    domain_error2 ("expt", arg1, arg2);
+#endif
+  IN_FLOAT (f1 = pow (f1, f2), "expt", arg1);
   return make_float (f1);
 }

 DEFUN ("log", Flog, Slog, 1, 2, 0,
-  "Return the natural logarithm of NUM.\n\
-If second optional argument BASE is given, return log NUM using that base.")
-  (num, base)
-     register Lisp_Object num, base;
+  "Return the natural logarithm of ARG.\n\
+If second optional argument BASE is given, return log ARG using that base.")
+  (arg, base)
+     register Lisp_Object arg, base;
 {
-  double d = extract_float (num);
+  double d = extract_float (arg);

+#ifdef FLOAT_CHECK_DOMAIN
+  if (d <= 0.0)
+    domain_error2 ("log", arg, base);
+#endif
   if (NILP (base))
-    IN_FLOAT (d = log (d), num);
+    IN_FLOAT (d = log (d), "log", arg);
   else
     {
       double b = extract_float (base);

-      IN_FLOAT (d = log (num) / log (b), num);
+#ifdef FLOAT_CHECK_DOMAIN
+      if (b <= 0.0 || b == 1.0)
+	domain_error2 ("log", arg, base);
+#endif
+      if (b == 10.0)
+	IN_FLOAT2 (d = log10 (d), "log", arg, base);
+      else
+	IN_FLOAT2 (d = log (arg) / log (b), "log", arg, base);
     }
   return make_float (d);
 }

 DEFUN ("log10", Flog10, Slog10, 1, 1, 0,
   "Return the logarithm base 10 of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = log10 (d), num);
+  double d = extract_float (arg);
+#ifdef FLOAT_CHECK_DOMAIN
+  if (d <= 0.0)
+    domain_error ("log10", arg);
+#endif
+  IN_FLOAT (d = log10 (d), "log10", arg);
   return make_float (d);
 }

 DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0,
   "Return the square root of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = sqrt (d), num);
+  double d = extract_float (arg);
+#ifdef FLOAT_CHECK_DOMAIN
+  if (d < 0.0)
+    domain_error ("sqrt", arg);
+#endif
+  IN_FLOAT (d = sqrt (d), "sqrt", arg);
   return make_float (d);
 }

@@ -348,169 +499,240 @@

 DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0,
   "Return the inverse hyperbolic cosine of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = acosh (d), num);
+  double d = extract_float (arg);
+#ifdef FLOAT_CHECK_DOMAIN
+  if (d < 1.0)
+    domain_error ("acosh", arg);
+#endif
+#ifdef HAVE_INVERSE_HYPERBOLIC
+  IN_FLOAT (d = acosh (d), "acosh", arg);
+#else
+  IN_FLOAT (d = log (d + sqrt (d*d - 1.0)), "acosh", arg);
+#endif
   return make_float (d);
 }

 DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0,
   "Return the inverse hyperbolic sine of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = asinh (d), num);
+  double d = extract_float (arg);
+#ifdef HAVE_INVERSE_HYPERBOLIC
+  IN_FLOAT (d = asinh (d), "asinh", arg);
+#else
+  IN_FLOAT (d = log (d + sqrt (d*d + 1.0)), "asinh", arg);
+#endif
   return make_float (d);
 }

 DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0,
   "Return the inverse hyperbolic tangent of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = atanh (d), num);
+  double d = extract_float (arg);
+#ifdef FLOAT_CHECK_DOMAIN
+  if (d >= 1.0 || d <= -1.0)
+    domain_error ("atanh", arg);
+#endif
+#ifdef HAVE_INVERSE_HYPERBOLIC
+  IN_FLOAT (d = atanh (d), "atanh", arg);
+#else
+  IN_FLOAT (d = 0.5 * log ((1.0 + d) / (1.0 - d)), "atanh", arg);
+#endif
   return make_float (d);
 }

 DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0,
   "Return the hyperbolic cosine of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = cosh (d), num);
+  double d = extract_float (arg);
+#ifdef FLOAT_CHECK_DOMAIN
+  if (d > 710.0 || d < -710.0)
+    range_error ("cosh", arg);
+#endif
+  IN_FLOAT (d = cosh (d), "cosh", arg);
   return make_float (d);
 }

 DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0,
   "Return the hyperbolic sine of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = sinh (d), num);
+  double d = extract_float (arg);
+#ifdef FLOAT_CHECK_DOMAIN
+  if (d > 710.0 || d < -710.0)
+    range_error ("sinh", arg);
+#endif
+  IN_FLOAT (d = sinh (d), "sinh", arg);
   return make_float (d);
 }

 DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0,
   "Return the hyperbolic tangent of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  double d = extract_float (num);
-  IN_FLOAT (d = tanh (d), num);
+  double d = extract_float (arg);
+  IN_FLOAT (d = tanh (d), "tanh", arg);
   return make_float (d);
 }
 #endif

 DEFUN ("abs", Fabs, Sabs, 1, 1, 0,
   "Return the absolute value of ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  CHECK_NUMBER_OR_FLOAT (num, 0);
+  CHECK_NUMBER_OR_FLOAT (arg, 0);

-  if (XTYPE (num) == Lisp_Float)
-    IN_FLOAT (num = make_float (fabs (XFLOAT (num)->data)), num);
-  else if (XINT (num) < 0)
-    XSETINT (num, - XFASTINT (num));
+  if (XTYPE (arg) == Lisp_Float)
+    IN_FLOAT (arg = make_float (fabs (XFLOAT (arg)->data)), "abs", arg);
+  else if (XINT (arg) < 0)
+    XSETINT (arg, - XFASTINT (arg));

-  return num;
+  return arg;
 }

 DEFUN ("float", Ffloat, Sfloat, 1, 1, 0,
   "Return the floating point number equal to ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  CHECK_NUMBER_OR_FLOAT (num, 0);
+  CHECK_NUMBER_OR_FLOAT (arg, 0);

-  if (XTYPE (num) == Lisp_Int)
-    return make_float ((double) XINT (num));
+  if (XTYPE (arg) == Lisp_Int)
+    return make_float ((double) XINT (arg));
   else				/* give 'em the same float back */
-    return num;
+    return arg;
 }

 DEFUN ("logb", Flogb, Slogb, 1, 1, 0,
   "Returns the integer that is the base 2 log of ARG.\n\
 This is the same as the exponent of a float.")
-     (num)
-Lisp_Object num;
+     (arg)
+     Lisp_Object arg;
 {
   /* System V apparently doesn't have a `logb' function.  It might be
      better to use it on systems that have it, but Ultrix (at least)
      doesn't declare it properly in <math.h>; does anyone really care? */
-  return Flog (num, make_number (2));
+  return Flog (arg, make_number (2));
 }

 /* the rounding functions  */

 DEFUN ("ceiling", Fceiling, Sceiling, 1, 1, 0,
   "Return the smallest integer no less than ARG.  (Round toward +inf.)")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  CHECK_NUMBER_OR_FLOAT (num, 0);
+  CHECK_NUMBER_OR_FLOAT (arg, 0);

-  if (XTYPE (num) == Lisp_Float)
-    IN_FLOAT (XSET (num, Lisp_Int, ceil (XFLOAT (num)->data)), num);
+  if (XTYPE (arg) == Lisp_Float)
+    IN_FLOAT (XSET (arg, Lisp_Int, ceil (XFLOAT (arg)->data)), "celing", arg);

-  return num;
+  return arg;
 }

 DEFUN ("floor", Ffloor, Sfloor, 1, 1, 0,
   "Return the largest integer no greater than ARG.  (Round towards -inf.)")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  CHECK_NUMBER_OR_FLOAT (num, 0);
+  CHECK_NUMBER_OR_FLOAT (arg, 0);

-  if (XTYPE (num) == Lisp_Float)
-    IN_FLOAT (XSET (num, Lisp_Int, floor (XFLOAT (num)->data)), num);
+  if (XTYPE (arg) == Lisp_Float)
+    IN_FLOAT (XSET (arg, Lisp_Int, floor (XFLOAT (arg)->data)), "floor", arg);

-  return num;
+  return arg;
 }

 DEFUN ("round", Fround, Sround, 1, 1, 0,
   "Return the nearest integer to ARG.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  CHECK_NUMBER_OR_FLOAT (num, 0);
+  CHECK_NUMBER_OR_FLOAT (arg, 0);

-  if (XTYPE (num) == Lisp_Float)
-    {
-      /* Screw the prevailing rounding mode.  */
-      IN_FLOAT (XSET (num, Lisp_Int, floor (XFLOAT (num)->data + 0.5)), num);
+  if (XTYPE (arg) == Lisp_Float)
+    /* Screw the prevailing rounding mode.  */
+    IN_FLOAT (XSET (arg, Lisp_Int, rint (XFLOAT (arg)->data)), "round", arg);

-      /* It used to be that on non-USG systems we'd use the `rint'
-	 function.  But that seems not to be declared properly in
-	 <math.h> on Ultrix, I don't want to declare it myself because
-	 that might conflict with <math.h> on other systems, and I
-	 don't see what's wrong with the code above anyway.  */
-    }
-
-  return num;
+  return arg;
 }

 DEFUN ("truncate", Ftruncate, Struncate, 1, 1, 0,
        "Truncate a floating point number to an int.\n\
 Rounds the value toward zero.")
-  (num)
-     register Lisp_Object num;
+  (arg)
+     register Lisp_Object arg;
 {
-  CHECK_NUMBER_OR_FLOAT (num, 0);
+  CHECK_NUMBER_OR_FLOAT (arg, 0);

-  if (XTYPE (num) == Lisp_Float)
-    XSET (num, Lisp_Int, (int) XFLOAT (num)->data);
+  if (XTYPE (arg) == Lisp_Float)
+    XSET (arg, Lisp_Int, (int) XFLOAT (arg)->data);

-  return num;
+  return arg;
 }

+#if 0
+/* It's not clear these are worth adding.  */
+
+DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0,
+  "Return the smallest integer no less than ARG, as a float.\n\
+\(Round toward +inf.\)")
+  (arg)
+     register Lisp_Object arg;
+{
+  double d = extract_float (arg);
+  IN_FLOAT (d = ceil (d), "fceiling", arg);
+  return make_float (d);
+}
+
+DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0,
+  "Return the largest integer no greater than ARG, as a float.\n\
+\(Round towards -inf.\)")
+  (arg)
+     register Lisp_Object arg;
+{
+  double d = extract_float (arg);
+  IN_FLOAT (d = floor (d), "ffloor", arg);
+  return make_float (d);
+}
+
+DEFUN ("fround", Ffround, Sfround, 1, 1, 0,
+  "Return the nearest integer to ARG, as a float.")
+  (arg)
+     register Lisp_Object arg;
+{
+  double d = extract_float (arg);
+  IN_FLOAT (d = rint (XFLOAT (arg)->data), "fround", arg);
+  return make_float (d);
+}
+
+DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0,
+       "Truncate a floating point number to an integral float value.\n\
+Rounds the value toward zero.")
+  (arg)
+     register Lisp_Object arg;
+{
+  double d = extract_float (arg);
+  if (d >= 0.0)
+    IN_FLOAT (d = floor (d), "ftruncate", arg);
+  else
+    IN_FLOAT (d = ceil (d), arg);
+  return make_float (d);
+}
+#endif
+
+#ifdef FLOAT_CATCH_SIGILL
 static SIGTYPE
 float_error (signo)
      int signo;
@@ -534,9 +756,46 @@
   Fsignal (Qarith_error, Fcons (float_error_arg, Qnil));
 }

+/* Another idea was to replace the library function `infnan'
+   where SIGILL is signaled.  */
+
+#endif /* FLOAT_CATCH_SIGILL */
+
+#ifdef HAVE_MATHERR
+int
+matherr (x)
+     struct exception *x;
+{
+  Lisp_Object args;
+  if (! in_float)
+    /* Not called from emacs-lisp float routines; do the default thing. */
+    return 0;
+  if (!strcmp (x->name, "pow"))
+    x->name = "expt";
+
+  args
+    = Fcons (build_string (x->name),
+	     Fcons (make_float (x->arg1),
+		    ((!strcmp (x->name, "log") || !strcmp (x->name, "pow"))
+		     ? Fcons (make_float (x->arg2), Qnil)
+		     : Qnil)));
+  switch (x->type)
+    {
+    case DOMAIN:	Fsignal (Qdomain_error, args);		break;
+    case SING:		Fsignal (Qsingularity_error, args);	break;
+    case OVERFLOW:	Fsignal (Qoverflow_error, args);	break;
+    case UNDERFLOW:	Fsignal (Qunderflow_error, args);	break;
+    default:		Fsignal (Qarith_error, args);		break;
+    }
+  return (1);	/* don't set errno or print a message */
+}
+#endif /* HAVE_MATHERR */
+
 init_floatfns ()
 {
+#ifdef FLOAT_CATCH_SIGILL
   signal (SIGILL, float_error);
+#endif
   in_float = 0;
 }

@@ -564,7 +823,11 @@
   defsubr (&Serf);
   defsubr (&Serfc);
   defsubr (&Slog_gamma);
-  defsubr (&Scbrt);
+  defsubr (&Scube_root);
+  defsubr (&Sfceiling);
+  defsubr (&Sffloor);
+  defsubr (&Sfround);
+  defsubr (&Sftruncate);
 #endif
   defsubr (&Sexp);
   defsubr (&Sexpt);