/* Primitive operations on floating point for GNU Emacs Lisp interpreter.
- Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc.
+ Copyright (C) 1988, 1993, 1994, 1999 Free Software Foundation, Inc.
This file is part of GNU Emacs.
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.
+ Define HAVE_RINT if you have a working 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.
a domain error occurs.)
*/
-#include <signal.h>
-
#include <config.h>
+#include <signal.h>
#include "lisp.h"
#include "syssignal.h"
-#ifdef LISP_FLOAT_TYPE
-
#if STDC_HEADERS
#include <float.h>
#endif
#ifdef FLOAT_CHECK_ERRNO
# include <errno.h>
+#ifndef USE_CRT_DLL
extern int errno;
#endif
+#endif
/* Avoid traps on VMS from sinh and cosh.
All the other functions set errno instead. */
#define sinh(x) ((exp(x)-exp(-x))*0.5)
#endif /* VMS */
+#ifdef FLOAT_CATCH_SIGILL
static SIGTYPE float_error ();
+#endif
/* Nonzero while executing in floating point.
This tells float_error what to do. */
#define FLOAT_TO_INT(x, i, name, num) \
do \
{ \
- if ((x) >= (((EMACS_INT) 1) << (VALBITS-1)) || \
- (x) <= - (((EMACS_INT) 1) << (VALBITS-1)) - 1) \
+ if (FIXNUM_OVERFLOW_P (x)) \
range_error (name, num); \
XSETINT (i, (EMACS_INT)(x)); \
} \
#define FLOAT_TO_INT2(x, i, name, num1, num2) \
do \
{ \
- if ((x) >= (((EMACS_INT) 1) << (VALBITS-1)) || \
- (x) <= - (((EMACS_INT) 1) << (VALBITS-1)) - 1) \
+ if (FIXNUM_OVERFLOW_P (x)) \
range_error2 (name, num1, num2); \
XSETINT (i, (EMACS_INT)(x)); \
} \
extract_float (num)
Lisp_Object num;
{
- CHECK_NUMBER_OR_FLOAT (num, 0);
+ CHECK_NUMBER_OR_FLOAT (num);
if (FLOATP (num))
- return XFLOAT (num)->data;
+ return XFLOAT_DATA (num);
return (double) XINT (num);
}
\f
{
double f1, f2;
- CHECK_NUMBER_OR_FLOAT (arg1, 0);
- CHECK_NUMBER_OR_FLOAT (arg2, 0);
+ CHECK_NUMBER_OR_FLOAT (arg1);
+ CHECK_NUMBER_OR_FLOAT (arg2);
if (INTEGERP (arg1) /* common lisp spec */
&& INTEGERP (arg2)) /* don't promote, if both are ints */
{ /* this can be improved by pre-calculating */
XSETINT (val, acc);
return val;
}
- f1 = FLOATP (arg1) ? XFLOAT (arg1)->data : XINT (arg1);
- f2 = FLOATP (arg2) ? XFLOAT (arg2)->data : XINT (arg2);
+ f1 = FLOATP (arg1) ? XFLOAT_DATA (arg1) : XINT (arg1);
+ f2 = FLOATP (arg2) ? XFLOAT_DATA (arg2) : XINT (arg2);
/* Really should check for overflow, too */
if (f1 == 0.0 && f2 == 0.0)
f1 = 1.0;
(arg)
register Lisp_Object arg;
{
- CHECK_NUMBER_OR_FLOAT (arg, 0);
+ CHECK_NUMBER_OR_FLOAT (arg);
if (FLOATP (arg))
- IN_FLOAT (arg = make_float (fabs (XFLOAT (arg)->data)), "abs", arg);
+ IN_FLOAT (arg = make_float (fabs (XFLOAT_DATA (arg))), "abs", arg);
else if (XINT (arg) < 0)
XSETINT (arg, - XINT (arg));
(arg)
register Lisp_Object arg;
{
- CHECK_NUMBER_OR_FLOAT (arg, 0);
+ CHECK_NUMBER_OR_FLOAT (arg);
if (INTEGERP (arg))
return make_float ((double) XINT (arg));
return val;
}
-#endif /* LISP_FLOAT_TYPE */
-
/* the rounding functions */
EMACS_INT (*int_round2) ();
char *name;
{
- CHECK_NUMBER_OR_FLOAT (arg, 0);
+ CHECK_NUMBER_OR_FLOAT (arg);
if (! NILP (divisor))
{
EMACS_INT i1, i2;
- CHECK_NUMBER_OR_FLOAT (divisor, 1);
+ CHECK_NUMBER_OR_FLOAT (divisor);
-#ifdef LISP_FLOAT_TYPE
if (FLOATP (arg) || FLOATP (divisor))
{
double f1, f2;
- f1 = FLOATP (arg) ? XFLOAT (arg)->data : XINT (arg);
- f2 = (FLOATP (divisor) ? XFLOAT (divisor)->data : XINT (divisor));
+ f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XINT (arg);
+ f2 = (FLOATP (divisor) ? XFLOAT_DATA (divisor) : XINT (divisor));
if (! IEEE_FLOATING_POINT && f2 == 0)
Fsignal (Qarith_error, Qnil);
FLOAT_TO_INT2 (f1, arg, name, arg, divisor);
return arg;
}
-#endif
i1 = XINT (arg);
i2 = XINT (divisor);
return arg;
}
-#ifdef LISP_FLOAT_TYPE
if (FLOATP (arg))
{
double d;
- IN_FLOAT (d = (*double_round) (XFLOAT (arg)->data), name, arg);
+ IN_FLOAT (d = (*double_round) (XFLOAT_DATA (arg)), name, arg);
FLOAT_TO_INT (d, arg, name, arg);
}
-#endif
return arg;
}
return q + (abs_r + (q & 1) <= abs_r1 ? 0 : (i2 ^ r) < 0 ? -1 : 1);
}
-#ifndef HAVE_RINT
+/* The code uses emacs_rint, so that it works to undefine HAVE_RINT
+ if `rint' exists but does not work right. */
+#ifdef HAVE_RINT
+#define emacs_rint rint
+#else
static double
-rint (d)
+emacs_rint (d)
double d;
{
- return floor(d + 0.5);
+ return floor (d + 0.5);
}
#endif
(arg, divisor)
Lisp_Object arg, divisor;
{
- return rounding_driver (arg, divisor, rint, round2, "round");
+ return rounding_driver (arg, divisor, emacs_rint, round2, "round");
}
DEFUN ("truncate", Ftruncate, Struncate, 1, 2, 0,
"truncate");
}
-#ifdef LISP_FLOAT_TYPE
Lisp_Object
fmod_float (x, y)
{
double f1, f2;
- f1 = FLOATP (x) ? XFLOAT (x)->data : XINT (x);
- f2 = FLOATP (y) ? XFLOAT (y)->data : XINT (y);
+ f1 = FLOATP (x) ? XFLOAT_DATA (x) : XINT (x);
+ f2 = FLOATP (y) ? XFLOAT_DATA (y) : XINT (y);
if (! IEEE_FLOATING_POINT && f2 == 0)
Fsignal (Qarith_error, Qnil);
register Lisp_Object arg;
{
double d = extract_float (arg);
- IN_FLOAT (d = rint (d), "fround", arg);
+ IN_FLOAT (d = emacs_rint (d), "fround", arg);
return make_float (d);
}
DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0,
- "Truncate a floating point number to an integral float value.\n\
+ "Truncate a floating point number to an integral float value.\n\
Rounds the value toward zero.")
(arg)
register Lisp_Object arg;
}
#endif /* HAVE_MATHERR */
+void
init_floatfns ()
{
#ifdef FLOAT_CATCH_SIGILL
in_float = 0;
}
-#else /* not LISP_FLOAT_TYPE */
-
-init_floatfns ()
-{}
-
-#endif /* not LISP_FLOAT_TYPE */
-
+void
syms_of_floatfns ()
{
-#ifdef LISP_FLOAT_TYPE
defsubr (&Sacos);
defsubr (&Sasin);
defsubr (&Satan);
defsubr (&Sabs);
defsubr (&Sfloat);
defsubr (&Slogb);
-#endif /* LISP_FLOAT_TYPE */
defsubr (&Sceiling);
defsubr (&Sfloor);
defsubr (&Sround);
HCoop / bpt / emacs.git / blobdiff