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
787 #define RETURN_WHEN_INDEF(number) \
788 if (INDEFP(number)) { \
789 if (XINDEF_DATA(number) == POS_INFINITY) { \
791 } else if (XINDEF_DATA(number) == NEG_INFINITY) { \
792 return make_indef(NOT_A_NUMBER); \
798 DEFUN("log10", Flog10, 1, 2, 0, /*
799 Return the logarithm base 10 of NUMBER.
800 If second optional argument PRECISION is given, use its value
801 (an integer) as precision.
805 RETURN_WHEN_INDEF(number);
807 #if defined HAVE_MPFR && defined WITH_MPFR
808 Lisp_Object bfrnumber;
810 bigfr_set_prec(ent_scratch_bigfr,
811 internal_get_precision(precision));
813 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
814 bigfr_log10(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
815 return make_bigfr_bfr(ent_scratch_bigfr);
817 #else /* !HAVE_MPFR */
818 number = ent_lift(number, FLOAT_T, NULL);
820 RETURN_WHEN_INDEF(number);
822 if (FLOATP(number)) {
825 d = log10(XFLOAT_DATA(number));
826 return make_float(d);
828 static const fpflot log2_10 = log2(10);
829 d = log2(XFLOAT_DATA(number))/log2_10;
830 return make_float(d);
832 static const fpflot log_10 - log(10);
833 d = log(XFLOAT_DATA(number))/log_10;
834 return make_float(d);
836 return ase_unary_operation_undefined(number);
840 Fsignal(Qarith_error, list1(number));
843 if (NILP(precision));
844 #endif /* HAVE_MPFR */
847 DEFUN("log2", Flog2, 1, 2, 0, /*
848 Return the logarithm base 2 of NUMBER.
849 If second optional argument PRECISION is given, use its value
850 (an integer) as precision.
854 RETURN_WHEN_INDEF(number);
856 #if defined HAVE_MPFR && defined WITH_MPFR
857 Lisp_Object bfrnumber;
859 bigfr_set_prec(ent_scratch_bigfr,
860 internal_get_precision(precision));
862 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
863 bigfr_log2(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
864 return make_bigfr_bfr(ent_scratch_bigfr);
866 number = ent_lift(number, FLOAT_T, NULL);
868 RETURN_WHEN_INDEF(number);
870 if (FLOATP(number)) {
873 d = log2(XFLOAT_DATA(number));
874 return make_float(d);
876 static const fpflot log_2 - log(2);
877 d = log(XFLOAT_DATA(number))/log_2;
878 return make_float(d);
880 return ase_unary_operation_undefined(number);
884 Fsignal(Qarith_error, list1(number));
887 if (NILP(precision));
888 #endif /* HAVE_MPFR */
891 DEFUN("log", Flog, 1, 3, 0, /*
892 Return the natural logarithm of NUMBER.
893 If second optional argument BASE is given, return the logarithm of
894 NUMBER using that base.
895 If third optional argument PRECISION is given, use its value
896 (an integer) as precision.
898 (number, base, precision))
900 RETURN_WHEN_INDEF(number);
902 if (INTEGERP(base)) {
904 case 2 : return Flog2 (number, precision);
905 case 10: return Flog10(number, precision);
906 default: break; /* Intentional Fall through */
911 #if defined HAVE_MPFR && defined WITH_MPFR
913 /* Not all bignumber libs optimize log2, for instance
914 MPFR implements log2 in function of log. */
915 Lisp_Object _logn, _logb;
916 _logn = Flog(number, precision);
917 if (UNLIKELY(INDEFP(_logn))) {
920 _logb = Flog2(base, precision);
921 return ent_binop(ASE_BINARY_OP_QUO, _logn, _logb);
924 Lisp_Object bfrnumber;
926 bigfr_set_prec(ent_scratch_bigfr,
927 internal_get_precision(precision));
929 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
930 bigfr_log(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
931 return make_bigfr_bfr(ent_scratch_bigfr);
933 #else /* !HAVE_MPFR */
935 /* Processor implementations tend to give an edge to log2 */
936 Lisp_Object _logn, _logb;
937 _logn = Flog2(number, precision);
938 if (UNLIKELY(INDEFP(_logn))) {
941 _logb = Flog2(base, precision);
942 return ent_binop(ASE_BINARY_OP_QUO, _logn, _logb);
945 number = ent_lift(number, FLOAT_T, NULL);
947 RETURN_WHEN_INDEF(number);
949 if (FLOATP(number)) {
951 d = log(XFLOAT_DATA(number));
952 return make_float(d);
955 Fsignal(Qarith_error, list1(number));
958 if (NILP(precision));
959 #endif /* HAVE_MPFR */
962 #undef RETURN_WHEN_INDEF
964 DEFUN("sqrt", Fsqrt, 1, 2, 0, /*
965 Return the square root of NUMBER.
966 If second optional argument PRECISION is given, use its value
967 (an integer) as precision.
971 #if defined(HAVE_MPFR) && defined WITH_MPFR || \
972 defined(HAVE_MPC) && defined WITH_MPC || \
973 defined(HAVE_PSEUC) && defined WITH_PSEUC
975 if (INDEFP(number)) {
976 if (XINDEF_DATA(number) == POS_INFINITY)
978 else if (XINDEF_DATA(number) == NEG_INFINITY)
979 return make_indef(COMPLEX_INFINITY);
984 if (COMPARABLEP(number)) {
985 #if defined HAVE_MPFR && defined WITH_MPFR
986 bigfr_set_prec(ent_scratch_bigfr,
987 internal_get_precision(precision));
990 bigfr_sqrt_ui(ent_scratch_bigfr,
991 (unsigned long)XUINT(number));
992 else if (BIGZP(number) &&
993 bigz_fits_ulong_p(XBIGZ_DATA(number)) &&
994 bigz_sign(XBIGZ_DATA(number)) >= 0) {
995 bigfr_sqrt_ui(ent_scratch_bigfr,
996 (unsigned long)bigz_to_ulong(
997 XBIGZ_DATA(number)));
998 } else if (!NILP(Fnonnegativep(number))) {
999 Lisp_Object bfrnumber;
1000 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
1001 bigfr_sqrt(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
1003 #if defined HAVE_MPC && defined WITH_MPC || \
1004 defined HAVE_PSEUC && defined WITH_PSEUC
1005 Lisp_Object bcnumber;
1006 bigc_set_prec(ent_scratch_bigc,
1007 internal_get_precision(precision));
1008 bcnumber = Fcoerce_number(number, Qbigc, precision);
1009 bigc_sqrt(ent_scratch_bigc, XBIGC_DATA(bcnumber));
1010 return make_bigc_bc(ent_scratch_bigc);
1011 #else /* !HAVE_MPC */
1012 Lisp_Object bfrnumber;
1013 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
1014 bigfr_sqrt(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
1015 #endif /* HAVE_MPC */
1017 return make_bigfr_bfr(ent_scratch_bigfr);
1018 #endif /* HAVE_MPFR */
1019 #if defined HAVE_MPC && defined WITH_MPC || \
1020 defined HAVE_PSEUC && defined WITH_PSEUC
1021 } else if (BIGCP(number) || BIGGP(number)) {
1022 Lisp_Object bcnumber;
1023 bigc_set_prec(ent_scratch_bigc,
1024 internal_get_precision(precision));
1026 bcnumber = Fcoerce_number(number, Qbigc, precision);
1027 bigc_sqrt(ent_scratch_bigc, XBIGC_DATA(bcnumber));
1028 return make_bigc_bc(ent_scratch_bigc);
1029 #endif /* HAVE_MPC */
1032 if (NILP(precision));
1033 return wrong_type_argument(Qnumberp, number);
1035 #else /* !HAVE_MPFR && !HAVE_MPC */
1036 if (INDEFP(number)) {
1040 number = ent_lift(number, FLOAT_T, NULL);
1042 if (FLOATP(number)) {
1044 d = sqrt(XFLOAT_DATA(number));
1045 return make_float(d);
1046 } else if (INDEFP(number)) {
1048 if (XINDEF_DATA(number) == POS_INFINITY)
1050 else if (XINDEF_DATA(number) == NEG_INFINITY)
1051 return make_indef(COMPLEX_INFINITY);
1056 Fsignal(Qarith_error, list1(number));
1059 if (NILP(precision));
1060 #endif /* HAVE_MPFR */
1063 DEFUN("cube-root", Fcube_root, 1, 2, 0, /*
1064 Return the cube root of NUMBER.
1065 If second optional argument PRECISION is given, use its value
1066 (an integer) as precision.
1068 (number, precision))
1070 #if defined HAVE_MPFR && defined WITH_MPFR
1071 Lisp_Object bfrnumber;
1076 bigfr_set_prec(ent_scratch_bigfr,
1077 internal_get_precision(precision));
1079 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
1080 bigfr_cbrt(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
1081 return make_bigfr_bfr(ent_scratch_bigfr);
1083 #else /* !HAVE_MPFR */
1084 if (INDEFP(number)) {
1088 number = ent_lift(number, FLOAT_T, NULL);
1090 if (FLOATP(number)) {
1093 d = cbrt(XFLOAT_DATA(number));
1095 d = XFLOAT_DATA(number);
1097 d = pow(d, 1.0 / 3.0);
1099 d = -pow(-d, 1.0 / 3.0);
1101 return make_float(d);
1102 } else if (INDEFP(number)) {
1107 Fsignal(Qarith_error, list1(number));
1110 if (NILP(precision));
1111 #endif /* HAVE_MPFR */
1113 #endif /* HAVE_FPFLOAT || MPFR */
1116 #if defined HAVE_MPFR && defined WITH_MPFR
1117 DEFUN("root", Froot, 2, 3, 0, /*
1118 Return the RADIX-th root of NUMBER.
1119 If third optional argument PRECISION is given, use its value
1120 (an integer) as precision.
1122 (number, radix, precision))
1124 Lisp_Object bfrnumber;
1126 if (!NATNUMP(radix)) {
1127 dead_wrong_type_argument(Qnatnump, radix);
1131 if (INDEFP(number)) {
1132 if (XINDEF_DATA(number) == POS_INFINITY)
1134 else if (XINDEF_DATA(number) == NEG_INFINITY)
1135 return make_indef(COMPLEX_INFINITY);
1140 bigfr_set_prec(ent_scratch_bigfr,
1141 internal_get_precision(precision));
1143 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
1144 bigfr_root(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber), XUINT(radix));
1145 return make_bigfr_bfr(ent_scratch_bigfr);
1147 #endif /* HAVE_MPFR */
1150 /* (Inverse) hyperbolic trig functions. */
1151 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR
1153 DEFUN("acosh", Facosh, 1, 2, 0, /*
1154 Return the inverse hyperbolic cosine of NUMBER.
1155 If optional argument PRECISION is non-nil, its value
1156 (an integer) is used as precision.
1158 (number, precision))
1160 #if defined HAVE_MPFR && defined WITH_MPFR
1162 MPFR_TRIG_FUN(acosh);
1164 #else /* !HAVE_MPFR */
1165 if (INDEFP(number)) {
1166 return make_indef(NOT_A_NUMBER);
1169 number = ent_lift(number, FLOAT_T, NULL);
1171 if (FLOATP(number)) {
1172 fpfloat d = XFLOAT_DATA(number);
1173 #ifdef HAVE_INVERSE_HYPERBOLIC
1176 d = log(d + sqrt(d * d - 1.0));
1178 return make_float(d);
1179 } else if (INDEFP(number)) {
1180 return make_indef(NOT_A_NUMBER);
1183 Fsignal(Qarith_error, list1(number));
1186 if (NILP(precision));
1187 #endif /* HAVE_MPFR */
1190 DEFUN("asinh", Fasinh, 1, 2, 0, /*
1191 Return the inverse hyperbolic sine of NUMBER.
1192 If optional argument PRECISION is non-nil, its value
1193 (an integer) is used as precision.
1195 (number, precision))
1197 #if defined HAVE_MPFR && defined WITH_MPFR
1199 MPFR_TRIG_FUN(asinh);
1201 #else /* !HAVE_MPFR */
1202 if (INDEFP(number)) {
1203 return make_indef(NOT_A_NUMBER);
1206 number = ent_lift(number, FLOAT_T, NULL);
1208 if (FLOATP(number)) {
1209 fpfloat d = XFLOAT_DATA(number);
1210 #ifdef HAVE_INVERSE_HYPERBOLIC
1213 d = log(d + sqrt(d * d + 1.0));
1215 return make_float(d);
1216 } else if (INDEFP(number)) {
1217 return make_indef(NOT_A_NUMBER);
1220 Fsignal(Qarith_error, list1(number));
1223 if (NILP(precision));
1224 #endif /* HAVE_MPFR */
1227 DEFUN("atanh", Fatanh, 1, 2, 0, /*
1228 Return the inverse hyperbolic tangent of NUMBER.
1229 If optional argument PRECISION is non-nil, its value
1230 (an integer) is used as precision.
1232 (number, precision))
1234 #if defined HAVE_MPFR && defined WITH_MPFR
1236 MPFR_TRIG_FUN(atanh);
1238 #else /* !HAVE_MPFR */
1239 if (INDEFP(number)) {
1240 return make_indef(NOT_A_NUMBER);
1243 number = ent_lift(number, FLOAT_T, NULL);
1245 if (FLOATP(number)) {
1246 fpfloat d = XFLOAT_DATA(number);
1247 #ifdef HAVE_INVERSE_HYPERBOLIC
1250 d = 0.5 * log((1.0 + d) / (1.0 - d));
1252 return make_float(d);
1253 } else if (INDEFP(number)) {
1254 return make_indef(NOT_A_NUMBER);
1257 Fsignal(Qarith_error, list1(number));
1260 if (NILP(precision));
1261 #endif /* HAVE_MPFR */
1264 DEFUN("cosh", Fcosh, 1, 2, 0, /*
1265 Return the hyperbolic cosine of NUMBER.
1266 If optional argument PRECISION is non-nil, its value
1267 (an integer) is used as precision.
1269 (number, precision))
1271 #if defined HAVE_MPFR && defined WITH_MPFR
1273 MPFR_TRIG_FUN(cosh);
1275 #else /* !HAVE_MPFR */
1276 if (INDEFP(number)) {
1277 return make_indef(NOT_A_NUMBER);
1280 number = ent_lift(number, FLOAT_T, NULL);
1282 if (FLOATP(number)) {
1284 d = cosh(XFLOAT_DATA(number));
1285 return make_float(d);
1286 } else if (INDEFP(number)) {
1287 return make_indef(NOT_A_NUMBER);
1290 Fsignal(Qarith_error, list1(number));
1293 if (NILP(precision));
1294 #endif /* HAVE_MPFR */
1297 DEFUN("sinh", Fsinh, 1, 2, 0, /*
1298 Return the hyperbolic sine of NUMBER.
1299 If optional argument PRECISION is non-nil, its value
1300 (an integer) is used as precision.
1302 (number, precision))
1304 #if defined HAVE_MPFR && defined WITH_MPFR
1306 MPFR_TRIG_FUN(sinh);
1308 #else /* !HAVE_MPFR */
1309 if (INDEFP(number)) {
1310 return make_indef(NOT_A_NUMBER);
1313 number = ent_lift(number, FLOAT_T, NULL);
1315 if (FLOATP(number)) {
1317 d = sinh(XFLOAT_DATA(number));
1318 return make_float(d);
1319 } else if (INDEFP(number)) {
1320 return make_indef(NOT_A_NUMBER);
1323 Fsignal(Qarith_error, list1(number));
1326 if (NILP(precision));
1327 #endif /* HAVE_MFPR */
1330 DEFUN("tanh", Ftanh, 1, 2, 0, /*
1331 Return the hyperbolic tangent of NUMBER.
1332 If optional argument PRECISION is non-nil, its value
1333 (an integer) is used as precision.
1335 (number, precision))
1337 #if defined HAVE_MPFR && defined WITH_MPFR
1339 MPFR_TRIG_FUN(tanh);
1341 #else /* !HAVE_MPFR */
1342 if (INDEFP(number)) {
1343 return make_indef(NOT_A_NUMBER);
1346 number = ent_lift(number, FLOAT_T, NULL);
1348 if (FLOATP(number)) {
1349 fpfloat d = XFLOAT_DATA(number);
1351 return make_float(d);
1352 } else if (INDEFP(number)) {
1353 return make_indef(NOT_A_NUMBER);
1356 Fsignal(Qarith_error, list1(number));
1359 if (NILP(precision));
1360 #endif /* HAVE_MPFR */
1363 #if defined HAVE_MPFR && defined WITH_MPFR
1365 DEFUN("sech", Fsech, 1, 2, 0, /*
1366 Return the hyperbolic secant of NUMBER.
1367 If optional argument PRECISION is non-nil, its value
1368 (an integer) is used as precision.
1370 (number, precision))
1372 MPFR_TRIG_FUN(sech);
1375 DEFUN("csch", Fcsch, 1, 2, 0, /*
1376 Return the hyperbolic cosecant of NUMBER.
1377 If optional argument PRECISION is non-nil, its value
1378 (an integer) is used as precision.
1380 (number, precision))
1382 MPFR_TRIG_FUN(csch);
1385 DEFUN("coth", Fcoth, 1, 2, 0, /*
1386 Return the hyperbolic cotangent of NUMBER.
1387 If optional argument PRECISION is non-nil, its value
1388 (an integer) is used as precision.
1390 (number, precision))
1392 MPFR_TRIG_FUN(coth);
1394 #endif /* HAVE_MPFR */
1396 #endif /* HAVE_MPFR || HAVE_FPFLOAT (inverse trig functions) */
1399 /* Rounding functions */
1401 DEFUN("abs", Fabs, 1, 1, 0, /*
1402 Return the absolute value of NUMBER.
1407 if (FLOATP(number)) {
1408 return make_float(fabs(XFLOAT_DATA(number)));
1410 #endif /* HAVE_FPFLOAT */
1413 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1414 /* The most negative Lisp int will overflow */
1415 return (XINT(number) >= 0)
1416 ? number : make_integer(-XINT(number));
1417 #else /* !HAVE_MPZ */
1418 return (XINT(number) >= 0) ? number : make_int(-XINT(number));
1419 #endif /* HAVE_MPZ */
1422 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1423 if (BIGZP(number)) {
1424 if (bigz_sign(XBIGZ_DATA(number)) >= 0)
1427 bigz_abs(ent_scratch_bigz, XBIGZ_DATA(number));
1428 return make_bigz_bz(ent_scratch_bigz);
1430 #endif /* HAVE_MPZ */
1432 #if defined HAVE_MPQ && defined WITH_GMP
1433 if (BIGQP(number)) {
1434 if (bigq_sign(XBIGQ_DATA(number)) >= 0)
1437 bigq_abs(ent_scratch_bigq, XBIGQ_DATA(number));
1438 return make_bigq_bq(ent_scratch_bigq);
1440 #endif /* HAVE_MPQ */
1442 #if defined HAVE_MPF && defined WITH_GMP
1443 if (BIGFP(number)) {
1444 if (bigf_sign(XBIGF_DATA (number)) >= 0)
1447 bigf_set_prec(ent_scratch_bigf, XBIGF_GET_PREC(number));
1449 bigf_abs(ent_scratch_bigf, XBIGF_DATA(number));
1450 return make_bigf_bf(ent_scratch_bigf);
1452 #endif /* HAVE_MPF */
1454 #if defined HAVE_MPFR && defined WITH_MPFR
1455 if (BIGFRP(number)) {
1456 if (bigfr_sign(XBIGFR_DATA (number)) >= 0)
1459 bigfr_set_prec(ent_scratch_bigfr, XBIGFR_GET_PREC(number));
1461 bigfr_abs(ent_scratch_bigfr, XBIGFR_DATA(number));
1462 return make_bigfr_bfr(ent_scratch_bigfr);
1464 #endif /* HAVE_MPFR */
1466 #if defined(HAVE_PSEUG) && defined WITH_PSEUG && defined(HAVE_MPFR)
1467 if (BIGGP(number)) {
1468 bigfr_set_prec(ent_scratch_bigfr,
1469 internal_get_precision(Qnil));
1471 bigg_abs(ent_scratch_bigfr, XBIGG_DATA(number));
1472 return make_bigfr_bfr(ent_scratch_bigfr);
1474 #endif /* HAVE_PSEUG && HAVE_MPFR */
1476 #if defined HAVE_MPC && defined WITH_MPC || \
1477 defined HAVE_PSEUC && defined WITH_PSEUC
1478 if (BIGCP(number)) {
1479 bigfr_set_prec(ent_scratch_bigfr, XBIGC_GET_PREC(number));
1481 if (bigc_nan_p(XBIGC_DATA(number)))
1482 return make_indef(NOT_A_NUMBER);
1483 else if (bigc_inf_p(XBIGC_DATA(number)))
1484 return make_indef(POS_INFINITY);
1486 bigc_abs(ent_scratch_bigfr, XBIGC_DATA(number));
1488 return make_bigfr_bfr(ent_scratch_bigfr);
1490 #endif /* HAVE_PSEUG */
1492 if (INDEFP(number)) {
1493 if (XINDEF_DATA(number) == POS_INFINITY)
1495 else if (XINDEF_DATA(number) == NEG_INFINITY)
1496 return make_indef(POS_INFINITY);
1501 return Fabs(wrong_type_argument(Qnumberp, number));
1504 #if defined(HAVE_FPFLOAT)
1505 /* fuck fuck fuck, I want this in number.el */
1506 DEFUN("float", Ffloat, 1, 1, 0, /*
1507 Return the floating point number numerically equal to NUMBER.
1511 /* Just create the float in order of preference */
1512 return Fcoerce_number(number, Qfloat, Qnil);
1514 #endif /* HAVE_FPFLOAT */
1517 DEFUN("logb", Flogb, 1, 1, 0, /*
1518 Return largest integer <= the base 2 log of the magnitude of NUMBER.
1519 This is the same as the exponent of a float.
1523 fpfloat f = extract_float(number);
1526 return make_int(EMACS_INT_MIN);
1529 fpfloat _lb = logb(f);
1531 IN_FLOAT(val = make_int((EMACS_INT)_lb), "logb", number);
1538 IN_FLOAT(frexp(f, &exqp), "logb", number);
1539 return make_int(exqp - 1);
1550 for (i = 1, d = 0.5; d * d >= f; i += i)
1556 for (i = 1, d = 2.0; d * d <= f; i += i)
1561 return make_int(val);
1563 #endif /* ! HAVE_FREXP */
1564 #endif /* ! HAVE_LOGB */
1566 #endif /* HAVE_FPFLOAT */
1568 DEFUN("ceiling", Fceiling, 1, 1, 0, /*
1569 Return the smallest integer no less than NUMBER. (Round toward +inf.)
1574 if (FLOATP(number)) {
1576 d = ceil(XFLOAT_DATA(number));
1577 return (float_to_int(d, "ceiling", number, Qunbound));
1579 #endif /* HAVE_FPFLOAT */
1581 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1582 if (INTEGERP(number))
1583 #else /* !HAVE_MPZ */
1585 #endif /* HAVE_MPZ */
1588 #if defined(HAVE_MPQ) && defined(HAVE_MPZ) && defined WITH_GMP
1589 if (BIGQP(number)) {
1590 bigz_ceil(ent_scratch_bigz,
1591 XBIGQ_NUMERATOR(number),
1592 XBIGQ_DENOMINATOR(number));
1593 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1597 #if defined HAVE_MPF && defined WITH_GMP
1598 else if (BIGFP(number)) {
1599 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1600 bigf_ceil(ent_scratch_bigf, XBIGF_DATA(number));
1601 bigz_set_bigf(ent_scratch_bigz, ent_scratch_bigf);
1602 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1603 #else /* !HAVE_MPZ */
1604 bigf_ceil(ent_scratch_bigf, XBIGF_DATA(number));
1605 return make_int((EMACS_INT)bigf_to_long(ent_scratch_bigf));
1606 #endif /* HAVE_MPZ */
1608 #endif /* HAVE_MPF */
1610 #if defined HAVE_MPFR && defined WITH_MPFR
1611 else if (BIGFRP(number)) {
1612 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1613 bigfr_ceil(ent_scratch_bigfr, XBIGFR_DATA(number));
1614 bigz_set_bigfr(ent_scratch_bigz, ent_scratch_bigfr);
1615 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1616 #else /* !HAVE_MPZ */
1617 bigfr_ceil(ent_scratch_bigfr, XBIGFR_DATA(number));
1618 return make_int((EMACS_INT)bigfr_to_long(ent_scratch_bigfr));
1619 #endif /* HAVE_MPZ */
1621 #endif /* HAVE_MPFR */
1626 #if defined HAVE_MPC && defined WITH_MPC || \
1627 defined HAVE_PSEUC && defined WITH_PSEUC || \
1628 defined HAVE_PSEUG && defined WITH_PSEUG
1629 return Fceiling(wrong_type_argument(Qcomparablep, number));
1630 #else /* !HAVE_MPC */
1631 return Fceiling(wrong_type_argument(Qnumberp, number));
1632 #endif /* HAVE_MPC */
1635 DEFUN("floor", Ffloor, 1, 2, 0, /*
1636 Return the largest integer no greater than NUMBER. (Round towards -inf.)
1637 With optional second argument DIVISOR, return the largest integer no
1638 greater than NUMBER/DIVISOR.
1642 ase_object_type_t ntquo;
1645 CHECK_COMPARABLE(number);
1646 if (NILP(divisor)) {
1647 return Ffloor(number, make_int(1L));
1651 /* !NILP(divisor) */
1653 CHECK_COMPARABLE(divisor);
1655 if (INTEGERP(number) && INTEGERP(divisor)) {
1656 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1657 /* this is the optimised version, since
1658 * bigz_floor always takes two arguments
1660 number = ent_lift(number, BIGZ_T, NULL);
1661 divisor = ent_lift(divisor, BIGZ_T, NULL);
1663 bigz_floor(ent_scratch_bigz,
1665 XBIGZ_DATA(divisor));
1666 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1668 number = ent_lift(number, FLOAT_T, NULL);
1669 divisor = ent_lift(divisor, FLOAT_T, NULL);
1673 quo = ent_binop(ASE_BINARY_OP_QUO, number, divisor);
1674 ntquo = ase_optable_index(quo);
1677 case INT_T: /* trivial */
1684 IN_FLOAT((d = floor(XFLOAT_DATA(quo))), "floor", quo);
1685 return (float_to_int(d, "floor", quo, Qunbound));
1688 #if defined(HAVE_MPQ) && defined(HAVE_MPZ) && defined WITH_GMP
1689 bigz_floor(ent_scratch_bigz,
1690 XBIGQ_NUMERATOR(quo), XBIGQ_DENOMINATOR(quo));
1691 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1697 #if defined HAVE_MPF && defined WITH_GMP
1698 bigf_floor(ent_scratch_bigf, XBIGF_DATA(quo));
1699 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1700 bigz_set_bigf(ent_scratch_bigz, ent_scratch_bigf);
1701 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1702 #else /* !HAVE_MPZ */
1704 (EMACS_INT)bigf_to_long(ent_scratch_bigf));
1705 #endif /* HAVE_MPZ */
1707 #endif /* HAVE_MPF */
1710 #if defined HAVE_MPFR && defined WITH_MPFR
1711 bigfr_floor(ent_scratch_bigfr, XBIGFR_DATA(quo));
1712 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1713 bigz_set_bigfr(ent_scratch_bigz, ent_scratch_bigfr);
1714 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1715 #else /* !HAVE_MPZ */
1717 (EMACS_INT)bigfr_to_long(ent_scratch_bigfr));
1718 #endif /* HAVE_MPZ */
1720 #endif /* HAVE_MPFR */
1726 return Fsignal(Qdomain_error, Qnil);
1729 DEFUN("round", Fround, 1, 1, 0, /*
1730 Return the nearest integer to NUMBER.
1732 NUMBER has to have an archimedian valuation, #'round returns the
1733 integer z for which | number - z | is minimal.
1738 if (FLOATP(number)) {
1740 /* Screw the prevailing rounding mode. */
1741 d = emacs_rint(XFLOAT_DATA(number));
1742 return (float_to_int(d, "round", number, Qunbound));
1744 #endif /* HAVE_FPFLOAT */
1746 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1747 if (INTEGERP(number))
1748 #else /* !HAVE_MPZ */
1750 #endif /* HAVE_MPZ */
1753 #if defined(HAVE_MPQ) && defined(HAVE_MPZ) && defined WITH_GMP
1754 else if (BIGQP(number)) {
1755 /* first off, let's create the division, remainder as well */
1757 mpz_tdiv_qr(ent_scratch_bigz,
1758 bigq_numerator(ent_scratch_bigq),
1759 XBIGQ_NUMERATOR(number),
1760 XBIGQ_DENOMINATOR(number));
1762 /* <- denom(number) * 2 */
1763 mpz_mul_2exp(bigq_numerator(ent_scratch_bigq),
1764 bigq_numerator(ent_scratch_bigq), 1);
1766 /* check if we had to add one */
1767 if (mpz_cmpabs(bigq_numerator(ent_scratch_bigq),
1768 XBIGQ_DENOMINATOR(number)) >= 0) {
1769 /* >= ceil(denom(number) / 2) */
1770 if (mpz_sgn(bigq_numerator(ent_scratch_bigq)) > 0) {
1771 mpz_add_ui(ent_scratch_bigz,
1772 ent_scratch_bigz, 1UL);
1774 mpz_sub_ui(ent_scratch_bigz,
1775 ent_scratch_bigz, 1UL);
1778 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1780 #endif /* HAVE_MPQ && HAVE_MPZ */
1782 #if defined HAVE_MPF && defined WITH_GMP
1783 else if (BIGFP(number)) {
1784 warn_when_safe(Qbigf, Qnotice,
1785 "rounding number of type 'bigf (mpf-floats)"
1786 "not yet implemented");
1789 #endif /* HAVE_MPF */
1791 #if defined HAVE_MPFR && defined WITH_MPFR
1792 else if (BIGFRP(number)) {
1793 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1794 bigfr_rint(ent_scratch_bigfr, XBIGFR_DATA(number));
1795 bigz_set_bigfr(ent_scratch_bigz, ent_scratch_bigfr);
1796 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1797 #else /* !HAVE_MPZ */
1798 bigfr_rint(ent_scratch_bigfr, XBIGFR_DATA(number));
1799 return make_int((EMACS_INT)bigfr_to_long(ent_scratch_bigfr));
1800 #endif /* HAVE_MPZ */
1802 #endif /* HAVE_MPFR */
1804 else if (INDEFP(number))
1807 #if defined HAVE_MPC && defined WITH_MPC || \
1808 defined HAVE_PSEUC && defined WITH_PSEUC || \
1809 defined HAVE_PSEUG && defined WITH_PSEUG
1810 return Fround(wrong_type_argument(Qcomparablep, number));
1811 #else /* !HAVE_MPC */
1812 return Fround(wrong_type_argument(Qnumberp, number));
1813 #endif /* HAVE_MPC */
1816 DEFUN("truncate", Ftruncate, 1, 1, 0, /*
1817 Truncate a floating point number to an integer.
1818 Rounds the value toward zero.
1824 return float_to_int(XFLOAT_DATA(number), "truncate", number,
1826 #endif /* HAVE_FPFLOAT */
1828 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1829 if (INTEGERP(number))
1830 #else /* !HAVE_MPZ */
1832 #endif /* HAVE_MPZ */
1835 #if defined HAVE_MPQ && defined WITH_GMP
1836 else if (BIGQP(number)) {
1837 bigz_div(ent_scratch_bigz,
1838 XBIGQ_NUMERATOR(number),
1839 XBIGQ_DENOMINATOR(number));
1840 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1844 #if defined HAVE_MPF && defined WITH_GMP
1845 else if (BIGFP(number)) {
1846 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1847 bigf_trunc(ent_scratch_bigf, XBIGF_DATA(number));
1848 bigz_set_bigf(ent_scratch_bigz, ent_scratch_bigf);
1849 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1850 #else /* !HAVE_MPZ */
1851 bigf_trunc(ent_scratch_bigf, XBIGF_DATA(number));
1852 return make_int((EMACS_INT)bigf_to_long(ent_scratch_bigf));
1853 #endif /* HAVE_MPZ */
1855 #endif /* HAVE_MPF */
1857 #if defined HAVE_MPFR && defined WITH_MPFR
1858 else if (BIGFRP(number)) {
1859 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1860 bigfr_trunc(ent_scratch_bigfr, XBIGFR_DATA(number));
1861 bigz_set_bigfr(ent_scratch_bigz, ent_scratch_bigfr);
1862 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1863 #else /* !HAVE_MPZ */
1864 bigfr_trunc(ent_scratch_bigfr, XBIGFR_DATA(number));
1865 return make_int((EMACS_INT)bigfr_to_long(ent_scratch_bigfr));
1866 #endif /* HAVE_MPZ */
1868 #endif /* HAVE_MPFR */
1870 else if (INDEFP(number))
1873 #if defined HAVE_MPC && defined WITH_MPC || \
1874 defined HAVE_PSEUC && defined WITH_PSEUC || \
1875 defined HAVE_PSEUG && defined WITH_PSEUG
1876 return Ftruncate(wrong_type_argument(Qcomparablep, number));
1877 #else /* !HAVE_MPC */
1878 return Ftruncate(wrong_type_argument(Qnumberp, number));
1879 #endif /* HAVE_MPC */
1882 DEFUN("almost=", Falmost_eq, 2, 3, 0, /*
1883 Return t if NUMBER1 is almost equal to NUMBER2.
1885 Optional argument THRES can be used to specify the threshold,
1886 float-epsilon by default.
1888 (number1, number2, thres))
1890 #if defined HAVE_FPFLOAT
1892 thres = Vfloat_epsilon;
1896 if (FLOATP(number1) && FLOATP(number2)) {
1897 fpfloat n1 = XFLOAT_DATA(number1);
1898 fpfloat n2 = XFLOAT_DATA(number2);
1899 fpfloat thr = XFLOAT_DATA(thres);
1906 return d < thr ? Qt : Qnil;
1908 #endif /* HAVE_FPFLOAT */
1909 return ent_binrel(ASE_BINARY_REL_EQUALP, number1, number2) ? Qt : Qnil;
1912 DEFUN("almost/=", Falmost_neq, 2, 3, 0, /*
1913 Return t if NUMBER1 is clearly different from NUMBER2.
1915 Optional argument THRES can be used to specify the threshold,
1916 float-epsilon by default.
1918 (number1, number2, thres))
1920 #if defined HAVE_FPFLOAT
1922 thres = Vfloat_epsilon;
1926 if (FLOATP(number1) && FLOATP(number2)) {
1927 fpfloat n1 = XFLOAT_DATA(number1);
1928 fpfloat n2 = XFLOAT_DATA(number2);
1929 fpfloat thr = XFLOAT_DATA(thres);
1936 return d < thr ? Qnil : Qt;
1938 #endif /* HAVE_FPFLOAT */
1939 return ent_binrel(ASE_BINARY_REL_NEQP, number1, number2) ? Qt : Qnil;
1943 /* misc complex functions */
1944 DEFUN("conjugate", Fconjugate, 1, 1, 0, /*
1945 Return the \(canonical\) conjugate of NUMBER.
1946 If NUMBER is a comparable, just return NUMBER.
1950 if (COMPARABLEP(number)) {
1952 #if defined HAVE_PSEUG && defined WITH_PSEUG
1953 } else if (BIGGP(number)) {
1954 bigg_conj(ent_scratch_bigg, XBIGG_DATA(number));
1955 return make_bigg_bg(ent_scratch_bigg);
1957 #if defined HAVE_MPC && defined WITH_MPC || \
1958 defined HAVE_PSEUC && defined WITH_PSEUC
1959 } else if (BIGCP(number)) {
1960 bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(number));
1961 bigc_conj(ent_scratch_bigc, XBIGC_DATA(number));
1962 return make_bigc_bc(ent_scratch_bigc);
1964 #if defined HAVE_QUATERN && defined WITH_QUATERN
1965 } else if (QUATERNP(number)) {
1966 quatern_conj(ent_scratch_quatern, XQUATERN_DATA(number));
1967 return make_quatern_qu(ent_scratch_quatern);
1969 } else if (INDEFP(number)) {
1973 /* what should the rest do? */
1974 return Fconjugate(wrong_type_argument(Qnumberp, number));
1977 DEFUN("canonical-norm", Fcanonical_norm, 1, 1, 0, /*
1978 Return the canonical norm of NUMBER.
1982 if (INDEFP(number)) {
1983 if (INFINITYP(number))
1984 return make_indef(POS_INFINITY);
1986 return make_indef(NOT_A_NUMBER);
1987 } else if (COMPARABLEP(number)) {
1988 return Fabs(number);
1989 #if defined HAVE_PSEUG && defined WITH_PSEUG
1990 } else if (BIGGP(number)) {
1991 bigg_norm(ent_scratch_bigz, XBIGG_DATA(number));
1992 return make_bigz_bz(ent_scratch_bigz);
1994 #if defined HAVE_MPC && defined WITH_MPC || \
1995 defined HAVE_PSEUC && defined WITH_PSEUC
1996 } else if (BIGCP(number)) {
1997 bigfr_set_prec(ent_scratch_bigfr, XBIGC_GET_PREC(number));
1998 bigc_norm(ent_scratch_bigfr, XBIGC_DATA(number));
1999 return make_bigfr_bfr(ent_scratch_bigfr);
2001 #if defined HAVE_QUATERN && defined WITH_QUATERN
2002 } else if (QUATERNP(number)) {
2003 quatern_norm(ent_scratch_bigz, XQUATERN_DATA(number));
2004 return make_bigz_bz(ent_scratch_bigz);
2008 /* what should the rest do? */
2009 return Fcanonical_norm(wrong_type_argument(Qnumberp, number));
2012 DEFUN("real-part", Freal_part, 1, 1, 0, /*
2013 Return the real part of NUMBER.
2017 if (INDEFP(number)) {
2018 if (COMPARABLE_INDEF_P(number))
2020 else if (INFINITYP(number))
2021 return make_indef(POS_INFINITY);
2023 return make_indef(NOT_A_NUMBER);
2024 } else if (COMPARABLEP(number)) {
2026 #if defined HAVE_PSEUG && defined WITH_PSEUG
2027 } else if (BIGGP(number)) {
2028 return make_bigz_bz(bigg_re(XBIGG_DATA(number)));
2030 #if defined HAVE_MPC && defined WITH_MPC || \
2031 defined HAVE_PSEUC && defined WITH_PSEUC
2032 } else if (BIGCP(number)) {
2033 return make_bigfr_bfr(bigc_re(XBIGC_DATA(number)));
2037 /* what should the rest do? */
2038 return Freal_part(wrong_type_argument(Qnumberp, number));
2041 DEFUN("imaginary-part", Fimaginary_part, 1, 1, 0, /*
2042 Return the imaginary part of NUMBER.
2043 If NUMBER is a comparable, 0 is returned.
2047 if (INDEFP(number)) {
2048 if (COMPARABLE_INDEF_P(number))
2050 else if (INFINITYP(number))
2051 return make_indef(POS_INFINITY);
2053 return make_indef(NOT_A_NUMBER);
2054 } else if (RATIONALP(number)) {
2056 #if defined HAVE_MPFR && defined WITH_MPFR
2057 } else if (REALP(number)) {
2058 return make_bigfr(0.0, 0UL);
2060 #if defined HAVE_PSEUG && defined WITH_PSEUG
2061 } else if (BIGGP(number)) {
2062 return make_bigz_bz(bigg_im(XBIGG_DATA(number)));
2064 #if defined HAVE_MPC && defined WITH_MPC || \
2065 defined HAVE_PSEUC && defined WITH_PSEUC
2066 } else if (BIGCP(number)) {
2067 return make_bigfr_bfr(bigc_im(XBIGC_DATA(number)));
2071 /* what should the rest do? */
2072 return Fimaginary_part(wrong_type_argument(Qnumberp, number));
2076 /* Float-rounding functions. */
2077 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR || \
2078 defined(HAVE_MPF) && defined WITH_GMP
2080 DEFUN("fceiling", Ffceiling, 1, 1, 0, /*
2081 Return the smallest integer no less than NUMBER, as a float.
2082 \(Round toward +inf.\)
2086 #if defined HAVE_MPF && defined WITH_GMP
2087 if (BIGFP(number)) {
2088 bigf_set_prec(ent_scratch_bigf, XBIGF_GET_PREC(number));
2090 bigf_ceil(ent_scratch_bigf, XBIGF_DATA(number));
2091 return make_bigf_bf(ent_scratch_bigf);
2093 #endif /* HAVE_MPF */
2095 #if defined HAVE_MPFR && defined WITH_MPFR
2096 if (BIGFRP(number)) {
2097 bigfr_set_prec(ent_scratch_bigfr, XBIGFR_GET_PREC(number));
2099 bigfr_ceil(ent_scratch_bigfr, XBIGFR_DATA(number));
2100 return make_bigfr_bfr(ent_scratch_bigfr);
2102 #endif /* HAVE_MPFR */
2107 number = ent_lift(number, FLOAT_T, NULL);
2110 return make_float(ceil(XFLOAT_DATA(number)));
2115 DEFUN("ffloor", Fffloor, 1, 1, 0, /*
2116 Return the largest integer no greater than NUMBER, as a float.
2117 \(Round towards -inf.\)
2121 #if defined HAVE_MPF && defined WITH_GMP
2122 if (BIGFP(number)) {
2123 bigf_set_prec(ent_scratch_bigf, XBIGF_GET_PREC(number));
2125 bigf_floor(ent_scratch_bigf, XBIGF_DATA(number));
2126 return make_bigf_bf(ent_scratch_bigf);
2128 #endif /* HAVE_MPF */
2130 #if defined HAVE_MPFR && defined WITH_MPFR
2131 if (BIGFRP(number)) {
2132 bigfr_set_prec(ent_scratch_bigfr, XBIGFR_GET_PREC(number));
2134 bigfr_floor(ent_scratch_bigfr, XBIGFR_DATA(number));
2135 return make_bigfr_bfr(ent_scratch_bigfr);
2137 #endif /* HAVE_MPFR */
2142 number = ent_lift(number, FLOAT_T, NULL);
2145 return make_float(floor(XFLOAT_DATA(number)));
2150 DEFUN("fround", Ffround, 1, 1, 0, /*
2151 Return the nearest integer to NUMBER, as a float.
2155 #if defined HAVE_MPF && defined WITH_GMP
2156 if (BIGFP(number)) {
2157 warn_when_safe(Qbigf, Qnotice,
2158 "rounding number of type 'bigf (mpf-floats)"
2159 "not yet implemented");
2162 #endif /* HAVE_MPF */
2164 #if defined HAVE_MPFR && defined WITH_MPFR
2165 if (BIGFRP(number)) {
2166 bigfr_set_prec(ent_scratch_bigfr, XBIGFR_GET_PREC(number));
2168 bigfr_rint(ent_scratch_bigfr, XBIGFR_DATA(number));
2169 return make_bigfr_bfr(ent_scratch_bigfr);
2171 #endif /* HAVE_MPFR */
2176 number = ent_lift(number, FLOAT_T, NULL);
2179 return make_float(emacs_rint(XFLOAT_DATA(number)));
2184 DEFUN("ftruncate", Fftruncate, 1, 1, 0, /*
2185 Truncate a floating point number to an integral float value.
2186 Rounds the value toward zero.
2191 #if defined HAVE_MPF && defined WITH_GMP
2192 if (BIGFP(number)) {
2193 bigf_set_prec(ent_scratch_bigf, XBIGF_GET_PREC(number));
2195 bigf_trunc(ent_scratch_bigf, XBIGF_DATA(number));
2196 return make_bigf_bf(ent_scratch_bigf);
2198 #endif /* HAVE_MPF */
2200 #if defined HAVE_MPFR && defined WITH_MPFR
2201 if (BIGFRP(number)) {
2202 bigfr_set_prec(ent_scratch_bigfr, XBIGFR_GET_PREC(number));
2204 bigfr_trunc(ent_scratch_bigfr, XBIGFR_DATA(number));
2205 return make_bigfr_bfr(ent_scratch_bigfr);
2207 #endif /* HAVE_MPFR */
2212 number = ent_lift(number, FLOAT_T, NULL);
2214 if (FLOATP(number)) {
2215 d = XFLOAT_DATA(number);
2220 return make_float(d);
2225 #endif /* HAVE_MPF(R) || HAVE_FPFLOAT (float-rounding functions) */
2229 #ifdef FLOAT_CATCH_SIGILL
2230 static SIGTYPE float_error(int signo)
2233 fatal_error_signal(signo);
2235 EMACS_REESTABLISH_SIGNAL(signo, arith_error);
2236 EMACS_UNBLOCK_SIGNAL(signo);
2240 /* Was Fsignal(), but it just doesn't make sense for an error
2241 occurring inside a signal handler to be restartable, considering
2242 that anything could happen when the error is signaled and trapped
2243 and considering the asynchronous nature of signal handlers. */
2244 signal_error(Qarith_error, list1(float_error_arg));
2247 /* Another idea was to replace the library function `infnan'
2248 where SIGILL is signaled. */
2250 #endif /* FLOAT_CATCH_SIGILL */
2252 /* In C++, it is impossible to determine what type matherr expects
2253 without some more configure magic.
2254 We shouldn't be using matherr anyways - it's a non-standard SYSVism. */
2255 #if defined (HAVE_MATHERR) && !defined(__cplusplus)
2256 int matherr(struct exception *x)
2260 /* Not called from emacs-lisp float routines; do the default thing. */
2263 /* if (!strcmp (x->name, "pow")) x->name = "expt"; */
2265 args = Fcons(build_string(x->name),
2266 Fcons(make_float(x->arg1), ((in_float == 2)
2267 ? Fcons(make_float(x->arg2),
2272 Fsignal(Qdomain_error, args);
2275 Fsignal(Qsingularity_error, args);
2278 Fsignal(Qoverflow_error, args);
2281 Fsignal(Qunderflow_error, args);
2284 Fsignal(Qarith_error, args);
2287 return 1; /* don't set errno or print a message */
2289 #endif /* HAVE_MATHERR */
2290 #endif /* HAVE_FPFLOAT */
2292 void init_floatfns_very_early(void)
2295 # ifdef FLOAT_CATCH_SIGILL
2296 signal(SIGILL, float_error);
2299 #endif /* HAVE_FPFLOAT */
2302 void syms_of_floatfns(void)
2305 /* Trig functions. */
2307 #if defined(HAVE_FPFLOAT) || defined HAVE_MPFR && defined WITH_MPFR
2314 #endif /* HAVE_FPFLOAT || HAVE_MPFR*/
2315 #if defined HAVE_MPFR && defined WITH_MPFR
2321 /* Bessel functions */
2324 DEFSUBR(Fbessel_y0);
2325 DEFSUBR(Fbessel_y1);
2326 DEFSUBR(Fbessel_yn);
2327 DEFSUBR(Fbessel_j0);
2328 DEFSUBR(Fbessel_j1);
2329 DEFSUBR(Fbessel_jn);
2332 /* Error functions. */
2335 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR
2338 DEFSUBR(Flog_gamma);
2342 /* Root and Log functions. */
2344 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR
2346 #endif /* HAVE_FPFLOAT || HAVE_MPFR */
2352 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR
2357 DEFSUBR(Fcube_root);
2358 #if defined HAVE_MPFR && defined WITH_MPFR
2361 #endif /* HAVE_FPFLOAT || HAVE_MPFR*/
2363 /* Inverse trig functions. */
2365 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR
2372 #endif /* HAVE_FPFLOAT || HAVE_MPFR */
2373 #if defined HAVE_MPFR && defined WITH_MPFR
2377 #endif /* HAVE_MPFR */
2379 /* Rounding functions */
2385 #endif /* HAVE_FPFLOAT */
2390 DEFSUBR(Falmost_eq);
2391 DEFSUBR(Falmost_neq);
2393 /* misc complex functions */
2394 DEFSUBR(Fconjugate);
2395 DEFSUBR(Fcanonical_norm);
2396 DEFSUBR(Freal_part);
2397 DEFSUBR(Fimaginary_part);
2399 /* Float-rounding functions. */
2401 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPF) && defined WITH_GMP || \
2402 defined(HAVE_MPFR) && defined WITH_MPFR
2406 DEFSUBR(Fftruncate);
2407 #endif /* HAVE_FPFLOAT || HAVE_MPF(R) */
2410 void vars_of_floatfns(void)