/* Primitive operations on floating point for GNU Emacs Lisp interpreter.
Copyright (C) 1988, 1993, 1994, 1999, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+
+Author: Wolfgang Rupprecht
+(according to ack.texi)
This file is part of GNU Emacs.
-GNU Emacs is free software; you can redistribute it and/or modify
+GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 3, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
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., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* ANSI C requires only these float functions:
#include <config.h>
#include <signal.h>
+#include <setjmp.h>
#include "lisp.h"
#include "syssignal.h"
#endif
#endif
-/* Work around a problem that happens because math.h on hpux 7
- defines two static variables--which, in Emacs, are not really static,
- because `static' is defined as nothing. The problem is that they are
- defined both here and in lread.c.
- These macros prevent the name conflict. */
-#if defined (HPUX) && !defined (HPUX8)
-#define _MAXLDBL floatfns_maxldbl
-#define _NMAXLDBL floatfns_nmaxldbl
-#endif
-
#include <math.h>
/* This declaration is omitted on some systems, like Ultrix. */
#if !defined (HPUX) && defined (HAVE_LOGB) && !defined (logb)
-extern double logb ();
+extern double logb (double);
#endif /* not HPUX and HAVE_LOGB and no logb macro */
#if defined(DOMAIN) && defined(SING) && defined(OVERFLOW)
#ifdef FLOAT_CHECK_ERRNO
# include <errno.h>
-
-#ifndef USE_CRT_DLL
-extern int errno;
#endif
-#endif
-
-/* Avoid traps on VMS from sinh and cosh.
- All the other functions set errno instead. */
-
-#ifdef VMS
-#undef cosh
-#undef sinh
-#define cosh(x) ((exp(x)+exp(-x))*0.5)
-#define sinh(x) ((exp(x)-exp(-x))*0.5)
-#endif /* VMS */
#ifdef FLOAT_CATCH_SIGILL
static SIGTYPE float_error ();
IN_FLOAT (d = sin (d) / c, "tan", arg);
return make_float (d);
}
+
+#if defined HAVE_ISNAN && defined HAVE_COPYSIGN
+DEFUN ("isnan", Fisnan, Sisnan, 1, 1, 0,
+ doc: /* Return non nil iff argument X is a NaN. */)
+ (x)
+ Lisp_Object x;
+{
+ CHECK_FLOAT (x);
+ return isnan (XFLOAT_DATA (x)) ? Qt : Qnil;
+}
+
+DEFUN ("copysign", Fcopysign, Scopysign, 1, 2, 0,
+ doc: /* Copy sign of X2 to value of X1, and return the result.
+Cause an error if X1 or X2 is not a float. */)
+ (x1, x2)
+ Lisp_Object x1, x2;
+{
+ double f1, f2;
+
+ CHECK_FLOAT (x1);
+ CHECK_FLOAT (x2);
+
+ f1 = XFLOAT_DATA (x1);
+ f2 = XFLOAT_DATA (x2);
+
+ return make_float (copysign (f1, f2));
+}
+
+DEFUN ("frexp", Ffrexp, Sfrexp, 1, 1, 0,
+ doc: /* Get significand and exponent of a floating point number.
+Breaks the floating point number X into its binary significand SGNFCAND
+\(a floating point value between 0.5 (included) and 1.0 (excluded))
+and an integral exponent EXP for 2, such that:
+
+ X = SGNFCAND * 2^EXP
+
+The function returns the cons cell (SGNFCAND . EXP).
+If X is zero, both parts (SGNFCAND and EXP) are zero. */)
+ (x)
+ Lisp_Object x;
+{
+ double f = XFLOATINT (x);
+
+ if (f == 0.0)
+ return Fcons (make_float (0.0), make_number (0));
+ else
+ {
+ int exp;
+ double sgnfcand = frexp (f, &exp);
+ return Fcons (make_float (sgnfcand), make_number (exp));
+ }
+}
+
+DEFUN ("ldexp", Fldexp, Sldexp, 1, 2, 0,
+ doc: /* Construct number X from significand SGNFCAND and exponent EXP.
+Returns the floating point value resulting from multiplying SGNFCAND
+(the significand) by 2 raised to the power of EXP (the exponent). */)
+ (sgnfcand, exp)
+ Lisp_Object sgnfcand, exp;
+{
+ CHECK_NUMBER (exp);
+ return make_float (ldexp (XFLOATINT (sgnfcand), XINT (exp)));
+}
+#endif
\f
#if 0 /* Leave these out unless we find there's a reason for them. */
/* the rounding functions */
static Lisp_Object
-rounding_driver (arg, divisor, double_round, int_round2, name)
- register Lisp_Object arg, divisor;
- double (*double_round) ();
- EMACS_INT (*int_round2) ();
- char *name;
+rounding_driver (Lisp_Object arg, Lisp_Object divisor,
+ double (*double_round) (double),
+ EMACS_INT (*int_round2) (EMACS_INT, EMACS_INT),
+ char *name)
{
CHECK_NUMBER_OR_FLOAT (arg);
integer functions. */
static EMACS_INT
-ceiling2 (i1, i2)
- EMACS_INT i1, i2;
+ceiling2 (EMACS_INT i1, EMACS_INT i2)
{
return (i2 < 0
? (i1 < 0 ? ((-1 - i1) / -i2) + 1 : - (i1 / -i2))
}
static EMACS_INT
-floor2 (i1, i2)
- EMACS_INT i1, i2;
+floor2 (EMACS_INT i1, EMACS_INT i2)
{
return (i2 < 0
? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2))
}
static EMACS_INT
-truncate2 (i1, i2)
- EMACS_INT i1, i2;
+truncate2 (EMACS_INT i1, EMACS_INT i2)
{
return (i2 < 0
? (i1 < 0 ? -i1 / -i2 : - (i1 / -i2))
}
static EMACS_INT
-round2 (i1, i2)
- EMACS_INT i1, i2;
+round2 (EMACS_INT i1, EMACS_INT i2)
{
/* The C language's division operator gives us one remainder R, but
we want the remainder R1 on the other side of 0 if R1 is closer
#define emacs_rint rint
#else
static double
-emacs_rint (d)
- double d;
+emacs_rint (double d)
{
return floor (d + 0.5);
}
#endif
static double
-double_identity (d)
- double d;
+double_identity (double d)
{
return d;
}
Lisp_Object
-fmod_float (x, y)
- register Lisp_Object x, y;
+fmod_float (Lisp_Object x, Lisp_Object y)
{
double f1, f2;
fatal_error_signal (signo);
#ifdef BSD_SYSTEM
-#ifdef BSD4_1
- sigrelse (SIGILL);
-#else /* not BSD4_1 */
sigsetmask (SIGEMPTYMASK);
-#endif /* not BSD4_1 */
#else
/* Must reestablish handler each time it is called. */
signal (SIGILL, float_error);
defsubr (&Scos);
defsubr (&Ssin);
defsubr (&Stan);
+#if defined HAVE_ISNAN && defined HAVE_COPYSIGN
+ defsubr (&Sisnan);
+ defsubr (&Scopysign);
+ defsubr (&Sfrexp);
+ defsubr (&Sldexp);
+#endif
#if 0
defsubr (&Sacosh);
defsubr (&Sasinh);
HCoop / bpt / emacs.git / blobdiff