Mercurial > emacs
annotate src/floatfns.c @ 1384:416f7f33fe95
* emacs.c (main): Call keys_of_frame.
author | Jim Blandy <jimb@redhat.com> |
---|---|
date | Sun, 11 Oct 1992 06:40:24 +0000 |
parents | 70ed307d9047 |
children | bef6b6903528 |
rev | line source |
---|---|
102 | 1 /* Primitive operations on floating point for GNU Emacs Lisp interpreter. |
621 | 2 Copyright (C) 1988, 1992 Free Software Foundation, Inc. |
102 | 3 |
4 This file is part of GNU Emacs. | |
5 | |
6 GNU Emacs is free software; you can redistribute it and/or modify | |
7 it under the terms of the GNU General Public License as published by | |
621 | 8 the Free Software Foundation; either version 2, or (at your option) |
102 | 9 any later version. |
10 | |
11 GNU Emacs is distributed in the hope that it will be useful, | |
12 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 GNU General Public License for more details. | |
15 | |
16 You should have received a copy of the GNU General Public License | |
17 along with GNU Emacs; see the file COPYING. If not, write to | |
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ | |
19 | |
20 | |
21 #include <signal.h> | |
22 | |
23 #include "config.h" | |
24 #include "lisp.h" | |
638 | 25 #include "syssignal.h" |
102 | 26 |
27 Lisp_Object Qarith_error; | |
28 | |
29 #ifdef LISP_FLOAT_TYPE | |
485 | 30 |
102 | 31 #include <math.h> |
485 | 32 #include <errno.h> |
33 | |
34 extern int errno; | |
35 | |
36 /* Avoid traps on VMS from sinh and cosh. | |
37 All the other functions set errno instead. */ | |
38 | |
39 #ifdef VMS | |
40 #undef cosh | |
41 #undef sinh | |
42 #define cosh(x) ((exp(x)+exp(-x))*0.5) | |
43 #define sinh(x) ((exp(x)-exp(-x))*0.5) | |
44 #endif /* VMS */ | |
45 | |
621 | 46 static SIGTYPE float_error (); |
102 | 47 |
48 /* Nonzero while executing in floating point. | |
49 This tells float_error what to do. */ | |
50 | |
51 static int in_float; | |
52 | |
53 /* If an argument is out of range for a mathematical function, | |
485 | 54 here is the actual argument value to use in the error message. */ |
102 | 55 |
56 static Lisp_Object float_error_arg; | |
57 | |
485 | 58 /* Evaluate the floating point expression D, recording NUM |
59 as the original argument for error messages. | |
60 D is normally an assignment expression. | |
61 Handle errors which may result in signals or may set errno. */ | |
62 | |
63 #define IN_FLOAT(D, NUM) \ | |
621 | 64 (in_float = 1, errno = 0, float_error_arg = NUM, (D), \ |
65 (errno == ERANGE || errno == EDOM ? float_error () : (SIGTYPE) 0), \ | |
485 | 66 in_float = 0) |
102 | 67 |
68 /* Extract a Lisp number as a `double', or signal an error. */ | |
69 | |
70 double | |
71 extract_float (num) | |
72 Lisp_Object num; | |
73 { | |
74 CHECK_NUMBER_OR_FLOAT (num, 0); | |
75 | |
76 if (XTYPE (num) == Lisp_Float) | |
77 return XFLOAT (num)->data; | |
78 return (double) XINT (num); | |
79 } | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
80 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
81 /* Trig functions. */ |
102 | 82 |
83 DEFUN ("acos", Facos, Sacos, 1, 1, 0, | |
84 "Return the inverse cosine of ARG.") | |
85 (num) | |
86 register Lisp_Object num; | |
87 { | |
88 double d = extract_float (num); | |
89 IN_FLOAT (d = acos (d), num); | |
90 return make_float (d); | |
91 } | |
92 | |
93 DEFUN ("asin", Fasin, Sasin, 1, 1, 0, | |
94 "Return the inverse sine of ARG.") | |
95 (num) | |
96 register Lisp_Object num; | |
97 { | |
98 double d = extract_float (num); | |
99 IN_FLOAT (d = asin (d), num); | |
100 return make_float (d); | |
101 } | |
102 | |
103 DEFUN ("atan", Fatan, Satan, 1, 1, 0, | |
104 "Return the inverse tangent of ARG.") | |
105 (num) | |
106 register Lisp_Object num; | |
107 { | |
108 double d = extract_float (num); | |
109 IN_FLOAT (d = atan (d), num); | |
110 return make_float (d); | |
111 } | |
112 | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
113 DEFUN ("cos", Fcos, Scos, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
114 "Return the cosine of ARG.") |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
115 (num) |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
116 register Lisp_Object num; |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
117 { |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
118 double d = extract_float (num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
119 IN_FLOAT (d = cos (d), num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
120 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
121 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
122 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
123 DEFUN ("sin", Fsin, Ssin, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
124 "Return the sine of ARG.") |
102 | 125 (num) |
126 register Lisp_Object num; | |
127 { | |
128 double d = extract_float (num); | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
129 IN_FLOAT (d = sin (d), num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
130 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
131 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
132 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
133 DEFUN ("tan", Ftan, Stan, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
134 "Return the tangent of ARG.") |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
135 (num) |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
136 register Lisp_Object num; |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
137 { |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
138 double d = extract_float (num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
139 IN_FLOAT (d = tan (d), num); |
102 | 140 return make_float (d); |
141 } | |
142 | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
143 #if 0 /* Leave these out unless we find there's a reason for them. */ |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
144 |
102 | 145 DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0, |
146 "Return the bessel function j0 of ARG.") | |
147 (num) | |
148 register Lisp_Object num; | |
149 { | |
150 double d = extract_float (num); | |
151 IN_FLOAT (d = j0 (d), num); | |
152 return make_float (d); | |
153 } | |
154 | |
155 DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0, | |
156 "Return the bessel function j1 of ARG.") | |
157 (num) | |
158 register Lisp_Object num; | |
159 { | |
160 double d = extract_float (num); | |
161 IN_FLOAT (d = j1 (d), num); | |
162 return make_float (d); | |
163 } | |
164 | |
165 DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0, | |
166 "Return the order N bessel function output jn of ARG.\n\ | |
167 The first arg (the order) is truncated to an integer.") | |
168 (num1, num2) | |
169 register Lisp_Object num1, num2; | |
170 { | |
171 int i1 = extract_float (num1); | |
172 double f2 = extract_float (num2); | |
173 | |
174 IN_FLOAT (f2 = jn (i1, f2), num1); | |
175 return make_float (f2); | |
176 } | |
177 | |
178 DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0, | |
179 "Return the bessel function y0 of ARG.") | |
180 (num) | |
181 register Lisp_Object num; | |
182 { | |
183 double d = extract_float (num); | |
184 IN_FLOAT (d = y0 (d), num); | |
185 return make_float (d); | |
186 } | |
187 | |
188 DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0, | |
189 "Return the bessel function y1 of ARG.") | |
190 (num) | |
191 register Lisp_Object num; | |
192 { | |
193 double d = extract_float (num); | |
194 IN_FLOAT (d = y1 (d), num); | |
195 return make_float (d); | |
196 } | |
197 | |
198 DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0, | |
199 "Return the order N bessel function output yn of ARG.\n\ | |
200 The first arg (the order) is truncated to an integer.") | |
201 (num1, num2) | |
202 register Lisp_Object num1, num2; | |
203 { | |
204 int i1 = extract_float (num1); | |
205 double f2 = extract_float (num2); | |
206 | |
207 IN_FLOAT (f2 = yn (i1, f2), num1); | |
208 return make_float (f2); | |
209 } | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
210 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
211 #endif |
102 | 212 |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
213 #if 0 /* Leave these out unless we see they are worth having. */ |
102 | 214 |
215 DEFUN ("erf", Ferf, Serf, 1, 1, 0, | |
216 "Return the mathematical error function of ARG.") | |
217 (num) | |
218 register Lisp_Object num; | |
219 { | |
220 double d = extract_float (num); | |
221 IN_FLOAT (d = erf (d), num); | |
222 return make_float (d); | |
223 } | |
224 | |
225 DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0, | |
226 "Return the complementary error function of ARG.") | |
227 (num) | |
228 register Lisp_Object num; | |
229 { | |
230 double d = extract_float (num); | |
231 IN_FLOAT (d = erfc (d), num); | |
232 return make_float (d); | |
233 } | |
234 | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
235 DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
236 "Return the log gamma of ARG.") |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
237 (num) |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
238 register Lisp_Object num; |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
239 { |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
240 double d = extract_float (num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
241 IN_FLOAT (d = lgamma (d), num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
242 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
243 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
244 |
694 | 245 DEFUN ("cbrt", Fcbrt, Scbrt, 1, 1, 0, |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
246 "Return the cube root of ARG.") |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
247 (num) |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
248 register Lisp_Object num; |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
249 { |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
250 double d = extract_float (num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
251 IN_FLOAT (d = cbrt (d), num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
252 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
253 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
254 |
694 | 255 #endif |
256 | |
102 | 257 DEFUN ("exp", Fexp, Sexp, 1, 1, 0, |
258 "Return the exponential base e of ARG.") | |
259 (num) | |
260 register Lisp_Object num; | |
261 { | |
262 double d = extract_float (num); | |
263 IN_FLOAT (d = exp (d), num); | |
264 return make_float (d); | |
265 } | |
266 | |
267 DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
268 "Return the exponential X ** Y.") |
102 | 269 (num1, num2) |
270 register Lisp_Object num1, num2; | |
271 { | |
272 double f1, f2; | |
273 | |
274 CHECK_NUMBER_OR_FLOAT (num1, 0); | |
275 CHECK_NUMBER_OR_FLOAT (num2, 0); | |
276 if ((XTYPE (num1) == Lisp_Int) && /* common lisp spec */ | |
277 (XTYPE (num2) == Lisp_Int)) /* don't promote, if both are ints */ | |
278 { /* this can be improved by pre-calculating */ | |
279 int acc, x, y; /* some binary powers of x then acumulating */ | |
280 /* these, therby saving some time. -wsr */ | |
281 x = XINT (num1); | |
282 y = XINT (num2); | |
283 acc = 1; | |
284 | |
285 if (y < 0) | |
286 { | |
287 for (; y < 0; y++) | |
288 acc /= x; | |
289 } | |
290 else | |
291 { | |
292 for (; y > 0; y--) | |
293 acc *= x; | |
294 } | |
295 return XSET (x, Lisp_Int, acc); | |
296 } | |
297 f1 = (XTYPE (num1) == Lisp_Float) ? XFLOAT (num1)->data : XINT (num1); | |
298 f2 = (XTYPE (num2) == Lisp_Float) ? XFLOAT (num2)->data : XINT (num2); | |
299 IN_FLOAT (f1 = pow (f1, f2), num1); | |
300 return make_float (f1); | |
301 } | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
302 |
1005
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
303 DEFUN ("log", Flog, Slog, 1, 2, 0, |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
304 "Return the natural logarithm of NUM. |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
305 If second optional argument BASE is given, return log NUM using that base.") |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
306 (num, base) |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
307 register Lisp_Object num; |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
308 { |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
309 double d = extract_float (num); |
1005
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
310 |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
311 if (NILP (base)) |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
312 IN_FLOAT (d = log (d), num); |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
313 else |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
314 { |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
315 double b = extract_float (base); |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
316 |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
317 IN_FLOAT (d = log (num) / log (b), num); |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
318 } |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
319 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
320 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
321 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
322 DEFUN ("log10", Flog10, Slog10, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
323 "Return the logarithm base 10 of ARG.") |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
324 (num) |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
325 register Lisp_Object num; |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
326 { |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
327 double d = extract_float (num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
328 IN_FLOAT (d = log10 (d), num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
329 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
330 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
331 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
332 DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
333 "Return the square root of ARG.") |
102 | 334 (num) |
335 register Lisp_Object num; | |
336 { | |
337 double d = extract_float (num); | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
338 IN_FLOAT (d = sqrt (d), num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
339 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
340 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
341 |
694 | 342 #if 0 /* Not clearly worth adding. */ |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
343 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
344 DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
345 "Return the inverse hyperbolic cosine of ARG.") |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
346 (num) |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
347 register Lisp_Object num; |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
348 { |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
349 double d = extract_float (num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
350 IN_FLOAT (d = acosh (d), num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
351 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
352 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
353 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
354 DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
355 "Return the inverse hyperbolic sine of ARG.") |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
356 (num) |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
357 register Lisp_Object num; |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
358 { |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
359 double d = extract_float (num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
360 IN_FLOAT (d = asinh (d), num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
361 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
362 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
363 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
364 DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
365 "Return the inverse hyperbolic tangent of ARG.") |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
366 (num) |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
367 register Lisp_Object num; |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
368 { |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
369 double d = extract_float (num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
370 IN_FLOAT (d = atanh (d), num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
371 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
372 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
373 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
374 DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
375 "Return the hyperbolic cosine of ARG.") |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
376 (num) |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
377 register Lisp_Object num; |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
378 { |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
379 double d = extract_float (num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
380 IN_FLOAT (d = cosh (d), num); |
102 | 381 return make_float (d); |
382 } | |
383 | |
384 DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0, | |
385 "Return the hyperbolic sine of ARG.") | |
386 (num) | |
387 register Lisp_Object num; | |
388 { | |
389 double d = extract_float (num); | |
390 IN_FLOAT (d = sinh (d), num); | |
391 return make_float (d); | |
392 } | |
393 | |
394 DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0, | |
395 "Return the hyperbolic tangent of ARG.") | |
396 (num) | |
397 register Lisp_Object num; | |
398 { | |
399 double d = extract_float (num); | |
400 IN_FLOAT (d = tanh (d), num); | |
401 return make_float (d); | |
402 } | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
403 #endif |
102 | 404 |
405 DEFUN ("abs", Fabs, Sabs, 1, 1, 0, | |
406 "Return the absolute value of ARG.") | |
407 (num) | |
408 register Lisp_Object num; | |
409 { | |
410 CHECK_NUMBER_OR_FLOAT (num, 0); | |
411 | |
412 if (XTYPE (num) == Lisp_Float) | |
413 IN_FLOAT (num = make_float (fabs (XFLOAT (num)->data)), num); | |
414 else if (XINT (num) < 0) | |
415 XSETINT (num, - XFASTINT (num)); | |
416 | |
417 return num; | |
418 } | |
419 | |
420 DEFUN ("float", Ffloat, Sfloat, 1, 1, 0, | |
421 "Return the floating point number equal to ARG.") | |
422 (num) | |
423 register Lisp_Object num; | |
424 { | |
425 CHECK_NUMBER_OR_FLOAT (num, 0); | |
426 | |
427 if (XTYPE (num) == Lisp_Int) | |
428 return make_float ((double) XINT (num)); | |
429 else /* give 'em the same float back */ | |
430 return num; | |
431 } | |
432 | |
433 DEFUN ("logb", Flogb, Slogb, 1, 1, 0, | |
434 "Returns the integer that is the base 2 log of ARG.\n\ | |
435 This is the same as the exponent of a float.") | |
436 (num) | |
437 Lisp_Object num; | |
438 { | |
1005
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
439 #ifdef USG |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
440 /* System V apparently doesn't have a `logb' function. */ |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
441 return Flog (num, make_number (2)); |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
442 #else |
102 | 443 Lisp_Object val; |
1005
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
444 double f = extract_float (num); |
102 | 445 |
446 IN_FLOAT (val = logb (f), num); | |
447 XSET (val, Lisp_Int, val); | |
448 return val; | |
1005
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
449 #endif |
102 | 450 } |
451 | |
452 /* the rounding functions */ | |
453 | |
454 DEFUN ("ceiling", Fceiling, Sceiling, 1, 1, 0, | |
455 "Return the smallest integer no less than ARG. (Round toward +inf.)") | |
456 (num) | |
457 register Lisp_Object num; | |
458 { | |
459 CHECK_NUMBER_OR_FLOAT (num, 0); | |
460 | |
461 if (XTYPE (num) == Lisp_Float) | |
462 IN_FLOAT (XSET (num, Lisp_Int, ceil (XFLOAT (num)->data)), num); | |
463 | |
464 return num; | |
465 } | |
466 | |
467 DEFUN ("floor", Ffloor, Sfloor, 1, 1, 0, | |
468 "Return the largest integer no greater than ARG. (Round towards -inf.)") | |
469 (num) | |
470 register Lisp_Object num; | |
471 { | |
472 CHECK_NUMBER_OR_FLOAT (num, 0); | |
473 | |
474 if (XTYPE (num) == Lisp_Float) | |
475 IN_FLOAT (XSET (num, Lisp_Int, floor (XFLOAT (num)->data)), num); | |
476 | |
477 return num; | |
478 } | |
479 | |
480 DEFUN ("round", Fround, Sround, 1, 1, 0, | |
481 "Return the nearest integer to ARG.") | |
482 (num) | |
483 register Lisp_Object num; | |
484 { | |
485 CHECK_NUMBER_OR_FLOAT (num, 0); | |
486 | |
487 if (XTYPE (num) == Lisp_Float) | |
1005
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
488 { |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
489 #ifdef USG |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
490 /* Screw the prevailing rounding mode. */ |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
491 IN_FLOAT (XSET (num, Lisp_Int, floor (XFLOAT (num)->data + 0.5)), num); |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
492 #else |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
493 IN_FLOAT (XSET (num, Lisp_Int, rint (XFLOAT (num)->data)), num); |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
494 #endif |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
495 } |
102 | 496 |
497 return num; | |
498 } | |
499 | |
500 DEFUN ("truncate", Ftruncate, Struncate, 1, 1, 0, | |
501 "Truncate a floating point number to an int.\n\ | |
502 Rounds the value toward zero.") | |
503 (num) | |
504 register Lisp_Object num; | |
505 { | |
506 CHECK_NUMBER_OR_FLOAT (num, 0); | |
507 | |
508 if (XTYPE (num) == Lisp_Float) | |
509 XSET (num, Lisp_Int, (int) XFLOAT (num)->data); | |
510 | |
511 return num; | |
512 } | |
513 | |
621 | 514 static SIGTYPE |
102 | 515 float_error (signo) |
516 int signo; | |
517 { | |
518 if (! in_float) | |
519 fatal_error_signal (signo); | |
520 | |
485 | 521 #ifdef BSD |
102 | 522 #ifdef BSD4_1 |
523 sigrelse (SIGILL); | |
524 #else /* not BSD4_1 */ | |
638 | 525 sigsetmask (SIGEMPTYMASK); |
102 | 526 #endif /* not BSD4_1 */ |
485 | 527 #else |
528 /* Must reestablish handler each time it is called. */ | |
529 signal (SIGILL, float_error); | |
530 #endif /* BSD */ | |
102 | 531 |
532 in_float = 0; | |
533 | |
534 Fsignal (Qarith_error, Fcons (float_error_arg, Qnil)); | |
535 } | |
536 | |
537 init_floatfns () | |
538 { | |
539 signal (SIGILL, float_error); | |
540 in_float = 0; | |
541 } | |
542 | |
543 syms_of_floatfns () | |
544 { | |
545 defsubr (&Sacos); | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
546 defsubr (&Sasin); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
547 defsubr (&Satan); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
548 defsubr (&Scos); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
549 defsubr (&Ssin); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
550 defsubr (&Stan); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
551 #if 0 |
102 | 552 defsubr (&Sacosh); |
553 defsubr (&Sasinh); | |
554 defsubr (&Satanh); | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
555 defsubr (&Scosh); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
556 defsubr (&Ssinh); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
557 defsubr (&Stanh); |
102 | 558 defsubr (&Sbessel_y0); |
559 defsubr (&Sbessel_y1); | |
560 defsubr (&Sbessel_yn); | |
561 defsubr (&Sbessel_j0); | |
562 defsubr (&Sbessel_j1); | |
563 defsubr (&Sbessel_jn); | |
564 defsubr (&Serf); | |
565 defsubr (&Serfc); | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
566 defsubr (&Slog_gamma); |
694 | 567 defsubr (&Scbrt); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
568 #endif |
102 | 569 defsubr (&Sexp); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
570 defsubr (&Sexpt); |
102 | 571 defsubr (&Slog); |
572 defsubr (&Slog10); | |
573 defsubr (&Ssqrt); | |
574 | |
575 defsubr (&Sabs); | |
576 defsubr (&Sfloat); | |
577 defsubr (&Slogb); | |
578 defsubr (&Sceiling); | |
579 defsubr (&Sfloor); | |
580 defsubr (&Sround); | |
581 defsubr (&Struncate); | |
582 } | |
583 | |
584 #else /* not LISP_FLOAT_TYPE */ | |
585 | |
586 init_floatfns () | |
587 {} | |
588 | |
589 syms_of_floatfns () | |
590 {} | |
591 | |
592 #endif /* not LISP_FLOAT_TYPE */ |