diff options
Diffstat (limited to 'src/floatfns.c')
| -rw-r--r-- | src/floatfns.c | 168 |
1 files changed, 58 insertions, 110 deletions
diff --git a/src/floatfns.c b/src/floatfns.c index 5cd996d033c..4c1548cfd8f 100644 --- a/src/floatfns.c +++ b/src/floatfns.c | |||
| @@ -70,7 +70,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 70 | 70 | ||
| 71 | /* This declaration is omitted on some systems, like Ultrix. */ | 71 | /* This declaration is omitted on some systems, like Ultrix. */ |
| 72 | #if !defined (HPUX) && defined (HAVE_LOGB) && !defined (logb) | 72 | #if !defined (HPUX) && defined (HAVE_LOGB) && !defined (logb) |
| 73 | extern double logb (); | 73 | extern double logb (double); |
| 74 | #endif /* not HPUX and HAVE_LOGB and no logb macro */ | 74 | #endif /* not HPUX and HAVE_LOGB and no logb macro */ |
| 75 | 75 | ||
| 76 | #if defined(DOMAIN) && defined(SING) && defined(OVERFLOW) | 76 | #if defined(DOMAIN) && defined(SING) && defined(OVERFLOW) |
| @@ -192,8 +192,7 @@ static char *float_error_fn_name; | |||
| 192 | /* Extract a Lisp number as a `double', or signal an error. */ | 192 | /* Extract a Lisp number as a `double', or signal an error. */ |
| 193 | 193 | ||
| 194 | double | 194 | double |
| 195 | extract_float (num) | 195 | extract_float (Lisp_Object num) |
| 196 | Lisp_Object num; | ||
| 197 | { | 196 | { |
| 198 | CHECK_NUMBER_OR_FLOAT (num); | 197 | CHECK_NUMBER_OR_FLOAT (num); |
| 199 | 198 | ||
| @@ -206,8 +205,7 @@ extract_float (num) | |||
| 206 | 205 | ||
| 207 | DEFUN ("acos", Facos, Sacos, 1, 1, 0, | 206 | DEFUN ("acos", Facos, Sacos, 1, 1, 0, |
| 208 | doc: /* Return the inverse cosine of ARG. */) | 207 | doc: /* Return the inverse cosine of ARG. */) |
| 209 | (arg) | 208 | (register Lisp_Object arg) |
| 210 | register Lisp_Object arg; | ||
| 211 | { | 209 | { |
| 212 | double d = extract_float (arg); | 210 | double d = extract_float (arg); |
| 213 | #ifdef FLOAT_CHECK_DOMAIN | 211 | #ifdef FLOAT_CHECK_DOMAIN |
| @@ -220,8 +218,7 @@ DEFUN ("acos", Facos, Sacos, 1, 1, 0, | |||
| 220 | 218 | ||
| 221 | DEFUN ("asin", Fasin, Sasin, 1, 1, 0, | 219 | DEFUN ("asin", Fasin, Sasin, 1, 1, 0, |
| 222 | doc: /* Return the inverse sine of ARG. */) | 220 | doc: /* Return the inverse sine of ARG. */) |
| 223 | (arg) | 221 | (register Lisp_Object arg) |
| 224 | register Lisp_Object arg; | ||
| 225 | { | 222 | { |
| 226 | double d = extract_float (arg); | 223 | double d = extract_float (arg); |
| 227 | #ifdef FLOAT_CHECK_DOMAIN | 224 | #ifdef FLOAT_CHECK_DOMAIN |
| @@ -238,8 +235,7 @@ If only one argument Y is given, return the inverse tangent of Y. | |||
| 238 | If two arguments Y and X are given, return the inverse tangent of Y | 235 | If two arguments Y and X are given, return the inverse tangent of Y |
| 239 | divided by X, i.e. the angle in radians between the vector (X, Y) | 236 | divided by X, i.e. the angle in radians between the vector (X, Y) |
| 240 | and the x-axis. */) | 237 | and the x-axis. */) |
| 241 | (y, x) | 238 | (register Lisp_Object y, Lisp_Object x) |
| 242 | register Lisp_Object y, x; | ||
| 243 | { | 239 | { |
| 244 | double d = extract_float (y); | 240 | double d = extract_float (y); |
| 245 | 241 | ||
| @@ -256,8 +252,7 @@ and the x-axis. */) | |||
| 256 | 252 | ||
| 257 | DEFUN ("cos", Fcos, Scos, 1, 1, 0, | 253 | DEFUN ("cos", Fcos, Scos, 1, 1, 0, |
| 258 | doc: /* Return the cosine of ARG. */) | 254 | doc: /* Return the cosine of ARG. */) |
| 259 | (arg) | 255 | (register Lisp_Object arg) |
| 260 | register Lisp_Object arg; | ||
| 261 | { | 256 | { |
| 262 | double d = extract_float (arg); | 257 | double d = extract_float (arg); |
| 263 | IN_FLOAT (d = cos (d), "cos", arg); | 258 | IN_FLOAT (d = cos (d), "cos", arg); |
| @@ -266,8 +261,7 @@ DEFUN ("cos", Fcos, Scos, 1, 1, 0, | |||
| 266 | 261 | ||
| 267 | DEFUN ("sin", Fsin, Ssin, 1, 1, 0, | 262 | DEFUN ("sin", Fsin, Ssin, 1, 1, 0, |
| 268 | doc: /* Return the sine of ARG. */) | 263 | doc: /* Return the sine of ARG. */) |
| 269 | (arg) | 264 | (register Lisp_Object arg) |
| 270 | register Lisp_Object arg; | ||
| 271 | { | 265 | { |
| 272 | double d = extract_float (arg); | 266 | double d = extract_float (arg); |
| 273 | IN_FLOAT (d = sin (d), "sin", arg); | 267 | IN_FLOAT (d = sin (d), "sin", arg); |
| @@ -276,8 +270,7 @@ DEFUN ("sin", Fsin, Ssin, 1, 1, 0, | |||
| 276 | 270 | ||
| 277 | DEFUN ("tan", Ftan, Stan, 1, 1, 0, | 271 | DEFUN ("tan", Ftan, Stan, 1, 1, 0, |
| 278 | doc: /* Return the tangent of ARG. */) | 272 | doc: /* Return the tangent of ARG. */) |
| 279 | (arg) | 273 | (register Lisp_Object arg) |
| 280 | register Lisp_Object arg; | ||
| 281 | { | 274 | { |
| 282 | double d = extract_float (arg); | 275 | double d = extract_float (arg); |
| 283 | double c = cos (d); | 276 | double c = cos (d); |
| @@ -292,8 +285,7 @@ DEFUN ("tan", Ftan, Stan, 1, 1, 0, | |||
| 292 | #if defined HAVE_ISNAN && defined HAVE_COPYSIGN | 285 | #if defined HAVE_ISNAN && defined HAVE_COPYSIGN |
| 293 | DEFUN ("isnan", Fisnan, Sisnan, 1, 1, 0, | 286 | DEFUN ("isnan", Fisnan, Sisnan, 1, 1, 0, |
| 294 | doc: /* Return non nil iff argument X is a NaN. */) | 287 | doc: /* Return non nil iff argument X is a NaN. */) |
| 295 | (x) | 288 | (Lisp_Object x) |
| 296 | Lisp_Object x; | ||
| 297 | { | 289 | { |
| 298 | CHECK_FLOAT (x); | 290 | CHECK_FLOAT (x); |
| 299 | return isnan (XFLOAT_DATA (x)) ? Qt : Qnil; | 291 | return isnan (XFLOAT_DATA (x)) ? Qt : Qnil; |
| @@ -302,8 +294,7 @@ DEFUN ("isnan", Fisnan, Sisnan, 1, 1, 0, | |||
| 302 | DEFUN ("copysign", Fcopysign, Scopysign, 1, 2, 0, | 294 | DEFUN ("copysign", Fcopysign, Scopysign, 1, 2, 0, |
| 303 | doc: /* Copy sign of X2 to value of X1, and return the result. | 295 | doc: /* Copy sign of X2 to value of X1, and return the result. |
| 304 | Cause an error if X1 or X2 is not a float. */) | 296 | Cause an error if X1 or X2 is not a float. */) |
| 305 | (x1, x2) | 297 | (Lisp_Object x1, Lisp_Object x2) |
| 306 | Lisp_Object x1, x2; | ||
| 307 | { | 298 | { |
| 308 | double f1, f2; | 299 | double f1, f2; |
| 309 | 300 | ||
| @@ -326,8 +317,7 @@ and an integral exponent EXP for 2, such that: | |||
| 326 | 317 | ||
| 327 | The function returns the cons cell (SGNFCAND . EXP). | 318 | The function returns the cons cell (SGNFCAND . EXP). |
| 328 | If X is zero, both parts (SGNFCAND and EXP) are zero. */) | 319 | If X is zero, both parts (SGNFCAND and EXP) are zero. */) |
| 329 | (x) | 320 | (Lisp_Object x) |
| 330 | Lisp_Object x; | ||
| 331 | { | 321 | { |
| 332 | double f = XFLOATINT (x); | 322 | double f = XFLOATINT (x); |
| 333 | 323 | ||
| @@ -345,8 +335,7 @@ DEFUN ("ldexp", Fldexp, Sldexp, 1, 2, 0, | |||
| 345 | doc: /* Construct number X from significand SGNFCAND and exponent EXP. | 335 | doc: /* Construct number X from significand SGNFCAND and exponent EXP. |
| 346 | Returns the floating point value resulting from multiplying SGNFCAND | 336 | Returns the floating point value resulting from multiplying SGNFCAND |
| 347 | (the significand) by 2 raised to the power of EXP (the exponent). */) | 337 | (the significand) by 2 raised to the power of EXP (the exponent). */) |
| 348 | (sgnfcand, exp) | 338 | (Lisp_Object sgnfcand, Lisp_Object exp) |
| 349 | Lisp_Object sgnfcand, exp; | ||
| 350 | { | 339 | { |
| 351 | CHECK_NUMBER (exp); | 340 | CHECK_NUMBER (exp); |
| 352 | return make_float (ldexp (XFLOATINT (sgnfcand), XINT (exp))); | 341 | return make_float (ldexp (XFLOATINT (sgnfcand), XINT (exp))); |
| @@ -357,8 +346,7 @@ Returns the floating point value resulting from multiplying SGNFCAND | |||
| 357 | 346 | ||
| 358 | DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0, | 347 | DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0, |
| 359 | doc: /* Return the bessel function j0 of ARG. */) | 348 | doc: /* Return the bessel function j0 of ARG. */) |
| 360 | (arg) | 349 | (register Lisp_Object arg) |
| 361 | register Lisp_Object arg; | ||
| 362 | { | 350 | { |
| 363 | double d = extract_float (arg); | 351 | double d = extract_float (arg); |
| 364 | IN_FLOAT (d = j0 (d), "bessel-j0", arg); | 352 | IN_FLOAT (d = j0 (d), "bessel-j0", arg); |
| @@ -367,8 +355,7 @@ DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0, | |||
| 367 | 355 | ||
| 368 | DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0, | 356 | DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0, |
| 369 | doc: /* Return the bessel function j1 of ARG. */) | 357 | doc: /* Return the bessel function j1 of ARG. */) |
| 370 | (arg) | 358 | (register Lisp_Object arg) |
| 371 | register Lisp_Object arg; | ||
| 372 | { | 359 | { |
| 373 | double d = extract_float (arg); | 360 | double d = extract_float (arg); |
| 374 | IN_FLOAT (d = j1 (d), "bessel-j1", arg); | 361 | IN_FLOAT (d = j1 (d), "bessel-j1", arg); |
| @@ -378,8 +365,7 @@ DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0, | |||
| 378 | DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0, | 365 | DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0, |
| 379 | doc: /* Return the order N bessel function output jn of ARG. | 366 | doc: /* Return the order N bessel function output jn of ARG. |
| 380 | The first arg (the order) is truncated to an integer. */) | 367 | The first arg (the order) is truncated to an integer. */) |
| 381 | (n, arg) | 368 | (register Lisp_Object n, Lisp_Object arg) |
| 382 | register Lisp_Object n, arg; | ||
| 383 | { | 369 | { |
| 384 | int i1 = extract_float (n); | 370 | int i1 = extract_float (n); |
| 385 | double f2 = extract_float (arg); | 371 | double f2 = extract_float (arg); |
| @@ -390,8 +376,7 @@ The first arg (the order) is truncated to an integer. */) | |||
| 390 | 376 | ||
| 391 | DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0, | 377 | DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0, |
| 392 | doc: /* Return the bessel function y0 of ARG. */) | 378 | doc: /* Return the bessel function y0 of ARG. */) |
| 393 | (arg) | 379 | (register Lisp_Object arg) |
| 394 | register Lisp_Object arg; | ||
| 395 | { | 380 | { |
| 396 | double d = extract_float (arg); | 381 | double d = extract_float (arg); |
| 397 | IN_FLOAT (d = y0 (d), "bessel-y0", arg); | 382 | IN_FLOAT (d = y0 (d), "bessel-y0", arg); |
| @@ -400,8 +385,7 @@ DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0, | |||
| 400 | 385 | ||
| 401 | DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0, | 386 | DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0, |
| 402 | doc: /* Return the bessel function y1 of ARG. */) | 387 | doc: /* Return the bessel function y1 of ARG. */) |
| 403 | (arg) | 388 | (register Lisp_Object arg) |
| 404 | register Lisp_Object arg; | ||
| 405 | { | 389 | { |
| 406 | double d = extract_float (arg); | 390 | double d = extract_float (arg); |
| 407 | IN_FLOAT (d = y1 (d), "bessel-y0", arg); | 391 | IN_FLOAT (d = y1 (d), "bessel-y0", arg); |
| @@ -411,8 +395,7 @@ DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0, | |||
| 411 | DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0, | 395 | DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0, |
| 412 | doc: /* Return the order N bessel function output yn of ARG. | 396 | doc: /* Return the order N bessel function output yn of ARG. |
| 413 | The first arg (the order) is truncated to an integer. */) | 397 | The first arg (the order) is truncated to an integer. */) |
| 414 | (n, arg) | 398 | (register Lisp_Object n, Lisp_Object arg) |
| 415 | register Lisp_Object n, arg; | ||
| 416 | { | 399 | { |
| 417 | int i1 = extract_float (n); | 400 | int i1 = extract_float (n); |
| 418 | double f2 = extract_float (arg); | 401 | double f2 = extract_float (arg); |
| @@ -427,8 +410,7 @@ The first arg (the order) is truncated to an integer. */) | |||
| 427 | 410 | ||
| 428 | DEFUN ("erf", Ferf, Serf, 1, 1, 0, | 411 | DEFUN ("erf", Ferf, Serf, 1, 1, 0, |
| 429 | doc: /* Return the mathematical error function of ARG. */) | 412 | doc: /* Return the mathematical error function of ARG. */) |
| 430 | (arg) | 413 | (register Lisp_Object arg) |
| 431 | register Lisp_Object arg; | ||
| 432 | { | 414 | { |
| 433 | double d = extract_float (arg); | 415 | double d = extract_float (arg); |
| 434 | IN_FLOAT (d = erf (d), "erf", arg); | 416 | IN_FLOAT (d = erf (d), "erf", arg); |
| @@ -437,8 +419,7 @@ DEFUN ("erf", Ferf, Serf, 1, 1, 0, | |||
| 437 | 419 | ||
| 438 | DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0, | 420 | DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0, |
| 439 | doc: /* Return the complementary error function of ARG. */) | 421 | doc: /* Return the complementary error function of ARG. */) |
| 440 | (arg) | 422 | (register Lisp_Object arg) |
| 441 | register Lisp_Object arg; | ||
| 442 | { | 423 | { |
| 443 | double d = extract_float (arg); | 424 | double d = extract_float (arg); |
| 444 | IN_FLOAT (d = erfc (d), "erfc", arg); | 425 | IN_FLOAT (d = erfc (d), "erfc", arg); |
| @@ -447,8 +428,7 @@ DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0, | |||
| 447 | 428 | ||
| 448 | DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0, | 429 | DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0, |
| 449 | doc: /* Return the log gamma of ARG. */) | 430 | doc: /* Return the log gamma of ARG. */) |
| 450 | (arg) | 431 | (register Lisp_Object arg) |
| 451 | register Lisp_Object arg; | ||
| 452 | { | 432 | { |
| 453 | double d = extract_float (arg); | 433 | double d = extract_float (arg); |
| 454 | IN_FLOAT (d = lgamma (d), "log-gamma", arg); | 434 | IN_FLOAT (d = lgamma (d), "log-gamma", arg); |
| @@ -457,8 +437,7 @@ DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0, | |||
| 457 | 437 | ||
| 458 | DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0, | 438 | DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0, |
| 459 | doc: /* Return the cube root of ARG. */) | 439 | doc: /* Return the cube root of ARG. */) |
| 460 | (arg) | 440 | (register Lisp_Object arg) |
| 461 | register Lisp_Object arg; | ||
| 462 | { | 441 | { |
| 463 | double d = extract_float (arg); | 442 | double d = extract_float (arg); |
| 464 | #ifdef HAVE_CBRT | 443 | #ifdef HAVE_CBRT |
| @@ -476,8 +455,7 @@ DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0, | |||
| 476 | 455 | ||
| 477 | DEFUN ("exp", Fexp, Sexp, 1, 1, 0, | 456 | DEFUN ("exp", Fexp, Sexp, 1, 1, 0, |
| 478 | doc: /* Return the exponential base e of ARG. */) | 457 | doc: /* Return the exponential base e of ARG. */) |
| 479 | (arg) | 458 | (register Lisp_Object arg) |
| 480 | register Lisp_Object arg; | ||
| 481 | { | 459 | { |
| 482 | double d = extract_float (arg); | 460 | double d = extract_float (arg); |
| 483 | #ifdef FLOAT_CHECK_DOMAIN | 461 | #ifdef FLOAT_CHECK_DOMAIN |
| @@ -493,8 +471,7 @@ DEFUN ("exp", Fexp, Sexp, 1, 1, 0, | |||
| 493 | 471 | ||
| 494 | DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, | 472 | DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, |
| 495 | doc: /* Return the exponential ARG1 ** ARG2. */) | 473 | doc: /* Return the exponential ARG1 ** ARG2. */) |
| 496 | (arg1, arg2) | 474 | (register Lisp_Object arg1, Lisp_Object arg2) |
| 497 | register Lisp_Object arg1, arg2; | ||
| 498 | { | 475 | { |
| 499 | double f1, f2, f3; | 476 | double f1, f2, f3; |
| 500 | 477 | ||
| @@ -552,8 +529,7 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, | |||
| 552 | DEFUN ("log", Flog, Slog, 1, 2, 0, | 529 | DEFUN ("log", Flog, Slog, 1, 2, 0, |
| 553 | doc: /* Return the natural logarithm of ARG. | 530 | doc: /* Return the natural logarithm of ARG. |
| 554 | If the optional argument BASE is given, return log ARG using that base. */) | 531 | If the optional argument BASE is given, return log ARG using that base. */) |
| 555 | (arg, base) | 532 | (register Lisp_Object arg, Lisp_Object base) |
| 556 | register Lisp_Object arg, base; | ||
| 557 | { | 533 | { |
| 558 | double d = extract_float (arg); | 534 | double d = extract_float (arg); |
| 559 | 535 | ||
| @@ -581,8 +557,7 @@ If the optional argument BASE is given, return log ARG using that base. */) | |||
| 581 | 557 | ||
| 582 | DEFUN ("log10", Flog10, Slog10, 1, 1, 0, | 558 | DEFUN ("log10", Flog10, Slog10, 1, 1, 0, |
| 583 | doc: /* Return the logarithm base 10 of ARG. */) | 559 | doc: /* Return the logarithm base 10 of ARG. */) |
| 584 | (arg) | 560 | (register Lisp_Object arg) |
| 585 | register Lisp_Object arg; | ||
| 586 | { | 561 | { |
| 587 | double d = extract_float (arg); | 562 | double d = extract_float (arg); |
| 588 | #ifdef FLOAT_CHECK_DOMAIN | 563 | #ifdef FLOAT_CHECK_DOMAIN |
| @@ -595,8 +570,7 @@ DEFUN ("log10", Flog10, Slog10, 1, 1, 0, | |||
| 595 | 570 | ||
| 596 | DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, | 571 | DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, |
| 597 | doc: /* Return the square root of ARG. */) | 572 | doc: /* Return the square root of ARG. */) |
| 598 | (arg) | 573 | (register Lisp_Object arg) |
| 599 | register Lisp_Object arg; | ||
| 600 | { | 574 | { |
| 601 | double d = extract_float (arg); | 575 | double d = extract_float (arg); |
| 602 | #ifdef FLOAT_CHECK_DOMAIN | 576 | #ifdef FLOAT_CHECK_DOMAIN |
| @@ -611,8 +585,7 @@ DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, | |||
| 611 | 585 | ||
| 612 | DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0, | 586 | DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0, |
| 613 | doc: /* Return the inverse hyperbolic cosine of ARG. */) | 587 | doc: /* Return the inverse hyperbolic cosine of ARG. */) |
| 614 | (arg) | 588 | (register Lisp_Object arg) |
| 615 | register Lisp_Object arg; | ||
| 616 | { | 589 | { |
| 617 | double d = extract_float (arg); | 590 | double d = extract_float (arg); |
| 618 | #ifdef FLOAT_CHECK_DOMAIN | 591 | #ifdef FLOAT_CHECK_DOMAIN |
| @@ -629,8 +602,7 @@ DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0, | |||
| 629 | 602 | ||
| 630 | DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0, | 603 | DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0, |
| 631 | doc: /* Return the inverse hyperbolic sine of ARG. */) | 604 | doc: /* Return the inverse hyperbolic sine of ARG. */) |
| 632 | (arg) | 605 | (register Lisp_Object arg) |
| 633 | register Lisp_Object arg; | ||
| 634 | { | 606 | { |
| 635 | double d = extract_float (arg); | 607 | double d = extract_float (arg); |
| 636 | #ifdef HAVE_INVERSE_HYPERBOLIC | 608 | #ifdef HAVE_INVERSE_HYPERBOLIC |
| @@ -643,8 +615,7 @@ DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0, | |||
| 643 | 615 | ||
| 644 | DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0, | 616 | DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0, |
| 645 | doc: /* Return the inverse hyperbolic tangent of ARG. */) | 617 | doc: /* Return the inverse hyperbolic tangent of ARG. */) |
| 646 | (arg) | 618 | (register Lisp_Object arg) |
| 647 | register Lisp_Object arg; | ||
| 648 | { | 619 | { |
| 649 | double d = extract_float (arg); | 620 | double d = extract_float (arg); |
| 650 | #ifdef FLOAT_CHECK_DOMAIN | 621 | #ifdef FLOAT_CHECK_DOMAIN |
| @@ -661,8 +632,7 @@ DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0, | |||
| 661 | 632 | ||
| 662 | DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0, | 633 | DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0, |
| 663 | doc: /* Return the hyperbolic cosine of ARG. */) | 634 | doc: /* Return the hyperbolic cosine of ARG. */) |
| 664 | (arg) | 635 | (register Lisp_Object arg) |
| 665 | register Lisp_Object arg; | ||
| 666 | { | 636 | { |
| 667 | double d = extract_float (arg); | 637 | double d = extract_float (arg); |
| 668 | #ifdef FLOAT_CHECK_DOMAIN | 638 | #ifdef FLOAT_CHECK_DOMAIN |
| @@ -675,8 +645,7 @@ DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0, | |||
| 675 | 645 | ||
| 676 | DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0, | 646 | DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0, |
| 677 | doc: /* Return the hyperbolic sine of ARG. */) | 647 | doc: /* Return the hyperbolic sine of ARG. */) |
| 678 | (arg) | 648 | (register Lisp_Object arg) |
| 679 | register Lisp_Object arg; | ||
| 680 | { | 649 | { |
| 681 | double d = extract_float (arg); | 650 | double d = extract_float (arg); |
| 682 | #ifdef FLOAT_CHECK_DOMAIN | 651 | #ifdef FLOAT_CHECK_DOMAIN |
| @@ -689,8 +658,7 @@ DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0, | |||
| 689 | 658 | ||
| 690 | DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0, | 659 | DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0, |
| 691 | doc: /* Return the hyperbolic tangent of ARG. */) | 660 | doc: /* Return the hyperbolic tangent of ARG. */) |
| 692 | (arg) | 661 | (register Lisp_Object arg) |
| 693 | register Lisp_Object arg; | ||
| 694 | { | 662 | { |
| 695 | double d = extract_float (arg); | 663 | double d = extract_float (arg); |
| 696 | IN_FLOAT (d = tanh (d), "tanh", arg); | 664 | IN_FLOAT (d = tanh (d), "tanh", arg); |
| @@ -700,8 +668,7 @@ DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0, | |||
| 700 | 668 | ||
| 701 | DEFUN ("abs", Fabs, Sabs, 1, 1, 0, | 669 | DEFUN ("abs", Fabs, Sabs, 1, 1, 0, |
| 702 | doc: /* Return the absolute value of ARG. */) | 670 | doc: /* Return the absolute value of ARG. */) |
| 703 | (arg) | 671 | (register Lisp_Object arg) |
| 704 | register Lisp_Object arg; | ||
| 705 | { | 672 | { |
| 706 | CHECK_NUMBER_OR_FLOAT (arg); | 673 | CHECK_NUMBER_OR_FLOAT (arg); |
| 707 | 674 | ||
| @@ -715,8 +682,7 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0, | |||
| 715 | 682 | ||
| 716 | DEFUN ("float", Ffloat, Sfloat, 1, 1, 0, | 683 | DEFUN ("float", Ffloat, Sfloat, 1, 1, 0, |
| 717 | doc: /* Return the floating point number equal to ARG. */) | 684 | doc: /* Return the floating point number equal to ARG. */) |
| 718 | (arg) | 685 | (register Lisp_Object arg) |
| 719 | register Lisp_Object arg; | ||
| 720 | { | 686 | { |
| 721 | CHECK_NUMBER_OR_FLOAT (arg); | 687 | CHECK_NUMBER_OR_FLOAT (arg); |
| 722 | 688 | ||
| @@ -729,8 +695,7 @@ DEFUN ("float", Ffloat, Sfloat, 1, 1, 0, | |||
| 729 | DEFUN ("logb", Flogb, Slogb, 1, 1, 0, | 695 | DEFUN ("logb", Flogb, Slogb, 1, 1, 0, |
| 730 | doc: /* Returns largest integer <= the base 2 log of the magnitude of ARG. | 696 | doc: /* Returns largest integer <= the base 2 log of the magnitude of ARG. |
| 731 | This is the same as the exponent of a float. */) | 697 | This is the same as the exponent of a float. */) |
| 732 | (arg) | 698 | (Lisp_Object arg) |
| 733 | Lisp_Object arg; | ||
| 734 | { | 699 | { |
| 735 | Lisp_Object val; | 700 | Lisp_Object val; |
| 736 | EMACS_INT value; | 701 | EMACS_INT value; |
| @@ -778,11 +743,10 @@ This is the same as the exponent of a float. */) | |||
| 778 | /* the rounding functions */ | 743 | /* the rounding functions */ |
| 779 | 744 | ||
| 780 | static Lisp_Object | 745 | static Lisp_Object |
| 781 | rounding_driver (arg, divisor, double_round, int_round2, name) | 746 | rounding_driver (Lisp_Object arg, Lisp_Object divisor, |
| 782 | register Lisp_Object arg, divisor; | 747 | double (*double_round) (double), |
| 783 | double (*double_round) (); | 748 | EMACS_INT (*int_round2) (EMACS_INT, EMACS_INT), |
| 784 | EMACS_INT (*int_round2) (); | 749 | char *name) |
| 785 | char *name; | ||
| 786 | { | 750 | { |
| 787 | CHECK_NUMBER_OR_FLOAT (arg); | 751 | CHECK_NUMBER_OR_FLOAT (arg); |
| 788 | 752 | ||
| @@ -832,8 +796,7 @@ rounding_driver (arg, divisor, double_round, int_round2, name) | |||
| 832 | integer functions. */ | 796 | integer functions. */ |
| 833 | 797 | ||
| 834 | static EMACS_INT | 798 | static EMACS_INT |
| 835 | ceiling2 (i1, i2) | 799 | ceiling2 (EMACS_INT i1, EMACS_INT i2) |
| 836 | EMACS_INT i1, i2; | ||
| 837 | { | 800 | { |
| 838 | return (i2 < 0 | 801 | return (i2 < 0 |
| 839 | ? (i1 < 0 ? ((-1 - i1) / -i2) + 1 : - (i1 / -i2)) | 802 | ? (i1 < 0 ? ((-1 - i1) / -i2) + 1 : - (i1 / -i2)) |
| @@ -841,8 +804,7 @@ ceiling2 (i1, i2) | |||
| 841 | } | 804 | } |
| 842 | 805 | ||
| 843 | static EMACS_INT | 806 | static EMACS_INT |
| 844 | floor2 (i1, i2) | 807 | floor2 (EMACS_INT i1, EMACS_INT i2) |
| 845 | EMACS_INT i1, i2; | ||
| 846 | { | 808 | { |
| 847 | return (i2 < 0 | 809 | return (i2 < 0 |
| 848 | ? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2)) | 810 | ? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2)) |
| @@ -850,8 +812,7 @@ floor2 (i1, i2) | |||
| 850 | } | 812 | } |
| 851 | 813 | ||
| 852 | static EMACS_INT | 814 | static EMACS_INT |
| 853 | truncate2 (i1, i2) | 815 | truncate2 (EMACS_INT i1, EMACS_INT i2) |
| 854 | EMACS_INT i1, i2; | ||
| 855 | { | 816 | { |
| 856 | return (i2 < 0 | 817 | return (i2 < 0 |
| 857 | ? (i1 < 0 ? -i1 / -i2 : - (i1 / -i2)) | 818 | ? (i1 < 0 ? -i1 / -i2 : - (i1 / -i2)) |
| @@ -859,8 +820,7 @@ truncate2 (i1, i2) | |||
| 859 | } | 820 | } |
| 860 | 821 | ||
| 861 | static EMACS_INT | 822 | static EMACS_INT |
| 862 | round2 (i1, i2) | 823 | round2 (EMACS_INT i1, EMACS_INT i2) |
| 863 | EMACS_INT i1, i2; | ||
| 864 | { | 824 | { |
| 865 | /* The C language's division operator gives us one remainder R, but | 825 | /* The C language's division operator gives us one remainder R, but |
| 866 | we want the remainder R1 on the other side of 0 if R1 is closer | 826 | we want the remainder R1 on the other side of 0 if R1 is closer |
| @@ -880,16 +840,14 @@ round2 (i1, i2) | |||
| 880 | #define emacs_rint rint | 840 | #define emacs_rint rint |
| 881 | #else | 841 | #else |
| 882 | static double | 842 | static double |
| 883 | emacs_rint (d) | 843 | emacs_rint (double d) |
| 884 | double d; | ||
| 885 | { | 844 | { |
| 886 | return floor (d + 0.5); | 845 | return floor (d + 0.5); |
| 887 | } | 846 | } |
| 888 | #endif | 847 | #endif |
| 889 | 848 | ||
| 890 | static double | 849 | static double |
| 891 | double_identity (d) | 850 | double_identity (double d) |
| 892 | double d; | ||
| 893 | { | 851 | { |
| 894 | return d; | 852 | return d; |
| 895 | } | 853 | } |
| @@ -898,8 +856,7 @@ DEFUN ("ceiling", Fceiling, Sceiling, 1, 2, 0, | |||
| 898 | doc: /* Return the smallest integer no less than ARG. | 856 | doc: /* Return the smallest integer no less than ARG. |
| 899 | This rounds the value towards +inf. | 857 | This rounds the value towards +inf. |
| 900 | With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR. */) | 858 | With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR. */) |
| 901 | (arg, divisor) | 859 | (Lisp_Object arg, Lisp_Object divisor) |
| 902 | Lisp_Object arg, divisor; | ||
| 903 | { | 860 | { |
| 904 | return rounding_driver (arg, divisor, ceil, ceiling2, "ceiling"); | 861 | return rounding_driver (arg, divisor, ceil, ceiling2, "ceiling"); |
| 905 | } | 862 | } |
| @@ -908,8 +865,7 @@ DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0, | |||
| 908 | doc: /* Return the largest integer no greater than ARG. | 865 | doc: /* Return the largest integer no greater than ARG. |
| 909 | This rounds the value towards -inf. | 866 | This rounds the value towards -inf. |
| 910 | With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. */) | 867 | With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. */) |
| 911 | (arg, divisor) | 868 | (Lisp_Object arg, Lisp_Object divisor) |
| 912 | Lisp_Object arg, divisor; | ||
| 913 | { | 869 | { |
| 914 | return rounding_driver (arg, divisor, floor, floor2, "floor"); | 870 | return rounding_driver (arg, divisor, floor, floor2, "floor"); |
| 915 | } | 871 | } |
| @@ -922,8 +878,7 @@ Rounding a value equidistant between two integers may choose the | |||
| 922 | integer closer to zero, or it may prefer an even integer, depending on | 878 | integer closer to zero, or it may prefer an even integer, depending on |
| 923 | your machine. For example, \(round 2.5\) can return 3 on some | 879 | your machine. For example, \(round 2.5\) can return 3 on some |
| 924 | systems, but 2 on others. */) | 880 | systems, but 2 on others. */) |
| 925 | (arg, divisor) | 881 | (Lisp_Object arg, Lisp_Object divisor) |
| 926 | Lisp_Object arg, divisor; | ||
| 927 | { | 882 | { |
| 928 | return rounding_driver (arg, divisor, emacs_rint, round2, "round"); | 883 | return rounding_driver (arg, divisor, emacs_rint, round2, "round"); |
| 929 | } | 884 | } |
| @@ -932,8 +887,7 @@ DEFUN ("truncate", Ftruncate, Struncate, 1, 2, 0, | |||
| 932 | doc: /* Truncate a floating point number to an int. | 887 | doc: /* Truncate a floating point number to an int. |
| 933 | Rounds ARG toward zero. | 888 | Rounds ARG toward zero. |
| 934 | With optional DIVISOR, truncate ARG/DIVISOR. */) | 889 | With optional DIVISOR, truncate ARG/DIVISOR. */) |
| 935 | (arg, divisor) | 890 | (Lisp_Object arg, Lisp_Object divisor) |
| 936 | Lisp_Object arg, divisor; | ||
| 937 | { | 891 | { |
| 938 | return rounding_driver (arg, divisor, double_identity, truncate2, | 892 | return rounding_driver (arg, divisor, double_identity, truncate2, |
| 939 | "truncate"); | 893 | "truncate"); |
| @@ -941,8 +895,7 @@ With optional DIVISOR, truncate ARG/DIVISOR. */) | |||
| 941 | 895 | ||
| 942 | 896 | ||
| 943 | Lisp_Object | 897 | Lisp_Object |
| 944 | fmod_float (x, y) | 898 | fmod_float (Lisp_Object x, Lisp_Object y) |
| 945 | register Lisp_Object x, y; | ||
| 946 | { | 899 | { |
| 947 | double f1, f2; | 900 | double f1, f2; |
| 948 | 901 | ||
| @@ -964,8 +917,7 @@ fmod_float (x, y) | |||
| 964 | DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0, | 917 | DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0, |
| 965 | doc: /* Return the smallest integer no less than ARG, as a float. | 918 | doc: /* Return the smallest integer no less than ARG, as a float. |
| 966 | \(Round toward +inf.\) */) | 919 | \(Round toward +inf.\) */) |
| 967 | (arg) | 920 | (register Lisp_Object arg) |
| 968 | register Lisp_Object arg; | ||
| 969 | { | 921 | { |
| 970 | double d = extract_float (arg); | 922 | double d = extract_float (arg); |
| 971 | IN_FLOAT (d = ceil (d), "fceiling", arg); | 923 | IN_FLOAT (d = ceil (d), "fceiling", arg); |
| @@ -975,8 +927,7 @@ DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0, | |||
| 975 | DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0, | 927 | DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0, |
| 976 | doc: /* Return the largest integer no greater than ARG, as a float. | 928 | doc: /* Return the largest integer no greater than ARG, as a float. |
| 977 | \(Round towards -inf.\) */) | 929 | \(Round towards -inf.\) */) |
| 978 | (arg) | 930 | (register Lisp_Object arg) |
| 979 | register Lisp_Object arg; | ||
| 980 | { | 931 | { |
| 981 | double d = extract_float (arg); | 932 | double d = extract_float (arg); |
| 982 | IN_FLOAT (d = floor (d), "ffloor", arg); | 933 | IN_FLOAT (d = floor (d), "ffloor", arg); |
| @@ -985,8 +936,7 @@ DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0, | |||
| 985 | 936 | ||
| 986 | DEFUN ("fround", Ffround, Sfround, 1, 1, 0, | 937 | DEFUN ("fround", Ffround, Sfround, 1, 1, 0, |
| 987 | doc: /* Return the nearest integer to ARG, as a float. */) | 938 | doc: /* Return the nearest integer to ARG, as a float. */) |
| 988 | (arg) | 939 | (register Lisp_Object arg) |
| 989 | register Lisp_Object arg; | ||
| 990 | { | 940 | { |
| 991 | double d = extract_float (arg); | 941 | double d = extract_float (arg); |
| 992 | IN_FLOAT (d = emacs_rint (d), "fround", arg); | 942 | IN_FLOAT (d = emacs_rint (d), "fround", arg); |
| @@ -996,8 +946,7 @@ DEFUN ("fround", Ffround, Sfround, 1, 1, 0, | |||
| 996 | DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0, | 946 | DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0, |
| 997 | doc: /* Truncate a floating point number to an integral float value. | 947 | doc: /* Truncate a floating point number to an integral float value. |
| 998 | Rounds the value toward zero. */) | 948 | Rounds the value toward zero. */) |
| 999 | (arg) | 949 | (register Lisp_Object arg) |
| 1000 | register Lisp_Object arg; | ||
| 1001 | { | 950 | { |
| 1002 | double d = extract_float (arg); | 951 | double d = extract_float (arg); |
| 1003 | if (d >= 0.0) | 952 | if (d >= 0.0) |
| @@ -1035,8 +984,7 @@ float_error (signo) | |||
| 1035 | 984 | ||
| 1036 | #ifdef HAVE_MATHERR | 985 | #ifdef HAVE_MATHERR |
| 1037 | int | 986 | int |
| 1038 | matherr (x) | 987 | matherr (struct exception *x) |
| 1039 | struct exception *x; | ||
| 1040 | { | 988 | { |
| 1041 | Lisp_Object args; | 989 | Lisp_Object args; |
| 1042 | if (! in_float) | 990 | if (! in_float) |
| @@ -1064,7 +1012,7 @@ matherr (x) | |||
| 1064 | #endif /* HAVE_MATHERR */ | 1012 | #endif /* HAVE_MATHERR */ |
| 1065 | 1013 | ||
| 1066 | void | 1014 | void |
| 1067 | init_floatfns () | 1015 | init_floatfns (void) |
| 1068 | { | 1016 | { |
| 1069 | #ifdef FLOAT_CATCH_SIGILL | 1017 | #ifdef FLOAT_CATCH_SIGILL |
| 1070 | signal (SIGILL, float_error); | 1018 | signal (SIGILL, float_error); |
| @@ -1073,7 +1021,7 @@ init_floatfns () | |||
| 1073 | } | 1021 | } |
| 1074 | 1022 | ||
| 1075 | void | 1023 | void |
| 1076 | syms_of_floatfns () | 1024 | syms_of_floatfns (void) |
| 1077 | { | 1025 | { |
| 1078 | defsubr (&Sacos); | 1026 | defsubr (&Sacos); |
| 1079 | defsubr (&Sasin); | 1027 | defsubr (&Sasin); |