diff options
author | Ian Lynagh <igloo@earth.li> | 2008-06-14 15:23:37 +0000 |
---|---|---|
committer | Ian Lynagh <igloo@earth.li> | 2008-06-14 15:23:37 +0000 |
commit | e9fdcd7b7d8ae466d83ce9f77f34e9b62b2a4fa7 (patch) | |
tree | 4dadd563ea7708b06e743c116f031476e6059fb2 /rts/StgPrimFloat.c | |
parent | 920470ae1780737c438e5d6fd3a9941d816c1d88 (diff) | |
download | haskell-e9fdcd7b7d8ae466d83ce9f77f34e9b62b2a4fa7.tar.gz |
Fix conversions between Double/Float and simple-integer
Diffstat (limited to 'rts/StgPrimFloat.c')
-rw-r--r-- | rts/StgPrimFloat.c | 36 |
1 files changed, 32 insertions, 4 deletions
diff --git a/rts/StgPrimFloat.c b/rts/StgPrimFloat.c index 80f10e103c..436236d69d 100644 --- a/rts/StgPrimFloat.c +++ b/rts/StgPrimFloat.c @@ -103,6 +103,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 +178,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 +256,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 +296,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; } } |