1 /* Primitive operations on floating point for GNU Emacs Lisp interpreter.
2 Copyright (C) 1988 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
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
8 the Free Software Foundation; either version 1, or (at your option)
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.
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. */
26 Lisp_Object Qarith_error
;
28 #ifdef LISP_FLOAT_TYPE
31 /* Nonzero while executing in floating point.
32 This tells float_error what to do. */
36 /* If an argument is out of range for a mathematical function,
37 that is detected with a signal. Here is the actual argument
38 value to use in the error message. */
40 static Lisp_Object float_error_arg
;
42 #define IN_FLOAT(d, num) \
43 (in_float = 1, float_error_arg = num, (d), in_float = 0)
45 /* Extract a Lisp number as a `double', or signal an error. */
51 CHECK_NUMBER_OR_FLOAT (num
, 0);
53 if (XTYPE (num
) == Lisp_Float
)
54 return XFLOAT (num
)->data
;
55 return (double) XINT (num
);
58 DEFUN ("acos", Facos
, Sacos
, 1, 1, 0,
59 "Return the inverse cosine of ARG.")
61 register Lisp_Object num
;
63 double d
= extract_float (num
);
64 IN_FLOAT (d
= acos (d
), num
);
65 return make_float (d
);
68 DEFUN ("acosh", Facosh
, Sacosh
, 1, 1, 0,
69 "Return the inverse hyperbolic cosine of ARG.")
71 register Lisp_Object num
;
73 double d
= extract_float (num
);
74 IN_FLOAT (d
= acosh (d
), num
);
75 return make_float (d
);
78 DEFUN ("asin", Fasin
, Sasin
, 1, 1, 0,
79 "Return the inverse sine of ARG.")
81 register Lisp_Object num
;
83 double d
= extract_float (num
);
84 IN_FLOAT (d
= asin (d
), num
);
85 return make_float (d
);
88 DEFUN ("asinh", Fasinh
, Sasinh
, 1, 1, 0,
89 "Return the inverse hyperbolic sine of ARG.")
91 register Lisp_Object num
;
93 double d
= extract_float (num
);
94 IN_FLOAT (d
= asinh (d
), num
);
95 return make_float (d
);
98 DEFUN ("atan", Fatan
, Satan
, 1, 1, 0,
99 "Return the inverse tangent of ARG.")
101 register Lisp_Object num
;
103 double d
= extract_float (num
);
104 IN_FLOAT (d
= atan (d
), num
);
105 return make_float (d
);
108 DEFUN ("atanh", Fatanh
, Satanh
, 1, 1, 0,
109 "Return the inverse hyperbolic tangent of ARG.")
111 register Lisp_Object num
;
113 double d
= extract_float (num
);
114 IN_FLOAT (d
= atanh (d
), num
);
115 return make_float (d
);
118 DEFUN ("bessel-j0", Fbessel_j0
, Sbessel_j0
, 1, 1, 0,
119 "Return the bessel function j0 of ARG.")
121 register Lisp_Object num
;
123 double d
= extract_float (num
);
124 IN_FLOAT (d
= j0 (d
), num
);
125 return make_float (d
);
128 DEFUN ("bessel-j1", Fbessel_j1
, Sbessel_j1
, 1, 1, 0,
129 "Return the bessel function j1 of ARG.")
131 register Lisp_Object num
;
133 double d
= extract_float (num
);
134 IN_FLOAT (d
= j1 (d
), num
);
135 return make_float (d
);
138 DEFUN ("bessel-jn", Fbessel_jn
, Sbessel_jn
, 2, 2, 0,
139 "Return the order N bessel function output jn of ARG.\n\
140 The first arg (the order) is truncated to an integer.")
142 register Lisp_Object num1
, num2
;
144 int i1
= extract_float (num1
);
145 double f2
= extract_float (num2
);
147 IN_FLOAT (f2
= jn (i1
, f2
), num1
);
148 return make_float (f2
);
151 DEFUN ("bessel-y0", Fbessel_y0
, Sbessel_y0
, 1, 1, 0,
152 "Return the bessel function y0 of ARG.")
154 register Lisp_Object num
;
156 double d
= extract_float (num
);
157 IN_FLOAT (d
= y0 (d
), num
);
158 return make_float (d
);
161 DEFUN ("bessel-y1", Fbessel_y1
, Sbessel_y1
, 1, 1, 0,
162 "Return the bessel function y1 of ARG.")
164 register Lisp_Object num
;
166 double d
= extract_float (num
);
167 IN_FLOAT (d
= y1 (d
), num
);
168 return make_float (d
);
171 DEFUN ("bessel-yn", Fbessel_yn
, Sbessel_yn
, 2, 2, 0,
172 "Return the order N bessel function output yn of ARG.\n\
173 The first arg (the order) is truncated to an integer.")
175 register Lisp_Object num1
, num2
;
177 int i1
= extract_float (num1
);
178 double f2
= extract_float (num2
);
180 IN_FLOAT (f2
= yn (i1
, f2
), num1
);
181 return make_float (f2
);
184 DEFUN ("cube-root", Fcube_root
, Scube_root
, 1, 1, 0,
185 "Return the cube root of ARG.")
187 register Lisp_Object num
;
189 double d
= extract_float (num
);
190 IN_FLOAT (d
= cbrt (d
), num
);
191 return make_float (d
);
194 DEFUN ("cos", Fcos
, Scos
, 1, 1, 0,
195 "Return the cosine of ARG.")
197 register Lisp_Object num
;
199 double d
= extract_float (num
);
200 IN_FLOAT (d
= cos (d
), num
);
201 return make_float (d
);
204 DEFUN ("cosh", Fcosh
, Scosh
, 1, 1, 0,
205 "Return the hyperbolic cosine of ARG.")
207 register Lisp_Object num
;
209 double d
= extract_float (num
);
210 IN_FLOAT (d
= cosh (d
), num
);
211 return make_float (d
);
214 DEFUN ("erf", Ferf
, Serf
, 1, 1, 0,
215 "Return the mathematical error function of ARG.")
217 register Lisp_Object num
;
219 double d
= extract_float (num
);
220 IN_FLOAT (d
= erf (d
), num
);
221 return make_float (d
);
224 DEFUN ("erfc", Ferfc
, Serfc
, 1, 1, 0,
225 "Return the complementary error function of ARG.")
227 register Lisp_Object num
;
229 double d
= extract_float (num
);
230 IN_FLOAT (d
= erfc (d
), num
);
231 return make_float (d
);
234 DEFUN ("exp", Fexp
, Sexp
, 1, 1, 0,
235 "Return the exponential base e of ARG.")
237 register Lisp_Object num
;
239 double d
= extract_float (num
);
240 IN_FLOAT (d
= exp (d
), num
);
241 return make_float (d
);
244 DEFUN ("expm1", Fexpm1
, Sexpm1
, 1, 1, 0,
245 "Return the exp (x)-1 of ARG.")
247 register Lisp_Object num
;
249 double d
= extract_float (num
);
250 IN_FLOAT (d
= expm1 (d
), num
);
251 return make_float (d
);
254 DEFUN ("log-gamma", Flog_gamma
, Slog_gamma
, 1, 1, 0,
255 "Return the log gamma of ARG.")
257 register Lisp_Object num
;
259 double d
= extract_float (num
);
260 IN_FLOAT (d
= lgamma (d
), num
);
261 return make_float (d
);
264 DEFUN ("log", Flog
, Slog
, 1, 1, 0,
265 "Return the natural logarithm of ARG.")
267 register Lisp_Object num
;
269 double d
= extract_float (num
);
270 IN_FLOAT (d
= log (d
), num
);
271 return make_float (d
);
274 DEFUN ("log10", Flog10
, Slog10
, 1, 1, 0,
275 "Return the logarithm base 10 of ARG.")
277 register Lisp_Object num
;
279 double d
= extract_float (num
);
280 IN_FLOAT (d
= log10 (d
), num
);
281 return make_float (d
);
284 DEFUN ("log1p", Flog1p
, Slog1p
, 1, 1, 0,
285 "Return the log (1+x) of ARG.")
287 register Lisp_Object num
;
289 double d
= extract_float (num
);
290 IN_FLOAT (d
= log1p (d
), num
);
291 return make_float (d
);
294 DEFUN ("expt", Fexpt
, Sexpt
, 2, 2, 0,
295 "Return the exponential x ** y.")
297 register Lisp_Object num1
, num2
;
301 CHECK_NUMBER_OR_FLOAT (num1
, 0);
302 CHECK_NUMBER_OR_FLOAT (num2
, 0);
303 if ((XTYPE (num1
) == Lisp_Int
) && /* common lisp spec */
304 (XTYPE (num2
) == Lisp_Int
)) /* don't promote, if both are ints */
305 { /* this can be improved by pre-calculating */
306 int acc
, x
, y
; /* some binary powers of x then acumulating */
307 /* these, therby saving some time. -wsr */
322 return XSET (x
, Lisp_Int
, acc
);
324 f1
= (XTYPE (num1
) == Lisp_Float
) ? XFLOAT (num1
)->data
: XINT (num1
);
325 f2
= (XTYPE (num2
) == Lisp_Float
) ? XFLOAT (num2
)->data
: XINT (num2
);
326 IN_FLOAT (f1
= pow (f1
, f2
), num1
);
327 return make_float (f1
);
330 DEFUN ("sin", Fsin
, Ssin
, 1, 1, 0,
331 "Return the sine of ARG.")
333 register Lisp_Object num
;
335 double d
= extract_float (num
);
336 IN_FLOAT (d
= sin (d
), num
);
337 return make_float (d
);
340 DEFUN ("sinh", Fsinh
, Ssinh
, 1, 1, 0,
341 "Return the hyperbolic sine of ARG.")
343 register Lisp_Object num
;
345 double d
= extract_float (num
);
346 IN_FLOAT (d
= sinh (d
), num
);
347 return make_float (d
);
350 DEFUN ("sqrt", Fsqrt
, Ssqrt
, 1, 1, 0,
351 "Return the square root of ARG.")
353 register Lisp_Object num
;
355 double d
= extract_float (num
);
356 IN_FLOAT (d
= sqrt (d
), num
);
357 return make_float (d
);
360 DEFUN ("tan", Ftan
, Stan
, 1, 1, 0,
361 "Return the tangent of ARG.")
363 register Lisp_Object num
;
365 double d
= extract_float (num
);
366 IN_FLOAT (d
= tan (d
), num
);
367 return make_float (d
);
370 DEFUN ("tanh", Ftanh
, Stanh
, 1, 1, 0,
371 "Return the hyperbolic tangent of ARG.")
373 register Lisp_Object num
;
375 double d
= extract_float (num
);
376 IN_FLOAT (d
= tanh (d
), num
);
377 return make_float (d
);
380 DEFUN ("abs", Fabs
, Sabs
, 1, 1, 0,
381 "Return the absolute value of ARG.")
383 register Lisp_Object num
;
385 CHECK_NUMBER_OR_FLOAT (num
, 0);
387 if (XTYPE (num
) == Lisp_Float
)
388 IN_FLOAT (num
= make_float (fabs (XFLOAT (num
)->data
)), num
);
389 else if (XINT (num
) < 0)
390 XSETINT (num
, - XFASTINT (num
));
395 DEFUN ("float", Ffloat
, Sfloat
, 1, 1, 0,
396 "Return the floating point number equal to ARG.")
398 register Lisp_Object num
;
400 CHECK_NUMBER_OR_FLOAT (num
, 0);
402 if (XTYPE (num
) == Lisp_Int
)
403 return make_float ((double) XINT (num
));
404 else /* give 'em the same float back */
408 DEFUN ("logb", Flogb
, Slogb
, 1, 1, 0,
409 "Returns the integer that is the base 2 log of ARG.\n\
410 This is the same as the exponent of a float.")
417 CHECK_NUMBER_OR_FLOAT (num
, 0);
418 f
= (XTYPE (num
) == Lisp_Float
) ? XFLOAT (num
)->data
: XINT (num
);
419 IN_FLOAT (val
= logb (f
), num
);
420 XSET (val
, Lisp_Int
, val
);
424 /* the rounding functions */
426 DEFUN ("ceiling", Fceiling
, Sceiling
, 1, 1, 0,
427 "Return the smallest integer no less than ARG. (Round toward +inf.)")
429 register Lisp_Object num
;
431 CHECK_NUMBER_OR_FLOAT (num
, 0);
433 if (XTYPE (num
) == Lisp_Float
)
434 IN_FLOAT (XSET (num
, Lisp_Int
, ceil (XFLOAT (num
)->data
)), num
);
439 DEFUN ("floor", Ffloor
, Sfloor
, 1, 1, 0,
440 "Return the largest integer no greater than ARG. (Round towards -inf.)")
442 register Lisp_Object num
;
444 CHECK_NUMBER_OR_FLOAT (num
, 0);
446 if (XTYPE (num
) == Lisp_Float
)
447 IN_FLOAT (XSET (num
, Lisp_Int
, floor (XFLOAT (num
)->data
)), num
);
452 DEFUN ("round", Fround
, Sround
, 1, 1, 0,
453 "Return the nearest integer to ARG.")
455 register Lisp_Object num
;
457 CHECK_NUMBER_OR_FLOAT (num
, 0);
459 if (XTYPE (num
) == Lisp_Float
)
460 IN_FLOAT (XSET (num
, Lisp_Int
, rint (XFLOAT (num
)->data
)), num
);
465 DEFUN ("truncate", Ftruncate
, Struncate
, 1, 1, 0,
466 "Truncate a floating point number to an int.\n\
467 Rounds the value toward zero.")
469 register Lisp_Object num
;
471 CHECK_NUMBER_OR_FLOAT (num
, 0);
473 if (XTYPE (num
) == Lisp_Float
)
474 XSET (num
, Lisp_Int
, (int) XFLOAT (num
)->data
);
485 fatal_error_signal (signo
);
489 #else /* not BSD4_1 */
491 #endif /* not BSD4_1 */
495 Fsignal (Qarith_error
, Fcons (float_error_arg
, Qnil
));
498 /* Another idea was to replace the library function `infnan'
499 where SIGILL is signaled. */
505 signal (SIGILL
, float_error
);
517 defsubr (&Sbessel_y0
);
518 defsubr (&Sbessel_y1
);
519 defsubr (&Sbessel_yn
);
520 defsubr (&Sbessel_j0
);
521 defsubr (&Sbessel_j1
);
522 defsubr (&Sbessel_jn
);
523 defsubr (&Scube_root
);
530 defsubr (&Slog_gamma
);
547 defsubr (&Struncate
);
550 #else /* not LISP_FLOAT_TYPE */
558 #endif /* not LISP_FLOAT_TYPE */