X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/523e929122415f6bad52eca72af3222c90caebcf..366717cfa0ff12fc544e9ee5031478e25aecf08d:/src/floatfns.c diff --git a/src/floatfns.c b/src/floatfns.c index 29bdccf298..79574e0a69 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -1,5 +1,6 @@ /* Primitive operations on floating point for GNU Emacs Lisp interpreter. - Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 1988, 1993, 1994, 1999, 2002, 2003, 2004, + 2005 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -15,8 +16,8 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ /* ANSI C requires only these float functions: @@ -25,7 +26,7 @@ Boston, MA 02111-1307, USA. */ Define HAVE_INVERSE_HYPERBOLIC if you have acosh, asinh, and atanh. Define HAVE_CBRT if you have cbrt. - Define HAVE_RINT if you have rint. + Define HAVE_RINT if you have a working rint. If you don't define these, then the appropriate routines will be simulated. Define HAVE_MATHERR if on a system supporting the SysV matherr callback. @@ -44,20 +45,15 @@ Boston, MA 02111-1307, USA. */ a domain error occurs.) */ -#include - #include +#include +#include "lisp.h" +#include "syssignal.h" -/* Put this before lisp.h so that lisp.h can define DBL_DIG if not defined. */ #if STDC_HEADERS #include #endif -#include "lisp.h" -#include "syssignal.h" - -#ifdef LISP_FLOAT_TYPE - /* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */ #ifndef IEEE_FLOATING_POINT #if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ @@ -112,8 +108,10 @@ extern double logb (); #ifdef FLOAT_CHECK_ERRNO # include +#ifndef USE_CRT_DLL extern int errno; #endif +#endif /* Avoid traps on VMS from sinh and cosh. All the other functions set errno instead. */ @@ -125,7 +123,9 @@ extern int errno; #define sinh(x) ((exp(x)-exp(-x))*0.5) #endif /* VMS */ +#ifdef FLOAT_CATCH_SIGILL static SIGTYPE float_error (); +#endif /* Nonzero while executing in floating point. This tells float_error what to do. */ @@ -186,8 +186,7 @@ static char *float_error_fn_name; #define FLOAT_TO_INT(x, i, name, num) \ do \ { \ - if ((x) >= (((EMACS_INT) 1) << (VALBITS-1)) || \ - (x) <= - (((EMACS_INT) 1) << (VALBITS-1)) - 1) \ + if (FIXNUM_OVERFLOW_P (x)) \ range_error (name, num); \ XSETINT (i, (EMACS_INT)(x)); \ } \ @@ -195,8 +194,7 @@ static char *float_error_fn_name; #define FLOAT_TO_INT2(x, i, name, num1, num2) \ do \ { \ - if ((x) >= (((EMACS_INT) 1) << (VALBITS-1)) || \ - (x) <= - (((EMACS_INT) 1) << (VALBITS-1)) - 1) \ + if (FIXNUM_OVERFLOW_P (x)) \ range_error2 (name, num1, num2); \ XSETINT (i, (EMACS_INT)(x)); \ } \ @@ -221,18 +219,18 @@ double extract_float (num) Lisp_Object num; { - CHECK_NUMBER_OR_FLOAT (num, 0); + CHECK_NUMBER_OR_FLOAT (num); if (FLOATP (num)) - return XFLOAT (num)->data; + return XFLOAT_DATA (num); return (double) XINT (num); } /* Trig functions. */ DEFUN ("acos", Facos, Sacos, 1, 1, 0, - "Return the inverse cosine of ARG.") - (arg) + doc: /* Return the inverse cosine of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -245,8 +243,8 @@ DEFUN ("acos", Facos, Sacos, 1, 1, 0, } DEFUN ("asin", Fasin, Sasin, 1, 1, 0, - "Return the inverse sine of ARG.") - (arg) + doc: /* Return the inverse sine of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -258,19 +256,31 @@ DEFUN ("asin", Fasin, Sasin, 1, 1, 0, return make_float (d); } -DEFUN ("atan", Fatan, Satan, 1, 1, 0, - "Return the inverse tangent of ARG.") - (arg) - register Lisp_Object arg; +DEFUN ("atan", Fatan, Satan, 1, 2, 0, + doc: /* Return the inverse tangent of the arguments. +If only one argument Y is given, return the inverse tangent of Y. +If two arguments Y and X are given, return the inverse tangent of Y +divided by X, i.e. the angle in radians between the vector (X, Y) +and the x-axis. */) + (y, x) + register Lisp_Object y, x; { - double d = extract_float (arg); - IN_FLOAT (d = atan (d), "atan", arg); + double d = extract_float (y); + + if (NILP (x)) + IN_FLOAT (d = atan (d), "atan", y); + else + { + double d2 = extract_float (x); + + IN_FLOAT2 (d = atan2 (d, d2), "atan", y, x); + } return make_float (d); } DEFUN ("cos", Fcos, Scos, 1, 1, 0, - "Return the cosine of ARG.") - (arg) + doc: /* Return the cosine of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -279,8 +289,8 @@ DEFUN ("cos", Fcos, Scos, 1, 1, 0, } DEFUN ("sin", Fsin, Ssin, 1, 1, 0, - "Return the sine of ARG.") - (arg) + doc: /* Return the sine of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -289,8 +299,8 @@ DEFUN ("sin", Fsin, Ssin, 1, 1, 0, } DEFUN ("tan", Ftan, Stan, 1, 1, 0, - "Return the tangent of ARG.") - (arg) + doc: /* Return the tangent of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -306,8 +316,8 @@ DEFUN ("tan", Ftan, Stan, 1, 1, 0, #if 0 /* Leave these out unless we find there's a reason for them. */ DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0, - "Return the bessel function j0 of ARG.") - (arg) + doc: /* Return the bessel function j0 of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -316,8 +326,8 @@ DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0, } DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0, - "Return the bessel function j1 of ARG.") - (arg) + doc: /* Return the bessel function j1 of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -326,9 +336,9 @@ DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0, } DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0, - "Return the order N bessel function output jn of ARG.\n\ -The first arg (the order) is truncated to an integer.") - (n, arg) + doc: /* Return the order N bessel function output jn of ARG. +The first arg (the order) is truncated to an integer. */) + (n, arg) register Lisp_Object n, arg; { int i1 = extract_float (n); @@ -339,8 +349,8 @@ The first arg (the order) is truncated to an integer.") } DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0, - "Return the bessel function y0 of ARG.") - (arg) + doc: /* Return the bessel function y0 of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -349,8 +359,8 @@ DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0, } DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0, - "Return the bessel function y1 of ARG.") - (arg) + doc: /* Return the bessel function y1 of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -359,9 +369,9 @@ DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0, } DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0, - "Return the order N bessel function output yn of ARG.\n\ -The first arg (the order) is truncated to an integer.") - (n, arg) + doc: /* Return the order N bessel function output yn of ARG. +The first arg (the order) is truncated to an integer. */) + (n, arg) register Lisp_Object n, arg; { int i1 = extract_float (n); @@ -376,8 +386,8 @@ The first arg (the order) is truncated to an integer.") #if 0 /* Leave these out unless we see they are worth having. */ DEFUN ("erf", Ferf, Serf, 1, 1, 0, - "Return the mathematical error function of ARG.") - (arg) + doc: /* Return the mathematical error function of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -386,8 +396,8 @@ DEFUN ("erf", Ferf, Serf, 1, 1, 0, } DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0, - "Return the complementary error function of ARG.") - (arg) + doc: /* Return the complementary error function of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -396,8 +406,8 @@ DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0, } DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0, - "Return the log gamma of ARG.") - (arg) + doc: /* Return the log gamma of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -406,8 +416,8 @@ DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0, } DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0, - "Return the cube root of ARG.") - (arg) + doc: /* Return the cube root of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -425,8 +435,8 @@ DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0, #endif DEFUN ("exp", Fexp, Sexp, 1, 1, 0, - "Return the exponential base e of ARG.") - (arg) + doc: /* Return the exponential base e of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -442,16 +452,17 @@ DEFUN ("exp", Fexp, Sexp, 1, 1, 0, } DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, - "Return the exponential ARG1 ** ARG2.") - (arg1, arg2) + doc: /* Return the exponential ARG1 ** ARG2. */) + (arg1, arg2) register Lisp_Object arg1, arg2; { double f1, f2; - CHECK_NUMBER_OR_FLOAT (arg1, 0); - CHECK_NUMBER_OR_FLOAT (arg2, 0); + CHECK_NUMBER_OR_FLOAT (arg1); + CHECK_NUMBER_OR_FLOAT (arg2); if (INTEGERP (arg1) /* common lisp spec */ - && INTEGERP (arg2)) /* don't promote, if both are ints */ + && INTEGERP (arg2) /* don't promote, if both are ints, and */ + && 0 <= XINT (arg2)) /* we are sure the result is not fractional */ { /* this can be improved by pre-calculating */ EMACS_INT acc, x, y; /* some binary powers of x then accumulating */ Lisp_Object val; @@ -459,7 +470,7 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, x = XINT (arg1); y = XINT (arg2); acc = 1; - + if (y < 0) { if (x == 1) @@ -482,8 +493,8 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, XSETINT (val, acc); return val; } - f1 = FLOATP (arg1) ? XFLOAT (arg1)->data : XINT (arg1); - f2 = FLOATP (arg2) ? XFLOAT (arg2)->data : XINT (arg2); + f1 = FLOATP (arg1) ? XFLOAT_DATA (arg1) : XINT (arg1); + f2 = FLOATP (arg2) ? XFLOAT_DATA (arg2) : XINT (arg2); /* Really should check for overflow, too */ if (f1 == 0.0 && f2 == 0.0) f1 = 1.0; @@ -496,9 +507,9 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, } DEFUN ("log", Flog, Slog, 1, 2, 0, - "Return the natural logarithm of ARG.\n\ -If second optional argument BASE is given, return log ARG using that base.") - (arg, base) + doc: /* Return the natural logarithm of ARG. +If second optional argument BASE is given, return log ARG using that base. */) + (arg, base) register Lisp_Object arg, base; { double d = extract_float (arg); @@ -526,8 +537,8 @@ If second optional argument BASE is given, return log ARG using that base.") } DEFUN ("log10", Flog10, Slog10, 1, 1, 0, - "Return the logarithm base 10 of ARG.") - (arg) + doc: /* Return the logarithm base 10 of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -540,8 +551,8 @@ DEFUN ("log10", Flog10, Slog10, 1, 1, 0, } DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, - "Return the square root of ARG.") - (arg) + doc: /* Return the square root of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -556,8 +567,8 @@ DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, #if 0 /* Not clearly worth adding. */ DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0, - "Return the inverse hyperbolic cosine of ARG.") - (arg) + doc: /* Return the inverse hyperbolic cosine of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -574,8 +585,8 @@ DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0, } DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0, - "Return the inverse hyperbolic sine of ARG.") - (arg) + doc: /* Return the inverse hyperbolic sine of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -588,8 +599,8 @@ DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0, } DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0, - "Return the inverse hyperbolic tangent of ARG.") - (arg) + doc: /* Return the inverse hyperbolic tangent of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -606,8 +617,8 @@ DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0, } DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0, - "Return the hyperbolic cosine of ARG.") - (arg) + doc: /* Return the hyperbolic cosine of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -620,8 +631,8 @@ DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0, } DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0, - "Return the hyperbolic sine of ARG.") - (arg) + doc: /* Return the hyperbolic sine of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -634,8 +645,8 @@ DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0, } DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0, - "Return the hyperbolic tangent of ARG.") - (arg) + doc: /* Return the hyperbolic tangent of ARG. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -645,14 +656,14 @@ DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0, #endif DEFUN ("abs", Fabs, Sabs, 1, 1, 0, - "Return the absolute value of ARG.") - (arg) + doc: /* Return the absolute value of ARG. */) + (arg) register Lisp_Object arg; { - CHECK_NUMBER_OR_FLOAT (arg, 0); + CHECK_NUMBER_OR_FLOAT (arg); if (FLOATP (arg)) - IN_FLOAT (arg = make_float (fabs (XFLOAT (arg)->data)), "abs", arg); + IN_FLOAT (arg = make_float (fabs (XFLOAT_DATA (arg))), "abs", arg); else if (XINT (arg) < 0) XSETINT (arg, - XINT (arg)); @@ -660,11 +671,11 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0, } DEFUN ("float", Ffloat, Sfloat, 1, 1, 0, - "Return the floating point number equal to ARG.") - (arg) + doc: /* Return the floating point number equal to ARG. */) + (arg) register Lisp_Object arg; { - CHECK_NUMBER_OR_FLOAT (arg, 0); + CHECK_NUMBER_OR_FLOAT (arg); if (INTEGERP (arg)) return make_float ((double) XINT (arg)); @@ -673,8 +684,8 @@ DEFUN ("float", Ffloat, Sfloat, 1, 1, 0, } DEFUN ("logb", Flogb, Slogb, 1, 1, 0, - "Returns largest integer <= the base 2 log of the magnitude of ARG.\n\ -This is the same as the exponent of a float.") + doc: /* Returns largest integer <= the base 2 log of the magnitude of ARG. +This is the same as the exponent of a float. */) (arg) Lisp_Object arg; { @@ -683,7 +694,7 @@ This is the same as the exponent of a float.") double f = extract_float (arg); if (f == 0.0) - value = -(VALMASK >> 1); + value = MOST_NEGATIVE_FIXNUM; else { #ifdef HAVE_LOGB @@ -720,8 +731,6 @@ This is the same as the exponent of a float.") return val; } -#endif /* LISP_FLOAT_TYPE */ - /* the rounding functions */ @@ -732,21 +741,20 @@ rounding_driver (arg, divisor, double_round, int_round2, name) EMACS_INT (*int_round2) (); char *name; { - CHECK_NUMBER_OR_FLOAT (arg, 0); + CHECK_NUMBER_OR_FLOAT (arg); if (! NILP (divisor)) { EMACS_INT i1, i2; - CHECK_NUMBER_OR_FLOAT (divisor, 1); + CHECK_NUMBER_OR_FLOAT (divisor); -#ifdef LISP_FLOAT_TYPE if (FLOATP (arg) || FLOATP (divisor)) { double f1, f2; - f1 = FLOATP (arg) ? XFLOAT (arg)->data : XINT (arg); - f2 = (FLOATP (divisor) ? XFLOAT (divisor)->data : XINT (divisor)); + f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XINT (arg); + f2 = (FLOATP (divisor) ? XFLOAT_DATA (divisor) : XINT (divisor)); if (! IEEE_FLOATING_POINT && f2 == 0) Fsignal (Qarith_error, Qnil); @@ -754,7 +762,6 @@ rounding_driver (arg, divisor, double_round, int_round2, name) FLOAT_TO_INT2 (f1, arg, name, arg, divisor); return arg; } -#endif i1 = XINT (arg); i2 = XINT (divisor); @@ -766,15 +773,13 @@ rounding_driver (arg, divisor, double_round, int_round2, name) return arg; } -#ifdef LISP_FLOAT_TYPE if (FLOATP (arg)) { double d; - IN_FLOAT (d = (*double_round) (XFLOAT (arg)->data), name, arg); + IN_FLOAT (d = (*double_round) (XFLOAT_DATA (arg)), name, arg); FLOAT_TO_INT (d, arg, name, arg); } -#endif return arg; } @@ -826,9 +831,13 @@ round2 (i1, i2) return q + (abs_r + (q & 1) <= abs_r1 ? 0 : (i2 ^ r) < 0 ? -1 : 1); } -#ifndef HAVE_RINT +/* The code uses emacs_rint, so that it works to undefine HAVE_RINT + if `rint' exists but does not work right. */ +#ifdef HAVE_RINT +#define emacs_rint rint +#else static double -rint (d) +emacs_rint (d) double d; { return floor (d + 0.5); @@ -843,44 +852,50 @@ double_identity (d) } DEFUN ("ceiling", Fceiling, Sceiling, 1, 2, 0, - "Return the smallest integer no less than ARG. (Round toward +inf.)\n\ -With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR.") - (arg, divisor) + doc: /* Return the smallest integer no less than ARG. +This rounds the value towards +inf. +With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR. */) + (arg, divisor) Lisp_Object arg, divisor; { return rounding_driver (arg, divisor, ceil, ceiling2, "ceiling"); } DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0, - "Return the largest integer no greater than ARG. (Round towards -inf.)\n\ -With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR.") - (arg, divisor) + doc: /* Return the largest integer no greater than ARG. +This rounds the value towards -inf. +With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. */) + (arg, divisor) Lisp_Object arg, divisor; { return rounding_driver (arg, divisor, floor, floor2, "floor"); } DEFUN ("round", Fround, Sround, 1, 2, 0, - "Return the nearest integer to ARG.\n\ -With optional DIVISOR, return the nearest integer to ARG/DIVISOR.") - (arg, divisor) + doc: /* Return the nearest integer to ARG. +With optional DIVISOR, return the nearest integer to ARG/DIVISOR. + +Rounding a value equidistant between two integers may choose the +integer closer to zero, or it may prefer an even integer, depending on +your machine. For example, \(round 2.5\) can return 3 on some +systems, but 2 on others. */) + (arg, divisor) Lisp_Object arg, divisor; { - return rounding_driver (arg, divisor, rint, round2, "round"); + return rounding_driver (arg, divisor, emacs_rint, round2, "round"); } DEFUN ("truncate", Ftruncate, Struncate, 1, 2, 0, - "Truncate a floating point number to an int.\n\ -Rounds ARG toward zero.\n\ -With optional DIVISOR, truncate ARG/DIVISOR.") - (arg, divisor) + doc: /* Truncate a floating point number to an int. +Rounds ARG toward zero. +With optional DIVISOR, truncate ARG/DIVISOR. */) + (arg, divisor) Lisp_Object arg, divisor; { return rounding_driver (arg, divisor, double_identity, truncate2, "truncate"); } -#ifdef LISP_FLOAT_TYPE Lisp_Object fmod_float (x, y) @@ -888,8 +903,8 @@ fmod_float (x, y) { double f1, f2; - f1 = FLOATP (x) ? XFLOAT (x)->data : XINT (x); - f2 = FLOATP (y) ? XFLOAT (y)->data : XINT (y); + f1 = FLOATP (x) ? XFLOAT_DATA (x) : XINT (x); + f2 = FLOATP (y) ? XFLOAT_DATA (y) : XINT (y); if (! IEEE_FLOATING_POINT && f2 == 0) Fsignal (Qarith_error, Qnil); @@ -904,9 +919,9 @@ fmod_float (x, y) /* It's not clear these are worth adding. */ DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0, - "Return the smallest integer no less than ARG, as a float.\n\ -\(Round toward +inf.\)") - (arg) + doc: /* Return the smallest integer no less than ARG, as a float. +\(Round toward +inf.\) */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -915,9 +930,9 @@ DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0, } DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0, - "Return the largest integer no greater than ARG, as a float.\n\ -\(Round towards -inf.\)") - (arg) + doc: /* Return the largest integer no greater than ARG, as a float. +\(Round towards -inf.\) */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -926,19 +941,19 @@ DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0, } DEFUN ("fround", Ffround, Sfround, 1, 1, 0, - "Return the nearest integer to ARG, as a float.") - (arg) + doc: /* Return the nearest integer to ARG, as a float. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); - IN_FLOAT (d = rint (d), "fround", arg); + IN_FLOAT (d = emacs_rint (d), "fround", arg); return make_float (d); } DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0, - "Truncate a floating point number to an integral float value.\n\ -Rounds the value toward zero.") - (arg) + doc: /* Truncate a floating point number to an integral float value. +Rounds the value toward zero. */) + (arg) register Lisp_Object arg; { double d = extract_float (arg); @@ -968,6 +983,7 @@ float_error (signo) signal (SIGILL, float_error); #endif /* BSD_SYSTEM */ + SIGNAL_THREAD_CHECK (signo); in_float = 0; Fsignal (Qarith_error, Fcons (float_error_arg, Qnil)); @@ -979,7 +995,7 @@ float_error (signo) #endif /* FLOAT_CATCH_SIGILL */ #ifdef HAVE_MATHERR -int +int matherr (x) struct exception *x; { @@ -1008,24 +1024,18 @@ matherr (x) } #endif /* HAVE_MATHERR */ +void init_floatfns () { #ifdef FLOAT_CATCH_SIGILL signal (SIGILL, float_error); -#endif +#endif in_float = 0; } -#else /* not LISP_FLOAT_TYPE */ - -init_floatfns () -{} - -#endif /* not LISP_FLOAT_TYPE */ - +void syms_of_floatfns () { -#ifdef LISP_FLOAT_TYPE defsubr (&Sacos); defsubr (&Sasin); defsubr (&Satan); @@ -1063,9 +1073,11 @@ syms_of_floatfns () defsubr (&Sabs); defsubr (&Sfloat); defsubr (&Slogb); -#endif /* LISP_FLOAT_TYPE */ defsubr (&Sceiling); defsubr (&Sfloor); defsubr (&Sround); defsubr (&Struncate); } + +/* arch-tag: be05bf9d-049e-4e31-91b9-e6153d483ae7 + (do not change this comment) */