diff options
| author | Paul Eggert | 2012-09-09 09:06:33 -0700 |
|---|---|---|
| committer | Paul Eggert | 2012-09-09 09:06:33 -0700 |
| commit | f6196b87e1ceee0d56f2fe6f3aa2b9d1d82c44b0 (patch) | |
| tree | 3400f2f4898ce1fc39ad437faa5e55714129d30b /src/floatfns.c | |
| parent | 8ed43f154827121c624a5a93808340618bd8f03f (diff) | |
| download | emacs-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.
Diffstat (limited to 'src/floatfns.c')
| -rw-r--r-- | src/floatfns.c | 435 |
1 files changed, 83 insertions, 352 deletions
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 | |||
| 22 | along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | 22 | along 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/>. */ | |||
| 67 | extern double logb (double); | 47 | extern 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 | |||
| 101 | static 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 | |||
| 108 | static Lisp_Object float_error_arg, float_error_arg2; | ||
| 109 | |||
| 110 | static 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 | ||
| 186 | double | 52 | double |
| @@ -197,27 +63,19 @@ extract_float (Lisp_Object num) | |||
| 197 | 63 | ||
| 198 | DEFUN ("acos", Facos, Sacos, 1, 1, 0, | 64 | DEFUN ("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 | ||
| 211 | DEFUN ("asin", Fasin, Sasin, 1, 1, 0, | 73 | DEFUN ("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. | |||
| 227 | If two arguments Y and X are given, return the inverse tangent of Y | 85 | If two arguments Y and X are given, return the inverse tangent of Y |
| 228 | divided by X, i.e. the angle in radians between the vector (X, Y) | 86 | divided by X, i.e. the angle in radians between the vector (X, Y) |
| 229 | and the x-axis. */) | 87 | and 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 | ||
| 245 | DEFUN ("cos", Fcos, Scos, 1, 1, 0, | 102 | DEFUN ("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 | ||
| 254 | DEFUN ("sin", Fsin, Ssin, 1, 1, 0, | 111 | DEFUN ("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 | ||
| 263 | DEFUN ("tan", Ftan, Stan, 1, 1, 0, | 120 | DEFUN ("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 | ||
| 342 | DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0, | 194 | DEFUN ("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 | ||
| 351 | DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0, | 203 | DEFUN ("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 | ||
| 360 | DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0, | 212 | DEFUN ("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. |
| 362 | The first arg (the order) is truncated to an integer. */) | 214 | The 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 | ||
| 372 | DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0, | 224 | DEFUN ("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 | ||
| 381 | DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0, | 233 | DEFUN ("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 | ||
| 390 | DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0, | 242 | DEFUN ("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. |
| 392 | The first arg (the order) is truncated to an integer. */) | 244 | The 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 | ||
| 406 | DEFUN ("erf", Ferf, Serf, 1, 1, 0, | 258 | DEFUN ("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 | ||
| 415 | DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0, | 267 | DEFUN ("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 | ||
| 424 | DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0, | 276 | DEFUN ("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 | ||
| 433 | DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0, | 285 | DEFUN ("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 | ||
| 451 | DEFUN ("exp", Fexp, Sexp, 1, 1, 0, | 303 | DEFUN ("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 | ||
| 467 | DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, | 312 | DEFUN ("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 | ||
| 512 | DEFUN ("log", Flog, Slog, 1, 2, 0, | 347 | DEFUN ("log", Flog, Slog, 1, 2, 0, |
| 513 | doc: /* Return the natural logarithm of ARG. | 348 | doc: /* Return the natural logarithm of ARG. |
| 514 | If the optional argument BASE is given, return log ARG using that base. */) | 349 | If 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 | ||
| 541 | DEFUN ("log10", Flog10, Slog10, 1, 1, 0, | 368 | DEFUN ("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 | ||
| 554 | DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, | 377 | DEFUN ("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 | ||
| 569 | DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0, | 388 | DEFUN ("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 | ||
| 586 | DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0, | 397 | DEFUN ("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 | ||
| 599 | DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0, | 406 | DEFUN ("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 | ||
| 616 | DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0, | 415 | DEFUN ("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 | ||
| 629 | DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0, | 424 | DEFUN ("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 | ||
| 642 | DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0, | 433 | DEFUN ("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 | |||
| 900 | DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0, | 668 | DEFUN ("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 | ||
| 910 | DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0, | 678 | DEFUN ("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 | ||
| 920 | DEFUN ("fround", Ffround, Sfround, 1, 1, 0, | 688 | DEFUN ("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 | ||
| 929 | DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0, | 697 | DEFUN ("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. |
| 931 | Rounds the value toward zero. */) | 699 | Rounds 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 | ||
| 943 | int | ||
| 944 | matherr (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 | |||
| 973 | void | ||
| 974 | init_floatfns (void) | ||
| 975 | { | ||
| 976 | in_float = 0; | ||
| 977 | } | ||
| 978 | |||
| 979 | void | 710 | void |
| 980 | syms_of_floatfns (void) | 711 | syms_of_floatfns (void) |
| 981 | { | 712 | { |