aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPaul Eggert2012-09-09 09:06:33 -0700
committerPaul Eggert2012-09-09 09:06:33 -0700
commitf6196b87e1ceee0d56f2fe6f3aa2b9d1d82c44b0 (patch)
tree3400f2f4898ce1fc39ad437faa5e55714129d30b
parent8ed43f154827121c624a5a93808340618bd8f03f (diff)
downloademacs-f6196b87e1ceee0d56f2fe6f3aa2b9d1d82c44b0.tar.gz
emacs-f6196b87e1ceee0d56f2fe6f3aa2b9d1d82c44b0.zip
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 <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.
-rw-r--r--ChangeLog9
-rw-r--r--admin/CPP-DEFINES5
-rw-r--r--admin/ChangeLog6
-rw-r--r--configure.ac19
-rw-r--r--src/ChangeLog32
-rw-r--r--src/data.c27
-rw-r--r--src/doprnt.c4
-rw-r--r--src/emacs.c1
-rw-r--r--src/floatfns.c435
-rw-r--r--src/image.c1
-rw-r--r--src/lisp.h1
-rw-r--r--src/lread.c1
-rw-r--r--src/print.c6
13 files changed, 131 insertions, 416 deletions
diff --git a/ChangeLog b/ChangeLog
index e20edc893e4..198670e59ee 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
12012-09-09 Paul Eggert <eggert@cs.ucla.edu>
2
3 Assume C89 or later for math functions (Bug#12381).
4 * configure.ac (frexp, fmod): Remove checks for these functions,
5 as we now assume them.
6 (FLOAT_CHECK_DOMAIN, HAVE_INVERSE_HYPERBOLIC, NO_MATHERR)
7 (HAVE_EXCEPTION):
8 Remove; no longer needed.
9
12012-09-07 Paul Eggert <eggert@cs.ucla.edu> 102012-09-07 Paul Eggert <eggert@cs.ucla.edu>
2 11
3 More signal-handler cleanup (Bug#12327). 12 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
107EMACS_CONFIG_OPTIONS 107EMACS_CONFIG_OPTIONS
108EMACS_INT 108EMACS_INT
109EMACS_UINT 109EMACS_UINT
110FLOAT_CHECK_DOMAIN
111GC_MARK_SECONDARY_STACK 110GC_MARK_SECONDARY_STACK
112GC_MARK_STACK 111GC_MARK_STACK
113GC_SETJMP_WORKS 112GC_SETJMP_WORKS
@@ -158,12 +157,10 @@ HAVE_ENDPWENT
158HAVE_ENVIRON_DECL 157HAVE_ENVIRON_DECL
159HAVE_EUIDACCESS 158HAVE_EUIDACCESS
160HAVE_FCNTL_H 159HAVE_FCNTL_H
161HAVE_FMOD
162HAVE_FORK 160HAVE_FORK
163HAVE_FPATHCONF 161HAVE_FPATHCONF
164HAVE_FREEIFADDRS 162HAVE_FREEIFADDRS
165HAVE_FREETYPE 163HAVE_FREETYPE
166HAVE_FREXP
167HAVE_FSEEKO 164HAVE_FSEEKO
168HAVE_FSYNC 165HAVE_FSYNC
169HAVE_FUTIMENS 166HAVE_FUTIMENS
@@ -217,7 +214,6 @@ HAVE_IFADDRS_H
217HAVE_IMAGEMAGICK 214HAVE_IMAGEMAGICK
218HAVE_INET_SOCKETS 215HAVE_INET_SOCKETS
219HAVE_INTTYPES_H 216HAVE_INTTYPES_H
220HAVE_INVERSE_HYPERBOLIC
221HAVE_JPEG 217HAVE_JPEG
222HAVE_KERBEROSIV_DES_H 218HAVE_KERBEROSIV_DES_H
223HAVE_KERBEROSIV_KRB_H 219HAVE_KERBEROSIV_KRB_H
@@ -429,7 +425,6 @@ MAIL_USE_SYSTEM_LOCK
429MAXPATHLEN 425MAXPATHLEN
430NLIST_STRUCT 426NLIST_STRUCT
431NO_EDITRES 427NO_EDITRES
432NO_MATHERR
433NO_TERMIO 428NO_TERMIO
434NSIG 429NSIG
435NSIG_MINIMUM 430NSIG_MINIMUM
diff --git a/admin/ChangeLog b/admin/ChangeLog
index 54fea2615fd..2c61f437981 100644
--- a/admin/ChangeLog
+++ b/admin/ChangeLog
@@ -1,3 +1,9 @@
12012-09-09 Paul Eggert <eggert@cs.ucla.edu>
2
3 Assume C89 or later for math functions (Bug#12381).
4 * CPP-DEFINES (HAVE_FMOD, HAVE_FREXP, FLOAT_CHECK_DOMAIN)
5 (HAVE_INVERSE_HYPERBOLIC, NO_MATHERR): Remove.
6
12012-09-04 Paul Eggert <eggert@cs.ucla.edu> 72012-09-04 Paul Eggert <eggert@cs.ucla.edu>
2 8
3 Simplify redefinition of 'abort' (Bug#12316). 9 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
1302 [Define to 1 if `speed_t' is declared by <termios.h>.]) 1302 [Define to 1 if `speed_t' is declared by <termios.h>.])
1303fi 1303fi
1304 1304
1305AC_CACHE_CHECK(for struct exception, emacs_cv_struct_exception,
1306AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <math.h>]],
1307[[static struct exception x; x.arg1 = x.arg2 = x.retval; x.name = ""; x.type = 1;]])],
1308 emacs_cv_struct_exception=yes, emacs_cv_struct_exception=no))
1309HAVE_EXCEPTION=$emacs_cv_struct_exception
1310dnl Define on Darwin so emacs symbols will not conflict with those
1311dnl in the System framework. Otherwise -prebind will not work.
1312if test $emacs_cv_struct_exception != yes || test $opsys = darwin; then
1313 AC_DEFINE(NO_MATHERR, 1, [Define to 1 if you don't have struct exception in math.h.])
1314fi
1315
1316AC_CHECK_HEADERS_ONCE(sys/socket.h) 1305AC_CHECK_HEADERS_ONCE(sys/socket.h)
1317AC_CHECK_HEADERS(net/if.h, , , [AC_INCLUDES_DEFAULT 1306AC_CHECK_HEADERS(net/if.h, , , [AC_INCLUDES_DEFAULT
1318#if HAVE_SYS_SOCKET_H 1307#if HAVE_SYS_SOCKET_H
@@ -2781,7 +2770,7 @@ AC_SUBST(BLESSMAIL_TARGET)
2781 2770
2782AC_CHECK_FUNCS(gethostname \ 2771AC_CHECK_FUNCS(gethostname \
2783closedir getrusage get_current_dir_name \ 2772closedir getrusage get_current_dir_name \
2784lrand48 logb frexp fmod cbrt setsid \ 2773lrand48 logb cbrt setsid \
2785fpathconf select euidaccess getpagesize setlocale \ 2774fpathconf select euidaccess getpagesize setlocale \
2786utimes getrlimit setrlimit setpgid getcwd shutdown getaddrinfo \ 2775utimes getrlimit setrlimit setpgid getcwd shutdown getaddrinfo \
2787__fpending strsignal setitimer \ 2776__fpending strsignal setitimer \
@@ -3211,12 +3200,6 @@ AC_DEFINE(CLASH_DETECTION, 1, [Define if you want lock files to be written,
3211 so that Emacs can tell instantly when you try to modify a file that 3200 so that Emacs can tell instantly when you try to modify a file that
3212 someone else has modified in his/her Emacs.]) 3201 someone else has modified in his/her Emacs.])
3213 3202
3214AH_TEMPLATE(FLOAT_CHECK_DOMAIN, [Define if the float library doesn't
3215 handle errors by either setting errno, or signaling SIGFPE.])
3216
3217AH_TEMPLATE(HAVE_INVERSE_HYPERBOLIC, [Define if you have the functions
3218 acosh, asinh, and atanh.])
3219
3220dnl Everybody supports this, except MS. 3203dnl Everybody supports this, except MS.
3221dnl Seems like the kind of thing we should be testing for, though. 3204dnl Seems like the kind of thing we should be testing for, though.
3222## Note: PTYs are broken on darwin <6. Use at your own risk. 3205## 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 @@
12012-09-09 Paul Eggert <eggert@cs.ucla.edu>
2
3 Assume C89 or later for math functions (Bug#12381).
4 This simplifies the code, and makes it a bit smaller and faster,
5 and (most important) makes it easier to clean up signal handling
6 since we can stop worring about floating-point exceptions in
7 library code. That was a problem before C89, but the problem
8 went away many years ago on all practical Emacs targets.
9 * data.c, image.c, lread.c, print.c:
10 Don't include <math.h>; no longer needed.
11 * data.c, floatfns.c (IEEE_FLOATING_POINT): Don't worry that it
12 might be autoconfigured, as that never happens.
13 * data.c (fmod):
14 * doprnt.c (DBL_MAX_10_EXP):
15 * print.c (DBL_DIG):
16 Remove. C89 or later always defines these.
17 * floatfns.c (HAVE_MATHERR, FLOAT_CHECK_ERRNO, FLOAT_CHECK_DOMAIN)
18 (in_float, float_error_arg, float_error_arg2, float_error_fn_name)
19 (arith_error, domain_error, domain_error2):
20 Remove all this pre-C89 cruft. Do not include <errno.h> as that's
21 no longer needed -- we simply return what C returns. All uses removed.
22 (IN_FLOAT, IN_FLOAT2): Remove. All uses replaced with
23 the wrapped code.
24 (FLOAT_TO_INT, FLOAT_TO_INT2, range_error, range_error2):
25 Remove. All uses expanded, as these macros are no longer used
26 more than once and are now more trouble than they're worth.
27 (Ftan): Use tan, not sin / cos.
28 (Flogb): Assume C89 frexp.
29 (fmod_float): Assume C89 fmod.
30 (matherr) [HAVE_MATHERR]: Remove; no longer needed.
31 (init_floatfns): Remove. All uses removed.
32
12012-09-08 Jan Djärv <jan.h.d@swipnet.se> 332012-09-08 Jan Djärv <jan.h.d@swipnet.se>
2 34
3 * nsterm.m (ns_draw_fringe_bitmap, ns_dumpglyphs_image): Take back 35 * 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 <http://www.gnu.org/licenses/>. */
36#include "keymap.h" 36#include "keymap.h"
37 37
38#include <float.h> 38#include <float.h>
39/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */
40#ifndef IEEE_FLOATING_POINT
41#if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ 39#if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
42 && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) 40 && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
43#define IEEE_FLOATING_POINT 1 41#define IEEE_FLOATING_POINT 1
44#else 42#else
45#define IEEE_FLOATING_POINT 0 43#define IEEE_FLOATING_POINT 0
46#endif 44#endif
47#endif
48
49#include <math.h>
50 45
51Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound; 46Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
52static Lisp_Object Qsubr; 47static Lisp_Object Qsubr;
@@ -2737,28 +2732,6 @@ Both must be integers or markers. */)
2737 return val; 2732 return val;
2738} 2733}
2739 2734
2740#ifndef HAVE_FMOD
2741double
2742fmod (double f1, double f2)
2743{
2744 double r = f1;
2745
2746 if (f2 < 0.0)
2747 f2 = -f2;
2748
2749 /* If the magnitude of the result exceeds that of the divisor, or
2750 the sign of the result does not agree with that of the dividend,
2751 iterate with the reduced value. This does not yield a
2752 particularly accurate result, but at least it will be in the
2753 range promised by fmod. */
2754 do
2755 r -= f2 * floor (r / f2);
2756 while (f2 <= (r < 0 ? -r : r) || ((r < 0) != (f1 < 0) && ! isnan (r)));
2757
2758 return r;
2759}
2760#endif /* ! HAVE_FMOD */
2761
2762DEFUN ("mod", Fmod, Smod, 2, 2, 0, 2735DEFUN ("mod", Fmod, Smod, 2, 2, 0,
2763 doc: /* Return X modulo Y. 2736 doc: /* Return X modulo Y.
2764The result falls between zero (inclusive) and Y (exclusive). 2737The 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 <http://www.gnu.org/licenses/>. */
114 another macro. */ 114 another macro. */
115#include "character.h" 115#include "character.h"
116 116
117#ifndef DBL_MAX_10_EXP
118#define DBL_MAX_10_EXP 308 /* IEEE double */
119#endif
120
121/* Generate output from a format-spec FORMAT, 117/* Generate output from a format-spec FORMAT,
122 terminated at position FORMAT_END. 118 terminated at position FORMAT_END.
123 (*FORMAT_END is not part of the format, but must exist and be readable.) 119 (*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
1587 init_fringe (); 1587 init_fringe ();
1588#endif /* HAVE_WINDOW_SYSTEM */ 1588#endif /* HAVE_WINDOW_SYSTEM */
1589 init_macros (); 1589 init_macros ();
1590 init_floatfns ();
1591 init_window (); 1590 init_window ();
1592 init_font (); 1591 init_font ();
1593 1592
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
22along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ 22along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 23
24 24
25/* ANSI C requires only these float functions: 25/* C89 requires only these math.h functions:
26 acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod, 26 acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod,
27 frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh. 27 frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh.
28
29 Define HAVE_INVERSE_HYPERBOLIC if you have acosh, asinh, and atanh.
30 Define HAVE_CBRT if you have cbrt.
31 Define HAVE_RINT if you have a working rint.
32 If you don't define these, then the appropriate routines will be simulated.
33
34 Define HAVE_MATHERR if on a system supporting the SysV matherr callback.
35 (This should happen automatically.)
36
37 Define FLOAT_CHECK_ERRNO if the float library routines set errno.
38 This has no effect if HAVE_MATHERR is defined.
39
40 Define FLOAT_CHECK_DOMAIN if the float library doesn't handle errors by
41 either setting errno, or signaling SIGFPE. Otherwise, domain and
42 range checking will happen before calling the float routines. This has
43 no effect if HAVE_MATHERR is defined (since matherr will be called when
44 a domain error occurs.)
45 */ 28 */
46 29
47#include <config.h> 30#include <config.h>
@@ -50,15 +33,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
50#include "syssignal.h" 33#include "syssignal.h"
51 34
52#include <float.h> 35#include <float.h>
53/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */
54#ifndef IEEE_FLOATING_POINT
55#if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ 36#if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
56 && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) 37 && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
57#define IEEE_FLOATING_POINT 1 38#define IEEE_FLOATING_POINT 1
58#else 39#else
59#define IEEE_FLOATING_POINT 0 40#define IEEE_FLOATING_POINT 0
60#endif 41#endif
61#endif
62 42
63#include <math.h> 43#include <math.h>
64 44
@@ -67,120 +47,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
67extern double logb (double); 47extern double logb (double);
68#endif /* not HPUX and HAVE_LOGB and no logb macro */ 48#endif /* not HPUX and HAVE_LOGB and no logb macro */
69 49
70#if defined (DOMAIN) && defined (SING) && defined (OVERFLOW)
71 /* If those are defined, then this is probably a `matherr' machine. */
72# ifndef HAVE_MATHERR
73# define HAVE_MATHERR
74# endif
75#endif
76
77#ifdef NO_MATHERR
78#undef HAVE_MATHERR
79#endif
80
81#ifdef HAVE_MATHERR
82# ifdef FLOAT_CHECK_ERRNO
83# undef FLOAT_CHECK_ERRNO
84# endif
85# ifdef FLOAT_CHECK_DOMAIN
86# undef FLOAT_CHECK_DOMAIN
87# endif
88#endif
89
90#ifndef NO_FLOAT_CHECK_ERRNO
91#define FLOAT_CHECK_ERRNO
92#endif
93
94#ifdef FLOAT_CHECK_ERRNO
95# include <errno.h>
96#endif
97
98/* True while executing in floating point.
99 This tells float_error what to do. */
100
101static bool in_float;
102
103/* If an argument is out of range for a mathematical function,
104 here is the actual argument value to use in the error message.
105 These variables are used only across the floating point library call
106 so there is no need to staticpro them. */
107
108static Lisp_Object float_error_arg, float_error_arg2;
109
110static const char *float_error_fn_name;
111
112/* Evaluate the floating point expression D, recording NUM
113 as the original argument for error messages.
114 D is normally an assignment expression.
115 Handle errors which may result in signals or may set errno.
116
117 Note that float_error may be declared to return void, so you can't
118 just cast the zero after the colon to (void) to make the types
119 check properly. */
120
121#ifdef FLOAT_CHECK_ERRNO
122#define IN_FLOAT(d, name, num) \
123 do { \
124 float_error_arg = num; \
125 float_error_fn_name = name; \
126 in_float = 1; errno = 0; (d); in_float = 0; \
127 switch (errno) { \
128 case 0: break; \
129 case EDOM: domain_error (float_error_fn_name, float_error_arg); \
130 case ERANGE: range_error (float_error_fn_name, float_error_arg); \
131 default: arith_error (float_error_fn_name, float_error_arg); \
132 } \
133 } while (0)
134#define IN_FLOAT2(d, name, num, num2) \
135 do { \
136 float_error_arg = num; \
137 float_error_arg2 = num2; \
138 float_error_fn_name = name; \
139 in_float = 1; errno = 0; (d); in_float = 0; \
140 switch (errno) { \
141 case 0: break; \
142 case EDOM: domain_error (float_error_fn_name, float_error_arg); \
143 case ERANGE: range_error (float_error_fn_name, float_error_arg); \
144 default: arith_error (float_error_fn_name, float_error_arg); \
145 } \
146 } while (0)
147#else
148#define IN_FLOAT(d, name, num) (in_float = 1, (d), in_float = 0)
149#define IN_FLOAT2(d, name, num, num2) (in_float = 1, (d), in_float = 0)
150#endif
151
152/* Convert float to Lisp_Int if it fits, else signal a range error
153 using the given arguments. */
154#define FLOAT_TO_INT(x, i, name, num) \
155 do \
156 { \
157 if (FIXNUM_OVERFLOW_P (x)) \
158 range_error (name, num); \
159 XSETINT (i, (EMACS_INT)(x)); \
160 } \
161 while (0)
162#define FLOAT_TO_INT2(x, i, name, num1, num2) \
163 do \
164 { \
165 if (FIXNUM_OVERFLOW_P (x)) \
166 range_error2 (name, num1, num2); \
167 XSETINT (i, (EMACS_INT)(x)); \
168 } \
169 while (0)
170
171#define arith_error(op,arg) \
172 xsignal2 (Qarith_error, build_string ((op)), (arg))
173#define range_error(op,arg) \
174 xsignal2 (Qrange_error, build_string ((op)), (arg))
175#define range_error2(op,a1,a2) \
176 xsignal3 (Qrange_error, build_string ((op)), (a1), (a2))
177#define domain_error(op,arg) \
178 xsignal2 (Qdomain_error, build_string ((op)), (arg))
179#ifdef FLOAT_CHECK_DOMAIN
180#define domain_error2(op,a1,a2) \
181 xsignal3 (Qdomain_error, build_string ((op)), (a1), (a2))
182#endif
183
184/* Extract a Lisp number as a `double', or signal an error. */ 50/* Extract a Lisp number as a `double', or signal an error. */
185 51
186double 52double
@@ -197,27 +63,19 @@ extract_float (Lisp_Object num)
197 63
198DEFUN ("acos", Facos, Sacos, 1, 1, 0, 64DEFUN ("acos", Facos, Sacos, 1, 1, 0,
199 doc: /* Return the inverse cosine of ARG. */) 65 doc: /* Return the inverse cosine of ARG. */)
200 (register Lisp_Object arg) 66 (Lisp_Object arg)
201{ 67{
202 double d = extract_float (arg); 68 double d = extract_float (arg);
203#ifdef FLOAT_CHECK_DOMAIN 69 d = acos (d);
204 if (d > 1.0 || d < -1.0)
205 domain_error ("acos", arg);
206#endif
207 IN_FLOAT (d = acos (d), "acos", arg);
208 return make_float (d); 70 return make_float (d);
209} 71}
210 72
211DEFUN ("asin", Fasin, Sasin, 1, 1, 0, 73DEFUN ("asin", Fasin, Sasin, 1, 1, 0,
212 doc: /* Return the inverse sine of ARG. */) 74 doc: /* Return the inverse sine of ARG. */)
213 (register Lisp_Object arg) 75 (Lisp_Object arg)
214{ 76{
215 double d = extract_float (arg); 77 double d = extract_float (arg);
216#ifdef FLOAT_CHECK_DOMAIN 78 d = asin (d);
217 if (d > 1.0 || d < -1.0)
218 domain_error ("asin", arg);
219#endif
220 IN_FLOAT (d = asin (d), "asin", arg);
221 return make_float (d); 79 return make_float (d);
222} 80}
223 81
@@ -227,50 +85,44 @@ If only one argument Y is given, return the inverse tangent of Y.
227If two arguments Y and X are given, return the inverse tangent of Y 85If two arguments Y and X are given, return the inverse tangent of Y
228divided by X, i.e. the angle in radians between the vector (X, Y) 86divided by X, i.e. the angle in radians between the vector (X, Y)
229and the x-axis. */) 87and the x-axis. */)
230 (register Lisp_Object y, Lisp_Object x) 88 (Lisp_Object y, Lisp_Object x)
231{ 89{
232 double d = extract_float (y); 90 double d = extract_float (y);
233 91
234 if (NILP (x)) 92 if (NILP (x))
235 IN_FLOAT (d = atan (d), "atan", y); 93 d = atan (d);
236 else 94 else
237 { 95 {
238 double d2 = extract_float (x); 96 double d2 = extract_float (x);
239 97 d = atan2 (d, d2);
240 IN_FLOAT2 (d = atan2 (d, d2), "atan", y, x);
241 } 98 }
242 return make_float (d); 99 return make_float (d);
243} 100}
244 101
245DEFUN ("cos", Fcos, Scos, 1, 1, 0, 102DEFUN ("cos", Fcos, Scos, 1, 1, 0,
246 doc: /* Return the cosine of ARG. */) 103 doc: /* Return the cosine of ARG. */)
247 (register Lisp_Object arg) 104 (Lisp_Object arg)
248{ 105{
249 double d = extract_float (arg); 106 double d = extract_float (arg);
250 IN_FLOAT (d = cos (d), "cos", arg); 107 d = cos (d);
251 return make_float (d); 108 return make_float (d);
252} 109}
253 110
254DEFUN ("sin", Fsin, Ssin, 1, 1, 0, 111DEFUN ("sin", Fsin, Ssin, 1, 1, 0,
255 doc: /* Return the sine of ARG. */) 112 doc: /* Return the sine of ARG. */)
256 (register Lisp_Object arg) 113 (Lisp_Object arg)
257{ 114{
258 double d = extract_float (arg); 115 double d = extract_float (arg);
259 IN_FLOAT (d = sin (d), "sin", arg); 116 d = sin (d);
260 return make_float (d); 117 return make_float (d);
261} 118}
262 119
263DEFUN ("tan", Ftan, Stan, 1, 1, 0, 120DEFUN ("tan", Ftan, Stan, 1, 1, 0,
264 doc: /* Return the tangent of ARG. */) 121 doc: /* Return the tangent of ARG. */)
265 (register Lisp_Object arg) 122 (Lisp_Object arg)
266{ 123{
267 double d = extract_float (arg); 124 double d = extract_float (arg);
268#ifdef FLOAT_CHECK_DOMAIN 125 d = tan (d);
269 double c = cos (d);
270 if (c == 0.0)
271 domain_error ("tan", arg);
272#endif
273 IN_FLOAT (d = tan (d), "tan", arg);
274 return make_float (d); 126 return make_float (d);
275} 127}
276 128
@@ -341,61 +193,61 @@ Returns the floating point value resulting from multiplying SGNFCAND
341 193
342DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0, 194DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0,
343 doc: /* Return the bessel function j0 of ARG. */) 195 doc: /* Return the bessel function j0 of ARG. */)
344 (register Lisp_Object arg) 196 (Lisp_Object arg)
345{ 197{
346 double d = extract_float (arg); 198 double d = extract_float (arg);
347 IN_FLOAT (d = j0 (d), "bessel-j0", arg); 199 d = j0 (d);
348 return make_float (d); 200 return make_float (d);
349} 201}
350 202
351DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0, 203DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0,
352 doc: /* Return the bessel function j1 of ARG. */) 204 doc: /* Return the bessel function j1 of ARG. */)
353 (register Lisp_Object arg) 205 (Lisp_Object arg)
354{ 206{
355 double d = extract_float (arg); 207 double d = extract_float (arg);
356 IN_FLOAT (d = j1 (d), "bessel-j1", arg); 208 d = j1 (d);
357 return make_float (d); 209 return make_float (d);
358} 210}
359 211
360DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0, 212DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0,
361 doc: /* Return the order N bessel function output jn of ARG. 213 doc: /* Return the order N bessel function output jn of ARG.
362The first arg (the order) is truncated to an integer. */) 214The first arg (the order) is truncated to an integer. */)
363 (register Lisp_Object n, Lisp_Object arg) 215 (Lisp_Object n, Lisp_Object arg)
364{ 216{
365 int i1 = extract_float (n); 217 int i1 = extract_float (n);
366 double f2 = extract_float (arg); 218 double f2 = extract_float (arg);
367 219
368 IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", n); 220 f2 = jn (i1, f2);
369 return make_float (f2); 221 return make_float (f2);
370} 222}
371 223
372DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0, 224DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0,
373 doc: /* Return the bessel function y0 of ARG. */) 225 doc: /* Return the bessel function y0 of ARG. */)
374 (register Lisp_Object arg) 226 (Lisp_Object arg)
375{ 227{
376 double d = extract_float (arg); 228 double d = extract_float (arg);
377 IN_FLOAT (d = y0 (d), "bessel-y0", arg); 229 d = y0 (d);
378 return make_float (d); 230 return make_float (d);
379} 231}
380 232
381DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0, 233DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0,
382 doc: /* Return the bessel function y1 of ARG. */) 234 doc: /* Return the bessel function y1 of ARG. */)
383 (register Lisp_Object arg) 235 (Lisp_Object arg)
384{ 236{
385 double d = extract_float (arg); 237 double d = extract_float (arg);
386 IN_FLOAT (d = y1 (d), "bessel-y0", arg); 238 d = y1 (d);
387 return make_float (d); 239 return make_float (d);
388} 240}
389 241
390DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0, 242DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0,
391 doc: /* Return the order N bessel function output yn of ARG. 243 doc: /* Return the order N bessel function output yn of ARG.
392The first arg (the order) is truncated to an integer. */) 244The first arg (the order) is truncated to an integer. */)
393 (register Lisp_Object n, Lisp_Object arg) 245 (Lisp_Object n, Lisp_Object arg)
394{ 246{
395 int i1 = extract_float (n); 247 int i1 = extract_float (n);
396 double f2 = extract_float (arg); 248 double f2 = extract_float (arg);
397 249
398 IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", n); 250 f2 = yn (i1, f2);
399 return make_float (f2); 251 return make_float (f2);
400} 252}
401 253
@@ -405,43 +257,43 @@ The first arg (the order) is truncated to an integer. */)
405 257
406DEFUN ("erf", Ferf, Serf, 1, 1, 0, 258DEFUN ("erf", Ferf, Serf, 1, 1, 0,
407 doc: /* Return the mathematical error function of ARG. */) 259 doc: /* Return the mathematical error function of ARG. */)
408 (register Lisp_Object arg) 260 (Lisp_Object arg)
409{ 261{
410 double d = extract_float (arg); 262 double d = extract_float (arg);
411 IN_FLOAT (d = erf (d), "erf", arg); 263 d = erf (d);
412 return make_float (d); 264 return make_float (d);
413} 265}
414 266
415DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0, 267DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0,
416 doc: /* Return the complementary error function of ARG. */) 268 doc: /* Return the complementary error function of ARG. */)
417 (register Lisp_Object arg) 269 (Lisp_Object arg)
418{ 270{
419 double d = extract_float (arg); 271 double d = extract_float (arg);
420 IN_FLOAT (d = erfc (d), "erfc", arg); 272 d = erfc (d);
421 return make_float (d); 273 return make_float (d);
422} 274}
423 275
424DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0, 276DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0,
425 doc: /* Return the log gamma of ARG. */) 277 doc: /* Return the log gamma of ARG. */)
426 (register Lisp_Object arg) 278 (Lisp_Object arg)
427{ 279{
428 double d = extract_float (arg); 280 double d = extract_float (arg);
429 IN_FLOAT (d = lgamma (d), "log-gamma", arg); 281 d = lgamma (d);
430 return make_float (d); 282 return make_float (d);
431} 283}
432 284
433DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0, 285DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0,
434 doc: /* Return the cube root of ARG. */) 286 doc: /* Return the cube root of ARG. */)
435 (register Lisp_Object arg) 287 (Lisp_Object arg)
436{ 288{
437 double d = extract_float (arg); 289 double d = extract_float (arg);
438#ifdef HAVE_CBRT 290#ifdef HAVE_CBRT
439 IN_FLOAT (d = cbrt (d), "cube-root", arg); 291 d = cbrt (d);
440#else 292#else
441 if (d >= 0.0) 293 if (d >= 0.0)
442 IN_FLOAT (d = pow (d, 1.0/3.0), "cube-root", arg); 294 d = pow (d, 1.0/3.0);
443 else 295 else
444 IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", arg); 296 d = -pow (-d, 1.0/3.0);
445#endif 297#endif
446 return make_float (d); 298 return make_float (d);
447} 299}
@@ -450,23 +302,16 @@ DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0,
450 302
451DEFUN ("exp", Fexp, Sexp, 1, 1, 0, 303DEFUN ("exp", Fexp, Sexp, 1, 1, 0,
452 doc: /* Return the exponential base e of ARG. */) 304 doc: /* Return the exponential base e of ARG. */)
453 (register Lisp_Object arg) 305 (Lisp_Object arg)
454{ 306{
455 double d = extract_float (arg); 307 double d = extract_float (arg);
456#ifdef FLOAT_CHECK_DOMAIN 308 d = exp (d);
457 if (d > 709.7827) /* Assume IEEE doubles here */
458 range_error ("exp", arg);
459 else if (d < -709.0)
460 return make_float (0.0);
461 else
462#endif
463 IN_FLOAT (d = exp (d), "exp", arg);
464 return make_float (d); 309 return make_float (d);
465} 310}
466 311
467DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, 312DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
468 doc: /* Return the exponential ARG1 ** ARG2. */) 313 doc: /* Return the exponential ARG1 ** ARG2. */)
469 (register Lisp_Object arg1, Lisp_Object arg2) 314 (Lisp_Object arg1, Lisp_Object arg2)
470{ 315{
471 double f1, f2, f3; 316 double f1, f2, f3;
472 317
@@ -495,72 +340,46 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
495 } 340 }
496 f1 = FLOATP (arg1) ? XFLOAT_DATA (arg1) : XINT (arg1); 341 f1 = FLOATP (arg1) ? XFLOAT_DATA (arg1) : XINT (arg1);
497 f2 = FLOATP (arg2) ? XFLOAT_DATA (arg2) : XINT (arg2); 342 f2 = FLOATP (arg2) ? XFLOAT_DATA (arg2) : XINT (arg2);
498 /* Really should check for overflow, too */ 343 f3 = pow (f1, f2);
499 if (f1 == 0.0 && f2 == 0.0)
500 f1 = 1.0;
501#ifdef FLOAT_CHECK_DOMAIN
502 else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor (f2)))
503 domain_error2 ("expt", arg1, arg2);
504#endif
505 IN_FLOAT2 (f3 = pow (f1, f2), "expt", arg1, arg2);
506 /* Check for overflow in the result. */
507 if (f1 != 0.0 && f3 == 0.0)
508 range_error ("expt", arg1);
509 return make_float (f3); 344 return make_float (f3);
510} 345}
511 346
512DEFUN ("log", Flog, Slog, 1, 2, 0, 347DEFUN ("log", Flog, Slog, 1, 2, 0,
513 doc: /* Return the natural logarithm of ARG. 348 doc: /* Return the natural logarithm of ARG.
514If the optional argument BASE is given, return log ARG using that base. */) 349If the optional argument BASE is given, return log ARG using that base. */)
515 (register Lisp_Object arg, Lisp_Object base) 350 (Lisp_Object arg, Lisp_Object base)
516{ 351{
517 double d = extract_float (arg); 352 double d = extract_float (arg);
518 353
519#ifdef FLOAT_CHECK_DOMAIN
520 if (d <= 0.0)
521 domain_error2 ("log", arg, base);
522#endif
523 if (NILP (base)) 354 if (NILP (base))
524 IN_FLOAT (d = log (d), "log", arg); 355 d = log (d);
525 else 356 else
526 { 357 {
527 double b = extract_float (base); 358 double b = extract_float (base);
528 359
529#ifdef FLOAT_CHECK_DOMAIN
530 if (b <= 0.0 || b == 1.0)
531 domain_error2 ("log", arg, base);
532#endif
533 if (b == 10.0) 360 if (b == 10.0)
534 IN_FLOAT2 (d = log10 (d), "log", arg, base); 361 d = log10 (d);
535 else 362 else
536 IN_FLOAT2 (d = log (d) / log (b), "log", arg, base); 363 d = log (d) / log (b);
537 } 364 }
538 return make_float (d); 365 return make_float (d);
539} 366}
540 367
541DEFUN ("log10", Flog10, Slog10, 1, 1, 0, 368DEFUN ("log10", Flog10, Slog10, 1, 1, 0,
542 doc: /* Return the logarithm base 10 of ARG. */) 369 doc: /* Return the logarithm base 10 of ARG. */)
543 (register Lisp_Object arg) 370 (Lisp_Object arg)
544{ 371{
545 double d = extract_float (arg); 372 double d = extract_float (arg);
546#ifdef FLOAT_CHECK_DOMAIN 373 d = log10 (d);
547 if (d <= 0.0)
548 domain_error ("log10", arg);
549#endif
550 IN_FLOAT (d = log10 (d), "log10", arg);
551 return make_float (d); 374 return make_float (d);
552} 375}
553 376
554DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, 377DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0,
555 doc: /* Return the square root of ARG. */) 378 doc: /* Return the square root of ARG. */)
556 (register Lisp_Object arg) 379 (Lisp_Object arg)
557{ 380{
558 double d = extract_float (arg); 381 double d = extract_float (arg);
559#ifdef FLOAT_CHECK_DOMAIN 382 d = sqrt (d);
560 if (d < 0.0)
561 domain_error ("sqrt", arg);
562#endif
563 IN_FLOAT (d = sqrt (d), "sqrt", arg);
564 return make_float (d); 383 return make_float (d);
565} 384}
566 385
@@ -568,83 +387,55 @@ DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0,
568 387
569DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0, 388DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0,
570 doc: /* Return the inverse hyperbolic cosine of ARG. */) 389 doc: /* Return the inverse hyperbolic cosine of ARG. */)
571 (register Lisp_Object arg) 390 (Lisp_Object arg)
572{ 391{
573 double d = extract_float (arg); 392 double d = extract_float (arg);
574#ifdef FLOAT_CHECK_DOMAIN 393 d = acosh (d);
575 if (d < 1.0)
576 domain_error ("acosh", arg);
577#endif
578#ifdef HAVE_INVERSE_HYPERBOLIC
579 IN_FLOAT (d = acosh (d), "acosh", arg);
580#else
581 IN_FLOAT (d = log (d + sqrt (d*d - 1.0)), "acosh", arg);
582#endif
583 return make_float (d); 394 return make_float (d);
584} 395}
585 396
586DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0, 397DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0,
587 doc: /* Return the inverse hyperbolic sine of ARG. */) 398 doc: /* Return the inverse hyperbolic sine of ARG. */)
588 (register Lisp_Object arg) 399 (Lisp_Object arg)
589{ 400{
590 double d = extract_float (arg); 401 double d = extract_float (arg);
591#ifdef HAVE_INVERSE_HYPERBOLIC 402 d = asinh (d);
592 IN_FLOAT (d = asinh (d), "asinh", arg);
593#else
594 IN_FLOAT (d = log (d + sqrt (d*d + 1.0)), "asinh", arg);
595#endif
596 return make_float (d); 403 return make_float (d);
597} 404}
598 405
599DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0, 406DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0,
600 doc: /* Return the inverse hyperbolic tangent of ARG. */) 407 doc: /* Return the inverse hyperbolic tangent of ARG. */)
601 (register Lisp_Object arg) 408 (Lisp_Object arg)
602{ 409{
603 double d = extract_float (arg); 410 double d = extract_float (arg);
604#ifdef FLOAT_CHECK_DOMAIN 411 d = atanh (d);
605 if (d >= 1.0 || d <= -1.0)
606 domain_error ("atanh", arg);
607#endif
608#ifdef HAVE_INVERSE_HYPERBOLIC
609 IN_FLOAT (d = atanh (d), "atanh", arg);
610#else
611 IN_FLOAT (d = 0.5 * log ((1.0 + d) / (1.0 - d)), "atanh", arg);
612#endif
613 return make_float (d); 412 return make_float (d);
614} 413}
615 414
616DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0, 415DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0,
617 doc: /* Return the hyperbolic cosine of ARG. */) 416 doc: /* Return the hyperbolic cosine of ARG. */)
618 (register Lisp_Object arg) 417 (Lisp_Object arg)
619{ 418{
620 double d = extract_float (arg); 419 double d = extract_float (arg);
621#ifdef FLOAT_CHECK_DOMAIN 420 d = cosh (d);
622 if (d > 710.0 || d < -710.0)
623 range_error ("cosh", arg);
624#endif
625 IN_FLOAT (d = cosh (d), "cosh", arg);
626 return make_float (d); 421 return make_float (d);
627} 422}
628 423
629DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0, 424DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0,
630 doc: /* Return the hyperbolic sine of ARG. */) 425 doc: /* Return the hyperbolic sine of ARG. */)
631 (register Lisp_Object arg) 426 (Lisp_Object arg)
632{ 427{
633 double d = extract_float (arg); 428 double d = extract_float (arg);
634#ifdef FLOAT_CHECK_DOMAIN 429 d = sinh (d);
635 if (d > 710.0 || d < -710.0)
636 range_error ("sinh", arg);
637#endif
638 IN_FLOAT (d = sinh (d), "sinh", arg);
639 return make_float (d); 430 return make_float (d);
640} 431}
641 432
642DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0, 433DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0,
643 doc: /* Return the hyperbolic tangent of ARG. */) 434 doc: /* Return the hyperbolic tangent of ARG. */)
644 (register Lisp_Object arg) 435 (Lisp_Object arg)
645{ 436{
646 double d = extract_float (arg); 437 double d = extract_float (arg);
647 IN_FLOAT (d = tanh (d), "tanh", arg); 438 d = tanh (d);
648 return make_float (d); 439 return make_float (d);
649} 440}
650#endif 441#endif
@@ -689,33 +480,11 @@ This is the same as the exponent of a float. */)
689 else 480 else
690 { 481 {
691#ifdef HAVE_LOGB 482#ifdef HAVE_LOGB
692 IN_FLOAT (value = logb (f), "logb", arg); 483 value = logb (f);
693#else 484#else
694#ifdef HAVE_FREXP
695 int ivalue; 485 int ivalue;
696 IN_FLOAT (frexp (f, &ivalue), "logb", arg); 486 frexp (f, &ivalue);
697 value = ivalue - 1; 487 value = ivalue - 1;
698#else
699 int i;
700 double d;
701 if (f < 0.0)
702 f = -f;
703 value = -1;
704 while (f < 0.5)
705 {
706 for (i = 1, d = 0.5; d * d >= f; i += i)
707 d *= d;
708 f /= d;
709 value -= i;
710 }
711 while (f >= 1.0)
712 {
713 for (i = 1, d = 2.0; d * d <= f; i += i)
714 d *= d;
715 f /= d;
716 value += i;
717 }
718#endif
719#endif 488#endif
720 } 489 }
721 XSETINT (val, value); 490 XSETINT (val, value);
@@ -748,8 +517,10 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor,
748 if (! IEEE_FLOATING_POINT && f2 == 0) 517 if (! IEEE_FLOATING_POINT && f2 == 0)
749 xsignal0 (Qarith_error); 518 xsignal0 (Qarith_error);
750 519
751 IN_FLOAT2 (f1 = (*double_round) (f1 / f2), name, arg, divisor); 520 f1 = (*double_round) (f1 / f2);
752 FLOAT_TO_INT2 (f1, arg, name, arg, divisor); 521 if (FIXNUM_OVERFLOW_P (f1))
522 xsignal3 (Qrange_error, build_string (name), arg, divisor);
523 arg = make_number (f1);
753 return arg; 524 return arg;
754 } 525 }
755 526
@@ -765,10 +536,10 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor,
765 536
766 if (FLOATP (arg)) 537 if (FLOATP (arg))
767 { 538 {
768 double d; 539 double d = (*double_round) (XFLOAT_DATA (arg));
769 540 if (FIXNUM_OVERFLOW_P (d))
770 IN_FLOAT (d = (*double_round) (XFLOAT_DATA (arg)), name, arg); 541 xsignal2 (Qrange_error, build_string (name), arg);
771 FLOAT_TO_INT (d, arg, name, arg); 542 arg = make_number (d);
772 } 543 }
773 544
774 return arg; 545 return arg;
@@ -885,97 +656,57 @@ fmod_float (Lisp_Object x, Lisp_Object y)
885 f1 = FLOATP (x) ? XFLOAT_DATA (x) : XINT (x); 656 f1 = FLOATP (x) ? XFLOAT_DATA (x) : XINT (x);
886 f2 = FLOATP (y) ? XFLOAT_DATA (y) : XINT (y); 657 f2 = FLOATP (y) ? XFLOAT_DATA (y) : XINT (y);
887 658
888 if (! IEEE_FLOATING_POINT && f2 == 0) 659 f1 = fmod (f1, f2);
889 xsignal0 (Qarith_error);
890 660
891 /* If the "remainder" comes out with the wrong sign, fix it. */ 661 /* If the "remainder" comes out with the wrong sign, fix it. */
892 IN_FLOAT2 ((f1 = fmod (f1, f2), 662 if (f2 < 0 ? 0 < f1 : f1 < 0)
893 f1 = (f2 < 0 ? f1 > 0 : f1 < 0) ? f1 + f2 : f1), 663 f1 += f2;
894 "mod", x, y); 664
895 return make_float (f1); 665 return make_float (f1);
896} 666}
897 667
898/* It's not clear these are worth adding. */
899
900DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0, 668DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0,
901 doc: /* Return the smallest integer no less than ARG, as a float. 669 doc: /* Return the smallest integer no less than ARG, as a float.
902\(Round toward +inf.\) */) 670\(Round toward +inf.\) */)
903 (register Lisp_Object arg) 671 (Lisp_Object arg)
904{ 672{
905 double d = extract_float (arg); 673 double d = extract_float (arg);
906 IN_FLOAT (d = ceil (d), "fceiling", arg); 674 d = ceil (d);
907 return make_float (d); 675 return make_float (d);
908} 676}
909 677
910DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0, 678DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0,
911 doc: /* Return the largest integer no greater than ARG, as a float. 679 doc: /* Return the largest integer no greater than ARG, as a float.
912\(Round towards -inf.\) */) 680\(Round towards -inf.\) */)
913 (register Lisp_Object arg) 681 (Lisp_Object arg)
914{ 682{
915 double d = extract_float (arg); 683 double d = extract_float (arg);
916 IN_FLOAT (d = floor (d), "ffloor", arg); 684 d = floor (d);
917 return make_float (d); 685 return make_float (d);
918} 686}
919 687
920DEFUN ("fround", Ffround, Sfround, 1, 1, 0, 688DEFUN ("fround", Ffround, Sfround, 1, 1, 0,
921 doc: /* Return the nearest integer to ARG, as a float. */) 689 doc: /* Return the nearest integer to ARG, as a float. */)
922 (register Lisp_Object arg) 690 (Lisp_Object arg)
923{ 691{
924 double d = extract_float (arg); 692 double d = extract_float (arg);
925 IN_FLOAT (d = emacs_rint (d), "fround", arg); 693 d = emacs_rint (d);
926 return make_float (d); 694 return make_float (d);
927} 695}
928 696
929DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0, 697DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0,
930 doc: /* Truncate a floating point number to an integral float value. 698 doc: /* Truncate a floating point number to an integral float value.
931Rounds the value toward zero. */) 699Rounds the value toward zero. */)
932 (register Lisp_Object arg) 700 (Lisp_Object arg)
933{ 701{
934 double d = extract_float (arg); 702 double d = extract_float (arg);
935 if (d >= 0.0) 703 if (d >= 0.0)
936 IN_FLOAT (d = floor (d), "ftruncate", arg); 704 d = floor (d);
937 else 705 else
938 IN_FLOAT (d = ceil (d), "ftruncate", arg); 706 d = ceil (d);
939 return make_float (d); 707 return make_float (d);
940} 708}
941 709
942#ifdef HAVE_MATHERR
943int
944matherr (struct exception *x)
945{
946 Lisp_Object args;
947 const char *name = x->name;
948
949 if (! in_float)
950 /* Not called from emacs-lisp float routines; do the default thing. */
951 return 0;
952 if (!strcmp (x->name, "pow"))
953 name = "expt";
954
955 args
956 = Fcons (build_string (name),
957 Fcons (make_float (x->arg1),
958 ((!strcmp (name, "log") || !strcmp (name, "pow"))
959 ? Fcons (make_float (x->arg2), Qnil)
960 : Qnil)));
961 switch (x->type)
962 {
963 case DOMAIN: xsignal (Qdomain_error, args); break;
964 case SING: xsignal (Qsingularity_error, args); break;
965 case OVERFLOW: xsignal (Qoverflow_error, args); break;
966 case UNDERFLOW: xsignal (Qunderflow_error, args); break;
967 default: xsignal (Qarith_error, args); break;
968 }
969 return (1); /* don't set errno or print a message */
970}
971#endif /* HAVE_MATHERR */
972
973void
974init_floatfns (void)
975{
976 in_float = 0;
977}
978
979void 710void
980syms_of_floatfns (void) 711syms_of_floatfns (void)
981{ 712{
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 <http://www.gnu.org/licenses/>. */
19 19
20#include <config.h> 20#include <config.h>
21#include <stdio.h> 21#include <stdio.h>
22#include <math.h>
23#include <unistd.h> 22#include <unistd.h>
24 23
25#ifdef HAVE_PNG 24#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);
2687 2687
2688/* Defined in floatfns.c */ 2688/* Defined in floatfns.c */
2689extern double extract_float (Lisp_Object); 2689extern double extract_float (Lisp_Object);
2690extern void init_floatfns (void);
2691extern void syms_of_floatfns (void); 2690extern void syms_of_floatfns (void);
2692extern Lisp_Object fmod_float (Lisp_Object x, Lisp_Object y); 2691extern Lisp_Object fmod_float (Lisp_Object x, Lisp_Object y);
2693 2692
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 <http://www.gnu.org/licenses/>. */
50#endif 50#endif
51 51
52#include <unistd.h> 52#include <unistd.h>
53#include <math.h>
54 53
55#ifdef HAVE_SETLOCALE 54#ifdef HAVE_SETLOCALE
56#include <locale.h> 55#include <locale.h>
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;
45 45
46static Lisp_Object Qfloat_output_format; 46static Lisp_Object Qfloat_output_format;
47 47
48#include <math.h>
49#include <float.h> 48#include <float.h>
50#include <ftoastr.h> 49#include <ftoastr.h>
51 50
52/* Default to values appropriate for IEEE floating point. */
53#ifndef DBL_DIG
54#define DBL_DIG 15
55#endif
56
57/* Avoid actual stack overflow in print. */ 51/* Avoid actual stack overflow in print. */
58static ptrdiff_t print_depth; 52static ptrdiff_t print_depth;
59 53