1 /* Primitive operations on floating point for SXEmacs Lisp interpreter.
2 Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of SXEmacs
6 SXEmacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 SXEmacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with this program. If not, see <http://www.gnu.org/licenses/>. */
20 /* Synched up with: FSF 19.30. */
22 /* ANSI C requires only these float functions:
23 acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod,
24 frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh.
26 Define HAVE_INVERSE_HYPERBOLIC if you have acosh, asinh, and atanh.
27 Define HAVE_CBRT if you have cbrt().
28 Define HAVE_RINT if you have rint().
29 If you don't define these, then the appropriate routines will be simulated.
31 Define HAVE_MATHERR if on a system supporting the SysV matherr() callback.
32 (This should happen automatically.)
34 Define FLOAT_CHECK_ERRNO if the float library routines set errno.
35 This has no effect if HAVE_MATHERR is defined.
37 Define FLOAT_CATCH_SIGILL if the float library routines signal SIGILL.
38 (What systems actually do this? Let me know. -jwz)
40 Define FLOAT_CHECK_DOMAIN if the float library doesn't handle errors by
41 either setting errno, or signalling SIGFPE/SIGILL. Otherwise, domain and
42 range checking will happen before calling the float routines. This has
43 no effect if HAVE_MATHERR is defined (since matherr will be called when
44 a domain error occurs).
49 #include "syssignal.h"
55 /* The code uses emacs_rint, so that it works to undefine HAVE_RINT
56 if `rint' exists but does not work right. */
58 #define emacs_rint rint
60 static fpfloat emacs_rint(fpfloat x)
62 fpfloat r = floor(x + 0.5);
63 fpfloat diff = fabs(r - x);
64 /* Round to even and correct for any roundoff errors. */
65 if (diff >= 0.5 && (diff > 0.5 || r != 2.0 * floor(r / 2.0)))
66 r += r < x ? 1.0 : -1.0;
71 /* Nonzero while executing in floating point.
72 This tells float_error what to do. */
75 /* If an argument is out of range for a mathematical function,
76 here is the actual argument value to use in the error message. */
77 static Lisp_Object float_error_arg, float_error_arg2;
78 static const char *float_error_fn_name;
80 /* Evaluate the floating point expression D, recording NUM
81 as the original argument for error messages.
82 D is normally an assignment expression.
83 Handle errors which may result in signals or may set errno.
85 Note that float_error may be declared to return void, so you can't
86 just cast the zero after the colon to (SIGTYPE) to make the types
88 #ifdef FLOAT_CHECK_ERRNO
89 #define IN_FLOAT(d, name, num) \
91 float_error_arg = num; \
92 float_error_fn_name = name; \
93 in_float = 1; errno = 0; (d); in_float = 0; \
94 if (errno != 0) in_float_error (); \
96 #define IN_FLOAT2(d, name, num, num2) \
98 float_error_arg = num; \
99 float_error_arg2 = num2; \
100 float_error_fn_name = name; \
101 in_float = 2; errno = 0; (d); in_float = 0; \
102 if (errno != 0) in_float_error (); \
105 #define IN_FLOAT(d, name, num) (in_float = 1, (d), in_float = 0)
106 #define IN_FLOAT2(d, name, num, num2) (in_float = 2, (d), in_float = 0)
109 #define arith_error(op,arg) \
110 Fsignal (Qarith_error, list2 (build_string (op), arg))
111 #define range_error(op,arg) \
112 Fsignal (Qrange_error, list2 (build_string (op), arg))
113 #define range_error2(op,a1,a2) \
114 Fsignal (Qrange_error, list3 (build_string (op), a1, a2))
115 #define domain_error(op,arg) \
116 Fsignal (Qdomain_error, list2 (build_string (op), arg))
117 #define domain_error2(op,a1,a2) \
118 Fsignal (Qdomain_error, list3 (build_string (op), a1, a2))
120 /* Convert float to Lisp Integer if it fits, else signal a range
121 error using the given arguments.
122 If numbers from multi-prec libraries are available, range errors
126 float_to_int(fpfloat x, const char *name, Lisp_Object num, Lisp_Object num2)
128 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
129 bigz_set_fpfloat(ent_scratch_bigz, x);
130 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
132 if (name || NILP(num) || NILP(num2));
134 #else /* !HAVE_MPZ */
135 REGISTER EMACS_INT result = (EMACS_INT) x;
137 if (result > EMACS_INT_MAX || result < EMACS_INT_MIN) {
139 range_error2(name, num, num2);
141 range_error(name, num);
143 return make_int(result);
144 #endif /* HAVE_MPZ */
147 static void in_float_error(void)
154 domain_error2(float_error_fn_name, float_error_arg,
157 domain_error(float_error_fn_name, float_error_arg);
160 range_error(float_error_fn_name, float_error_arg);
163 arith_error(float_error_fn_name, float_error_arg);
169 #endif /* HAVE_FPFLOAT */
171 /* Trig functions. */
173 #if defined HAVE_MPFR && defined WITH_MPFR
174 #define MPFR_TRIG_FUN(op) do \
176 Lisp_Object bfrnumber; \
178 if (INDEFP(number)) \
179 return make_indef(NOT_A_NUMBER); \
181 bigfr_set_prec(ent_scratch_bigfr, \
182 internal_get_precision(precision)); \
184 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil); \
185 bigfr_##op(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber)); \
186 return make_bigfr_bfr(ent_scratch_bigfr); \
190 #if defined(HAVE_MPFR) && defined WITH_MPFR || defined(HAVE_FPFLOAT)
192 DEFUN("acos", Facos, 1, 2, 0, /*
193 Return the inverse cosine of NUMBER.
194 If optional argument PRECISION is non-nil, its value
195 (an integer) is used as precision.
199 #if defined HAVE_MPFR && defined WITH_MPFR
203 #else /* !HAVE_MPFR */
204 if (INDEFP(number)) {
205 return make_indef(NOT_A_NUMBER);
208 number = ent_lift(number, FLOAT_T, NULL);
210 if (FLOATP(number)) {
212 d = acos(XFLOAT_DATA(number));
213 return make_float(d);
214 } else if (INDEFP(number)) {
215 return make_indef(NOT_A_NUMBER);
218 Fsignal(Qarith_error, list1(number));
220 #endif /* HAVE_MPFR */
223 DEFUN("asin", Fasin, 1, 2, 0, /*
224 Return the inverse sine of NUMBER.
225 If optional argument PRECISION is non-nil, its value
226 (an integer) is used as precision.
230 #if defined HAVE_MPFR && defined WITH_MPFR
234 #else /* !HAVE_MPFR */
235 if (INDEFP(number)) {
236 return make_indef(NOT_A_NUMBER);
239 number = ent_lift(number, FLOAT_T, NULL);
241 if (FLOATP(number)) {
243 d = asin(XFLOAT_DATA(number));
244 return make_float(d);
245 } else if (INDEFP(number)) {
246 return make_indef(NOT_A_NUMBER);
249 Fsignal(Qarith_error, list1(number));
252 if (NILP(precision));
253 #endif /* HAVE_MPFR */
256 DEFUN("atan", Fatan, 1, 3, 0, /*
257 Return the inverse tangent of NUMBER.
258 If optional second argument NUMBER2 is provided,
259 return atan2 (NUMBER, NUMBER2).
260 If optional argument PRECISION is non-nil, its value
261 (an integer) is used as precision.
263 (number, number2, precision))
265 #if defined HAVE_MPFR && defined WITH_MPFR
269 Lisp_Object bfrnumber;
272 return make_indef(NOT_A_NUMBER);
274 bigfr_set_prec(ent_scratch_bigfr,
275 internal_get_precision(precision));
276 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
277 bigfr_atan(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
278 result = make_bigfr_bfr(ent_scratch_bigfr);
284 return make_indef(NOT_A_NUMBER);
285 if (INFINITYP(number2))
288 return make_indef(NOT_A_NUMBER);
290 bigfr_set_prec(ent_scratch_bigfr,
291 internal_get_precision(precision));
292 bfrn1 = Fcoerce_number(number, Qbigfr, Qnil);
293 bfrn2 = Fcoerce_number(number2, Qbigfr, Qnil);
294 bigfr_atan2(ent_scratch_bigfr,
297 result = make_bigfr_bfr(ent_scratch_bigfr);
302 #else /* !HAVE_MPFR */
303 if (INDEFP(number)) {
304 return make_indef(NOT_A_NUMBER);
307 number = ent_lift(number, FLOAT_T, NULL);
310 return make_indef(NOT_A_NUMBER);
312 if (NILP(number2) && FLOATP(number)) {
314 d = atan(XFLOAT_DATA(number));
315 return make_float(d);
316 } else if (FLOATP(number)) {
317 number = ent_lift(number2, FLOAT_T, NULL);
319 if (FLOATP(number2)) {
321 d = atan2(XFLOAT_DATA(number), XFLOAT_DATA(number2));
322 return make_float(d);
323 } else if (INFINITYP(number2)) {
325 } else if (INDEFP(number2)) {
326 return make_indef(NOT_A_NUMBER);
330 /* Just signal here, I'm not in the mood to distinguish cases here */
331 Fsignal(Qarith_error, list1(number));
334 if (NILP(precision));
335 #endif /* HAVE_MPFR */
338 DEFUN("cos", Fcos, 1, 2, 0, /*
339 Return the cosine of NUMBER.
340 If optional argument PRECISION is non-nil, its value
341 (an integer) is used as precision.
345 #if defined HAVE_MPFR && defined WITH_MPFR
349 #else /* !HAVE_MPFR */
350 if (INDEFP(number)) {
351 return make_indef(NOT_A_NUMBER);
354 number = ent_lift(number, FLOAT_T, NULL);
356 if (FLOATP(number)) {
358 d = cos(XFLOAT_DATA(number));
359 return make_float(d);
360 } else if (INDEFP(number)) {
361 return make_indef(NOT_A_NUMBER);
364 Fsignal(Qarith_error, list1(number));
367 if (NILP(precision));
368 #endif /* HAVE_MPFR */
371 DEFUN("sin", Fsin, 1, 2, 0, /*
372 Return the sine of NUMBER.
373 If optional argument PRECISION is non-nil, its value
374 (an integer) is used as precision.
378 #if defined HAVE_MPFR && defined WITH_MPFR
382 #else /* !HAVE_MPFR */
383 if (INDEFP(number)) {
384 return make_indef(NOT_A_NUMBER);
387 number = ent_lift(number, FLOAT_T, NULL);
389 if (FLOATP(number)) {
391 d = sin(XFLOAT_DATA(number));
392 return make_float(d);
393 } else if (INDEFP(number)) {
394 return make_indef(NOT_A_NUMBER);
397 Fsignal(Qarith_error, list1(number));
400 if (NILP(precision));
401 #endif /* HAVE_MPFR */
404 DEFUN("tan", Ftan, 1, 2, 0, /*
405 Return the tangent of NUMBER.
406 If optional argument PRECISION is non-nil, its value
407 (an integer) is used as precision.
411 #if defined HAVE_MPFR && defined WITH_MPFR
415 #else /* !HAVE_MPFR */
416 if (INDEFP(number)) {
417 return make_indef(NOT_A_NUMBER);
420 number = ent_lift(number, FLOAT_T, NULL);
422 if (FLOATP(number)) {
424 d = XFLOAT_DATA(number);
426 return make_float(d);
427 } else if (INDEFP(number)) {
428 return make_indef(NOT_A_NUMBER);
431 Fsignal(Qarith_error, list1(number));
434 if (NILP(precision));
435 #endif /* HAVE_MPFR */
438 #if defined HAVE_MPFR && defined WITH_MPFR
439 DEFUN("sec", Fsec, 1, 2, 0, /*
440 Return the secant of NUMBER.
441 If optional argument PRECISION is non-nil, its value
442 (an integer) is used as precision.
449 DEFUN("csc", Fcsc, 1, 2, 0, /*
450 Return the cosecant of NUMBER.
451 If optional argument PRECISION is non-nil, its value
452 (an integer) is used as precision.
459 DEFUN("cot", Fcot, 1, 2, 0, /*
460 Return the cotangent of NUMBER.
461 If optional argument PRECISION is non-nil, its value
462 (an integer) is used as precision.
468 #endif /* HAVE_MPFR */
470 #endif /* HAVE_MPFR || HAVE_FPFLOAT (trig functions) */
472 /* Bessel functions */
473 #if 0 /* Leave these out unless we find there's a reason for them. */
474 /* #ifdef HAVE_FPFLOAT */
476 DEFUN("bessel-j0", Fbessel_j0, 1, 1, 0, /*
477 Return the bessel function j0 of NUMBER.
481 fpfloat d = extract_float(number);
482 IN_FLOAT(d = j0(d), "bessel-j0", number);
483 return make_float(d);
486 DEFUN("bessel-j1", Fbessel_j1, 1, 1, 0, /*
487 Return the bessel function j1 of NUMBER.
491 fpfloat d = extract_float(number);
492 IN_FLOAT(d = j1(d), "bessel-j1", number);
493 return make_float(d);
496 DEFUN("bessel-jn", Fbessel_jn, 2, 2, 0, /*
497 Return the order N bessel function output jn of NUMBER.
498 The first number (the order) is truncated to an integer.
502 int i1 = extract_float(number1);
503 fpfloat f2 = extract_float(number2);
505 IN_FLOAT(f2 = jn(i1, f2), "bessel-jn", number1);
506 return make_float(f2);
509 DEFUN("bessel-y0", Fbessel_y0, 1, 1, 0, /*
510 Return the bessel function y0 of NUMBER.
514 fpfloat d = extract_float(number);
515 IN_FLOAT(d = y0(d), "bessel-y0", number);
516 return make_float(d);
519 DEFUN("bessel-y1", Fbessel_y1, 1, 1, 0, /*
520 Return the bessel function y1 of NUMBER.
524 fpfloat d = extract_float(number);
525 IN_FLOAT(d = y1(d), "bessel-y0", number);
526 return make_float(d);
529 DEFUN("bessel-yn", Fbessel_yn, 2, 2, 0, /*
530 Return the order N bessel function output yn of NUMBER.
531 The first number (the order) is truncated to an integer.
535 int i1 = extract_float(number1);
536 fpfloat f2 = extract_float(number2);
538 IN_FLOAT(f2 = yn(i1, f2), "bessel-yn", number1);
539 return make_float(f2);
542 #endif /* 0 (bessel functions) */
545 /* Error functions. */
546 #if defined(HAVE_MPFR) && defined WITH_MPFR || defined(HAVE_FPFLOAT)
547 DEFUN("erf", Ferf, 1, 2, 0, /*
548 Return the mathematical error function of NUMBER.
552 #if defined HAVE_MPFR && defined WITH_MPFR
556 #else /* !HAVE_MPFR */
557 if (INDEFP(number)) {
558 return make_indef(NOT_A_NUMBER);
561 number = ent_lift(number, FLOAT_T, NULL);
563 if (FLOATP(number)) {
565 d = erf(XFLOAT_DATA(number));
566 return make_float(d);
567 } else if (INDEFP(number)) {
568 return make_indef(NOT_A_NUMBER);
571 Fsignal(Qarith_error, list1(number));
574 if (NILP(precision));
575 #endif /* HAVE_MPFR */
578 DEFUN("erfc", Ferfc, 1, 2, 0, /*
579 Return the complementary error function of NUMBER.
583 #if defined HAVE_MPFR && defined WITH_MPFR
587 #else /* !HAVE_MPFR */
588 if (INDEFP(number)) {
589 return make_indef(NOT_A_NUMBER);
592 number = ent_lift(number, FLOAT_T, NULL);
594 if (FLOATP(number)) {
596 d = erfc(XFLOAT_DATA(number));
597 return make_float(d);
598 } else if (INDEFP(number)) {
599 return make_indef(NOT_A_NUMBER);
602 Fsignal(Qarith_error, list1(number));
605 if (NILP(precision));
606 #endif /* HAVE_MPFR */
609 DEFUN("log-gamma", Flog_gamma, 1, 2, 0, /*
610 Return the log gamma of NUMBER.
614 #if defined HAVE_MPFR && defined WITH_MPFR
616 MPFR_TRIG_FUN(lgamma);
618 #else /* !HAVE_MPFR */
619 if (INDEFP(number)) {
620 return make_indef(NOT_A_NUMBER);
623 number = ent_lift(number, FLOAT_T, NULL);
625 if (FLOATP(number)) {
627 d = lgamma(XFLOAT_DATA(number));
628 return make_float(d);
629 } else if (INDEFP(number)) {
630 return make_indef(NOT_A_NUMBER);
633 Fsignal(Qarith_error, list1(number));
636 if (NILP(precision));
637 #endif /* HAVE_MPFR */
639 #endif /* HAVE_FPFLOAT || HAVE_MPFR */
642 /* Root and Log functions. */
644 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR
645 DEFUN("exp", Fexp, 1, 2, 0, /*
646 Return the exponential base e of NUMBER.
647 If optional argument PRECISION is non-nil, its value
648 (an integer) is used as precision.
652 /* Attention, somehow the precision must be large enough to make the result
653 * fit, otherwise this is a good memory test :)
655 #if defined(HAVE_MPFR) && defined WITH_MPFR || \
656 defined(HAVE_MPC) && defined WITH_MPC || \
657 defined HAVE_PSEUC && defined WITH_PSEUC
659 if (INDEFP(number)) {
660 if (XINDEF_DATA(number) == POS_INFINITY)
662 else if (XINDEF_DATA(number) == NEG_INFINITY)
663 return Fcoerce_number(Qzero, Qbigfr, precision);
668 if (COMPARABLEP(number)) {
669 #if defined HAVE_MPFR && defined WITH_MPFR
670 Lisp_Object bfrnumber;
672 bigfr_set_prec(ent_scratch_bigfr,
673 internal_get_precision(precision));
675 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
676 bigfr_exp(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
677 return make_bigfr_bfr(ent_scratch_bigfr);
679 #endif /* HAVE_MPFR */
680 #if defined HAVE_MPC && defined WITH_MPC || \
681 defined HAVE_PSEUC && defined WITH_PSEUC
682 } else if (BIGCP(number)) {
683 bigc_set_prec(ent_scratch_bigc,
684 internal_get_precision(precision));
686 bigc_exp(ent_scratch_bigc, XBIGC_DATA(number));
687 return make_bigc_bc(ent_scratch_bigc);
688 #endif /* HAVE_MPC */
691 return wrong_type_argument(Qnumberp, number);
692 #else /* !HAVE_MPFR && !HAVE_MPC */
693 if (INDEFP(number)) {
697 number = ent_lift(number, FLOAT_T, NULL);
699 if (FLOATP(number)) {
701 d = exp(XFLOAT_DATA(number));
702 return make_float(d);
703 } else if (INDEFP(number)) {
705 if (XINDEF_DATA(number) == POS_INFINITY)
707 else if (XINDEF_DATA(number) == NEG_INFINITY)
708 return Fcoerce_number(Qzero, Qfloat, precision);
713 Fsignal(Qarith_error, list1(number));
716 if (NILP(precision));
717 #endif /* HAVE_MPFR */
719 #endif /* HAVE_FPFLOAT || HAVE_MPFR */
721 DEFUN("2^", Fexp2, 1, 2, 0, /*
722 Return the exponential of NUMBER to 2 power.
723 If optional argument PRECISION is non-nil, its value
724 \(an integer\) is used as precision in float computations.
728 #if defined HAVE_MPFR && defined WITH_MPFR
729 Lisp_Object bfrnumber;
731 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
733 return _ent_binop(ASE_BINARY_OP_POW,
734 INT_T, make_int(2), INT_T, number);
737 return _ent_binop(ASE_BINARY_OP_POW,
738 INT_T, make_int(2), INDEF_T, number);
740 #if defined HAVE_MPFR && defined WITH_MPFR
741 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
742 bigfr_set_prec(ent_scratch_bigfr,
743 internal_get_precision(precision));
745 bigfr_exp2(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
746 return make_bigfr_bfr(ent_scratch_bigfr);
749 if (NILP(precision));
753 DEFUN("10^", Fexp10, 1, 2, 0, /*
754 Return the exponential of NUMBER to 10 power.
755 If optional argument PRECISION is non-nil, its value
756 \(an integer\) is used as precision in float computations.
760 #if defined HAVE_MPFR && defined WITH_MPFR
761 Lisp_Object bfrnumber;
763 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
765 return _ent_binop(ASE_BINARY_OP_POW,
766 INT_T, make_int(10), INT_T, number);
769 return _ent_binop(ASE_BINARY_OP_POW,
770 INT_T, make_int(10), INDEF_T, number);
772 #if defined HAVE_MPFR && defined WITH_MPFR
773 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
774 bigfr_set_prec(ent_scratch_bigfr,
775 internal_get_precision(precision));
777 bigfr_exp10(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
778 return make_bigfr_bfr(ent_scratch_bigfr);
781 if (NILP(precision));
785 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR
786 DEFUN("log", Flog, 1, 3, 0, /*
787 Return the natural logarithm of NUMBER.
788 If second optional argument BASE is given, return the logarithm of
789 NUMBER using that base.
790 If third optional argument PRECISION is given, use its value
791 (an integer) as precision.
793 (number, base, precision))
795 #if defined HAVE_MPFR && defined WITH_MPFR
796 Lisp_Object bfrnumber;
799 Lisp_Object _logn, _logb;
800 _logn = Flog(number, Qnil, precision);
801 if (UNLIKELY(INDEFP(_logn))) {
804 _logb = Flog(base, Qnil, precision);
805 return ent_binop(ASE_BINARY_OP_QUO, _logn, _logb);
808 if (INDEFP(number)) {
809 if (XINDEF_DATA(number) == POS_INFINITY) {
811 } else if (XINDEF_DATA(number) == NEG_INFINITY) {
812 return make_indef(NOT_A_NUMBER);
818 bigfr_set_prec(ent_scratch_bigfr,
819 internal_get_precision(precision));
821 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
822 bigfr_log(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
823 return make_bigfr_bfr(ent_scratch_bigfr);
825 #else /* !HAVE_MPFR */
826 if (INDEFP(number)) {
830 number = ent_lift(number, FLOAT_T, NULL);
832 if (FLOATP(number)) {
834 d = log(XFLOAT_DATA(number));
835 return make_float(d);
836 } else if (INDEFP(number)) {
838 if (XINDEF_DATA(number) == POS_INFINITY) {
840 } else if (XINDEF_DATA(number) == NEG_INFINITY) {
841 return make_indef(NOT_A_NUMBER);
847 Fsignal(Qarith_error, list1(number));
850 if (NILP(precision));
851 #endif /* HAVE_MPFR */
854 DEFUN("log10", Flog10, 1, 2, 0, /*
855 Return the logarithm base 10 of NUMBER.
856 If second optional argument PRECISION is given, use its value
857 (an integer) as precision.
861 #if defined HAVE_MPFR && defined WITH_MPFR
862 Lisp_Object bfrnumber;
864 if (INDEFP(number)) {
865 if (XINDEF_DATA(number) == POS_INFINITY)
867 else if (XINDEF_DATA(number) == NEG_INFINITY)
868 return make_indef(NOT_A_NUMBER);
873 bigfr_set_prec(ent_scratch_bigfr,
874 internal_get_precision(precision));
876 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
877 bigfr_log10(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
878 return make_bigfr_bfr(ent_scratch_bigfr);
880 #else /* !HAVE_MPFR */
881 if (INDEFP(number)) {
885 number = ent_lift(number, FLOAT_T, NULL);
887 if (FLOATP(number)) {
889 d = log10(XFLOAT_DATA(number));
890 return make_float(d);
891 } else if (INDEFP(number)) {
893 if (XINDEF_DATA(number) == POS_INFINITY)
895 else if (XINDEF_DATA(number) == NEG_INFINITY)
896 return make_indef(NOT_A_NUMBER);
901 Fsignal(Qarith_error, list1(number));
904 if (NILP(precision));
905 #endif /* HAVE_MPFR */
908 #if defined HAVE_MPFR && defined WITH_MPFR
909 DEFUN("log2", Flog2, 1, 2, 0, /*
910 Return the logarithm base 2 of NUMBER.
911 If second optional argument PRECISION is given, use its value
912 (an integer) as precision.
916 Lisp_Object bfrnumber;
918 if (INDEFP(number)) {
919 if (XINDEF_DATA(number) == POS_INFINITY)
921 else if (XINDEF_DATA(number) == NEG_INFINITY)
922 return make_indef(NOT_A_NUMBER);
927 bigfr_set_prec(ent_scratch_bigfr,
928 internal_get_precision(precision));
930 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
931 bigfr_log2(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
932 return make_bigfr_bfr(ent_scratch_bigfr);
934 #endif /* HAVE_MPFR */
937 DEFUN("sqrt", Fsqrt, 1, 2, 0, /*
938 Return the square root of NUMBER.
939 If second optional argument PRECISION is given, use its value
940 (an integer) as precision.
944 #if defined(HAVE_MPFR) && defined WITH_MPFR || \
945 defined(HAVE_MPC) && defined WITH_MPC || \
946 defined(HAVE_PSEUC) && defined WITH_PSEUC
948 if (INDEFP(number)) {
949 if (XINDEF_DATA(number) == POS_INFINITY)
951 else if (XINDEF_DATA(number) == NEG_INFINITY)
952 return make_indef(COMPLEX_INFINITY);
957 if (COMPARABLEP(number)) {
958 #if defined HAVE_MPFR && defined WITH_MPFR
959 bigfr_set_prec(ent_scratch_bigfr,
960 internal_get_precision(precision));
963 bigfr_sqrt_ui(ent_scratch_bigfr,
964 (unsigned long)XUINT(number));
965 else if (BIGZP(number) &&
966 bigz_fits_ulong_p(XBIGZ_DATA(number)) &&
967 bigz_sign(XBIGZ_DATA(number)) >= 0) {
968 bigfr_sqrt_ui(ent_scratch_bigfr,
969 (unsigned long)bigz_to_ulong(
970 XBIGZ_DATA(number)));
971 } else if (!NILP(Fnonnegativep(number))) {
972 Lisp_Object bfrnumber;
973 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
974 bigfr_sqrt(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
976 #if defined HAVE_MPC && defined WITH_MPC || \
977 defined HAVE_PSEUC && defined WITH_PSEUC
978 Lisp_Object bcnumber;
979 bigc_set_prec(ent_scratch_bigc,
980 internal_get_precision(precision));
981 bcnumber = Fcoerce_number(number, Qbigc, precision);
982 bigc_sqrt(ent_scratch_bigc, XBIGC_DATA(bcnumber));
983 return make_bigc_bc(ent_scratch_bigc);
984 #else /* !HAVE_MPC */
985 Lisp_Object bfrnumber;
986 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
987 bigfr_sqrt(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
988 #endif /* HAVE_MPC */
990 return make_bigfr_bfr(ent_scratch_bigfr);
991 #endif /* HAVE_MPFR */
992 #if defined HAVE_MPC && defined WITH_MPC || \
993 defined HAVE_PSEUC && defined WITH_PSEUC
994 } else if (BIGCP(number) || BIGGP(number)) {
995 Lisp_Object bcnumber;
996 bigc_set_prec(ent_scratch_bigc,
997 internal_get_precision(precision));
999 bcnumber = Fcoerce_number(number, Qbigc, precision);
1000 bigc_sqrt(ent_scratch_bigc, XBIGC_DATA(bcnumber));
1001 return make_bigc_bc(ent_scratch_bigc);
1002 #endif /* HAVE_MPC */
1005 if (NILP(precision));
1006 return wrong_type_argument(Qnumberp, number);
1008 #else /* !HAVE_MPFR && !HAVE_MPC */
1009 if (INDEFP(number)) {
1013 number = ent_lift(number, FLOAT_T, NULL);
1015 if (FLOATP(number)) {
1017 d = sqrt(XFLOAT_DATA(number));
1018 return make_float(d);
1019 } else if (INDEFP(number)) {
1021 if (XINDEF_DATA(number) == POS_INFINITY)
1023 else if (XINDEF_DATA(number) == NEG_INFINITY)
1024 return make_indef(COMPLEX_INFINITY);
1029 Fsignal(Qarith_error, list1(number));
1032 if (NILP(precision));
1033 #endif /* HAVE_MPFR */
1036 DEFUN("cube-root", Fcube_root, 1, 2, 0, /*
1037 Return the cube root of NUMBER.
1038 If second optional argument PRECISION is given, use its value
1039 (an integer) as precision.
1041 (number, precision))
1043 #if defined HAVE_MPFR && defined WITH_MPFR
1044 Lisp_Object bfrnumber;
1049 bigfr_set_prec(ent_scratch_bigfr,
1050 internal_get_precision(precision));
1052 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
1053 bigfr_cbrt(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
1054 return make_bigfr_bfr(ent_scratch_bigfr);
1056 #else /* !HAVE_MPFR */
1057 if (INDEFP(number)) {
1061 number = ent_lift(number, FLOAT_T, NULL);
1063 if (FLOATP(number)) {
1066 d = cbrt(XFLOAT_DATA(number));
1068 d = XFLOAT_DATA(number);
1070 d = pow(d, 1.0 / 3.0);
1072 d = -pow(-d, 1.0 / 3.0);
1074 return make_float(d);
1075 } else if (INDEFP(number)) {
1080 Fsignal(Qarith_error, list1(number));
1083 if (NILP(precision));
1084 #endif /* HAVE_MPFR */
1086 #endif /* HAVE_FPFLOAT || MPFR */
1089 #if defined HAVE_MPFR && defined WITH_MPFR
1090 DEFUN("root", Froot, 2, 3, 0, /*
1091 Return the RADIX-th root of NUMBER.
1092 If third optional argument PRECISION is given, use its value
1093 (an integer) as precision.
1095 (number, radix, precision))
1097 Lisp_Object bfrnumber;
1099 if (!NATNUMP(radix)) {
1100 dead_wrong_type_argument(Qnatnump, radix);
1104 if (INDEFP(number)) {
1105 if (XINDEF_DATA(number) == POS_INFINITY)
1107 else if (XINDEF_DATA(number) == NEG_INFINITY)
1108 return make_indef(COMPLEX_INFINITY);
1113 bigfr_set_prec(ent_scratch_bigfr,
1114 internal_get_precision(precision));
1116 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
1117 bigfr_root(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber), XUINT(radix));
1118 return make_bigfr_bfr(ent_scratch_bigfr);
1120 #endif /* HAVE_MPFR */
1123 /* (Inverse) hyperbolic trig functions. */
1124 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR
1126 DEFUN("acosh", Facosh, 1, 2, 0, /*
1127 Return the inverse hyperbolic cosine of NUMBER.
1128 If optional argument PRECISION is non-nil, its value
1129 (an integer) is used as precision.
1131 (number, precision))
1133 #if defined HAVE_MPFR && defined WITH_MPFR
1135 MPFR_TRIG_FUN(acosh);
1137 #else /* !HAVE_MPFR */
1138 if (INDEFP(number)) {
1139 return make_indef(NOT_A_NUMBER);
1142 number = ent_lift(number, FLOAT_T, NULL);
1144 if (FLOATP(number)) {
1145 fpfloat d = XFLOAT_DATA(number);
1146 #ifdef HAVE_INVERSE_HYPERBOLIC
1149 d = log(d + sqrt(d * d - 1.0));
1151 return make_float(d);
1152 } else if (INDEFP(number)) {
1153 return make_indef(NOT_A_NUMBER);
1156 Fsignal(Qarith_error, list1(number));
1159 if (NILP(precision));
1160 #endif /* HAVE_MPFR */
1163 DEFUN("asinh", Fasinh, 1, 2, 0, /*
1164 Return the inverse hyperbolic sine of NUMBER.
1165 If optional argument PRECISION is non-nil, its value
1166 (an integer) is used as precision.
1168 (number, precision))
1170 #if defined HAVE_MPFR && defined WITH_MPFR
1172 MPFR_TRIG_FUN(asinh);
1174 #else /* !HAVE_MPFR */
1175 if (INDEFP(number)) {
1176 return make_indef(NOT_A_NUMBER);
1179 number = ent_lift(number, FLOAT_T, NULL);
1181 if (FLOATP(number)) {
1182 fpfloat d = XFLOAT_DATA(number);
1183 #ifdef HAVE_INVERSE_HYPERBOLIC
1186 d = log(d + sqrt(d * d + 1.0));
1188 return make_float(d);
1189 } else if (INDEFP(number)) {
1190 return make_indef(NOT_A_NUMBER);
1193 Fsignal(Qarith_error, list1(number));
1196 if (NILP(precision));
1197 #endif /* HAVE_MPFR */
1200 DEFUN("atanh", Fatanh, 1, 2, 0, /*
1201 Return the inverse hyperbolic tangent of NUMBER.
1202 If optional argument PRECISION is non-nil, its value
1203 (an integer) is used as precision.
1205 (number, precision))
1207 #if defined HAVE_MPFR && defined WITH_MPFR
1209 MPFR_TRIG_FUN(atanh);
1211 #else /* !HAVE_MPFR */
1212 if (INDEFP(number)) {
1213 return make_indef(NOT_A_NUMBER);
1216 number = ent_lift(number, FLOAT_T, NULL);
1218 if (FLOATP(number)) {
1219 fpfloat d = XFLOAT_DATA(number);
1220 #ifdef HAVE_INVERSE_HYPERBOLIC
1223 d = 0.5 * log((1.0 + d) / (1.0 - d));
1225 return make_float(d);
1226 } else if (INDEFP(number)) {
1227 return make_indef(NOT_A_NUMBER);
1230 Fsignal(Qarith_error, list1(number));
1233 if (NILP(precision));
1234 #endif /* HAVE_MPFR */
1237 DEFUN("cosh", Fcosh, 1, 2, 0, /*
1238 Return the hyperbolic cosine of NUMBER.
1239 If optional argument PRECISION is non-nil, its value
1240 (an integer) is used as precision.
1242 (number, precision))
1244 #if defined HAVE_MPFR && defined WITH_MPFR
1246 MPFR_TRIG_FUN(cosh);
1248 #else /* !HAVE_MPFR */
1249 if (INDEFP(number)) {
1250 return make_indef(NOT_A_NUMBER);
1253 number = ent_lift(number, FLOAT_T, NULL);
1255 if (FLOATP(number)) {
1257 d = cosh(XFLOAT_DATA(number));
1258 return make_float(d);
1259 } else if (INDEFP(number)) {
1260 return make_indef(NOT_A_NUMBER);
1263 Fsignal(Qarith_error, list1(number));
1266 if (NILP(precision));
1267 #endif /* HAVE_MPFR */
1270 DEFUN("sinh", Fsinh, 1, 2, 0, /*
1271 Return the hyperbolic sine of NUMBER.
1272 If optional argument PRECISION is non-nil, its value
1273 (an integer) is used as precision.
1275 (number, precision))
1277 #if defined HAVE_MPFR && defined WITH_MPFR
1279 MPFR_TRIG_FUN(sinh);
1281 #else /* !HAVE_MPFR */
1282 if (INDEFP(number)) {
1283 return make_indef(NOT_A_NUMBER);
1286 number = ent_lift(number, FLOAT_T, NULL);
1288 if (FLOATP(number)) {
1290 d = sinh(XFLOAT_DATA(number));
1291 return make_float(d);
1292 } else if (INDEFP(number)) {
1293 return make_indef(NOT_A_NUMBER);
1296 Fsignal(Qarith_error, list1(number));
1299 if (NILP(precision));
1300 #endif /* HAVE_MFPR */
1303 DEFUN("tanh", Ftanh, 1, 2, 0, /*
1304 Return the hyperbolic tangent of NUMBER.
1305 If optional argument PRECISION is non-nil, its value
1306 (an integer) is used as precision.
1308 (number, precision))
1310 #if defined HAVE_MPFR && defined WITH_MPFR
1312 MPFR_TRIG_FUN(tanh);
1314 #else /* !HAVE_MPFR */
1315 if (INDEFP(number)) {
1316 return make_indef(NOT_A_NUMBER);
1319 number = ent_lift(number, FLOAT_T, NULL);
1321 if (FLOATP(number)) {
1322 fpfloat d = XFLOAT_DATA(number);
1324 return make_float(d);
1325 } else if (INDEFP(number)) {
1326 return make_indef(NOT_A_NUMBER);
1329 Fsignal(Qarith_error, list1(number));
1332 if (NILP(precision));
1333 #endif /* HAVE_MPFR */
1336 #if defined HAVE_MPFR && defined WITH_MPFR
1338 DEFUN("sech", Fsech, 1, 2, 0, /*
1339 Return the hyperbolic secant of NUMBER.
1340 If optional argument PRECISION is non-nil, its value
1341 (an integer) is used as precision.
1343 (number, precision))
1345 MPFR_TRIG_FUN(sech);
1348 DEFUN("csch", Fcsch, 1, 2, 0, /*
1349 Return the hyperbolic cosecant of NUMBER.
1350 If optional argument PRECISION is non-nil, its value
1351 (an integer) is used as precision.
1353 (number, precision))
1355 MPFR_TRIG_FUN(csch);
1358 DEFUN("coth", Fcoth, 1, 2, 0, /*
1359 Return the hyperbolic cotangent of NUMBER.
1360 If optional argument PRECISION is non-nil, its value
1361 (an integer) is used as precision.
1363 (number, precision))
1365 MPFR_TRIG_FUN(coth);
1367 #endif /* HAVE_MPFR */
1369 #endif /* HAVE_MPFR || HAVE_FPFLOAT (inverse trig functions) */
1372 /* Rounding functions */
1374 DEFUN("abs", Fabs, 1, 1, 0, /*
1375 Return the absolute value of NUMBER.
1380 if (FLOATP(number)) {
1381 return make_float(fabs(XFLOAT_DATA(number)));
1383 #endif /* HAVE_FPFLOAT */
1386 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1387 /* The most negative Lisp int will overflow */
1388 return (XINT(number) >= 0)
1389 ? number : make_integer(-XINT(number));
1390 #else /* !HAVE_MPZ */
1391 return (XINT(number) >= 0) ? number : make_int(-XINT(number));
1392 #endif /* HAVE_MPZ */
1395 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1396 if (BIGZP(number)) {
1397 if (bigz_sign(XBIGZ_DATA(number)) >= 0)
1400 bigz_abs(ent_scratch_bigz, XBIGZ_DATA(number));
1401 return make_bigz_bz(ent_scratch_bigz);
1403 #endif /* HAVE_MPZ */
1405 #if defined HAVE_MPQ && defined WITH_GMP
1406 if (BIGQP(number)) {
1407 if (bigq_sign(XBIGQ_DATA(number)) >= 0)
1410 bigq_abs(ent_scratch_bigq, XBIGQ_DATA(number));
1411 return make_bigq_bq(ent_scratch_bigq);
1413 #endif /* HAVE_MPQ */
1415 #if defined HAVE_MPF && defined WITH_GMP
1416 if (BIGFP(number)) {
1417 if (bigf_sign(XBIGF_DATA (number)) >= 0)
1420 bigf_set_prec(ent_scratch_bigf, XBIGF_GET_PREC(number));
1422 bigf_abs(ent_scratch_bigf, XBIGF_DATA(number));
1423 return make_bigf_bf(ent_scratch_bigf);
1425 #endif /* HAVE_MPF */
1427 #if defined HAVE_MPFR && defined WITH_MPFR
1428 if (BIGFRP(number)) {
1429 if (bigfr_sign(XBIGFR_DATA (number)) >= 0)
1432 bigfr_set_prec(ent_scratch_bigfr, XBIGFR_GET_PREC(number));
1434 bigfr_abs(ent_scratch_bigfr, XBIGFR_DATA(number));
1435 return make_bigfr_bfr(ent_scratch_bigfr);
1437 #endif /* HAVE_MPFR */
1439 #if defined(HAVE_PSEUG) && defined WITH_PSEUG && defined(HAVE_MPFR)
1440 if (BIGGP(number)) {
1441 bigfr_set_prec(ent_scratch_bigfr,
1442 internal_get_precision(Qnil));
1444 bigg_abs(ent_scratch_bigfr, XBIGG_DATA(number));
1445 return make_bigfr_bfr(ent_scratch_bigfr);
1447 #endif /* HAVE_PSEUG && HAVE_MPFR */
1449 #if defined HAVE_MPC && defined WITH_MPC || \
1450 defined HAVE_PSEUC && defined WITH_PSEUC
1451 if (BIGCP(number)) {
1452 bigfr_set_prec(ent_scratch_bigfr, XBIGC_GET_PREC(number));
1454 if (bigc_nan_p(XBIGC_DATA(number)))
1455 return make_indef(NOT_A_NUMBER);
1456 else if (bigc_inf_p(XBIGC_DATA(number)))
1457 return make_indef(POS_INFINITY);
1459 bigc_abs(ent_scratch_bigfr, XBIGC_DATA(number));
1461 return make_bigfr_bfr(ent_scratch_bigfr);
1463 #endif /* HAVE_PSEUG */
1465 if (INDEFP(number)) {
1466 if (XINDEF_DATA(number) == POS_INFINITY)
1468 else if (XINDEF_DATA(number) == NEG_INFINITY)
1469 return make_indef(POS_INFINITY);
1474 return Fabs(wrong_type_argument(Qnumberp, number));
1477 #if defined(HAVE_FPFLOAT)
1478 /* fuck fuck fuck, I want this in number.el */
1479 DEFUN("float", Ffloat, 1, 1, 0, /*
1480 Return the floating point number numerically equal to NUMBER.
1484 /* Just create the float in order of preference */
1485 return Fcoerce_number(number, Qfloat, Qnil);
1487 #endif /* HAVE_FPFLOAT */
1490 DEFUN("logb", Flogb, 1, 1, 0, /*
1491 Return largest integer <= the base 2 log of the magnitude of NUMBER.
1492 This is the same as the exponent of a float.
1496 fpfloat f = extract_float(number);
1499 return make_int(EMACS_INT_MIN);
1502 fpfloat _lb = logb(f);
1504 IN_FLOAT(val = make_int((EMACS_INT)_lb), "logb", number);
1511 IN_FLOAT(frexp(f, &exqp), "logb", number);
1512 return make_int(exqp - 1);
1523 for (i = 1, d = 0.5; d * d >= f; i += i)
1529 for (i = 1, d = 2.0; d * d <= f; i += i)
1534 return make_int(val);
1536 #endif /* ! HAVE_FREXP */
1537 #endif /* ! HAVE_LOGB */
1539 #endif /* HAVE_FPFLOAT */
1541 DEFUN("ceiling", Fceiling, 1, 1, 0, /*
1542 Return the smallest integer no less than NUMBER. (Round toward +inf.)
1547 if (FLOATP(number)) {
1549 d = ceil(XFLOAT_DATA(number));
1550 return (float_to_int(d, "ceiling", number, Qunbound));
1552 #endif /* HAVE_FPFLOAT */
1554 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1555 if (INTEGERP(number))
1556 #else /* !HAVE_MPZ */
1558 #endif /* HAVE_MPZ */
1561 #if defined(HAVE_MPQ) && defined(HAVE_MPZ) && defined WITH_GMP
1562 if (BIGQP(number)) {
1563 bigz_ceil(ent_scratch_bigz,
1564 XBIGQ_NUMERATOR(number),
1565 XBIGQ_DENOMINATOR(number));
1566 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1570 #if defined HAVE_MPF && defined WITH_GMP
1571 else if (BIGFP(number)) {
1572 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1573 bigf_ceil(ent_scratch_bigf, XBIGF_DATA(number));
1574 bigz_set_bigf(ent_scratch_bigz, ent_scratch_bigf);
1575 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1576 #else /* !HAVE_MPZ */
1577 bigf_ceil(ent_scratch_bigf, XBIGF_DATA(number));
1578 return make_int((EMACS_INT)bigf_to_long(ent_scratch_bigf));
1579 #endif /* HAVE_MPZ */
1581 #endif /* HAVE_MPF */
1583 #if defined HAVE_MPFR && defined WITH_MPFR
1584 else if (BIGFRP(number)) {
1585 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1586 bigfr_ceil(ent_scratch_bigfr, XBIGFR_DATA(number));
1587 bigz_set_bigfr(ent_scratch_bigz, ent_scratch_bigfr);
1588 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1589 #else /* !HAVE_MPZ */
1590 bigfr_ceil(ent_scratch_bigfr, XBIGFR_DATA(number));
1591 return make_int((EMACS_INT)bigfr_to_long(ent_scratch_bigfr));
1592 #endif /* HAVE_MPZ */
1594 #endif /* HAVE_MPFR */
1599 #if defined HAVE_MPC && defined WITH_MPC || \
1600 defined HAVE_PSEUC && defined WITH_PSEUC || \
1601 defined HAVE_PSEUG && defined WITH_PSEUG
1602 return Fceiling(wrong_type_argument(Qcomparablep, number));
1603 #else /* !HAVE_MPC */
1604 return Fceiling(wrong_type_argument(Qnumberp, number));
1605 #endif /* HAVE_MPC */
1608 DEFUN("floor", Ffloor, 1, 2, 0, /*
1609 Return the largest integer no greater than NUMBER. (Round towards -inf.)
1610 With optional second argument DIVISOR, return the largest integer no
1611 greater than NUMBER/DIVISOR.
1615 ase_object_type_t ntquo;
1618 CHECK_COMPARABLE(number);
1619 if (NILP(divisor)) {
1620 return Ffloor(number, make_int(1L));
1624 /* !NILP(divisor) */
1626 CHECK_COMPARABLE(divisor);
1628 if (INTEGERP(number) && INTEGERP(divisor)) {
1629 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1630 /* this is the optimised version, since
1631 * bigz_floor always takes two arguments
1633 number = ent_lift(number, BIGZ_T, NULL);
1634 divisor = ent_lift(divisor, BIGZ_T, NULL);
1636 bigz_floor(ent_scratch_bigz,
1638 XBIGZ_DATA(divisor));
1639 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1641 number = ent_lift(number, FLOAT_T, NULL);
1642 divisor = ent_lift(divisor, FLOAT_T, NULL);
1646 quo = ent_binop(ASE_BINARY_OP_QUO, number, divisor);
1647 ntquo = ase_optable_index(quo);
1650 case INT_T: /* trivial */
1657 IN_FLOAT((d = floor(XFLOAT_DATA(quo))), "floor", quo);
1658 return (float_to_int(d, "floor", quo, Qunbound));
1661 #if defined(HAVE_MPQ) && defined(HAVE_MPZ) && defined WITH_GMP
1662 bigz_floor(ent_scratch_bigz,
1663 XBIGQ_NUMERATOR(quo), XBIGQ_DENOMINATOR(quo));
1664 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1670 #if defined HAVE_MPF && defined WITH_GMP
1671 bigf_floor(ent_scratch_bigf, XBIGF_DATA(quo));
1672 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1673 bigz_set_bigf(ent_scratch_bigz, ent_scratch_bigf);
1674 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1675 #else /* !HAVE_MPZ */
1677 (EMACS_INT)bigf_to_long(ent_scratch_bigf));
1678 #endif /* HAVE_MPZ */
1680 #endif /* HAVE_MPF */
1683 #if defined HAVE_MPFR && defined WITH_MPFR
1684 bigfr_floor(ent_scratch_bigfr, XBIGFR_DATA(quo));
1685 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1686 bigz_set_bigfr(ent_scratch_bigz, ent_scratch_bigfr);
1687 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1688 #else /* !HAVE_MPZ */
1690 (EMACS_INT)bigfr_to_long(ent_scratch_bigfr));
1691 #endif /* HAVE_MPZ */
1693 #endif /* HAVE_MPFR */
1699 return Fsignal(Qdomain_error, Qnil);
1702 DEFUN("round", Fround, 1, 1, 0, /*
1703 Return the nearest integer to NUMBER.
1705 NUMBER has to have an archimedian valuation, #'round returns the
1706 integer z for which | number - z | is minimal.
1711 if (FLOATP(number)) {
1713 /* Screw the prevailing rounding mode. */
1714 d = emacs_rint(XFLOAT_DATA(number));
1715 return (float_to_int(d, "round", number, Qunbound));
1717 #endif /* HAVE_FPFLOAT */
1719 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1720 if (INTEGERP(number))
1721 #else /* !HAVE_MPZ */
1723 #endif /* HAVE_MPZ */
1726 #if defined(HAVE_MPQ) && defined(HAVE_MPZ) && defined WITH_GMP
1727 else if (BIGQP(number)) {
1728 /* first off, let's create the division, remainder as well */
1730 mpz_tdiv_qr(ent_scratch_bigz,
1731 bigq_numerator(ent_scratch_bigq),
1732 XBIGQ_NUMERATOR(number),
1733 XBIGQ_DENOMINATOR(number));
1735 /* <- denom(number) * 2 */
1736 mpz_mul_2exp(bigq_numerator(ent_scratch_bigq),
1737 bigq_numerator(ent_scratch_bigq), 1);
1739 /* check if we had to add one */
1740 if (mpz_cmpabs(bigq_numerator(ent_scratch_bigq),
1741 XBIGQ_DENOMINATOR(number)) >= 0) {
1742 /* >= ceil(denom(number) / 2) */
1743 if (mpz_sgn(bigq_numerator(ent_scratch_bigq)) > 0) {
1744 mpz_add_ui(ent_scratch_bigz,
1745 ent_scratch_bigz, 1UL);
1747 mpz_sub_ui(ent_scratch_bigz,
1748 ent_scratch_bigz, 1UL);
1751 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1753 #endif /* HAVE_MPQ && HAVE_MPZ */
1755 #if defined HAVE_MPF && defined WITH_GMP
1756 else if (BIGFP(number)) {
1757 warn_when_safe(Qbigf, Qnotice,
1758 "rounding number of type 'bigf (mpf-floats)"
1759 "not yet implemented");
1762 #endif /* HAVE_MPF */
1764 #if defined HAVE_MPFR && defined WITH_MPFR
1765 else if (BIGFRP(number)) {
1766 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1767 bigfr_rint(ent_scratch_bigfr, XBIGFR_DATA(number));
1768 bigz_set_bigfr(ent_scratch_bigz, ent_scratch_bigfr);
1769 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1770 #else /* !HAVE_MPZ */
1771 bigfr_rint(ent_scratch_bigfr, XBIGFR_DATA(number));
1772 return make_int((EMACS_INT)bigfr_to_long(ent_scratch_bigfr));
1773 #endif /* HAVE_MPZ */
1775 #endif /* HAVE_MPFR */
1777 else if (INDEFP(number))
1780 #if defined HAVE_MPC && defined WITH_MPC || \
1781 defined HAVE_PSEUC && defined WITH_PSEUC || \
1782 defined HAVE_PSEUG && defined WITH_PSEUG
1783 return Fround(wrong_type_argument(Qcomparablep, number));
1784 #else /* !HAVE_MPC */
1785 return Fround(wrong_type_argument(Qnumberp, number));
1786 #endif /* HAVE_MPC */
1789 DEFUN("truncate", Ftruncate, 1, 1, 0, /*
1790 Truncate a floating point number to an integer.
1791 Rounds the value toward zero.
1797 return float_to_int(XFLOAT_DATA(number), "truncate", number,
1799 #endif /* HAVE_FPFLOAT */
1801 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1802 if (INTEGERP(number))
1803 #else /* !HAVE_MPZ */
1805 #endif /* HAVE_MPZ */
1808 #if defined HAVE_MPQ && defined WITH_GMP
1809 else if (BIGQP(number)) {
1810 bigz_div(ent_scratch_bigz,
1811 XBIGQ_NUMERATOR(number),
1812 XBIGQ_DENOMINATOR(number));
1813 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1817 #if defined HAVE_MPF && defined WITH_GMP
1818 else if (BIGFP(number)) {
1819 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1820 bigf_trunc(ent_scratch_bigf, XBIGF_DATA(number));
1821 bigz_set_bigf(ent_scratch_bigz, ent_scratch_bigf);
1822 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1823 #else /* !HAVE_MPZ */
1824 bigf_trunc(ent_scratch_bigf, XBIGF_DATA(number));
1825 return make_int((EMACS_INT)bigf_to_long(ent_scratch_bigf));
1826 #endif /* HAVE_MPZ */
1828 #endif /* HAVE_MPF */
1830 #if defined HAVE_MPFR && defined WITH_MPFR
1831 else if (BIGFRP(number)) {
1832 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1833 bigfr_trunc(ent_scratch_bigfr, XBIGFR_DATA(number));
1834 bigz_set_bigfr(ent_scratch_bigz, ent_scratch_bigfr);
1835 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1836 #else /* !HAVE_MPZ */
1837 bigfr_trunc(ent_scratch_bigfr, XBIGFR_DATA(number));
1838 return make_int((EMACS_INT)bigfr_to_long(ent_scratch_bigfr));
1839 #endif /* HAVE_MPZ */
1841 #endif /* HAVE_MPFR */
1843 else if (INDEFP(number))
1846 #if defined HAVE_MPC && defined WITH_MPC || \
1847 defined HAVE_PSEUC && defined WITH_PSEUC || \
1848 defined HAVE_PSEUG && defined WITH_PSEUG
1849 return Ftruncate(wrong_type_argument(Qcomparablep, number));
1850 #else /* !HAVE_MPC */
1851 return Ftruncate(wrong_type_argument(Qnumberp, number));
1852 #endif /* HAVE_MPC */
1855 DEFUN("almost=", Falmost_eq, 2, 3, 0, /*
1856 Return t if NUMBER1 is almost equal to NUMBER2.
1858 Optional argument THRES can be used to specify the threshold,
1859 float-epsilon by default.
1861 (number1, number2, thres))
1863 #if defined HAVE_FPFLOAT
1865 thres = Vfloat_epsilon;
1869 if (FLOATP(number1) && FLOATP(number2)) {
1870 fpfloat n1 = XFLOAT_DATA(number1);
1871 fpfloat n2 = XFLOAT_DATA(number2);
1872 fpfloat thr = XFLOAT_DATA(thres);
1879 return d < thr ? Qt : Qnil;
1881 #endif /* HAVE_FPFLOAT */
1882 return ent_binrel(ASE_BINARY_REL_EQUALP, number1, number2) ? Qt : Qnil;
1885 DEFUN("almost/=", Falmost_neq, 2, 3, 0, /*
1886 Return t if NUMBER1 is clearly different from NUMBER2.
1888 Optional argument THRES can be used to specify the threshold,
1889 float-epsilon by default.
1891 (number1, number2, thres))
1893 #if defined HAVE_FPFLOAT
1895 thres = Vfloat_epsilon;
1899 if (FLOATP(number1) && FLOATP(number2)) {
1900 fpfloat n1 = XFLOAT_DATA(number1);
1901 fpfloat n2 = XFLOAT_DATA(number2);
1902 fpfloat thr = XFLOAT_DATA(thres);
1909 return d < thr ? Qnil : Qt;
1911 #endif /* HAVE_FPFLOAT */
1912 return ent_binrel(ASE_BINARY_REL_NEQP, number1, number2) ? Qt : Qnil;
1916 /* misc complex functions */
1917 DEFUN("conjugate", Fconjugate, 1, 1, 0, /*
1918 Return the \(canonical\) conjugate of NUMBER.
1919 If NUMBER is a comparable, just return NUMBER.
1923 if (COMPARABLEP(number)) {
1925 #if defined HAVE_PSEUG && defined WITH_PSEUG
1926 } else if (BIGGP(number)) {
1927 bigg_conj(ent_scratch_bigg, XBIGG_DATA(number));
1928 return make_bigg_bg(ent_scratch_bigg);
1930 #if defined HAVE_MPC && defined WITH_MPC || \
1931 defined HAVE_PSEUC && defined WITH_PSEUC
1932 } else if (BIGCP(number)) {
1933 bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(number));
1934 bigc_conj(ent_scratch_bigc, XBIGC_DATA(number));
1935 return make_bigc_bc(ent_scratch_bigc);
1937 #if defined HAVE_QUATERN && defined WITH_QUATERN
1938 } else if (QUATERNP(number)) {
1939 quatern_conj(ent_scratch_quatern, XQUATERN_DATA(number));
1940 return make_quatern_qu(ent_scratch_quatern);
1942 } else if (INDEFP(number)) {
1946 /* what should the rest do? */
1947 return Fconjugate(wrong_type_argument(Qnumberp, number));
1950 DEFUN("canonical-norm", Fcanonical_norm, 1, 1, 0, /*
1951 Return the canonical norm of NUMBER.
1955 if (INDEFP(number)) {
1956 if (INFINITYP(number))
1957 return make_indef(POS_INFINITY);
1959 return make_indef(NOT_A_NUMBER);
1960 } else if (COMPARABLEP(number)) {
1961 return Fabs(number);
1962 #if defined HAVE_PSEUG && defined WITH_PSEUG
1963 } else if (BIGGP(number)) {
1964 bigg_norm(ent_scratch_bigz, XBIGG_DATA(number));
1965 return make_bigz_bz(ent_scratch_bigz);
1967 #if defined HAVE_MPC && defined WITH_MPC || \
1968 defined HAVE_PSEUC && defined WITH_PSEUC
1969 } else if (BIGCP(number)) {
1970 bigfr_set_prec(ent_scratch_bigfr, XBIGC_GET_PREC(number));
1971 bigc_norm(ent_scratch_bigfr, XBIGC_DATA(number));
1972 return make_bigfr_bfr(ent_scratch_bigfr);
1974 #if defined HAVE_QUATERN && defined WITH_QUATERN
1975 } else if (QUATERNP(number)) {
1976 quatern_norm(ent_scratch_bigz, XQUATERN_DATA(number));
1977 return make_bigz_bz(ent_scratch_bigz);
1981 /* what should the rest do? */
1982 return Fcanonical_norm(wrong_type_argument(Qnumberp, number));
1985 DEFUN("real-part", Freal_part, 1, 1, 0, /*
1986 Return the real part of NUMBER.
1990 if (INDEFP(number)) {
1991 if (COMPARABLE_INDEF_P(number))
1993 else if (INFINITYP(number))
1994 return make_indef(POS_INFINITY);
1996 return make_indef(NOT_A_NUMBER);
1997 } else if (COMPARABLEP(number)) {
1999 #if defined HAVE_PSEUG && defined WITH_PSEUG
2000 } else if (BIGGP(number)) {
2001 return make_bigz_bz(bigg_re(XBIGG_DATA(number)));
2003 #if defined HAVE_MPC && defined WITH_MPC || \
2004 defined HAVE_PSEUC && defined WITH_PSEUC
2005 } else if (BIGCP(number)) {
2006 return make_bigfr_bfr(bigc_re(XBIGC_DATA(number)));
2010 /* what should the rest do? */
2011 return Freal_part(wrong_type_argument(Qnumberp, number));
2014 DEFUN("imaginary-part", Fimaginary_part, 1, 1, 0, /*
2015 Return the imaginary part of NUMBER.
2016 If NUMBER is a comparable, 0 is returned.
2020 if (INDEFP(number)) {
2021 if (COMPARABLE_INDEF_P(number))
2023 else if (INFINITYP(number))
2024 return make_indef(POS_INFINITY);
2026 return make_indef(NOT_A_NUMBER);
2027 } else if (RATIONALP(number)) {
2029 #if defined HAVE_MPFR && defined WITH_MPFR
2030 } else if (REALP(number)) {
2031 return make_bigfr(0.0, 0UL);
2033 #if defined HAVE_PSEUG && defined WITH_PSEUG
2034 } else if (BIGGP(number)) {
2035 return make_bigz_bz(bigg_im(XBIGG_DATA(number)));
2037 #if defined HAVE_MPC && defined WITH_MPC || \
2038 defined HAVE_PSEUC && defined WITH_PSEUC
2039 } else if (BIGCP(number)) {
2040 return make_bigfr_bfr(bigc_im(XBIGC_DATA(number)));
2044 /* what should the rest do? */
2045 return Fimaginary_part(wrong_type_argument(Qnumberp, number));
2049 /* Float-rounding functions. */
2050 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR || \
2051 defined(HAVE_MPF) && defined WITH_GMP
2053 DEFUN("fceiling", Ffceiling, 1, 1, 0, /*
2054 Return the smallest integer no less than NUMBER, as a float.
2055 \(Round toward +inf.\)
2059 #if defined HAVE_MPF && defined WITH_GMP
2060 if (BIGFP(number)) {
2061 bigf_set_prec(ent_scratch_bigf, XBIGF_GET_PREC(number));
2063 bigf_ceil(ent_scratch_bigf, XBIGF_DATA(number));
2064 return make_bigf_bf(ent_scratch_bigf);
2066 #endif /* HAVE_MPF */
2068 #if defined HAVE_MPFR && defined WITH_MPFR
2069 if (BIGFRP(number)) {
2070 bigfr_set_prec(ent_scratch_bigfr, XBIGFR_GET_PREC(number));
2072 bigfr_ceil(ent_scratch_bigfr, XBIGFR_DATA(number));
2073 return make_bigfr_bfr(ent_scratch_bigfr);
2075 #endif /* HAVE_MPFR */
2080 number = ent_lift(number, FLOAT_T, NULL);
2083 return make_float(ceil(XFLOAT_DATA(number)));
2088 DEFUN("ffloor", Fffloor, 1, 1, 0, /*
2089 Return the largest integer no greater than NUMBER, as a float.
2090 \(Round towards -inf.\)
2094 #if defined HAVE_MPF && defined WITH_GMP
2095 if (BIGFP(number)) {
2096 bigf_set_prec(ent_scratch_bigf, XBIGF_GET_PREC(number));
2098 bigf_floor(ent_scratch_bigf, XBIGF_DATA(number));
2099 return make_bigf_bf(ent_scratch_bigf);
2101 #endif /* HAVE_MPF */
2103 #if defined HAVE_MPFR && defined WITH_MPFR
2104 if (BIGFRP(number)) {
2105 bigfr_set_prec(ent_scratch_bigfr, XBIGFR_GET_PREC(number));
2107 bigfr_floor(ent_scratch_bigfr, XBIGFR_DATA(number));
2108 return make_bigfr_bfr(ent_scratch_bigfr);
2110 #endif /* HAVE_MPFR */
2115 number = ent_lift(number, FLOAT_T, NULL);
2118 return make_float(floor(XFLOAT_DATA(number)));
2123 DEFUN("fround", Ffround, 1, 1, 0, /*
2124 Return the nearest integer to NUMBER, as a float.
2128 #if defined HAVE_MPF && defined WITH_GMP
2129 if (BIGFP(number)) {
2130 warn_when_safe(Qbigf, Qnotice,
2131 "rounding number of type 'bigf (mpf-floats)"
2132 "not yet implemented");
2135 #endif /* HAVE_MPF */
2137 #if defined HAVE_MPFR && defined WITH_MPFR
2138 if (BIGFRP(number)) {
2139 bigfr_set_prec(ent_scratch_bigfr, XBIGFR_GET_PREC(number));
2141 bigfr_rint(ent_scratch_bigfr, XBIGFR_DATA(number));
2142 return make_bigfr_bfr(ent_scratch_bigfr);
2144 #endif /* HAVE_MPFR */
2149 number = ent_lift(number, FLOAT_T, NULL);
2152 return make_float(emacs_rint(XFLOAT_DATA(number)));
2157 DEFUN("ftruncate", Fftruncate, 1, 1, 0, /*
2158 Truncate a floating point number to an integral float value.
2159 Rounds the value toward zero.
2164 #if defined HAVE_MPF && defined WITH_GMP
2165 if (BIGFP(number)) {
2166 bigf_set_prec(ent_scratch_bigf, XBIGF_GET_PREC(number));
2168 bigf_trunc(ent_scratch_bigf, XBIGF_DATA(number));
2169 return make_bigf_bf(ent_scratch_bigf);
2171 #endif /* HAVE_MPF */
2173 #if defined HAVE_MPFR && defined WITH_MPFR
2174 if (BIGFRP(number)) {
2175 bigfr_set_prec(ent_scratch_bigfr, XBIGFR_GET_PREC(number));
2177 bigfr_trunc(ent_scratch_bigfr, XBIGFR_DATA(number));
2178 return make_bigfr_bfr(ent_scratch_bigfr);
2180 #endif /* HAVE_MPFR */
2185 number = ent_lift(number, FLOAT_T, NULL);
2187 if (FLOATP(number)) {
2188 d = XFLOAT_DATA(number);
2193 return make_float(d);
2198 #endif /* HAVE_MPF(R) || HAVE_FPFLOAT (float-rounding functions) */
2202 #ifdef FLOAT_CATCH_SIGILL
2203 static SIGTYPE float_error(int signo)
2206 fatal_error_signal(signo);
2208 EMACS_REESTABLISH_SIGNAL(signo, arith_error);
2209 EMACS_UNBLOCK_SIGNAL(signo);
2213 /* Was Fsignal(), but it just doesn't make sense for an error
2214 occurring inside a signal handler to be restartable, considering
2215 that anything could happen when the error is signaled and trapped
2216 and considering the asynchronous nature of signal handlers. */
2217 signal_error(Qarith_error, list1(float_error_arg));
2220 /* Another idea was to replace the library function `infnan'
2221 where SIGILL is signaled. */
2223 #endif /* FLOAT_CATCH_SIGILL */
2225 /* In C++, it is impossible to determine what type matherr expects
2226 without some more configure magic.
2227 We shouldn't be using matherr anyways - it's a non-standard SYSVism. */
2228 #if defined (HAVE_MATHERR) && !defined(__cplusplus)
2229 int matherr(struct exception *x)
2233 /* Not called from emacs-lisp float routines; do the default thing. */
2236 /* if (!strcmp (x->name, "pow")) x->name = "expt"; */
2238 args = Fcons(build_string(x->name),
2239 Fcons(make_float(x->arg1), ((in_float == 2)
2240 ? Fcons(make_float(x->arg2),
2245 Fsignal(Qdomain_error, args);
2248 Fsignal(Qsingularity_error, args);
2251 Fsignal(Qoverflow_error, args);
2254 Fsignal(Qunderflow_error, args);
2257 Fsignal(Qarith_error, args);
2260 return 1; /* don't set errno or print a message */
2262 #endif /* HAVE_MATHERR */
2263 #endif /* HAVE_FPFLOAT */
2265 void init_floatfns_very_early(void)
2268 # ifdef FLOAT_CATCH_SIGILL
2269 signal(SIGILL, float_error);
2272 #endif /* HAVE_FPFLOAT */
2275 void syms_of_floatfns(void)
2278 /* Trig functions. */
2280 #if defined(HAVE_FPFLOAT) || defined HAVE_MPFR && defined WITH_MPFR
2287 #endif /* HAVE_FPFLOAT || HAVE_MPFR*/
2288 #if defined HAVE_MPFR && defined WITH_MPFR
2294 /* Bessel functions */
2297 DEFSUBR(Fbessel_y0);
2298 DEFSUBR(Fbessel_y1);
2299 DEFSUBR(Fbessel_yn);
2300 DEFSUBR(Fbessel_j0);
2301 DEFSUBR(Fbessel_j1);
2302 DEFSUBR(Fbessel_jn);
2305 /* Error functions. */
2308 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR
2311 DEFSUBR(Flog_gamma);
2315 /* Root and Log functions. */
2317 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR
2319 #endif /* HAVE_FPFLOAT || HAVE_MPFR */
2325 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR
2327 #if defined HAVE_MPFR && defined WITH_MPFR
2329 #endif /* HAVE_MPFR */
2332 DEFSUBR(Fcube_root);
2333 #if defined HAVE_MPFR && defined WITH_MPFR
2336 #endif /* HAVE_FPFLOAT || HAVE_MPFR*/
2338 /* Inverse trig functions. */
2340 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR
2347 #endif /* HAVE_FPFLOAT || HAVE_MPFR */
2348 #if defined HAVE_MPFR && defined WITH_MPFR
2352 #endif /* HAVE_MPFR */
2354 /* Rounding functions */
2360 #endif /* HAVE_FPFLOAT */
2365 DEFSUBR(Falmost_eq);
2366 DEFSUBR(Falmost_neq);
2368 /* misc complex functions */
2369 DEFSUBR(Fconjugate);
2370 DEFSUBR(Fcanonical_norm);
2371 DEFSUBR(Freal_part);
2372 DEFSUBR(Fimaginary_part);
2374 /* Float-rounding functions. */
2376 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPF) && defined WITH_GMP || \
2377 defined(HAVE_MPFR) && defined WITH_MPFR
2381 DEFSUBR(Fftruncate);
2382 #endif /* HAVE_FPFLOAT || HAVE_MPF(R) */
2385 void vars_of_floatfns(void)