From e9fdcd7b7d8ae466d83ce9f77f34e9b62b2a4fa7 Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Sat, 14 Jun 2008 15:23:37 +0000 Subject: [PATCH] Fix conversions between Double/Float and simple-integer --- compiler/cmm/CmmParse.y | 1 + compiler/prelude/primops.txt.pp | 7 ++++--- includes/Rts.h | 2 +- includes/RtsExternal.h | 2 ++ rts/Linker.c | 2 ++ rts/PrimOps.cmm | 14 +++++++++----- rts/StgPrimFloat.c | 36 ++++++++++++++++++++++++++++++++---- 7 files changed, 51 insertions(+), 13 deletions(-) diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index 9f6bbc6..b83a07e 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -765,6 +765,7 @@ stmtMacros = listToUFM [ ( fsLit "RET_NPP", \[a,b,c] -> emitRetUT [(NonPtrArg,a),(PtrArg,b),(PtrArg,c)]), ( fsLit "RET_NNP", \[a,b,c] -> emitRetUT [(NonPtrArg,a),(NonPtrArg,b),(PtrArg,c)]), ( fsLit "RET_NNN", \[a,b,c] -> emitRetUT [(NonPtrArg,a),(NonPtrArg,b),(NonPtrArg,c)]), + ( fsLit "RET_NNNN", \[a,b,c,d] -> emitRetUT [(NonPtrArg,a),(NonPtrArg,b),(NonPtrArg,c),(NonPtrArg,d)]), ( fsLit "RET_NNNP", \[a,b,c,d] -> emitRetUT [(NonPtrArg,a),(NonPtrArg,b),(NonPtrArg,c),(PtrArg,d)]), ( fsLit "RET_NPNP", \[a,b,c,d] -> emitRetUT [(NonPtrArg,a),(PtrArg,b),(NonPtrArg,c),(PtrArg,d)]) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 471cba1..d4fd608 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -619,10 +619,11 @@ primop DoubleDecodeOp "decodeDouble#" GenPrimOp with out_of_line = True primop DoubleDecode_2IntOp "decodeDouble_2Int#" GenPrimOp - Double# -> (# Int#, Int#, Int# #) + Double# -> (# Int#, Word#, Word#, Int# #) {Convert to arbitrary-precision integer. - First {\tt Int\#} in result is the high 32 bits of the mantissa, and the - second is the low 32. The third is the exponent.} + First component of the result is -1 or 1, indicating the sign of the + mantissa. The next two are the high and low 32 bits of the mantissa + respectively, and the last is the exponent.} with out_of_line = True ------------------------------------------------------------------------ diff --git a/includes/Rts.h b/includes/Rts.h index 610cd70..5aff979 100644 --- a/includes/Rts.h +++ b/includes/Rts.h @@ -206,7 +206,7 @@ extern void stackOverflow(void); extern void __decodeDouble (MP_INT *man, I_ *_exp, StgDouble dbl); extern void __decodeFloat (MP_INT *man, I_ *_exp, StgFloat flt); -extern void __decodeDouble_2Int (I_ *man_high, I_ *man_low, I_ *exp, StgDouble dbl); +extern void __decodeDouble_2Int (I_ *man_sign, W_ *man_high, W_ *man_low, I_ *exp, StgDouble dbl); extern void __decodeFloat_Int (I_ *man, I_ *exp, StgFloat flt); #if defined(WANT_DOTNET_SUPPORT) diff --git a/includes/RtsExternal.h b/includes/RtsExternal.h index f0e7b75..b952761 100644 --- a/includes/RtsExternal.h +++ b/includes/RtsExternal.h @@ -50,8 +50,10 @@ extern unsigned int n_capabilities; extern StgDouble __encodeDouble (I_ size, StgByteArray arr, I_ e); extern StgDouble __2Int_encodeDouble (I_ j_high, I_ j_low, I_ e); extern StgDouble __int_encodeDouble (I_ j, I_ e); +extern StgDouble __word_encodeDouble (W_ j, I_ e); extern StgFloat __encodeFloat (I_ size, StgByteArray arr, I_ e); extern StgFloat __int_encodeFloat (I_ j, I_ e); +extern StgFloat __word_encodeFloat (W_ j, I_ e); extern StgInt isDoubleNaN(StgDouble d); extern StgInt isDoubleInfinite(StgDouble d); extern StgInt isDoubleDenormalized(StgDouble d); diff --git a/rts/Linker.c b/rts/Linker.c index bca6026..db495dd 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -537,8 +537,10 @@ typedef struct _RtsSymbolVal { SymX(addDLL) \ GMP_SYMS \ SymX(__int_encodeDouble) \ + SymX(__word_encodeDouble) \ SymX(__2Int_encodeDouble) \ SymX(__int_encodeFloat) \ + SymX(__word_encodeFloat) \ SymX(andIntegerzh_fast) \ SymX(atomicallyzh_fast) \ SymX(barf) \ diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index c3ab788..c7c3727 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -928,16 +928,20 @@ decodeDoublezu2Intzh_fast W_ p; FETCH_MP_TEMP(mp_tmp1); FETCH_MP_TEMP(mp_tmp2); - FETCH_MP_TEMP(mp_tmp_w); + FETCH_MP_TEMP(mp_result1); + FETCH_MP_TEMP(mp_result2); /* arguments: D1 = Double# */ arg = D1; /* Perform the operation */ - foreign "C" __decodeDouble_2Int(mp_tmp1 "ptr", mp_tmp2 "ptr", mp_tmp_w "ptr", arg) []; - - /* returns: (Int# (mant high), Int# (mant low), Int# (expn)) */ - RET_NNN(W_[mp_tmp1], W_[mp_tmp2], W_[mp_tmp_w]); + foreign "C" __decodeDouble_2Int(mp_tmp1 "ptr", mp_tmp2 "ptr", + mp_result1 "ptr", mp_result2 "ptr", + arg) []; + + /* returns: + (Int# (mant sign), Word# (mant high), Word# (mant low), Int# (expn)) */ + RET_NNNN(W_[mp_tmp1], W_[mp_tmp2], W_[mp_result1], W_[mp_result2]); } /* ----------------------------------------------------------------------------- diff --git a/rts/StgPrimFloat.c b/rts/StgPrimFloat.c index 80f10e1..436236d 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; } } -- 1.7.10.4