Add 2008 to copyright years.

[bpt/emacs.git] / src / floatfns.c

diff --git a/src/floatfns.c b/src/floatfns.c
index 57bece2..3f512ff 100644 (file)
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -1,12 +1,12 @@
 /* Primitive operations on floating point for GNU Emacs Lisp interpreter.
 /* Primitive operations on floating point for GNU Emacs Lisp interpreter.

-   Copyright (C) 1988, 1993, 1994, 1999, 2002, 2003, 2004,
-                 2005 Free Software Foundation, Inc.
+   Copyright (C) 1988, 1993, 1994, 1999, 2001, 2002, 2003, 2004,
+                 2005, 2006, 2007, 2008  Free Software Foundation, Inc.

 
 This file is part of GNU Emacs.
 
 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
 
 This file is part of GNU Emacs.
 
 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 2, or (at your option)
+the Free Software Foundation; either version 3, or (at your option)

 any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,
 any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,


@@ -201,17 +201,15 @@ static char *float_error_fn_name;
   while (0)
 
 #define arith_error(op,arg) \
   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) \
 #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) \
 #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) \
 #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) \
 #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.  */
 
 
 /* Extract a Lisp number as a `double', or signal an error.  */
 


@@ -461,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 */
   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;
     {                          /* this can be improved by pre-calculating */
       EMACS_INT acc, x, y;     /* some binary powers of x then accumulating */
       Lisp_Object val;


@@ -507,7 +506,7 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
 
 DEFUN ("log", Flog, Slog, 1, 2, 0,
        doc: /* Return the natural logarithm of ARG.
 
 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;
 {
      (arg, base)
      register Lisp_Object arg, base;
 {


@@ -755,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)
          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);
 
          IN_FLOAT2 (f1 = (*double_round) (f1 / f2), name, arg, divisor);
          FLOAT_TO_INT2 (f1, arg, name, arg, divisor);


@@ -766,7 +765,7 @@ rounding_driver (arg, divisor, double_round, int_round2, name)
       i2 = XINT (divisor);
 
       if (i2 == 0)
       i2 = XINT (divisor);
 
       if (i2 == 0)

-       Fsignal (Qarith_error, Qnil);
+       xsignal0 (Qarith_error);

 
       XSETINT (arg, (*int_round2) (i1, i2));
       return arg;
 
       XSETINT (arg, (*int_round2) (i1, i2));
       return arg;


@@ -906,7 +905,7 @@ fmod_float (x, y)
   f2 = FLOATP (y) ? XFLOAT_DATA (y) : XINT (y);
 
   if (! IEEE_FLOATING_POINT && f2 == 0)
   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),
 
   /* If the "remainder" comes out with the wrong sign, fix it.  */
   IN_FLOAT2 ((f1 = fmod (f1, f2),


@@ -985,7 +984,7 @@ float_error (signo)
   SIGNAL_THREAD_CHECK (signo);
   in_float = 0;
 
   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'
 }
 
 /* Another idea was to replace the library function `infnan'


@@ -1013,11 +1012,11 @@ matherr (x)
                     : Qnil)));
   switch (x->type)
     {
                     : 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 */
 }
     }
   return (1);  /* don't set errno or print a message */
 }