From 0270afbb05e5838d7803d760c649bf9f7fa60fc1 Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@users.sourceforge.net>
Date: Sun, 3 Oct 2010 15:54:29 +0200
Subject: [PATCH] Rounding routines ratio_to_double, ratio_to_long_double, were
 missing code for the situation when the argument is not a fixnum

---
 src/c/big.d    | 14 ++++++++++++++
 src/c/number.d | 23 ++++++++++++++++++++---
 src/h/number.h |  3 +++
 src/h/object.h |  1 +
 4 files changed, 38 insertions(+), 3 deletions(-)

diff --git a/src/c/big.d b/src/c/big.d
index 23610bb02..df6e96cb1 100644
--- a/src/c/big.d
+++ b/src/c/big.d
@@ -351,6 +351,20 @@ _ecl_big_set_index(cl_object x, cl_index f)
 # endif /* GMP_LIMB_BITS >= FIXNUM_BITS */
 #endif /* ECL_LONG_BITS >= FIXNUM_BITS */
 
+#ifdef ECL_LONG_FLOAT
+long double
+_ecl_big_to_long_double(cl_object o)
+{
+        long double output = 0;
+        int i, l = mpz_size(o->big.big_num), exp = 0;
+        for (i = 0; i < l; i++) {
+                output += ldexpl(mpz_getlimbn(o->big.big_num, i), exp);
+                exp += GMP_LIMB_BITS;
+        }
+        return (mpz_sgn(o->big.big_num) < 0)? -output : output;
+}
+#endif
+
 void
 init_big()
 {
diff --git a/src/c/number.d b/src/c/number.d
index 46945847b..24c366da0 100644
--- a/src/c/number.d
+++ b/src/c/number.d
@@ -742,7 +742,12 @@ ratio_to_float(cl_object num, cl_object den)
 #ifdef WITH_GMP
         cl_fixnum scale;
         cl_object bits = prepare_ratio_to_float(num, den, FLT_MANT_DIG, &scale);
-        float output = ecl_to_double(bits);
+# if (FIXNUM_BITS-ECL_TAG_BITS) >= FLT_MANT_DIG
+        /* The output of prepare_ratio_to_float will always fit an integer */
+        float output = fix(bits);
+# else
+        float output = FIXNUMP(bits)? fix(bits) : _ecl_big_to_double(bits);
+# endif
         return ldexpf(output, scale);
 #else
         return (float)(FIXNUMP(num) ? fix(num) : num->big.big_num) /
@@ -756,7 +761,12 @@ ratio_to_double(cl_object num, cl_object den)
 #ifdef WITH_GMP
         cl_fixnum scale;
         cl_object bits = prepare_ratio_to_float(num, den, DBL_MANT_DIG, &scale);
-        double output = ecl_to_double(bits);
+# if (FIXNUM_BITS-ECL_TAG_BITS) >= DBL_MANT_DIG
+        /* The output of prepare_ratio_to_float will always fit an integer */
+        double output = fix(bits);
+# else
+        double output = FIXNUMP(bits)? fix(bits) : _ecl_big_to_double(bits);
+# endif
         return ldexp(output, scale);
 #else
         return (double)(FIXNUMP(num) ? fix(num) : num->big.big_num) /
@@ -771,7 +781,14 @@ ratio_to_long_double(cl_object num, cl_object den)
 #ifdef WITH_GMP
         cl_fixnum scale;
         cl_object bits = prepare_ratio_to_float(num, den, LDBL_MANT_DIG, &scale);
-        long double output = ecl_to_long_double(bits);
+# if (FIXNUM_BITS-ECL_TAG_BITS) >= LDBL_MANT_DIG
+        /* The output of prepare_ratio_to_float will always fit an integer */
+        long double output = fix(bits);
+# else
+        long double output = FIXNUMP(bits)?
+                (long double)fix(bits) :
+                _ecl_big_to_long_double(bits);
+# endif
         return ldexpl(output, scale);
 #else
         return (long double)(FIXNUMP(num) ? fix(num) : num->big.big_num) /
diff --git a/src/h/number.h b/src/h/number.h
index d7af61a2a..a0d4bd82e 100644
--- a/src/h/number.h
+++ b/src/h/number.h
@@ -27,6 +27,9 @@
 
 extern ECL_API cl_object _ecl_big_set_fixnum(cl_object x, cl_fixnum f);
 extern ECL_API cl_object _ecl_big_set_index(cl_object x, cl_index f);
+#ifdef ECL_LONG_FLOAT
+extern ECL_API long double _ecl_big_to_long_double(cl_object x);
+#endif
 #if ECL_LONG_BITS >= FIXNUM_BITS
 #define _ecl_big_set_fixnum(x, f) mpz_set_si((x)->big.big_num,(f))
 #define _ecl_big_set_index(x, f) mpz_set_ui((x)->big.big_num,(f))
diff --git a/src/h/object.h b/src/h/object.h
index daec2d79e..25ec46df9 100644
--- a/src/h/object.h
+++ b/src/h/object.h
@@ -116,6 +116,7 @@ typedef cl_object (*cl_objectfn_fixed)();
 	Definition of each implementation type.
 */
 
+#define ECL_TAG_BITS		2
 #define IMMEDIATE(o)		((cl_fixnum)(o) & 3)
 #define IMMEDIATE_TAG		3