From: Paul Eggert Date: Sun, 9 Sep 2012 16:06:33 +0000 (-0700) Subject: Assume C89 or later for math functions. X-Git-Tag: emacs-24.2.90~346 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f6196b87e1ceee0d56f2fe6f3aa2b9d1d82c44b0;p=emacs.git Assume C89 or later for math functions. 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 ; 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 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. --- diff --git a/ChangeLog b/ChangeLog index e20edc893e4..198670e59ee 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2012-09-09 Paul Eggert + + 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 More signal-handler cleanup (Bug#12327). diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index d87feb9b866..b40ba78e20d 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -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 diff --git a/admin/ChangeLog b/admin/ChangeLog index 54fea2615fd..2c61f437981 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,9 @@ +2012-09-09 Paul Eggert + + 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 Simplify redefinition of 'abort' (Bug#12316). diff --git a/configure.ac b/configure.ac index 5fecea724dc..97e967d8043 100644 --- a/configure.ac +++ b/configure.ac @@ -1302,17 +1302,6 @@ if test $emacs_cv_speed_t = yes; then [Define to 1 if `speed_t' is declared by .]) fi -AC_CACHE_CHECK(for struct exception, emacs_cv_struct_exception, -AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], -[[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. diff --git a/src/ChangeLog b/src/ChangeLog index 56b96fda519..ae99fcc138d 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,35 @@ +2012-09-09 Paul Eggert + + 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 ; 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 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 * nsterm.m (ns_draw_fringe_bitmap, ns_dumpglyphs_image): Take back diff --git a/src/data.c b/src/data.c index de107fc04a5..a4cca0a3ee5 100644 --- a/src/data.c +++ b/src/data.c @@ -36,17 +36,12 @@ along with GNU Emacs. If not, see . */ #include "keymap.h" #include -/* 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 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). diff --git a/src/doprnt.c b/src/doprnt.c index b36e946005d..3b7391f07d4 100644 --- a/src/doprnt.c +++ b/src/doprnt.c @@ -114,10 +114,6 @@ along with GNU Emacs. If not, see . */ 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.) diff --git a/src/emacs.c b/src/emacs.c index 36e51869504..deaed25d9e8 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -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 (); diff --git a/src/floatfns.c b/src/floatfns.c index dfe063b152f..8a9a9fd0886 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -22,26 +22,9 @@ You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ -/* 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 @@ -50,15 +33,12 @@ along with GNU Emacs. If not, see . */ #include "syssignal.h" #include -/* 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 @@ -67,120 +47,6 @@ along with GNU Emacs. If not, see . */ 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 -#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) { diff --git a/src/image.c b/src/image.c index fc99f882973..4ec6105d72d 100644 --- a/src/image.c +++ b/src/image.c @@ -19,7 +19,6 @@ along with GNU Emacs. If not, see . */ #include #include -#include #include #ifdef HAVE_PNG diff --git a/src/lisp.h b/src/lisp.h index e6594b5890c..95ea87a15d2 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -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); diff --git a/src/lread.c b/src/lread.c index 4f3a93b16b4..02b13affb6a 100644 --- a/src/lread.c +++ b/src/lread.c @@ -50,7 +50,6 @@ along with GNU Emacs. If not, see . */ #endif #include -#include #ifdef HAVE_SETLOCALE #include diff --git a/src/print.c b/src/print.c index 72e536e4278..ab86ee1a8b5 100644 --- a/src/print.c +++ b/src/print.c @@ -45,15 +45,9 @@ static Lisp_Object Qtemp_buffer_setup_hook; static Lisp_Object Qfloat_output_format; -#include #include #include -/* 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;