X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FPrimOps.cmm;h=6c3593e4a485a97306735ffdd8421db8dc51a359;hb=9d03becc597e5b1ab6c8466209a1263bf8ba6f29;hp=06628b96f8ad1b57de4dcb5522555a349495def0;hpb=086bab42386098009471c46139013c41f40856a2;p=ghc-hetmet.git diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 06628b9..6c3593e 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -46,10 +46,10 @@ import __gmpz_xor; import __gmpz_ior; import __gmpz_com; #endif -import base_GHCziIOBase_NestedAtomically_closure; import pthread_mutex_lock; import pthread_mutex_unlock; #endif +import base_GHCziIOBase_NestedAtomically_closure; import EnterCriticalSection; import LeaveCriticalSection; @@ -452,11 +452,11 @@ int64ToIntegerzh_fast hi = TO_W_(val >> 32); lo = TO_W_(val); - if ( hi != 0 && hi != 0xFFFFFFFF ) { - words_needed = 2; - } else { + if ( hi == 0 || (hi == 0xFFFFFFFF && lo != 0) ) { // minimum is one word words_needed = 1; + } else { + words_needed = 2; } ALLOC_PRIM( SIZEOF_StgArrWords + WDS(words_needed), @@ -876,6 +876,23 @@ decodeFloatzh_fast RET_NNP(W_[mp_tmp_w], TO_W_(MP_INT__mp_size(mp_tmp1)), p); } +decodeFloatzuIntzh_fast +{ + W_ p; + F_ arg; + FETCH_MP_TEMP(mp_tmp1); + FETCH_MP_TEMP(mp_tmp_w); + + /* arguments: F1 = Float# */ + arg = F1; + + /* Perform the operation */ + foreign "C" __decodeFloat_Int(mp_tmp1 "ptr", mp_tmp_w "ptr", arg) []; + + /* returns: (Int# (mantissa), Int# (exponent)) */ + RET_NN(W_[mp_tmp1], W_[mp_tmp_w]); +} + #define DOUBLE_MANTISSA_SIZE SIZEOF_DOUBLE #define ARR_SIZE (SIZEOF_StgArrWords + DOUBLE_MANTISSA_SIZE) @@ -905,6 +922,24 @@ decodeDoublezh_fast RET_NNP(W_[mp_tmp_w], TO_W_(MP_INT__mp_size(mp_tmp1)), p); } +decodeDoublezu2Intzh_fast +{ + D_ arg; + W_ p; + FETCH_MP_TEMP(mp_tmp1); + FETCH_MP_TEMP(mp_tmp2); + FETCH_MP_TEMP(mp_tmp_w); + + /* 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]); +} + /* ----------------------------------------------------------------------------- * Concurrency primitives * -------------------------------------------------------------------------- */