root/src/floatfns.c

DEFINITIONS

1. CHECK_FLOAT
2. extract_float
3. DEFUN
4. DEFUN
5. DEFUN
6. DEFUN
7. DEFUN
8. DEFUN
9. DEFUN
10. DEFUN
11. DEFUN
12. DEFUN
13. DEFUN
14. DEFUN
15. double_integer_scale
16. rescale_for_division
17. rounding_driver
18. ceiling2
19. floor2
20. truncate2
21. round2
22. rounddiv_q
23. emacs_rint
24. trunc
25. identity
26. fmod_float
27. DEFUN
28. DEFUN
29. DEFUN
30. DEFUN
31. syms_of_floatfns

     1 /* Primitive operations on floating point for GNU Emacs Lisp interpreter.
     2 
     3 Copyright (C) 1988, 1993-1994, 1999, 2001-2023 Free Software Foundation,
     4 Inc.
     5 
     6 Author: Wolfgang Rupprecht (according to ack.texi)
     7 
     8 This file is part of GNU Emacs.
     9 
    10 GNU Emacs is free software: you can redistribute it and/or modify
    11 it under the terms of the GNU General Public License as published by
    12 the Free Software Foundation, either version 3 of the License, or (at
    13 your option) any later version.
    14 
    15 GNU Emacs is distributed in the hope that it will be useful,
    16 but WITHOUT ANY WARRANTY; without even the implied warranty of
    17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    18 GNU General Public License for more details.
    19 
    20 You should have received a copy of the GNU General Public License
    21 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
    22 
    23 
    24 /* C89 requires only the following math.h functions, and Emacs omits
    25    the starred functions since we haven't found a use for them:
    26    acos, asin, atan, atan2, ceil, cos, *cosh, exp, fabs, floor, fmod,
    27    frexp, ldexp, log, log10 [via (log X 10)], *modf, pow, sin, *sinh,
    28    sqrt, tan, *tanh.
    29 
    30    C99, C11 and C17 require the following math.h functions in addition to
    31    the C89 functions.  Of these, Emacs currently exports only the
    32    starred ones to Lisp, since we haven't found a use for the others.
    33    Also, it uses the ones marked "+" internally:
    34    acosh, atanh, cbrt, copysign (implemented by signbit), erf, erfc,
    35    exp2, expm1, fdim, fma, fmax, fmin, fpclassify, hypot, +ilogb,
    36    +isfinite, isgreater, isgreaterequal, +isinf, isless, islessequal,
    37    islessgreater, *isnan, isnormal, isunordered, lgamma, log1p, *log2
    38    [via (log X 2)], logb (approximately; implemented by frexp),
    39    +lrint/llrint, +lround/llround, nan, nearbyint, nextafter,
    40    nexttoward, remainder, remquo, *rint, round, scalbln, +scalbn,
    41    +signbit, tgamma, *trunc.
    42 
    43    C23 requires many more math.h functions.  Emacs does not yet export
    44    or use them.
    45 
    46    The C standard also requires functions for float and long double
    47    that are not listed above.  Of these functions, Emacs uses only the
    48    following internally: fabsf, powf, sprintf.
    49  */
    50 
    51 #include <config.h>
    52 
    53 #include "lisp.h"
    54 #include "bignum.h"
    55 
    56 #include <math.h>
    57 
    58 /* Emacs needs proper handling of +/-inf; correct printing as well as
    59    important packages depend on it.  Make sure the user didn't specify
    60    -ffinite-math-only, either directly or implicitly with -Ofast or
    61    -ffast-math.  */
    62 #if defined __FINITE_MATH_ONLY__ && __FINITE_MATH_ONLY__
    63  #error Emacs cannot be built with -ffinite-math-only
    64 #endif
    65 
    66 /* Check that X is a floating point number.  */
    67 
    68 static void
    69 CHECK_FLOAT (Lisp_Object x)
    70 {
    71   CHECK_TYPE (FLOATP (x), Qfloatp, x);
    72 }
    73 
    74 /* Extract a Lisp number as a `double', or signal an error.  */
    75 
    76 double
    77 extract_float (Lisp_Object num)
    78 {
    79   CHECK_NUMBER (num);
    80   return XFLOATINT (num);
    81 }
    82 
    83 /* Trig functions.  */
    84 
    85 DEFUN ("acos", Facos, Sacos, 1, 1, 0,
    86        doc: /* Return the inverse cosine of ARG.  */)
    87   (Lisp_Object arg)
    88 {
    89   double d = extract_float (arg);
    90   d = acos (d);
    91   return make_float (d);
    92 }
    93 
    94 DEFUN ("asin", Fasin, Sasin, 1, 1, 0,
    95        doc: /* Return the inverse sine of ARG.  */)
    96   (Lisp_Object arg)
    97 {
    98   double d = extract_float (arg);
    99   d = asin (d);
   100   return make_float (d);
   101 }
   102 
   103 DEFUN ("atan", Fatan, Satan, 1, 2, 0,
   104        doc: /* Return the inverse tangent of the arguments.
   105 If only one argument Y is given, return the inverse tangent of Y.
   106 If two arguments Y and X are given, return the inverse tangent of Y
   107 divided by X, i.e. the angle in radians between the vector (X, Y)
   108 and the x-axis.  */)
   109   (Lisp_Object y, Lisp_Object x)
   110 {
   111   double d = extract_float (y);
   112 
   113   if (NILP (x))
   114     d = atan (d);
   115   else
   116     {
   117       double d2 = extract_float (x);
   118       d = atan2 (d, d2);
   119     }
   120   return make_float (d);
   121 }
   122 
   123 DEFUN ("cos", Fcos, Scos, 1, 1, 0,
   124        doc: /* Return the cosine of ARG.  */)
   125   (Lisp_Object arg)
   126 {
   127   double d = extract_float (arg);
   128   d = cos (d);
   129   return make_float (d);
   130 }
   131 
   132 DEFUN ("sin", Fsin, Ssin, 1, 1, 0,
   133        doc: /* Return the sine of ARG.  */)
   134   (Lisp_Object arg)
   135 {
   136   double d = extract_float (arg);
   137   d = sin (d);
   138   return make_float (d);
   139 }
   140 
   141 DEFUN ("tan", Ftan, Stan, 1, 1, 0,
   142        doc: /* Return the tangent of ARG.  */)
   143   (Lisp_Object arg)
   144 {
   145   double d = extract_float (arg);
   146   d = tan (d);
   147   return make_float (d);
   148 }
   149 
   150 DEFUN ("isnan", Fisnan, Sisnan, 1, 1, 0,
   151        doc: /* Return non-nil if argument X is a NaN.  */)
   152   (Lisp_Object x)
   153 {
   154   CHECK_FLOAT (x);
   155   return isnan (XFLOAT_DATA (x)) ? Qt : Qnil;
   156 }
   157 
   158 /* Although the substitute does not work on NaNs, it is good enough
   159    for platforms lacking the signbit macro.  */
   160 #ifndef signbit
   161 # define signbit(x) ((x) < 0 || (IEEE_FLOATING_POINT && !(x) && 1 / (x) < 0))
   162 #endif
   163 
   164 DEFUN ("copysign", Fcopysign, Scopysign, 2, 2, 0,
   165        doc: /* Copy sign of X2 to value of X1, and return the result.
   166 Cause an error if X1 or X2 is not a float.  */)
   167   (Lisp_Object x1, Lisp_Object x2)
   168 {
   169   double f1, f2;
   170 
   171   CHECK_FLOAT (x1);
   172   CHECK_FLOAT (x2);
   173 
   174   f1 = XFLOAT_DATA (x1);
   175   f2 = XFLOAT_DATA (x2);
   176 
   177   /* Use signbit instead of copysign, to avoid calling make_float when
   178      the result is X1.  */
   179   return signbit (f1) != signbit (f2) ? make_float (-f1) : x1;
   180 }
   181 
   182 DEFUN ("frexp", Ffrexp, Sfrexp, 1, 1, 0,
   183        doc: /* Get significand and exponent of a floating point number.
   184 Breaks the floating point number X into its binary significand SGNFCAND
   185 \(a floating point value between 0.5 (included) and 1.0 (excluded))
   186 and an integral exponent EXP for 2, such that:
   187 
   188   X = SGNFCAND * 2^EXP
   189 
   190 The function returns the cons cell (SGNFCAND . EXP).
   191 If X is zero, both parts (SGNFCAND and EXP) are zero.  */)
   192   (Lisp_Object x)
   193 {
   194   double f = extract_float (x);
   195   int exponent;
   196   double sgnfcand = frexp (f, &exponent);
   197   return Fcons (make_float (sgnfcand), make_fixnum (exponent));
   198 }
   199 
   200 DEFUN ("ldexp", Fldexp, Sldexp, 2, 2, 0,
   201        doc: /* Return SGNFCAND * 2**EXPONENT, as a floating point number.
   202 EXPONENT must be an integer.   */)
   203   (Lisp_Object sgnfcand, Lisp_Object exponent)
   204 {
   205   CHECK_FIXNUM (exponent);
   206   int e = min (max (INT_MIN, XFIXNUM (exponent)), INT_MAX);
   207   return make_float (ldexp (extract_float (sgnfcand), e));
   208 }
   209 
   210 DEFUN ("exp", Fexp, Sexp, 1, 1, 0,
   211        doc: /* Return the exponential base e of ARG.  */)
   212   (Lisp_Object arg)
   213 {
   214   double d = extract_float (arg);
   215   d = exp (d);
   216   return make_float (d);
   217 }
   218 
   219 DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
   220        doc: /* Return the exponential ARG1 ** ARG2.  */)
   221   (Lisp_Object arg1, Lisp_Object arg2)
   222 {
   223   CHECK_NUMBER (arg1);
   224   CHECK_NUMBER (arg2);
   225 
   226   /* Common Lisp spec: don't promote if both are integers, and if the
   227      result is not fractional.  */
   228   if (INTEGERP (arg1) && !NILP (Fnatnump (arg2)))
   229     return expt_integer (arg1, arg2);
   230 
   231   return make_float (pow (XFLOATINT (arg1), XFLOATINT (arg2)));
   232 }
   233 
   234 DEFUN ("log", Flog, Slog, 1, 2, 0,
   235        doc: /* Return the natural logarithm of ARG.
   236 If the optional argument BASE is given, return log ARG using that base.  */)
   237   (Lisp_Object arg, Lisp_Object base)
   238 {
   239   double d = extract_float (arg);
   240 
   241   if (NILP (base))
   242     d = log (d);
   243   else
   244     {
   245       double b = extract_float (base);
   246 
   247       if (b == 10.0)
   248         d = log10 (d);
   249 #if HAVE_LOG2
   250       else if (b == 2.0)
   251         d = log2 (d);
   252 #endif
   253       else
   254         d = log (d) / log (b);
   255     }
   256   return make_float (d);
   257 }
   258 
   259 DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0,
   260        doc: /* Return the square root of ARG.  */)
   261   (Lisp_Object arg)
   262 {
   263   double d = extract_float (arg);
   264   d = sqrt (d);
   265   return make_float (d);
   266 }
   267 
   268 DEFUN ("abs", Fabs, Sabs, 1, 1, 0,
   269        doc: /* Return the absolute value of ARG.  */)
   270   (Lisp_Object arg)
   271 {
   272   CHECK_NUMBER (arg);
   273 
   274   if (FIXNUMP (arg))
   275     {
   276       if (XFIXNUM (arg) < 0)
   277         arg = make_int (-XFIXNUM (arg));
   278     }
   279   else if (FLOATP (arg))
   280     {
   281       if (signbit (XFLOAT_DATA (arg)))
   282         arg = make_float (- XFLOAT_DATA (arg));
   283     }
   284   else
   285     {
   286       if (mpz_sgn (*xbignum_val (arg)) < 0)
   287         {
   288           mpz_neg (mpz[0], *xbignum_val (arg));
   289           arg = make_integer_mpz ();
   290         }
   291     }
   292 
   293   return arg;
   294 }
   295 
   296 DEFUN ("float", Ffloat, Sfloat, 1, 1, 0,
   297        doc: /* Return the floating point number equal to ARG.  */)
   298   (register Lisp_Object arg)
   299 {
   300   CHECK_NUMBER (arg);
   301   /* If ARG is a float, give 'em the same float back.  */
   302   return FLOATP (arg) ? arg : make_float (XFLOATINT (arg));
   303 }
   304 
   305 DEFUN ("logb", Flogb, Slogb, 1, 1, 0,
   306        doc: /* Returns largest integer <= the base 2 log of the magnitude of ARG.
   307 This is the same as the exponent of a float.  */)
   308   (Lisp_Object arg)
   309 {
   310   EMACS_INT value;
   311   CHECK_NUMBER (arg);
   312 
   313   if (FLOATP (arg))
   314     {
   315       double f = XFLOAT_DATA (arg);
   316       if (f == 0)
   317         return make_float (-HUGE_VAL);
   318       if (!isfinite (f))
   319         return f < 0 ? make_float (-f) : arg;
   320       int ivalue;
   321       frexp (f, &ivalue);
   322       value = ivalue - 1;
   323     }
   324   else if (!FIXNUMP (arg))
   325     value = mpz_sizeinbase (*xbignum_val (arg), 2) - 1;
   326   else
   327     {
   328       EMACS_INT i = XFIXNUM (arg);
   329       if (i == 0)
   330         return make_float (-HUGE_VAL);
   331       value = elogb (eabs (i));
   332     }
   333 
   334   return make_fixnum (value);
   335 }
   336 
   337 /* Return the integer exponent E such that D * FLT_RADIX**E (i.e.,
   338    scalbn (D, E)) is an integer that has precision equal to D and is
   339    representable as a double.
   340 
   341    Return DBL_MANT_DIG - DBL_MIN_EXP (the maximum possible valid
   342    scale) if D is zero or tiny.  Return one greater than that if
   343    D is infinite, and two greater than that if D is a NaN.  */
   344 
   345 int
   346 double_integer_scale (double d)
   347 {
   348   int exponent = ilogb (d);
   349 #ifdef HAIKU
   350   /* On Haiku, the values returned by ilogb are nonsensical when
   351      confronted with tiny numbers, inf, or NaN, which breaks the trick
   352      used by code on other platforms, so we have to test for each case
   353      manually, and return the appropriate value.  */
   354   if (exponent == FP_ILOGB0)
   355     {
   356       if (isnan (d))
   357         return (DBL_MANT_DIG - DBL_MIN_EXP) + 2;
   358       if (isinf (d))
   359         return (DBL_MANT_DIG - DBL_MIN_EXP) + 1;
   360 
   361       return (DBL_MANT_DIG - DBL_MIN_EXP);
   362     }
   363 #endif
   364   return (DBL_MIN_EXP - 1 <= exponent && exponent < INT_MAX
   365           ? DBL_MANT_DIG - 1 - exponent
   366           : (DBL_MANT_DIG - DBL_MIN_EXP
   367              + (isnan (d) ? 2 : exponent == INT_MAX)));
   368 }
   369 
   370 /* Convert the Lisp number N to an integer and return a pointer to the
   371    converted integer, represented as an mpz_t *.  Use *T as a
   372    temporary; the returned value might be T.  Scale N by the maximum
   373    of NSCALE and DSCALE while converting.  If NSCALE is nonzero, N
   374    must be a float; signal an overflow if NSCALE is greater than
   375    DBL_MANT_DIG - DBL_MIN_EXP, otherwise scalbn (XFLOAT_DATA (N), NSCALE)
   376    must return an integer value, without rounding or overflow.  */
   377 
   378 static mpz_t const *
   379 rescale_for_division (Lisp_Object n, mpz_t *t, int nscale, int dscale)
   380 {
   381   mpz_t const *pn;
   382 
   383   if (FLOATP (n))
   384     {
   385       if (DBL_MANT_DIG - DBL_MIN_EXP < nscale)
   386         overflow_error ();
   387       mpz_set_d (*t, scalbn (XFLOAT_DATA (n), nscale));
   388       pn = t;
   389     }
   390   else
   391     pn = bignum_integer (t, n);
   392 
   393   if (nscale < dscale)
   394     {
   395       emacs_mpz_mul_2exp (*t, *pn, (dscale - nscale) * LOG2_FLT_RADIX);
   396       pn = t;
   397     }
   398   return pn;
   399 }
   400 
   401 /* the rounding functions  */
   402 
   403 static Lisp_Object
   404 rounding_driver (Lisp_Object n, Lisp_Object d,
   405                  double (*double_round) (double),
   406                  void (*int_divide) (mpz_t, mpz_t const, mpz_t const),
   407                  EMACS_INT (*fixnum_divide) (EMACS_INT, EMACS_INT))
   408 {
   409   CHECK_NUMBER (n);
   410 
   411   if (NILP (d))
   412     return FLOATP (n) ? double_to_integer (double_round (XFLOAT_DATA (n))) : n;
   413 
   414   CHECK_NUMBER (d);
   415 
   416   int dscale = 0;
   417   if (FIXNUMP (d))
   418     {
   419       if (XFIXNUM (d) == 0)
   420         xsignal0 (Qarith_error);
   421 
   422       /* Divide fixnum by fixnum specially, for speed.  */
   423       if (FIXNUMP (n))
   424         return make_int (fixnum_divide (XFIXNUM (n), XFIXNUM (d)));
   425     }
   426   else if (FLOATP (d))
   427     {
   428       if (XFLOAT_DATA (d) == 0)
   429         xsignal0 (Qarith_error);
   430       dscale = double_integer_scale (XFLOAT_DATA (d));
   431     }
   432 
   433   int nscale = FLOATP (n) ? double_integer_scale (XFLOAT_DATA (n)) : 0;
   434 
   435   /* If the numerator is finite and the denominator infinite, the
   436      quotient is zero and there is no need to try the impossible task
   437      of rescaling the denominator.  */
   438   if (dscale == DBL_MANT_DIG - DBL_MIN_EXP + 1 && nscale < dscale)
   439     return make_fixnum (0);
   440 
   441   int_divide (mpz[0],
   442               *rescale_for_division (n, &mpz[0], nscale, dscale),
   443               *rescale_for_division (d, &mpz[1], dscale, nscale));
   444   return make_integer_mpz ();
   445 }
   446 
   447 static EMACS_INT
   448 ceiling2 (EMACS_INT n, EMACS_INT d)
   449 {
   450   return n / d + ((n % d != 0) & ((n < 0) == (d < 0)));
   451 }
   452 
   453 static EMACS_INT
   454 floor2 (EMACS_INT n, EMACS_INT d)
   455 {
   456   return n / d - ((n % d != 0) & ((n < 0) != (d < 0)));
   457 }
   458 
   459 static EMACS_INT
   460 truncate2 (EMACS_INT n, EMACS_INT d)
   461 {
   462   return n / d;
   463 }
   464 
   465 static EMACS_INT
   466 round2 (EMACS_INT n, EMACS_INT d)
   467 {
   468   /* The C language's division operator gives us the remainder R
   469      corresponding to truncated division, but we want the remainder R1
   470      on the other side of 0 if R1 is closer to 0 than R is; because we
   471      want to round to even, we also want R1 if R and R1 are the same
   472      distance from 0 and if the truncated quotient is odd.  */
   473   EMACS_INT q = n / d;
   474   EMACS_INT r = n % d;
   475   bool neg_d = d < 0;
   476   bool neg_r = r < 0;
   477   EMACS_INT abs_r = eabs (r);
   478   EMACS_INT abs_r1 = eabs (d) - abs_r;
   479   if (abs_r1 < abs_r + (q & 1))
   480     q += neg_d == neg_r ? 1 : -1;
   481   return q;
   482 }
   483 
   484 static void
   485 rounddiv_q (mpz_t q, mpz_t const n, mpz_t const d)
   486 {
   487   /* Mimic the source code of round2, using mpz_t instead of EMACS_INT.  */
   488   mpz_t *r = &mpz[2], *abs_r = r, *abs_r1 = &mpz[3];
   489   mpz_tdiv_qr (q, *r, n, d);
   490   bool neg_d = mpz_sgn (d) < 0;
   491   bool neg_r = mpz_sgn (*r) < 0;
   492   mpz_abs (*abs_r, *r);
   493   mpz_abs (*abs_r1, d);
   494   mpz_sub (*abs_r1, *abs_r1, *abs_r);
   495   if (mpz_cmp (*abs_r1, *abs_r) < (mpz_odd_p (q) != 0))
   496     (neg_d == neg_r ? mpz_add_ui : mpz_sub_ui) (q, q, 1);
   497 }
   498 
   499 /* The code uses emacs_rint, so that it works to undefine HAVE_RINT
   500    if `rint' exists but does not work right.  */
   501 #ifdef HAVE_RINT
   502 #define emacs_rint rint
   503 #else
   504 static double
   505 emacs_rint (double d)
   506 {
   507   double d1 = d + 0.5;
   508   double r = floor (d1);
   509   return r - (r == d1 && fmod (r, 2) != 0);
   510 }
   511 #endif
   512 
   513 #ifndef HAVE_TRUNC
   514 double
   515 trunc (double d)
   516 {
   517   return (d < 0 ? ceil : floor) (d);
   518 }
   519 #endif
   520 
   521 DEFUN ("ceiling", Fceiling, Sceiling, 1, 2, 0,
   522        doc: /* Return the smallest integer no less than ARG.
   523 This rounds the value towards +inf.
   524 With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR.  */)
   525   (Lisp_Object arg, Lisp_Object divisor)
   526 {
   527   return rounding_driver (arg, divisor, ceil, mpz_cdiv_q, ceiling2);
   528 }
   529 
   530 DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0,
   531        doc: /* Return the largest integer no greater than ARG.
   532 This rounds the value towards -inf.
   533 With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR.  */)
   534   (Lisp_Object arg, Lisp_Object divisor)
   535 {
   536   return rounding_driver (arg, divisor, floor, mpz_fdiv_q, floor2);
   537 }
   538 
   539 DEFUN ("round", Fround, Sround, 1, 2, 0,
   540        doc: /* Return the nearest integer to ARG.
   541 With optional DIVISOR, return the nearest integer to ARG/DIVISOR.
   542 
   543 Rounding a value equidistant between two integers may choose the
   544 integer closer to zero, or it may prefer an even integer, depending on
   545 your machine.  For example, (round 2.5) can return 3 on some
   546 systems, but 2 on others.  */)
   547   (Lisp_Object arg, Lisp_Object divisor)
   548 {
   549   return rounding_driver (arg, divisor, emacs_rint, rounddiv_q, round2);
   550 }
   551 
   552 /* Since rounding_driver truncates anyway, no need to call 'trunc'.  */
   553 static double
   554 identity (double x)
   555 {
   556   return x;
   557 }
   558 
   559 DEFUN ("truncate", Ftruncate, Struncate, 1, 2, 0,
   560        doc: /* Truncate a floating point number to an int.
   561 Rounds ARG toward zero.
   562 With optional DIVISOR, truncate ARG/DIVISOR.  */)
   563   (Lisp_Object arg, Lisp_Object divisor)
   564 {
   565   return rounding_driver (arg, divisor, identity, mpz_tdiv_q, truncate2);
   566 }
   567 
   568 
   569 Lisp_Object
   570 fmod_float (Lisp_Object x, Lisp_Object y)
   571 {
   572   double f1 = XFLOATINT (x);
   573   double f2 = XFLOATINT (y);
   574 
   575   f1 = fmod (f1, f2);
   576 
   577   /* If the "remainder" comes out with the wrong sign, fix it.  */
   578   if (f2 < 0 ? f1 > 0 : f1 < 0)
   579     f1 += f2;
   580 
   581   return make_float (f1);
   582 }
   583 
   584 DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0,
   585        doc: /* Return the smallest integer no less than ARG, as a float.
   586 \(Round toward +inf.)  */)
   587   (Lisp_Object arg)
   588 {
   589   CHECK_FLOAT (arg);
   590   double d = XFLOAT_DATA (arg);
   591   d = ceil (d);
   592   return make_float (d);
   593 }
   594 
   595 DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0,
   596        doc: /* Return the largest integer no greater than ARG, as a float.
   597 \(Round toward -inf.)  */)
   598   (Lisp_Object arg)
   599 {
   600   CHECK_FLOAT (arg);
   601   double d = XFLOAT_DATA (arg);
   602   d = floor (d);
   603   return make_float (d);
   604 }
   605 
   606 DEFUN ("fround", Ffround, Sfround, 1, 1, 0,
   607        doc: /* Return the nearest integer to ARG, as a float.  */)
   608   (Lisp_Object arg)
   609 {
   610   CHECK_FLOAT (arg);
   611   double d = XFLOAT_DATA (arg);
   612   d = emacs_rint (d);
   613   return make_float (d);
   614 }
   615 
   616 DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0,
   617        doc: /* Truncate a floating point number to an integral float value.
   618 \(Round toward zero.)  */)
   619   (Lisp_Object arg)
   620 {
   621   CHECK_FLOAT (arg);
   622   double d = XFLOAT_DATA (arg);
   623   d = trunc (d);
   624   return make_float (d);
   625 }
   626 
   627 void
   628 syms_of_floatfns (void)
   629 {
   630   defsubr (&Sacos);
   631   defsubr (&Sasin);
   632   defsubr (&Satan);
   633   defsubr (&Scos);
   634   defsubr (&Ssin);
   635   defsubr (&Stan);
   636   defsubr (&Sisnan);
   637   defsubr (&Scopysign);
   638   defsubr (&Sfrexp);
   639   defsubr (&Sldexp);
   640   defsubr (&Sfceiling);
   641   defsubr (&Sffloor);
   642   defsubr (&Sfround);
   643   defsubr (&Sftruncate);
   644   defsubr (&Sexp);
   645   defsubr (&Sexpt);
   646   defsubr (&Slog);
   647   defsubr (&Ssqrt);
   648 
   649   defsubr (&Sabs);
   650   defsubr (&Sfloat);
   651   defsubr (&Slogb);
   652   defsubr (&Sceiling);
   653   defsubr (&Sfloor);
   654   defsubr (&Sround);
   655   defsubr (&Struncate);
   656 }