diff options
| author | Paul Eggert | 2012-09-10 19:28:27 -0700 |
|---|---|---|
| committer | Paul Eggert | 2012-09-10 19:28:27 -0700 |
| commit | c990426a9883c1bd1782e6b117184b654eecda67 (patch) | |
| tree | 43083f890e5286637ee754482af0f92d6d2236d0 /src/floatfns.c | |
| parent | 6fda35f2b3e3ce3c7dcc05f230f60c51c4c42e60 (diff) | |
| download | emacs-c990426a9883c1bd1782e6b117184b654eecda67.tar.gz emacs-c990426a9883c1bd1782e6b117184b654eecda67.zip | |
Simplify, document, and port floating-point.
The porting part of this patch fixes bugs on non-IEEE platforms
with frexp, ldexp, logb.
* admin/CPP-DEFINES (HAVE_CBRT, HAVE_LOGB, logb): Remove.
* configure.ac (logb, cbrt): Do not check for these functions,
as they are not being used.
* doc/lispref/numbers.texi (Float Basics, Arithmetic Operations, Math Functions):
Document that / and mod (with floating point arguments), along
with asin, acos, log, log10, expt and sqrt, return special values
instead of signaling exceptions.
(Float Basics): Document that logb operates on the absolute value
of its argument.
(Math Functions): Document that (log ARG BASE) also returns NaN if
BASE is negative. Document that (expt X Y) returns NaN if X is a
finite negative number and Y a finite non-integer.
* etc/NEWS: Document NaNs versus signaling-error change.
* src/data.c, src/lisp.h (Qdomain_error, Qsingularity_error, Qunderflow_error):
Now static.
* src/floatfns.c: Simplify discussion of functions that Emacs doesn't
support, by removing commented-out code and briefly listing the
C89 functions excluded. The commented-out stuff was confusing
maintenance, e.g., we thought we needed cbrt but it was commented out.
(logb): Remove decl; no longer needed.
(isfinite): New macro, if not already supplied.
(isnan): Don't replace any existing macro.
(Ffrexp, Fldexp): Define even if !HAVE_COPYSIGN, as frexp and ldexp
are present on all C89 platforms.
(Ffrexp): Do not special-case zero, as frexp does the right thing
for that case.
(Flogb): Do not use logb, as it doesn't have the desired meaning
on hosts that use non-base-2 floating point. Instead, stick with
frexp, which is C89 anyway. Do not pass an infinity or a NaN to
frexp, to avoid getting an unspecified result.
Diffstat (limited to 'src/floatfns.c')
| -rw-r--r-- | src/floatfns.c | 231 |
1 files changed, 19 insertions, 212 deletions
diff --git a/src/floatfns.c b/src/floatfns.c index 8a9a9fd0886..66d7ca4af2c 100644 --- a/src/floatfns.c +++ b/src/floatfns.c | |||
| @@ -22,9 +22,10 @@ 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 | /* C89 requires only these math.h 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 | frexp, ldexp, log, log10, *modf, pow, sin, *sinh, sqrt, tan, *tanh. | ||
| 28 | */ | 29 | */ |
| 29 | 30 | ||
| 30 | #include <config.h> | 31 | #include <config.h> |
| @@ -42,10 +43,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 42 | 43 | ||
| 43 | #include <math.h> | 44 | #include <math.h> |
| 44 | 45 | ||
| 45 | /* This declaration is omitted on some systems, like Ultrix. */ | 46 | #ifndef isfinite |
| 46 | #if !defined (HPUX) && defined (HAVE_LOGB) && !defined (logb) | 47 | # define isfinite(x) ((x) - (x) == 0) |
| 47 | extern double logb (double); | 48 | #endif |
| 48 | #endif /* not HPUX and HAVE_LOGB and no logb macro */ | 49 | #ifndef isnan |
| 50 | # define isnan(x) ((x) != (x)) | ||
| 51 | #endif | ||
| 49 | 52 | ||
| 50 | /* Extract a Lisp number as a `double', or signal an error. */ | 53 | /* Extract a Lisp number as a `double', or signal an error. */ |
| 51 | 54 | ||
| @@ -126,9 +129,6 @@ DEFUN ("tan", Ftan, Stan, 1, 1, 0, | |||
| 126 | return make_float (d); | 129 | return make_float (d); |
| 127 | } | 130 | } |
| 128 | 131 | ||
| 129 | #undef isnan | ||
| 130 | #define isnan(x) ((x) != (x)) | ||
| 131 | |||
| 132 | DEFUN ("isnan", Fisnan, Sisnan, 1, 1, 0, | 132 | DEFUN ("isnan", Fisnan, Sisnan, 1, 1, 0, |
| 133 | doc: /* Return non nil iff argument X is a NaN. */) | 133 | doc: /* Return non nil iff argument X is a NaN. */) |
| 134 | (Lisp_Object x) | 134 | (Lisp_Object x) |
| @@ -153,6 +153,7 @@ Cause an error if X1 or X2 is not a float. */) | |||
| 153 | 153 | ||
| 154 | return make_float (copysign (f1, f2)); | 154 | return make_float (copysign (f1, f2)); |
| 155 | } | 155 | } |
| 156 | #endif | ||
| 156 | 157 | ||
| 157 | DEFUN ("frexp", Ffrexp, Sfrexp, 1, 1, 0, | 158 | DEFUN ("frexp", Ffrexp, Sfrexp, 1, 1, 0, |
| 158 | doc: /* Get significand and exponent of a floating point number. | 159 | doc: /* Get significand and exponent of a floating point number. |
| @@ -167,15 +168,9 @@ If X is zero, both parts (SGNFCAND and EXP) are zero. */) | |||
| 167 | (Lisp_Object x) | 168 | (Lisp_Object x) |
| 168 | { | 169 | { |
| 169 | double f = XFLOATINT (x); | 170 | double f = XFLOATINT (x); |
| 170 | 171 | int exponent; | |
| 171 | if (f == 0.0) | 172 | double sgnfcand = frexp (f, &exponent); |
| 172 | return Fcons (make_float (0.0), make_number (0)); | 173 | return Fcons (make_float (sgnfcand), make_number (exponent)); |
| 173 | else | ||
| 174 | { | ||
| 175 | int exponent; | ||
| 176 | double sgnfcand = frexp (f, &exponent); | ||
| 177 | return Fcons (make_float (sgnfcand), make_number (exponent)); | ||
| 178 | } | ||
| 179 | } | 174 | } |
| 180 | 175 | ||
| 181 | DEFUN ("ldexp", Fldexp, Sldexp, 1, 2, 0, | 176 | DEFUN ("ldexp", Fldexp, Sldexp, 1, 2, 0, |
| @@ -187,118 +182,6 @@ Returns the floating point value resulting from multiplying SGNFCAND | |||
| 187 | CHECK_NUMBER (exponent); | 182 | CHECK_NUMBER (exponent); |
| 188 | return make_float (ldexp (XFLOATINT (sgnfcand), XINT (exponent))); | 183 | return make_float (ldexp (XFLOATINT (sgnfcand), XINT (exponent))); |
| 189 | } | 184 | } |
| 190 | #endif | ||
| 191 | |||
| 192 | #if 0 /* Leave these out unless we find there's a reason for them. */ | ||
| 193 | |||
| 194 | DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0, | ||
| 195 | doc: /* Return the bessel function j0 of ARG. */) | ||
| 196 | (Lisp_Object arg) | ||
| 197 | { | ||
| 198 | double d = extract_float (arg); | ||
| 199 | d = j0 (d); | ||
| 200 | return make_float (d); | ||
| 201 | } | ||
| 202 | |||
| 203 | DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0, | ||
| 204 | doc: /* Return the bessel function j1 of ARG. */) | ||
| 205 | (Lisp_Object arg) | ||
| 206 | { | ||
| 207 | double d = extract_float (arg); | ||
| 208 | d = j1 (d); | ||
| 209 | return make_float (d); | ||
| 210 | } | ||
| 211 | |||
| 212 | DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0, | ||
| 213 | doc: /* Return the order N bessel function output jn of ARG. | ||
| 214 | The first arg (the order) is truncated to an integer. */) | ||
| 215 | (Lisp_Object n, Lisp_Object arg) | ||
| 216 | { | ||
| 217 | int i1 = extract_float (n); | ||
| 218 | double f2 = extract_float (arg); | ||
| 219 | |||
| 220 | f2 = jn (i1, f2); | ||
| 221 | return make_float (f2); | ||
| 222 | } | ||
| 223 | |||
| 224 | DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0, | ||
| 225 | doc: /* Return the bessel function y0 of ARG. */) | ||
| 226 | (Lisp_Object arg) | ||
| 227 | { | ||
| 228 | double d = extract_float (arg); | ||
| 229 | d = y0 (d); | ||
| 230 | return make_float (d); | ||
| 231 | } | ||
| 232 | |||
| 233 | DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0, | ||
| 234 | doc: /* Return the bessel function y1 of ARG. */) | ||
| 235 | (Lisp_Object arg) | ||
| 236 | { | ||
| 237 | double d = extract_float (arg); | ||
| 238 | d = y1 (d); | ||
| 239 | return make_float (d); | ||
| 240 | } | ||
| 241 | |||
| 242 | DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0, | ||
| 243 | doc: /* Return the order N bessel function output yn of ARG. | ||
| 244 | The first arg (the order) is truncated to an integer. */) | ||
| 245 | (Lisp_Object n, Lisp_Object arg) | ||
| 246 | { | ||
| 247 | int i1 = extract_float (n); | ||
| 248 | double f2 = extract_float (arg); | ||
| 249 | |||
| 250 | f2 = yn (i1, f2); | ||
| 251 | return make_float (f2); | ||
| 252 | } | ||
| 253 | |||
| 254 | #endif | ||
| 255 | |||
| 256 | #if 0 /* Leave these out unless we see they are worth having. */ | ||
| 257 | |||
| 258 | DEFUN ("erf", Ferf, Serf, 1, 1, 0, | ||
| 259 | doc: /* Return the mathematical error function of ARG. */) | ||
| 260 | (Lisp_Object arg) | ||
| 261 | { | ||
| 262 | double d = extract_float (arg); | ||
| 263 | d = erf (d); | ||
| 264 | return make_float (d); | ||
| 265 | } | ||
| 266 | |||
| 267 | DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0, | ||
| 268 | doc: /* Return the complementary error function of ARG. */) | ||
| 269 | (Lisp_Object arg) | ||
| 270 | { | ||
| 271 | double d = extract_float (arg); | ||
| 272 | d = erfc (d); | ||
| 273 | return make_float (d); | ||
| 274 | } | ||
| 275 | |||
| 276 | DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0, | ||
| 277 | doc: /* Return the log gamma of ARG. */) | ||
| 278 | (Lisp_Object arg) | ||
| 279 | { | ||
| 280 | double d = extract_float (arg); | ||
| 281 | d = lgamma (d); | ||
| 282 | return make_float (d); | ||
| 283 | } | ||
| 284 | |||
| 285 | DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0, | ||
| 286 | doc: /* Return the cube root of ARG. */) | ||
| 287 | (Lisp_Object arg) | ||
| 288 | { | ||
| 289 | double d = extract_float (arg); | ||
| 290 | #ifdef HAVE_CBRT | ||
| 291 | d = cbrt (d); | ||
| 292 | #else | ||
| 293 | if (d >= 0.0) | ||
| 294 | d = pow (d, 1.0/3.0); | ||
| 295 | else | ||
| 296 | d = -pow (-d, 1.0/3.0); | ||
| 297 | #endif | ||
| 298 | return make_float (d); | ||
| 299 | } | ||
| 300 | |||
| 301 | #endif | ||
| 302 | 185 | ||
| 303 | DEFUN ("exp", Fexp, Sexp, 1, 1, 0, | 186 | DEFUN ("exp", Fexp, Sexp, 1, 1, 0, |
| 304 | doc: /* Return the exponential base e of ARG. */) | 187 | doc: /* Return the exponential base e of ARG. */) |
| @@ -383,63 +266,6 @@ DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, | |||
| 383 | return make_float (d); | 266 | return make_float (d); |
| 384 | } | 267 | } |
| 385 | 268 | ||
| 386 | #if 0 /* Not clearly worth adding. */ | ||
| 387 | |||
| 388 | DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0, | ||
| 389 | doc: /* Return the inverse hyperbolic cosine of ARG. */) | ||
| 390 | (Lisp_Object arg) | ||
| 391 | { | ||
| 392 | double d = extract_float (arg); | ||
| 393 | d = acosh (d); | ||
| 394 | return make_float (d); | ||
| 395 | } | ||
| 396 | |||
| 397 | DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0, | ||
| 398 | doc: /* Return the inverse hyperbolic sine of ARG. */) | ||
| 399 | (Lisp_Object arg) | ||
| 400 | { | ||
| 401 | double d = extract_float (arg); | ||
| 402 | d = asinh (d); | ||
| 403 | return make_float (d); | ||
| 404 | } | ||
| 405 | |||
| 406 | DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0, | ||
| 407 | doc: /* Return the inverse hyperbolic tangent of ARG. */) | ||
| 408 | (Lisp_Object arg) | ||
| 409 | { | ||
| 410 | double d = extract_float (arg); | ||
| 411 | d = atanh (d); | ||
| 412 | return make_float (d); | ||
| 413 | } | ||
| 414 | |||
| 415 | DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0, | ||
| 416 | doc: /* Return the hyperbolic cosine of ARG. */) | ||
| 417 | (Lisp_Object arg) | ||
| 418 | { | ||
| 419 | double d = extract_float (arg); | ||
| 420 | d = cosh (d); | ||
| 421 | return make_float (d); | ||
| 422 | } | ||
| 423 | |||
| 424 | DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0, | ||
| 425 | doc: /* Return the hyperbolic sine of ARG. */) | ||
| 426 | (Lisp_Object arg) | ||
| 427 | { | ||
| 428 | double d = extract_float (arg); | ||
| 429 | d = sinh (d); | ||
| 430 | return make_float (d); | ||
| 431 | } | ||
| 432 | |||
| 433 | DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0, | ||
| 434 | doc: /* Return the hyperbolic tangent of ARG. */) | ||
| 435 | (Lisp_Object arg) | ||
| 436 | { | ||
| 437 | double d = extract_float (arg); | ||
| 438 | d = tanh (d); | ||
| 439 | return make_float (d); | ||
| 440 | } | ||
| 441 | #endif | ||
| 442 | |||
| 443 | DEFUN ("abs", Fabs, Sabs, 1, 1, 0, | 269 | DEFUN ("abs", Fabs, Sabs, 1, 1, 0, |
| 444 | doc: /* Return the absolute value of ARG. */) | 270 | doc: /* Return the absolute value of ARG. */) |
| 445 | (register Lisp_Object arg) | 271 | (register Lisp_Object arg) |
| @@ -477,16 +303,15 @@ This is the same as the exponent of a float. */) | |||
| 477 | 303 | ||
| 478 | if (f == 0.0) | 304 | if (f == 0.0) |
| 479 | value = MOST_NEGATIVE_FIXNUM; | 305 | value = MOST_NEGATIVE_FIXNUM; |
| 480 | else | 306 | else if (isfinite (f)) |
| 481 | { | 307 | { |
| 482 | #ifdef HAVE_LOGB | ||
| 483 | value = logb (f); | ||
| 484 | #else | ||
| 485 | int ivalue; | 308 | int ivalue; |
| 486 | frexp (f, &ivalue); | 309 | frexp (f, &ivalue); |
| 487 | value = ivalue - 1; | 310 | value = ivalue - 1; |
| 488 | #endif | ||
| 489 | } | 311 | } |
| 312 | else | ||
| 313 | value = MOST_POSITIVE_FIXNUM; | ||
| 314 | |||
| 490 | XSETINT (val, value); | 315 | XSETINT (val, value); |
| 491 | return val; | 316 | return val; |
| 492 | } | 317 | } |
| @@ -719,27 +544,9 @@ syms_of_floatfns (void) | |||
| 719 | defsubr (&Sisnan); | 544 | defsubr (&Sisnan); |
| 720 | #ifdef HAVE_COPYSIGN | 545 | #ifdef HAVE_COPYSIGN |
| 721 | defsubr (&Scopysign); | 546 | defsubr (&Scopysign); |
| 547 | #endif | ||
| 722 | defsubr (&Sfrexp); | 548 | defsubr (&Sfrexp); |
| 723 | defsubr (&Sldexp); | 549 | defsubr (&Sldexp); |
| 724 | #endif | ||
| 725 | #if 0 | ||
| 726 | defsubr (&Sacosh); | ||
| 727 | defsubr (&Sasinh); | ||
| 728 | defsubr (&Satanh); | ||
| 729 | defsubr (&Scosh); | ||
| 730 | defsubr (&Ssinh); | ||
| 731 | defsubr (&Stanh); | ||
| 732 | defsubr (&Sbessel_y0); | ||
| 733 | defsubr (&Sbessel_y1); | ||
| 734 | defsubr (&Sbessel_yn); | ||
| 735 | defsubr (&Sbessel_j0); | ||
| 736 | defsubr (&Sbessel_j1); | ||
| 737 | defsubr (&Sbessel_jn); | ||
| 738 | defsubr (&Serf); | ||
| 739 | defsubr (&Serfc); | ||
| 740 | defsubr (&Slog_gamma); | ||
| 741 | defsubr (&Scube_root); | ||
| 742 | #endif | ||
| 743 | defsubr (&Sfceiling); | 550 | defsubr (&Sfceiling); |
| 744 | defsubr (&Sffloor); | 551 | defsubr (&Sffloor); |
| 745 | defsubr (&Sfround); | 552 | defsubr (&Sfround); |