X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/1d6ea92f4fcff0aa652489c87e60151d3bdaf6c2..cd72c39915f4d43a286f1a193ee950c8c8049c10:/src/floatfns.c diff --git a/src/floatfns.c b/src/floatfns.c index ea06db5b5f..dd879de7eb 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -1,5 +1,6 @@ /* 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. @@ -15,8 +16,8 @@ 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., 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: @@ -200,17 +201,15 @@ static char *float_error_fn_name; 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. */ @@ -255,13 +254,25 @@ DEFUN ("asin", Fasin, Sasin, 1, 1, 0, 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); } @@ -448,7 +459,8 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, 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; @@ -456,7 +468,7 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, x = XINT (arg1); y = XINT (arg2); acc = 1; - + if (y < 0) { if (x == 1) @@ -494,7 +506,7 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, 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; { @@ -680,7 +692,7 @@ This is the same as the exponent of a float. */) double f = extract_float (arg); if (f == 0.0) - value = -(VALMASK >> 1); + value = MOST_NEGATIVE_FIXNUM; else { #ifdef HAVE_LOGB @@ -742,7 +754,7 @@ rounding_driver (arg, divisor, double_round, int_round2, name) 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); @@ -753,7 +765,7 @@ rounding_driver (arg, divisor, double_round, int_round2, name) i2 = XINT (divisor); if (i2 == 0) - Fsignal (Qarith_error, Qnil); + xsignal0 (Qarith_error); XSETINT (arg, (*int_round2) (i1, i2)); return arg; @@ -849,7 +861,7 @@ With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR. */ 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; @@ -859,7 +871,12 @@ With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. DEFUN ("round", Fround, Sround, 1, 2, 0, doc: /* Return the nearest integer to ARG. -With optional DIVISOR, return the nearest integer to ARG/DIVISOR. */) +With optional DIVISOR, return the nearest integer to ARG/DIVISOR. + +Rounding a value equidistant between two integers may choose the +integer closer to zero, or it may prefer an even integer, depending on +your machine. For example, \(round 2.5\) can return 3 on some +systems, but 2 on others. */) (arg, divisor) Lisp_Object arg, divisor; { @@ -888,7 +905,7 @@ fmod_float (x, y) 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), @@ -964,9 +981,10 @@ float_error (signo) 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' @@ -975,7 +993,7 @@ float_error (signo) #endif /* FLOAT_CATCH_SIGILL */ #ifdef HAVE_MATHERR -int +int matherr (x) struct exception *x; { @@ -994,11 +1012,11 @@ matherr (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 */ } @@ -1009,7 +1027,7 @@ init_floatfns () { #ifdef FLOAT_CATCH_SIGILL signal (SIGILL, float_error); -#endif +#endif in_float = 0; } @@ -1058,3 +1076,6 @@ syms_of_floatfns () defsubr (&Sround); defsubr (&Struncate); } + +/* arch-tag: be05bf9d-049e-4e31-91b9-e6153d483ae7 + (do not change this comment) */