X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FStgPrimFloat.c;h=e7754250c7b4ea8a5dfd370d5ed46989b9066695;hb=1353826e5159c9a5a81e75e0b7459271f27c08ea;hp=21ba9dc41c5c29a99529bc4921199fb8da3d3628;hpb=4f92da533cd1c7b5f41ef8794ee6a284f1680413;p=ghc-hetmet.git diff --git a/rts/StgPrimFloat.c b/rts/StgPrimFloat.c index 21ba9dc..e775425 100644 --- a/rts/StgPrimFloat.c +++ b/rts/StgPrimFloat.c @@ -1,5 +1,6 @@ /* ----------------------------------------------------------------------------- * + * (c) Lennart Augustsson * (c) The GHC Team, 1998-2000 * * Miscellaneous support for floating-point primitives @@ -89,7 +90,7 @@ __2Int_encodeDouble (I_ j_high, I_ j_low, I_ e) ASSERT(sizeof(int ) == 4 ); r = (StgDouble)((unsigned int)j_high); - r *= exp2f(32); + r *= 4294967296.0; /* exp2f(32); */ r += (StgDouble)((unsigned int)j_low); /* Now raise to the exponent */ @@ -103,6 +104,21 @@ __2Int_encodeDouble (I_ j_high, I_ j_low, I_ e) return r; } +/* Special version for words */ +StgDouble +__word_encodeDouble (W_ j, I_ e) +{ + StgDouble r; + + r = (StgDouble)j; + + /* Now raise to the exponent */ + if ( r != 0.0 ) /* Lennart suggests this avoids a bug in MIPS's ldexp */ + r = ldexp(r, e); + + return r; +} + /* Special version for small Integers */ StgDouble __int_encodeDouble (I_ j, I_ e) @@ -163,6 +179,21 @@ __int_encodeFloat (I_ j, I_ e) return r; } +/* Special version for small positive Integers */ +StgFloat +__word_encodeFloat (W_ j, I_ e) +{ + StgFloat r; + + r = (StgFloat)j; + + /* Now raise to the exponent */ + if ( r != 0.0 ) /* Lennart suggests this avoids a bug in MIPS's ldexp */ + r = ldexp(r, e); + + return r; +} + /* This only supports IEEE floating point */ void @@ -226,7 +257,7 @@ __decodeDouble (MP_INT *man, I_ *exp, StgDouble dbl) } void -__decodeDouble_2Int (I_ *man_high, I_ *man_low, I_ *exp, StgDouble dbl) +__decodeDouble_2Int (I_ *man_sign, W_ *man_high, W_ *man_low, I_ *exp, StgDouble dbl) { /* Do some bit fiddling on IEEE */ unsigned int low, high; /* assuming 32 bit ints */ @@ -266,9 +297,7 @@ __decodeDouble_2Int (I_ *man_high, I_ *man_low, I_ *exp, StgDouble dbl) *exp = (I_) iexp; *man_low = low; *man_high = high; - if (sign < 0) { - *man_high = - *man_high; - } + *man_sign = (sign < 0) ? -1 : 1; } }