1 /* Primitive operations on floating point for XEmacs Lisp interpreter.
2 Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of XEmacs.
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Synched up with: FSF 19.30. */
23 /* ANSI C requires only these float functions:
24 acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod,
25 frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh.
27 Define HAVE_INVERSE_HYPERBOLIC if you have acosh, asinh, and atanh.
28 Define HAVE_CBRT if you have cbrt().
29 Define HAVE_RINT if you have rint().
30 If you don't define these, then the appropriate routines will be simulated.
32 Define HAVE_MATHERR if on a system supporting the SysV matherr() callback.
33 (This should happen automatically.)
35 Define FLOAT_CHECK_ERRNO if the float library routines set errno.
36 This has no effect if HAVE_MATHERR is defined.
38 Define FLOAT_CATCH_SIGILL if the float library routines signal SIGILL.
39 (What systems actually do this? Let me know. -jwz)
41 Define FLOAT_CHECK_DOMAIN if the float library doesn't handle errors by
42 either setting errno, or signalling SIGFPE/SIGILL. Otherwise, domain and
43 range checking will happen before calling the float routines. This has
44 no effect if HAVE_MATHERR is defined (since matherr will be called when
45 a domain error occurs).
50 #include "syssignal.h"
52 #ifdef LISP_FLOAT_TYPE
54 /* Need to define a differentiating symbol -- see sysfloat.h */
55 #define THIS_FILENAME floatfns
62 double r = floor (x + 0.5);
63 double 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)
110 #define arith_error(op,arg) \
111 Fsignal (Qarith_error, list2 (build_string ((op)), (arg)))
112 #define range_error(op,arg) \
113 Fsignal (Qrange_error, list2 (build_string ((op)), (arg)))
114 #define range_error2(op,a1,a2) \
115 Fsignal (Qrange_error, list3 (build_string ((op)), (a1), (a2)))
116 #define domain_error(op,arg) \
117 Fsignal (Qdomain_error, list2 (build_string ((op)), (arg)))
118 #define domain_error2(op,a1,a2) \
119 Fsignal (Qdomain_error, list3 (build_string ((op)), (a1), (a2)))
122 /* Convert float to Lisp Integer if it fits, else signal a range
123 error using the given arguments. */
125 float_to_int (double x, CONST char *name, Lisp_Object num, Lisp_Object num2)
127 if (x >= ((EMACS_INT) 1 << (VALBITS-1))
128 || x <= - ((EMACS_INT) 1 << (VALBITS-1)) - (EMACS_INT) 1)
130 if (!UNBOUNDP (num2))
131 range_error2 (name, num, num2);
133 range_error (name, num);
135 return (make_int ((EMACS_INT) x));
140 in_float_error (void)
148 domain_error2 (float_error_fn_name, float_error_arg, float_error_arg2);
150 domain_error (float_error_fn_name, float_error_arg);
153 range_error (float_error_fn_name, float_error_arg);
156 arith_error (float_error_fn_name, float_error_arg);
163 mark_float (Lisp_Object obj, void (*markobj) (Lisp_Object))
169 float_equal (Lisp_Object o1, Lisp_Object o2, int depth)
171 return (extract_float (o1) == extract_float (o2));
175 float_hash (Lisp_Object obj, int depth)
177 /* mod the value down to 32-bit range */
178 /* #### change for 64-bit machines */
179 return (unsigned long) fmod (extract_float (obj), 4e9);
182 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("float", float,
183 mark_float, print_float, 0, float_equal,
184 float_hash, struct Lisp_Float);
186 /* Extract a Lisp number as a `double', or signal an error. */
189 extract_float (Lisp_Object num)
191 CHECK_INT_OR_FLOAT (num);
194 return (float_data (XFLOAT (num)));
195 return (double) XINT (num);
197 #endif /* LISP_FLOAT_TYPE */
200 /* Trig functions. */
201 #ifdef LISP_FLOAT_TYPE
203 DEFUN ("acos", Facos, 1, 1, 0, /*
204 Return the inverse cosine of ARG.
208 double d = extract_float (arg);
209 #ifdef FLOAT_CHECK_DOMAIN
210 if (d > 1.0 || d < -1.0)
211 domain_error ("acos", arg);
213 IN_FLOAT (d = acos (d), "acos", arg);
214 return make_float (d);
217 DEFUN ("asin", Fasin, 1, 1, 0, /*
218 Return the inverse sine of ARG.
222 double d = extract_float (arg);
223 #ifdef FLOAT_CHECK_DOMAIN
224 if (d > 1.0 || d < -1.0)
225 domain_error ("asin", arg);
227 IN_FLOAT (d = asin (d), "asin", arg);
228 return make_float (d);
231 DEFUN ("atan", Fatan, 1, 2, 0, /*
232 Return the inverse tangent of ARG.
236 double d = extract_float (arg1);
239 IN_FLOAT (d = atan (d), "atan", arg1);
242 double d2 = extract_float (arg2);
243 #ifdef FLOAT_CHECK_DOMAIN
244 if (d == 0.0 && d2 == 0.0)
245 domain_error2 ("atan", arg1, arg2);
247 IN_FLOAT2 (d = atan2 (d, d2), "atan", arg1, arg2);
249 return make_float (d);
252 DEFUN ("cos", Fcos, 1, 1, 0, /*
253 Return the cosine of ARG.
257 double d = extract_float (arg);
258 IN_FLOAT (d = cos (d), "cos", arg);
259 return make_float (d);
262 DEFUN ("sin", Fsin, 1, 1, 0, /*
263 Return the sine of ARG.
267 double d = extract_float (arg);
268 IN_FLOAT (d = sin (d), "sin", arg);
269 return make_float (d);
272 DEFUN ("tan", Ftan, 1, 1, 0, /*
273 Return the tangent of ARG.
277 double d = extract_float (arg);
279 #ifdef FLOAT_CHECK_DOMAIN
281 domain_error ("tan", arg);
283 IN_FLOAT (d = (sin (d) / c), "tan", arg);
284 return make_float (d);
286 #endif /* LISP_FLOAT_TYPE (trig functions) */
289 /* Bessel functions */
290 #if 0 /* Leave these out unless we find there's a reason for them. */
291 /* #ifdef LISP_FLOAT_TYPE */
293 DEFUN ("bessel-j0", Fbessel_j0, 1, 1, 0, /*
294 Return the bessel function j0 of ARG.
298 double d = extract_float (arg);
299 IN_FLOAT (d = j0 (d), "bessel-j0", arg);
300 return make_float (d);
303 DEFUN ("bessel-j1", Fbessel_j1, 1, 1, 0, /*
304 Return the bessel function j1 of ARG.
308 double d = extract_float (arg);
309 IN_FLOAT (d = j1 (d), "bessel-j1", arg);
310 return make_float (d);
313 DEFUN ("bessel-jn", Fbessel_jn, 2, 2, 0, /*
314 Return the order N bessel function output jn of ARG.
315 The first arg (the order) is truncated to an integer.
319 int i1 = extract_float (arg1);
320 double f2 = extract_float (arg2);
322 IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", arg1);
323 return make_float (f2);
326 DEFUN ("bessel-y0", Fbessel_y0, 1, 1, 0, /*
327 Return the bessel function y0 of ARG.
331 double d = extract_float (arg);
332 IN_FLOAT (d = y0 (d), "bessel-y0", arg);
333 return make_float (d);
336 DEFUN ("bessel-y1", Fbessel_y1, 1, 1, 0, /*
337 Return the bessel function y1 of ARG.
341 double d = extract_float (arg);
342 IN_FLOAT (d = y1 (d), "bessel-y0", arg);
343 return make_float (d);
346 DEFUN ("bessel-yn", Fbessel_yn, 2, 2, 0, /*
347 Return the order N bessel function output yn of ARG.
348 The first arg (the order) is truncated to an integer.
352 int i1 = extract_float (arg1);
353 double f2 = extract_float (arg2);
355 IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", arg1);
356 return make_float (f2);
359 #endif /* 0 (bessel functions) */
361 /* Error functions. */
362 #if 0 /* Leave these out unless we see they are worth having. */
363 /* #ifdef LISP_FLOAT_TYPE */
365 DEFUN ("erf", Ferf, 1, 1, 0, /*
366 Return the mathematical error function of ARG.
370 double d = extract_float (arg);
371 IN_FLOAT (d = erf (d), "erf", arg);
372 return make_float (d);
375 DEFUN ("erfc", Ferfc, 1, 1, 0, /*
376 Return the complementary error function of ARG.
380 double d = extract_float (arg);
381 IN_FLOAT (d = erfc (d), "erfc", arg);
382 return make_float (d);
385 DEFUN ("log-gamma", Flog_gamma, 1, 1, 0, /*
386 Return the log gamma of ARG.
390 double d = extract_float (arg);
391 IN_FLOAT (d = lgamma (d), "log-gamma", arg);
392 return make_float (d);
395 #endif /* 0 (error functions) */
398 /* Root and Log functions. */
400 #ifdef LISP_FLOAT_TYPE
401 DEFUN ("exp", Fexp, 1, 1, 0, /*
402 Return the exponential base e of ARG.
406 double d = extract_float (arg);
407 #ifdef FLOAT_CHECK_DOMAIN
408 if (d > 709.7827) /* Assume IEEE doubles here */
409 range_error ("exp", arg);
411 return make_float (0.0);
414 IN_FLOAT (d = exp (d), "exp", arg);
415 return make_float (d);
417 #endif /* LISP_FLOAT_TYPE */
420 DEFUN ("expt", Fexpt, 2, 2, 0, /*
421 Return the exponential ARG1 ** ARG2.
427 CHECK_INT_OR_FLOAT (arg1);
428 CHECK_INT_OR_FLOAT (arg2);
429 if ((INTP (arg1)) && /* common lisp spec */
430 (INTP (arg2))) /* don't promote, if both are ints */
441 acc = (y & 1) ? -1 : 1;
453 y = (EMACS_UINT) y >> 1;
456 return (make_int (acc));
458 #ifdef LISP_FLOAT_TYPE
459 f1 = (FLOATP (arg1)) ? float_data (XFLOAT (arg1)) : XINT (arg1);
460 f2 = (FLOATP (arg2)) ? float_data (XFLOAT (arg2)) : XINT (arg2);
461 /* Really should check for overflow, too */
462 if (f1 == 0.0 && f2 == 0.0)
464 # ifdef FLOAT_CHECK_DOMAIN
465 else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor(f2)))
466 domain_error2 ("expt", arg1, arg2);
467 # endif /* FLOAT_CHECK_DOMAIN */
468 IN_FLOAT2 (f1 = pow (f1, f2), "expt", arg1, arg2);
469 return make_float (f1);
470 #else /* !LISP_FLOAT_TYPE */
472 #endif /* LISP_FLOAT_TYPE */
475 #ifdef LISP_FLOAT_TYPE
476 DEFUN ("log", Flog, 1, 2, 0, /*
477 Return the natural logarithm of ARG.
478 If second optional argument BASE is given, return log ARG using that base.
482 double d = extract_float (arg);
483 #ifdef FLOAT_CHECK_DOMAIN
485 domain_error2 ("log", arg, base);
488 IN_FLOAT (d = log (d), "log", arg);
491 double b = extract_float (base);
492 #ifdef FLOAT_CHECK_DOMAIN
493 if (b <= 0.0 || b == 1.0)
494 domain_error2 ("log", arg, base);
497 IN_FLOAT2 (d = log10 (d), "log", arg, base);
499 IN_FLOAT2 (d = (log (d) / log (b)), "log", arg, base);
501 return make_float (d);
505 DEFUN ("log10", Flog10, 1, 1, 0, /*
506 Return the logarithm base 10 of ARG.
510 double d = extract_float (arg);
511 #ifdef FLOAT_CHECK_DOMAIN
513 domain_error ("log10", arg);
515 IN_FLOAT (d = log10 (d), "log10", arg);
516 return make_float (d);
520 DEFUN ("sqrt", Fsqrt, 1, 1, 0, /*
521 Return the square root of ARG.
525 double d = extract_float (arg);
526 #ifdef FLOAT_CHECK_DOMAIN
528 domain_error ("sqrt", arg);
530 IN_FLOAT (d = sqrt (d), "sqrt", arg);
531 return make_float (d);
535 DEFUN ("cube-root", Fcube_root, 1, 1, 0, /*
536 Return the cube root of ARG.
540 double d = extract_float (arg);
542 IN_FLOAT (d = cbrt (d), "cube-root", arg);
545 IN_FLOAT (d = pow (d, 1.0/3.0), "cube-root", arg);
547 IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", arg);
549 return make_float (d);
551 #endif /* LISP_FLOAT_TYPE */
554 /* Inverse trig functions. */
555 #ifdef LISP_FLOAT_TYPE
556 /* #if 0 Not clearly worth adding... */
558 DEFUN ("acosh", Facosh, 1, 1, 0, /*
559 Return the inverse hyperbolic cosine of ARG.
563 double d = extract_float (arg);
564 #ifdef FLOAT_CHECK_DOMAIN
566 domain_error ("acosh", arg);
568 #ifdef HAVE_INVERSE_HYPERBOLIC
569 IN_FLOAT (d = acosh (d), "acosh", arg);
571 IN_FLOAT (d = log (d + sqrt (d*d - 1.0)), "acosh", arg);
573 return make_float (d);
576 DEFUN ("asinh", Fasinh, 1, 1, 0, /*
577 Return the inverse hyperbolic sine of ARG.
581 double d = extract_float (arg);
582 #ifdef HAVE_INVERSE_HYPERBOLIC
583 IN_FLOAT (d = asinh (d), "asinh", arg);
585 IN_FLOAT (d = log (d + sqrt (d*d + 1.0)), "asinh", arg);
587 return make_float (d);
590 DEFUN ("atanh", Fatanh, 1, 1, 0, /*
591 Return the inverse hyperbolic tangent of ARG.
595 double d = extract_float (arg);
596 #ifdef FLOAT_CHECK_DOMAIN
597 if (d >= 1.0 || d <= -1.0)
598 domain_error ("atanh", arg);
600 #ifdef HAVE_INVERSE_HYPERBOLIC
601 IN_FLOAT (d = atanh (d), "atanh", arg);
603 IN_FLOAT (d = 0.5 * log ((1.0 + d) / (1.0 - d)), "atanh", arg);
605 return make_float (d);
608 DEFUN ("cosh", Fcosh, 1, 1, 0, /*
609 Return the hyperbolic cosine of ARG.
613 double d = extract_float (arg);
614 #ifdef FLOAT_CHECK_DOMAIN
615 if (d > 710.0 || d < -710.0)
616 range_error ("cosh", arg);
618 IN_FLOAT (d = cosh (d), "cosh", arg);
619 return make_float (d);
622 DEFUN ("sinh", Fsinh, 1, 1, 0, /*
623 Return the hyperbolic sine of ARG.
627 double d = extract_float (arg);
628 #ifdef FLOAT_CHECK_DOMAIN
629 if (d > 710.0 || d < -710.0)
630 range_error ("sinh", arg);
632 IN_FLOAT (d = sinh (d), "sinh", arg);
633 return make_float (d);
636 DEFUN ("tanh", Ftanh, 1, 1, 0, /*
637 Return the hyperbolic tangent of ARG.
641 double d = extract_float (arg);
642 IN_FLOAT (d = tanh (d), "tanh", arg);
643 return make_float (d);
645 #endif /* LISP_FLOAT_TYPE (inverse trig functions) */
647 /* Rounding functions */
649 DEFUN ("abs", Fabs, 1, 1, 0, /*
650 Return the absolute value of ARG.
654 CHECK_INT_OR_FLOAT (arg);
656 #ifdef LISP_FLOAT_TYPE
659 IN_FLOAT (arg = make_float ((double) fabs (float_data (XFLOAT (arg)))),
664 #endif /* LISP_FLOAT_TYPE */
666 return (make_int (- XINT (arg)));
671 #ifdef LISP_FLOAT_TYPE
672 DEFUN ("float", Ffloat, 1, 1, 0, /*
673 Return the floating point number equal to ARG.
677 CHECK_INT_OR_FLOAT (arg);
680 return make_float ((double) XINT (arg));
681 else /* give 'em the same float back */
684 #endif /* LISP_FLOAT_TYPE */
687 #ifdef LISP_FLOAT_TYPE
688 DEFUN ("logb", Flogb, 1, 1, 0, /*
689 Return largest integer <= the base 2 log of the magnitude of ARG.
690 This is the same as the exponent of a float.
694 double f = extract_float (arg);
697 return make_int (- (int)((((EMACS_UINT) 1) << (VALBITS - 1)))); /* most-negative-fixnum */
701 IN_FLOAT (val = make_int ((int) logb (f)), "logb", arg);
708 IN_FLOAT (frexp (f, &exqp), "logb", arg);
709 return (make_int (exqp - 1));
721 for (i = 1, d = 0.5; d * d >= f; i += i)
728 for (i = 1, d = 2.0; d * d <= f; i += i)
733 return (make_int (val));
735 #endif /* ! HAVE_FREXP */
736 #endif /* ! HAVE_LOGB */
738 #endif /* LISP_FLOAT_TYPE */
741 DEFUN ("ceiling", Fceiling, 1, 1, 0, /*
742 Return the smallest integer no less than ARG. (Round toward +inf.)
746 CHECK_INT_OR_FLOAT (arg);
748 #ifdef LISP_FLOAT_TYPE
752 IN_FLOAT ((d = ceil (float_data (XFLOAT (arg)))), "ceiling", arg);
753 return (float_to_int (d, "ceiling", arg, Qunbound));
755 #endif /* LISP_FLOAT_TYPE */
761 DEFUN ("floor", Ffloor, 1, 2, 0, /*
762 Return the largest integer no greater than ARG. (Round towards -inf.)
763 With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR.
767 CHECK_INT_OR_FLOAT (arg);
769 if (! NILP (divisor))
773 CHECK_INT_OR_FLOAT (divisor);
775 #ifdef LISP_FLOAT_TYPE
776 if (FLOATP (arg) || FLOATP (divisor))
780 f1 = ((FLOATP (arg)) ? float_data (XFLOAT (arg)) : XINT (arg));
781 f2 = ((FLOATP (divisor)) ? float_data (XFLOAT (divisor)) : XINT (divisor));
783 Fsignal (Qarith_error, Qnil);
785 IN_FLOAT2 (f1 = floor (f1 / f2), "floor", arg, divisor);
786 return float_to_int (f1, "floor", arg, divisor);
788 #endif /* LISP_FLOAT_TYPE */
794 Fsignal (Qarith_error, Qnil);
796 /* With C's /, the result is implementation-defined if either operand
797 is negative, so use only nonnegative operands. */
799 ? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2))
800 : (i1 < 0 ? -1 - ((-1 - i1) / i2) : i1 / i2));
802 return (make_int (i1));
805 #ifdef LISP_FLOAT_TYPE
809 IN_FLOAT ((d = floor (float_data (XFLOAT (arg)))), "floor", arg);
810 return (float_to_int (d, "floor", arg, Qunbound));
812 #endif /* LISP_FLOAT_TYPE */
817 DEFUN ("round", Fround, 1, 1, 0, /*
818 Return the nearest integer to ARG.
822 CHECK_INT_OR_FLOAT (arg);
824 #ifdef LISP_FLOAT_TYPE
828 /* Screw the prevailing rounding mode. */
829 IN_FLOAT ((d = rint (float_data (XFLOAT (arg)))), "round", arg);
830 return (float_to_int (d, "round", arg, Qunbound));
832 #endif /* LISP_FLOAT_TYPE */
837 DEFUN ("truncate", Ftruncate, 1, 1, 0, /*
838 Truncate a floating point number to an integer.
839 Rounds the value toward zero.
843 CHECK_INT_OR_FLOAT (arg);
845 #ifdef LISP_FLOAT_TYPE
847 return (float_to_int (float_data (XFLOAT (arg)),
848 "truncate", arg, Qunbound));
849 #endif /* LISP_FLOAT_TYPE */
854 /* Float-rounding functions. */
855 #ifdef LISP_FLOAT_TYPE
856 /* #if 1 It's not clear these are worth adding... */
858 DEFUN ("fceiling", Ffceiling, 1, 1, 0, /*
859 Return the smallest integer no less than ARG, as a float.
860 \(Round toward +inf.\)
864 double d = extract_float (arg);
865 IN_FLOAT (d = ceil (d), "fceiling", arg);
866 return make_float (d);
869 DEFUN ("ffloor", Fffloor, 1, 1, 0, /*
870 Return the largest integer no greater than ARG, as a float.
871 \(Round towards -inf.\)
875 double d = extract_float (arg);
876 IN_FLOAT (d = floor (d), "ffloor", arg);
877 return make_float (d);
880 DEFUN ("fround", Ffround, 1, 1, 0, /*
881 Return the nearest integer to ARG, as a float.
885 double d = extract_float (arg);
886 IN_FLOAT (d = rint (d), "fround", arg);
887 return make_float (d);
890 DEFUN ("ftruncate", Fftruncate, 1, 1, 0, /*
891 Truncate a floating point number to an integral float value.
892 Rounds the value toward zero.
896 double d = extract_float (arg);
898 IN_FLOAT (d = floor (d), "ftruncate", arg);
900 IN_FLOAT (d = ceil (d), "ftruncate", arg);
901 return make_float (d);
904 #endif /* LISP_FLOAT_TYPE (float-rounding functions) */
907 #ifdef LISP_FLOAT_TYPE
908 #ifdef FLOAT_CATCH_SIGILL
910 float_error (int signo)
913 fatal_error_signal (signo);
915 EMACS_REESTABLISH_SIGNAL (signo, arith_error);
916 EMACS_UNBLOCK_SIGNAL (signo);
920 /* Was Fsignal(), but it just doesn't make sense for an error
921 occurring inside a signal handler to be restartable, considering
922 that anything could happen when the error is signaled and trapped
923 and considering the asynchronous nature of signal handlers. */
924 signal_error (Qarith_error, list1 (float_error_arg));
927 /* Another idea was to replace the library function `infnan'
928 where SIGILL is signaled. */
930 #endif /* FLOAT_CATCH_SIGILL */
932 /* In C++, it is impossible to determine what type matherr expects
933 without some more configure magic.
934 We shouldn't be using matherr anyways - it's a non-standard SYSVism. */
935 #if defined (HAVE_MATHERR) && !defined(__cplusplus)
937 matherr (struct exception *x)
941 /* Not called from emacs-lisp float routines; do the default thing. */
944 /* if (!strcmp (x->name, "pow")) x->name = "expt"; */
946 args = Fcons (build_string (x->name),
947 Fcons (make_float (x->arg1),
949 ? Fcons (make_float (x->arg2), Qnil)
953 case DOMAIN: Fsignal (Qdomain_error, args); break;
954 case SING: Fsignal (Qsingularity_error, args); break;
955 case OVERFLOW: Fsignal (Qoverflow_error, args); break;
956 case UNDERFLOW: Fsignal (Qunderflow_error, args); break;
957 default: Fsignal (Qarith_error, args); break;
959 return 1; /* don't set errno or print a message */
961 #endif /* HAVE_MATHERR */
962 #endif /* LISP_FLOAT_TYPE */
966 init_floatfns_very_early (void)
968 #ifdef LISP_FLOAT_TYPE
969 # ifdef FLOAT_CATCH_SIGILL
970 signal (SIGILL, float_error);
973 #endif /* LISP_FLOAT_TYPE */
977 syms_of_floatfns (void)
980 /* Trig functions. */
982 #ifdef LISP_FLOAT_TYPE
989 #endif /* LISP_FLOAT_TYPE */
991 /* Bessel functions */
994 DEFSUBR (Fbessel_y0);
995 DEFSUBR (Fbessel_y1);
996 DEFSUBR (Fbessel_yn);
997 DEFSUBR (Fbessel_j0);
998 DEFSUBR (Fbessel_j1);
999 DEFSUBR (Fbessel_jn);
1002 /* Error functions. */
1007 DEFSUBR (Flog_gamma);
1010 /* Root and Log functions. */
1012 #ifdef LISP_FLOAT_TYPE
1014 #endif /* LISP_FLOAT_TYPE */
1016 #ifdef LISP_FLOAT_TYPE
1020 DEFSUBR (Fcube_root);
1021 #endif /* LISP_FLOAT_TYPE */
1023 /* Inverse trig functions. */
1025 #ifdef LISP_FLOAT_TYPE
1032 #endif /* LISP_FLOAT_TYPE */
1034 /* Rounding functions */
1037 #ifdef LISP_FLOAT_TYPE
1040 #endif /* LISP_FLOAT_TYPE */
1044 DEFSUBR (Ftruncate);
1046 /* Float-rounding functions. */
1048 #ifdef LISP_FLOAT_TYPE
1049 DEFSUBR (Ffceiling);
1052 DEFSUBR (Fftruncate);
1053 #endif /* LISP_FLOAT_TYPE */
1057 vars_of_floatfns (void)
1059 #ifdef LISP_FLOAT_TYPE
1060 Fprovide (intern ("lisp-float-type"));