mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-13 04:42:13 -08:00
Code Issues Projects Releases Packages Wiki Activity

Rounding routines ratio_to_double, ratio_to_long_double, were missing code for the situation when the argument is not a fixnum

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-10-03 15:54:29 +02:00
parent ef0b0add8f
commit 0270afbb05
4 changed files with 38 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

14
src/c/big.d
View file

@ -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()
{

23
src/c/number.d
View file

@ -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) /

3
src/h/number.h
View file

@ -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))

1
src/h/object.h
View file

@ -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