src/floatfns.c

   1 /* Primitive operations on floating point for GNU Emacs Lisp interpreter.
   2
   3 Copyright (C) 1988, 1993-1994, 1999, 2001-2012
   4   Free Software Foundation, Inc.
   5
   6 Author: Wolfgang Rupprecht
   7 (according to ack.texi)
   8
   9 This file is part of GNU Emacs.
  10
  11 GNU Emacs is free software: you can redistribute it and/or modify
  12 it under the terms of the GNU General Public License as published by
  13 the Free Software Foundation, either version 3 of the License, or
  14 (at your option) any later version.
  15
  16 GNU Emacs is distributed in the hope that it will be useful,
  17 but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 GNU General Public License for more details.
  20
  21 You should have received a copy of the GNU General Public License
  22 along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
  23
  24
  25 /* C89 requires only these math.h functions:
  26    acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod,
  27    frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh.
  28  */
  29
  30 #include <config.h>
  31 #include <setjmp.h>
  32 #include "lisp.h"
  33 #include "syssignal.h"
  34
  35 #include <float.h>
  36 #if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
  37      && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
  38 #define IEEE_FLOATING_POINT 1
  39 #else
  40 #define IEEE_FLOATING_POINT 0
  41 #endif
  42
  43 #include <math.h>
  44
  45 /* This declaration is omitted on some systems, like Ultrix.  */
  46 #if !defined (HPUX) && defined (HAVE_LOGB) && !defined (logb)
  47 extern double logb (double);
  48 #endif /* not HPUX and HAVE_LOGB and no logb macro */
  49
  50 /* Extract a Lisp number as a `double', or signal an error.  */
  51
  52 double
  53 extract_float (Lisp_Object num)
  54 {
  55   CHECK_NUMBER_OR_FLOAT (num);
  56
  57   if (FLOATP (num))
  58     return XFLOAT_DATA (num);
  59   return (double) XINT (num);
  60 }
  61 \f
  62 /* Trig functions.  */
  63
  64 DEFUN ("acos", Facos, Sacos, 1, 1, 0,
  65        doc: /* Return the inverse cosine of ARG.  */)
  66   (Lisp_Object arg)
  67 {
  68   double d = extract_float (arg);
  69   d = acos (d);
  70   return make_float (d);
  71 }
  72
  73 DEFUN ("asin", Fasin, Sasin, 1, 1, 0,
  74        doc: /* Return the inverse sine of ARG.  */)
  75   (Lisp_Object arg)
  76 {
  77   double d = extract_float (arg);
  78   d = asin (d);
  79   return make_float (d);
  80 }
  81
  82 DEFUN ("atan", Fatan, Satan, 1, 2, 0,
  83        doc: /* Return the inverse tangent of the arguments.
  84 If only one argument Y is given, return the inverse tangent of Y.
  85 If two arguments Y and X are given, return the inverse tangent of Y
  86 divided by X, i.e. the angle in radians between the vector (X, Y)
  87 and the x-axis.  */)
  88   (Lisp_Object y, Lisp_Object x)
  89 {
  90   double d = extract_float (y);
  91
  92   if (NILP (x))
  93     d = atan (d);
  94   else
  95     {
  96       double d2 = extract_float (x);
  97       d = atan2 (d, d2);
  98     }
  99   return make_float (d);
 100 }
 101
 102 DEFUN ("cos", Fcos, Scos, 1, 1, 0,
 103        doc: /* Return the cosine of ARG.  */)
 104   (Lisp_Object arg)
 105 {
 106   double d = extract_float (arg);
 107   d = cos (d);
 108   return make_float (d);
 109 }
 110
 111 DEFUN ("sin", Fsin, Ssin, 1, 1, 0,
 112        doc: /* Return the sine of ARG.  */)
 113   (Lisp_Object arg)
 114 {
 115   double d = extract_float (arg);
 116   d = sin (d);
 117   return make_float (d);
 118 }
 119
 120 DEFUN ("tan", Ftan, Stan, 1, 1, 0,
 121        doc: /* Return the tangent of ARG.  */)
 122   (Lisp_Object arg)
 123 {
 124   double d = extract_float (arg);
 125   d = tan (d);
 126   return make_float (d);
 127 }
 128
 129 #undef isnan
 130 #define isnan(x) ((x) != (x))
 131
 132 DEFUN ("isnan", Fisnan, Sisnan, 1, 1, 0,
 133        doc: /* Return non nil iff argument X is a NaN.  */)
 134   (Lisp_Object x)
 135 {
 136   CHECK_FLOAT (x);
 137   return isnan (XFLOAT_DATA (x)) ? Qt : Qnil;
 138 }
 139
 140 #ifdef HAVE_COPYSIGN
 141 DEFUN ("copysign", Fcopysign, Scopysign, 2, 2, 0,
 142        doc: /* Copy sign of X2 to value of X1, and return the result.
 143 Cause an error if X1 or X2 is not a float.  */)
 144   (Lisp_Object x1, Lisp_Object x2)
 145 {
 146   double f1, f2;
 147
 148   CHECK_FLOAT (x1);
 149   CHECK_FLOAT (x2);
 150
 151   f1 = XFLOAT_DATA (x1);
 152   f2 = XFLOAT_DATA (x2);
 153
 154   return make_float (copysign (f1, f2));
 155 }
 156
 157 DEFUN ("frexp", Ffrexp, Sfrexp, 1, 1, 0,
 158        doc: /* Get significand and exponent of a floating point number.
 159 Breaks the floating point number X into its binary significand SGNFCAND
 160 \(a floating point value between 0.5 (included) and 1.0 (excluded))
 161 and an integral exponent EXP for 2, such that:
 162
 163   X = SGNFCAND * 2^EXP
 164
 165 The function returns the cons cell (SGNFCAND . EXP).
 166 If X is zero, both parts (SGNFCAND and EXP) are zero.  */)
 167   (Lisp_Object x)
 168 {
 169   double f = XFLOATINT (x);
 170
 171   if (f == 0.0)
 172     return Fcons (make_float (0.0), make_number (0));
 173   else
 174     {
 175       int exponent;
 176       double sgnfcand = frexp (f, &exponent);
 177       return Fcons (make_float (sgnfcand), make_number (exponent));
 178     }
 179 }
 180
 181 DEFUN ("ldexp", Fldexp, Sldexp, 1, 2, 0,
 182        doc: /* Construct number X from significand SGNFCAND and exponent EXP.
 183 Returns the floating point value resulting from multiplying SGNFCAND
 184 (the significand) by 2 raised to the power of EXP (the exponent).   */)
 185   (Lisp_Object sgnfcand, Lisp_Object exponent)
 186 {
 187   CHECK_NUMBER (exponent);
 188   return make_float (ldexp (XFLOATINT (sgnfcand), XINT (exponent)));
 189 }
 190 #endif
 191 \f
 192 #if 0 /* Leave these out unless we find there's a reason for them.  */
 193
 194 DEFUN ("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
 203 DEFUN ("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
 212 DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0,
 213        doc: /* Return the order N bessel function output jn of ARG.
 214 The 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
 224 DEFUN ("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
 233 DEFUN ("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
 242 DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0,
 243        doc: /* Return the order N bessel function output yn of ARG.
 244 The 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 \f
 256 #if 0 /* Leave these out unless we see they are worth having.  */
 257
 258 DEFUN ("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
 267 DEFUN ("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
 276 DEFUN ("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
 285 DEFUN ("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 \f
 303 DEFUN ("exp", Fexp, Sexp, 1, 1, 0,
 304        doc: /* Return the exponential base e of ARG.  */)
 305   (Lisp_Object arg)
 306 {
 307   double d = extract_float (arg);
 308   d = exp (d);
 309   return make_float (d);
 310 }
 311
 312 DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
 313        doc: /* Return the exponential ARG1 ** ARG2.  */)
 314   (Lisp_Object arg1, Lisp_Object arg2)
 315 {
 316   double f1, f2, f3;
 317
 318   CHECK_NUMBER_OR_FLOAT (arg1);
 319   CHECK_NUMBER_OR_FLOAT (arg2);
 320   if (INTEGERP (arg1)     /* common lisp spec */
 321       && INTEGERP (arg2)   /* don't promote, if both are ints, and */
 322       && 0 <= XINT (arg2)) /* we are sure the result is not fractional */
 323     {                           /* this can be improved by pre-calculating */
 324       EMACS_INT y;              /* some binary powers of x then accumulating */
 325       EMACS_UINT acc, x;  /* Unsigned so that overflow is well defined.  */
 326       Lisp_Object val;
 327
 328       x = XINT (arg1);
 329       y = XINT (arg2);
 330       acc = (y & 1 ? x : 1);
 331
 332       while ((y >>= 1) != 0)
 333         {
 334           x *= x;
 335           if (y & 1)
 336             acc *= x;
 337         }
 338       XSETINT (val, acc);
 339       return val;
 340     }
 341   f1 = FLOATP (arg1) ? XFLOAT_DATA (arg1) : XINT (arg1);
 342   f2 = FLOATP (arg2) ? XFLOAT_DATA (arg2) : XINT (arg2);
 343   f3 = pow (f1, f2);
 344   return make_float (f3);
 345 }
 346
 347 DEFUN ("log", Flog, Slog, 1, 2, 0,
 348        doc: /* Return the natural logarithm of ARG.
 349 If the optional argument BASE is given, return log ARG using that base.  */)
 350   (Lisp_Object arg, Lisp_Object base)
 351 {
 352   double d = extract_float (arg);
 353
 354   if (NILP (base))
 355     d = log (d);
 356   else
 357     {
 358       double b = extract_float (base);
 359
 360       if (b == 10.0)
 361         d = log10 (d);
 362       else
 363         d = log (d) / log (b);
 364     }
 365   return make_float (d);
 366 }
 367
 368 DEFUN ("log10", Flog10, Slog10, 1, 1, 0,
 369        doc: /* Return the logarithm base 10 of ARG.  */)
 370   (Lisp_Object arg)
 371 {
 372   double d = extract_float (arg);
 373   d = log10 (d);
 374   return make_float (d);
 375 }
 376
 377 DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0,
 378        doc: /* Return the square root of ARG.  */)
 379   (Lisp_Object arg)
 380 {
 381   double d = extract_float (arg);
 382   d = sqrt (d);
 383   return make_float (d);
 384 }
 385 \f
 386 #if 0 /* Not clearly worth adding.  */
 387
 388 DEFUN ("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
 397 DEFUN ("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
 406 DEFUN ("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
 415 DEFUN ("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
 424 DEFUN ("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
 433 DEFUN ("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 \f
 443 DEFUN ("abs", Fabs, Sabs, 1, 1, 0,
 444        doc: /* Return the absolute value of ARG.  */)
 445   (register Lisp_Object arg)
 446 {
 447   CHECK_NUMBER_OR_FLOAT (arg);
 448
 449   if (FLOATP (arg))
 450     arg = make_float (fabs (XFLOAT_DATA (arg)));
 451   else if (XINT (arg) < 0)
 452     XSETINT (arg, - XINT (arg));
 453
 454   return arg;
 455 }
 456
 457 DEFUN ("float", Ffloat, Sfloat, 1, 1, 0,
 458        doc: /* Return the floating point number equal to ARG.  */)
 459   (register Lisp_Object arg)
 460 {
 461   CHECK_NUMBER_OR_FLOAT (arg);
 462
 463   if (INTEGERP (arg))
 464     return make_float ((double) XINT (arg));
 465   else                          /* give 'em the same float back */
 466     return arg;
 467 }
 468
 469 DEFUN ("logb", Flogb, Slogb, 1, 1, 0,
 470        doc: /* Returns largest integer <= the base 2 log of the magnitude of ARG.
 471 This is the same as the exponent of a float.  */)
 472   (Lisp_Object arg)
 473 {
 474   Lisp_Object val;
 475   EMACS_INT value;
 476   double f = extract_float (arg);
 477
 478   if (f == 0.0)
 479     value = MOST_NEGATIVE_FIXNUM;
 480   else
 481     {
 482 #ifdef HAVE_LOGB
 483       value = logb (f);
 484 #else
 485       int ivalue;
 486       frexp (f, &ivalue);
 487       value = ivalue - 1;
 488 #endif
 489     }
 490   XSETINT (val, value);
 491   return val;
 492 }
 493
 494
 495 /* the rounding functions  */
 496
 497 static Lisp_Object
 498 rounding_driver (Lisp_Object arg, Lisp_Object divisor,
 499                  double (*double_round) (double),
 500                  EMACS_INT (*int_round2) (EMACS_INT, EMACS_INT),
 501                  const char *name)
 502 {
 503   CHECK_NUMBER_OR_FLOAT (arg);
 504
 505   if (! NILP (divisor))
 506     {
 507       EMACS_INT i1, i2;
 508
 509       CHECK_NUMBER_OR_FLOAT (divisor);
 510
 511       if (FLOATP (arg) || FLOATP (divisor))
 512         {
 513           double f1, f2;
 514
 515           f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XINT (arg);
 516           f2 = (FLOATP (divisor) ? XFLOAT_DATA (divisor) : XINT (divisor));
 517           if (! IEEE_FLOATING_POINT && f2 == 0)
 518             xsignal0 (Qarith_error);
 519
 520           f1 = (*double_round) (f1 / f2);
 521           if (FIXNUM_OVERFLOW_P (f1))
 522             xsignal3 (Qrange_error, build_string (name), arg, divisor);
 523           arg = make_number (f1);
 524           return arg;
 525         }
 526
 527       i1 = XINT (arg);
 528       i2 = XINT (divisor);
 529
 530       if (i2 == 0)
 531         xsignal0 (Qarith_error);
 532
 533       XSETINT (arg, (*int_round2) (i1, i2));
 534       return arg;
 535     }
 536
 537   if (FLOATP (arg))
 538     {
 539       double d = (*double_round) (XFLOAT_DATA (arg));
 540       if (FIXNUM_OVERFLOW_P (d))
 541         xsignal2 (Qrange_error, build_string (name), arg);
 542       arg = make_number (d);
 543     }
 544
 545   return arg;
 546 }
 547
 548 /* With C's /, the result is implementation-defined if either operand
 549    is negative, so take care with negative operands in the following
 550    integer functions.  */
 551
 552 static EMACS_INT
 553 ceiling2 (EMACS_INT i1, EMACS_INT i2)
 554 {
 555   return (i2 < 0
 556           ? (i1 < 0  ?  ((-1 - i1) / -i2) + 1  :  - (i1 / -i2))
 557           : (i1 <= 0  ?  - (-i1 / i2)  :  ((i1 - 1) / i2) + 1));
 558 }
 559
 560 static EMACS_INT
 561 floor2 (EMACS_INT i1, EMACS_INT i2)
 562 {
 563   return (i2 < 0
 564           ? (i1 <= 0  ?  -i1 / -i2  :  -1 - ((i1 - 1) / -i2))
 565           : (i1 < 0  ?  -1 - ((-1 - i1) / i2)  :  i1 / i2));
 566 }
 567
 568 static EMACS_INT
 569 truncate2 (EMACS_INT i1, EMACS_INT i2)
 570 {
 571   return (i2 < 0
 572           ? (i1 < 0  ?  -i1 / -i2  :  - (i1 / -i2))
 573           : (i1 < 0  ?  - (-i1 / i2)  :  i1 / i2));
 574 }
 575
 576 static EMACS_INT
 577 round2 (EMACS_INT i1, EMACS_INT i2)
 578 {
 579   /* The C language's division operator gives us one remainder R, but
 580      we want the remainder R1 on the other side of 0 if R1 is closer
 581      to 0 than R is; because we want to round to even, we also want R1
 582      if R and R1 are the same distance from 0 and if C's quotient is
 583      odd.  */
 584   EMACS_INT q = i1 / i2;
 585   EMACS_INT r = i1 % i2;
 586   EMACS_INT abs_r = r < 0 ? -r : r;
 587   EMACS_INT abs_r1 = (i2 < 0 ? -i2 : i2) - abs_r;
 588   return q + (abs_r + (q & 1) <= abs_r1 ? 0 : (i2 ^ r) < 0 ? -1 : 1);
 589 }
 590
 591 /* The code uses emacs_rint, so that it works to undefine HAVE_RINT
 592    if `rint' exists but does not work right.  */
 593 #ifdef HAVE_RINT
 594 #define emacs_rint rint
 595 #else
 596 static double
 597 emacs_rint (double d)
 598 {
 599   return floor (d + 0.5);
 600 }
 601 #endif
 602
 603 static double
 604 double_identity (double d)
 605 {
 606   return d;
 607 }
 608
 609 DEFUN ("ceiling", Fceiling, Sceiling, 1, 2, 0,
 610        doc: /* Return the smallest integer no less than ARG.
 611 This rounds the value towards +inf.
 612 With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR.  */)
 613   (Lisp_Object arg, Lisp_Object divisor)
 614 {
 615   return rounding_driver (arg, divisor, ceil, ceiling2, "ceiling");
 616 }
 617
 618 DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0,
 619        doc: /* Return the largest integer no greater than ARG.
 620 This rounds the value towards -inf.
 621 With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR.  */)
 622   (Lisp_Object arg, Lisp_Object divisor)
 623 {
 624   return rounding_driver (arg, divisor, floor, floor2, "floor");
 625 }
 626
 627 DEFUN ("round", Fround, Sround, 1, 2, 0,
 628        doc: /* Return the nearest integer to ARG.
 629 With optional DIVISOR, return the nearest integer to ARG/DIVISOR.
 630
 631 Rounding a value equidistant between two integers may choose the
 632 integer closer to zero, or it may prefer an even integer, depending on
 633 your machine.  For example, \(round 2.5\) can return 3 on some
 634 systems, but 2 on others.  */)
 635   (Lisp_Object arg, Lisp_Object divisor)
 636 {
 637   return rounding_driver (arg, divisor, emacs_rint, round2, "round");
 638 }
 639
 640 DEFUN ("truncate", Ftruncate, Struncate, 1, 2, 0,
 641        doc: /* Truncate a floating point number to an int.
 642 Rounds ARG toward zero.
 643 With optional DIVISOR, truncate ARG/DIVISOR.  */)
 644   (Lisp_Object arg, Lisp_Object divisor)
 645 {
 646   return rounding_driver (arg, divisor, double_identity, truncate2,
 647                           "truncate");
 648 }
 649
 650
 651 Lisp_Object
 652 fmod_float (Lisp_Object x, Lisp_Object y)
 653 {
 654   double f1, f2;
 655
 656   f1 = FLOATP (x) ? XFLOAT_DATA (x) : XINT (x);
 657   f2 = FLOATP (y) ? XFLOAT_DATA (y) : XINT (y);
 658
 659   f1 = fmod (f1, f2);
 660
 661   /* If the "remainder" comes out with the wrong sign, fix it.  */
 662   if (f2 < 0 ? 0 < f1 : f1 < 0)
 663     f1 += f2;
 664
 665   return make_float (f1);
 666 }
 667 \f
 668 DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0,
 669        doc: /* Return the smallest integer no less than ARG, as a float.
 670 \(Round toward +inf.\)  */)
 671   (Lisp_Object arg)
 672 {
 673   double d = extract_float (arg);
 674   d = ceil (d);
 675   return make_float (d);
 676 }
 677
 678 DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0,
 679        doc: /* Return the largest integer no greater than ARG, as a float.
 680 \(Round towards -inf.\)  */)
 681   (Lisp_Object arg)
 682 {
 683   double d = extract_float (arg);
 684   d = floor (d);
 685   return make_float (d);
 686 }
 687
 688 DEFUN ("fround", Ffround, Sfround, 1, 1, 0,
 689        doc: /* Return the nearest integer to ARG, as a float.  */)
 690   (Lisp_Object arg)
 691 {
 692   double d = extract_float (arg);
 693   d = emacs_rint (d);
 694   return make_float (d);
 695 }
 696
 697 DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0,
 698        doc: /* Truncate a floating point number to an integral float value.
 699 Rounds the value toward zero.  */)
 700   (Lisp_Object arg)
 701 {
 702   double d = extract_float (arg);
 703   if (d >= 0.0)
 704     d = floor (d);
 705   else
 706     d = ceil (d);
 707   return make_float (d);
 708 }
 709 \f
 710 void
 711 syms_of_floatfns (void)
 712 {
 713   defsubr (&Sacos);
 714   defsubr (&Sasin);
 715   defsubr (&Satan);
 716   defsubr (&Scos);
 717   defsubr (&Ssin);
 718   defsubr (&Stan);
 719   defsubr (&Sisnan);
 720 #ifdef HAVE_COPYSIGN
 721   defsubr (&Scopysign);
 722   defsubr (&Sfrexp);
 723   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);
 744   defsubr (&Sffloor);
 745   defsubr (&Sfround);
 746   defsubr (&Sftruncate);
 747   defsubr (&Sexp);
 748   defsubr (&Sexpt);
 749   defsubr (&Slog);
 750   defsubr (&Slog10);
 751   defsubr (&Ssqrt);
 752
 753   defsubr (&Sabs);
 754   defsubr (&Sfloat);
 755   defsubr (&Slogb);
 756   defsubr (&Sceiling);
 757   defsubr (&Sfloor);
 758   defsubr (&Sround);
 759   defsubr (&Struncate);
 760 }