comparison src/floatfns.c @ 444:576fb035e263 r21-2-37

Import from CVS: tag r21-2-37
author cvs
date Mon, 13 Aug 2007 11:36:19 +0200
parents abe6d1db359e
children 183866b06e0b
comparison
equal deleted inserted replaced
443:a8296e22da4e 444:576fb035e263
210 210
211 /* Trig functions. */ 211 /* Trig functions. */
212 #ifdef LISP_FLOAT_TYPE 212 #ifdef LISP_FLOAT_TYPE
213 213
214 DEFUN ("acos", Facos, 1, 1, 0, /* 214 DEFUN ("acos", Facos, 1, 1, 0, /*
215 Return the inverse cosine of ARG. 215 Return the inverse cosine of NUMBER.
216 */ 216 */
217 (arg)) 217 (number))
218 { 218 {
219 double d = extract_float (arg); 219 double d = extract_float (number);
220 #ifdef FLOAT_CHECK_DOMAIN 220 #ifdef FLOAT_CHECK_DOMAIN
221 if (d > 1.0 || d < -1.0) 221 if (d > 1.0 || d < -1.0)
222 domain_error ("acos", arg); 222 domain_error ("acos", number);
223 #endif 223 #endif
224 IN_FLOAT (d = acos (d), "acos", arg); 224 IN_FLOAT (d = acos (d), "acos", number);
225 return make_float (d); 225 return make_float (d);
226 } 226 }
227 227
228 DEFUN ("asin", Fasin, 1, 1, 0, /* 228 DEFUN ("asin", Fasin, 1, 1, 0, /*
229 Return the inverse sine of ARG. 229 Return the inverse sine of NUMBER.
230 */ 230 */
231 (arg)) 231 (number))
232 { 232 {
233 double d = extract_float (arg); 233 double d = extract_float (number);
234 #ifdef FLOAT_CHECK_DOMAIN 234 #ifdef FLOAT_CHECK_DOMAIN
235 if (d > 1.0 || d < -1.0) 235 if (d > 1.0 || d < -1.0)
236 domain_error ("asin", arg); 236 domain_error ("asin", number);
237 #endif 237 #endif
238 IN_FLOAT (d = asin (d), "asin", arg); 238 IN_FLOAT (d = asin (d), "asin", number);
239 return make_float (d); 239 return make_float (d);
240 } 240 }
241 241
242 DEFUN ("atan", Fatan, 1, 2, 0, /* 242 DEFUN ("atan", Fatan, 1, 2, 0, /*
243 Return the inverse tangent of ARG. 243 Return the inverse tangent of NUMBER.
244 */ 244 If optional second argument NUMBER2 is provided,
245 (arg1, arg2)) 245 return atan2 (NUMBER, NUMBER2).
246 { 246 */
247 double d = extract_float (arg1); 247 (number, number2))
248 248 {
249 if (NILP (arg2)) 249 double d = extract_float (number);
250 IN_FLOAT (d = atan (d), "atan", arg1); 250
251 if (NILP (number2))
252 IN_FLOAT (d = atan (d), "atan", number);
251 else 253 else
252 { 254 {
253 double d2 = extract_float (arg2); 255 double d2 = extract_float (number2);
254 #ifdef FLOAT_CHECK_DOMAIN 256 #ifdef FLOAT_CHECK_DOMAIN
255 if (d == 0.0 && d2 == 0.0) 257 if (d == 0.0 && d2 == 0.0)
256 domain_error2 ("atan", arg1, arg2); 258 domain_error2 ("atan", number, number2);
257 #endif 259 #endif
258 IN_FLOAT2 (d = atan2 (d, d2), "atan", arg1, arg2); 260 IN_FLOAT2 (d = atan2 (d, d2), "atan", number, number2);
259 } 261 }
260 return make_float (d); 262 return make_float (d);
261 } 263 }
262 264
263 DEFUN ("cos", Fcos, 1, 1, 0, /* 265 DEFUN ("cos", Fcos, 1, 1, 0, /*
264 Return the cosine of ARG. 266 Return the cosine of NUMBER.
265 */ 267 */
266 (arg)) 268 (number))
267 { 269 {
268 double d = extract_float (arg); 270 double d = extract_float (number);
269 IN_FLOAT (d = cos (d), "cos", arg); 271 IN_FLOAT (d = cos (d), "cos", number);
270 return make_float (d); 272 return make_float (d);
271 } 273 }
272 274
273 DEFUN ("sin", Fsin, 1, 1, 0, /* 275 DEFUN ("sin", Fsin, 1, 1, 0, /*
274 Return the sine of ARG. 276 Return the sine of NUMBER.
275 */ 277 */
276 (arg)) 278 (number))
277 { 279 {
278 double d = extract_float (arg); 280 double d = extract_float (number);
279 IN_FLOAT (d = sin (d), "sin", arg); 281 IN_FLOAT (d = sin (d), "sin", number);
280 return make_float (d); 282 return make_float (d);
281 } 283 }
282 284
283 DEFUN ("tan", Ftan, 1, 1, 0, /* 285 DEFUN ("tan", Ftan, 1, 1, 0, /*
284 Return the tangent of ARG. 286 Return the tangent of NUMBER.
285 */ 287 */
286 (arg)) 288 (number))
287 { 289 {
288 double d = extract_float (arg); 290 double d = extract_float (number);
289 double c = cos (d); 291 double c = cos (d);
290 #ifdef FLOAT_CHECK_DOMAIN 292 #ifdef FLOAT_CHECK_DOMAIN
291 if (c == 0.0) 293 if (c == 0.0)
292 domain_error ("tan", arg); 294 domain_error ("tan", number);
293 #endif 295 #endif
294 IN_FLOAT (d = (sin (d) / c), "tan", arg); 296 IN_FLOAT (d = (sin (d) / c), "tan", number);
295 return make_float (d); 297 return make_float (d);
296 } 298 }
297 #endif /* LISP_FLOAT_TYPE (trig functions) */ 299 #endif /* LISP_FLOAT_TYPE (trig functions) */
298 300
299 301
300 /* Bessel functions */ 302 /* Bessel functions */
301 #if 0 /* Leave these out unless we find there's a reason for them. */ 303 #if 0 /* Leave these out unless we find there's a reason for them. */
302 /* #ifdef LISP_FLOAT_TYPE */ 304 /* #ifdef LISP_FLOAT_TYPE */
303 305
304 DEFUN ("bessel-j0", Fbessel_j0, 1, 1, 0, /* 306 DEFUN ("bessel-j0", Fbessel_j0, 1, 1, 0, /*
305 Return the bessel function j0 of ARG. 307 Return the bessel function j0 of NUMBER.
306 */ 308 */
307 (arg)) 309 (number))
308 { 310 {
309 double d = extract_float (arg); 311 double d = extract_float (number);
310 IN_FLOAT (d = j0 (d), "bessel-j0", arg); 312 IN_FLOAT (d = j0 (d), "bessel-j0", number);
311 return make_float (d); 313 return make_float (d);
312 } 314 }
313 315
314 DEFUN ("bessel-j1", Fbessel_j1, 1, 1, 0, /* 316 DEFUN ("bessel-j1", Fbessel_j1, 1, 1, 0, /*
315 Return the bessel function j1 of ARG. 317 Return the bessel function j1 of NUMBER.
316 */ 318 */
317 (arg)) 319 (number))
318 { 320 {
319 double d = extract_float (arg); 321 double d = extract_float (number);
320 IN_FLOAT (d = j1 (d), "bessel-j1", arg); 322 IN_FLOAT (d = j1 (d), "bessel-j1", number);
321 return make_float (d); 323 return make_float (d);
322 } 324 }
323 325
324 DEFUN ("bessel-jn", Fbessel_jn, 2, 2, 0, /* 326 DEFUN ("bessel-jn", Fbessel_jn, 2, 2, 0, /*
325 Return the order N bessel function output jn of ARG. 327 Return the order N bessel function output jn of NUMBER.
326 The first arg (the order) is truncated to an integer. 328 The first number (the order) is truncated to an integer.
327 */ 329 */
328 (arg1, arg2)) 330 (number1, number2))
329 { 331 {
330 int i1 = extract_float (arg1); 332 int i1 = extract_float (number1);
331 double f2 = extract_float (arg2); 333 double f2 = extract_float (number2);
332 334
333 IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", arg1); 335 IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", number1);
334 return make_float (f2); 336 return make_float (f2);
335 } 337 }
336 338
337 DEFUN ("bessel-y0", Fbessel_y0, 1, 1, 0, /* 339 DEFUN ("bessel-y0", Fbessel_y0, 1, 1, 0, /*
338 Return the bessel function y0 of ARG. 340 Return the bessel function y0 of NUMBER.
339 */ 341 */
340 (arg)) 342 (number))
341 { 343 {
342 double d = extract_float (arg); 344 double d = extract_float (number);
343 IN_FLOAT (d = y0 (d), "bessel-y0", arg); 345 IN_FLOAT (d = y0 (d), "bessel-y0", number);
344 return make_float (d); 346 return make_float (d);
345 } 347 }
346 348
347 DEFUN ("bessel-y1", Fbessel_y1, 1, 1, 0, /* 349 DEFUN ("bessel-y1", Fbessel_y1, 1, 1, 0, /*
348 Return the bessel function y1 of ARG. 350 Return the bessel function y1 of NUMBER.
349 */ 351 */
350 (arg)) 352 (number))
351 { 353 {
352 double d = extract_float (arg); 354 double d = extract_float (number);
353 IN_FLOAT (d = y1 (d), "bessel-y0", arg); 355 IN_FLOAT (d = y1 (d), "bessel-y0", number);
354 return make_float (d); 356 return make_float (d);
355 } 357 }
356 358
357 DEFUN ("bessel-yn", Fbessel_yn, 2, 2, 0, /* 359 DEFUN ("bessel-yn", Fbessel_yn, 2, 2, 0, /*
358 Return the order N bessel function output yn of ARG. 360 Return the order N bessel function output yn of NUMBER.
359 The first arg (the order) is truncated to an integer. 361 The first number (the order) is truncated to an integer.
360 */ 362 */
361 (arg1, arg2)) 363 (number1, number2))
362 { 364 {
363 int i1 = extract_float (arg1); 365 int i1 = extract_float (number1);
364 double f2 = extract_float (arg2); 366 double f2 = extract_float (number2);
365 367
366 IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", arg1); 368 IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", number1);
367 return make_float (f2); 369 return make_float (f2);
368 } 370 }
369 371
370 #endif /* 0 (bessel functions) */ 372 #endif /* 0 (bessel functions) */
371 373
372 /* Error functions. */ 374 /* Error functions. */
373 #if 0 /* Leave these out unless we see they are worth having. */ 375 #if 0 /* Leave these out unless we see they are worth having. */
374 /* #ifdef LISP_FLOAT_TYPE */ 376 /* #ifdef LISP_FLOAT_TYPE */
375 377
376 DEFUN ("erf", Ferf, 1, 1, 0, /* 378 DEFUN ("erf", Ferf, 1, 1, 0, /*
377 Return the mathematical error function of ARG. 379 Return the mathematical error function of NUMBER.
378 */ 380 */
379 (arg)) 381 (number))
380 { 382 {
381 double d = extract_float (arg); 383 double d = extract_float (number);
382 IN_FLOAT (d = erf (d), "erf", arg); 384 IN_FLOAT (d = erf (d), "erf", number);
383 return make_float (d); 385 return make_float (d);
384 } 386 }
385 387
386 DEFUN ("erfc", Ferfc, 1, 1, 0, /* 388 DEFUN ("erfc", Ferfc, 1, 1, 0, /*
387 Return the complementary error function of ARG. 389 Return the complementary error function of NUMBER.
388 */ 390 */
389 (arg)) 391 (number))
390 { 392 {
391 double d = extract_float (arg); 393 double d = extract_float (number);
392 IN_FLOAT (d = erfc (d), "erfc", arg); 394 IN_FLOAT (d = erfc (d), "erfc", number);
393 return make_float (d); 395 return make_float (d);
394 } 396 }
395 397
396 DEFUN ("log-gamma", Flog_gamma, 1, 1, 0, /* 398 DEFUN ("log-gamma", Flog_gamma, 1, 1, 0, /*
397 Return the log gamma of ARG. 399 Return the log gamma of NUMBER.
398 */ 400 */
399 (arg)) 401 (number))
400 { 402 {
401 double d = extract_float (arg); 403 double d = extract_float (number);
402 IN_FLOAT (d = lgamma (d), "log-gamma", arg); 404 IN_FLOAT (d = lgamma (d), "log-gamma", number);
403 return make_float (d); 405 return make_float (d);
404 } 406 }
405 407
406 #endif /* 0 (error functions) */ 408 #endif /* 0 (error functions) */
407 409
408 410
409 /* Root and Log functions. */ 411 /* Root and Log functions. */
410 412
411 #ifdef LISP_FLOAT_TYPE 413 #ifdef LISP_FLOAT_TYPE
412 DEFUN ("exp", Fexp, 1, 1, 0, /* 414 DEFUN ("exp", Fexp, 1, 1, 0, /*
413 Return the exponential base e of ARG. 415 Return the exponential base e of NUMBER.
414 */ 416 */
415 (arg)) 417 (number))
416 { 418 {
417 double d = extract_float (arg); 419 double d = extract_float (number);
418 #ifdef FLOAT_CHECK_DOMAIN 420 #ifdef FLOAT_CHECK_DOMAIN
419 if (d > 709.7827) /* Assume IEEE doubles here */ 421 if (d > 709.7827) /* Assume IEEE doubles here */
420 range_error ("exp", arg); 422 range_error ("exp", number);
421 else if (d < -709.0) 423 else if (d < -709.0)
422 return make_float (0.0); 424 return make_float (0.0);
423 else 425 else
424 #endif 426 #endif
425 IN_FLOAT (d = exp (d), "exp", arg); 427 IN_FLOAT (d = exp (d), "exp", number);
426 return make_float (d); 428 return make_float (d);
427 } 429 }
428 #endif /* LISP_FLOAT_TYPE */ 430 #endif /* LISP_FLOAT_TYPE */
429 431
430 432
431 DEFUN ("expt", Fexpt, 2, 2, 0, /* 433 DEFUN ("expt", Fexpt, 2, 2, 0, /*
432 Return the exponential ARG1 ** ARG2. 434 Return the exponential NUMBER1 ** NUMBER2.
433 */ 435 */
434 (arg1, arg2)) 436 (number1, number2))
435 { 437 {
436 if (INTP (arg1) && /* common lisp spec */ 438 if (INTP (number1) && /* common lisp spec */
437 INTP (arg2)) /* don't promote, if both are ints */ 439 INTP (number2)) /* don't promote, if both are ints */
438 { 440 {
439 EMACS_INT retval; 441 EMACS_INT retval;
440 EMACS_INT x = XINT (arg1); 442 EMACS_INT x = XINT (number1);
441 EMACS_INT y = XINT (arg2); 443 EMACS_INT y = XINT (number2);
442 444
443 if (y < 0) 445 if (y < 0)
444 { 446 {
445 if (x == 1) 447 if (x == 1)
446 retval = 1; 448 retval = 1;
463 return make_int (retval); 465 return make_int (retval);
464 } 466 }
465 467
466 #ifdef LISP_FLOAT_TYPE 468 #ifdef LISP_FLOAT_TYPE
467 { 469 {
468 double f1 = extract_float (arg1); 470 double f1 = extract_float (number1);
469 double f2 = extract_float (arg2); 471 double f2 = extract_float (number2);
470 /* Really should check for overflow, too */ 472 /* Really should check for overflow, too */
471 if (f1 == 0.0 && f2 == 0.0) 473 if (f1 == 0.0 && f2 == 0.0)
472 f1 = 1.0; 474 f1 = 1.0;
473 # ifdef FLOAT_CHECK_DOMAIN 475 # ifdef FLOAT_CHECK_DOMAIN
474 else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor(f2))) 476 else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor(f2)))
475 domain_error2 ("expt", arg1, arg2); 477 domain_error2 ("expt", number1, number2);
476 # endif /* FLOAT_CHECK_DOMAIN */ 478 # endif /* FLOAT_CHECK_DOMAIN */
477 IN_FLOAT2 (f1 = pow (f1, f2), "expt", arg1, arg2); 479 IN_FLOAT2 (f1 = pow (f1, f2), "expt", number1, number2);
478 return make_float (f1); 480 return make_float (f1);
479 } 481 }
480 #else 482 #else
481 CHECK_INT_OR_FLOAT (arg1); 483 CHECK_INT_OR_FLOAT (number1);
482 CHECK_INT_OR_FLOAT (arg2); 484 CHECK_INT_OR_FLOAT (number2);
483 return Fexpt (arg1, arg2); 485 return Fexpt (number1, number2);
484 #endif /* LISP_FLOAT_TYPE */ 486 #endif /* LISP_FLOAT_TYPE */
485 } 487 }
486 488
487 #ifdef LISP_FLOAT_TYPE 489 #ifdef LISP_FLOAT_TYPE
488 DEFUN ("log", Flog, 1, 2, 0, /* 490 DEFUN ("log", Flog, 1, 2, 0, /*
489 Return the natural logarithm of ARG. 491 Return the natural logarithm of NUMBER.
490 If second optional argument BASE is given, return log ARG using that base. 492 If second optional argument BASE is given, return the logarithm of
491 */ 493 NUMBER using that base.
492 (arg, base)) 494 */
493 { 495 (number, base))
494 double d = extract_float (arg); 496 {
497 double d = extract_float (number);
495 #ifdef FLOAT_CHECK_DOMAIN 498 #ifdef FLOAT_CHECK_DOMAIN
496 if (d <= 0.0) 499 if (d <= 0.0)
497 domain_error2 ("log", arg, base); 500 domain_error2 ("log", number, base);
498 #endif 501 #endif
499 if (NILP (base)) 502 if (NILP (base))
500 IN_FLOAT (d = log (d), "log", arg); 503 IN_FLOAT (d = log (d), "log", number);
501 else 504 else
502 { 505 {
503 double b = extract_float (base); 506 double b = extract_float (base);
504 #ifdef FLOAT_CHECK_DOMAIN 507 #ifdef FLOAT_CHECK_DOMAIN
505 if (b <= 0.0 || b == 1.0) 508 if (b <= 0.0 || b == 1.0)
506 domain_error2 ("log", arg, base); 509 domain_error2 ("log", number, base);
507 #endif 510 #endif
508 if (b == 10.0) 511 if (b == 10.0)
509 IN_FLOAT2 (d = log10 (d), "log", arg, base); 512 IN_FLOAT2 (d = log10 (d), "log", number, base);
510 else 513 else
511 IN_FLOAT2 (d = (log (d) / log (b)), "log", arg, base); 514 IN_FLOAT2 (d = (log (d) / log (b)), "log", number, base);
512 } 515 }
513 return make_float (d); 516 return make_float (d);
514 } 517 }
515 518
516 519
517 DEFUN ("log10", Flog10, 1, 1, 0, /* 520 DEFUN ("log10", Flog10, 1, 1, 0, /*
518 Return the logarithm base 10 of ARG. 521 Return the logarithm base 10 of NUMBER.
519 */ 522 */
520 (arg)) 523 (number))
521 { 524 {
522 double d = extract_float (arg); 525 double d = extract_float (number);
523 #ifdef FLOAT_CHECK_DOMAIN 526 #ifdef FLOAT_CHECK_DOMAIN
524 if (d <= 0.0) 527 if (d <= 0.0)
525 domain_error ("log10", arg); 528 domain_error ("log10", number);
526 #endif 529 #endif
527 IN_FLOAT (d = log10 (d), "log10", arg); 530 IN_FLOAT (d = log10 (d), "log10", number);
528 return make_float (d); 531 return make_float (d);
529 } 532 }
530 533
531 534
532 DEFUN ("sqrt", Fsqrt, 1, 1, 0, /* 535 DEFUN ("sqrt", Fsqrt, 1, 1, 0, /*
533 Return the square root of ARG. 536 Return the square root of NUMBER.
534 */ 537 */
535 (arg)) 538 (number))
536 { 539 {
537 double d = extract_float (arg); 540 double d = extract_float (number);
538 #ifdef FLOAT_CHECK_DOMAIN 541 #ifdef FLOAT_CHECK_DOMAIN
539 if (d < 0.0) 542 if (d < 0.0)
540 domain_error ("sqrt", arg); 543 domain_error ("sqrt", number);
541 #endif 544 #endif
542 IN_FLOAT (d = sqrt (d), "sqrt", arg); 545 IN_FLOAT (d = sqrt (d), "sqrt", number);
543 return make_float (d); 546 return make_float (d);
544 } 547 }
545 548
546 549
547 DEFUN ("cube-root", Fcube_root, 1, 1, 0, /* 550 DEFUN ("cube-root", Fcube_root, 1, 1, 0, /*
548 Return the cube root of ARG. 551 Return the cube root of NUMBER.
549 */ 552 */
550 (arg)) 553 (number))
551 { 554 {
552 double d = extract_float (arg); 555 double d = extract_float (number);
553 #ifdef HAVE_CBRT 556 #ifdef HAVE_CBRT
554 IN_FLOAT (d = cbrt (d), "cube-root", arg); 557 IN_FLOAT (d = cbrt (d), "cube-root", number);
555 #else 558 #else
556 if (d >= 0.0) 559 if (d >= 0.0)
557 IN_FLOAT (d = pow (d, 1.0/3.0), "cube-root", arg); 560 IN_FLOAT (d = pow (d, 1.0/3.0), "cube-root", number);
558 else 561 else
559 IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", arg); 562 IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", number);
560 #endif 563 #endif
561 return make_float (d); 564 return make_float (d);
562 } 565 }
563 #endif /* LISP_FLOAT_TYPE */ 566 #endif /* LISP_FLOAT_TYPE */
564 567
566 /* Inverse trig functions. */ 569 /* Inverse trig functions. */
567 #ifdef LISP_FLOAT_TYPE 570 #ifdef LISP_FLOAT_TYPE
568 /* #if 0 Not clearly worth adding... */ 571 /* #if 0 Not clearly worth adding... */
569 572
570 DEFUN ("acosh", Facosh, 1, 1, 0, /* 573 DEFUN ("acosh", Facosh, 1, 1, 0, /*
571 Return the inverse hyperbolic cosine of ARG. 574 Return the inverse hyperbolic cosine of NUMBER.
572 */ 575 */
573 (arg)) 576 (number))
574 { 577 {
575 double d = extract_float (arg); 578 double d = extract_float (number);
576 #ifdef FLOAT_CHECK_DOMAIN 579 #ifdef FLOAT_CHECK_DOMAIN
577 if (d < 1.0) 580 if (d < 1.0)
578 domain_error ("acosh", arg); 581 domain_error ("acosh", number);
579 #endif 582 #endif
580 #ifdef HAVE_INVERSE_HYPERBOLIC 583 #ifdef HAVE_INVERSE_HYPERBOLIC
581 IN_FLOAT (d = acosh (d), "acosh", arg); 584 IN_FLOAT (d = acosh (d), "acosh", number);
582 #else 585 #else
583 IN_FLOAT (d = log (d + sqrt (d*d - 1.0)), "acosh", arg); 586 IN_FLOAT (d = log (d + sqrt (d*d - 1.0)), "acosh", number);
584 #endif 587 #endif
585 return make_float (d); 588 return make_float (d);
586 } 589 }
587 590
588 DEFUN ("asinh", Fasinh, 1, 1, 0, /* 591 DEFUN ("asinh", Fasinh, 1, 1, 0, /*
589 Return the inverse hyperbolic sine of ARG. 592 Return the inverse hyperbolic sine of NUMBER.
590 */ 593 */
591 (arg)) 594 (number))
592 { 595 {
593 double d = extract_float (arg); 596 double d = extract_float (number);
594 #ifdef HAVE_INVERSE_HYPERBOLIC 597 #ifdef HAVE_INVERSE_HYPERBOLIC
595 IN_FLOAT (d = asinh (d), "asinh", arg); 598 IN_FLOAT (d = asinh (d), "asinh", number);
596 #else 599 #else
597 IN_FLOAT (d = log (d + sqrt (d*d + 1.0)), "asinh", arg); 600 IN_FLOAT (d = log (d + sqrt (d*d + 1.0)), "asinh", number);
598 #endif 601 #endif
599 return make_float (d); 602 return make_float (d);
600 } 603 }
601 604
602 DEFUN ("atanh", Fatanh, 1, 1, 0, /* 605 DEFUN ("atanh", Fatanh, 1, 1, 0, /*
603 Return the inverse hyperbolic tangent of ARG. 606 Return the inverse hyperbolic tangent of NUMBER.
604 */ 607 */
605 (arg)) 608 (number))
606 { 609 {
607 double d = extract_float (arg); 610 double d = extract_float (number);
608 #ifdef FLOAT_CHECK_DOMAIN 611 #ifdef FLOAT_CHECK_DOMAIN
609 if (d >= 1.0 || d <= -1.0) 612 if (d >= 1.0 || d <= -1.0)
610 domain_error ("atanh", arg); 613 domain_error ("atanh", number);
611 #endif 614 #endif
612 #ifdef HAVE_INVERSE_HYPERBOLIC 615 #ifdef HAVE_INVERSE_HYPERBOLIC
613 IN_FLOAT (d = atanh (d), "atanh", arg); 616 IN_FLOAT (d = atanh (d), "atanh", number);
614 #else 617 #else
615 IN_FLOAT (d = 0.5 * log ((1.0 + d) / (1.0 - d)), "atanh", arg); 618 IN_FLOAT (d = 0.5 * log ((1.0 + d) / (1.0 - d)), "atanh", number);
616 #endif 619 #endif
617 return make_float (d); 620 return make_float (d);
618 } 621 }
619 622
620 DEFUN ("cosh", Fcosh, 1, 1, 0, /* 623 DEFUN ("cosh", Fcosh, 1, 1, 0, /*
621 Return the hyperbolic cosine of ARG. 624 Return the hyperbolic cosine of NUMBER.
622 */ 625 */
623 (arg)) 626 (number))
624 { 627 {
625 double d = extract_float (arg); 628 double d = extract_float (number);
626 #ifdef FLOAT_CHECK_DOMAIN 629 #ifdef FLOAT_CHECK_DOMAIN
627 if (d > 710.0 || d < -710.0) 630 if (d > 710.0 || d < -710.0)
628 range_error ("cosh", arg); 631 range_error ("cosh", number);
629 #endif 632 #endif
630 IN_FLOAT (d = cosh (d), "cosh", arg); 633 IN_FLOAT (d = cosh (d), "cosh", number);
631 return make_float (d); 634 return make_float (d);
632 } 635 }
633 636
634 DEFUN ("sinh", Fsinh, 1, 1, 0, /* 637 DEFUN ("sinh", Fsinh, 1, 1, 0, /*
635 Return the hyperbolic sine of ARG. 638 Return the hyperbolic sine of NUMBER.
636 */ 639 */
637 (arg)) 640 (number))
638 { 641 {
639 double d = extract_float (arg); 642 double d = extract_float (number);
640 #ifdef FLOAT_CHECK_DOMAIN 643 #ifdef FLOAT_CHECK_DOMAIN
641 if (d > 710.0 || d < -710.0) 644 if (d > 710.0 || d < -710.0)
642 range_error ("sinh", arg); 645 range_error ("sinh", number);
643 #endif 646 #endif
644 IN_FLOAT (d = sinh (d), "sinh", arg); 647 IN_FLOAT (d = sinh (d), "sinh", number);
645 return make_float (d); 648 return make_float (d);
646 } 649 }
647 650
648 DEFUN ("tanh", Ftanh, 1, 1, 0, /* 651 DEFUN ("tanh", Ftanh, 1, 1, 0, /*
649 Return the hyperbolic tangent of ARG. 652 Return the hyperbolic tangent of NUMBER.
650 */ 653 */
651 (arg)) 654 (number))
652 { 655 {
653 double d = extract_float (arg); 656 double d = extract_float (number);
654 IN_FLOAT (d = tanh (d), "tanh", arg); 657 IN_FLOAT (d = tanh (d), "tanh", number);
655 return make_float (d); 658 return make_float (d);
656 } 659 }
657 #endif /* LISP_FLOAT_TYPE (inverse trig functions) */ 660 #endif /* LISP_FLOAT_TYPE (inverse trig functions) */
658 661
659 /* Rounding functions */ 662 /* Rounding functions */
660 663
661 DEFUN ("abs", Fabs, 1, 1, 0, /* 664 DEFUN ("abs", Fabs, 1, 1, 0, /*
662 Return the absolute value of ARG. 665 Return the absolute value of NUMBER.
663 */ 666 */
664 (arg)) 667 (number))
665 { 668 {
666 #ifdef LISP_FLOAT_TYPE 669 #ifdef LISP_FLOAT_TYPE
667 if (FLOATP (arg)) 670 if (FLOATP (number))
668 { 671 {
669 IN_FLOAT (arg = make_float (fabs (XFLOAT_DATA (arg))), 672 IN_FLOAT (number = make_float (fabs (XFLOAT_DATA (number))),
670 "abs", arg); 673 "abs", number);
671 return arg; 674 return number;
672 } 675 }
673 #endif /* LISP_FLOAT_TYPE */ 676 #endif /* LISP_FLOAT_TYPE */
674 677
675 if (INTP (arg)) 678 if (INTP (number))
676 return (XINT (arg) >= 0) ? arg : make_int (- XINT (arg)); 679 return (XINT (number) >= 0) ? number : make_int (- XINT (number));
677 680
678 return Fabs (wrong_type_argument (Qnumberp, arg)); 681 return Fabs (wrong_type_argument (Qnumberp, number));
679 } 682 }
680 683
681 #ifdef LISP_FLOAT_TYPE 684 #ifdef LISP_FLOAT_TYPE
682 DEFUN ("float", Ffloat, 1, 1, 0, /* 685 DEFUN ("float", Ffloat, 1, 1, 0, /*
683 Return the floating point number numerically equal to ARG. 686 Return the floating point number numerically equal to NUMBER.
684 */ 687 */
685 (arg)) 688 (number))
686 { 689 {
687 if (INTP (arg)) 690 if (INTP (number))
688 return make_float ((double) XINT (arg)); 691 return make_float ((double) XINT (number));
689 692
690 if (FLOATP (arg)) /* give 'em the same float back */ 693 if (FLOATP (number)) /* give 'em the same float back */
691 return arg; 694 return number;
692 695
693 return Ffloat (wrong_type_argument (Qnumberp, arg)); 696 return Ffloat (wrong_type_argument (Qnumberp, number));
694 } 697 }
695 #endif /* LISP_FLOAT_TYPE */ 698 #endif /* LISP_FLOAT_TYPE */
696 699
697 700
698 #ifdef LISP_FLOAT_TYPE 701 #ifdef LISP_FLOAT_TYPE
699 DEFUN ("logb", Flogb, 1, 1, 0, /* 702 DEFUN ("logb", Flogb, 1, 1, 0, /*
700 Return largest integer <= the base 2 log of the magnitude of ARG. 703 Return largest integer <= the base 2 log of the magnitude of NUMBER.
701 This is the same as the exponent of a float. 704 This is the same as the exponent of a float.
702 */ 705 */
703 (arg)) 706 (number))
704 { 707 {
705 double f = extract_float (arg); 708 double f = extract_float (number);
706 709
707 if (f == 0.0) 710 if (f == 0.0)
708 return make_int (- (EMACS_INT)(((EMACS_UINT) 1) << (VALBITS - 1))); /* most-negative-fixnum */ 711 return make_int (- (EMACS_INT)(((EMACS_UINT) 1) << (VALBITS - 1))); /* most-negative-fixnum */
709 #ifdef HAVE_LOGB 712 #ifdef HAVE_LOGB
710 { 713 {
711 Lisp_Object val; 714 Lisp_Object val;
712 IN_FLOAT (val = make_int ((EMACS_INT) logb (f)), "logb", arg); 715 IN_FLOAT (val = make_int ((EMACS_INT) logb (f)), "logb", number);
713 return val; 716 return val;
714 } 717 }
715 #else 718 #else
716 #ifdef HAVE_FREXP 719 #ifdef HAVE_FREXP
717 { 720 {
718 int exqp; 721 int exqp;
719 IN_FLOAT (frexp (f, &exqp), "logb", arg); 722 IN_FLOAT (frexp (f, &exqp), "logb", number);
720 return make_int (exqp - 1); 723 return make_int (exqp - 1);
721 } 724 }
722 #else 725 #else
723 { 726 {
724 int i; 727 int i;
748 } 751 }
749 #endif /* LISP_FLOAT_TYPE */ 752 #endif /* LISP_FLOAT_TYPE */
750 753
751 754
752 DEFUN ("ceiling", Fceiling, 1, 1, 0, /* 755 DEFUN ("ceiling", Fceiling, 1, 1, 0, /*
753 Return the smallest integer no less than ARG. (Round toward +inf.) 756 Return the smallest integer no less than NUMBER. (Round toward +inf.)
754 */ 757 */
755 (arg)) 758 (number))
756 { 759 {
757 #ifdef LISP_FLOAT_TYPE 760 #ifdef LISP_FLOAT_TYPE
758 if (FLOATP (arg)) 761 if (FLOATP (number))
759 { 762 {
760 double d; 763 double d;
761 IN_FLOAT ((d = ceil (XFLOAT_DATA (arg))), "ceiling", arg); 764 IN_FLOAT ((d = ceil (XFLOAT_DATA (number))), "ceiling", number);
762 return (float_to_int (d, "ceiling", arg, Qunbound)); 765 return (float_to_int (d, "ceiling", number, Qunbound));
763 } 766 }
764 #endif /* LISP_FLOAT_TYPE */ 767 #endif /* LISP_FLOAT_TYPE */
765 768
766 if (INTP (arg)) 769 if (INTP (number))
767 return arg; 770 return number;
768 771
769 return Fceiling (wrong_type_argument (Qnumberp, arg)); 772 return Fceiling (wrong_type_argument (Qnumberp, number));
770 } 773 }
771 774
772 775
773 DEFUN ("floor", Ffloor, 1, 2, 0, /* 776 DEFUN ("floor", Ffloor, 1, 2, 0, /*
774 Return the largest integer no greater than ARG. (Round towards -inf.) 777 Return the largest integer no greater than NUMBER. (Round towards -inf.)
775 With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. 778 With optional second argument DIVISOR, return the largest integer no
776 */ 779 greater than NUMBER/DIVISOR.
777 (arg, divisor)) 780 */
778 { 781 (number, divisor))
779 CHECK_INT_OR_FLOAT (arg); 782 {
783 CHECK_INT_OR_FLOAT (number);
780 784
781 if (! NILP (divisor)) 785 if (! NILP (divisor))
782 { 786 {
783 EMACS_INT i1, i2; 787 EMACS_INT i1, i2;
784 788
785 CHECK_INT_OR_FLOAT (divisor); 789 CHECK_INT_OR_FLOAT (divisor);
786 790
787 #ifdef LISP_FLOAT_TYPE 791 #ifdef LISP_FLOAT_TYPE
788 if (FLOATP (arg) || FLOATP (divisor)) 792 if (FLOATP (number) || FLOATP (divisor))
789 { 793 {
790 double f1 = extract_float (arg); 794 double f1 = extract_float (number);
791 double f2 = extract_float (divisor); 795 double f2 = extract_float (divisor);
792 796
793 if (f2 == 0) 797 if (f2 == 0)
794 Fsignal (Qarith_error, Qnil); 798 Fsignal (Qarith_error, Qnil);
795 799
796 IN_FLOAT2 (f1 = floor (f1 / f2), "floor", arg, divisor); 800 IN_FLOAT2 (f1 = floor (f1 / f2), "floor", number, divisor);
797 return float_to_int (f1, "floor", arg, divisor); 801 return float_to_int (f1, "floor", number, divisor);
798 } 802 }
799 #endif /* LISP_FLOAT_TYPE */ 803 #endif /* LISP_FLOAT_TYPE */
800 804
801 i1 = XINT (arg); 805 i1 = XINT (number);
802 i2 = XINT (divisor); 806 i2 = XINT (divisor);
803 807
804 if (i2 == 0) 808 if (i2 == 0)
805 Fsignal (Qarith_error, Qnil); 809 Fsignal (Qarith_error, Qnil);
806 810
812 816
813 return (make_int (i1)); 817 return (make_int (i1));
814 } 818 }
815 819
816 #ifdef LISP_FLOAT_TYPE 820 #ifdef LISP_FLOAT_TYPE
817 if (FLOATP (arg)) 821 if (FLOATP (number))
818 { 822 {
819 double d; 823 double d;
820 IN_FLOAT ((d = floor (XFLOAT_DATA (arg))), "floor", arg); 824 IN_FLOAT ((d = floor (XFLOAT_DATA (number))), "floor", number);
821 return (float_to_int (d, "floor", arg, Qunbound)); 825 return (float_to_int (d, "floor", number, Qunbound));
822 } 826 }
823 #endif /* LISP_FLOAT_TYPE */ 827 #endif /* LISP_FLOAT_TYPE */
824 828
825 return arg; 829 return number;
826 } 830 }
827 831
828 DEFUN ("round", Fround, 1, 1, 0, /* 832 DEFUN ("round", Fround, 1, 1, 0, /*
829 Return the nearest integer to ARG. 833 Return the nearest integer to NUMBER.
830 */ 834 */
831 (arg)) 835 (number))
832 { 836 {
833 #ifdef LISP_FLOAT_TYPE 837 #ifdef LISP_FLOAT_TYPE
834 if (FLOATP (arg)) 838 if (FLOATP (number))
835 { 839 {
836 double d; 840 double d;
837 /* Screw the prevailing rounding mode. */ 841 /* Screw the prevailing rounding mode. */
838 IN_FLOAT ((d = emacs_rint (XFLOAT_DATA (arg))), "round", arg); 842 IN_FLOAT ((d = emacs_rint (XFLOAT_DATA (number))), "round", number);
839 return (float_to_int (d, "round", arg, Qunbound)); 843 return (float_to_int (d, "round", number, Qunbound));
840 } 844 }
841 #endif /* LISP_FLOAT_TYPE */ 845 #endif /* LISP_FLOAT_TYPE */
842 846
843 if (INTP (arg)) 847 if (INTP (number))
844 return arg; 848 return number;
845 849
846 return Fround (wrong_type_argument (Qnumberp, arg)); 850 return Fround (wrong_type_argument (Qnumberp, number));
847 } 851 }
848 852
849 DEFUN ("truncate", Ftruncate, 1, 1, 0, /* 853 DEFUN ("truncate", Ftruncate, 1, 1, 0, /*
850 Truncate a floating point number to an integer. 854 Truncate a floating point number to an integer.
851 Rounds the value toward zero. 855 Rounds the value toward zero.
852 */ 856 */
853 (arg)) 857 (number))
854 { 858 {
855 #ifdef LISP_FLOAT_TYPE 859 #ifdef LISP_FLOAT_TYPE
856 if (FLOATP (arg)) 860 if (FLOATP (number))
857 return float_to_int (XFLOAT_DATA (arg), "truncate", arg, Qunbound); 861 return float_to_int (XFLOAT_DATA (number), "truncate", number, Qunbound);
858 #endif /* LISP_FLOAT_TYPE */ 862 #endif /* LISP_FLOAT_TYPE */
859 863
860 if (INTP (arg)) 864 if (INTP (number))
861 return arg; 865 return number;
862 866
863 return Ftruncate (wrong_type_argument (Qnumberp, arg)); 867 return Ftruncate (wrong_type_argument (Qnumberp, number));
864 } 868 }
865 869
866 /* Float-rounding functions. */ 870 /* Float-rounding functions. */
867 #ifdef LISP_FLOAT_TYPE 871 #ifdef LISP_FLOAT_TYPE
868 /* #if 1 It's not clear these are worth adding... */ 872 /* #if 1 It's not clear these are worth adding... */
869 873
870 DEFUN ("fceiling", Ffceiling, 1, 1, 0, /* 874 DEFUN ("fceiling", Ffceiling, 1, 1, 0, /*
871 Return the smallest integer no less than ARG, as a float. 875 Return the smallest integer no less than NUMBER, as a float.
872 \(Round toward +inf.\) 876 \(Round toward +inf.\)
873 */ 877 */
874 (arg)) 878 (number))
875 { 879 {
876 double d = extract_float (arg); 880 double d = extract_float (number);
877 IN_FLOAT (d = ceil (d), "fceiling", arg); 881 IN_FLOAT (d = ceil (d), "fceiling", number);
878 return make_float (d); 882 return make_float (d);
879 } 883 }
880 884
881 DEFUN ("ffloor", Fffloor, 1, 1, 0, /* 885 DEFUN ("ffloor", Fffloor, 1, 1, 0, /*
882 Return the largest integer no greater than ARG, as a float. 886 Return the largest integer no greater than NUMBER, as a float.
883 \(Round towards -inf.\) 887 \(Round towards -inf.\)
884 */ 888 */
885 (arg)) 889 (number))
886 { 890 {
887 double d = extract_float (arg); 891 double d = extract_float (number);
888 IN_FLOAT (d = floor (d), "ffloor", arg); 892 IN_FLOAT (d = floor (d), "ffloor", number);
889 return make_float (d); 893 return make_float (d);
890 } 894 }
891 895
892 DEFUN ("fround", Ffround, 1, 1, 0, /* 896 DEFUN ("fround", Ffround, 1, 1, 0, /*
893 Return the nearest integer to ARG, as a float. 897 Return the nearest integer to NUMBER, as a float.
894 */ 898 */
895 (arg)) 899 (number))
896 { 900 {
897 double d = extract_float (arg); 901 double d = extract_float (number);
898 IN_FLOAT (d = emacs_rint (d), "fround", arg); 902 IN_FLOAT (d = emacs_rint (d), "fround", number);
899 return make_float (d); 903 return make_float (d);
900 } 904 }
901 905
902 DEFUN ("ftruncate", Fftruncate, 1, 1, 0, /* 906 DEFUN ("ftruncate", Fftruncate, 1, 1, 0, /*
903 Truncate a floating point number to an integral float value. 907 Truncate a floating point number to an integral float value.
904 Rounds the value toward zero. 908 Rounds the value toward zero.
905 */ 909 */
906 (arg)) 910 (number))
907 { 911 {
908 double d = extract_float (arg); 912 double d = extract_float (number);
909 if (d >= 0.0) 913 if (d >= 0.0)
910 IN_FLOAT (d = floor (d), "ftruncate", arg); 914 IN_FLOAT (d = floor (d), "ftruncate", number);
911 else 915 else
912 IN_FLOAT (d = ceil (d), "ftruncate", arg); 916 IN_FLOAT (d = ceil (d), "ftruncate", number);
913 return make_float (d); 917 return make_float (d);
914 } 918 }
915 919
916 #endif /* LISP_FLOAT_TYPE (float-rounding functions) */ 920 #endif /* LISP_FLOAT_TYPE (float-rounding functions) */
917 921