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:
(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.)
#include "lisp.h"
#include "syssignal.h"
-Lisp_Object Qarith_error;
-
#ifdef LISP_FLOAT_TYPE
+#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
defines two static variables--which, in Emacs, are not really static,
because `static' is defined as nothing. The problem is that they are
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;
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);
}
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);
}
}
DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
- "Return the exponential X ** Y.")
+ "Return the exponential ARG1 ** ARG2.")
(arg1, arg2)
register Lisp_Object arg1, arg2;
{
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);
#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)
if (! in_float)
fatal_error_signal (signo);
-#ifdef BSD
+#ifdef BSD_SYSTEM
#ifdef BSD4_1
sigrelse (SIGILL);
#else /* not BSD4_1 */
#else
/* Must reestablish handler each time it is called. */
signal (SIGILL, float_error);
-#endif /* BSD */
+#endif /* BSD_SYSTEM */
in_float = 0;