X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/36a305a723c63fd345be65c536c52fe9765c14be..6bc76cee212aab0a2c02f8c28213fc842cc7880f:/src/floatfns.c diff --git a/src/floatfns.c b/src/floatfns.c index 645a595760..ac0447ce6d 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -1,7 +1,7 @@ /* Primitive operations on floating point for GNU Emacs Lisp interpreter. -Copyright (C) 1988, 1993-1994, 1999, 2001-2012 - Free Software Foundation, Inc. +Copyright (C) 1988, 1993-1994, 1999, 2001-2014 Free Software Foundation, +Inc. Author: Wolfgang Rupprecht (according to ack.texi) @@ -25,7 +25,19 @@ along with GNU Emacs. If not, see . */ /* C89 requires only the following math.h functions, and Emacs omits the starred functions since we haven't found a use for them: acos, asin, atan, atan2, ceil, cos, *cosh, exp, fabs, floor, fmod, - frexp, ldexp, log, log10, *modf, pow, sin, *sinh, sqrt, tan, *tanh. + frexp, ldexp, log, log10 [via (log X 10)], *modf, pow, sin, *sinh, + sqrt, tan, *tanh. + + C99 and C11 require the following math.h functions in addition to + the C89 functions. Of these, Emacs currently exports only the + starred ones to Lisp, since we haven't found a use for the others: + acosh, atanh, cbrt, *copysign, erf, erfc, exp2, expm1, fdim, fma, + fmax, fmin, fpclassify, hypot, ilogb, isfinite, isgreater, + isgreaterequal, isinf, isless, islessequal, islessgreater, *isnan, + isnormal, isunordered, lgamma, log1p, *log2 [via (log X 2)], *logb + (approximately), lrint/llrint, lround/llround, nan, nearbyint, + nextafter, nexttoward, remainder, remquo, *rint, round, scalbln, + scalbn, signbit, tgamma, trunc. */ #include @@ -34,12 +46,21 @@ along with GNU Emacs. If not, see . */ #include -#ifndef isfinite -# define isfinite(x) ((x) - (x) == 0) -#endif -#ifndef isnan -# define isnan(x) ((x) != (x)) -#endif +/* 'isfinite' and 'isnan' cause build failures on Solaris 10 with the + bundled GCC in c99 mode. Work around the bugs with simple + implementations that are good enough. */ +#undef isfinite +#define isfinite(x) ((x) - (x) == 0) +#undef isnan +#define isnan(x) ((x) != (x)) + +/* Check that X is a floating point number. */ + +static void +CHECK_FLOAT (Lisp_Object x) +{ + CHECK_TYPE (FLOATP (x), Qfloatp, x); +} /* Extract a Lisp number as a `double', or signal an error. */ @@ -193,7 +214,7 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, CHECK_NUMBER_OR_FLOAT (arg2); if (INTEGERP (arg1) /* common lisp spec */ && INTEGERP (arg2) /* don't promote, if both are ints, and */ - && 0 <= XINT (arg2)) /* we are sure the result is not fractional */ + && XINT (arg2) >= 0) /* we are sure the result is not fractional */ { /* this can be improved by pre-calculating */ EMACS_INT y; /* some binary powers of x then accumulating */ EMACS_UINT acc, x; /* Unsigned so that overflow is well defined. */ @@ -233,21 +254,16 @@ If the optional argument BASE is given, return log ARG using that base. */) if (b == 10.0) d = log10 (d); +#if HAVE_LOG2 + else if (b == 2.0) + d = log2 (d); +#endif else d = log (d) / log (b); } return make_float (d); } -DEFUN ("log10", Flog10, Slog10, 1, 1, 0, - doc: /* Return the logarithm base 10 of ARG. */) - (Lisp_Object arg) -{ - double d = extract_float (arg); - d = log10 (d); - return make_float (d); -} - DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, doc: /* Return the square root of ARG. */) (Lisp_Object arg) @@ -399,8 +415,8 @@ round2 (EMACS_INT i1, EMACS_INT i2) odd. */ EMACS_INT q = i1 / i2; EMACS_INT r = i1 % i2; - EMACS_INT abs_r = r < 0 ? -r : r; - EMACS_INT abs_r1 = (i2 < 0 ? -i2 : i2) - abs_r; + EMACS_INT abs_r = eabs (r); + EMACS_INT abs_r1 = eabs (i2) - abs_r; return q + (abs_r + (q & 1) <= abs_r1 ? 0 : (i2 ^ r) < 0 ? -1 : 1); } @@ -412,7 +428,9 @@ round2 (EMACS_INT i1, EMACS_INT i2) static double emacs_rint (double d) { - return floor (d + 0.5); + double d1 = d + 0.5; + double r = floor (d1); + return r - (r == d1 && fmod (r, 2) != 0); } #endif @@ -475,7 +493,7 @@ fmod_float (Lisp_Object x, Lisp_Object y) f1 = fmod (f1, f2); /* If the "remainder" comes out with the wrong sign, fix it. */ - if (f2 < 0 ? 0 < f1 : f1 < 0) + if (f2 < 0 ? f1 > 0 : f1 < 0) f1 += f2; return make_float (f1); @@ -545,7 +563,6 @@ syms_of_floatfns (void) defsubr (&Sexp); defsubr (&Sexpt); defsubr (&Slog); - defsubr (&Slog10); defsubr (&Ssqrt); defsubr (&Sabs);