xemacs-beta: src/floatfns.c comparison

comparison 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

comparison

equal deleted inserted replaced

-:76b7d63099ad
+:8626e4521993
 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
 float_hash (Lisp_Object obj, int depth)
 {
 /* Extract a Lisp number as a `double', or signal an error.  */
 double
 extract_float (Lisp_Object num)
 {
-CHECK_INT_OR_FLOAT (num);
 if (FLOATP (num))
-return (float_data (XFLOAT (num)));
+return XFLOAT_DATA (num);
-return (double) XINT (num);
+if (INTP (num))
+return (double) XINT (num);
+return extract_float (wrong_type_argument (num, Qnumberp));
 }
 #endif /* LISP_FLOAT_TYPE */
 /* Trig functions.  */
 DEFUN ("expt", Fexpt, 2, 2, 0, /*
 Return the exponential ARG1 ** ARG2.
 */
 (arg1, arg2))
 {
-double f1, f2;
+if (INTP (arg1) && /* common lisp spec */
+INTP (arg2)) /* don't promote, if both are ints */
-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 */
 {
-EMACS_INT acc, x, y;
+EMACS_INT retval;
-x = XINT (arg1);
+EMACS_INT x = XINT (arg1);
-y = XINT (arg2);
+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);
+#ifdef LISP_FLOAT_TYPE
-f2 = (FLOATP (arg2)) ? float_data (XFLOAT (arg2)) : XINT (arg2);
+{
-/* Really should check for overflow, too */
+double f1 = extract_float (arg1);
-if (f1 == 0.0 && f2 == 0.0)
+double f2 = extract_float (arg2);
-f1 = 1.0;
+/* 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);
 # endif /* FLOAT_CHECK_DOMAIN */
 IN_FLOAT2 (f1 = pow (f1, f2), "expt", arg1, arg2);
 return make_float (f1);
-#else  /* !LISP_FLOAT_TYPE */
+}
-abort ();
+#else
+CHECK_INT_OR_FLOAT (arg1);
+CHECK_INT_OR_FLOAT (arg2);
+return Fexpt (arg1, arg2);
 #endif /* LISP_FLOAT_TYPE */
 }
 #ifdef LISP_FLOAT_TYPE
 DEFUN ("log", Flog, 1, 2, 0, /*
 DEFUN ("abs", Fabs, 1, 1, 0, /*
 Return the absolute value of ARG.
 */
 (arg))
 {
-CHECK_INT_OR_FLOAT (arg);
 #ifdef LISP_FLOAT_TYPE
 if (FLOATP (arg))
 {
-IN_FLOAT (arg = make_float ((double) fabs (float_data (XFLOAT (arg)))),
+IN_FLOAT (arg = make_float (fabs (XFLOAT_DATA (arg))),
-"abs", arg);
+		"abs", arg);
-return (arg);
+return arg;
 }
-else
+#endif /* LISP_FLOAT_TYPE */
-#endif /* LISP_FLOAT_TYPE */
-if (XINT (arg) < 0)
+if (INTP (arg))
-return (make_int (- XINT (arg)));
+return (XINT (arg) >= 0) ? arg : make_int (- XINT (arg));
-else
-return (arg);
+return Fabs (wrong_type_argument (arg, Qnumberp));
 }
 #ifdef LISP_FLOAT_TYPE
 DEFUN ("float", Ffloat, 1, 1, 0, /*
 Return the floating point number equal to ARG.
 */
 (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 */
 #ifdef LISP_FLOAT_TYPE
 DEFUN ("ceiling", Fceiling, 1, 1, 0, /*
 Return the smallest integer no less than ARG.  (Round toward +inf.)
 */
 (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);
+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));
 }
 DEFUN ("floor", Ffloor, 1, 2, 0, /*
 Return the largest integer no greater than ARG.  (Round towards -inf.)
 CHECK_INT_OR_FLOAT (divisor);
 #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);
 	  IN_FLOAT2 (f1 = floor (f1 / f2), "floor", arg, divisor);
 	  return float_to_int (f1, "floor", arg, divisor);
 return (make_int (i1));
 }
 #ifdef LISP_FLOAT_TYPE
 if (FLOATP (arg))
 {
 double d;
-IN_FLOAT ((d = floor (float_data (XFLOAT (arg)))), "floor", arg);
+IN_FLOAT ((d = floor (XFLOAT_DATA (arg))), "floor", arg);
 return (float_to_int (d, "floor", arg, Qunbound));
 }
 #endif /* LISP_FLOAT_TYPE */
 return arg;
 }
 DEFUN ("round", Fround, 1, 1, 0, /*
 Return the nearest integer to ARG.
 */
 (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);
+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, /*
 Truncate a floating point number to an integer.
 Rounds the value toward zero.
 */
 (arg))
 {
-CHECK_INT_OR_FLOAT (arg);
 #ifdef LISP_FLOAT_TYPE
 if (FLOATP (arg))
-return (float_to_int (float_data (XFLOAT (arg)),
+return float_to_int (XFLOAT_DATA (arg), "truncate", arg, Qunbound);
-"truncate", arg, Qunbound));
+#endif /* LISP_FLOAT_TYPE */
-#endif /* LISP_FLOAT_TYPE */
+if (INTP (arg))
 return arg;
+return Ftruncate (wrong_type_argument (arg, Qnumberp));
 }
 /* Float-rounding functions. */
 #ifdef LISP_FLOAT_TYPE
 /* #if 1  It's not clear these are worth adding... */

Mercurial > hg > xemacs-beta

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