diff options
| author | Bill Wohler | 2014-02-23 18:04:35 -0800 |
|---|---|---|
| committer | Bill Wohler | 2014-02-23 18:04:35 -0800 |
| commit | 3e93bafb95608467e438ba7f725fd1f020669f8c (patch) | |
| tree | f2f90109f283e06a18caea3cb2a2623abcfb3a92 /src/floatfns.c | |
| parent | 791c0d7634e44bb92ca85af605be84ff2ae08963 (diff) | |
| parent | e918e27fdf331e89268fc2c9d7cf838d3ecf7aa7 (diff) | |
| download | emacs-3e93bafb95608467e438ba7f725fd1f020669f8c.tar.gz emacs-3e93bafb95608467e438ba7f725fd1f020669f8c.zip | |
Merge from trunk; up to 2014-02-23T23:41:17Z!lekktu@gmail.com.
Diffstat (limited to 'src/floatfns.c')
| -rw-r--r-- | src/floatfns.c | 55 |
1 files changed, 35 insertions, 20 deletions
diff --git a/src/floatfns.c b/src/floatfns.c index 43576a16248..4de5f480259 100644 --- a/src/floatfns.c +++ b/src/floatfns.c | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | /* Primitive operations on floating point for GNU Emacs Lisp interpreter. | 1 | /* Primitive operations on floating point for GNU Emacs Lisp interpreter. |
| 2 | 2 | ||
| 3 | Copyright (C) 1988, 1993-1994, 1999, 2001-2013 Free Software Foundation, | 3 | Copyright (C) 1988, 1993-1994, 1999, 2001-2014 Free Software Foundation, |
| 4 | Inc. | 4 | Inc. |
| 5 | 5 | ||
| 6 | Author: Wolfgang Rupprecht | 6 | Author: Wolfgang Rupprecht |
| @@ -25,7 +25,19 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 25 | /* C89 requires only the following math.h functions, and Emacs omits | 25 | /* C89 requires only the following math.h functions, and Emacs omits |
| 26 | the starred functions since we haven't found a use for them: | 26 | the starred functions since we haven't found a use for them: |
| 27 | acos, asin, atan, atan2, ceil, cos, *cosh, exp, fabs, floor, fmod, | 27 | acos, asin, atan, atan2, ceil, cos, *cosh, exp, fabs, floor, fmod, |
| 28 | frexp, ldexp, log, log10, *modf, pow, sin, *sinh, sqrt, tan, *tanh. | 28 | frexp, ldexp, log, log10 [via (log X 10)], *modf, pow, sin, *sinh, |
| 29 | sqrt, tan, *tanh. | ||
| 30 | |||
| 31 | C99 and C11 require the following math.h functions in addition to | ||
| 32 | the C89 functions. Of these, Emacs currently exports only the | ||
| 33 | starred ones to Lisp, since we haven't found a use for the others: | ||
| 34 | acosh, atanh, cbrt, *copysign, erf, erfc, exp2, expm1, fdim, fma, | ||
| 35 | fmax, fmin, fpclassify, hypot, ilogb, isfinite, isgreater, | ||
| 36 | isgreaterequal, isinf, isless, islessequal, islessgreater, *isnan, | ||
| 37 | isnormal, isunordered, lgamma, log1p, *log2 [via (log X 2)], *logb | ||
| 38 | (approximately), lrint/llrint, lround/llround, nan, nearbyint, | ||
| 39 | nextafter, nexttoward, remainder, remquo, *rint, round, scalbln, | ||
| 40 | scalbn, signbit, tgamma, trunc. | ||
| 29 | */ | 41 | */ |
| 30 | 42 | ||
| 31 | #include <config.h> | 43 | #include <config.h> |
| @@ -34,12 +46,21 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 34 | 46 | ||
| 35 | #include <math.h> | 47 | #include <math.h> |
| 36 | 48 | ||
| 37 | #ifndef isfinite | 49 | /* 'isfinite' and 'isnan' cause build failures on Solaris 10 with the |
| 38 | # define isfinite(x) ((x) - (x) == 0) | 50 | bundled GCC in c99 mode. Work around the bugs with simple |
| 39 | #endif | 51 | implementations that are good enough. */ |
| 40 | #ifndef isnan | 52 | #undef isfinite |
| 41 | # define isnan(x) ((x) != (x)) | 53 | #define isfinite(x) ((x) - (x) == 0) |
| 42 | #endif | 54 | #undef isnan |
| 55 | #define isnan(x) ((x) != (x)) | ||
| 56 | |||
| 57 | /* Check that X is a floating point number. */ | ||
| 58 | |||
| 59 | static void | ||
| 60 | CHECK_FLOAT (Lisp_Object x) | ||
| 61 | { | ||
| 62 | CHECK_TYPE (FLOATP (x), Qfloatp, x); | ||
| 63 | } | ||
| 43 | 64 | ||
| 44 | /* Extract a Lisp number as a `double', or signal an error. */ | 65 | /* Extract a Lisp number as a `double', or signal an error. */ |
| 45 | 66 | ||
| @@ -193,7 +214,7 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, | |||
| 193 | CHECK_NUMBER_OR_FLOAT (arg2); | 214 | CHECK_NUMBER_OR_FLOAT (arg2); |
| 194 | if (INTEGERP (arg1) /* common lisp spec */ | 215 | if (INTEGERP (arg1) /* common lisp spec */ |
| 195 | && INTEGERP (arg2) /* don't promote, if both are ints, and */ | 216 | && INTEGERP (arg2) /* don't promote, if both are ints, and */ |
| 196 | && 0 <= XINT (arg2)) /* we are sure the result is not fractional */ | 217 | && XINT (arg2) >= 0) /* we are sure the result is not fractional */ |
| 197 | { /* this can be improved by pre-calculating */ | 218 | { /* this can be improved by pre-calculating */ |
| 198 | EMACS_INT y; /* some binary powers of x then accumulating */ | 219 | EMACS_INT y; /* some binary powers of x then accumulating */ |
| 199 | EMACS_UINT acc, x; /* Unsigned so that overflow is well defined. */ | 220 | EMACS_UINT acc, x; /* Unsigned so that overflow is well defined. */ |
| @@ -233,21 +254,16 @@ If the optional argument BASE is given, return log ARG using that base. */) | |||
| 233 | 254 | ||
| 234 | if (b == 10.0) | 255 | if (b == 10.0) |
| 235 | d = log10 (d); | 256 | d = log10 (d); |
| 257 | #if HAVE_LOG2 | ||
| 258 | else if (b == 2.0) | ||
| 259 | d = log2 (d); | ||
| 260 | #endif | ||
| 236 | else | 261 | else |
| 237 | d = log (d) / log (b); | 262 | d = log (d) / log (b); |
| 238 | } | 263 | } |
| 239 | return make_float (d); | 264 | return make_float (d); |
| 240 | } | 265 | } |
| 241 | 266 | ||
| 242 | DEFUN ("log10", Flog10, Slog10, 1, 1, 0, | ||
| 243 | doc: /* Return the logarithm base 10 of ARG. */) | ||
| 244 | (Lisp_Object arg) | ||
| 245 | { | ||
| 246 | double d = extract_float (arg); | ||
| 247 | d = log10 (d); | ||
| 248 | return make_float (d); | ||
| 249 | } | ||
| 250 | |||
| 251 | DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, | 267 | DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, |
| 252 | doc: /* Return the square root of ARG. */) | 268 | doc: /* Return the square root of ARG. */) |
| 253 | (Lisp_Object arg) | 269 | (Lisp_Object arg) |
| @@ -475,7 +491,7 @@ fmod_float (Lisp_Object x, Lisp_Object y) | |||
| 475 | f1 = fmod (f1, f2); | 491 | f1 = fmod (f1, f2); |
| 476 | 492 | ||
| 477 | /* If the "remainder" comes out with the wrong sign, fix it. */ | 493 | /* If the "remainder" comes out with the wrong sign, fix it. */ |
| 478 | if (f2 < 0 ? 0 < f1 : f1 < 0) | 494 | if (f2 < 0 ? f1 > 0 : f1 < 0) |
| 479 | f1 += f2; | 495 | f1 += f2; |
| 480 | 496 | ||
| 481 | return make_float (f1); | 497 | return make_float (f1); |
| @@ -545,7 +561,6 @@ syms_of_floatfns (void) | |||
| 545 | defsubr (&Sexp); | 561 | defsubr (&Sexp); |
| 546 | defsubr (&Sexpt); | 562 | defsubr (&Sexpt); |
| 547 | defsubr (&Slog); | 563 | defsubr (&Slog); |
| 548 | defsubr (&Slog10); | ||
| 549 | defsubr (&Ssqrt); | 564 | defsubr (&Ssqrt); |
| 550 | 565 | ||
| 551 | defsubr (&Sabs); | 566 | defsubr (&Sabs); |