diff src/floatfns.c @ 380:8626e4521993 r21-2-5

Import from CVS: tag r21-2-5
author cvs
date Mon, 13 Aug 2007 11:07:10 +0200
parents e11d67e05968
children 74fd4e045ea6
line wrap: on
line diff
--- a/src/floatfns.c	Mon Aug 13 11:06:08 2007 +0200
+++ b/src/floatfns.c	Mon Aug 13 11:07:10 2007 +0200
@@ -162,13 +162,13 @@
 static Lisp_Object
 mark_float (Lisp_Object obj, void (*markobj) (Lisp_Object))
 {
-  return (Qnil);
+  return Qnil;
 }
 
 static int
-float_equal (Lisp_Object o1, Lisp_Object o2, int depth)
+float_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
 {
-  return (extract_float (o1) == extract_float (o2));
+  return (extract_float (obj1) == extract_float (obj2));
 }
 
 static unsigned long
@@ -188,11 +188,13 @@
 double
 extract_float (Lisp_Object num)
 {
-  CHECK_INT_OR_FLOAT (num);
+  if (FLOATP (num))
+    return XFLOAT_DATA (num);
 
-  if (FLOATP (num))
-    return (float_data (XFLOAT (num)));
-  return (double) XINT (num);
+  if (INTP (num))
+    return (double) XINT (num);
+
+  return extract_float (wrong_type_argument (num, Qnumberp));
 }
 #endif /* LISP_FLOAT_TYPE */
 
@@ -422,53 +424,54 @@
 */
        (arg1, arg2))
 {
-  double f1, f2;
-
-  CHECK_INT_OR_FLOAT (arg1);
-  CHECK_INT_OR_FLOAT (arg2);
-  if ((INTP (arg1)) && /* common lisp spec */
-      (INTP (arg2))) /* don't promote, if both are ints */
+  if (INTP (arg1) && /* common lisp spec */
+      INTP (arg2)) /* don't promote, if both are ints */
     {
-      EMACS_INT acc, x, y;
-      x = XINT (arg1);
-      y = XINT (arg2);
+      EMACS_INT retval;
+      EMACS_INT x = XINT (arg1);
+      EMACS_INT y = XINT (arg2);
 
       if (y < 0)
 	{
 	  if (x == 1)
-	    acc = 1;
+	    retval = 1;
 	  else if (x == -1)
-	    acc = (y & 1) ? -1 : 1;
+	    retval = (y & 1) ? -1 : 1;
 	  else
-	    acc = 0;
+	    retval = 0;
 	}
       else
 	{
-	  acc = 1;
+	  retval = 1;
 	  while (y > 0)
 	    {
 	      if (y & 1)
-		acc *= x;
+		retval *= x;
 	      x *= x;
 	      y = (EMACS_UINT) y >> 1;
 	    }
 	}
-      return (make_int (acc));
+      return make_int (retval);
     }
+
 #ifdef LISP_FLOAT_TYPE
-  f1 = (FLOATP (arg1)) ? float_data (XFLOAT (arg1)) : XINT (arg1);
-  f2 = (FLOATP (arg2)) ? float_data (XFLOAT (arg2)) : XINT (arg2);
-  /* Really should check for overflow, too */
-  if (f1 == 0.0 && f2 == 0.0)
-    f1 = 1.0;
+  {
+    double f1 = extract_float (arg1);
+    double f2 = extract_float (arg2);
+    /* Really should check for overflow, too */
+    if (f1 == 0.0 && f2 == 0.0)
+      f1 = 1.0;
 # ifdef FLOAT_CHECK_DOMAIN
-  else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor(f2)))
-    domain_error2 ("expt", arg1, arg2);
+    else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor(f2)))
+      domain_error2 ("expt", arg1, arg2);
 # endif /* FLOAT_CHECK_DOMAIN */
-  IN_FLOAT2 (f1 = pow (f1, f2), "expt", arg1, arg2);
-  return make_float (f1);
-#else  /* !LISP_FLOAT_TYPE */
-  abort ();
+    IN_FLOAT2 (f1 = pow (f1, f2), "expt", arg1, arg2);
+    return make_float (f1);
+  }
+#else
+  CHECK_INT_OR_FLOAT (arg1);
+  CHECK_INT_OR_FLOAT (arg2);
+  return Fexpt (arg1, arg2);
 #endif /* LISP_FLOAT_TYPE */
 }
 
@@ -651,21 +654,19 @@
 */
        (arg))
 {
-  CHECK_INT_OR_FLOAT (arg);
-
 #ifdef LISP_FLOAT_TYPE
   if (FLOATP (arg))
-  {
-    IN_FLOAT (arg = make_float ((double) fabs (float_data (XFLOAT (arg)))),
-              "abs", arg);
-    return (arg);
-  }
-  else
+    {
+      IN_FLOAT (arg = make_float (fabs (XFLOAT_DATA (arg))),
+		"abs", arg);
+      return arg;
+    }
 #endif /* LISP_FLOAT_TYPE */
-    if (XINT (arg) < 0)
-      return (make_int (- XINT (arg)));
-    else
-      return (arg);
+
+  if (INTP (arg))
+    return (XINT (arg) >= 0) ? arg : make_int (- XINT (arg));
+
+  return Fabs (wrong_type_argument (arg, Qnumberp));
 }
 
 #ifdef LISP_FLOAT_TYPE
@@ -674,12 +675,13 @@
 */
        (arg))
 {
-  CHECK_INT_OR_FLOAT (arg);
-
   if (INTP (arg))
     return make_float ((double) XINT (arg));
-  else				/* give 'em the same float back */
+
+  if (FLOATP (arg))		/* give 'em the same float back */
     return arg;
+
+  return Ffloat (wrong_type_argument (arg, Qnumberp));
 }
 #endif /* LISP_FLOAT_TYPE */
 
@@ -743,18 +745,19 @@
 */
        (arg))
 {
-  CHECK_INT_OR_FLOAT (arg);
-
 #ifdef LISP_FLOAT_TYPE
   if (FLOATP (arg))
-  {
-    double d;
-    IN_FLOAT ((d = ceil (float_data (XFLOAT (arg)))), "ceiling", arg);
-    return (float_to_int (d, "ceiling", arg, Qunbound));
-  }
+    {
+      double d;
+      IN_FLOAT ((d = ceil (XFLOAT_DATA (arg))), "ceiling", arg);
+      return (float_to_int (d, "ceiling", arg, Qunbound));
+    }
 #endif /* LISP_FLOAT_TYPE */
 
-  return arg;
+  if (INTP (arg))
+    return arg;
+
+  return Fceiling (wrong_type_argument (arg, Qnumberp));
 }
 
 
@@ -775,10 +778,9 @@
 #ifdef LISP_FLOAT_TYPE
       if (FLOATP (arg) || FLOATP (divisor))
 	{
-	  double f1, f2;
+	  double f1 = extract_float (arg);
+	  double f2 = extract_float (divisor);
 
-	  f1 = ((FLOATP (arg)) ? float_data (XFLOAT (arg)) : XINT (arg));
-	  f2 = ((FLOATP (divisor)) ? float_data (XFLOAT (divisor)) : XINT (divisor));
 	  if (f2 == 0)
 	    Fsignal (Qarith_error, Qnil);
 
@@ -804,11 +806,11 @@
 
 #ifdef LISP_FLOAT_TYPE
   if (FLOATP (arg))
-  {
-    double d;
-    IN_FLOAT ((d = floor (float_data (XFLOAT (arg)))), "floor", arg);
-    return (float_to_int (d, "floor", arg, Qunbound));
-  }
+    {
+      double d;
+      IN_FLOAT ((d = floor (XFLOAT_DATA (arg))), "floor", arg);
+      return (float_to_int (d, "floor", arg, Qunbound));
+    }
 #endif /* LISP_FLOAT_TYPE */
 
   return arg;
@@ -819,19 +821,20 @@
 */
        (arg))
 {
-  CHECK_INT_OR_FLOAT (arg);
-
 #ifdef LISP_FLOAT_TYPE
   if (FLOATP (arg))
-  {
-    double d;
-    /* Screw the prevailing rounding mode.  */
-    IN_FLOAT ((d = rint (float_data (XFLOAT (arg)))), "round", arg);
-    return (float_to_int (d, "round", arg, Qunbound));
-  }
+    {
+      double d;
+      /* Screw the prevailing rounding mode.  */
+      IN_FLOAT ((d = rint (XFLOAT_DATA (arg))), "round", arg);
+      return (float_to_int (d, "round", arg, Qunbound));
+    }
 #endif /* LISP_FLOAT_TYPE */
 
-  return arg;
+  if (INTP (arg))
+    return arg;
+
+  return Fround (wrong_type_argument (arg, Qnumberp));
 }
 
 DEFUN ("truncate", Ftruncate, 1, 1, 0, /*
@@ -840,15 +843,15 @@
 */
        (arg))
 {
-  CHECK_INT_OR_FLOAT (arg);
-
 #ifdef LISP_FLOAT_TYPE
   if (FLOATP (arg))
-    return (float_to_int (float_data (XFLOAT (arg)),
-                          "truncate", arg, Qunbound));
+    return float_to_int (XFLOAT_DATA (arg), "truncate", arg, Qunbound);
 #endif /* LISP_FLOAT_TYPE */
 
-  return arg;
+  if (INTP (arg))
+    return arg;
+
+  return Ftruncate (wrong_type_argument (arg, Qnumberp));
 }
 
 /* Float-rounding functions. */