X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FStgPrimFloat.c;h=5987aa95891a9e23dfac03b81f1a75105caa0e4b;hb=b20e2bee6b0a734563f456dc346f91a3286d84b0;hp=e7754250c7b4ea8a5dfd370d5ed46989b9066695;hpb=59da61350d3b103ec6ee1d44fe9e391408883259;p=ghc-hetmet.git diff --git a/rts/StgPrimFloat.c b/rts/StgPrimFloat.c index e775425..5987aa9 100644 --- a/rts/StgPrimFloat.c +++ b/rts/StgPrimFloat.c @@ -17,27 +17,6 @@ * (lib/fltcode.c). */ -#ifdef _SHORT_LIMB -#define SIZEOF_LIMB_T SIZEOF_UNSIGNED_INT -#else -#ifdef _LONG_LONG_LIMB -#define SIZEOF_LIMB_T SIZEOF_UNSIGNED_LONG_LONG -#else -#define SIZEOF_LIMB_T SIZEOF_UNSIGNED_LONG -#endif -#endif - -#if SIZEOF_LIMB_T == 4 -#define GMP_BASE 4294967296.0 -#elif SIZEOF_LIMB_T == 8 -#define GMP_BASE 18446744073709551616.0 -#else -#error Cannot cope with SIZEOF_LIMB_T -- please add definition of GMP_BASE -#endif - -#define DNBIGIT ((SIZEOF_DOUBLE+SIZEOF_LIMB_T-1)/SIZEOF_LIMB_T) -#define FNBIGIT ((SIZEOF_FLOAT +SIZEOF_LIMB_T-1)/SIZEOF_LIMB_T) - #if IEEE_FLOATING_POINT #define MY_DMINEXP ((DBL_MIN_EXP) - (DBL_MANT_DIG) - 1) /* DMINEXP is defined in values.h on Linux (for example) */ @@ -60,28 +39,6 @@ #define __abs(a) (( (a) >= 0 ) ? (a) : (-(a))) StgDouble -__encodeDouble (I_ size, StgByteArray ba, I_ e) /* result = s * 2^e */ -{ - StgDouble r; - const mp_limb_t *const arr = (const mp_limb_t *)ba; - I_ i; - - /* Convert MP_INT to a double; knows a lot about internal rep! */ - for(r = 0.0, i = __abs(size)-1; i >= 0; i--) - r = (r * GMP_BASE) + arr[i]; - - /* Now raise to the exponent */ - if ( r != 0.0 ) /* Lennart suggests this avoids a bug in MIPS's ldexp */ - r = ldexp(r, e); - - /* sign is encoded in the size */ - if (size < 0) - r = -r; - - return r; -} - -StgDouble __2Int_encodeDouble (I_ j_high, I_ j_low, I_ e) { StgDouble r; @@ -138,28 +95,6 @@ __int_encodeDouble (I_ j, I_ e) return r; } -StgFloat -__encodeFloat (I_ size, StgByteArray ba, I_ e) /* result = s * 2^e */ -{ - StgFloat r; - const mp_limb_t *arr = (const mp_limb_t *)ba; - I_ i; - - /* Convert MP_INT to a float; knows a lot about internal rep! */ - for(r = 0.0, i = __abs(size)-1; i >= 0; i--) - r = (r * GMP_BASE) + arr[i]; - - /* Now raise to the exponent */ - if ( r != 0.0 ) /* Lennart suggests this avoids a bug in MIPS's ldexp */ - r = ldexp(r, e); - - /* sign is encoded in the size */ - if (size < 0) - r = -r; - - return r; -} - /* Special version for small Integers */ StgFloat __int_encodeFloat (I_ j, I_ e) @@ -197,66 +132,6 @@ __word_encodeFloat (W_ j, I_ e) /* This only supports IEEE floating point */ void -__decodeDouble (MP_INT *man, I_ *exp, StgDouble dbl) -{ - /* Do some bit fiddling on IEEE */ - unsigned int low, high; /* assuming 32 bit ints */ - int sign, iexp; - union { double d; unsigned int i[2]; } u; /* assuming 32 bit ints, 64 bit double */ - - ASSERT(sizeof(unsigned int ) == 4 ); - ASSERT(sizeof(dbl ) == SIZEOF_DOUBLE); - ASSERT(sizeof(man->_mp_d[0]) == SIZEOF_LIMB_T); - ASSERT(DNBIGIT*SIZEOF_LIMB_T >= SIZEOF_DOUBLE); - - u.d = dbl; /* grab chunks of the double */ - low = u.i[L]; - high = u.i[H]; - - /* we know the MP_INT* passed in has size zero, so we realloc - no matter what. - */ - man->_mp_alloc = DNBIGIT; - - if (low == 0 && (high & ~DMSBIT) == 0) { - man->_mp_size = 0; - *exp = 0L; - } else { - man->_mp_size = DNBIGIT; - iexp = ((high >> 20) & 0x7ff) + MY_DMINEXP; - sign = high; - - high &= DHIGHBIT-1; - if (iexp != MY_DMINEXP) /* don't add hidden bit to denorms */ - high |= DHIGHBIT; - else { - iexp++; - /* A denorm, normalize the mantissa */ - while (! (high & DHIGHBIT)) { - high <<= 1; - if (low & DMSBIT) - high++; - low <<= 1; - iexp--; - } - } - *exp = (I_) iexp; -#if DNBIGIT == 2 - man->_mp_d[0] = (mp_limb_t)low; - man->_mp_d[1] = (mp_limb_t)high; -#else -#if DNBIGIT == 1 - man->_mp_d[0] = ((mp_limb_t)high) << 32 | (mp_limb_t)low; -#else -#error Cannot cope with DNBIGIT -#endif -#endif - if (sign < 0) - man->_mp_size = -man->_mp_size; - } -} - -void __decodeDouble_2Int (I_ *man_sign, W_ *man_high, W_ *man_low, I_ *exp, StgDouble dbl) { /* Do some bit fiddling on IEEE */ @@ -301,55 +176,6 @@ __decodeDouble_2Int (I_ *man_sign, W_ *man_high, W_ *man_low, I_ *exp, StgDouble } } -void -__decodeFloat (MP_INT *man, I_ *exp, StgFloat flt) -{ - /* Do some bit fiddling on IEEE */ - int high, sign; /* assuming 32 bit ints */ - union { float f; int i; } u; /* assuming 32 bit float and int */ - - ASSERT(sizeof(int ) == 4 ); - ASSERT(sizeof(flt ) == SIZEOF_FLOAT ); - ASSERT(sizeof(man->_mp_d[0]) == SIZEOF_LIMB_T); - ASSERT(FNBIGIT*SIZEOF_LIMB_T >= SIZEOF_FLOAT ); - - u.f = flt; /* grab the float */ - high = u.i; - - /* we know the MP_INT* passed in has size zero, so we realloc - no matter what. - */ - man->_mp_alloc = FNBIGIT; - - if ((high & ~FMSBIT) == 0) { - man->_mp_size = 0; - *exp = 0; - } else { - man->_mp_size = FNBIGIT; - *exp = ((high >> 23) & 0xff) + MY_FMINEXP; - sign = high; - - high &= FHIGHBIT-1; - if (*exp != MY_FMINEXP) /* don't add hidden bit to denorms */ - high |= FHIGHBIT; - else { - (*exp)++; - /* A denorm, normalize the mantissa */ - while (! (high & FHIGHBIT)) { - high <<= 1; - (*exp)--; - } - } -#if FNBIGIT == 1 - man->_mp_d[0] = (mp_limb_t)high; -#else -#error Cannot cope with FNBIGIT -#endif - if (sign < 0) - man->_mp_size = -man->_mp_size; - } -} - /* Convenient union types for checking the layout of IEEE 754 types - based on defs in GNU libc */