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));
830 RETURN_WHEN_INDEF(d);
831 return make_float(d/log2_10);
833 static const fpflot log_10 - log(10);
834 d = log(XFLOAT_DATA(number));
835 RETURN_WHEN_INDEF(d);
836 return make_float(d/log_10);
838 return ase_unary_operation_undefined(number);
842 Fsignal(Qarith_error, list1(number));
845 if (NILP(precision));
846 #endif /* HAVE_MPFR */
849 DEFUN("log2", Flog2, 1, 2, 0, /*
850 Return the logarithm base 2 of NUMBER.
851 If second optional argument PRECISION is given, use its value
852 (an integer) as precision.
856 RETURN_WHEN_INDEF(number);
858 #if defined HAVE_MPFR && defined WITH_MPFR
859 Lisp_Object bfrnumber;
861 bigfr_set_prec(ent_scratch_bigfr,
862 internal_get_precision(precision));
864 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
865 bigfr_log2(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
866 return make_bigfr_bfr(ent_scratch_bigfr);
868 number = ent_lift(number, FLOAT_T, NULL);
870 RETURN_WHEN_INDEF(number);
872 if (FLOATP(number)) {
875 d = log2(XFLOAT_DATA(number));
876 return make_float(d);
878 static const fpflot log_2 - log(2);
879 d = log(XFLOAT_DATA(number));
880 RETURN_WHEN_INDEF(d);
881 return make_float(d/log_2);
883 return ase_unary_operation_undefined(number);
887 Fsignal(Qarith_error, list1(number));
890 if (NILP(precision));
891 #endif /* HAVE_MPFR */
894 DEFUN("log", Flog, 1, 3, 0, /*
895 Return the natural logarithm of NUMBER.
896 If second optional argument BASE is given, return the logarithm of
897 NUMBER using that base.
898 If third optional argument PRECISION is given, use its value
899 (an integer) as precision.
901 (number, base, precision))
903 RETURN_WHEN_INDEF(number);
905 if (INTEGERP(base)) {
907 case 2 : return Flog2 (number, precision);
908 case 10: return Flog10(number, precision);
909 default: break; /* Intentional Fall through */
914 #if defined HAVE_MPFR && defined WITH_MPFR
916 /* Not all bignumber libs optimize log2, for instance MPFR
917 implements log2 in function of log. */
918 Lisp_Object _logn, _logb;
919 _logn = Flog(number, Qnil, precision);
920 RETURN_WHEN_INDEF(_logn);
921 _logb = Flog(base, Qnil, precision);
922 return ent_binop(ASE_BINARY_OP_QUO, _logn, _logb);
925 Lisp_Object bfrnumber;
927 bigfr_set_prec(ent_scratch_bigfr,
928 internal_get_precision(precision));
930 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
931 bigfr_log(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
932 return make_bigfr_bfr(ent_scratch_bigfr);
934 #else /* !HAVE_MPFR */
936 /* Processor implementations tend to give an edge to log2 */
937 Lisp_Object _logn, _logb;
938 _logn = Flog2(number, precision);
939 RETURN_WHEN_INDEF(_logn);
940 _logb = Flog2(base, precision);
941 return ent_binop(ASE_BINARY_OP_QUO, _logn, _logb);
944 number = ent_lift(number, FLOAT_T, NULL);
946 RETURN_WHEN_INDEF(number);
948 if (FLOATP(number)) {
950 d = log(XFLOAT_DATA(number));
951 return make_float(d);
954 Fsignal(Qarith_error, list1(number));
957 if (NILP(precision));
958 #endif /* HAVE_MPFR */
961 #undef RETURN_WHEN_INDEF
963 DEFUN("sqrt", Fsqrt, 1, 2, 0, /*
964 Return the square root of NUMBER.
965 If second optional argument PRECISION is given, use its value
966 (an integer) as precision.
970 #if defined(HAVE_MPFR) && defined WITH_MPFR || \
971 defined(HAVE_MPC) && defined WITH_MPC || \
972 defined(HAVE_PSEUC) && defined WITH_PSEUC
974 if (INDEFP(number)) {
975 if (XINDEF_DATA(number) == POS_INFINITY)
977 else if (XINDEF_DATA(number) == NEG_INFINITY)
978 return make_indef(COMPLEX_INFINITY);
983 if (COMPARABLEP(number)) {
984 #if defined HAVE_MPFR && defined WITH_MPFR
985 bigfr_set_prec(ent_scratch_bigfr,
986 internal_get_precision(precision));
989 bigfr_sqrt_ui(ent_scratch_bigfr,
990 (unsigned long)XUINT(number));
991 else if (BIGZP(number) &&
992 bigz_fits_ulong_p(XBIGZ_DATA(number)) &&
993 bigz_sign(XBIGZ_DATA(number)) >= 0) {
994 bigfr_sqrt_ui(ent_scratch_bigfr,
995 (unsigned long)bigz_to_ulong(
996 XBIGZ_DATA(number)));
997 } else if (!NILP(Fnonnegativep(number))) {
998 Lisp_Object bfrnumber;
999 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
1000 bigfr_sqrt(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
1002 #if defined HAVE_MPC && defined WITH_MPC || \
1003 defined HAVE_PSEUC && defined WITH_PSEUC
1004 Lisp_Object bcnumber;
1005 bigc_set_prec(ent_scratch_bigc,
1006 internal_get_precision(precision));
1007 bcnumber = Fcoerce_number(number, Qbigc, precision);
1008 bigc_sqrt(ent_scratch_bigc, XBIGC_DATA(bcnumber));
1009 return make_bigc_bc(ent_scratch_bigc);
1010 #else /* !HAVE_MPC */
1011 Lisp_Object bfrnumber;
1012 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
1013 bigfr_sqrt(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
1014 #endif /* HAVE_MPC */
1016 return make_bigfr_bfr(ent_scratch_bigfr);
1017 #endif /* HAVE_MPFR */
1018 #if defined HAVE_MPC && defined WITH_MPC || \
1019 defined HAVE_PSEUC && defined WITH_PSEUC
1020 } else if (BIGCP(number) || BIGGP(number)) {
1021 Lisp_Object bcnumber;
1022 bigc_set_prec(ent_scratch_bigc,
1023 internal_get_precision(precision));
1025 bcnumber = Fcoerce_number(number, Qbigc, precision);
1026 bigc_sqrt(ent_scratch_bigc, XBIGC_DATA(bcnumber));
1027 return make_bigc_bc(ent_scratch_bigc);
1028 #endif /* HAVE_MPC */
1031 if (NILP(precision));
1032 return wrong_type_argument(Qnumberp, number);
1034 #else /* !HAVE_MPFR && !HAVE_MPC */
1035 if (INDEFP(number)) {
1039 number = ent_lift(number, FLOAT_T, NULL);
1041 if (FLOATP(number)) {
1043 d = sqrt(XFLOAT_DATA(number));
1044 return make_float(d);
1045 } else if (INDEFP(number)) {
1047 if (XINDEF_DATA(number) == POS_INFINITY)
1049 else if (XINDEF_DATA(number) == NEG_INFINITY)
1050 return make_indef(COMPLEX_INFINITY);
1055 Fsignal(Qarith_error, list1(number));
1058 if (NILP(precision));
1059 #endif /* HAVE_MPFR */
1062 DEFUN("cube-root", Fcube_root, 1, 2, 0, /*
1063 Return the cube root of NUMBER.
1064 If second optional argument PRECISION is given, use its value
1065 (an integer) as precision.
1067 (number, precision))
1069 #if defined HAVE_MPFR && defined WITH_MPFR
1070 Lisp_Object bfrnumber;
1075 bigfr_set_prec(ent_scratch_bigfr,
1076 internal_get_precision(precision));
1078 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
1079 bigfr_cbrt(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
1080 return make_bigfr_bfr(ent_scratch_bigfr);
1082 #else /* !HAVE_MPFR */
1083 if (INDEFP(number)) {
1087 number = ent_lift(number, FLOAT_T, NULL);
1089 if (FLOATP(number)) {
1092 d = cbrt(XFLOAT_DATA(number));
1094 d = XFLOAT_DATA(number);
1096 d = pow(d, 1.0 / 3.0);
1098 d = -pow(-d, 1.0 / 3.0);
1100 return make_float(d);
1101 } else if (INDEFP(number)) {
1106 Fsignal(Qarith_error, list1(number));
1109 if (NILP(precision));
1110 #endif /* HAVE_MPFR */
1112 #endif /* HAVE_FPFLOAT || MPFR */
1115 #if defined HAVE_MPFR && defined WITH_MPFR
1116 DEFUN("root", Froot, 2, 3, 0, /*
1117 Return the RADIX-th root of NUMBER.
1118 If third optional argument PRECISION is given, use its value
1119 (an integer) as precision.
1121 (number, radix, precision))
1123 Lisp_Object bfrnumber;
1125 if (!NATNUMP(radix)) {
1126 dead_wrong_type_argument(Qnatnump, radix);
1130 if (INDEFP(number)) {
1131 if (XINDEF_DATA(number) == POS_INFINITY)
1133 else if (XINDEF_DATA(number) == NEG_INFINITY)
1134 return make_indef(COMPLEX_INFINITY);
1139 bigfr_set_prec(ent_scratch_bigfr,
1140 internal_get_precision(precision));
1142 bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
1143 bigfr_root(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber), XUINT(radix));
1144 return make_bigfr_bfr(ent_scratch_bigfr);
1146 #endif /* HAVE_MPFR */
1149 /* (Inverse) hyperbolic trig functions. */
1150 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR
1152 DEFUN("acosh", Facosh, 1, 2, 0, /*
1153 Return the inverse hyperbolic cosine of NUMBER.
1154 If optional argument PRECISION is non-nil, its value
1155 (an integer) is used as precision.
1157 (number, precision))
1159 #if defined HAVE_MPFR && defined WITH_MPFR
1161 MPFR_TRIG_FUN(acosh);
1163 #else /* !HAVE_MPFR */
1164 if (INDEFP(number)) {
1165 return make_indef(NOT_A_NUMBER);
1168 number = ent_lift(number, FLOAT_T, NULL);
1170 if (FLOATP(number)) {
1171 fpfloat d = XFLOAT_DATA(number);
1172 #ifdef HAVE_INVERSE_HYPERBOLIC
1175 d = log(d + sqrt(d * d - 1.0));
1177 return make_float(d);
1178 } else if (INDEFP(number)) {
1179 return make_indef(NOT_A_NUMBER);
1182 Fsignal(Qarith_error, list1(number));
1185 if (NILP(precision));
1186 #endif /* HAVE_MPFR */
1189 DEFUN("asinh", Fasinh, 1, 2, 0, /*
1190 Return the inverse hyperbolic sine of NUMBER.
1191 If optional argument PRECISION is non-nil, its value
1192 (an integer) is used as precision.
1194 (number, precision))
1196 #if defined HAVE_MPFR && defined WITH_MPFR
1198 MPFR_TRIG_FUN(asinh);
1200 #else /* !HAVE_MPFR */
1201 if (INDEFP(number)) {
1202 return make_indef(NOT_A_NUMBER);
1205 number = ent_lift(number, FLOAT_T, NULL);
1207 if (FLOATP(number)) {
1208 fpfloat d = XFLOAT_DATA(number);
1209 #ifdef HAVE_INVERSE_HYPERBOLIC
1212 d = log(d + sqrt(d * d + 1.0));
1214 return make_float(d);
1215 } else if (INDEFP(number)) {
1216 return make_indef(NOT_A_NUMBER);
1219 Fsignal(Qarith_error, list1(number));
1222 if (NILP(precision));
1223 #endif /* HAVE_MPFR */
1226 DEFUN("atanh", Fatanh, 1, 2, 0, /*
1227 Return the inverse hyperbolic tangent of NUMBER.
1228 If optional argument PRECISION is non-nil, its value
1229 (an integer) is used as precision.
1231 (number, precision))
1233 #if defined HAVE_MPFR && defined WITH_MPFR
1235 MPFR_TRIG_FUN(atanh);
1237 #else /* !HAVE_MPFR */
1238 if (INDEFP(number)) {
1239 return make_indef(NOT_A_NUMBER);
1242 number = ent_lift(number, FLOAT_T, NULL);
1244 if (FLOATP(number)) {
1245 fpfloat d = XFLOAT_DATA(number);
1246 #ifdef HAVE_INVERSE_HYPERBOLIC
1249 d = 0.5 * log((1.0 + d) / (1.0 - d));
1251 return make_float(d);
1252 } else if (INDEFP(number)) {
1253 return make_indef(NOT_A_NUMBER);
1256 Fsignal(Qarith_error, list1(number));
1259 if (NILP(precision));
1260 #endif /* HAVE_MPFR */
1263 DEFUN("cosh", Fcosh, 1, 2, 0, /*
1264 Return the hyperbolic cosine of NUMBER.
1265 If optional argument PRECISION is non-nil, its value
1266 (an integer) is used as precision.
1268 (number, precision))
1270 #if defined HAVE_MPFR && defined WITH_MPFR
1272 MPFR_TRIG_FUN(cosh);
1274 #else /* !HAVE_MPFR */
1275 if (INDEFP(number)) {
1276 return make_indef(NOT_A_NUMBER);
1279 number = ent_lift(number, FLOAT_T, NULL);
1281 if (FLOATP(number)) {
1283 d = cosh(XFLOAT_DATA(number));
1284 return make_float(d);
1285 } else if (INDEFP(number)) {
1286 return make_indef(NOT_A_NUMBER);
1289 Fsignal(Qarith_error, list1(number));
1292 if (NILP(precision));
1293 #endif /* HAVE_MPFR */
1296 DEFUN("sinh", Fsinh, 1, 2, 0, /*
1297 Return the hyperbolic sine of NUMBER.
1298 If optional argument PRECISION is non-nil, its value
1299 (an integer) is used as precision.
1301 (number, precision))
1303 #if defined HAVE_MPFR && defined WITH_MPFR
1305 MPFR_TRIG_FUN(sinh);
1307 #else /* !HAVE_MPFR */
1308 if (INDEFP(number)) {
1309 return make_indef(NOT_A_NUMBER);
1312 number = ent_lift(number, FLOAT_T, NULL);
1314 if (FLOATP(number)) {
1316 d = sinh(XFLOAT_DATA(number));
1317 return make_float(d);
1318 } else if (INDEFP(number)) {
1319 return make_indef(NOT_A_NUMBER);
1322 Fsignal(Qarith_error, list1(number));
1325 if (NILP(precision));
1326 #endif /* HAVE_MFPR */
1329 DEFUN("tanh", Ftanh, 1, 2, 0, /*
1330 Return the hyperbolic tangent of NUMBER.
1331 If optional argument PRECISION is non-nil, its value
1332 (an integer) is used as precision.
1334 (number, precision))
1336 #if defined HAVE_MPFR && defined WITH_MPFR
1338 MPFR_TRIG_FUN(tanh);
1340 #else /* !HAVE_MPFR */
1341 if (INDEFP(number)) {
1342 return make_indef(NOT_A_NUMBER);
1345 number = ent_lift(number, FLOAT_T, NULL);
1347 if (FLOATP(number)) {
1348 fpfloat d = XFLOAT_DATA(number);
1350 return make_float(d);
1351 } else if (INDEFP(number)) {
1352 return make_indef(NOT_A_NUMBER);
1355 Fsignal(Qarith_error, list1(number));
1358 if (NILP(precision));
1359 #endif /* HAVE_MPFR */
1362 #if defined HAVE_MPFR && defined WITH_MPFR
1364 DEFUN("sech", Fsech, 1, 2, 0, /*
1365 Return the hyperbolic secant of NUMBER.
1366 If optional argument PRECISION is non-nil, its value
1367 (an integer) is used as precision.
1369 (number, precision))
1371 MPFR_TRIG_FUN(sech);
1374 DEFUN("csch", Fcsch, 1, 2, 0, /*
1375 Return the hyperbolic cosecant of NUMBER.
1376 If optional argument PRECISION is non-nil, its value
1377 (an integer) is used as precision.
1379 (number, precision))
1381 MPFR_TRIG_FUN(csch);
1384 DEFUN("coth", Fcoth, 1, 2, 0, /*
1385 Return the hyperbolic cotangent of NUMBER.
1386 If optional argument PRECISION is non-nil, its value
1387 (an integer) is used as precision.
1389 (number, precision))
1391 MPFR_TRIG_FUN(coth);
1393 #endif /* HAVE_MPFR */
1395 #endif /* HAVE_MPFR || HAVE_FPFLOAT (inverse trig functions) */
1398 /* Rounding functions */
1400 DEFUN("abs", Fabs, 1, 1, 0, /*
1401 Return the absolute value of NUMBER.
1406 if (FLOATP(number)) {
1407 return make_float(fabs(XFLOAT_DATA(number)));
1409 #endif /* HAVE_FPFLOAT */
1412 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1413 /* The most negative Lisp int will overflow */
1414 return (XINT(number) >= 0)
1415 ? number : make_integer(-XINT(number));
1416 #else /* !HAVE_MPZ */
1417 return (XINT(number) >= 0) ? number : make_int(-XINT(number));
1418 #endif /* HAVE_MPZ */
1421 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1422 if (BIGZP(number)) {
1423 if (bigz_sign(XBIGZ_DATA(number)) >= 0)
1426 bigz_abs(ent_scratch_bigz, XBIGZ_DATA(number));
1427 return make_bigz_bz(ent_scratch_bigz);
1429 #endif /* HAVE_MPZ */
1431 #if defined HAVE_MPQ && defined WITH_GMP
1432 if (BIGQP(number)) {
1433 if (bigq_sign(XBIGQ_DATA(number)) >= 0)
1436 bigq_abs(ent_scratch_bigq, XBIGQ_DATA(number));
1437 return make_bigq_bq(ent_scratch_bigq);
1439 #endif /* HAVE_MPQ */
1441 #if defined HAVE_MPF && defined WITH_GMP
1442 if (BIGFP(number)) {
1443 if (bigf_sign(XBIGF_DATA (number)) >= 0)
1446 bigf_set_prec(ent_scratch_bigf, XBIGF_GET_PREC(number));
1448 bigf_abs(ent_scratch_bigf, XBIGF_DATA(number));
1449 return make_bigf_bf(ent_scratch_bigf);
1451 #endif /* HAVE_MPF */
1453 #if defined HAVE_MPFR && defined WITH_MPFR
1454 if (BIGFRP(number)) {
1455 if (bigfr_sign(XBIGFR_DATA (number)) >= 0)
1458 bigfr_set_prec(ent_scratch_bigfr, XBIGFR_GET_PREC(number));
1460 bigfr_abs(ent_scratch_bigfr, XBIGFR_DATA(number));
1461 return make_bigfr_bfr(ent_scratch_bigfr);
1463 #endif /* HAVE_MPFR */
1465 #if defined(HAVE_PSEUG) && defined WITH_PSEUG && defined(HAVE_MPFR)
1466 if (BIGGP(number)) {
1467 bigfr_set_prec(ent_scratch_bigfr,
1468 internal_get_precision(Qnil));
1470 bigg_abs(ent_scratch_bigfr, XBIGG_DATA(number));
1471 return make_bigfr_bfr(ent_scratch_bigfr);
1473 #endif /* HAVE_PSEUG && HAVE_MPFR */
1475 #if defined HAVE_MPC && defined WITH_MPC || \
1476 defined HAVE_PSEUC && defined WITH_PSEUC
1477 if (BIGCP(number)) {
1478 bigfr_set_prec(ent_scratch_bigfr, XBIGC_GET_PREC(number));
1480 if (bigc_nan_p(XBIGC_DATA(number)))
1481 return make_indef(NOT_A_NUMBER);
1482 else if (bigc_inf_p(XBIGC_DATA(number)))
1483 return make_indef(POS_INFINITY);
1485 bigc_abs(ent_scratch_bigfr, XBIGC_DATA(number));
1487 return make_bigfr_bfr(ent_scratch_bigfr);
1489 #endif /* HAVE_PSEUG */
1491 if (INDEFP(number)) {
1492 if (XINDEF_DATA(number) == POS_INFINITY)
1494 else if (XINDEF_DATA(number) == NEG_INFINITY)
1495 return make_indef(POS_INFINITY);
1500 return Fabs(wrong_type_argument(Qnumberp, number));
1503 #if defined(HAVE_FPFLOAT)
1504 /* fuck fuck fuck, I want this in number.el */
1505 DEFUN("float", Ffloat, 1, 1, 0, /*
1506 Return the floating point number numerically equal to NUMBER.
1510 /* Just create the float in order of preference */
1511 return Fcoerce_number(number, Qfloat, Qnil);
1513 #endif /* HAVE_FPFLOAT */
1516 DEFUN("logb", Flogb, 1, 1, 0, /*
1517 Return largest integer <= the base 2 log of the magnitude of NUMBER.
1518 This is the same as the exponent of a float.
1522 fpfloat f = extract_float(number);
1525 return make_int(EMACS_INT_MIN);
1528 fpfloat _lb = logb(f);
1530 IN_FLOAT(val = make_int((EMACS_INT)_lb), "logb", number);
1537 IN_FLOAT(frexp(f, &exqp), "logb", number);
1538 return make_int(exqp - 1);
1549 for (i = 1, d = 0.5; d * d >= f; i += i)
1555 for (i = 1, d = 2.0; d * d <= f; i += i)
1560 return make_int(val);
1562 #endif /* ! HAVE_FREXP */
1563 #endif /* ! HAVE_LOGB */
1565 #endif /* HAVE_FPFLOAT */
1567 DEFUN("ceiling", Fceiling, 1, 1, 0, /*
1568 Return the smallest integer no less than NUMBER. (Round toward +inf.)
1573 if (FLOATP(number)) {
1575 d = ceil(XFLOAT_DATA(number));
1576 return (float_to_int(d, "ceiling", number, Qunbound));
1578 #endif /* HAVE_FPFLOAT */
1580 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1581 if (INTEGERP(number))
1582 #else /* !HAVE_MPZ */
1584 #endif /* HAVE_MPZ */
1587 #if defined(HAVE_MPQ) && defined(HAVE_MPZ) && defined WITH_GMP
1588 if (BIGQP(number)) {
1589 bigz_ceil(ent_scratch_bigz,
1590 XBIGQ_NUMERATOR(number),
1591 XBIGQ_DENOMINATOR(number));
1592 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1596 #if defined HAVE_MPF && defined WITH_GMP
1597 else if (BIGFP(number)) {
1598 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1599 bigf_ceil(ent_scratch_bigf, XBIGF_DATA(number));
1600 bigz_set_bigf(ent_scratch_bigz, ent_scratch_bigf);
1601 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1602 #else /* !HAVE_MPZ */
1603 bigf_ceil(ent_scratch_bigf, XBIGF_DATA(number));
1604 return make_int((EMACS_INT)bigf_to_long(ent_scratch_bigf));
1605 #endif /* HAVE_MPZ */
1607 #endif /* HAVE_MPF */
1609 #if defined HAVE_MPFR && defined WITH_MPFR
1610 else if (BIGFRP(number)) {
1611 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1612 bigfr_ceil(ent_scratch_bigfr, XBIGFR_DATA(number));
1613 bigz_set_bigfr(ent_scratch_bigz, ent_scratch_bigfr);
1614 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1615 #else /* !HAVE_MPZ */
1616 bigfr_ceil(ent_scratch_bigfr, XBIGFR_DATA(number));
1617 return make_int((EMACS_INT)bigfr_to_long(ent_scratch_bigfr));
1618 #endif /* HAVE_MPZ */
1620 #endif /* HAVE_MPFR */
1625 #if defined HAVE_MPC && defined WITH_MPC || \
1626 defined HAVE_PSEUC && defined WITH_PSEUC || \
1627 defined HAVE_PSEUG && defined WITH_PSEUG
1628 return Fceiling(wrong_type_argument(Qcomparablep, number));
1629 #else /* !HAVE_MPC */
1630 return Fceiling(wrong_type_argument(Qnumberp, number));
1631 #endif /* HAVE_MPC */
1634 DEFUN("floor", Ffloor, 1, 2, 0, /*
1635 Return the largest integer no greater than NUMBER. (Round towards -inf.)
1636 With optional second argument DIVISOR, return the largest integer no
1637 greater than NUMBER/DIVISOR.
1641 ase_object_type_t ntquo;
1644 CHECK_COMPARABLE(number);
1645 if (NILP(divisor)) {
1646 return Ffloor(number, make_int(1L));
1650 /* !NILP(divisor) */
1652 CHECK_COMPARABLE(divisor);
1654 if (INTEGERP(number) && INTEGERP(divisor)) {
1655 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1656 /* this is the optimised version, since
1657 * bigz_floor always takes two arguments
1659 number = ent_lift(number, BIGZ_T, NULL);
1660 divisor = ent_lift(divisor, BIGZ_T, NULL);
1662 bigz_floor(ent_scratch_bigz,
1664 XBIGZ_DATA(divisor));
1665 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1667 number = ent_lift(number, FLOAT_T, NULL);
1668 divisor = ent_lift(divisor, FLOAT_T, NULL);
1672 quo = ent_binop(ASE_BINARY_OP_QUO, number, divisor);
1673 ntquo = ase_optable_index(quo);
1676 case INT_T: /* trivial */
1683 IN_FLOAT((d = floor(XFLOAT_DATA(quo))), "floor", quo);
1684 return (float_to_int(d, "floor", quo, Qunbound));
1687 #if defined(HAVE_MPQ) && defined(HAVE_MPZ) && defined WITH_GMP
1688 bigz_floor(ent_scratch_bigz,
1689 XBIGQ_NUMERATOR(quo), XBIGQ_DENOMINATOR(quo));
1690 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1696 #if defined HAVE_MPF && defined WITH_GMP
1697 bigf_floor(ent_scratch_bigf, XBIGF_DATA(quo));
1698 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1699 bigz_set_bigf(ent_scratch_bigz, ent_scratch_bigf);
1700 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1701 #else /* !HAVE_MPZ */
1703 (EMACS_INT)bigf_to_long(ent_scratch_bigf));
1704 #endif /* HAVE_MPZ */
1706 #endif /* HAVE_MPF */
1709 #if defined HAVE_MPFR && defined WITH_MPFR
1710 bigfr_floor(ent_scratch_bigfr, XBIGFR_DATA(quo));
1711 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1712 bigz_set_bigfr(ent_scratch_bigz, ent_scratch_bigfr);
1713 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1714 #else /* !HAVE_MPZ */
1716 (EMACS_INT)bigfr_to_long(ent_scratch_bigfr));
1717 #endif /* HAVE_MPZ */
1719 #endif /* HAVE_MPFR */
1725 return Fsignal(Qdomain_error, Qnil);
1728 DEFUN("round", Fround, 1, 1, 0, /*
1729 Return the nearest integer to NUMBER.
1731 NUMBER has to have an archimedian valuation, #'round returns the
1732 integer z for which | number - z | is minimal.
1737 if (FLOATP(number)) {
1739 /* Screw the prevailing rounding mode. */
1740 d = emacs_rint(XFLOAT_DATA(number));
1741 return (float_to_int(d, "round", number, Qunbound));
1743 #endif /* HAVE_FPFLOAT */
1745 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1746 if (INTEGERP(number))
1747 #else /* !HAVE_MPZ */
1749 #endif /* HAVE_MPZ */
1752 #if defined(HAVE_MPQ) && defined(HAVE_MPZ) && defined WITH_GMP
1753 else if (BIGQP(number)) {
1754 /* first off, let's create the division, remainder as well */
1756 mpz_tdiv_qr(ent_scratch_bigz,
1757 bigq_numerator(ent_scratch_bigq),
1758 XBIGQ_NUMERATOR(number),
1759 XBIGQ_DENOMINATOR(number));
1761 /* <- denom(number) * 2 */
1762 mpz_mul_2exp(bigq_numerator(ent_scratch_bigq),
1763 bigq_numerator(ent_scratch_bigq), 1);
1765 /* check if we had to add one */
1766 if (mpz_cmpabs(bigq_numerator(ent_scratch_bigq),
1767 XBIGQ_DENOMINATOR(number)) >= 0) {
1768 /* >= ceil(denom(number) / 2) */
1769 if (mpz_sgn(bigq_numerator(ent_scratch_bigq)) > 0) {
1770 mpz_add_ui(ent_scratch_bigz,
1771 ent_scratch_bigz, 1UL);
1773 mpz_sub_ui(ent_scratch_bigz,
1774 ent_scratch_bigz, 1UL);
1777 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1779 #endif /* HAVE_MPQ && HAVE_MPZ */
1781 #if defined HAVE_MPF && defined WITH_GMP
1782 else if (BIGFP(number)) {
1783 warn_when_safe(Qbigf, Qnotice,
1784 "rounding number of type 'bigf (mpf-floats)"
1785 "not yet implemented");
1788 #endif /* HAVE_MPF */
1790 #if defined HAVE_MPFR && defined WITH_MPFR
1791 else if (BIGFRP(number)) {
1792 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1793 bigfr_rint(ent_scratch_bigfr, XBIGFR_DATA(number));
1794 bigz_set_bigfr(ent_scratch_bigz, ent_scratch_bigfr);
1795 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1796 #else /* !HAVE_MPZ */
1797 bigfr_rint(ent_scratch_bigfr, XBIGFR_DATA(number));
1798 return make_int((EMACS_INT)bigfr_to_long(ent_scratch_bigfr));
1799 #endif /* HAVE_MPZ */
1801 #endif /* HAVE_MPFR */
1803 else if (INDEFP(number))
1806 #if defined HAVE_MPC && defined WITH_MPC || \
1807 defined HAVE_PSEUC && defined WITH_PSEUC || \
1808 defined HAVE_PSEUG && defined WITH_PSEUG
1809 return Fround(wrong_type_argument(Qcomparablep, number));
1810 #else /* !HAVE_MPC */
1811 return Fround(wrong_type_argument(Qnumberp, number));
1812 #endif /* HAVE_MPC */
1815 DEFUN("truncate", Ftruncate, 1, 1, 0, /*
1816 Truncate a floating point number to an integer.
1817 Rounds the value toward zero.
1823 return float_to_int(XFLOAT_DATA(number), "truncate", number,
1825 #endif /* HAVE_FPFLOAT */
1827 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1828 if (INTEGERP(number))
1829 #else /* !HAVE_MPZ */
1831 #endif /* HAVE_MPZ */
1834 #if defined HAVE_MPQ && defined WITH_GMP
1835 else if (BIGQP(number)) {
1836 bigz_div(ent_scratch_bigz,
1837 XBIGQ_NUMERATOR(number),
1838 XBIGQ_DENOMINATOR(number));
1839 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1843 #if defined HAVE_MPF && defined WITH_GMP
1844 else if (BIGFP(number)) {
1845 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1846 bigf_trunc(ent_scratch_bigf, XBIGF_DATA(number));
1847 bigz_set_bigf(ent_scratch_bigz, ent_scratch_bigf);
1848 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1849 #else /* !HAVE_MPZ */
1850 bigf_trunc(ent_scratch_bigf, XBIGF_DATA(number));
1851 return make_int((EMACS_INT)bigf_to_long(ent_scratch_bigf));
1852 #endif /* HAVE_MPZ */
1854 #endif /* HAVE_MPF */
1856 #if defined HAVE_MPFR && defined WITH_MPFR
1857 else if (BIGFRP(number)) {
1858 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1859 bigfr_trunc(ent_scratch_bigfr, XBIGFR_DATA(number));
1860 bigz_set_bigfr(ent_scratch_bigz, ent_scratch_bigfr);
1861 return ent_mpz_downgrade_maybe(ent_scratch_bigz);
1862 #else /* !HAVE_MPZ */
1863 bigfr_trunc(ent_scratch_bigfr, XBIGFR_DATA(number));
1864 return make_int((EMACS_INT)bigfr_to_long(ent_scratch_bigfr));
1865 #endif /* HAVE_MPZ */
1867 #endif /* HAVE_MPFR */
1869 else if (INDEFP(number))
1872 #if defined HAVE_MPC && defined WITH_MPC || \
1873 defined HAVE_PSEUC && defined WITH_PSEUC || \
1874 defined HAVE_PSEUG && defined WITH_PSEUG
1875 return Ftruncate(wrong_type_argument(Qcomparablep, number));
1876 #else /* !HAVE_MPC */
1877 return Ftruncate(wrong_type_argument(Qnumberp, number));
1878 #endif /* HAVE_MPC */
1881 DEFUN("almost=", Falmost_eq, 2, 3, 0, /*
1882 Return t if NUMBER1 is almost equal to NUMBER2.
1884 Optional argument THRES can be used to specify the threshold,
1885 float-epsilon by default.
1887 (number1, number2, thres))
1889 #if defined HAVE_FPFLOAT
1891 thres = Vfloat_epsilon;
1895 if (FLOATP(number1) && FLOATP(number2)) {
1896 fpfloat n1 = XFLOAT_DATA(number1);
1897 fpfloat n2 = XFLOAT_DATA(number2);
1898 fpfloat thr = XFLOAT_DATA(thres);
1905 return d < thr ? Qt : Qnil;
1907 #endif /* HAVE_FPFLOAT */
1908 return ent_binrel(ASE_BINARY_REL_EQUALP, number1, number2) ? Qt : Qnil;
1911 DEFUN("almost/=", Falmost_neq, 2, 3, 0, /*
1912 Return t if NUMBER1 is clearly different from NUMBER2.
1914 Optional argument THRES can be used to specify the threshold,
1915 float-epsilon by default.
1917 (number1, number2, thres))
1919 #if defined HAVE_FPFLOAT
1921 thres = Vfloat_epsilon;
1925 if (FLOATP(number1) && FLOATP(number2)) {
1926 fpfloat n1 = XFLOAT_DATA(number1);
1927 fpfloat n2 = XFLOAT_DATA(number2);
1928 fpfloat thr = XFLOAT_DATA(thres);
1935 return d < thr ? Qnil : Qt;
1937 #endif /* HAVE_FPFLOAT */
1938 return ent_binrel(ASE_BINARY_REL_NEQP, number1, number2) ? Qt : Qnil;
1942 /* misc complex functions */
1943 DEFUN("conjugate", Fconjugate, 1, 1, 0, /*
1944 Return the \(canonical\) conjugate of NUMBER.
1945 If NUMBER is a comparable, just return NUMBER.
1949 if (COMPARABLEP(number)) {
1951 #if defined HAVE_PSEUG && defined WITH_PSEUG
1952 } else if (BIGGP(number)) {
1953 bigg_conj(ent_scratch_bigg, XBIGG_DATA(number));
1954 return make_bigg_bg(ent_scratch_bigg);
1956 #if defined HAVE_MPC && defined WITH_MPC || \
1957 defined HAVE_PSEUC && defined WITH_PSEUC
1958 } else if (BIGCP(number)) {
1959 bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(number));
1960 bigc_conj(ent_scratch_bigc, XBIGC_DATA(number));
1961 return make_bigc_bc(ent_scratch_bigc);
1963 #if defined HAVE_QUATERN && defined WITH_QUATERN
1964 } else if (QUATERNP(number)) {
1965 quatern_conj(ent_scratch_quatern, XQUATERN_DATA(number));
1966 return make_quatern_qu(ent_scratch_quatern);
1968 } else if (INDEFP(number)) {
1972 /* what should the rest do? */
1973 return Fconjugate(wrong_type_argument(Qnumberp, number));
1976 DEFUN("canonical-norm", Fcanonical_norm, 1, 1, 0, /*
1977 Return the canonical norm of NUMBER.
1981 if (INDEFP(number)) {
1982 if (INFINITYP(number))
1983 return make_indef(POS_INFINITY);
1985 return make_indef(NOT_A_NUMBER);
1986 } else if (COMPARABLEP(number)) {
1987 return Fabs(number);
1988 #if defined HAVE_PSEUG && defined WITH_PSEUG
1989 } else if (BIGGP(number)) {
1990 bigg_norm(ent_scratch_bigz, XBIGG_DATA(number));
1991 return make_bigz_bz(ent_scratch_bigz);
1993 #if defined HAVE_MPC && defined WITH_MPC || \
1994 defined HAVE_PSEUC && defined WITH_PSEUC
1995 } else if (BIGCP(number)) {
1996 bigfr_set_prec(ent_scratch_bigfr, XBIGC_GET_PREC(number));
1997 bigc_norm(ent_scratch_bigfr, XBIGC_DATA(number));
1998 return make_bigfr_bfr(ent_scratch_bigfr);
2000 #if defined HAVE_QUATERN && defined WITH_QUATERN
2001 } else if (QUATERNP(number)) {
2002 quatern_norm(ent_scratch_bigz, XQUATERN_DATA(number));
2003 return make_bigz_bz(ent_scratch_bigz);
2007 /* what should the rest do? */
2008 return Fcanonical_norm(wrong_type_argument(Qnumberp, number));
2011 DEFUN("real-part", Freal_part, 1, 1, 0, /*
2012 Return the real part of NUMBER.
2016 if (INDEFP(number)) {
2017 if (COMPARABLE_INDEF_P(number))
2019 else if (INFINITYP(number))
2020 return make_indef(POS_INFINITY);
2022 return make_indef(NOT_A_NUMBER);
2023 } else if (COMPARABLEP(number)) {
2025 #if defined HAVE_PSEUG && defined WITH_PSEUG
2026 } else if (BIGGP(number)) {
2027 return make_bigz_bz(bigg_re(XBIGG_DATA(number)));
2029 #if defined HAVE_MPC && defined WITH_MPC || \
2030 defined HAVE_PSEUC && defined WITH_PSEUC
2031 } else if (BIGCP(number)) {
2032 return make_bigfr_bfr(bigc_re(XBIGC_DATA(number)));
2036 /* what should the rest do? */
2037 return Freal_part(wrong_type_argument(Qnumberp, number));
2040 DEFUN("imaginary-part", Fimaginary_part, 1, 1, 0, /*
2041 Return the imaginary part of NUMBER.
2042 If NUMBER is a comparable, 0 is returned.
2046 if (INDEFP(number)) {
2047 if (COMPARABLE_INDEF_P(number))
2049 else if (INFINITYP(number))
2050 return make_indef(POS_INFINITY);
2052 return make_indef(NOT_A_NUMBER);
2053 } else if (RATIONALP(number)) {
2055 #if defined HAVE_MPFR && defined WITH_MPFR
2056 } else if (REALP(number)) {
2057 return make_bigfr(0.0, 0UL);
2059 #if defined HAVE_PSEUG && defined WITH_PSEUG
2060 } else if (BIGGP(number)) {
2061 return make_bigz_bz(bigg_im(XBIGG_DATA(number)));
2063 #if defined HAVE_MPC && defined WITH_MPC || \
2064 defined HAVE_PSEUC && defined WITH_PSEUC
2065 } else if (BIGCP(number)) {
2066 return make_bigfr_bfr(bigc_im(XBIGC_DATA(number)));
2070 /* what should the rest do? */
2071 return Fimaginary_part(wrong_type_argument(Qnumberp, number));
2075 /* Float-rounding functions. */
2076 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR || \
2077 defined(HAVE_MPF) && defined WITH_GMP
2079 DEFUN("fceiling", Ffceiling, 1, 1, 0, /*
2080 Return the smallest integer no less than NUMBER, as a float.
2081 \(Round toward +inf.\)
2085 #if defined HAVE_MPF && defined WITH_GMP
2086 if (BIGFP(number)) {
2087 bigf_set_prec(ent_scratch_bigf, XBIGF_GET_PREC(number));
2089 bigf_ceil(ent_scratch_bigf, XBIGF_DATA(number));
2090 return make_bigf_bf(ent_scratch_bigf);
2092 #endif /* HAVE_MPF */
2094 #if defined HAVE_MPFR && defined WITH_MPFR
2095 if (BIGFRP(number)) {
2096 bigfr_set_prec(ent_scratch_bigfr, XBIGFR_GET_PREC(number));
2098 bigfr_ceil(ent_scratch_bigfr, XBIGFR_DATA(number));
2099 return make_bigfr_bfr(ent_scratch_bigfr);
2101 #endif /* HAVE_MPFR */
2106 number = ent_lift(number, FLOAT_T, NULL);
2109 return make_float(ceil(XFLOAT_DATA(number)));
2114 DEFUN("ffloor", Fffloor, 1, 1, 0, /*
2115 Return the largest integer no greater than NUMBER, as a float.
2116 \(Round towards -inf.\)
2120 #if defined HAVE_MPF && defined WITH_GMP
2121 if (BIGFP(number)) {
2122 bigf_set_prec(ent_scratch_bigf, XBIGF_GET_PREC(number));
2124 bigf_floor(ent_scratch_bigf, XBIGF_DATA(number));
2125 return make_bigf_bf(ent_scratch_bigf);
2127 #endif /* HAVE_MPF */
2129 #if defined HAVE_MPFR && defined WITH_MPFR
2130 if (BIGFRP(number)) {
2131 bigfr_set_prec(ent_scratch_bigfr, XBIGFR_GET_PREC(number));
2133 bigfr_floor(ent_scratch_bigfr, XBIGFR_DATA(number));
2134 return make_bigfr_bfr(ent_scratch_bigfr);
2136 #endif /* HAVE_MPFR */
2141 number = ent_lift(number, FLOAT_T, NULL);
2144 return make_float(floor(XFLOAT_DATA(number)));
2149 DEFUN("fround", Ffround, 1, 1, 0, /*
2150 Return the nearest integer to NUMBER, as a float.
2154 #if defined HAVE_MPF && defined WITH_GMP
2155 if (BIGFP(number)) {
2156 warn_when_safe(Qbigf, Qnotice,
2157 "rounding number of type 'bigf (mpf-floats)"
2158 "not yet implemented");
2161 #endif /* HAVE_MPF */
2163 #if defined HAVE_MPFR && defined WITH_MPFR
2164 if (BIGFRP(number)) {
2165 bigfr_set_prec(ent_scratch_bigfr, XBIGFR_GET_PREC(number));
2167 bigfr_rint(ent_scratch_bigfr, XBIGFR_DATA(number));
2168 return make_bigfr_bfr(ent_scratch_bigfr);
2170 #endif /* HAVE_MPFR */
2175 number = ent_lift(number, FLOAT_T, NULL);
2178 return make_float(emacs_rint(XFLOAT_DATA(number)));
2183 DEFUN("ftruncate", Fftruncate, 1, 1, 0, /*
2184 Truncate a floating point number to an integral float value.
2185 Rounds the value toward zero.
2190 #if defined HAVE_MPF && defined WITH_GMP
2191 if (BIGFP(number)) {
2192 bigf_set_prec(ent_scratch_bigf, XBIGF_GET_PREC(number));
2194 bigf_trunc(ent_scratch_bigf, XBIGF_DATA(number));
2195 return make_bigf_bf(ent_scratch_bigf);
2197 #endif /* HAVE_MPF */
2199 #if defined HAVE_MPFR && defined WITH_MPFR
2200 if (BIGFRP(number)) {
2201 bigfr_set_prec(ent_scratch_bigfr, XBIGFR_GET_PREC(number));
2203 bigfr_trunc(ent_scratch_bigfr, XBIGFR_DATA(number));
2204 return make_bigfr_bfr(ent_scratch_bigfr);
2206 #endif /* HAVE_MPFR */
2211 number = ent_lift(number, FLOAT_T, NULL);
2213 if (FLOATP(number)) {
2214 d = XFLOAT_DATA(number);
2219 return make_float(d);
2224 #endif /* HAVE_MPF(R) || HAVE_FPFLOAT (float-rounding functions) */
2228 #ifdef FLOAT_CATCH_SIGILL
2229 static SIGTYPE float_error(int signo)
2232 fatal_error_signal(signo);
2234 EMACS_REESTABLISH_SIGNAL(signo, arith_error);
2235 EMACS_UNBLOCK_SIGNAL(signo);
2239 /* Was Fsignal(), but it just doesn't make sense for an error
2240 occurring inside a signal handler to be restartable, considering
2241 that anything could happen when the error is signaled and trapped
2242 and considering the asynchronous nature of signal handlers. */
2243 signal_error(Qarith_error, list1(float_error_arg));
2246 /* Another idea was to replace the library function `infnan'
2247 where SIGILL is signaled. */
2249 #endif /* FLOAT_CATCH_SIGILL */
2251 /* In C++, it is impossible to determine what type matherr expects
2252 without some more configure magic.
2253 We shouldn't be using matherr anyways - it's a non-standard SYSVism. */
2254 #if defined (HAVE_MATHERR) && !defined(__cplusplus)
2255 int matherr(struct exception *x)
2259 /* Not called from emacs-lisp float routines; do the default thing. */
2262 /* if (!strcmp (x->name, "pow")) x->name = "expt"; */
2264 args = Fcons(build_string(x->name),
2265 Fcons(make_float(x->arg1), ((in_float == 2)
2266 ? Fcons(make_float(x->arg2),
2271 Fsignal(Qdomain_error, args);
2274 Fsignal(Qsingularity_error, args);
2277 Fsignal(Qoverflow_error, args);
2280 Fsignal(Qunderflow_error, args);
2283 Fsignal(Qarith_error, args);
2286 return 1; /* don't set errno or print a message */
2288 #endif /* HAVE_MATHERR */
2289 #endif /* HAVE_FPFLOAT */
2291 void init_floatfns_very_early(void)
2294 # ifdef FLOAT_CATCH_SIGILL
2295 signal(SIGILL, float_error);
2298 #endif /* HAVE_FPFLOAT */
2301 void syms_of_floatfns(void)
2304 /* Trig functions. */
2306 #if defined(HAVE_FPFLOAT) || defined HAVE_MPFR && defined WITH_MPFR
2313 #endif /* HAVE_FPFLOAT || HAVE_MPFR*/
2314 #if defined HAVE_MPFR && defined WITH_MPFR
2320 /* Bessel functions */
2323 DEFSUBR(Fbessel_y0);
2324 DEFSUBR(Fbessel_y1);
2325 DEFSUBR(Fbessel_yn);
2326 DEFSUBR(Fbessel_j0);
2327 DEFSUBR(Fbessel_j1);
2328 DEFSUBR(Fbessel_jn);
2331 /* Error functions. */
2334 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR
2337 DEFSUBR(Flog_gamma);
2341 /* Root and Log functions. */
2343 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR
2345 #endif /* HAVE_FPFLOAT || HAVE_MPFR */
2351 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR
2356 DEFSUBR(Fcube_root);
2357 #if defined HAVE_MPFR && defined WITH_MPFR
2360 #endif /* HAVE_FPFLOAT || HAVE_MPFR*/
2362 /* Inverse trig functions. */
2364 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR
2371 #endif /* HAVE_FPFLOAT || HAVE_MPFR */
2372 #if defined HAVE_MPFR && defined WITH_MPFR
2376 #endif /* HAVE_MPFR */
2378 /* Rounding functions */
2384 #endif /* HAVE_FPFLOAT */
2389 DEFSUBR(Falmost_eq);
2390 DEFSUBR(Falmost_neq);
2392 /* misc complex functions */
2393 DEFSUBR(Fconjugate);
2394 DEFSUBR(Fcanonical_norm);
2395 DEFSUBR(Freal_part);
2396 DEFSUBR(Fimaginary_part);
2398 /* Float-rounding functions. */
2400 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPF) && defined WITH_GMP || \
2401 defined(HAVE_MPFR) && defined WITH_MPFR
2405 DEFSUBR(Fftruncate);
2406 #endif /* HAVE_FPFLOAT || HAVE_MPF(R) */
2409 void vars_of_floatfns(void)