Mercurial > emacs
annotate src/floatfns.c @ 1678:62ecf0c5b54c
Give subprocess creation a way to find a valid current directory
for subprocesses when the buffer's default-directory is a handled
name.
* fileio.c (Funhandled_file_name_directory): New function.
(Qunhandled_file_name_directory): New file-name-handler operation.
(syms_of_fileio): Defsubr Sunhandled_file_name_directory, and
initialize and staticpro Qunhandled_file_name_directory.
* callproc.c (Fcall_process): Call Funhandled_file_name_directory
on the buffer's default directory. Do it earlier in the function
so there's less to GCPRO.
* process.c (create_process): Don't check the validity of the
buffer's default directory here...
(Fstart_process): Instead, do it here; if we call
Funhandled_file_name_directory here, there's less GCPROing to do.
* callproc.c (Fcall_process_region): Return the value returned by
Fcall_process.
author | Jim Blandy <jimb@redhat.com> |
---|---|
date | Sat, 12 Dec 1992 15:31:32 +0000 |
parents | bef6b6903528 |
children | cd23f7ef1bd0 |
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 } | |
1512
bef6b6903528
* floatfns.c (Flog): Don't forget to declare the BASE argument a
Jim Blandy <jimb@redhat.com>
parents:
1005
diff
changeset
|
295 XFASTINT (x) = acc; |
bef6b6903528
* floatfns.c (Flog): Don't forget to declare the BASE argument a
Jim Blandy <jimb@redhat.com>
parents:
1005
diff
changeset
|
296 return x; |
102 | 297 } |
298 f1 = (XTYPE (num1) == Lisp_Float) ? XFLOAT (num1)->data : XINT (num1); | |
299 f2 = (XTYPE (num2) == Lisp_Float) ? XFLOAT (num2)->data : XINT (num2); | |
300 IN_FLOAT (f1 = pow (f1, f2), num1); | |
301 return make_float (f1); | |
302 } | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
303 |
1005
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
304 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
|
305 "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
|
306 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
|
307 (num, base) |
1512
bef6b6903528
* floatfns.c (Flog): Don't forget to declare the BASE argument a
Jim Blandy <jimb@redhat.com>
parents:
1005
diff
changeset
|
308 register Lisp_Object num, base; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
309 { |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
310 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
|
311 |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
312 if (NILP (base)) |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
313 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
|
314 else |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
315 { |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
316 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
|
317 |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
318 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
|
319 } |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
320 return make_float (d); |
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 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
323 DEFUN ("log10", Flog10, Slog10, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
324 "Return the logarithm base 10 of ARG.") |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
325 (num) |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
326 register Lisp_Object num; |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
327 { |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
328 double d = extract_float (num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
329 IN_FLOAT (d = log10 (d), num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
330 return make_float (d); |
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 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
333 DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
334 "Return the square root of ARG.") |
102 | 335 (num) |
336 register Lisp_Object num; | |
337 { | |
338 double d = extract_float (num); | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
339 IN_FLOAT (d = sqrt (d), num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
340 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
341 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
342 |
694 | 343 #if 0 /* Not clearly worth adding. */ |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
344 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
345 DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
346 "Return the inverse hyperbolic cosine of ARG.") |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
347 (num) |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
348 register Lisp_Object num; |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
349 { |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
350 double d = extract_float (num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
351 IN_FLOAT (d = acosh (d), num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
352 return make_float (d); |
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 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
355 DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
356 "Return the inverse hyperbolic sine of ARG.") |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
357 (num) |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
358 register Lisp_Object num; |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
359 { |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
360 double d = extract_float (num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
361 IN_FLOAT (d = asinh (d), num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
362 return make_float (d); |
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 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
365 DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
366 "Return the inverse hyperbolic tangent of ARG.") |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
367 (num) |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
368 register Lisp_Object num; |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
369 { |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
370 double d = extract_float (num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
371 IN_FLOAT (d = atanh (d), num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
372 return make_float (d); |
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 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
375 DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
376 "Return the hyperbolic cosine of ARG.") |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
377 (num) |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
378 register Lisp_Object num; |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
379 { |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
380 double d = extract_float (num); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
381 IN_FLOAT (d = cosh (d), num); |
102 | 382 return make_float (d); |
383 } | |
384 | |
385 DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0, | |
386 "Return the hyperbolic sine of ARG.") | |
387 (num) | |
388 register Lisp_Object num; | |
389 { | |
390 double d = extract_float (num); | |
391 IN_FLOAT (d = sinh (d), num); | |
392 return make_float (d); | |
393 } | |
394 | |
395 DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0, | |
396 "Return the hyperbolic tangent of ARG.") | |
397 (num) | |
398 register Lisp_Object num; | |
399 { | |
400 double d = extract_float (num); | |
401 IN_FLOAT (d = tanh (d), num); | |
402 return make_float (d); | |
403 } | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
404 #endif |
102 | 405 |
406 DEFUN ("abs", Fabs, Sabs, 1, 1, 0, | |
407 "Return the absolute value of ARG.") | |
408 (num) | |
409 register Lisp_Object num; | |
410 { | |
411 CHECK_NUMBER_OR_FLOAT (num, 0); | |
412 | |
413 if (XTYPE (num) == Lisp_Float) | |
414 IN_FLOAT (num = make_float (fabs (XFLOAT (num)->data)), num); | |
415 else if (XINT (num) < 0) | |
416 XSETINT (num, - XFASTINT (num)); | |
417 | |
418 return num; | |
419 } | |
420 | |
421 DEFUN ("float", Ffloat, Sfloat, 1, 1, 0, | |
422 "Return the floating point number equal to ARG.") | |
423 (num) | |
424 register Lisp_Object num; | |
425 { | |
426 CHECK_NUMBER_OR_FLOAT (num, 0); | |
427 | |
428 if (XTYPE (num) == Lisp_Int) | |
429 return make_float ((double) XINT (num)); | |
430 else /* give 'em the same float back */ | |
431 return num; | |
432 } | |
433 | |
434 DEFUN ("logb", Flogb, Slogb, 1, 1, 0, | |
435 "Returns the integer that is the base 2 log of ARG.\n\ | |
436 This is the same as the exponent of a float.") | |
437 (num) | |
438 Lisp_Object num; | |
439 { | |
1005
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
440 #ifdef USG |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
441 /* 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
|
442 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
|
443 #else |
102 | 444 Lisp_Object val; |
1005
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
445 double f = extract_float (num); |
102 | 446 |
447 IN_FLOAT (val = logb (f), num); | |
448 XSET (val, Lisp_Int, val); | |
449 return val; | |
1005
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
450 #endif |
102 | 451 } |
452 | |
453 /* the rounding functions */ | |
454 | |
455 DEFUN ("ceiling", Fceiling, Sceiling, 1, 1, 0, | |
456 "Return the smallest integer no less than ARG. (Round toward +inf.)") | |
457 (num) | |
458 register Lisp_Object num; | |
459 { | |
460 CHECK_NUMBER_OR_FLOAT (num, 0); | |
461 | |
462 if (XTYPE (num) == Lisp_Float) | |
463 IN_FLOAT (XSET (num, Lisp_Int, ceil (XFLOAT (num)->data)), num); | |
464 | |
465 return num; | |
466 } | |
467 | |
468 DEFUN ("floor", Ffloor, Sfloor, 1, 1, 0, | |
469 "Return the largest integer no greater than ARG. (Round towards -inf.)") | |
470 (num) | |
471 register Lisp_Object num; | |
472 { | |
473 CHECK_NUMBER_OR_FLOAT (num, 0); | |
474 | |
475 if (XTYPE (num) == Lisp_Float) | |
476 IN_FLOAT (XSET (num, Lisp_Int, floor (XFLOAT (num)->data)), num); | |
477 | |
478 return num; | |
479 } | |
480 | |
481 DEFUN ("round", Fround, Sround, 1, 1, 0, | |
482 "Return the nearest integer to ARG.") | |
483 (num) | |
484 register Lisp_Object num; | |
485 { | |
486 CHECK_NUMBER_OR_FLOAT (num, 0); | |
487 | |
488 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
|
489 { |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
490 #ifdef USG |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
491 /* 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
|
492 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
|
493 #else |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
494 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
|
495 #endif |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
496 } |
102 | 497 |
498 return num; | |
499 } | |
500 | |
501 DEFUN ("truncate", Ftruncate, Struncate, 1, 1, 0, | |
502 "Truncate a floating point number to an int.\n\ | |
503 Rounds the value toward zero.") | |
504 (num) | |
505 register Lisp_Object num; | |
506 { | |
507 CHECK_NUMBER_OR_FLOAT (num, 0); | |
508 | |
509 if (XTYPE (num) == Lisp_Float) | |
510 XSET (num, Lisp_Int, (int) XFLOAT (num)->data); | |
511 | |
512 return num; | |
513 } | |
514 | |
621 | 515 static SIGTYPE |
102 | 516 float_error (signo) |
517 int signo; | |
518 { | |
519 if (! in_float) | |
520 fatal_error_signal (signo); | |
521 | |
485 | 522 #ifdef BSD |
102 | 523 #ifdef BSD4_1 |
524 sigrelse (SIGILL); | |
525 #else /* not BSD4_1 */ | |
638 | 526 sigsetmask (SIGEMPTYMASK); |
102 | 527 #endif /* not BSD4_1 */ |
485 | 528 #else |
529 /* Must reestablish handler each time it is called. */ | |
530 signal (SIGILL, float_error); | |
531 #endif /* BSD */ | |
102 | 532 |
533 in_float = 0; | |
534 | |
535 Fsignal (Qarith_error, Fcons (float_error_arg, Qnil)); | |
536 } | |
537 | |
538 init_floatfns () | |
539 { | |
540 signal (SIGILL, float_error); | |
541 in_float = 0; | |
542 } | |
543 | |
544 syms_of_floatfns () | |
545 { | |
546 defsubr (&Sacos); | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
547 defsubr (&Sasin); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
548 defsubr (&Satan); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
549 defsubr (&Scos); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
550 defsubr (&Ssin); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
551 defsubr (&Stan); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
552 #if 0 |
102 | 553 defsubr (&Sacosh); |
554 defsubr (&Sasinh); | |
555 defsubr (&Satanh); | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
556 defsubr (&Scosh); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
557 defsubr (&Ssinh); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
558 defsubr (&Stanh); |
102 | 559 defsubr (&Sbessel_y0); |
560 defsubr (&Sbessel_y1); | |
561 defsubr (&Sbessel_yn); | |
562 defsubr (&Sbessel_j0); | |
563 defsubr (&Sbessel_j1); | |
564 defsubr (&Sbessel_jn); | |
565 defsubr (&Serf); | |
566 defsubr (&Serfc); | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
567 defsubr (&Slog_gamma); |
694 | 568 defsubr (&Scbrt); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
569 #endif |
102 | 570 defsubr (&Sexp); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
571 defsubr (&Sexpt); |
102 | 572 defsubr (&Slog); |
573 defsubr (&Slog10); | |
574 defsubr (&Ssqrt); | |
575 | |
576 defsubr (&Sabs); | |
577 defsubr (&Sfloat); | |
578 defsubr (&Slogb); | |
579 defsubr (&Sceiling); | |
580 defsubr (&Sfloor); | |
581 defsubr (&Sround); | |
582 defsubr (&Struncate); | |
583 } | |
584 | |
585 #else /* not LISP_FLOAT_TYPE */ | |
586 | |
587 init_floatfns () | |
588 {} | |
589 | |
590 syms_of_floatfns () | |
591 {} | |
592 | |
593 #endif /* not LISP_FLOAT_TYPE */ |