aboutsummaryrefslogtreecommitdiffstats
path: root/src/floatfns.c
diff options
context:
space:
mode:
authorPaul Eggert2012-09-10 19:28:27 -0700
committerPaul Eggert2012-09-10 19:28:27 -0700
commitc990426a9883c1bd1782e6b117184b654eecda67 (patch)
tree43083f890e5286637ee754482af0f92d6d2236d0 /src/floatfns.c
parent6fda35f2b3e3ce3c7dcc05f230f60c51c4c42e60 (diff)
downloademacs-c990426a9883c1bd1782e6b117184b654eecda67.tar.gz
emacs-c990426a9883c1bd1782e6b117184b654eecda67.zip
Simplify, document, and port floating-point.
The porting part of this patch fixes bugs on non-IEEE platforms with frexp, ldexp, logb. * admin/CPP-DEFINES (HAVE_CBRT, HAVE_LOGB, logb): Remove. * configure.ac (logb, cbrt): Do not check for these functions, as they are not being used. * doc/lispref/numbers.texi (Float Basics, Arithmetic Operations, Math Functions): Document that / and mod (with floating point arguments), along with asin, acos, log, log10, expt and sqrt, return special values instead of signaling exceptions. (Float Basics): Document that logb operates on the absolute value of its argument. (Math Functions): Document that (log ARG BASE) also returns NaN if BASE is negative. Document that (expt X Y) returns NaN if X is a finite negative number and Y a finite non-integer. * etc/NEWS: Document NaNs versus signaling-error change. * src/data.c, src/lisp.h (Qdomain_error, Qsingularity_error, Qunderflow_error): Now static. * src/floatfns.c: Simplify discussion of functions that Emacs doesn't support, by removing commented-out code and briefly listing the C89 functions excluded. The commented-out stuff was confusing maintenance, e.g., we thought we needed cbrt but it was commented out. (logb): Remove decl; no longer needed. (isfinite): New macro, if not already supplied. (isnan): Don't replace any existing macro. (Ffrexp, Fldexp): Define even if !HAVE_COPYSIGN, as frexp and ldexp are present on all C89 platforms. (Ffrexp): Do not special-case zero, as frexp does the right thing for that case. (Flogb): Do not use logb, as it doesn't have the desired meaning on hosts that use non-base-2 floating point. Instead, stick with frexp, which is C89 anyway. Do not pass an infinity or a NaN to frexp, to avoid getting an unspecified result.
Diffstat (limited to 'src/floatfns.c')
-rw-r--r--src/floatfns.c231
1 files changed, 19 insertions, 212 deletions
diff --git a/src/floatfns.c b/src/floatfns.c
index 8a9a9fd0886..66d7ca4af2c 100644
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -22,9 +22,10 @@ You should have received a copy of the GNU General Public License
22along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ 22along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 23
24 24
25/* C89 requires only these math.h functions: 25/* C89 requires only the following math.h functions, and Emacs omits
26 acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod, 26 the starred functions since we haven't found a use for them:
27 frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh. 27 acos, asin, atan, atan2, ceil, cos, *cosh, exp, fabs, floor, fmod,
28 frexp, ldexp, log, log10, *modf, pow, sin, *sinh, sqrt, tan, *tanh.
28 */ 29 */
29 30
30#include <config.h> 31#include <config.h>
@@ -42,10 +43,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
42 43
43#include <math.h> 44#include <math.h>
44 45
45/* This declaration is omitted on some systems, like Ultrix. */ 46#ifndef isfinite
46#if !defined (HPUX) && defined (HAVE_LOGB) && !defined (logb) 47# define isfinite(x) ((x) - (x) == 0)
47extern double logb (double); 48#endif
48#endif /* not HPUX and HAVE_LOGB and no logb macro */ 49#ifndef isnan
50# define isnan(x) ((x) != (x))
51#endif
49 52
50/* Extract a Lisp number as a `double', or signal an error. */ 53/* Extract a Lisp number as a `double', or signal an error. */
51 54
@@ -126,9 +129,6 @@ DEFUN ("tan", Ftan, Stan, 1, 1, 0,
126 return make_float (d); 129 return make_float (d);
127} 130}
128 131
129#undef isnan
130#define isnan(x) ((x) != (x))
131
132DEFUN ("isnan", Fisnan, Sisnan, 1, 1, 0, 132DEFUN ("isnan", Fisnan, Sisnan, 1, 1, 0,
133 doc: /* Return non nil iff argument X is a NaN. */) 133 doc: /* Return non nil iff argument X is a NaN. */)
134 (Lisp_Object x) 134 (Lisp_Object x)
@@ -153,6 +153,7 @@ Cause an error if X1 or X2 is not a float. */)
153 153
154 return make_float (copysign (f1, f2)); 154 return make_float (copysign (f1, f2));
155} 155}
156#endif
156 157
157DEFUN ("frexp", Ffrexp, Sfrexp, 1, 1, 0, 158DEFUN ("frexp", Ffrexp, Sfrexp, 1, 1, 0,
158 doc: /* Get significand and exponent of a floating point number. 159 doc: /* Get significand and exponent of a floating point number.
@@ -167,15 +168,9 @@ If X is zero, both parts (SGNFCAND and EXP) are zero. */)
167 (Lisp_Object x) 168 (Lisp_Object x)
168{ 169{
169 double f = XFLOATINT (x); 170 double f = XFLOATINT (x);
170 171 int exponent;
171 if (f == 0.0) 172 double sgnfcand = frexp (f, &exponent);
172 return Fcons (make_float (0.0), make_number (0)); 173 return Fcons (make_float (sgnfcand), make_number (exponent));
173 else
174 {
175 int exponent;
176 double sgnfcand = frexp (f, &exponent);
177 return Fcons (make_float (sgnfcand), make_number (exponent));
178 }
179} 174}
180 175
181DEFUN ("ldexp", Fldexp, Sldexp, 1, 2, 0, 176DEFUN ("ldexp", Fldexp, Sldexp, 1, 2, 0,
@@ -187,118 +182,6 @@ Returns the floating point value resulting from multiplying SGNFCAND
187 CHECK_NUMBER (exponent); 182 CHECK_NUMBER (exponent);
188 return make_float (ldexp (XFLOATINT (sgnfcand), XINT (exponent))); 183 return make_float (ldexp (XFLOATINT (sgnfcand), XINT (exponent)));
189} 184}
190#endif
191
192#if 0 /* Leave these out unless we find there's a reason for them. */
193
194DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0,
195 doc: /* Return the bessel function j0 of ARG. */)
196 (Lisp_Object arg)
197{
198 double d = extract_float (arg);
199 d = j0 (d);
200 return make_float (d);
201}
202
203DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0,
204 doc: /* Return the bessel function j1 of ARG. */)
205 (Lisp_Object arg)
206{
207 double d = extract_float (arg);
208 d = j1 (d);
209 return make_float (d);
210}
211
212DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0,
213 doc: /* Return the order N bessel function output jn of ARG.
214The first arg (the order) is truncated to an integer. */)
215 (Lisp_Object n, Lisp_Object arg)
216{
217 int i1 = extract_float (n);
218 double f2 = extract_float (arg);
219
220 f2 = jn (i1, f2);
221 return make_float (f2);
222}
223
224DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0,
225 doc: /* Return the bessel function y0 of ARG. */)
226 (Lisp_Object arg)
227{
228 double d = extract_float (arg);
229 d = y0 (d);
230 return make_float (d);
231}
232
233DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0,
234 doc: /* Return the bessel function y1 of ARG. */)
235 (Lisp_Object arg)
236{
237 double d = extract_float (arg);
238 d = y1 (d);
239 return make_float (d);
240}
241
242DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0,
243 doc: /* Return the order N bessel function output yn of ARG.
244The first arg (the order) is truncated to an integer. */)
245 (Lisp_Object n, Lisp_Object arg)
246{
247 int i1 = extract_float (n);
248 double f2 = extract_float (arg);
249
250 f2 = yn (i1, f2);
251 return make_float (f2);
252}
253
254#endif
255
256#if 0 /* Leave these out unless we see they are worth having. */
257
258DEFUN ("erf", Ferf, Serf, 1, 1, 0,
259 doc: /* Return the mathematical error function of ARG. */)
260 (Lisp_Object arg)
261{
262 double d = extract_float (arg);
263 d = erf (d);
264 return make_float (d);
265}
266
267DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0,
268 doc: /* Return the complementary error function of ARG. */)
269 (Lisp_Object arg)
270{
271 double d = extract_float (arg);
272 d = erfc (d);
273 return make_float (d);
274}
275
276DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0,
277 doc: /* Return the log gamma of ARG. */)
278 (Lisp_Object arg)
279{
280 double d = extract_float (arg);
281 d = lgamma (d);
282 return make_float (d);
283}
284
285DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0,
286 doc: /* Return the cube root of ARG. */)
287 (Lisp_Object arg)
288{
289 double d = extract_float (arg);
290#ifdef HAVE_CBRT
291 d = cbrt (d);
292#else
293 if (d >= 0.0)
294 d = pow (d, 1.0/3.0);
295 else
296 d = -pow (-d, 1.0/3.0);
297#endif
298 return make_float (d);
299}
300
301#endif
302 185
303DEFUN ("exp", Fexp, Sexp, 1, 1, 0, 186DEFUN ("exp", Fexp, Sexp, 1, 1, 0,
304 doc: /* Return the exponential base e of ARG. */) 187 doc: /* Return the exponential base e of ARG. */)
@@ -383,63 +266,6 @@ DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0,
383 return make_float (d); 266 return make_float (d);
384} 267}
385 268
386#if 0 /* Not clearly worth adding. */
387
388DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0,
389 doc: /* Return the inverse hyperbolic cosine of ARG. */)
390 (Lisp_Object arg)
391{
392 double d = extract_float (arg);
393 d = acosh (d);
394 return make_float (d);
395}
396
397DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0,
398 doc: /* Return the inverse hyperbolic sine of ARG. */)
399 (Lisp_Object arg)
400{
401 double d = extract_float (arg);
402 d = asinh (d);
403 return make_float (d);
404}
405
406DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0,
407 doc: /* Return the inverse hyperbolic tangent of ARG. */)
408 (Lisp_Object arg)
409{
410 double d = extract_float (arg);
411 d = atanh (d);
412 return make_float (d);
413}
414
415DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0,
416 doc: /* Return the hyperbolic cosine of ARG. */)
417 (Lisp_Object arg)
418{
419 double d = extract_float (arg);
420 d = cosh (d);
421 return make_float (d);
422}
423
424DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0,
425 doc: /* Return the hyperbolic sine of ARG. */)
426 (Lisp_Object arg)
427{
428 double d = extract_float (arg);
429 d = sinh (d);
430 return make_float (d);
431}
432
433DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0,
434 doc: /* Return the hyperbolic tangent of ARG. */)
435 (Lisp_Object arg)
436{
437 double d = extract_float (arg);
438 d = tanh (d);
439 return make_float (d);
440}
441#endif
442
443DEFUN ("abs", Fabs, Sabs, 1, 1, 0, 269DEFUN ("abs", Fabs, Sabs, 1, 1, 0,
444 doc: /* Return the absolute value of ARG. */) 270 doc: /* Return the absolute value of ARG. */)
445 (register Lisp_Object arg) 271 (register Lisp_Object arg)
@@ -477,16 +303,15 @@ This is the same as the exponent of a float. */)
477 303
478 if (f == 0.0) 304 if (f == 0.0)
479 value = MOST_NEGATIVE_FIXNUM; 305 value = MOST_NEGATIVE_FIXNUM;
480 else 306 else if (isfinite (f))
481 { 307 {
482#ifdef HAVE_LOGB
483 value = logb (f);
484#else
485 int ivalue; 308 int ivalue;
486 frexp (f, &ivalue); 309 frexp (f, &ivalue);
487 value = ivalue - 1; 310 value = ivalue - 1;
488#endif
489 } 311 }
312 else
313 value = MOST_POSITIVE_FIXNUM;
314
490 XSETINT (val, value); 315 XSETINT (val, value);
491 return val; 316 return val;
492} 317}
@@ -719,27 +544,9 @@ syms_of_floatfns (void)
719 defsubr (&Sisnan); 544 defsubr (&Sisnan);
720#ifdef HAVE_COPYSIGN 545#ifdef HAVE_COPYSIGN
721 defsubr (&Scopysign); 546 defsubr (&Scopysign);
547#endif
722 defsubr (&Sfrexp); 548 defsubr (&Sfrexp);
723 defsubr (&Sldexp); 549 defsubr (&Sldexp);
724#endif
725#if 0
726 defsubr (&Sacosh);
727 defsubr (&Sasinh);
728 defsubr (&Satanh);
729 defsubr (&Scosh);
730 defsubr (&Ssinh);
731 defsubr (&Stanh);
732 defsubr (&Sbessel_y0);
733 defsubr (&Sbessel_y1);
734 defsubr (&Sbessel_yn);
735 defsubr (&Sbessel_j0);
736 defsubr (&Sbessel_j1);
737 defsubr (&Sbessel_jn);
738 defsubr (&Serf);
739 defsubr (&Serfc);
740 defsubr (&Slog_gamma);
741 defsubr (&Scube_root);
742#endif
743 defsubr (&Sfceiling); 550 defsubr (&Sfceiling);
744 defsubr (&Sffloor); 551 defsubr (&Sffloor);
745 defsubr (&Sfround); 552 defsubr (&Sfround);