/* Primitive operations on floating point for GNU Emacs Lisp interpreter.
- Copyright (C) 1988, 1993, 1994, 1999 Free Software Foundation, Inc.
+ Copyright (C) 1988, 1993, 1994, 1999, 2002, 2003, 2004,
+ 2005, 2006 Free Software Foundation, Inc.
This file is part of GNU Emacs.
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:
while (0)
#define arith_error(op,arg) \
- Fsignal (Qarith_error, Fcons (build_string ((op)), Fcons ((arg), Qnil)))
+ xsignal2 (Qarith_error, build_string ((op)), (arg))
#define range_error(op,arg) \
- Fsignal (Qrange_error, Fcons (build_string ((op)), Fcons ((arg), Qnil)))
+ xsignal2 (Qrange_error, build_string ((op)), (arg))
#define range_error2(op,a1,a2) \
- Fsignal (Qrange_error, Fcons (build_string ((op)), \
- Fcons ((a1), Fcons ((a2), Qnil))))
+ xsignal3 (Qrange_error, build_string ((op)), (a1), (a2))
#define domain_error(op,arg) \
- Fsignal (Qdomain_error, Fcons (build_string ((op)), Fcons ((arg), Qnil)))
+ xsignal2 (Qdomain_error, build_string ((op)), (arg))
#define domain_error2(op,a1,a2) \
- Fsignal (Qdomain_error, Fcons (build_string ((op)), \
- Fcons ((a1), Fcons ((a2), Qnil))))
+ xsignal3 (Qdomain_error, build_string ((op)), (a1), (a2))
/* Extract a Lisp number as a `double', or signal an error. */
return make_float (d);
}
-DEFUN ("atan", Fatan, Satan, 1, 1, 0,
- doc: /* 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);
}
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;
x = XINT (arg1);
y = XINT (arg2);
acc = 1;
-
+
if (y < 0)
{
if (x == 1)
DEFUN ("log", Flog, Slog, 1, 2, 0,
doc: /* Return the natural logarithm of ARG.
-If second optional argument BASE is given, return log ARG using that base. */)
+If the optional argument BASE is given, return log ARG using that base. */)
(arg, base)
register Lisp_Object arg, base;
{
double f = extract_float (arg);
if (f == 0.0)
- value = -(VALMASK >> 1);
+ value = MOST_NEGATIVE_FIXNUM;
else
{
#ifdef HAVE_LOGB
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);
+ xsignal0 (Qarith_error);
IN_FLOAT2 (f1 = (*double_round) (f1 / f2), name, arg, divisor);
FLOAT_TO_INT2 (f1, arg, name, arg, divisor);
i2 = XINT (divisor);
if (i2 == 0)
- Fsignal (Qarith_error, Qnil);
+ xsignal0 (Qarith_error);
XSETINT (arg, (*int_round2) (i1, i2));
return arg;
DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0,
doc: /* Return the largest integer no greater than ARG.
-This rounds the value towards +inf.
+This rounds the value towards -inf.
With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. */)
(arg, divisor)
Lisp_Object arg, divisor;
f2 = FLOATP (y) ? XFLOAT_DATA (y) : XINT (y);
if (! IEEE_FLOATING_POINT && f2 == 0)
- Fsignal (Qarith_error, Qnil);
+ xsignal0 (Qarith_error);
/* If the "remainder" comes out with the wrong sign, fix it. */
IN_FLOAT2 ((f1 = fmod (f1, f2),
signal (SIGILL, float_error);
#endif /* BSD_SYSTEM */
+ SIGNAL_THREAD_CHECK (signo);
in_float = 0;
- Fsignal (Qarith_error, Fcons (float_error_arg, Qnil));
+ xsignal1 (Qarith_error, float_error_arg);
}
/* Another idea was to replace the library function `infnan'
#endif /* FLOAT_CATCH_SIGILL */
#ifdef HAVE_MATHERR
-int
+int
matherr (x)
struct exception *x;
{
: Qnil)));
switch (x->type)
{
- case DOMAIN: Fsignal (Qdomain_error, args); break;
- case SING: Fsignal (Qsingularity_error, args); break;
- case OVERFLOW: Fsignal (Qoverflow_error, args); break;
- case UNDERFLOW: Fsignal (Qunderflow_error, args); break;
- default: Fsignal (Qarith_error, args); break;
+ case DOMAIN: xsignal (Qdomain_error, args); break;
+ case SING: xsignal (Qsingularity_error, args); break;
+ case OVERFLOW: xsignal (Qoverflow_error, args); break;
+ case UNDERFLOW: xsignal (Qunderflow_error, args); break;
+ default: xsignal (Qarith_error, args); break;
}
return (1); /* don't set errno or print a message */
}
{
#ifdef FLOAT_CATCH_SIGILL
signal (SIGILL, float_error);
-#endif
+#endif
in_float = 0;
}
defsubr (&Sround);
defsubr (&Struncate);
}
+
+/* arch-tag: be05bf9d-049e-4e31-91b9-e6153d483ae7
+ (do not change this comment) */