annotate src/floatfns.c @ 1995:4e6a63799f08

[xemacs-hg @ 2004-04-07 03:48:58 by james] Fix various ICC warnings and compilation errors.
author james
date Wed, 07 Apr 2004 03:49:00 +0000
parents 9c872f33ecbe
children fd0cbe945410
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Primitive operations on floating point for XEmacs Lisp interpreter.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 /* Synched up with: FSF 19.30. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 /* ANSI C requires only these float functions:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 Define HAVE_INVERSE_HYPERBOLIC if you have acosh, asinh, and atanh.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 Define HAVE_CBRT if you have cbrt().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 Define HAVE_RINT if you have rint().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 If you don't define these, then the appropriate routines will be simulated.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 Define HAVE_MATHERR if on a system supporting the SysV matherr() callback.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 (This should happen automatically.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 Define FLOAT_CHECK_ERRNO if the float library routines set errno.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 This has no effect if HAVE_MATHERR is defined.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 Define FLOAT_CATCH_SIGILL if the float library routines signal SIGILL.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 (What systems actually do this? Let me know. -jwz)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 Define FLOAT_CHECK_DOMAIN if the float library doesn't handle errors by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 either setting errno, or signalling SIGFPE/SIGILL. Otherwise, domain and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 range checking will happen before calling the float routines. This has
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 no effect if HAVE_MATHERR is defined (since matherr will be called when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 a domain error occurs).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 #include "syssignal.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 #include "sysfloat.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
53 /* The code uses emacs_rint, so that it works to undefine HAVE_RINT
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
54 if `rint' exists but does not work right. */
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
55 #ifdef HAVE_RINT
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
56 #define emacs_rint rint
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
57 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 static double
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
59 emacs_rint (double x)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 double r = floor (x + 0.5);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 double diff = fabs (r - x);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 /* Round to even and correct for any roundoff errors. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 if (diff >= 0.5 && (diff > 0.5 || r != 2.0 * floor (r / 2.0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 r += r < x ? 1.0 : -1.0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 return r;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 /* Nonzero while executing in floating point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 This tells float_error what to do. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 static int in_float;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 /* If an argument is out of range for a mathematical function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 here is the actual argument value to use in the error message. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 static Lisp_Object float_error_arg, float_error_arg2;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
77 static const char *float_error_fn_name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 /* Evaluate the floating point expression D, recording NUM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 as the original argument for error messages.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 D is normally an assignment expression.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 Handle errors which may result in signals or may set errno.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 Note that float_error may be declared to return void, so you can't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 just cast the zero after the colon to (SIGTYPE) to make the types
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 check properly. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 #ifdef FLOAT_CHECK_ERRNO
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 #define IN_FLOAT(d, name, num) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 float_error_arg = num; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 float_error_fn_name = name; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 in_float = 1; errno = 0; (d); in_float = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 if (errno != 0) in_float_error (); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 #define IN_FLOAT2(d, name, num, num2) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 float_error_arg = num; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 float_error_arg2 = num2; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 float_error_fn_name = name; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 in_float = 2; errno = 0; (d); in_float = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 if (errno != 0) in_float_error (); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 #define IN_FLOAT(d, name, num) (in_float = 1, (d), in_float = 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 #define IN_FLOAT2(d, name, num, num2) (in_float = 2, (d), in_float = 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 #define arith_error(op,arg) \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
110 Fsignal (Qarith_error, list2 (build_msg_string (op), arg))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 #define range_error(op,arg) \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
112 Fsignal (Qrange_error, list2 (build_msg_string (op), arg))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 #define range_error2(op,a1,a2) \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
114 Fsignal (Qrange_error, list3 (build_msg_string (op), a1, a2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 #define domain_error(op,arg) \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
116 Fsignal (Qdomain_error, list2 (build_msg_string (op), arg))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 #define domain_error2(op,a1,a2) \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
118 Fsignal (Qdomain_error, list3 (build_msg_string (op), a1, a2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 /* Convert float to Lisp Integer if it fits, else signal a range
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
122 error using the given arguments. If bignums are available, range errors
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
123 are never signaled. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
125 float_to_int (double x, const char *name, Lisp_Object num, Lisp_Object num2)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 {
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
127 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
128 bignum_set_double (scratch_bignum, x);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
129 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
130 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 if (x >= ((EMACS_INT) 1 << (VALBITS-1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 || x <= - ((EMACS_INT) 1 << (VALBITS-1)) - (EMACS_INT) 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 if (!UNBOUNDP (num2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 range_error2 (name, num, num2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 range_error (name, num);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 return (make_int ((EMACS_INT) x));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
140 #endif /* HAVE_BIGNUM */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 in_float_error (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 switch (errno)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 case 0:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 case EDOM:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 if (in_float == 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 domain_error2 (float_error_fn_name, float_error_arg, float_error_arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 domain_error (float_error_fn_name, float_error_arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 case ERANGE:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 range_error (float_error_fn_name, float_error_arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 arith_error (float_error_fn_name, float_error_arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 mark_float (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 float_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 return (extract_float (obj1) == extract_float (obj2));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
179 static Hashcode
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 float_hash (Lisp_Object obj, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 /* mod the value down to 32-bit range */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 /* #### change for 64-bit machines */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 return (unsigned long) fmod (extract_float (obj), 4e9);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1104
diff changeset
187 static const struct memory_description float_description[] = {
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 771
diff changeset
191 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("float", float,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 771
diff changeset
192 1, /*dumpable-flag*/
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 771
diff changeset
193 mark_float, print_float, 0, float_equal,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 771
diff changeset
194 float_hash, float_description,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 771
diff changeset
195 Lisp_Float);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 /* Extract a Lisp number as a `double', or signal an error. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 double
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 extract_float (Lisp_Object num)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 if (FLOATP (num))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 return XFLOAT_DATA (num);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 if (INTP (num))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 return (double) XINT (num);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
208 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
209 if (BIGNUMP (num))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
210 return bignum_to_double (XBIGNUM_DATA (num));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
211 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
212
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
213 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
214 if (RATIOP (num))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
215 return ratio_to_double (XRATIO_DATA (num));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
216 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
217
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
218 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
219 if (BIGFLOATP (num))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
220 return bigfloat_to_double (XBIGFLOAT_DATA (num));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
221 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
222
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 return extract_float (wrong_type_argument (Qnumberp, num));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 /* Trig functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 DEFUN ("acos", Facos, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
229 Return the inverse cosine of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
231 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
233 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 if (d > 1.0 || d < -1.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
236 domain_error ("acos", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
238 IN_FLOAT (d = acos (d), "acos", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 DEFUN ("asin", Fasin, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
243 Return the inverse sine of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
245 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
247 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 if (d > 1.0 || d < -1.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
250 domain_error ("asin", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
252 IN_FLOAT (d = asin (d), "asin", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 DEFUN ("atan", Fatan, 1, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
257 Return the inverse tangent of NUMBER.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
258 If optional second argument NUMBER2 is provided,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
259 return atan2 (NUMBER, NUMBER2).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
261 (number, number2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
263 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
265 if (NILP (number2))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
266 IN_FLOAT (d = atan (d), "atan", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
269 double d2 = extract_float (number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 if (d == 0.0 && d2 == 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
272 domain_error2 ("atan", number, number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
274 IN_FLOAT2 (d = atan2 (d, d2), "atan", number, number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 DEFUN ("cos", Fcos, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
280 Return the cosine of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
282 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
284 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
285 IN_FLOAT (d = cos (d), "cos", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 DEFUN ("sin", Fsin, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
290 Return the sine of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
292 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
294 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
295 IN_FLOAT (d = sin (d), "sin", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 DEFUN ("tan", Ftan, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
300 Return the tangent of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
302 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
304 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 double c = cos (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 if (c == 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
308 domain_error ("tan", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
310 IN_FLOAT (d = (sin (d) / c), "tan", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 /* Bessel functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 #if 0 /* Leave these out unless we find there's a reason for them. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 DEFUN ("bessel-j0", Fbessel_j0, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
318 Return the bessel function j0 of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
320 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
322 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
323 IN_FLOAT (d = j0 (d), "bessel-j0", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 DEFUN ("bessel-j1", Fbessel_j1, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
328 Return the bessel function j1 of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
330 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
332 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
333 IN_FLOAT (d = j1 (d), "bessel-j1", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 DEFUN ("bessel-jn", Fbessel_jn, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
338 Return the order N bessel function output jn of NUMBER.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
339 The first number (the order) is truncated to an integer.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
341 (number1, number2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
343 int i1 = extract_float (number1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
344 double f2 = extract_float (number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
346 IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", number1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 return make_float (f2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 DEFUN ("bessel-y0", Fbessel_y0, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
351 Return the bessel function y0 of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
353 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
355 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
356 IN_FLOAT (d = y0 (d), "bessel-y0", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 DEFUN ("bessel-y1", Fbessel_y1, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
361 Return the bessel function y1 of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
363 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
365 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
366 IN_FLOAT (d = y1 (d), "bessel-y0", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 DEFUN ("bessel-yn", Fbessel_yn, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
371 Return the order N bessel function output yn of NUMBER.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
372 The first number (the order) is truncated to an integer.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
374 (number1, number2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
376 int i1 = extract_float (number1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
377 double f2 = extract_float (number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
379 IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", number1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 return make_float (f2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 #endif /* 0 (bessel functions) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 /* Error functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 #if 0 /* Leave these out unless we see they are worth having. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 DEFUN ("erf", Ferf, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
389 Return the mathematical error function of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
391 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
393 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
394 IN_FLOAT (d = erf (d), "erf", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 DEFUN ("erfc", Ferfc, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
399 Return the complementary error function of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
401 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
403 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
404 IN_FLOAT (d = erfc (d), "erfc", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 DEFUN ("log-gamma", Flog_gamma, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
409 Return the log gamma of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
411 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
413 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
414 IN_FLOAT (d = lgamma (d), "log-gamma", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 #endif /* 0 (error functions) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 /* Root and Log functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 DEFUN ("exp", Fexp, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
424 Return the exponential base e of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
426 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
428 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 if (d > 709.7827) /* Assume IEEE doubles here */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
431 range_error ("exp", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 else if (d < -709.0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 return make_float (0.0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
436 IN_FLOAT (d = exp (d), "exp", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 DEFUN ("expt", Fexpt, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
441 Return the exponential NUMBER1 ** NUMBER2.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
443 (number1, number2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 {
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
445 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
446 if (INTEGERP (number1) && INTP (number2))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
447 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
448 if (INTP (number1))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
449 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
450 bignum_set_long (scratch_bignum2, XREALINT (number1));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
451 bignum_pow (scratch_bignum, scratch_bignum2, XREALINT (number2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
452 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
453 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
454 bignum_pow (scratch_bignum, XBIGNUM_DATA (number1),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
455 XREALINT (number2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
456 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
457 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
458 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
459
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
460 if (INTP (number1) && /* common lisp spec */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
461 INTP (number2)) /* don't promote, if both are ints */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 EMACS_INT retval;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
464 EMACS_INT x = XINT (number1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
465 EMACS_INT y = XINT (number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 if (y < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 if (x == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 retval = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 else if (x == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 retval = (y & 1) ? -1 : 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 retval = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 retval = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 while (y > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 if (y & 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 retval *= x;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 x *= x;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 y = (EMACS_UINT) y >> 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 return make_int (retval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
490 #if defined(HAVE_BIGFLOAT) && defined(bigfloat_pow)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
491 if (BIGFLOATP (number1) && INTEGERP (number2))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
492 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
493 unsigned long exp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
494
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
495 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
496 if (BIGNUMP (number2))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
497 exp = bignum_to_ulong (XBIGNUM_DATA (number2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
498 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
499 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
500 exp = XUINT (number2);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
501 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number1));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
502 bigfloat_pow (scratch_bigfloat, XBIGFLOAT_DATA (number1), exp);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
503 return make_bigfloat_bf (scratch_bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
504 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
505 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
506
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
508 double f1 = extract_float (number1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
509 double f2 = extract_float (number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 /* Really should check for overflow, too */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 if (f1 == 0.0 && f2 == 0.0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 f1 = 1.0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 # ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor(f2)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
515 domain_error2 ("expt", number1, number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 # endif /* FLOAT_CHECK_DOMAIN */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
517 IN_FLOAT2 (f1 = pow (f1, f2), "expt", number1, number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 return make_float (f1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 DEFUN ("log", Flog, 1, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
523 Return the natural logarithm of NUMBER.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
524 If second optional argument BASE is given, return the logarithm of
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
525 NUMBER using that base.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
527 (number, base))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
529 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 if (d <= 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
532 domain_error2 ("log", number, base);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 if (NILP (base))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
535 IN_FLOAT (d = log (d), "log", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 double b = extract_float (base);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 if (b <= 0.0 || b == 1.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
541 domain_error2 ("log", number, base);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 if (b == 10.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
544 IN_FLOAT2 (d = log10 (d), "log", number, base);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
546 IN_FLOAT2 (d = (log (d) / log (b)), "log", number, base);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 DEFUN ("log10", Flog10, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
553 Return the logarithm base 10 of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
555 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
557 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 if (d <= 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
560 domain_error ("log10", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
562 IN_FLOAT (d = log10 (d), "log10", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 DEFUN ("sqrt", Fsqrt, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
568 Return the square root of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
570 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 {
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
572 double d;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
573
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
574 #if defined(HAVE_BIGFLOAT) && defined(bigfloat_sqrt)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
575 if (BIGFLOATP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
576 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
577 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
578 bigfloat_sqrt (scratch_bigfloat, XBIGFLOAT_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
579 return make_bigfloat_bf (scratch_bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
580 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
581 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
582 d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 if (d < 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
585 domain_error ("sqrt", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
587 IN_FLOAT (d = sqrt (d), "sqrt", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 DEFUN ("cube-root", Fcube_root, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
593 Return the cube root of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
595 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
597 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 #ifdef HAVE_CBRT
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
599 IN_FLOAT (d = cbrt (d), "cube-root", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 if (d >= 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
602 IN_FLOAT (d = pow (d, 1.0/3.0), "cube-root", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
604 IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 /* Inverse trig functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 DEFUN ("acosh", Facosh, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
612 Return the inverse hyperbolic cosine of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
614 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
616 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 if (d < 1.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
619 domain_error ("acosh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 #ifdef HAVE_INVERSE_HYPERBOLIC
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
622 IN_FLOAT (d = acosh (d), "acosh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 #else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
624 IN_FLOAT (d = log (d + sqrt (d*d - 1.0)), "acosh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 DEFUN ("asinh", Fasinh, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
630 Return the inverse hyperbolic sine of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
632 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
634 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 #ifdef HAVE_INVERSE_HYPERBOLIC
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
636 IN_FLOAT (d = asinh (d), "asinh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 #else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
638 IN_FLOAT (d = log (d + sqrt (d*d + 1.0)), "asinh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 DEFUN ("atanh", Fatanh, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
644 Return the inverse hyperbolic tangent of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
646 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
648 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 if (d >= 1.0 || d <= -1.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
651 domain_error ("atanh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 #ifdef HAVE_INVERSE_HYPERBOLIC
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
654 IN_FLOAT (d = atanh (d), "atanh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 #else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
656 IN_FLOAT (d = 0.5 * log ((1.0 + d) / (1.0 - d)), "atanh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 DEFUN ("cosh", Fcosh, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
662 Return the hyperbolic cosine of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
664 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
666 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 if (d > 710.0 || d < -710.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
669 range_error ("cosh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
671 IN_FLOAT (d = cosh (d), "cosh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 DEFUN ("sinh", Fsinh, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
676 Return the hyperbolic sine of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
678 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
680 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 if (d > 710.0 || d < -710.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
683 range_error ("sinh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
685 IN_FLOAT (d = sinh (d), "sinh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 DEFUN ("tanh", Ftanh, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
690 Return the hyperbolic tangent of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
692 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
694 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
695 IN_FLOAT (d = tanh (d), "tanh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 /* Rounding functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 DEFUN ("abs", Fabs, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
702 Return the absolute value of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
704 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
706 if (FLOATP (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
708 IN_FLOAT (number = make_float (fabs (XFLOAT_DATA (number))),
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
709 "abs", number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
710 return number;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
713 if (INTP (number))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
714 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
715 /* The most negative Lisp fixnum will overflow */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
716 return (XINT (number) >= 0) ? number : make_integer (- XINT (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
717 #else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
718 return (XINT (number) >= 0) ? number : make_int (- XINT (number));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
719 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
720
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
721 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
722 if (BIGNUMP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
723 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
724 if (bignum_sign (XBIGNUM_DATA (number)) >= 0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
725 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
726 bignum_abs (scratch_bignum, XBIGNUM_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
727 return make_bignum_bg (scratch_bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
728 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
729 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
730
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
731 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
732 if (RATIOP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
733 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
734 if (ratio_sign (XRATIO_DATA (number)) >= 0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
735 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
736 ratio_abs (scratch_ratio, XRATIO_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
737 return make_ratio_rt (scratch_ratio);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
738 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
739 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
740
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
741 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
742 if (BIGFLOATP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
743 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
744 if (bigfloat_sign (XBIGFLOAT_DATA (number)) >= 0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
745 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
746 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
747 bigfloat_abs (scratch_bigfloat, XBIGFLOAT_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
748 return make_bigfloat_bf (scratch_bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
749 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
750 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
752 return Fabs (wrong_type_argument (Qnumberp, number));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 DEFUN ("float", Ffloat, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
756 Return the floating point number numerically equal to NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
758 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
760 if (INTP (number))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
761 return make_float ((double) XINT (number));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
763 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
764 if (BIGFLOATP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
765 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
766 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
767 if (ZEROP (Vdefault_float_precision))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
768 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
769 return make_float (bignum_to_double (XBIGNUM_DATA (number)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
770 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
771 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
772 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
773 bigfloat_set_prec (scratch_bigfloat, bigfloat_get_default_prec ());
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
774 bigfloat_set_bignum (scratch_bigfloat, XBIGNUM_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
775 return make_bigfloat_bf (scratch_bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
776 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
777 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
778 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
779 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
780
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
781 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
782 if (RATIOP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
783 make_float (ratio_to_double (XRATIO_DATA (number)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
784 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
785
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
786 if (FLOATP (number)) /* give 'em the same float back */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
787 return number;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
789 return Ffloat (wrong_type_argument (Qnumberp, number));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 DEFUN ("logb", Flogb, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
793 Return largest integer <= the base 2 log of the magnitude of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 This is the same as the exponent of a float.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
796 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
798 double f = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 if (f == 0.0)
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
801 return make_int (- (EMACS_INT)(((EMACS_UINT) 1) << (VALBITS - 1))); /* most-negative-fixnum */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 #ifdef HAVE_LOGB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 Lisp_Object val;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
805 IN_FLOAT (val = make_int ((EMACS_INT) logb (f)), "logb", number);
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
806 return val;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 #ifdef HAVE_FREXP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 int exqp;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
812 IN_FLOAT (frexp (f, &exqp), "logb", number);
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
813 return make_int (exqp - 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 double d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 EMACS_INT val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 if (f < 0.0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 f = -f;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 val = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 while (f < 0.5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 for (i = 1, d = 0.5; d * d >= f; i += i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 d *= d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 f /= d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 val -= i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 while (f >= 1.0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 for (i = 1, d = 2.0; d * d <= f; i += i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 d *= d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 f /= d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 val += i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 }
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
837 return make_int (val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 #endif /* ! HAVE_FREXP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 #endif /* ! HAVE_LOGB */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 DEFUN ("ceiling", Fceiling, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
844 Return the smallest integer no less than NUMBER. (Round toward +inf.)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
846 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
848 if (FLOATP (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 double d;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
851 IN_FLOAT ((d = ceil (XFLOAT_DATA (number))), "ceiling", number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
852 return (float_to_int (d, "ceiling", number, Qunbound));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
855 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
856 if (INTEGERP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
857 #else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
858 if (INTP (number))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
859 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
860 return number;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
862 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
863 if (RATIOP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
864 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
865 bignum_ceil (scratch_bignum, XRATIO_NUMERATOR (number),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
866 XRATIO_DENOMINATOR (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
867 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
868 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
869 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
870
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
871 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
872 if (BIGFLOATP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
873 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
874 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
875 bigfloat_ceil (scratch_bigfloat, XBIGFLOAT_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
876 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
877 bignum_set_bigfloat (scratch_bignum, scratch_bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
878 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
879 #else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
880 return make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
881 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
882 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
883 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
884
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
885 return Fceiling (wrong_type_argument (Qnumberp, number));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 DEFUN ("floor", Ffloor, 1, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
890 Return the largest integer no greater than NUMBER. (Round towards -inf.)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
891 With optional second argument DIVISOR, return the largest integer no
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
892 greater than NUMBER/DIVISOR.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
894 (number, divisor))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 {
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
896 #ifdef WITH_NUMBER_TYPES
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
897 CHECK_REAL (number);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
898 if (NILP (divisor))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
899 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
900 if (FLOATP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
901 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
902 double d;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
903 IN_FLOAT ((d = floor (XFLOAT_DATA (number))), "floor", number);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
904 return (float_to_int (d, "floor", number, Qunbound));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
905 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
906 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
907 else if (RATIOP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
908 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
909 bignum_floor (scratch_bignum, XRATIO_NUMERATOR (number),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
910 XRATIO_DENOMINATOR (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
911 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
912 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
913 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
914 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
915 else if (BIGFLOATP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
916 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
917 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
918 bigfloat_floor (scratch_bigfloat, XBIGFLOAT_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
919 return make_bigfloat_bf (scratch_bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
920 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
921 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
922 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
923 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
924 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
925 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
926 CHECK_REAL (divisor);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
927 switch (promote_args (&number, &divisor))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
928 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
929 case FIXNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
930 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
931 EMACS_INT i1 = XREALINT (number);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
932 EMACS_INT i2 = XREALINT (divisor);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
933
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
934 if (i2 == 0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
935 Fsignal (Qarith_error, Qnil);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
936
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
937 /* With C's /, the result is implementation-defined if either
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
938 operand is negative, so use only nonnegative operands. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
939 i1 = (i2 < 0
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
940 ? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
941 : (i1 < 0 ? -1 - ((-1 - i1) / i2) : i1 / i2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
942
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
943 return make_int (i1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
944 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
945 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
946 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
947 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
948 Fsignal (Qarith_error, Qnil);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
949 bignum_floor (scratch_bignum, XBIGNUM_DATA (number),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
950 XBIGNUM_DATA (divisor));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
951 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
952 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
953 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
954 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
955 if (ratio_sign (XRATIO_DATA (divisor)) == 0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
956 Fsignal (Qarith_error, Qnil);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
957 ratio_div (scratch_ratio, XRATIO_DATA (number),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
958 XRATIO_DATA (divisor));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
959 bignum_floor (scratch_bignum, ratio_numerator (scratch_ratio),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
960 ratio_denominator (scratch_ratio));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
961 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
962 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
963 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
964 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
965 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
966 Fsignal (Qarith_error, Qnil);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
967 bigfloat_set_prec (scratch_bigfloat,
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
968 max (XBIGFLOAT_GET_PREC (number),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
969 XBIGFLOAT_GET_PREC (divisor)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
970 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (number),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
971 XBIGFLOAT_DATA (divisor));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
972 bigfloat_floor (scratch_bigfloat, scratch_bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
973 return make_bigfloat_bf (scratch_bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
974 #endif
1995
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
975 default: /* FLOAT_T */
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
976 {
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
977 double f1 = extract_float (number);
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
978 double f2 = extract_float (divisor);
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
979
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
980 if (f2 == 0.0)
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
981 Fsignal (Qarith_error, Qnil);
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
982
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
983 IN_FLOAT2 (f1 = floor (f1 / f2), "floor", number, divisor);
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
984 return float_to_int (f1, "floor", number, divisor);
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
985 }
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
986 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
987 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
988 #else /* !WITH_NUMBER_TYPES */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
989 CHECK_INT_OR_FLOAT (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 if (! NILP (divisor))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 EMACS_INT i1, i2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 CHECK_INT_OR_FLOAT (divisor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
997 if (FLOATP (number) || FLOATP (divisor))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
999 double f1 = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 double f2 = extract_float (divisor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 if (f2 == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 Fsignal (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1005 IN_FLOAT2 (f1 = floor (f1 / f2), "floor", number, divisor);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1006 return float_to_int (f1, "floor", number, divisor);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1009 i1 = XINT (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 i2 = XINT (divisor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 if (i2 == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 Fsignal (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 /* With C's /, the result is implementation-defined if either operand
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 is negative, so use only nonnegative operands. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 i1 = (i2 < 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 ? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 : (i1 < 0 ? -1 - ((-1 - i1) / i2) : i1 / i2));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 return (make_int (i1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1024 if (FLOATP (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 double d;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1027 IN_FLOAT ((d = floor (XFLOAT_DATA (number))), "floor", number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1028 return (float_to_int (d, "floor", number, Qunbound));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1031 return number;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1032 #endif /* WITH_NUMBER_TYPES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 DEFUN ("round", Fround, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1036 Return the nearest integer to NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1038 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1040 if (FLOATP (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 double d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 /* Screw the prevailing rounding mode. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1044 IN_FLOAT ((d = emacs_rint (XFLOAT_DATA (number))), "round", number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1045 return (float_to_int (d, "round", number, Qunbound));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1048 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1049 if (INTEGERP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1050 #else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1051 if (INTP (number))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1052 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1053 return number;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1055 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1056 if (RATIOP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1057 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1058 if (bignum_divisible_p (XRATIO_NUMERATOR (number),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1059 XRATIO_DENOMINATOR (number)))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1060 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1061 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1062 XRATIO_DENOMINATOR (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1063 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1064 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1065 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1066 bignum_add (scratch_bignum2, XRATIO_NUMERATOR (number),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1067 XRATIO_DENOMINATOR (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1068 bignum_div (scratch_bignum, scratch_bignum2,
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1069 XRATIO_DENOMINATOR (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1070 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1071 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1072 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1073 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1074
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1075 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1076 if (BIGFLOATP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1077 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1078 unsigned long prec = XBIGFLOAT_GET_PREC (number);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1079 bigfloat_set_prec (scratch_bigfloat, prec);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1080 bigfloat_set_prec (scratch_bigfloat2, prec);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1081 bigfloat_set_double (scratch_bigfloat2,
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1082 bigfloat_sign (XBIGFLOAT_DATA (number)) * 0.5);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1083 bigfloat_floor (scratch_bigfloat, scratch_bigfloat2);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1084 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1085 bignum_set_bigfloat (scratch_bignum, scratch_bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1086 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1087 #else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1088 return make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1089 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1090 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1091 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1092
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1093 return Fround (wrong_type_argument (Qnumberp, number));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 DEFUN ("truncate", Ftruncate, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 Truncate a floating point number to an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 Rounds the value toward zero.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1100 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1102 if (FLOATP (number))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1103 return float_to_int (XFLOAT_DATA (number), "truncate", number, Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1105 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1106 if (INTEGERP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1107 #else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1108 if (INTP (number))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1109 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1110 return number;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1112 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1113 if (RATIOP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1114 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1115 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1116 XRATIO_DENOMINATOR (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1117 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1118 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1119 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1120
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1121 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1122 if (BIGFLOATP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1123 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1124 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1125 bigfloat_trunc (scratch_bigfloat, XBIGFLOAT_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1126 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1127 bignum_set_bigfloat (scratch_bignum, scratch_bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1128 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1129 #else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1130 return make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1131 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1132 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1133 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1204
diff changeset
1134
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1135 return Ftruncate (wrong_type_argument (Qnumberp, number));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 /* Float-rounding functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 DEFUN ("fceiling", Ffceiling, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1141 Return the smallest integer no less than NUMBER, as a float.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 \(Round toward +inf.\)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1144 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1146 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1147 IN_FLOAT (d = ceil (d), "fceiling", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 DEFUN ("ffloor", Fffloor, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1152 Return the largest integer no greater than NUMBER, as a float.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 \(Round towards -inf.\)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1155 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1157 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1158 IN_FLOAT (d = floor (d), "ffloor", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 DEFUN ("fround", Ffround, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1163 Return the nearest integer to NUMBER, as a float.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1165 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1167 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1168 IN_FLOAT (d = emacs_rint (d), "fround", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 DEFUN ("ftruncate", Fftruncate, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 Truncate a floating point number to an integral float value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 Rounds the value toward zero.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1176 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1178 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 if (d >= 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1180 IN_FLOAT (d = floor (d), "ftruncate", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1182 IN_FLOAT (d = ceil (d), "ftruncate", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 #ifdef FLOAT_CATCH_SIGILL
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 static SIGTYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 float_error (int signo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 if (! in_float)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 fatal_error_signal (signo);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 EMACS_REESTABLISH_SIGNAL (signo, arith_error);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 EMACS_UNBLOCK_SIGNAL (signo);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 in_float = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 /* Was Fsignal(), but it just doesn't make sense for an error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 occurring inside a signal handler to be restartable, considering
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 that anything could happen when the error is signaled and trapped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 and considering the asynchronous nature of signal handlers. */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1202 signal_error (Qarith_error, 0, float_error_arg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 /* Another idea was to replace the library function `infnan'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 where SIGILL is signaled. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 #endif /* FLOAT_CATCH_SIGILL */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 /* In C++, it is impossible to determine what type matherr expects
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 without some more configure magic.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 We shouldn't be using matherr anyways - it's a non-standard SYSVism. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 #if defined (HAVE_MATHERR) && !defined(__cplusplus)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 matherr (struct exception *x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 Lisp_Object args;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 if (! in_float)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 /* Not called from emacs-lisp float routines; do the default thing. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 /* if (!strcmp (x->name, "pow")) x->name = "expt"; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 args = Fcons (build_string (x->name),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 Fcons (make_float (x->arg1),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 ((in_float == 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 ? Fcons (make_float (x->arg2), Qnil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 : Qnil)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 switch (x->type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 case DOMAIN: Fsignal (Qdomain_error, args); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 case SING: Fsignal (Qsingularity_error, args); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 case OVERFLOW: Fsignal (Qoverflow_error, args); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 case UNDERFLOW: Fsignal (Qunderflow_error, args); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 default: Fsignal (Qarith_error, args); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 return 1; /* don't set errno or print a message */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 #endif /* HAVE_MATHERR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 init_floatfns_very_early (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 # ifdef FLOAT_CATCH_SIGILL
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 563
diff changeset
1245 EMACS_SIGNAL (SIGILL, float_error);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 # endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 in_float = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 syms_of_floatfns (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1253 INIT_LRECORD_IMPLEMENTATION (float);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 /* Trig functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 DEFSUBR (Facos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 DEFSUBR (Fasin);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 DEFSUBR (Fatan);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 DEFSUBR (Fcos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 DEFSUBR (Fsin);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 DEFSUBR (Ftan);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 /* Bessel functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 DEFSUBR (Fbessel_y0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 DEFSUBR (Fbessel_y1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 DEFSUBR (Fbessel_yn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 DEFSUBR (Fbessel_j0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 DEFSUBR (Fbessel_j1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 DEFSUBR (Fbessel_jn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 /* Error functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 DEFSUBR (Ferf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 DEFSUBR (Ferfc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 DEFSUBR (Flog_gamma);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 /* Root and Log functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 DEFSUBR (Fexp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 DEFSUBR (Fexpt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 DEFSUBR (Flog);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 DEFSUBR (Flog10);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 DEFSUBR (Fsqrt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 DEFSUBR (Fcube_root);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 /* Inverse trig functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 DEFSUBR (Facosh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 DEFSUBR (Fasinh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 DEFSUBR (Fatanh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 DEFSUBR (Fcosh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 DEFSUBR (Fsinh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 DEFSUBR (Ftanh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 /* Rounding functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 DEFSUBR (Fabs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 DEFSUBR (Ffloat);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 DEFSUBR (Flogb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 DEFSUBR (Fceiling);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 DEFSUBR (Ffloor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 DEFSUBR (Fround);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 DEFSUBR (Ftruncate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 /* Float-rounding functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 DEFSUBR (Ffceiling);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 DEFSUBR (Fffloor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 DEFSUBR (Ffround);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 DEFSUBR (Fftruncate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 vars_of_floatfns (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 Fprovide (intern ("lisp-float-type"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 }