diff options
| author | Daniel Colascione | 2012-09-17 04:07:36 -0800 |
|---|---|---|
| committer | Daniel Colascione | 2012-09-17 04:07:36 -0800 |
| commit | 2ab329f3b5d52a39f0a45c3d9c129f1c19560142 (patch) | |
| tree | 6dd6784d63e54cb18071df8e28fbdbc27d418728 /src/floatfns.c | |
| parent | f701ab72dd55460d23c8b029550aa4d7ecef3cfa (diff) | |
| parent | bb7dce392f6d9d5fc4b9d7de09ff920a52f07669 (diff) | |
| download | emacs-2ab329f3b5d52a39f0a45c3d9c129f1c19560142.tar.gz emacs-2ab329f3b5d52a39f0a45c3d9c129f1c19560142.zip | |
Merge from trunk
Diffstat (limited to 'src/floatfns.c')
| -rw-r--r-- | src/floatfns.c | 628 |
1 files changed, 65 insertions, 563 deletions
diff --git a/src/floatfns.c b/src/floatfns.c index cad071f1e15..4fe209fcb61 100644 --- a/src/floatfns.c +++ b/src/floatfns.c | |||
| @@ -22,171 +22,32 @@ 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 the following math.h functions, and Emacs omits |
| 26 | acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod, | 26 | the starred functions since we haven't found a use for them: |
| 27 | frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh. | 27 | acos, asin, atan, atan2, ceil, cos, *cosh, exp, fabs, floor, fmod, |
| 28 | 28 | frexp, ldexp, log, log10, *modf, pow, sin, *sinh, sqrt, tan, *tanh. | |
| 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_CATCH_SIGILL if the float library routines signal SIGILL. | ||
| 41 | (What systems actually do this? Please let us know.) | ||
| 42 | |||
| 43 | Define FLOAT_CHECK_DOMAIN if the float library doesn't handle errors by | ||
| 44 | either setting errno, or signaling SIGFPE/SIGILL. Otherwise, domain and | ||
| 45 | range checking will happen before calling the float routines. This has | ||
| 46 | no effect if HAVE_MATHERR is defined (since matherr will be called when | ||
| 47 | a domain error occurs.) | ||
| 48 | */ | 29 | */ |
| 49 | 30 | ||
| 50 | #include <config.h> | 31 | #include <config.h> |
| 51 | #include <signal.h> | 32 | |
| 52 | #include <setjmp.h> | ||
| 53 | #include "lisp.h" | 33 | #include "lisp.h" |
| 54 | #include "syssignal.h" | 34 | #include "syssignal.h" |
| 55 | 35 | ||
| 56 | #include <float.h> | 36 | #include <float.h> |
| 57 | /* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */ | ||
| 58 | #ifndef IEEE_FLOATING_POINT | ||
| 59 | #if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ | 37 | #if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ |
| 60 | && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) | 38 | && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) |
| 61 | #define IEEE_FLOATING_POINT 1 | 39 | #define IEEE_FLOATING_POINT 1 |
| 62 | #else | 40 | #else |
| 63 | #define IEEE_FLOATING_POINT 0 | 41 | #define IEEE_FLOATING_POINT 0 |
| 64 | #endif | 42 | #endif |
| 65 | #endif | ||
| 66 | 43 | ||
| 67 | #include <math.h> | 44 | #include <math.h> |
| 68 | 45 | ||
| 69 | /* This declaration is omitted on some systems, like Ultrix. */ | 46 | #ifndef isfinite |
| 70 | #if !defined (HPUX) && defined (HAVE_LOGB) && !defined (logb) | 47 | # define isfinite(x) ((x) - (x) == 0) |
| 71 | extern double logb (double); | ||
| 72 | #endif /* not HPUX and HAVE_LOGB and no logb macro */ | ||
| 73 | |||
| 74 | #if defined (DOMAIN) && defined (SING) && defined (OVERFLOW) | ||
| 75 | /* If those are defined, then this is probably a `matherr' machine. */ | ||
| 76 | # ifndef HAVE_MATHERR | ||
| 77 | # define HAVE_MATHERR | ||
| 78 | # endif | ||
| 79 | #endif | ||
| 80 | |||
| 81 | #ifdef NO_MATHERR | ||
| 82 | #undef HAVE_MATHERR | ||
| 83 | #endif | 48 | #endif |
| 84 | 49 | #ifndef isnan | |
| 85 | #ifdef HAVE_MATHERR | 50 | # define isnan(x) ((x) != (x)) |
| 86 | # ifdef FLOAT_CHECK_ERRNO | ||
| 87 | # undef FLOAT_CHECK_ERRNO | ||
| 88 | # endif | ||
| 89 | # ifdef FLOAT_CHECK_DOMAIN | ||
| 90 | # undef FLOAT_CHECK_DOMAIN | ||
| 91 | # endif | ||
| 92 | #endif | ||
| 93 | |||
| 94 | #ifndef NO_FLOAT_CHECK_ERRNO | ||
| 95 | #define FLOAT_CHECK_ERRNO | ||
| 96 | #endif | ||
| 97 | |||
| 98 | #ifdef FLOAT_CHECK_ERRNO | ||
| 99 | # include <errno.h> | ||
| 100 | #endif | ||
| 101 | |||
| 102 | #ifdef FLOAT_CATCH_SIGILL | ||
| 103 | static void float_error (); | ||
| 104 | #endif | ||
| 105 | |||
| 106 | /* Nonzero while executing in floating point. | ||
| 107 | This tells float_error what to do. */ | ||
| 108 | |||
| 109 | static int in_float; | ||
| 110 | |||
| 111 | /* If an argument is out of range for a mathematical function, | ||
| 112 | here is the actual argument value to use in the error message. | ||
| 113 | These variables are used only across the floating point library call | ||
| 114 | so there is no need to staticpro them. */ | ||
| 115 | |||
| 116 | static Lisp_Object float_error_arg, float_error_arg2; | ||
| 117 | |||
| 118 | static const char *float_error_fn_name; | ||
| 119 | |||
| 120 | /* Evaluate the floating point expression D, recording NUM | ||
| 121 | as the original argument for error messages. | ||
| 122 | D is normally an assignment expression. | ||
| 123 | Handle errors which may result in signals or may set errno. | ||
| 124 | |||
| 125 | Note that float_error may be declared to return void, so you can't | ||
| 126 | just cast the zero after the colon to (void) to make the types | ||
| 127 | check properly. */ | ||
| 128 | |||
| 129 | #ifdef FLOAT_CHECK_ERRNO | ||
| 130 | #define IN_FLOAT(d, name, num) \ | ||
| 131 | do { \ | ||
| 132 | float_error_arg = num; \ | ||
| 133 | float_error_fn_name = name; \ | ||
| 134 | in_float = 1; errno = 0; (d); in_float = 0; \ | ||
| 135 | switch (errno) { \ | ||
| 136 | case 0: break; \ | ||
| 137 | case EDOM: domain_error (float_error_fn_name, float_error_arg); \ | ||
| 138 | case ERANGE: range_error (float_error_fn_name, float_error_arg); \ | ||
| 139 | default: arith_error (float_error_fn_name, float_error_arg); \ | ||
| 140 | } \ | ||
| 141 | } while (0) | ||
| 142 | #define IN_FLOAT2(d, name, num, num2) \ | ||
| 143 | do { \ | ||
| 144 | float_error_arg = num; \ | ||
| 145 | float_error_arg2 = num2; \ | ||
| 146 | float_error_fn_name = name; \ | ||
| 147 | in_float = 1; errno = 0; (d); in_float = 0; \ | ||
| 148 | switch (errno) { \ | ||
| 149 | case 0: break; \ | ||
| 150 | case EDOM: domain_error (float_error_fn_name, float_error_arg); \ | ||
| 151 | case ERANGE: range_error (float_error_fn_name, float_error_arg); \ | ||
| 152 | default: arith_error (float_error_fn_name, float_error_arg); \ | ||
| 153 | } \ | ||
| 154 | } while (0) | ||
| 155 | #else | ||
| 156 | #define IN_FLOAT(d, name, num) (in_float = 1, (d), in_float = 0) | ||
| 157 | #define IN_FLOAT2(d, name, num, num2) (in_float = 1, (d), in_float = 0) | ||
| 158 | #endif | ||
| 159 | |||
| 160 | /* Convert float to Lisp_Int if it fits, else signal a range error | ||
| 161 | using the given arguments. */ | ||
| 162 | #define FLOAT_TO_INT(x, i, name, num) \ | ||
| 163 | do \ | ||
| 164 | { \ | ||
| 165 | if (FIXNUM_OVERFLOW_P (x)) \ | ||
| 166 | range_error (name, num); \ | ||
| 167 | XSETINT (i, (EMACS_INT)(x)); \ | ||
| 168 | } \ | ||
| 169 | while (0) | ||
| 170 | #define FLOAT_TO_INT2(x, i, name, num1, num2) \ | ||
| 171 | do \ | ||
| 172 | { \ | ||
| 173 | if (FIXNUM_OVERFLOW_P (x)) \ | ||
| 174 | range_error2 (name, num1, num2); \ | ||
| 175 | XSETINT (i, (EMACS_INT)(x)); \ | ||
| 176 | } \ | ||
| 177 | while (0) | ||
| 178 | |||
| 179 | #define arith_error(op,arg) \ | ||
| 180 | xsignal2 (Qarith_error, build_string ((op)), (arg)) | ||
| 181 | #define range_error(op,arg) \ | ||
| 182 | xsignal2 (Qrange_error, build_string ((op)), (arg)) | ||
| 183 | #define range_error2(op,a1,a2) \ | ||
| 184 | xsignal3 (Qrange_error, build_string ((op)), (a1), (a2)) | ||
| 185 | #define domain_error(op,arg) \ | ||
| 186 | xsignal2 (Qdomain_error, build_string ((op)), (arg)) | ||
| 187 | #ifdef FLOAT_CHECK_DOMAIN | ||
| 188 | #define domain_error2(op,a1,a2) \ | ||
| 189 | xsignal3 (Qdomain_error, build_string ((op)), (a1), (a2)) | ||
| 190 | #endif | 51 | #endif |
| 191 | 52 | ||
| 192 | /* Extract a Lisp number as a `double', or signal an error. */ | 53 | /* Extract a Lisp number as a `double', or signal an error. */ |
| @@ -205,27 +66,19 @@ extract_float (Lisp_Object num) | |||
| 205 | 66 | ||
| 206 | DEFUN ("acos", Facos, Sacos, 1, 1, 0, | 67 | DEFUN ("acos", Facos, Sacos, 1, 1, 0, |
| 207 | doc: /* Return the inverse cosine of ARG. */) | 68 | doc: /* Return the inverse cosine of ARG. */) |
| 208 | (register Lisp_Object arg) | 69 | (Lisp_Object arg) |
| 209 | { | 70 | { |
| 210 | double d = extract_float (arg); | 71 | double d = extract_float (arg); |
| 211 | #ifdef FLOAT_CHECK_DOMAIN | 72 | d = acos (d); |
| 212 | if (d > 1.0 || d < -1.0) | ||
| 213 | domain_error ("acos", arg); | ||
| 214 | #endif | ||
| 215 | IN_FLOAT (d = acos (d), "acos", arg); | ||
| 216 | return make_float (d); | 73 | return make_float (d); |
| 217 | } | 74 | } |
| 218 | 75 | ||
| 219 | DEFUN ("asin", Fasin, Sasin, 1, 1, 0, | 76 | DEFUN ("asin", Fasin, Sasin, 1, 1, 0, |
| 220 | doc: /* Return the inverse sine of ARG. */) | 77 | doc: /* Return the inverse sine of ARG. */) |
| 221 | (register Lisp_Object arg) | 78 | (Lisp_Object arg) |
| 222 | { | 79 | { |
| 223 | double d = extract_float (arg); | 80 | double d = extract_float (arg); |
| 224 | #ifdef FLOAT_CHECK_DOMAIN | 81 | d = asin (d); |
| 225 | if (d > 1.0 || d < -1.0) | ||
| 226 | domain_error ("asin", arg); | ||
| 227 | #endif | ||
| 228 | IN_FLOAT (d = asin (d), "asin", arg); | ||
| 229 | return make_float (d); | 82 | return make_float (d); |
| 230 | } | 83 | } |
| 231 | 84 | ||
| @@ -235,56 +88,47 @@ If only one argument Y is given, return the inverse tangent of Y. | |||
| 235 | If two arguments Y and X are given, return the inverse tangent of Y | 88 | If two arguments Y and X are given, return the inverse tangent of Y |
| 236 | divided by X, i.e. the angle in radians between the vector (X, Y) | 89 | divided by X, i.e. the angle in radians between the vector (X, Y) |
| 237 | and the x-axis. */) | 90 | and the x-axis. */) |
| 238 | (register Lisp_Object y, Lisp_Object x) | 91 | (Lisp_Object y, Lisp_Object x) |
| 239 | { | 92 | { |
| 240 | double d = extract_float (y); | 93 | double d = extract_float (y); |
| 241 | 94 | ||
| 242 | if (NILP (x)) | 95 | if (NILP (x)) |
| 243 | IN_FLOAT (d = atan (d), "atan", y); | 96 | d = atan (d); |
| 244 | else | 97 | else |
| 245 | { | 98 | { |
| 246 | double d2 = extract_float (x); | 99 | double d2 = extract_float (x); |
| 247 | 100 | d = atan2 (d, d2); | |
| 248 | IN_FLOAT2 (d = atan2 (d, d2), "atan", y, x); | ||
| 249 | } | 101 | } |
| 250 | return make_float (d); | 102 | return make_float (d); |
| 251 | } | 103 | } |
| 252 | 104 | ||
| 253 | DEFUN ("cos", Fcos, Scos, 1, 1, 0, | 105 | DEFUN ("cos", Fcos, Scos, 1, 1, 0, |
| 254 | doc: /* Return the cosine of ARG. */) | 106 | doc: /* Return the cosine of ARG. */) |
| 255 | (register Lisp_Object arg) | 107 | (Lisp_Object arg) |
| 256 | { | 108 | { |
| 257 | double d = extract_float (arg); | 109 | double d = extract_float (arg); |
| 258 | IN_FLOAT (d = cos (d), "cos", arg); | 110 | d = cos (d); |
| 259 | return make_float (d); | 111 | return make_float (d); |
| 260 | } | 112 | } |
| 261 | 113 | ||
| 262 | DEFUN ("sin", Fsin, Ssin, 1, 1, 0, | 114 | DEFUN ("sin", Fsin, Ssin, 1, 1, 0, |
| 263 | doc: /* Return the sine of ARG. */) | 115 | doc: /* Return the sine of ARG. */) |
| 264 | (register Lisp_Object arg) | 116 | (Lisp_Object arg) |
| 265 | { | 117 | { |
| 266 | double d = extract_float (arg); | 118 | double d = extract_float (arg); |
| 267 | IN_FLOAT (d = sin (d), "sin", arg); | 119 | d = sin (d); |
| 268 | return make_float (d); | 120 | return make_float (d); |
| 269 | } | 121 | } |
| 270 | 122 | ||
| 271 | DEFUN ("tan", Ftan, Stan, 1, 1, 0, | 123 | DEFUN ("tan", Ftan, Stan, 1, 1, 0, |
| 272 | doc: /* Return the tangent of ARG. */) | 124 | doc: /* Return the tangent of ARG. */) |
| 273 | (register Lisp_Object arg) | 125 | (Lisp_Object arg) |
| 274 | { | 126 | { |
| 275 | double d = extract_float (arg); | 127 | double d = extract_float (arg); |
| 276 | double c = cos (d); | 128 | d = tan (d); |
| 277 | #ifdef FLOAT_CHECK_DOMAIN | ||
| 278 | if (c == 0.0) | ||
| 279 | domain_error ("tan", arg); | ||
| 280 | #endif | ||
| 281 | IN_FLOAT (d = sin (d) / c, "tan", arg); | ||
| 282 | return make_float (d); | 129 | return make_float (d); |
| 283 | } | 130 | } |
| 284 | 131 | ||
| 285 | #undef isnan | ||
| 286 | #define isnan(x) ((x) != (x)) | ||
| 287 | |||
| 288 | DEFUN ("isnan", Fisnan, Sisnan, 1, 1, 0, | 132 | DEFUN ("isnan", Fisnan, Sisnan, 1, 1, 0, |
| 289 | doc: /* Return non nil iff argument X is a NaN. */) | 133 | doc: /* Return non nil iff argument X is a NaN. */) |
| 290 | (Lisp_Object x) | 134 | (Lisp_Object x) |
| @@ -309,6 +153,7 @@ Cause an error if X1 or X2 is not a float. */) | |||
| 309 | 153 | ||
| 310 | return make_float (copysign (f1, f2)); | 154 | return make_float (copysign (f1, f2)); |
| 311 | } | 155 | } |
| 156 | #endif | ||
| 312 | 157 | ||
| 313 | DEFUN ("frexp", Ffrexp, Sfrexp, 1, 1, 0, | 158 | DEFUN ("frexp", Ffrexp, Sfrexp, 1, 1, 0, |
| 314 | doc: /* Get significand and exponent of a floating point number. | 159 | doc: /* Get significand and exponent of a floating point number. |
| @@ -323,15 +168,9 @@ If X is zero, both parts (SGNFCAND and EXP) are zero. */) | |||
| 323 | (Lisp_Object x) | 168 | (Lisp_Object x) |
| 324 | { | 169 | { |
| 325 | double f = XFLOATINT (x); | 170 | double f = XFLOATINT (x); |
| 326 | 171 | int exponent; | |
| 327 | if (f == 0.0) | 172 | double sgnfcand = frexp (f, &exponent); |
| 328 | return Fcons (make_float (0.0), make_number (0)); | 173 | return Fcons (make_float (sgnfcand), make_number (exponent)); |
| 329 | else | ||
| 330 | { | ||
| 331 | int exponent; | ||
| 332 | double sgnfcand = frexp (f, &exponent); | ||
| 333 | return Fcons (make_float (sgnfcand), make_number (exponent)); | ||
| 334 | } | ||
| 335 | } | 174 | } |
| 336 | 175 | ||
| 337 | DEFUN ("ldexp", Fldexp, Sldexp, 1, 2, 0, | 176 | DEFUN ("ldexp", Fldexp, Sldexp, 1, 2, 0, |
| @@ -343,138 +182,19 @@ Returns the floating point value resulting from multiplying SGNFCAND | |||
| 343 | CHECK_NUMBER (exponent); | 182 | CHECK_NUMBER (exponent); |
| 344 | return make_float (ldexp (XFLOATINT (sgnfcand), XINT (exponent))); | 183 | return make_float (ldexp (XFLOATINT (sgnfcand), XINT (exponent))); |
| 345 | } | 184 | } |
| 346 | #endif | ||
| 347 | |||
| 348 | #if 0 /* Leave these out unless we find there's a reason for them. */ | ||
| 349 | |||
| 350 | DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0, | ||
| 351 | doc: /* Return the bessel function j0 of ARG. */) | ||
| 352 | (register Lisp_Object arg) | ||
| 353 | { | ||
| 354 | double d = extract_float (arg); | ||
| 355 | IN_FLOAT (d = j0 (d), "bessel-j0", arg); | ||
| 356 | return make_float (d); | ||
| 357 | } | ||
| 358 | |||
| 359 | DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0, | ||
| 360 | doc: /* Return the bessel function j1 of ARG. */) | ||
| 361 | (register Lisp_Object arg) | ||
| 362 | { | ||
| 363 | double d = extract_float (arg); | ||
| 364 | IN_FLOAT (d = j1 (d), "bessel-j1", arg); | ||
| 365 | return make_float (d); | ||
| 366 | } | ||
| 367 | |||
| 368 | DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0, | ||
| 369 | doc: /* Return the order N bessel function output jn of ARG. | ||
| 370 | The first arg (the order) is truncated to an integer. */) | ||
| 371 | (register Lisp_Object n, Lisp_Object arg) | ||
| 372 | { | ||
| 373 | int i1 = extract_float (n); | ||
| 374 | double f2 = extract_float (arg); | ||
| 375 | |||
| 376 | IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", n); | ||
| 377 | return make_float (f2); | ||
| 378 | } | ||
| 379 | |||
| 380 | DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0, | ||
| 381 | doc: /* Return the bessel function y0 of ARG. */) | ||
| 382 | (register Lisp_Object arg) | ||
| 383 | { | ||
| 384 | double d = extract_float (arg); | ||
| 385 | IN_FLOAT (d = y0 (d), "bessel-y0", arg); | ||
| 386 | return make_float (d); | ||
| 387 | } | ||
| 388 | |||
| 389 | DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0, | ||
| 390 | doc: /* Return the bessel function y1 of ARG. */) | ||
| 391 | (register Lisp_Object arg) | ||
| 392 | { | ||
| 393 | double d = extract_float (arg); | ||
| 394 | IN_FLOAT (d = y1 (d), "bessel-y0", arg); | ||
| 395 | return make_float (d); | ||
| 396 | } | ||
| 397 | |||
| 398 | DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0, | ||
| 399 | doc: /* Return the order N bessel function output yn of ARG. | ||
| 400 | The first arg (the order) is truncated to an integer. */) | ||
| 401 | (register Lisp_Object n, Lisp_Object arg) | ||
| 402 | { | ||
| 403 | int i1 = extract_float (n); | ||
| 404 | double f2 = extract_float (arg); | ||
| 405 | |||
| 406 | IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", n); | ||
| 407 | return make_float (f2); | ||
| 408 | } | ||
| 409 | |||
| 410 | #endif | ||
| 411 | |||
| 412 | #if 0 /* Leave these out unless we see they are worth having. */ | ||
| 413 | |||
| 414 | DEFUN ("erf", Ferf, Serf, 1, 1, 0, | ||
| 415 | doc: /* Return the mathematical error function of ARG. */) | ||
| 416 | (register Lisp_Object arg) | ||
| 417 | { | ||
| 418 | double d = extract_float (arg); | ||
| 419 | IN_FLOAT (d = erf (d), "erf", arg); | ||
| 420 | return make_float (d); | ||
| 421 | } | ||
| 422 | |||
| 423 | DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0, | ||
| 424 | doc: /* Return the complementary error function of ARG. */) | ||
| 425 | (register Lisp_Object arg) | ||
| 426 | { | ||
| 427 | double d = extract_float (arg); | ||
| 428 | IN_FLOAT (d = erfc (d), "erfc", arg); | ||
| 429 | return make_float (d); | ||
| 430 | } | ||
| 431 | |||
| 432 | DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0, | ||
| 433 | doc: /* Return the log gamma of ARG. */) | ||
| 434 | (register Lisp_Object arg) | ||
| 435 | { | ||
| 436 | double d = extract_float (arg); | ||
| 437 | IN_FLOAT (d = lgamma (d), "log-gamma", arg); | ||
| 438 | return make_float (d); | ||
| 439 | } | ||
| 440 | |||
| 441 | DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0, | ||
| 442 | doc: /* Return the cube root of ARG. */) | ||
| 443 | (register Lisp_Object arg) | ||
| 444 | { | ||
| 445 | double d = extract_float (arg); | ||
| 446 | #ifdef HAVE_CBRT | ||
| 447 | IN_FLOAT (d = cbrt (d), "cube-root", arg); | ||
| 448 | #else | ||
| 449 | if (d >= 0.0) | ||
| 450 | IN_FLOAT (d = pow (d, 1.0/3.0), "cube-root", arg); | ||
| 451 | else | ||
| 452 | IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", arg); | ||
| 453 | #endif | ||
| 454 | return make_float (d); | ||
| 455 | } | ||
| 456 | |||
| 457 | #endif | ||
| 458 | 185 | ||
| 459 | DEFUN ("exp", Fexp, Sexp, 1, 1, 0, | 186 | DEFUN ("exp", Fexp, Sexp, 1, 1, 0, |
| 460 | doc: /* Return the exponential base e of ARG. */) | 187 | doc: /* Return the exponential base e of ARG. */) |
| 461 | (register Lisp_Object arg) | 188 | (Lisp_Object arg) |
| 462 | { | 189 | { |
| 463 | double d = extract_float (arg); | 190 | double d = extract_float (arg); |
| 464 | #ifdef FLOAT_CHECK_DOMAIN | 191 | d = exp (d); |
| 465 | if (d > 709.7827) /* Assume IEEE doubles here */ | ||
| 466 | range_error ("exp", arg); | ||
| 467 | else if (d < -709.0) | ||
| 468 | return make_float (0.0); | ||
| 469 | else | ||
| 470 | #endif | ||
| 471 | IN_FLOAT (d = exp (d), "exp", arg); | ||
| 472 | return make_float (d); | 192 | return make_float (d); |
| 473 | } | 193 | } |
| 474 | 194 | ||
| 475 | DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, | 195 | DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, |
| 476 | doc: /* Return the exponential ARG1 ** ARG2. */) | 196 | doc: /* Return the exponential ARG1 ** ARG2. */) |
| 477 | (register Lisp_Object arg1, Lisp_Object arg2) | 197 | (Lisp_Object arg1, Lisp_Object arg2) |
| 478 | { | 198 | { |
| 479 | double f1, f2, f3; | 199 | double f1, f2, f3; |
| 480 | 200 | ||
| @@ -503,159 +223,48 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, | |||
| 503 | } | 223 | } |
| 504 | f1 = FLOATP (arg1) ? XFLOAT_DATA (arg1) : XINT (arg1); | 224 | f1 = FLOATP (arg1) ? XFLOAT_DATA (arg1) : XINT (arg1); |
| 505 | f2 = FLOATP (arg2) ? XFLOAT_DATA (arg2) : XINT (arg2); | 225 | f2 = FLOATP (arg2) ? XFLOAT_DATA (arg2) : XINT (arg2); |
| 506 | /* Really should check for overflow, too */ | 226 | f3 = pow (f1, f2); |
| 507 | if (f1 == 0.0 && f2 == 0.0) | ||
| 508 | f1 = 1.0; | ||
| 509 | #ifdef FLOAT_CHECK_DOMAIN | ||
| 510 | else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor (f2))) | ||
| 511 | domain_error2 ("expt", arg1, arg2); | ||
| 512 | #endif | ||
| 513 | IN_FLOAT2 (f3 = pow (f1, f2), "expt", arg1, arg2); | ||
| 514 | /* Check for overflow in the result. */ | ||
| 515 | if (f1 != 0.0 && f3 == 0.0) | ||
| 516 | range_error ("expt", arg1); | ||
| 517 | return make_float (f3); | 227 | return make_float (f3); |
| 518 | } | 228 | } |
| 519 | 229 | ||
| 520 | DEFUN ("log", Flog, Slog, 1, 2, 0, | 230 | DEFUN ("log", Flog, Slog, 1, 2, 0, |
| 521 | doc: /* Return the natural logarithm of ARG. | 231 | doc: /* Return the natural logarithm of ARG. |
| 522 | If the optional argument BASE is given, return log ARG using that base. */) | 232 | If the optional argument BASE is given, return log ARG using that base. */) |
| 523 | (register Lisp_Object arg, Lisp_Object base) | 233 | (Lisp_Object arg, Lisp_Object base) |
| 524 | { | 234 | { |
| 525 | double d = extract_float (arg); | 235 | double d = extract_float (arg); |
| 526 | 236 | ||
| 527 | #ifdef FLOAT_CHECK_DOMAIN | ||
| 528 | if (d <= 0.0) | ||
| 529 | domain_error2 ("log", arg, base); | ||
| 530 | #endif | ||
| 531 | if (NILP (base)) | 237 | if (NILP (base)) |
| 532 | IN_FLOAT (d = log (d), "log", arg); | 238 | d = log (d); |
| 533 | else | 239 | else |
| 534 | { | 240 | { |
| 535 | double b = extract_float (base); | 241 | double b = extract_float (base); |
| 536 | 242 | ||
| 537 | #ifdef FLOAT_CHECK_DOMAIN | ||
| 538 | if (b <= 0.0 || b == 1.0) | ||
| 539 | domain_error2 ("log", arg, base); | ||
| 540 | #endif | ||
| 541 | if (b == 10.0) | 243 | if (b == 10.0) |
| 542 | IN_FLOAT2 (d = log10 (d), "log", arg, base); | 244 | d = log10 (d); |
| 543 | else | 245 | else |
| 544 | IN_FLOAT2 (d = log (d) / log (b), "log", arg, base); | 246 | d = log (d) / log (b); |
| 545 | } | 247 | } |
| 546 | return make_float (d); | 248 | return make_float (d); |
| 547 | } | 249 | } |
| 548 | 250 | ||
| 549 | DEFUN ("log10", Flog10, Slog10, 1, 1, 0, | 251 | DEFUN ("log10", Flog10, Slog10, 1, 1, 0, |
| 550 | doc: /* Return the logarithm base 10 of ARG. */) | 252 | doc: /* Return the logarithm base 10 of ARG. */) |
| 551 | (register Lisp_Object arg) | 253 | (Lisp_Object arg) |
| 552 | { | 254 | { |
| 553 | double d = extract_float (arg); | 255 | double d = extract_float (arg); |
| 554 | #ifdef FLOAT_CHECK_DOMAIN | 256 | d = log10 (d); |
| 555 | if (d <= 0.0) | ||
| 556 | domain_error ("log10", arg); | ||
| 557 | #endif | ||
| 558 | IN_FLOAT (d = log10 (d), "log10", arg); | ||
| 559 | return make_float (d); | 257 | return make_float (d); |
| 560 | } | 258 | } |
| 561 | 259 | ||
| 562 | DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, | 260 | DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, |
| 563 | doc: /* Return the square root of ARG. */) | 261 | doc: /* Return the square root of ARG. */) |
| 564 | (register Lisp_Object arg) | 262 | (Lisp_Object arg) |
| 565 | { | ||
| 566 | double d = extract_float (arg); | ||
| 567 | #ifdef FLOAT_CHECK_DOMAIN | ||
| 568 | if (d < 0.0) | ||
| 569 | domain_error ("sqrt", arg); | ||
| 570 | #endif | ||
| 571 | IN_FLOAT (d = sqrt (d), "sqrt", arg); | ||
| 572 | return make_float (d); | ||
| 573 | } | ||
| 574 | |||
| 575 | #if 0 /* Not clearly worth adding. */ | ||
| 576 | |||
| 577 | DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0, | ||
| 578 | doc: /* Return the inverse hyperbolic cosine of ARG. */) | ||
| 579 | (register Lisp_Object arg) | ||
| 580 | { | ||
| 581 | double d = extract_float (arg); | ||
| 582 | #ifdef FLOAT_CHECK_DOMAIN | ||
| 583 | if (d < 1.0) | ||
| 584 | domain_error ("acosh", arg); | ||
| 585 | #endif | ||
| 586 | #ifdef HAVE_INVERSE_HYPERBOLIC | ||
| 587 | IN_FLOAT (d = acosh (d), "acosh", arg); | ||
| 588 | #else | ||
| 589 | IN_FLOAT (d = log (d + sqrt (d*d - 1.0)), "acosh", arg); | ||
| 590 | #endif | ||
| 591 | return make_float (d); | ||
| 592 | } | ||
| 593 | |||
| 594 | DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0, | ||
| 595 | doc: /* Return the inverse hyperbolic sine of ARG. */) | ||
| 596 | (register Lisp_Object arg) | ||
| 597 | { | ||
| 598 | double d = extract_float (arg); | ||
| 599 | #ifdef HAVE_INVERSE_HYPERBOLIC | ||
| 600 | IN_FLOAT (d = asinh (d), "asinh", arg); | ||
| 601 | #else | ||
| 602 | IN_FLOAT (d = log (d + sqrt (d*d + 1.0)), "asinh", arg); | ||
| 603 | #endif | ||
| 604 | return make_float (d); | ||
| 605 | } | ||
| 606 | |||
| 607 | DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0, | ||
| 608 | doc: /* Return the inverse hyperbolic tangent of ARG. */) | ||
| 609 | (register Lisp_Object arg) | ||
| 610 | { | ||
| 611 | double d = extract_float (arg); | ||
| 612 | #ifdef FLOAT_CHECK_DOMAIN | ||
| 613 | if (d >= 1.0 || d <= -1.0) | ||
| 614 | domain_error ("atanh", arg); | ||
| 615 | #endif | ||
| 616 | #ifdef HAVE_INVERSE_HYPERBOLIC | ||
| 617 | IN_FLOAT (d = atanh (d), "atanh", arg); | ||
| 618 | #else | ||
| 619 | IN_FLOAT (d = 0.5 * log ((1.0 + d) / (1.0 - d)), "atanh", arg); | ||
| 620 | #endif | ||
| 621 | return make_float (d); | ||
| 622 | } | ||
| 623 | |||
| 624 | DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0, | ||
| 625 | doc: /* Return the hyperbolic cosine of ARG. */) | ||
| 626 | (register Lisp_Object arg) | ||
| 627 | { | ||
| 628 | double d = extract_float (arg); | ||
| 629 | #ifdef FLOAT_CHECK_DOMAIN | ||
| 630 | if (d > 710.0 || d < -710.0) | ||
| 631 | range_error ("cosh", arg); | ||
| 632 | #endif | ||
| 633 | IN_FLOAT (d = cosh (d), "cosh", arg); | ||
| 634 | return make_float (d); | ||
| 635 | } | ||
| 636 | |||
| 637 | DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0, | ||
| 638 | doc: /* Return the hyperbolic sine of ARG. */) | ||
| 639 | (register Lisp_Object arg) | ||
| 640 | { | ||
| 641 | double d = extract_float (arg); | ||
| 642 | #ifdef FLOAT_CHECK_DOMAIN | ||
| 643 | if (d > 710.0 || d < -710.0) | ||
| 644 | range_error ("sinh", arg); | ||
| 645 | #endif | ||
| 646 | IN_FLOAT (d = sinh (d), "sinh", arg); | ||
| 647 | return make_float (d); | ||
| 648 | } | ||
| 649 | |||
| 650 | DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0, | ||
| 651 | doc: /* Return the hyperbolic tangent of ARG. */) | ||
| 652 | (register Lisp_Object arg) | ||
| 653 | { | 263 | { |
| 654 | double d = extract_float (arg); | 264 | double d = extract_float (arg); |
| 655 | IN_FLOAT (d = tanh (d), "tanh", arg); | 265 | d = sqrt (d); |
| 656 | return make_float (d); | 266 | return make_float (d); |
| 657 | } | 267 | } |
| 658 | #endif | ||
| 659 | 268 | ||
| 660 | DEFUN ("abs", Fabs, Sabs, 1, 1, 0, | 269 | DEFUN ("abs", Fabs, Sabs, 1, 1, 0, |
| 661 | doc: /* Return the absolute value of ARG. */) | 270 | doc: /* Return the absolute value of ARG. */) |
| @@ -694,38 +303,15 @@ This is the same as the exponent of a float. */) | |||
| 694 | 303 | ||
| 695 | if (f == 0.0) | 304 | if (f == 0.0) |
| 696 | value = MOST_NEGATIVE_FIXNUM; | 305 | value = MOST_NEGATIVE_FIXNUM; |
| 697 | else | 306 | else if (isfinite (f)) |
| 698 | { | 307 | { |
| 699 | #ifdef HAVE_LOGB | ||
| 700 | IN_FLOAT (value = logb (f), "logb", arg); | ||
| 701 | #else | ||
| 702 | #ifdef HAVE_FREXP | ||
| 703 | int ivalue; | 308 | int ivalue; |
| 704 | IN_FLOAT (frexp (f, &ivalue), "logb", arg); | 309 | frexp (f, &ivalue); |
| 705 | value = ivalue - 1; | 310 | value = ivalue - 1; |
| 706 | #else | ||
| 707 | int i; | ||
| 708 | double d; | ||
| 709 | if (f < 0.0) | ||
| 710 | f = -f; | ||
| 711 | value = -1; | ||
| 712 | while (f < 0.5) | ||
| 713 | { | ||
| 714 | for (i = 1, d = 0.5; d * d >= f; i += i) | ||
| 715 | d *= d; | ||
| 716 | f /= d; | ||
| 717 | value -= i; | ||
| 718 | } | ||
| 719 | while (f >= 1.0) | ||
| 720 | { | ||
| 721 | for (i = 1, d = 2.0; d * d <= f; i += i) | ||
| 722 | d *= d; | ||
| 723 | f /= d; | ||
| 724 | value += i; | ||
| 725 | } | ||
| 726 | #endif | ||
| 727 | #endif | ||
| 728 | } | 311 | } |
| 312 | else | ||
| 313 | value = MOST_POSITIVE_FIXNUM; | ||
| 314 | |||
| 729 | XSETINT (val, value); | 315 | XSETINT (val, value); |
| 730 | return val; | 316 | return val; |
| 731 | } | 317 | } |
| @@ -756,8 +342,10 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, | |||
| 756 | if (! IEEE_FLOATING_POINT && f2 == 0) | 342 | if (! IEEE_FLOATING_POINT && f2 == 0) |
| 757 | xsignal0 (Qarith_error); | 343 | xsignal0 (Qarith_error); |
| 758 | 344 | ||
| 759 | IN_FLOAT2 (f1 = (*double_round) (f1 / f2), name, arg, divisor); | 345 | f1 = (*double_round) (f1 / f2); |
| 760 | FLOAT_TO_INT2 (f1, arg, name, arg, divisor); | 346 | if (FIXNUM_OVERFLOW_P (f1)) |
| 347 | xsignal3 (Qrange_error, build_string (name), arg, divisor); | ||
| 348 | arg = make_number (f1); | ||
| 761 | return arg; | 349 | return arg; |
| 762 | } | 350 | } |
| 763 | 351 | ||
| @@ -773,10 +361,10 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, | |||
| 773 | 361 | ||
| 774 | if (FLOATP (arg)) | 362 | if (FLOATP (arg)) |
| 775 | { | 363 | { |
| 776 | double d; | 364 | double d = (*double_round) (XFLOAT_DATA (arg)); |
| 777 | 365 | if (FIXNUM_OVERFLOW_P (d)) | |
| 778 | IN_FLOAT (d = (*double_round) (XFLOAT_DATA (arg)), name, arg); | 366 | xsignal2 (Qrange_error, build_string (name), arg); |
| 779 | FLOAT_TO_INT (d, arg, name, arg); | 367 | arg = make_number (d); |
| 780 | } | 368 | } |
| 781 | 369 | ||
| 782 | return arg; | 370 | return arg; |
| @@ -893,125 +481,57 @@ fmod_float (Lisp_Object x, Lisp_Object y) | |||
| 893 | f1 = FLOATP (x) ? XFLOAT_DATA (x) : XINT (x); | 481 | f1 = FLOATP (x) ? XFLOAT_DATA (x) : XINT (x); |
| 894 | f2 = FLOATP (y) ? XFLOAT_DATA (y) : XINT (y); | 482 | f2 = FLOATP (y) ? XFLOAT_DATA (y) : XINT (y); |
| 895 | 483 | ||
| 896 | if (! IEEE_FLOATING_POINT && f2 == 0) | 484 | f1 = fmod (f1, f2); |
| 897 | xsignal0 (Qarith_error); | ||
| 898 | 485 | ||
| 899 | /* If the "remainder" comes out with the wrong sign, fix it. */ | 486 | /* If the "remainder" comes out with the wrong sign, fix it. */ |
| 900 | IN_FLOAT2 ((f1 = fmod (f1, f2), | 487 | if (f2 < 0 ? 0 < f1 : f1 < 0) |
| 901 | f1 = (f2 < 0 ? f1 > 0 : f1 < 0) ? f1 + f2 : f1), | 488 | f1 += f2; |
| 902 | "mod", x, y); | 489 | |
| 903 | return make_float (f1); | 490 | return make_float (f1); |
| 904 | } | 491 | } |
| 905 | 492 | ||
| 906 | /* It's not clear these are worth adding. */ | ||
| 907 | |||
| 908 | DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0, | 493 | DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0, |
| 909 | doc: /* Return the smallest integer no less than ARG, as a float. | 494 | doc: /* Return the smallest integer no less than ARG, as a float. |
| 910 | \(Round toward +inf.\) */) | 495 | \(Round toward +inf.\) */) |
| 911 | (register Lisp_Object arg) | 496 | (Lisp_Object arg) |
| 912 | { | 497 | { |
| 913 | double d = extract_float (arg); | 498 | double d = extract_float (arg); |
| 914 | IN_FLOAT (d = ceil (d), "fceiling", arg); | 499 | d = ceil (d); |
| 915 | return make_float (d); | 500 | return make_float (d); |
| 916 | } | 501 | } |
| 917 | 502 | ||
| 918 | DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0, | 503 | DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0, |
| 919 | doc: /* Return the largest integer no greater than ARG, as a float. | 504 | doc: /* Return the largest integer no greater than ARG, as a float. |
| 920 | \(Round towards -inf.\) */) | 505 | \(Round towards -inf.\) */) |
| 921 | (register Lisp_Object arg) | 506 | (Lisp_Object arg) |
| 922 | { | 507 | { |
| 923 | double d = extract_float (arg); | 508 | double d = extract_float (arg); |
| 924 | IN_FLOAT (d = floor (d), "ffloor", arg); | 509 | d = floor (d); |
| 925 | return make_float (d); | 510 | return make_float (d); |
| 926 | } | 511 | } |
| 927 | 512 | ||
| 928 | DEFUN ("fround", Ffround, Sfround, 1, 1, 0, | 513 | DEFUN ("fround", Ffround, Sfround, 1, 1, 0, |
| 929 | doc: /* Return the nearest integer to ARG, as a float. */) | 514 | doc: /* Return the nearest integer to ARG, as a float. */) |
| 930 | (register Lisp_Object arg) | 515 | (Lisp_Object arg) |
| 931 | { | 516 | { |
| 932 | double d = extract_float (arg); | 517 | double d = extract_float (arg); |
| 933 | IN_FLOAT (d = emacs_rint (d), "fround", arg); | 518 | d = emacs_rint (d); |
| 934 | return make_float (d); | 519 | return make_float (d); |
| 935 | } | 520 | } |
| 936 | 521 | ||
| 937 | DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0, | 522 | DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0, |
| 938 | doc: /* Truncate a floating point number to an integral float value. | 523 | doc: /* Truncate a floating point number to an integral float value. |
| 939 | Rounds the value toward zero. */) | 524 | Rounds the value toward zero. */) |
| 940 | (register Lisp_Object arg) | 525 | (Lisp_Object arg) |
| 941 | { | 526 | { |
| 942 | double d = extract_float (arg); | 527 | double d = extract_float (arg); |
| 943 | if (d >= 0.0) | 528 | if (d >= 0.0) |
| 944 | IN_FLOAT (d = floor (d), "ftruncate", arg); | 529 | d = floor (d); |
| 945 | else | 530 | else |
| 946 | IN_FLOAT (d = ceil (d), "ftruncate", arg); | 531 | d = ceil (d); |
| 947 | return make_float (d); | 532 | return make_float (d); |
| 948 | } | 533 | } |
| 949 | 534 | ||
| 950 | #ifdef FLOAT_CATCH_SIGILL | ||
| 951 | static void | ||
| 952 | float_error (int signo) | ||
| 953 | { | ||
| 954 | if (! in_float) | ||
| 955 | fatal_error_signal (signo); | ||
| 956 | |||
| 957 | #ifdef BSD_SYSTEM | ||
| 958 | sigsetmask (SIGEMPTYMASK); | ||
| 959 | #else | ||
| 960 | /* Must reestablish handler each time it is called. */ | ||
| 961 | signal (SIGILL, float_error); | ||
| 962 | #endif /* BSD_SYSTEM */ | ||
| 963 | |||
| 964 | SIGNAL_THREAD_CHECK (signo); | ||
| 965 | in_float = 0; | ||
| 966 | |||
| 967 | xsignal1 (Qarith_error, float_error_arg); | ||
| 968 | } | ||
| 969 | |||
| 970 | /* Another idea was to replace the library function `infnan' | ||
| 971 | where SIGILL is signaled. */ | ||
| 972 | |||
| 973 | #endif /* FLOAT_CATCH_SIGILL */ | ||
| 974 | |||
| 975 | #ifdef HAVE_MATHERR | ||
| 976 | int | ||
| 977 | matherr (struct exception *x) | ||
| 978 | { | ||
| 979 | Lisp_Object args; | ||
| 980 | const char *name = x->name; | ||
| 981 | |||
| 982 | if (! in_float) | ||
| 983 | /* Not called from emacs-lisp float routines; do the default thing. */ | ||
| 984 | return 0; | ||
| 985 | if (!strcmp (x->name, "pow")) | ||
| 986 | name = "expt"; | ||
| 987 | |||
| 988 | args | ||
| 989 | = Fcons (build_string (name), | ||
| 990 | Fcons (make_float (x->arg1), | ||
| 991 | ((!strcmp (name, "log") || !strcmp (name, "pow")) | ||
| 992 | ? Fcons (make_float (x->arg2), Qnil) | ||
| 993 | : Qnil))); | ||
| 994 | switch (x->type) | ||
| 995 | { | ||
| 996 | case DOMAIN: xsignal (Qdomain_error, args); break; | ||
| 997 | case SING: xsignal (Qsingularity_error, args); break; | ||
| 998 | case OVERFLOW: xsignal (Qoverflow_error, args); break; | ||
| 999 | case UNDERFLOW: xsignal (Qunderflow_error, args); break; | ||
| 1000 | default: xsignal (Qarith_error, args); break; | ||
| 1001 | } | ||
| 1002 | return (1); /* don't set errno or print a message */ | ||
| 1003 | } | ||
| 1004 | #endif /* HAVE_MATHERR */ | ||
| 1005 | |||
| 1006 | void | ||
| 1007 | init_floatfns (void) | ||
| 1008 | { | ||
| 1009 | #ifdef FLOAT_CATCH_SIGILL | ||
| 1010 | signal (SIGILL, float_error); | ||
| 1011 | #endif | ||
| 1012 | in_float = 0; | ||
| 1013 | } | ||
| 1014 | |||
| 1015 | void | 535 | void |
| 1016 | syms_of_floatfns (void) | 536 | syms_of_floatfns (void) |
| 1017 | { | 537 | { |
| @@ -1024,27 +544,9 @@ syms_of_floatfns (void) | |||
| 1024 | defsubr (&Sisnan); | 544 | defsubr (&Sisnan); |
| 1025 | #ifdef HAVE_COPYSIGN | 545 | #ifdef HAVE_COPYSIGN |
| 1026 | defsubr (&Scopysign); | 546 | defsubr (&Scopysign); |
| 547 | #endif | ||
| 1027 | defsubr (&Sfrexp); | 548 | defsubr (&Sfrexp); |
| 1028 | defsubr (&Sldexp); | 549 | defsubr (&Sldexp); |
| 1029 | #endif | ||
| 1030 | #if 0 | ||
| 1031 | defsubr (&Sacosh); | ||
| 1032 | defsubr (&Sasinh); | ||
| 1033 | defsubr (&Satanh); | ||
| 1034 | defsubr (&Scosh); | ||
| 1035 | defsubr (&Ssinh); | ||
| 1036 | defsubr (&Stanh); | ||
| 1037 | defsubr (&Sbessel_y0); | ||
| 1038 | defsubr (&Sbessel_y1); | ||
| 1039 | defsubr (&Sbessel_yn); | ||
| 1040 | defsubr (&Sbessel_j0); | ||
| 1041 | defsubr (&Sbessel_j1); | ||
| 1042 | defsubr (&Sbessel_jn); | ||
| 1043 | defsubr (&Serf); | ||
| 1044 | defsubr (&Serfc); | ||
| 1045 | defsubr (&Slog_gamma); | ||
| 1046 | defsubr (&Scube_root); | ||
| 1047 | #endif | ||
| 1048 | defsubr (&Sfceiling); | 550 | defsubr (&Sfceiling); |
| 1049 | defsubr (&Sffloor); | 551 | defsubr (&Sffloor); |
| 1050 | defsubr (&Sfround); | 552 | defsubr (&Sfround); |