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