Mercurial > hg > xemacs-beta
diff src/floatfns.c @ 1983:9c872f33ecbe
[xemacs-hg @ 2004-04-05 22:49:31 by james]
Add bignum, ratio, and bigfloat support.
author | james |
---|---|
date | Mon, 05 Apr 2004 22:50:11 +0000 |
parents | e22b0213b713 |
children | 4e6a63799f08 |
line wrap: on
line diff
--- a/src/floatfns.c Mon Apr 05 21:50:47 2004 +0000 +++ b/src/floatfns.c Mon Apr 05 22:50:11 2004 +0000 @@ -119,10 +119,15 @@ /* Convert float to Lisp Integer if it fits, else signal a range - error using the given arguments. */ + error using the given arguments. If bignums are available, range errors + are never signaled. */ static Lisp_Object float_to_int (double x, const char *name, Lisp_Object num, Lisp_Object num2) { +#ifdef HAVE_BIGNUM + bignum_set_double (scratch_bignum, x); + return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); +#else if (x >= ((EMACS_INT) 1 << (VALBITS-1)) || x <= - ((EMACS_INT) 1 << (VALBITS-1)) - (EMACS_INT) 1) { @@ -132,6 +137,7 @@ range_error (name, num); } return (make_int ((EMACS_INT) x)); +#endif /* HAVE_BIGNUM */ } @@ -199,6 +205,21 @@ if (INTP (num)) return (double) XINT (num); +#ifdef HAVE_BIGNUM + if (BIGNUMP (num)) + return bignum_to_double (XBIGNUM_DATA (num)); +#endif + +#ifdef HAVE_RATIO + if (RATIOP (num)) + return ratio_to_double (XRATIO_DATA (num)); +#endif + +#ifdef HAVE_BIGFLOAT + if (BIGFLOATP (num)) + return bigfloat_to_double (XBIGFLOAT_DATA (num)); +#endif + return extract_float (wrong_type_argument (Qnumberp, num)); } @@ -421,6 +442,21 @@ */ (number1, number2)) { +#ifdef HAVE_BIGNUM + if (INTEGERP (number1) && INTP (number2)) + { + if (INTP (number1)) + { + bignum_set_long (scratch_bignum2, XREALINT (number1)); + bignum_pow (scratch_bignum, scratch_bignum2, XREALINT (number2)); + } + else + bignum_pow (scratch_bignum, XBIGNUM_DATA (number1), + XREALINT (number2)); + return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); + } +#endif + if (INTP (number1) && /* common lisp spec */ INTP (number2)) /* don't promote, if both are ints */ { @@ -451,6 +487,23 @@ return make_int (retval); } +#if defined(HAVE_BIGFLOAT) && defined(bigfloat_pow) + if (BIGFLOATP (number1) && INTEGERP (number2)) + { + unsigned long exp; + +#ifdef HAVE_BIGNUM + if (BIGNUMP (number2)) + exp = bignum_to_ulong (XBIGNUM_DATA (number2)); + else +#endif + exp = XUINT (number2); + bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number1)); + bigfloat_pow (scratch_bigfloat, XBIGFLOAT_DATA (number1), exp); + return make_bigfloat_bf (scratch_bigfloat); + } +#endif + { double f1 = extract_float (number1); double f2 = extract_float (number2); @@ -516,7 +569,17 @@ */ (number)) { - double d = extract_float (number); + double d; + +#if defined(HAVE_BIGFLOAT) && defined(bigfloat_sqrt) + if (BIGFLOATP (number)) + { + bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number)); + bigfloat_sqrt (scratch_bigfloat, XBIGFLOAT_DATA (number)); + return make_bigfloat_bf (scratch_bigfloat); + } +#endif /* HAVE_BIGFLOAT */ + d = extract_float (number); #ifdef FLOAT_CHECK_DOMAIN if (d < 0.0) domain_error ("sqrt", number); @@ -648,7 +711,43 @@ } if (INTP (number)) +#ifdef HAVE_BIGNUM + /* The most negative Lisp fixnum will overflow */ + return (XINT (number) >= 0) ? number : make_integer (- XINT (number)); +#else return (XINT (number) >= 0) ? number : make_int (- XINT (number)); +#endif + +#ifdef HAVE_BIGNUM + if (BIGNUMP (number)) + { + if (bignum_sign (XBIGNUM_DATA (number)) >= 0) + return number; + bignum_abs (scratch_bignum, XBIGNUM_DATA (number)); + return make_bignum_bg (scratch_bignum); + } +#endif + +#ifdef HAVE_RATIO + if (RATIOP (number)) + { + if (ratio_sign (XRATIO_DATA (number)) >= 0) + return number; + ratio_abs (scratch_ratio, XRATIO_DATA (number)); + return make_ratio_rt (scratch_ratio); + } +#endif + +#ifdef HAVE_BIGFLOAT + if (BIGFLOATP (number)) + { + if (bigfloat_sign (XBIGFLOAT_DATA (number)) >= 0) + return number; + bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number)); + bigfloat_abs (scratch_bigfloat, XBIGFLOAT_DATA (number)); + return make_bigfloat_bf (scratch_bigfloat); + } +#endif return Fabs (wrong_type_argument (Qnumberp, number)); } @@ -661,6 +760,29 @@ if (INTP (number)) return make_float ((double) XINT (number)); +#ifdef HAVE_BIGNUM + if (BIGFLOATP (number)) + { +#ifdef HAVE_BIGFLOAT + if (ZEROP (Vdefault_float_precision)) +#endif + return make_float (bignum_to_double (XBIGNUM_DATA (number))); +#ifdef HAVE_BIGFLOAT + else + { + bigfloat_set_prec (scratch_bigfloat, bigfloat_get_default_prec ()); + bigfloat_set_bignum (scratch_bigfloat, XBIGNUM_DATA (number)); + return make_bigfloat_bf (scratch_bigfloat); + } +#endif /* HAVE_BIGFLOAT */ + } +#endif /* HAVE_BIGNUM */ + +#ifdef HAVE_RATIO + if (RATIOP (number)) + make_float (ratio_to_double (XRATIO_DATA (number))); +#endif + if (FLOATP (number)) /* give 'em the same float back */ return number; @@ -730,9 +852,36 @@ return (float_to_int (d, "ceiling", number, Qunbound)); } +#ifdef HAVE_BIGNUM + if (INTEGERP (number)) +#else if (INTP (number)) +#endif return number; +#ifdef HAVE_RATIO + if (RATIOP (number)) + { + bignum_ceil (scratch_bignum, XRATIO_NUMERATOR (number), + XRATIO_DENOMINATOR (number)); + return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); + } +#endif + +#ifdef HAVE_BIGFLOAT + if (BIGFLOATP (number)) + { + bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number)); + bigfloat_ceil (scratch_bigfloat, XBIGFLOAT_DATA (number)); +#ifdef HAVE_BIGNUM + bignum_set_bigfloat (scratch_bignum, scratch_bigfloat); + return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); +#else + return make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat)); +#endif /* HAVE_BIGNUM */ + } +#endif /* HAVE_BIGFLOAT */ + return Fceiling (wrong_type_argument (Qnumberp, number)); } @@ -744,6 +893,99 @@ */ (number, divisor)) { +#ifdef WITH_NUMBER_TYPES + CHECK_REAL (number); + if (NILP (divisor)) + { + if (FLOATP (number)) + { + double d; + IN_FLOAT ((d = floor (XFLOAT_DATA (number))), "floor", number); + return (float_to_int (d, "floor", number, Qunbound)); + } +#ifdef HAVE_RATIO + else if (RATIOP (number)) + { + bignum_floor (scratch_bignum, XRATIO_NUMERATOR (number), + XRATIO_DENOMINATOR (number)); + return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); + } +#endif +#ifdef HAVE_BIGFLOAT + else if (BIGFLOATP (number)) + { + bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number)); + bigfloat_floor (scratch_bigfloat, XBIGFLOAT_DATA (number)); + return make_bigfloat_bf (scratch_bigfloat); + } +#endif + return number; + } + else + { + CHECK_REAL (divisor); + switch (promote_args (&number, &divisor)) + { + case FIXNUM_T: + { + EMACS_INT i1 = XREALINT (number); + EMACS_INT i2 = XREALINT (divisor); + + if (i2 == 0) + Fsignal (Qarith_error, Qnil); + + /* With C's /, the result is implementation-defined if either + operand is negative, so use only nonnegative operands. */ + i1 = (i2 < 0 + ? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2)) + : (i1 < 0 ? -1 - ((-1 - i1) / i2) : i1 / i2)); + + return make_int (i1); + } +#ifdef HAVE_BIGNUM + case BIGNUM_T: + if (bignum_sign (XBIGNUM_DATA (divisor)) == 0) + Fsignal (Qarith_error, Qnil); + bignum_floor (scratch_bignum, XBIGNUM_DATA (number), + XBIGNUM_DATA (divisor)); + return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); +#endif + case FLOAT_T: + { + double f1 = extract_float (number); + double f2 = extract_float (divisor); + + if (f2 == 0.0) + Fsignal (Qarith_error, Qnil); + + IN_FLOAT2 (f1 = floor (f1 / f2), "floor", number, divisor); + return float_to_int (f1, "floor", number, divisor); + } +#ifdef HAVE_RATIO + case RATIO_T: + if (ratio_sign (XRATIO_DATA (divisor)) == 0) + Fsignal (Qarith_error, Qnil); + ratio_div (scratch_ratio, XRATIO_DATA (number), + XRATIO_DATA (divisor)); + bignum_floor (scratch_bignum, ratio_numerator (scratch_ratio), + ratio_denominator (scratch_ratio)); + return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); +#endif +#ifdef HAVE_BIGFLOAT + case BIGFLOAT_T: + if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0) + Fsignal (Qarith_error, Qnil); + bigfloat_set_prec (scratch_bigfloat, + max (XBIGFLOAT_GET_PREC (number), + XBIGFLOAT_GET_PREC (divisor))); + bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (number), + XBIGFLOAT_DATA (divisor)); + bigfloat_floor (scratch_bigfloat, scratch_bigfloat); + return make_bigfloat_bf (scratch_bigfloat); +#endif + } + } +#else /* !WITH_NUMBER_TYPES */ CHECK_INT_OR_FLOAT (number); if (! NILP (divisor)) @@ -787,6 +1029,7 @@ } return number; +#endif /* WITH_NUMBER_TYPES */ } DEFUN ("round", Fround, 1, 1, 0, /* @@ -802,9 +1045,51 @@ return (float_to_int (d, "round", number, Qunbound)); } +#ifdef HAVE_BIGNUM + if (INTEGERP (number)) +#else if (INTP (number)) +#endif return number; +#ifdef HAVE_RATIO + if (RATIOP (number)) + { + if (bignum_divisible_p (XRATIO_NUMERATOR (number), + XRATIO_DENOMINATOR (number))) + { + bignum_div (scratch_bignum, XRATIO_NUMERATOR (number), + XRATIO_DENOMINATOR (number)); + } + else + { + bignum_add (scratch_bignum2, XRATIO_NUMERATOR (number), + XRATIO_DENOMINATOR (number)); + bignum_div (scratch_bignum, scratch_bignum2, + XRATIO_DENOMINATOR (number)); + } + return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); + } +#endif + +#ifdef HAVE_BIGFLOAT + if (BIGFLOATP (number)) + { + unsigned long prec = XBIGFLOAT_GET_PREC (number); + bigfloat_set_prec (scratch_bigfloat, prec); + bigfloat_set_prec (scratch_bigfloat2, prec); + bigfloat_set_double (scratch_bigfloat2, + bigfloat_sign (XBIGFLOAT_DATA (number)) * 0.5); + bigfloat_floor (scratch_bigfloat, scratch_bigfloat2); +#ifdef HAVE_BIGNUM + bignum_set_bigfloat (scratch_bignum, scratch_bigfloat); + return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); +#else + return make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat)); +#endif /* HAVE_BIGNUM */ + } +#endif /* HAVE_BIGFLOAT */ + return Fround (wrong_type_argument (Qnumberp, number)); } @@ -817,9 +1102,36 @@ if (FLOATP (number)) return float_to_int (XFLOAT_DATA (number), "truncate", number, Qunbound); +#ifdef HAVE_BIGNUM + if (INTEGERP (number)) +#else if (INTP (number)) +#endif return number; +#ifdef HAVE_RATIO + if (RATIOP (number)) + { + bignum_div (scratch_bignum, XRATIO_NUMERATOR (number), + XRATIO_DENOMINATOR (number)); + return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); + } +#endif + +#ifdef HAVE_BIGFLOAT + if (BIGFLOATP (number)) + { + bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number)); + bigfloat_trunc (scratch_bigfloat, XBIGFLOAT_DATA (number)); +#ifdef HAVE_BIGNUM + bignum_set_bigfloat (scratch_bignum, scratch_bigfloat); + return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); +#else + return make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat)); +#endif /* HAVE_BIGNUM */ + } +#endif /* HAVE_BIGFLOAT */ + return Ftruncate (wrong_type_argument (Qnumberp, number)); }