procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Assume C89 or later for math functions.

Browse source 
This simplifies the code, and makes it a bit smaller and faster,
and (most important) makes it easier to clean up signal handling
since we can stop worring about floating-point exceptions in
library code.  That was a problem before C89, but the problem
went away many years ago on all practical Emacs targets.
* configure.ac (frexp, fmod): Remove checks for these functions,
as we now assume them.
(FLOAT_CHECK_DOMAIN, HAVE_INVERSE_HYPERBOLIC, NO_MATHERR)
(HAVE_EXCEPTION):
Remove; no longer needed.
* admin/CPP-DEFINES (HAVE_FMOD, HAVE_FREXP, FLOAT_CHECK_DOMAIN)
(HAVE_INVERSE_HYPERBOLIC, NO_MATHERR): Remove.
* src/data.c, src/image.c, src/lread.c, src/print.c:
Don't include <math.h>; no longer needed.
* src/data.c, src/floatfns.c (IEEE_FLOATING_POINT): Don't worry that it
might be autoconfigured, as that never happens.
* src/data.c (fmod):
* src/doprnt.c (DBL_MAX_10_EXP):
* src/print.c (DBL_DIG):
Remove.  C89 or later always defines these.
* src/floatfns.c (HAVE_MATHERR, FLOAT_CHECK_ERRNO, FLOAT_CHECK_DOMAIN)
(in_float, float_error_arg, float_error_arg2, float_error_fn_name)
(arith_error, domain_error, domain_error2):
Remove all this pre-C89 cruft.  Do not include <errno.h> as that's
no longer needed -- we simply return what C returns.  All uses removed.
(IN_FLOAT, IN_FLOAT2): Remove.  All uses replaced with
the wrapped code.
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error, range_error2):
Remove.  All uses expanded, as these macros are no longer used
more than once and are now more trouble than they're worth.
(Ftan): Use tan, not sin / cos.
(Flogb): Assume C89 frexp.
(fmod_float): Assume C89 fmod.
(matherr) [HAVE_MATHERR]: Remove; no longer needed.
(init_floatfns): Remove.  All uses removed.
This commit is contained in:
Paul Eggert 2012-09-09 09:06:33 -07:00
parent 8ed43f1548
commit f6196b87e1
13 changed files with 131 additions and 416 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
ChangeLog
View file

@ -1,3 +1,12 @@
2012-09-09 Paul Eggert <eggert@cs.ucla.edu>
Assume C89 or later for math functions (Bug#12381).
* configure.ac (frexp, fmod): Remove checks for these functions,
as we now assume them.
(FLOAT_CHECK_DOMAIN, HAVE_INVERSE_HYPERBOLIC, NO_MATHERR)
(HAVE_EXCEPTION):
Remove; no longer needed.
2012-09-07 Paul Eggert <eggert@cs.ucla.edu>
More signal-handler cleanup (Bug#12327).

5
admin/CPP-DEFINES
View file

@ -107,7 +107,6 @@ EMACS_CONFIGURATION
EMACS_CONFIG_OPTIONS
EMACS_INT
EMACS_UINT
FLOAT_CHECK_DOMAIN
GC_MARK_SECONDARY_STACK
GC_MARK_STACK
GC_SETJMP_WORKS
@ -158,12 +157,10 @@ HAVE_ENDPWENT
HAVE_ENVIRON_DECL
HAVE_EUIDACCESS
HAVE_FCNTL_H
HAVE_FMOD
HAVE_FORK
HAVE_FPATHCONF
HAVE_FREEIFADDRS
HAVE_FREETYPE
HAVE_FREXP
HAVE_FSEEKO
HAVE_FSYNC
HAVE_FUTIMENS
@ -217,7 +214,6 @@ HAVE_IFADDRS_H
HAVE_IMAGEMAGICK
HAVE_INET_SOCKETS
HAVE_INTTYPES_H
HAVE_INVERSE_HYPERBOLIC
HAVE_JPEG
HAVE_KERBEROSIV_DES_H
HAVE_KERBEROSIV_KRB_H
@ -429,7 +425,6 @@ MAIL_USE_SYSTEM_LOCK
MAXPATHLEN
NLIST_STRUCT
NO_EDITRES
NO_MATHERR
NO_TERMIO
NSIG
NSIG_MINIMUM

6
admin/ChangeLog
View file

@ -1,3 +1,9 @@
2012-09-09 Paul Eggert <eggert@cs.ucla.edu>
Assume C89 or later for math functions (Bug#12381).
* CPP-DEFINES (HAVE_FMOD, HAVE_FREXP, FLOAT_CHECK_DOMAIN)
(HAVE_INVERSE_HYPERBOLIC, NO_MATHERR): Remove.
2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
Simplify redefinition of 'abort' (Bug#12316).

19
configure.ac
View file

@ -1302,17 +1302,6 @@ if test $emacs_cv_speed_t = yes; then
[Define to 1 if `speed_t' is declared by <termios.h>.])
fi
AC_CACHE_CHECK(for struct exception, emacs_cv_struct_exception,
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <math.h>]],
[[static struct exception x; x.arg1 = x.arg2 = x.retval; x.name = ""; x.type = 1;]])],
emacs_cv_struct_exception=yes, emacs_cv_struct_exception=no))
HAVE_EXCEPTION=$emacs_cv_struct_exception
dnl Define on Darwin so emacs symbols will not conflict with those
dnl in the System framework. Otherwise -prebind will not work.
if test $emacs_cv_struct_exception != yes || test $opsys = darwin; then
AC_DEFINE(NO_MATHERR, 1, [Define to 1 if you don't have struct exception in math.h.])
fi
AC_CHECK_HEADERS_ONCE(sys/socket.h)
AC_CHECK_HEADERS(net/if.h, , , [AC_INCLUDES_DEFAULT
#if HAVE_SYS_SOCKET_H
@ -2781,7 +2770,7 @@ AC_SUBST(BLESSMAIL_TARGET)
AC_CHECK_FUNCS(gethostname \
closedir getrusage get_current_dir_name \
lrand48 logb frexp fmod cbrt setsid \
lrand48 logb cbrt setsid \
fpathconf select euidaccess getpagesize setlocale \
utimes getrlimit setrlimit setpgid getcwd shutdown getaddrinfo \
__fpending strsignal setitimer \
@ -3211,12 +3200,6 @@ AC_DEFINE(CLASH_DETECTION, 1, [Define if you want lock files to be written,
so that Emacs can tell instantly when you try to modify a file that
someone else has modified in his/her Emacs.])
AH_TEMPLATE(FLOAT_CHECK_DOMAIN, [Define if the float library doesn't
handle errors by either setting errno, or signaling SIGFPE.])
AH_TEMPLATE(HAVE_INVERSE_HYPERBOLIC, [Define if you have the functions
acosh, asinh, and atanh.])
dnl Everybody supports this, except MS.
dnl Seems like the kind of thing we should be testing for, though.
## Note: PTYs are broken on darwin <6. Use at your own risk.

32
src/ChangeLog
View file

@ -1,3 +1,35 @@
2012-09-09 Paul Eggert <eggert@cs.ucla.edu>
Assume C89 or later for math functions (Bug#12381).
This simplifies the code, and makes it a bit smaller and faster,
and (most important) makes it easier to clean up signal handling
since we can stop worring about floating-point exceptions in
library code. That was a problem before C89, but the problem
went away many years ago on all practical Emacs targets.
* data.c, image.c, lread.c, print.c:
Don't include <math.h>; no longer needed.
* data.c, floatfns.c (IEEE_FLOATING_POINT): Don't worry that it
might be autoconfigured, as that never happens.
* data.c (fmod):
* doprnt.c (DBL_MAX_10_EXP):
* print.c (DBL_DIG):
Remove. C89 or later always defines these.
* floatfns.c (HAVE_MATHERR, FLOAT_CHECK_ERRNO, FLOAT_CHECK_DOMAIN)
(in_float, float_error_arg, float_error_arg2, float_error_fn_name)
(arith_error, domain_error, domain_error2):
Remove all this pre-C89 cruft. Do not include <errno.h> as that's
no longer needed -- we simply return what C returns. All uses removed.
(IN_FLOAT, IN_FLOAT2): Remove. All uses replaced with
the wrapped code.
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error, range_error2):
Remove. All uses expanded, as these macros are no longer used
more than once and are now more trouble than they're worth.
(Ftan): Use tan, not sin / cos.
(Flogb): Assume C89 frexp.
(fmod_float): Assume C89 fmod.
(matherr) [HAVE_MATHERR]: Remove; no longer needed.
(init_floatfns): Remove. All uses removed.
2012-09-08 Jan Djärv <jan.h.d@swipnet.se>
* nsterm.m (ns_draw_fringe_bitmap, ns_dumpglyphs_image): Take back

27
src/data.c
View file

@ -36,17 +36,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "keymap.h"
#include <float.h>
/* 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
#include <math.h>
Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
static Lisp_Object Qsubr;
@ -2737,28 +2732,6 @@ Both must be integers or markers. */)
return val;
}
#ifndef HAVE_FMOD
double
fmod (double f1, double f2)
{
double r = f1;
if (f2 < 0.0)
f2 = -f2;
/* If the magnitude of the result exceeds that of the divisor, or
the sign of the result does not agree with that of the dividend,
iterate with the reduced value. This does not yield a
particularly accurate result, but at least it will be in the
range promised by fmod. */
do
r -= f2 * floor (r / f2);
while (f2 <= (r < 0 ? -r : r) || ((r < 0) != (f1 < 0) && ! isnan (r)));
return r;
}
#endif /* ! HAVE_FMOD */
DEFUN ("mod", Fmod, Smod, 2, 2, 0,
doc: /* Return X modulo Y.
The result falls between zero (inclusive) and Y (exclusive).

4
src/doprnt.c
View file

@ -114,10 +114,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
another macro. */
#include "character.h"
#ifndef DBL_MAX_10_EXP
#define DBL_MAX_10_EXP 308 /* IEEE double */
#endif
/* Generate output from a format-spec FORMAT,
terminated at position FORMAT_END.
(*FORMAT_END is not part of the format, but must exist and be readable.)

1
src/emacs.c
View file

@ -1587,7 +1587,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
init_fringe ();
#endif /* HAVE_WINDOW_SYSTEM */
init_macros ();
init_floatfns ();
init_window ();
init_font ();

435
src/floatfns.c
View file

@ -22,26 +22,9 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* ANSI C requires only these float functions:
/* C89 requires only these math.h 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 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.
(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_CHECK_DOMAIN if the float library doesn't handle errors by
either setting errno, or signaling SIGFPE. 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 <config.h>
@ -50,15 +33,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "syssignal.h"
#include <float.h>
/* 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
#include <math.h>
@ -67,120 +47,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
extern double logb (double);
#endif /* not HPUX and HAVE_LOGB and no logb macro */
#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 NO_MATHERR
#undef HAVE_MATHERR
#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>
#endif
/* True while executing in floating point.
This tells float_error what to do. */
static bool 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.
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;
static const char *float_error_fn_name;
/* Evaluate the floating point expression D, recording NUM
as the original argument for error messages.
D is normally an assignment expression.
Handle errors which may result in signals or may set errno.
Note that float_error may be declared to return void, so you can't
just cast the zero after the colon to (void) to make the types
check properly. */
#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_FLOAT(d, name, num) (in_float = 1, (d), in_float = 0)
#define IN_FLOAT2(d, name, num, num2) (in_float = 1, (d), in_float = 0)
#endif
/* Convert float to Lisp_Int if it fits, else signal a range error
using the given arguments. */
#define FLOAT_TO_INT(x, i, name, num) \
do \
{ \
if (FIXNUM_OVERFLOW_P (x)) \
range_error (name, num); \
XSETINT (i, (EMACS_INT)(x)); \
} \
while (0)
#define FLOAT_TO_INT2(x, i, name, num1, num2) \
do \
{ \
if (FIXNUM_OVERFLOW_P (x)) \
range_error2 (name, num1, num2); \
XSETINT (i, (EMACS_INT)(x)); \
} \
while (0)
#define arith_error(op,arg) \
xsignal2 (Qarith_error, build_string ((op)), (arg))
#define range_error(op,arg) \
xsignal2 (Qrange_error, build_string ((op)), (arg))
#define range_error2(op,a1,a2) \
xsignal3 (Qrange_error, build_string ((op)), (a1), (a2))
#define domain_error(op,arg) \
xsignal2 (Qdomain_error, build_string ((op)), (arg))
#ifdef FLOAT_CHECK_DOMAIN
#define domain_error2(op,a1,a2) \
xsignal3 (Qdomain_error, build_string ((op)), (a1), (a2))
#endif
/* Extract a Lisp number as a `double', or signal an error. */
double
@ -197,27 +63,19 @@ extract_float (Lisp_Object num)
DEFUN ("acos", Facos, Sacos, 1, 1, 0,
doc: /* Return the inverse cosine of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
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);
d = acos (d);
return make_float (d);
}
DEFUN ("asin", Fasin, Sasin, 1, 1, 0,
doc: /* Return the inverse sine of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
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);
d = asin (d);
return make_float (d);
}
@ -227,50 +85,44 @@ If only one argument Y is given, return the inverse tangent of Y.
If two arguments Y and X are given, return the inverse tangent of Y
divided by X, i.e. the angle in radians between the vector (X, Y)
and the x-axis. */)
(register Lisp_Object y, Lisp_Object x)
(Lisp_Object y, Lisp_Object x)
{
double d = extract_float (y);
if (NILP (x))
IN_FLOAT (d = atan (d), "atan", y);
d = atan (d);
else
{
double d2 = extract_float (x);
IN_FLOAT2 (d = atan2 (d, d2), "atan", y, x);
d = atan2 (d, d2);
}
return make_float (d);
}
DEFUN ("cos", Fcos, Scos, 1, 1, 0,
doc: /* Return the cosine of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
double d = extract_float (arg);
IN_FLOAT (d = cos (d), "cos", arg);
d = cos (d);
return make_float (d);
}
DEFUN ("sin", Fsin, Ssin, 1, 1, 0,
doc: /* Return the sine of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
double d = extract_float (arg);
IN_FLOAT (d = sin (d), "sin", arg);
d = sin (d);
return make_float (d);
}
DEFUN ("tan", Ftan, Stan, 1, 1, 0,
doc: /* Return the tangent of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
double d = extract_float (arg);
#ifdef FLOAT_CHECK_DOMAIN
double c = cos (d);
if (c == 0.0)
domain_error ("tan", arg);
#endif
IN_FLOAT (d = tan (d), "tan", arg);
d = tan (d);
return make_float (d);
}
@ -341,61 +193,61 @@ Returns the floating point value resulting from multiplying SGNFCAND
DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0,
doc: /* Return the bessel function j0 of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
double d = extract_float (arg);
IN_FLOAT (d = j0 (d), "bessel-j0", arg);
d = j0 (d);
return make_float (d);
}
DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0,
doc: /* Return the bessel function j1 of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
double d = extract_float (arg);
IN_FLOAT (d = j1 (d), "bessel-j1", arg);
d = j1 (d);
return make_float (d);
}
DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0,
doc: /* Return the order N bessel function output jn of ARG.
The first arg (the order) is truncated to an integer. */)
(register Lisp_Object n, Lisp_Object arg)
(Lisp_Object n, Lisp_Object arg)
{
int i1 = extract_float (n);
double f2 = extract_float (arg);
IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", n);
f2 = jn (i1, f2);
return make_float (f2);
}
DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0,
doc: /* Return the bessel function y0 of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
double d = extract_float (arg);
IN_FLOAT (d = y0 (d), "bessel-y0", arg);
d = y0 (d);
return make_float (d);
}
DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0,
doc: /* Return the bessel function y1 of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
double d = extract_float (arg);
IN_FLOAT (d = y1 (d), "bessel-y0", arg);
d = y1 (d);
return make_float (d);
}
DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0,
doc: /* Return the order N bessel function output yn of ARG.
The first arg (the order) is truncated to an integer. */)
(register Lisp_Object n, Lisp_Object arg)
(Lisp_Object n, Lisp_Object arg)
{
int i1 = extract_float (n);
double f2 = extract_float (arg);
IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", n);
f2 = yn (i1, f2);
return make_float (f2);
}
@ -405,43 +257,43 @@ The first arg (the order) is truncated to an integer. */)
DEFUN ("erf", Ferf, Serf, 1, 1, 0,
doc: /* Return the mathematical error function of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
double d = extract_float (arg);
IN_FLOAT (d = erf (d), "erf", arg);
d = erf (d);
return make_float (d);
}
DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0,
doc: /* Return the complementary error function of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
double d = extract_float (arg);
IN_FLOAT (d = erfc (d), "erfc", arg);
d = erfc (d);
return make_float (d);
}
DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0,
doc: /* Return the log gamma of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
double d = extract_float (arg);
IN_FLOAT (d = lgamma (d), "log-gamma", arg);
d = lgamma (d);
return make_float (d);
}
DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0,
doc: /* Return the cube root of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
double d = extract_float (arg);
#ifdef HAVE_CBRT
IN_FLOAT (d = cbrt (d), "cube-root", arg);
d = cbrt (d);
#else
if (d >= 0.0)
IN_FLOAT (d = pow (d, 1.0/3.0), "cube-root", arg);
d = pow (d, 1.0/3.0);
else
IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", arg);
d = -pow (-d, 1.0/3.0);
#endif
return make_float (d);
}
@ -450,23 +302,16 @@ DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0,
DEFUN ("exp", Fexp, Sexp, 1, 1, 0,
doc: /* Return the exponential base e of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
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);
d = exp (d);
return make_float (d);
}
DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
doc: /* Return the exponential ARG1 ** ARG2. */)
(register Lisp_Object arg1, Lisp_Object arg2)
(Lisp_Object arg1, Lisp_Object arg2)
{
double f1, f2, f3;
@ -495,72 +340,46 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
}
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;
#ifdef FLOAT_CHECK_DOMAIN
else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor (f2)))
domain_error2 ("expt", arg1, arg2);
#endif
IN_FLOAT2 (f3 = pow (f1, f2), "expt", arg1, arg2);
/* Check for overflow in the result. */
if (f1 != 0.0 && f3 == 0.0)
range_error ("expt", arg1);
f3 = pow (f1, f2);
return make_float (f3);
}
DEFUN ("log", Flog, Slog, 1, 2, 0,
doc: /* Return the natural logarithm of ARG.
If the optional argument BASE is given, return log ARG using that base. */)
(register Lisp_Object arg, Lisp_Object base)
(Lisp_Object arg, Lisp_Object base)
{
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), "log", arg);
d = log (d);
else
{
double b = extract_float (base);
#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);
d = log10 (d);
else
IN_FLOAT2 (d = log (d) / log (b), "log", arg, base);
d = log (d) / log (b);
}
return make_float (d);
}
DEFUN ("log10", Flog10, Slog10, 1, 1, 0,
doc: /* Return the logarithm base 10 of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
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);
d = log10 (d);
return make_float (d);
}
DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0,
doc: /* Return the square root of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
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);
d = sqrt (d);
return make_float (d);
}
@ -568,83 +387,55 @@ DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0,
DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0,
doc: /* Return the inverse hyperbolic cosine of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
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
d = acosh (d);
return make_float (d);
}
DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0,
doc: /* Return the inverse hyperbolic sine of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
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
d = asinh (d);
return make_float (d);
}
DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0,
doc: /* Return the inverse hyperbolic tangent of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
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
d = atanh (d);
return make_float (d);
}
DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0,
doc: /* Return the hyperbolic cosine of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
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);
d = cosh (d);
return make_float (d);
}
DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0,
doc: /* Return the hyperbolic sine of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
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);
d = sinh (d);
return make_float (d);
}
DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0,
doc: /* Return the hyperbolic tangent of ARG. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
double d = extract_float (arg);
IN_FLOAT (d = tanh (d), "tanh", arg);
d = tanh (d);
return make_float (d);
}
#endif
@ -689,33 +480,11 @@ This is the same as the exponent of a float. */)
else
{
#ifdef HAVE_LOGB
IN_FLOAT (value = logb (f), "logb", arg);
value = logb (f);
#else
#ifdef HAVE_FREXP
int ivalue;
IN_FLOAT (frexp (f, &ivalue), "logb", arg);
frexp (f, &ivalue);
value = ivalue - 1;
#else
int i;
double d;
if (f < 0.0)
f = -f;
value = -1;
while (f < 0.5)
{
for (i = 1, d = 0.5; d * d >= f; i += i)
d *= d;
f /= d;
value -= i;
}
while (f >= 1.0)
{
for (i = 1, d = 2.0; d * d <= f; i += i)
d *= d;
f /= d;
value += i;
}
#endif
#endif
}
XSETINT (val, value);
@ -748,8 +517,10 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor,
if (! IEEE_FLOATING_POINT && f2 == 0)
xsignal0 (Qarith_error);
IN_FLOAT2 (f1 = (*double_round) (f1 / f2), name, arg, divisor);
FLOAT_TO_INT2 (f1, arg, name, arg, divisor);
f1 = (*double_round) (f1 / f2);
if (FIXNUM_OVERFLOW_P (f1))
xsignal3 (Qrange_error, build_string (name), arg, divisor);
arg = make_number (f1);
return arg;
}
@ -765,10 +536,10 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor,
if (FLOATP (arg))
{
double d;
IN_FLOAT (d = (*double_round) (XFLOAT_DATA (arg)), name, arg);
FLOAT_TO_INT (d, arg, name, arg);
double d = (*double_round) (XFLOAT_DATA (arg));
if (FIXNUM_OVERFLOW_P (d))
xsignal2 (Qrange_error, build_string (name), arg);
arg = make_number (d);
}
return arg;
@ -885,97 +656,57 @@ fmod_float (Lisp_Object x, Lisp_Object y)
f1 = FLOATP (x) ? XFLOAT_DATA (x) : XINT (x);
f2 = FLOATP (y) ? XFLOAT_DATA (y) : XINT (y);
if (! IEEE_FLOATING_POINT && f2 == 0)
xsignal0 (Qarith_error);
f1 = fmod (f1, f2);
/* 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);
if (f2 < 0 ? 0 < f1 : f1 < 0)
f1 += f2;
return make_float (f1);
}
/* It's not clear these are worth adding. */
DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0,
doc: /* Return the smallest integer no less than ARG, as a float.
\(Round toward +inf.\) */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
double d = extract_float (arg);
IN_FLOAT (d = ceil (d), "fceiling", arg);
d = ceil (d);
return make_float (d);
}
DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0,
doc: /* Return the largest integer no greater than ARG, as a float.
\(Round towards -inf.\) */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
double d = extract_float (arg);
IN_FLOAT (d = floor (d), "ffloor", arg);
d = floor (d);
return make_float (d);
}
DEFUN ("fround", Ffround, Sfround, 1, 1, 0,
doc: /* Return the nearest integer to ARG, as a float. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
double d = extract_float (arg);
IN_FLOAT (d = emacs_rint (d), "fround", arg);
d = emacs_rint (d);
return make_float (d);
}
DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0,
doc: /* Truncate a floating point number to an integral float value.
Rounds the value toward zero. */)
(register Lisp_Object arg)
(Lisp_Object arg)
{
double d = extract_float (arg);
if (d >= 0.0)
IN_FLOAT (d = floor (d), "ftruncate", arg);
d = floor (d);
else
IN_FLOAT (d = ceil (d), "ftruncate", arg);
d = ceil (d);
return make_float (d);
}
#ifdef HAVE_MATHERR
int
matherr (struct exception *x)
{
Lisp_Object args;
const char *name = x->name;
if (! in_float)
/* Not called from emacs-lisp float routines; do the default thing. */
return 0;
if (!strcmp (x->name, "pow"))
name = "expt";
args
= Fcons (build_string (name),
Fcons (make_float (x->arg1),
((!strcmp (name, "log") || !strcmp (name, "pow"))
? Fcons (make_float (x->arg2), Qnil)
: Qnil)));
switch (x->type)
{
case DOMAIN: xsignal (Qdomain_error, args); break;
case SING: xsignal (Qsingularity_error, args); break;
case OVERFLOW: xsignal (Qoverflow_error, args); break;
case UNDERFLOW: xsignal (Qunderflow_error, args); break;
default: xsignal (Qarith_error, args); break;
}
return (1); /* don't set errno or print a message */
}
#endif /* HAVE_MATHERR */
void
init_floatfns (void)
{
in_float = 0;
}
void
syms_of_floatfns (void)
{

1
src/image.c
View file

@ -19,7 +19,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
#include <math.h>
#include <unistd.h>
#ifdef HAVE_PNG

1
src/lisp.h
View file

@ -2687,7 +2687,6 @@ extern void syms_of_fns (void);
/* Defined in floatfns.c */
extern double extract_float (Lisp_Object);
extern void init_floatfns (void);
extern void syms_of_floatfns (void);
extern Lisp_Object fmod_float (Lisp_Object x, Lisp_Object y);

1
src/lread.c
View file

@ -50,7 +50,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif
#include <unistd.h>
#include <math.h>
#ifdef HAVE_SETLOCALE
#include <locale.h>

6
src/print.c
View file

@ -45,15 +45,9 @@ static Lisp_Object Qtemp_buffer_setup_hook;
static Lisp_Object Qfloat_output_format;
#include <math.h>
#include <float.h>
#include <ftoastr.h>
/* Default to values appropriate for IEEE floating point. */
#ifndef DBL_DIG
#define DBL_DIG 15
#endif
/* Avoid actual stack overflow in print. */
static ptrdiff_t print_depth;