Mercurial > hg > xemacs-beta
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 |