Mercurial > emacs
comparison src/floatfns.c @ 109179:8cfee7d2955f
Convert DEFUNs to standard C.
* src/alloc.c: Convert DEFUNs to standard C.
* src/buffer.c:
* src/bytecode.c:
* src/callint.c:
* src/callproc.c:
* src/casefiddle.c:
* src/casetab.c:
* src/category.c:
* src/character.c:
* src/charset.c:
* src/chartab.c:
* src/cmds.c:
* src/coding.c:
* src/composite.c:
* src/data.c:
* src/dbusbind.c:
* src/dired.c:
* src/dispnew.c:
* src/doc.c:
* src/dosfns.c:
* src/editfns.c:
* src/emacs.c:
* src/eval.c:
* src/fileio.c:
* src/filelock.c:
* src/floatfns.c:
* src/fns.c:
* src/font.c:
* src/fontset.c:
* src/frame.c:
* src/fringe.c:
* src/image.c:
* src/indent.c:
* src/insdel.c:
* src/keyboard.c:
* src/keymap.c:
* src/lread.c:
* src/macros.c:
* src/marker.c:
* src/menu.c:
* src/minibuf.c:
* src/msdos.c:
* src/nsfns.m:
* src/nsmenu.m:
* src/nsselect.m:
* src/print.c:
* src/process.c:
* src/search.c:
* src/sound.c:
* src/syntax.c:
* src/term.c:
* src/terminal.c:
* src/textprop.c:
* src/undo.c:
* src/w16select.c:
* src/w32console.c:
* src/w32fns.c:
* src/w32font.c:
* src/w32menu.c:
* src/w32proc.c:
* src/w32select.c:
* src/window.c:
* src/xdisp.c:
* src/xfaces.c:
* src/xfns.c:
* src/xmenu.c:
* src/xselect.c:
* src/xsettings.c:
* src/xsmfns.c: Likewise.
| author | Dan Nicolaescu <dann@ics.uci.edu> |
|---|---|
| date | Thu, 08 Jul 2010 14:25:08 -0700 |
| parents | d0090a8b66c3 |
| children | 89a16701cde1 |
comparison
equal
deleted
inserted
replaced
| 109178:53f8ebcd9a97 | 109179:8cfee7d2955f |
|---|---|
| 204 | 204 |
| 205 /* Trig functions. */ | 205 /* Trig functions. */ |
| 206 | 206 |
| 207 DEFUN ("acos", Facos, Sacos, 1, 1, 0, | 207 DEFUN ("acos", Facos, Sacos, 1, 1, 0, |
| 208 doc: /* Return the inverse cosine of ARG. */) | 208 doc: /* Return the inverse cosine of ARG. */) |
| 209 (arg) | 209 (register Lisp_Object arg) |
| 210 register Lisp_Object arg; | |
| 211 { | 210 { |
| 212 double d = extract_float (arg); | 211 double d = extract_float (arg); |
| 213 #ifdef FLOAT_CHECK_DOMAIN | 212 #ifdef FLOAT_CHECK_DOMAIN |
| 214 if (d > 1.0 || d < -1.0) | 213 if (d > 1.0 || d < -1.0) |
| 215 domain_error ("acos", arg); | 214 domain_error ("acos", arg); |
| 218 return make_float (d); | 217 return make_float (d); |
| 219 } | 218 } |
| 220 | 219 |
| 221 DEFUN ("asin", Fasin, Sasin, 1, 1, 0, | 220 DEFUN ("asin", Fasin, Sasin, 1, 1, 0, |
| 222 doc: /* Return the inverse sine of ARG. */) | 221 doc: /* Return the inverse sine of ARG. */) |
| 223 (arg) | 222 (register Lisp_Object arg) |
| 224 register Lisp_Object arg; | |
| 225 { | 223 { |
| 226 double d = extract_float (arg); | 224 double d = extract_float (arg); |
| 227 #ifdef FLOAT_CHECK_DOMAIN | 225 #ifdef FLOAT_CHECK_DOMAIN |
| 228 if (d > 1.0 || d < -1.0) | 226 if (d > 1.0 || d < -1.0) |
| 229 domain_error ("asin", arg); | 227 domain_error ("asin", arg); |
| 236 doc: /* Return the inverse tangent of the arguments. | 234 doc: /* Return the inverse tangent of the arguments. |
| 237 If only one argument Y is given, return the inverse tangent of Y. | 235 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 | 236 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) | 237 divided by X, i.e. the angle in radians between the vector (X, Y) |
| 240 and the x-axis. */) | 238 and the x-axis. */) |
| 241 (y, x) | 239 (register Lisp_Object y, Lisp_Object x) |
| 242 register Lisp_Object y, x; | |
| 243 { | 240 { |
| 244 double d = extract_float (y); | 241 double d = extract_float (y); |
| 245 | 242 |
| 246 if (NILP (x)) | 243 if (NILP (x)) |
| 247 IN_FLOAT (d = atan (d), "atan", y); | 244 IN_FLOAT (d = atan (d), "atan", y); |
| 254 return make_float (d); | 251 return make_float (d); |
| 255 } | 252 } |
| 256 | 253 |
| 257 DEFUN ("cos", Fcos, Scos, 1, 1, 0, | 254 DEFUN ("cos", Fcos, Scos, 1, 1, 0, |
| 258 doc: /* Return the cosine of ARG. */) | 255 doc: /* Return the cosine of ARG. */) |
| 259 (arg) | 256 (register Lisp_Object arg) |
| 260 register Lisp_Object arg; | |
| 261 { | 257 { |
| 262 double d = extract_float (arg); | 258 double d = extract_float (arg); |
| 263 IN_FLOAT (d = cos (d), "cos", arg); | 259 IN_FLOAT (d = cos (d), "cos", arg); |
| 264 return make_float (d); | 260 return make_float (d); |
| 265 } | 261 } |
| 266 | 262 |
| 267 DEFUN ("sin", Fsin, Ssin, 1, 1, 0, | 263 DEFUN ("sin", Fsin, Ssin, 1, 1, 0, |
| 268 doc: /* Return the sine of ARG. */) | 264 doc: /* Return the sine of ARG. */) |
| 269 (arg) | 265 (register Lisp_Object arg) |
| 270 register Lisp_Object arg; | |
| 271 { | 266 { |
| 272 double d = extract_float (arg); | 267 double d = extract_float (arg); |
| 273 IN_FLOAT (d = sin (d), "sin", arg); | 268 IN_FLOAT (d = sin (d), "sin", arg); |
| 274 return make_float (d); | 269 return make_float (d); |
| 275 } | 270 } |
| 276 | 271 |
| 277 DEFUN ("tan", Ftan, Stan, 1, 1, 0, | 272 DEFUN ("tan", Ftan, Stan, 1, 1, 0, |
| 278 doc: /* Return the tangent of ARG. */) | 273 doc: /* Return the tangent of ARG. */) |
| 279 (arg) | 274 (register Lisp_Object arg) |
| 280 register Lisp_Object arg; | |
| 281 { | 275 { |
| 282 double d = extract_float (arg); | 276 double d = extract_float (arg); |
| 283 double c = cos (d); | 277 double c = cos (d); |
| 284 #ifdef FLOAT_CHECK_DOMAIN | 278 #ifdef FLOAT_CHECK_DOMAIN |
| 285 if (c == 0.0) | 279 if (c == 0.0) |
| 290 } | 284 } |
| 291 | 285 |
| 292 #if defined HAVE_ISNAN && defined HAVE_COPYSIGN | 286 #if defined HAVE_ISNAN && defined HAVE_COPYSIGN |
| 293 DEFUN ("isnan", Fisnan, Sisnan, 1, 1, 0, | 287 DEFUN ("isnan", Fisnan, Sisnan, 1, 1, 0, |
| 294 doc: /* Return non nil iff argument X is a NaN. */) | 288 doc: /* Return non nil iff argument X is a NaN. */) |
| 295 (x) | 289 (Lisp_Object x) |
| 296 Lisp_Object x; | |
| 297 { | 290 { |
| 298 CHECK_FLOAT (x); | 291 CHECK_FLOAT (x); |
| 299 return isnan (XFLOAT_DATA (x)) ? Qt : Qnil; | 292 return isnan (XFLOAT_DATA (x)) ? Qt : Qnil; |
| 300 } | 293 } |
| 301 | 294 |
| 302 DEFUN ("copysign", Fcopysign, Scopysign, 1, 2, 0, | 295 DEFUN ("copysign", Fcopysign, Scopysign, 1, 2, 0, |
| 303 doc: /* Copy sign of X2 to value of X1, and return the result. | 296 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. */) | 297 Cause an error if X1 or X2 is not a float. */) |
| 305 (x1, x2) | 298 (Lisp_Object x1, Lisp_Object x2) |
| 306 Lisp_Object x1, x2; | |
| 307 { | 299 { |
| 308 double f1, f2; | 300 double f1, f2; |
| 309 | 301 |
| 310 CHECK_FLOAT (x1); | 302 CHECK_FLOAT (x1); |
| 311 CHECK_FLOAT (x2); | 303 CHECK_FLOAT (x2); |
| 324 | 316 |
| 325 X = SGNFCAND * 2^EXP | 317 X = SGNFCAND * 2^EXP |
| 326 | 318 |
| 327 The function returns the cons cell (SGNFCAND . EXP). | 319 The function returns the cons cell (SGNFCAND . EXP). |
| 328 If X is zero, both parts (SGNFCAND and EXP) are zero. */) | 320 If X is zero, both parts (SGNFCAND and EXP) are zero. */) |
| 329 (x) | 321 (Lisp_Object x) |
| 330 Lisp_Object x; | |
| 331 { | 322 { |
| 332 double f = XFLOATINT (x); | 323 double f = XFLOATINT (x); |
| 333 | 324 |
| 334 if (f == 0.0) | 325 if (f == 0.0) |
| 335 return Fcons (make_float (0.0), make_number (0)); | 326 return Fcons (make_float (0.0), make_number (0)); |
| 343 | 334 |
| 344 DEFUN ("ldexp", Fldexp, Sldexp, 1, 2, 0, | 335 DEFUN ("ldexp", Fldexp, Sldexp, 1, 2, 0, |
| 345 doc: /* Construct number X from significand SGNFCAND and exponent EXP. | 336 doc: /* Construct number X from significand SGNFCAND and exponent EXP. |
| 346 Returns the floating point value resulting from multiplying SGNFCAND | 337 Returns the floating point value resulting from multiplying SGNFCAND |
| 347 (the significand) by 2 raised to the power of EXP (the exponent). */) | 338 (the significand) by 2 raised to the power of EXP (the exponent). */) |
| 348 (sgnfcand, exp) | 339 (Lisp_Object sgnfcand, Lisp_Object exp) |
| 349 Lisp_Object sgnfcand, exp; | |
| 350 { | 340 { |
| 351 CHECK_NUMBER (exp); | 341 CHECK_NUMBER (exp); |
| 352 return make_float (ldexp (XFLOATINT (sgnfcand), XINT (exp))); | 342 return make_float (ldexp (XFLOATINT (sgnfcand), XINT (exp))); |
| 353 } | 343 } |
| 354 #endif | 344 #endif |
| 355 | 345 |
| 356 #if 0 /* Leave these out unless we find there's a reason for them. */ | 346 #if 0 /* Leave these out unless we find there's a reason for them. */ |
| 357 | 347 |
| 358 DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0, | 348 DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0, |
| 359 doc: /* Return the bessel function j0 of ARG. */) | 349 doc: /* Return the bessel function j0 of ARG. */) |
| 360 (arg) | 350 (register Lisp_Object arg) |
| 361 register Lisp_Object arg; | |
| 362 { | 351 { |
| 363 double d = extract_float (arg); | 352 double d = extract_float (arg); |
| 364 IN_FLOAT (d = j0 (d), "bessel-j0", arg); | 353 IN_FLOAT (d = j0 (d), "bessel-j0", arg); |
| 365 return make_float (d); | 354 return make_float (d); |
| 366 } | 355 } |
| 367 | 356 |
| 368 DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0, | 357 DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0, |
| 369 doc: /* Return the bessel function j1 of ARG. */) | 358 doc: /* Return the bessel function j1 of ARG. */) |
| 370 (arg) | 359 (register Lisp_Object arg) |
| 371 register Lisp_Object arg; | |
| 372 { | 360 { |
| 373 double d = extract_float (arg); | 361 double d = extract_float (arg); |
| 374 IN_FLOAT (d = j1 (d), "bessel-j1", arg); | 362 IN_FLOAT (d = j1 (d), "bessel-j1", arg); |
| 375 return make_float (d); | 363 return make_float (d); |
| 376 } | 364 } |
| 377 | 365 |
| 378 DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0, | 366 DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0, |
| 379 doc: /* Return the order N bessel function output jn of ARG. | 367 doc: /* Return the order N bessel function output jn of ARG. |
| 380 The first arg (the order) is truncated to an integer. */) | 368 The first arg (the order) is truncated to an integer. */) |
| 381 (n, arg) | 369 (register Lisp_Object n, Lisp_Object arg) |
| 382 register Lisp_Object n, arg; | |
| 383 { | 370 { |
| 384 int i1 = extract_float (n); | 371 int i1 = extract_float (n); |
| 385 double f2 = extract_float (arg); | 372 double f2 = extract_float (arg); |
| 386 | 373 |
| 387 IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", n); | 374 IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", n); |
| 388 return make_float (f2); | 375 return make_float (f2); |
| 389 } | 376 } |
| 390 | 377 |
| 391 DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0, | 378 DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0, |
| 392 doc: /* Return the bessel function y0 of ARG. */) | 379 doc: /* Return the bessel function y0 of ARG. */) |
| 393 (arg) | 380 (register Lisp_Object arg) |
| 394 register Lisp_Object arg; | |
| 395 { | 381 { |
| 396 double d = extract_float (arg); | 382 double d = extract_float (arg); |
| 397 IN_FLOAT (d = y0 (d), "bessel-y0", arg); | 383 IN_FLOAT (d = y0 (d), "bessel-y0", arg); |
| 398 return make_float (d); | 384 return make_float (d); |
| 399 } | 385 } |
| 400 | 386 |
| 401 DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0, | 387 DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0, |
| 402 doc: /* Return the bessel function y1 of ARG. */) | 388 doc: /* Return the bessel function y1 of ARG. */) |
| 403 (arg) | 389 (register Lisp_Object arg) |
| 404 register Lisp_Object arg; | |
| 405 { | 390 { |
| 406 double d = extract_float (arg); | 391 double d = extract_float (arg); |
| 407 IN_FLOAT (d = y1 (d), "bessel-y0", arg); | 392 IN_FLOAT (d = y1 (d), "bessel-y0", arg); |
| 408 return make_float (d); | 393 return make_float (d); |
| 409 } | 394 } |
| 410 | 395 |
| 411 DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0, | 396 DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0, |
| 412 doc: /* Return the order N bessel function output yn of ARG. | 397 doc: /* Return the order N bessel function output yn of ARG. |
| 413 The first arg (the order) is truncated to an integer. */) | 398 The first arg (the order) is truncated to an integer. */) |
| 414 (n, arg) | 399 (register Lisp_Object n, Lisp_Object arg) |
| 415 register Lisp_Object n, arg; | |
| 416 { | 400 { |
| 417 int i1 = extract_float (n); | 401 int i1 = extract_float (n); |
| 418 double f2 = extract_float (arg); | 402 double f2 = extract_float (arg); |
| 419 | 403 |
| 420 IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", n); | 404 IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", n); |
| 425 | 409 |
| 426 #if 0 /* Leave these out unless we see they are worth having. */ | 410 #if 0 /* Leave these out unless we see they are worth having. */ |
| 427 | 411 |
| 428 DEFUN ("erf", Ferf, Serf, 1, 1, 0, | 412 DEFUN ("erf", Ferf, Serf, 1, 1, 0, |
| 429 doc: /* Return the mathematical error function of ARG. */) | 413 doc: /* Return the mathematical error function of ARG. */) |
| 430 (arg) | 414 (register Lisp_Object arg) |
| 431 register Lisp_Object arg; | |
| 432 { | 415 { |
| 433 double d = extract_float (arg); | 416 double d = extract_float (arg); |
| 434 IN_FLOAT (d = erf (d), "erf", arg); | 417 IN_FLOAT (d = erf (d), "erf", arg); |
| 435 return make_float (d); | 418 return make_float (d); |
| 436 } | 419 } |
| 437 | 420 |
| 438 DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0, | 421 DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0, |
| 439 doc: /* Return the complementary error function of ARG. */) | 422 doc: /* Return the complementary error function of ARG. */) |
| 440 (arg) | 423 (register Lisp_Object arg) |
| 441 register Lisp_Object arg; | |
| 442 { | 424 { |
| 443 double d = extract_float (arg); | 425 double d = extract_float (arg); |
| 444 IN_FLOAT (d = erfc (d), "erfc", arg); | 426 IN_FLOAT (d = erfc (d), "erfc", arg); |
| 445 return make_float (d); | 427 return make_float (d); |
| 446 } | 428 } |
| 447 | 429 |
| 448 DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0, | 430 DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0, |
| 449 doc: /* Return the log gamma of ARG. */) | 431 doc: /* Return the log gamma of ARG. */) |
| 450 (arg) | 432 (register Lisp_Object arg) |
| 451 register Lisp_Object arg; | |
| 452 { | 433 { |
| 453 double d = extract_float (arg); | 434 double d = extract_float (arg); |
| 454 IN_FLOAT (d = lgamma (d), "log-gamma", arg); | 435 IN_FLOAT (d = lgamma (d), "log-gamma", arg); |
| 455 return make_float (d); | 436 return make_float (d); |
| 456 } | 437 } |
| 457 | 438 |
| 458 DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0, | 439 DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0, |
| 459 doc: /* Return the cube root of ARG. */) | 440 doc: /* Return the cube root of ARG. */) |
| 460 (arg) | 441 (register Lisp_Object arg) |
| 461 register Lisp_Object arg; | |
| 462 { | 442 { |
| 463 double d = extract_float (arg); | 443 double d = extract_float (arg); |
| 464 #ifdef HAVE_CBRT | 444 #ifdef HAVE_CBRT |
| 465 IN_FLOAT (d = cbrt (d), "cube-root", arg); | 445 IN_FLOAT (d = cbrt (d), "cube-root", arg); |
| 466 #else | 446 #else |
| 474 | 454 |
| 475 #endif | 455 #endif |
| 476 | 456 |
| 477 DEFUN ("exp", Fexp, Sexp, 1, 1, 0, | 457 DEFUN ("exp", Fexp, Sexp, 1, 1, 0, |
| 478 doc: /* Return the exponential base e of ARG. */) | 458 doc: /* Return the exponential base e of ARG. */) |
| 479 (arg) | 459 (register Lisp_Object arg) |
| 480 register Lisp_Object arg; | |
| 481 { | 460 { |
| 482 double d = extract_float (arg); | 461 double d = extract_float (arg); |
| 483 #ifdef FLOAT_CHECK_DOMAIN | 462 #ifdef FLOAT_CHECK_DOMAIN |
| 484 if (d > 709.7827) /* Assume IEEE doubles here */ | 463 if (d > 709.7827) /* Assume IEEE doubles here */ |
| 485 range_error ("exp", arg); | 464 range_error ("exp", arg); |
| 491 return make_float (d); | 470 return make_float (d); |
| 492 } | 471 } |
| 493 | 472 |
| 494 DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, | 473 DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, |
| 495 doc: /* Return the exponential ARG1 ** ARG2. */) | 474 doc: /* Return the exponential ARG1 ** ARG2. */) |
| 496 (arg1, arg2) | 475 (register Lisp_Object arg1, Lisp_Object arg2) |
| 497 register Lisp_Object arg1, arg2; | |
| 498 { | 476 { |
| 499 double f1, f2, f3; | 477 double f1, f2, f3; |
| 500 | 478 |
| 501 CHECK_NUMBER_OR_FLOAT (arg1); | 479 CHECK_NUMBER_OR_FLOAT (arg1); |
| 502 CHECK_NUMBER_OR_FLOAT (arg2); | 480 CHECK_NUMBER_OR_FLOAT (arg2); |
| 550 } | 528 } |
| 551 | 529 |
| 552 DEFUN ("log", Flog, Slog, 1, 2, 0, | 530 DEFUN ("log", Flog, Slog, 1, 2, 0, |
| 553 doc: /* Return the natural logarithm of ARG. | 531 doc: /* Return the natural logarithm of ARG. |
| 554 If the optional argument BASE is given, return log ARG using that base. */) | 532 If the optional argument BASE is given, return log ARG using that base. */) |
| 555 (arg, base) | 533 (register Lisp_Object arg, Lisp_Object base) |
| 556 register Lisp_Object arg, base; | |
| 557 { | 534 { |
| 558 double d = extract_float (arg); | 535 double d = extract_float (arg); |
| 559 | 536 |
| 560 #ifdef FLOAT_CHECK_DOMAIN | 537 #ifdef FLOAT_CHECK_DOMAIN |
| 561 if (d <= 0.0) | 538 if (d <= 0.0) |
| 579 return make_float (d); | 556 return make_float (d); |
| 580 } | 557 } |
| 581 | 558 |
| 582 DEFUN ("log10", Flog10, Slog10, 1, 1, 0, | 559 DEFUN ("log10", Flog10, Slog10, 1, 1, 0, |
| 583 doc: /* Return the logarithm base 10 of ARG. */) | 560 doc: /* Return the logarithm base 10 of ARG. */) |
| 584 (arg) | 561 (register Lisp_Object arg) |
| 585 register Lisp_Object arg; | |
| 586 { | 562 { |
| 587 double d = extract_float (arg); | 563 double d = extract_float (arg); |
| 588 #ifdef FLOAT_CHECK_DOMAIN | 564 #ifdef FLOAT_CHECK_DOMAIN |
| 589 if (d <= 0.0) | 565 if (d <= 0.0) |
| 590 domain_error ("log10", arg); | 566 domain_error ("log10", arg); |
| 593 return make_float (d); | 569 return make_float (d); |
| 594 } | 570 } |
| 595 | 571 |
| 596 DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, | 572 DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, |
| 597 doc: /* Return the square root of ARG. */) | 573 doc: /* Return the square root of ARG. */) |
| 598 (arg) | 574 (register Lisp_Object arg) |
| 599 register Lisp_Object arg; | |
| 600 { | 575 { |
| 601 double d = extract_float (arg); | 576 double d = extract_float (arg); |
| 602 #ifdef FLOAT_CHECK_DOMAIN | 577 #ifdef FLOAT_CHECK_DOMAIN |
| 603 if (d < 0.0) | 578 if (d < 0.0) |
| 604 domain_error ("sqrt", arg); | 579 domain_error ("sqrt", arg); |
| 609 | 584 |
| 610 #if 0 /* Not clearly worth adding. */ | 585 #if 0 /* Not clearly worth adding. */ |
| 611 | 586 |
| 612 DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0, | 587 DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0, |
| 613 doc: /* Return the inverse hyperbolic cosine of ARG. */) | 588 doc: /* Return the inverse hyperbolic cosine of ARG. */) |
| 614 (arg) | 589 (register Lisp_Object arg) |
| 615 register Lisp_Object arg; | |
| 616 { | 590 { |
| 617 double d = extract_float (arg); | 591 double d = extract_float (arg); |
| 618 #ifdef FLOAT_CHECK_DOMAIN | 592 #ifdef FLOAT_CHECK_DOMAIN |
| 619 if (d < 1.0) | 593 if (d < 1.0) |
| 620 domain_error ("acosh", arg); | 594 domain_error ("acosh", arg); |
| 627 return make_float (d); | 601 return make_float (d); |
| 628 } | 602 } |
| 629 | 603 |
| 630 DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0, | 604 DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0, |
| 631 doc: /* Return the inverse hyperbolic sine of ARG. */) | 605 doc: /* Return the inverse hyperbolic sine of ARG. */) |
| 632 (arg) | 606 (register Lisp_Object arg) |
| 633 register Lisp_Object arg; | |
| 634 { | 607 { |
| 635 double d = extract_float (arg); | 608 double d = extract_float (arg); |
| 636 #ifdef HAVE_INVERSE_HYPERBOLIC | 609 #ifdef HAVE_INVERSE_HYPERBOLIC |
| 637 IN_FLOAT (d = asinh (d), "asinh", arg); | 610 IN_FLOAT (d = asinh (d), "asinh", arg); |
| 638 #else | 611 #else |
| 641 return make_float (d); | 614 return make_float (d); |
| 642 } | 615 } |
| 643 | 616 |
| 644 DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0, | 617 DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0, |
| 645 doc: /* Return the inverse hyperbolic tangent of ARG. */) | 618 doc: /* Return the inverse hyperbolic tangent of ARG. */) |
| 646 (arg) | 619 (register Lisp_Object arg) |
| 647 register Lisp_Object arg; | |
| 648 { | 620 { |
| 649 double d = extract_float (arg); | 621 double d = extract_float (arg); |
| 650 #ifdef FLOAT_CHECK_DOMAIN | 622 #ifdef FLOAT_CHECK_DOMAIN |
| 651 if (d >= 1.0 || d <= -1.0) | 623 if (d >= 1.0 || d <= -1.0) |
| 652 domain_error ("atanh", arg); | 624 domain_error ("atanh", arg); |
| 659 return make_float (d); | 631 return make_float (d); |
| 660 } | 632 } |
| 661 | 633 |
| 662 DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0, | 634 DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0, |
| 663 doc: /* Return the hyperbolic cosine of ARG. */) | 635 doc: /* Return the hyperbolic cosine of ARG. */) |
| 664 (arg) | 636 (register Lisp_Object arg) |
| 665 register Lisp_Object arg; | |
| 666 { | 637 { |
| 667 double d = extract_float (arg); | 638 double d = extract_float (arg); |
| 668 #ifdef FLOAT_CHECK_DOMAIN | 639 #ifdef FLOAT_CHECK_DOMAIN |
| 669 if (d > 710.0 || d < -710.0) | 640 if (d > 710.0 || d < -710.0) |
| 670 range_error ("cosh", arg); | 641 range_error ("cosh", arg); |
| 673 return make_float (d); | 644 return make_float (d); |
| 674 } | 645 } |
| 675 | 646 |
| 676 DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0, | 647 DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0, |
| 677 doc: /* Return the hyperbolic sine of ARG. */) | 648 doc: /* Return the hyperbolic sine of ARG. */) |
| 678 (arg) | 649 (register Lisp_Object arg) |
| 679 register Lisp_Object arg; | |
| 680 { | 650 { |
| 681 double d = extract_float (arg); | 651 double d = extract_float (arg); |
| 682 #ifdef FLOAT_CHECK_DOMAIN | 652 #ifdef FLOAT_CHECK_DOMAIN |
| 683 if (d > 710.0 || d < -710.0) | 653 if (d > 710.0 || d < -710.0) |
| 684 range_error ("sinh", arg); | 654 range_error ("sinh", arg); |
| 687 return make_float (d); | 657 return make_float (d); |
| 688 } | 658 } |
| 689 | 659 |
| 690 DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0, | 660 DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0, |
| 691 doc: /* Return the hyperbolic tangent of ARG. */) | 661 doc: /* Return the hyperbolic tangent of ARG. */) |
| 692 (arg) | 662 (register Lisp_Object arg) |
| 693 register Lisp_Object arg; | |
| 694 { | 663 { |
| 695 double d = extract_float (arg); | 664 double d = extract_float (arg); |
| 696 IN_FLOAT (d = tanh (d), "tanh", arg); | 665 IN_FLOAT (d = tanh (d), "tanh", arg); |
| 697 return make_float (d); | 666 return make_float (d); |
| 698 } | 667 } |
| 699 #endif | 668 #endif |
| 700 | 669 |
| 701 DEFUN ("abs", Fabs, Sabs, 1, 1, 0, | 670 DEFUN ("abs", Fabs, Sabs, 1, 1, 0, |
| 702 doc: /* Return the absolute value of ARG. */) | 671 doc: /* Return the absolute value of ARG. */) |
| 703 (arg) | 672 (register Lisp_Object arg) |
| 704 register Lisp_Object arg; | |
| 705 { | 673 { |
| 706 CHECK_NUMBER_OR_FLOAT (arg); | 674 CHECK_NUMBER_OR_FLOAT (arg); |
| 707 | 675 |
| 708 if (FLOATP (arg)) | 676 if (FLOATP (arg)) |
| 709 IN_FLOAT (arg = make_float (fabs (XFLOAT_DATA (arg))), "abs", arg); | 677 IN_FLOAT (arg = make_float (fabs (XFLOAT_DATA (arg))), "abs", arg); |
| 713 return arg; | 681 return arg; |
| 714 } | 682 } |
| 715 | 683 |
| 716 DEFUN ("float", Ffloat, Sfloat, 1, 1, 0, | 684 DEFUN ("float", Ffloat, Sfloat, 1, 1, 0, |
| 717 doc: /* Return the floating point number equal to ARG. */) | 685 doc: /* Return the floating point number equal to ARG. */) |
| 718 (arg) | 686 (register Lisp_Object arg) |
| 719 register Lisp_Object arg; | |
| 720 { | 687 { |
| 721 CHECK_NUMBER_OR_FLOAT (arg); | 688 CHECK_NUMBER_OR_FLOAT (arg); |
| 722 | 689 |
| 723 if (INTEGERP (arg)) | 690 if (INTEGERP (arg)) |
| 724 return make_float ((double) XINT (arg)); | 691 return make_float ((double) XINT (arg)); |
| 727 } | 694 } |
| 728 | 695 |
| 729 DEFUN ("logb", Flogb, Slogb, 1, 1, 0, | 696 DEFUN ("logb", Flogb, Slogb, 1, 1, 0, |
| 730 doc: /* Returns largest integer <= the base 2 log of the magnitude of ARG. | 697 doc: /* Returns largest integer <= the base 2 log of the magnitude of ARG. |
| 731 This is the same as the exponent of a float. */) | 698 This is the same as the exponent of a float. */) |
| 732 (arg) | 699 (Lisp_Object arg) |
| 733 Lisp_Object arg; | |
| 734 { | 700 { |
| 735 Lisp_Object val; | 701 Lisp_Object val; |
| 736 EMACS_INT value; | 702 EMACS_INT value; |
| 737 double f = extract_float (arg); | 703 double f = extract_float (arg); |
| 738 | 704 |
| 889 | 855 |
| 890 DEFUN ("ceiling", Fceiling, Sceiling, 1, 2, 0, | 856 DEFUN ("ceiling", Fceiling, Sceiling, 1, 2, 0, |
| 891 doc: /* Return the smallest integer no less than ARG. | 857 doc: /* Return the smallest integer no less than ARG. |
| 892 This rounds the value towards +inf. | 858 This rounds the value towards +inf. |
| 893 With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR. */) | 859 With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR. */) |
| 894 (arg, divisor) | 860 (Lisp_Object arg, Lisp_Object divisor) |
| 895 Lisp_Object arg, divisor; | |
| 896 { | 861 { |
| 897 return rounding_driver (arg, divisor, ceil, ceiling2, "ceiling"); | 862 return rounding_driver (arg, divisor, ceil, ceiling2, "ceiling"); |
| 898 } | 863 } |
| 899 | 864 |
| 900 DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0, | 865 DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0, |
| 901 doc: /* Return the largest integer no greater than ARG. | 866 doc: /* Return the largest integer no greater than ARG. |
| 902 This rounds the value towards -inf. | 867 This rounds the value towards -inf. |
| 903 With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. */) | 868 With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. */) |
| 904 (arg, divisor) | 869 (Lisp_Object arg, Lisp_Object divisor) |
| 905 Lisp_Object arg, divisor; | |
| 906 { | 870 { |
| 907 return rounding_driver (arg, divisor, floor, floor2, "floor"); | 871 return rounding_driver (arg, divisor, floor, floor2, "floor"); |
| 908 } | 872 } |
| 909 | 873 |
| 910 DEFUN ("round", Fround, Sround, 1, 2, 0, | 874 DEFUN ("round", Fround, Sround, 1, 2, 0, |
| 913 | 877 |
| 914 Rounding a value equidistant between two integers may choose the | 878 Rounding a value equidistant between two integers may choose the |
| 915 integer closer to zero, or it may prefer an even integer, depending on | 879 integer closer to zero, or it may prefer an even integer, depending on |
| 916 your machine. For example, \(round 2.5\) can return 3 on some | 880 your machine. For example, \(round 2.5\) can return 3 on some |
| 917 systems, but 2 on others. */) | 881 systems, but 2 on others. */) |
| 918 (arg, divisor) | 882 (Lisp_Object arg, Lisp_Object divisor) |
| 919 Lisp_Object arg, divisor; | |
| 920 { | 883 { |
| 921 return rounding_driver (arg, divisor, emacs_rint, round2, "round"); | 884 return rounding_driver (arg, divisor, emacs_rint, round2, "round"); |
| 922 } | 885 } |
| 923 | 886 |
| 924 DEFUN ("truncate", Ftruncate, Struncate, 1, 2, 0, | 887 DEFUN ("truncate", Ftruncate, Struncate, 1, 2, 0, |
| 925 doc: /* Truncate a floating point number to an int. | 888 doc: /* Truncate a floating point number to an int. |
| 926 Rounds ARG toward zero. | 889 Rounds ARG toward zero. |
| 927 With optional DIVISOR, truncate ARG/DIVISOR. */) | 890 With optional DIVISOR, truncate ARG/DIVISOR. */) |
| 928 (arg, divisor) | 891 (Lisp_Object arg, Lisp_Object divisor) |
| 929 Lisp_Object arg, divisor; | |
| 930 { | 892 { |
| 931 return rounding_driver (arg, divisor, double_identity, truncate2, | 893 return rounding_driver (arg, divisor, double_identity, truncate2, |
| 932 "truncate"); | 894 "truncate"); |
| 933 } | 895 } |
| 934 | 896 |
| 954 /* It's not clear these are worth adding. */ | 916 /* It's not clear these are worth adding. */ |
| 955 | 917 |
| 956 DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0, | 918 DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0, |
| 957 doc: /* Return the smallest integer no less than ARG, as a float. | 919 doc: /* Return the smallest integer no less than ARG, as a float. |
| 958 \(Round toward +inf.\) */) | 920 \(Round toward +inf.\) */) |
| 959 (arg) | 921 (register Lisp_Object arg) |
| 960 register Lisp_Object arg; | |
| 961 { | 922 { |
| 962 double d = extract_float (arg); | 923 double d = extract_float (arg); |
| 963 IN_FLOAT (d = ceil (d), "fceiling", arg); | 924 IN_FLOAT (d = ceil (d), "fceiling", arg); |
| 964 return make_float (d); | 925 return make_float (d); |
| 965 } | 926 } |
| 966 | 927 |
| 967 DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0, | 928 DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0, |
| 968 doc: /* Return the largest integer no greater than ARG, as a float. | 929 doc: /* Return the largest integer no greater than ARG, as a float. |
| 969 \(Round towards -inf.\) */) | 930 \(Round towards -inf.\) */) |
| 970 (arg) | 931 (register Lisp_Object arg) |
| 971 register Lisp_Object arg; | |
| 972 { | 932 { |
| 973 double d = extract_float (arg); | 933 double d = extract_float (arg); |
| 974 IN_FLOAT (d = floor (d), "ffloor", arg); | 934 IN_FLOAT (d = floor (d), "ffloor", arg); |
| 975 return make_float (d); | 935 return make_float (d); |
| 976 } | 936 } |
| 977 | 937 |
| 978 DEFUN ("fround", Ffround, Sfround, 1, 1, 0, | 938 DEFUN ("fround", Ffround, Sfround, 1, 1, 0, |
| 979 doc: /* Return the nearest integer to ARG, as a float. */) | 939 doc: /* Return the nearest integer to ARG, as a float. */) |
| 980 (arg) | 940 (register Lisp_Object arg) |
| 981 register Lisp_Object arg; | |
| 982 { | 941 { |
| 983 double d = extract_float (arg); | 942 double d = extract_float (arg); |
| 984 IN_FLOAT (d = emacs_rint (d), "fround", arg); | 943 IN_FLOAT (d = emacs_rint (d), "fround", arg); |
| 985 return make_float (d); | 944 return make_float (d); |
| 986 } | 945 } |
| 987 | 946 |
| 988 DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0, | 947 DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0, |
| 989 doc: /* Truncate a floating point number to an integral float value. | 948 doc: /* Truncate a floating point number to an integral float value. |
| 990 Rounds the value toward zero. */) | 949 Rounds the value toward zero. */) |
| 991 (arg) | 950 (register Lisp_Object arg) |
| 992 register Lisp_Object arg; | |
| 993 { | 951 { |
| 994 double d = extract_float (arg); | 952 double d = extract_float (arg); |
| 995 if (d >= 0.0) | 953 if (d >= 0.0) |
| 996 IN_FLOAT (d = floor (d), "ftruncate", arg); | 954 IN_FLOAT (d = floor (d), "ftruncate", arg); |
| 997 else | 955 else |
