<float.h>: Include if STDC_HEADERS.

[gnu-emacs] / src / floatfns.c

diff --git a/src/floatfns.c b/src/floatfns.c
index 459f4d63faa380d47f5cf9ef460fba5687748a1f..452bdc2ea5438d507e860dae8bb21a3d581fc24c 100644 (file)
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -15,7 +15,8 @@ GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
-the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
 
 
 /* ANSI C requires only these float functions:
@@ -37,7 +38,7 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
    (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
+   either setting errno, or signaling 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.)
@@ -49,15 +50,20 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
 #include "lisp.h"
 #include "syssignal.h"
 
-Lisp_Object Qarith_error;
-
 #ifdef LISP_FLOAT_TYPE
 
-#ifdef MSDOS
-/* These are redefined (correctly, but differently) in values.h.  */
-#undef INTBITS
-#undef LONGBITS
-#undef SHORTBITS
+#if STDC_HEADERS
+#include <float.h>
+#endif
+
+/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */
+#ifndef IEEE_FLOATING_POINT
+#if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
+     && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
+#define IEEE_FLOATING_POINT 1
+#else
+#define IEEE_FLOATING_POINT 0
+#endif
 #endif
 
 /* Work around a problem that happens because math.h on hpux 7
@@ -129,7 +135,9 @@ static SIGTYPE float_error ();
 static int in_float;
 
 /* If an argument is out of range for a mathematical function,
-   here is the actual argument value to use in the error message.  */
+   here is the actual argument value to use in the error message.
+   These variables are used only across the floating point library call
+   so there is no need to staticpro them.  */
 
 static Lisp_Object float_error_arg, float_error_arg2;
 
@@ -322,13 +330,13 @@ DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0,
 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.")
-  (arg1, arg2)
-     register Lisp_Object arg1, arg2;
+  (n, arg)
+     register Lisp_Object n, arg;
 {
-  int i1 = extract_float (arg1);
-  double f2 = extract_float (arg2);
+  int i1 = extract_float (n);
+  double f2 = extract_float (arg);
 
-  IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", arg1);
+  IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", n);
   return make_float (f2);
 }
 
@@ -355,13 +363,13 @@ DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0,
 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.")
-  (arg1, arg2)
-     register Lisp_Object arg1, arg2;
+  (n, arg)
+     register Lisp_Object n, arg;
 {
-  int i1 = extract_float (arg1);
-  double f2 = extract_float (arg2);
+  int i1 = extract_float (n);
+  double f2 = extract_float (arg);
 
-  IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", arg1);
+  IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", n);
   return make_float (f2);
 }
 
@@ -436,7 +444,7 @@ DEFUN ("exp", Fexp, Sexp, 1, 1, 0,
 }
 
 DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
-  "Return the exponential X ** Y.")
+  "Return the exponential ARG1 ** ARG2.")
   (arg1, arg2)
      register Lisp_Object arg1, arg2;
 {
@@ -758,7 +766,7 @@ With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR.")
 
          f1 = FLOATP (arg) ? XFLOAT (arg)->data : XINT (arg);
          f2 = (FLOATP (divisor) ? XFLOAT (divisor)->data : XINT (divisor));
-         if (f2 == 0)
+         if (! IEEE_FLOATING_POINT && f2 == 0)
            Fsignal (Qarith_error, Qnil);
 
          IN_FLOAT2 (f1 = floor (f1 / f2), "floor", arg, divisor);
@@ -797,6 +805,25 @@ With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR.")
 
 #ifdef LISP_FLOAT_TYPE
 
+Lisp_Object
+fmod_float (x, y)
+     register Lisp_Object x, y;
+{
+  double f1, f2;
+
+  f1 = FLOATP (x) ? XFLOAT (x)->data : XINT (x);
+  f2 = FLOATP (y) ? XFLOAT (y)->data : XINT (y);
+
+  if (! IEEE_FLOATING_POINT && f2 == 0)
+    Fsignal (Qarith_error, Qnil);
+
+  /* If the "remainder" comes out with the wrong sign, fix it.  */
+  IN_FLOAT2 ((f1 = fmod (f1, f2),
+             f1 = (f2 < 0 ? f1 > 0 : f1 < 0) ? f1 + f2 : f1),
+            "mod", x, y);
+  return make_float (f1);
+}
+
 DEFUN ("round", Fround, Sround, 1, 1, 0,
   "Return the nearest integer to ARG.")
   (arg)
@@ -891,7 +918,7 @@ float_error (signo)
   if (! in_float)
     fatal_error_signal (signo);
 
-#ifdef BSD
+#ifdef BSD_SYSTEM
 #ifdef BSD4_1
   sigrelse (SIGILL);
 #else /* not BSD4_1 */
@@ -900,7 +927,7 @@ float_error (signo)
 #else
   /* Must reestablish handler each time it is called.  */
   signal (SIGILL, float_error);
-#endif /* BSD */
+#endif /* BSD_SYSTEM */
 
   in_float = 0;