From 1b61c2db6a8d6627577bcd7876474a0c5bd1eedb Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sat, 13 Jun 2009 19:18:51 +0000 Subject: [PATCH] Remove the implementation of gmp primops from the rts --- includes/Rts.h | 1 - includes/mkDerivedConstants.c | 6 - rts/Linker.c | 49 ---- rts/PrimOps.cmm | 515 +---------------------------------------- rts/StgPrimFloat.c | 81 ------- 5 files changed, 1 insertion(+), 651 deletions(-) diff --git a/includes/Rts.h b/includes/Rts.h index 0caccc7..6c039f8 100644 --- a/includes/Rts.h +++ b/includes/Rts.h @@ -205,7 +205,6 @@ DLL_IMPORT_RTS extern char *prog_name; extern void stackOverflow(void); -extern void __decodeDouble (MP_INT *man, 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); diff --git a/includes/mkDerivedConstants.c b/includes/mkDerivedConstants.c index a771818..89b9b1f 100644 --- a/includes/mkDerivedConstants.c +++ b/includes/mkDerivedConstants.c @@ -422,11 +422,5 @@ main(int argc, char *argv[]) struct_field(StgAsyncIOResult, errCode); #endif - struct_size(MP_INT); - struct_field(MP_INT,_mp_alloc); - struct_field(MP_INT,_mp_size); - struct_field(MP_INT,_mp_d); - - ctype(mp_limb_t); return 0; } diff --git a/rts/Linker.c b/rts/Linker.c index 17c5c3b..b075128 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -537,23 +537,6 @@ typedef struct _RtsSymbolVal { SymI_HasProto(stg_ap_pppppp_ret) #endif -/* On Windows, we link libgmp.a statically into libHSrts.dll */ -#ifdef mingw32_HOST_OS -#define GMP_SYMS \ - SymI_HasProto(__gmpz_cmp) \ - SymI_HasProto(__gmpz_cmp_si) \ - SymI_HasProto(__gmpz_cmp_ui) \ - SymI_HasProto(__gmpz_get_si) \ - SymI_HasProto(__gmpz_get_ui) -#else -#define GMP_SYMS \ - SymE_HasProto(__gmpz_cmp) \ - SymE_HasProto(__gmpz_cmp_si) \ - SymE_HasProto(__gmpz_cmp_ui) \ - SymE_HasProto(__gmpz_get_si) \ - SymE_HasProto(__gmpz_get_ui) -#endif - #define RTS_SYMBOLS \ Maybe_Stable_Names \ SymI_HasProto(StgReturn) \ @@ -591,13 +574,11 @@ typedef struct _RtsSymbolVal { SymI_HasProto(OutOfHeapHook) \ SymI_HasProto(StackOverflowHook) \ SymI_HasProto(addDLL) \ - GMP_SYMS \ SymI_HasProto(__int_encodeDouble) \ SymI_HasProto(__word_encodeDouble) \ SymI_HasProto(__2Int_encodeDouble) \ SymI_HasProto(__int_encodeFloat) \ SymI_HasProto(__word_encodeFloat) \ - SymI_HasProto(andIntegerzh_fast) \ SymI_HasProto(atomicallyzh_fast) \ SymI_HasProto(barf) \ SymI_HasProto(debugBelch) \ @@ -611,11 +592,7 @@ typedef struct _RtsSymbolVal { SymI_HasProto(checkzh_fast) \ SymI_HasProto(closure_flags) \ SymI_HasProto(cmp_thread) \ - SymI_HasProto(cmpIntegerzh_fast) \ - SymI_HasProto(cmpIntegerIntzh_fast) \ - SymI_HasProto(complementIntegerzh_fast) \ SymI_HasProto(createAdjustor) \ - SymI_HasProto(decodeDoublezh_fast) \ SymI_HasProto(decodeDoublezu2Intzh_fast) \ SymI_HasProto(decodeFloatzuIntzh_fast) \ SymI_HasProto(defaultsHook) \ @@ -623,8 +600,6 @@ typedef struct _RtsSymbolVal { SymI_HasProto(deRefWeakzh_fast) \ SymI_HasProto(deRefStablePtrzh_fast) \ SymI_HasProto(dirty_MUT_VAR) \ - SymI_HasProto(divExactIntegerzh_fast) \ - SymI_HasProto(divModIntegerzh_fast) \ SymI_HasProto(forkzh_fast) \ SymI_HasProto(forkOnzh_fast) \ SymI_HasProto(forkProcess) \ @@ -633,9 +608,6 @@ typedef struct _RtsSymbolVal { SymI_HasProto(freeStablePtr) \ SymI_HasProto(getOrSetTypeableStore) \ SymI_HasProto(getOrSetSignalHandlerStore) \ - SymI_HasProto(gcdIntegerzh_fast) \ - SymI_HasProto(gcdIntegerIntzh_fast) \ - SymI_HasProto(gcdIntzh_fast) \ SymI_HasProto(genSymZh) \ SymI_HasProto(genericRaise) \ SymI_HasProto(getProgArgv) \ @@ -654,9 +626,6 @@ typedef struct _RtsSymbolVal { SymI_HasProto(unpackClosurezh_fast) \ SymI_HasProto(getApStackValzh_fast) \ SymI_HasProto(getSparkzh_fast) \ - SymI_HasProto(int2Integerzh_fast) \ - SymI_HasProto(integer2Intzh_fast) \ - SymI_HasProto(integer2Wordzh_fast) \ SymI_HasProto(isCurrentThreadBoundzh_fast) \ SymI_HasProto(isDoubleDenormalized) \ SymI_HasProto(isDoubleInfinite) \ @@ -673,7 +642,6 @@ typedef struct _RtsSymbolVal { SymI_HasProto(insertSymbol) \ SymI_HasProto(lookupSymbol) \ SymI_HasProto(makeStablePtrzh_fast) \ - SymI_HasProto(minusIntegerzh_fast) \ SymI_HasProto(mkApUpd0zh_fast) \ SymI_HasProto(myThreadIdzh_fast) \ SymI_HasProto(labelThreadzh_fast) \ @@ -689,20 +657,15 @@ typedef struct _RtsSymbolVal { SymI_HasProto(newPinnedByteArrayzh_fast) \ SymI_HasProto(newAlignedPinnedByteArrayzh_fast) \ SymI_HasProto(newSpark) \ - SymI_HasProto(orIntegerzh_fast) \ SymI_HasProto(performGC) \ SymI_HasProto(performMajorGC) \ - SymI_HasProto(plusIntegerzh_fast) \ SymI_HasProto(prog_argc) \ SymI_HasProto(prog_argv) \ SymI_HasProto(putMVarzh_fast) \ - SymI_HasProto(quotIntegerzh_fast) \ - SymI_HasProto(quotRemIntegerzh_fast) \ SymI_HasProto(raisezh_fast) \ SymI_HasProto(raiseIOzh_fast) \ SymI_HasProto(readTVarzh_fast) \ SymI_HasProto(readTVarIOzh_fast) \ - SymI_HasProto(remIntegerzh_fast) \ SymI_HasProto(resetNonBlockingFd) \ SymI_HasProto(resumeThread) \ SymI_HasProto(resolveObjs) \ @@ -833,7 +796,6 @@ typedef struct _RtsSymbolVal { SymI_HasProto(suspendThread) \ SymI_HasProto(takeMVarzh_fast) \ SymI_HasProto(threadStatuszh_fast) \ - SymI_HasProto(timesIntegerzh_fast) \ SymI_HasProto(tryPutMVarzh_fast) \ SymI_HasProto(tryTakeMVarzh_fast) \ SymI_HasProto(unblockAsyncExceptionszh_fast) \ @@ -841,9 +803,7 @@ typedef struct _RtsSymbolVal { SymI_HasProto(unsafeThawArrayzh_fast) \ SymI_HasProto(waitReadzh_fast) \ SymI_HasProto(waitWritezh_fast) \ - SymI_HasProto(word2Integerzh_fast) \ SymI_HasProto(writeTVarzh_fast) \ - SymI_HasProto(xorIntegerzh_fast) \ SymI_HasProto(yieldzh_fast) \ SymI_NeedsProto(stg_interp_constr_entry) \ SymI_HasProto(alloc_blocks) \ @@ -862,13 +822,6 @@ typedef struct _RtsSymbolVal { SymI_HasProto(traceCcszh_fast) \ RTS_USER_SIGNALS_SYMBOLS -#ifdef SUPPORT_LONG_LONGS -#define RTS_LONG_LONG_SYMS \ - SymI_HasProto(int64ToIntegerzh_fast) \ - SymI_HasProto(word64ToIntegerzh_fast) -#else -#define RTS_LONG_LONG_SYMS /* nothing */ -#endif // 64-bit support functions in libgcc.a #if defined(__GNUC__) && SIZEOF_VOID_P <= 4 @@ -916,7 +869,6 @@ typedef struct _RtsSymbolVal { #define SymI_HasProto_redirect(vvv,xxx) /**/ RTS_SYMBOLS RTS_RET_SYMBOLS -RTS_LONG_LONG_SYMS RTS_POSIX_ONLY_SYMBOLS RTS_MINGW_ONLY_SYMBOLS RTS_CYGWIN_ONLY_SYMBOLS @@ -952,7 +904,6 @@ RTS_LIBFFI_SYMBOLS static RtsSymbolVal rtsSyms[] = { RTS_SYMBOLS RTS_RET_SYMBOLS - RTS_LONG_LONG_SYMS RTS_POSIX_ONLY_SYMBOLS RTS_MINGW_ONLY_SYMBOLS RTS_CYGWIN_ONLY_SYMBOLS diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 9ebe8fb..84567fe 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -28,24 +28,6 @@ #include "Cmm.h" #ifdef __PIC__ -#ifndef mingw32_HOST_OS -import __gmpz_init; -import __gmpz_add; -import __gmpz_sub; -import __gmpz_mul; -import __gmpz_gcd; -import __gmpn_gcd_1; -import __gmpn_cmp; -import __gmpz_tdiv_q; -import __gmpz_tdiv_r; -import __gmpz_tdiv_qr; -import __gmpz_fdiv_qr; -import __gmpz_divexact; -import __gmpz_and; -import __gmpz_xor; -import __gmpz_ior; -import __gmpz_com; -#endif import pthread_mutex_lock; import pthread_mutex_unlock; #endif @@ -470,470 +452,9 @@ deRefWeakzh_fast } /* ----------------------------------------------------------------------------- - Arbitrary-precision Integer operations. - - There are some assumptions in this code that mp_limb_t == W_. This is - the case for all the platforms that GHC supports, currently. + Floating point operations. -------------------------------------------------------------------------- */ -int2Integerzh_fast -{ - /* arguments: R1 = Int# */ - - W_ val, s, p; /* to avoid aliasing */ - - val = R1; - ALLOC_PRIM( SIZEOF_StgArrWords + WDS(1), NO_PTRS, int2Integerzh_fast ); - - p = Hp - SIZEOF_StgArrWords; - SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]); - StgArrWords_words(p) = 1; - - /* mpz_set_si is inlined here, makes things simpler */ - if (%lt(val,0)) { - s = -1; - Hp(0) = -val; - } else { - if (%gt(val,0)) { - s = 1; - Hp(0) = val; - } else { - s = 0; - } - } - - /* returns (# size :: Int#, - data :: ByteArray# - #) - */ - RET_NP(s,p); -} - -word2Integerzh_fast -{ - /* arguments: R1 = Word# */ - - W_ val, s, p; /* to avoid aliasing */ - - val = R1; - - ALLOC_PRIM( SIZEOF_StgArrWords + WDS(1), NO_PTRS, word2Integerzh_fast); - - p = Hp - SIZEOF_StgArrWords; - SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]); - StgArrWords_words(p) = 1; - - if (val != 0) { - s = 1; - W_[Hp] = val; - } else { - s = 0; - } - - /* returns (# size :: Int#, - data :: ByteArray# #) - */ - RET_NP(s,p); -} - - -/* - * 'long long' primops for converting to/from Integers. - */ - -#ifdef SUPPORT_LONG_LONGS - -int64ToIntegerzh_fast -{ - /* arguments: L1 = Int64# */ - - L_ val; - W_ hi, lo, s, neg, words_needed, p; - - val = L1; - neg = 0; - - hi = TO_W_(val >> 32); - lo = TO_W_(val); - - 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), - NO_PTRS, int64ToIntegerzh_fast ); - - p = Hp - SIZEOF_StgArrWords - WDS(words_needed) + WDS(1); - SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]); - StgArrWords_words(p) = words_needed; - - if ( %lt(hi,0) ) { - neg = 1; - lo = -lo; - if(lo == 0) { - hi = -hi; - } else { - hi = -hi - 1; - } - } - - if ( words_needed == 2 ) { - s = 2; - Hp(-1) = lo; - Hp(0) = hi; - } else { - if ( lo != 0 ) { - s = 1; - Hp(0) = lo; - } else /* val==0 */ { - s = 0; - } - } - if ( neg != 0 ) { - s = -s; - } - - /* returns (# size :: Int#, - data :: ByteArray# #) - */ - RET_NP(s,p); -} -word64ToIntegerzh_fast -{ - /* arguments: L1 = Word64# */ - - L_ val; - W_ hi, lo, s, words_needed, p; - - val = L1; - hi = TO_W_(val >> 32); - lo = TO_W_(val); - - if ( hi != 0 ) { - words_needed = 2; - } else { - words_needed = 1; - } - - ALLOC_PRIM( SIZEOF_StgArrWords + WDS(words_needed), - NO_PTRS, word64ToIntegerzh_fast ); - - p = Hp - SIZEOF_StgArrWords - WDS(words_needed) + WDS(1); - SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]); - StgArrWords_words(p) = words_needed; - - if ( hi != 0 ) { - s = 2; - Hp(-1) = lo; - Hp(0) = hi; - } else { - if ( lo != 0 ) { - s = 1; - Hp(0) = lo; - } else /* val==0 */ { - s = 0; - } - } - - /* returns (# size :: Int#, - data :: ByteArray# #) - */ - RET_NP(s,p); -} - -#endif /* SUPPORT_LONG_LONGS */ - -#define GMP_TAKE2_RET1(name,mp_fun) \ -name \ -{ \ - CInt s1, s2; \ - W_ d1, d2; \ - W_ mp_tmp1; \ - W_ mp_tmp2; \ - W_ mp_result1; \ - W_ mp_result2; \ - \ - /* call doYouWantToGC() */ \ - MAYBE_GC(R2_PTR & R4_PTR, name); \ - \ - STK_CHK_GEN( 4 * SIZEOF_MP_INT, R2_PTR & R4_PTR, name ); \ - \ - s1 = W_TO_INT(R1); \ - d1 = R2; \ - s2 = W_TO_INT(R3); \ - d2 = R4; \ - \ - mp_tmp1 = Sp - 1 * SIZEOF_MP_INT; \ - mp_tmp2 = Sp - 2 * SIZEOF_MP_INT; \ - mp_result1 = Sp - 3 * SIZEOF_MP_INT; \ - mp_result2 = Sp - 4 * SIZEOF_MP_INT; \ - MP_INT__mp_alloc(mp_tmp1) = W_TO_INT(StgArrWords_words(d1)); \ - MP_INT__mp_size(mp_tmp1) = (s1); \ - MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(d1); \ - MP_INT__mp_alloc(mp_tmp2) = W_TO_INT(StgArrWords_words(d2)); \ - MP_INT__mp_size(mp_tmp2) = (s2); \ - MP_INT__mp_d(mp_tmp2) = BYTE_ARR_CTS(d2); \ - \ - foreign "C" __gmpz_init(mp_result1 "ptr") []; \ - \ - /* Perform the operation */ \ - foreign "C" mp_fun(mp_result1 "ptr",mp_tmp1 "ptr",mp_tmp2 "ptr") []; \ - \ - RET_NP(TO_W_(MP_INT__mp_size(mp_result1)), \ - MP_INT__mp_d(mp_result1) - SIZEOF_StgArrWords); \ -} - -#define GMP_TAKE1_RET1(name,mp_fun) \ -name \ -{ \ - CInt s1; \ - W_ d1; \ - W_ mp_tmp1; \ - W_ mp_result1; \ - \ - /* call doYouWantToGC() */ \ - MAYBE_GC(R2_PTR, name); \ - \ - STK_CHK_GEN( 2 * SIZEOF_MP_INT, R2_PTR, name ); \ - \ - d1 = R2; \ - s1 = W_TO_INT(R1); \ - \ - mp_tmp1 = Sp - 1 * SIZEOF_MP_INT; \ - mp_result1 = Sp - 2 * SIZEOF_MP_INT; \ - MP_INT__mp_alloc(mp_tmp1) = W_TO_INT(StgArrWords_words(d1)); \ - MP_INT__mp_size(mp_tmp1) = (s1); \ - MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(d1); \ - \ - foreign "C" __gmpz_init(mp_result1 "ptr") []; \ - \ - /* Perform the operation */ \ - foreign "C" mp_fun(mp_result1 "ptr",mp_tmp1 "ptr") []; \ - \ - RET_NP(TO_W_(MP_INT__mp_size(mp_result1)), \ - MP_INT__mp_d(mp_result1) - SIZEOF_StgArrWords); \ -} - -#define GMP_TAKE2_RET2(name,mp_fun) \ -name \ -{ \ - CInt s1, s2; \ - W_ d1, d2; \ - W_ mp_tmp1; \ - W_ mp_tmp2; \ - W_ mp_result1; \ - W_ mp_result2; \ - \ - /* call doYouWantToGC() */ \ - MAYBE_GC(R2_PTR & R4_PTR, name); \ - \ - STK_CHK_GEN( 4 * SIZEOF_MP_INT, R2_PTR & R4_PTR, name ); \ - \ - s1 = W_TO_INT(R1); \ - d1 = R2; \ - s2 = W_TO_INT(R3); \ - d2 = R4; \ - \ - mp_tmp1 = Sp - 1 * SIZEOF_MP_INT; \ - mp_tmp2 = Sp - 2 * SIZEOF_MP_INT; \ - mp_result1 = Sp - 3 * SIZEOF_MP_INT; \ - mp_result2 = Sp - 4 * SIZEOF_MP_INT; \ - MP_INT__mp_alloc(mp_tmp1) = W_TO_INT(StgArrWords_words(d1)); \ - MP_INT__mp_size(mp_tmp1) = (s1); \ - MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(d1); \ - MP_INT__mp_alloc(mp_tmp2) = W_TO_INT(StgArrWords_words(d2)); \ - MP_INT__mp_size(mp_tmp2) = (s2); \ - MP_INT__mp_d(mp_tmp2) = BYTE_ARR_CTS(d2); \ - \ - foreign "C" __gmpz_init(mp_result1 "ptr") []; \ - foreign "C" __gmpz_init(mp_result2 "ptr") []; \ - \ - /* Perform the operation */ \ - foreign "C" mp_fun(mp_result1 "ptr",mp_result2 "ptr",mp_tmp1 "ptr",mp_tmp2 "ptr") []; \ - \ - RET_NPNP(TO_W_(MP_INT__mp_size(mp_result1)), \ - MP_INT__mp_d(mp_result1) - SIZEOF_StgArrWords, \ - TO_W_(MP_INT__mp_size(mp_result2)), \ - MP_INT__mp_d(mp_result2) - SIZEOF_StgArrWords); \ -} - -GMP_TAKE2_RET1(plusIntegerzh_fast, __gmpz_add) -GMP_TAKE2_RET1(minusIntegerzh_fast, __gmpz_sub) -GMP_TAKE2_RET1(timesIntegerzh_fast, __gmpz_mul) -GMP_TAKE2_RET1(gcdIntegerzh_fast, __gmpz_gcd) -GMP_TAKE2_RET1(quotIntegerzh_fast, __gmpz_tdiv_q) -GMP_TAKE2_RET1(remIntegerzh_fast, __gmpz_tdiv_r) -GMP_TAKE2_RET1(divExactIntegerzh_fast, __gmpz_divexact) -GMP_TAKE2_RET1(andIntegerzh_fast, __gmpz_and) -GMP_TAKE2_RET1(orIntegerzh_fast, __gmpz_ior) -GMP_TAKE2_RET1(xorIntegerzh_fast, __gmpz_xor) -GMP_TAKE1_RET1(complementIntegerzh_fast, __gmpz_com) - -GMP_TAKE2_RET2(quotRemIntegerzh_fast, __gmpz_tdiv_qr) -GMP_TAKE2_RET2(divModIntegerzh_fast, __gmpz_fdiv_qr) - -gcdIntzh_fast -{ - /* R1 = the first Int#; R2 = the second Int# */ - W_ r; - W_ mp_tmp_w; - - STK_CHK_GEN( 1 * SIZEOF_MP_INT, NO_PTRS, gcdIntzh_fast ); - - mp_tmp_w = Sp - 1 * SIZEOF_MP_INT; - - W_[mp_tmp_w] = R1; - (r) = foreign "C" __gmpn_gcd_1(mp_tmp_w "ptr", 1, R2) []; - - R1 = r; - /* Result parked in R1, return via info-pointer at TOS */ - jump %ENTRY_CODE(Sp(0)); -} - - -gcdIntegerIntzh_fast -{ - /* R1 = s1; R2 = d1; R3 = the int */ - W_ s1; - (s1) = foreign "C" __gmpn_gcd_1( BYTE_ARR_CTS(R2) "ptr", R1, R3) []; - R1 = s1; - - /* Result parked in R1, return via info-pointer at TOS */ - jump %ENTRY_CODE(Sp(0)); -} - - -cmpIntegerIntzh_fast -{ - /* R1 = s1; R2 = d1; R3 = the int */ - W_ usize, vsize, v_digit, u_digit; - - usize = R1; - vsize = 0; - v_digit = R3; - - // paraphrased from __gmpz_cmp_si() in the GMP sources - if (%gt(v_digit,0)) { - vsize = 1; - } else { - if (%lt(v_digit,0)) { - vsize = -1; - v_digit = -v_digit; - } - } - - if (usize != vsize) { - R1 = usize - vsize; - jump %ENTRY_CODE(Sp(0)); - } - - if (usize == 0) { - R1 = 0; - jump %ENTRY_CODE(Sp(0)); - } - - u_digit = W_[BYTE_ARR_CTS(R2)]; - - if (u_digit == v_digit) { - R1 = 0; - jump %ENTRY_CODE(Sp(0)); - } - - if (%gtu(u_digit,v_digit)) { // NB. unsigned: these are mp_limb_t's - R1 = usize; - } else { - R1 = -usize; - } - - jump %ENTRY_CODE(Sp(0)); -} - -cmpIntegerzh_fast -{ - /* R1 = s1; R2 = d1; R3 = s2; R4 = d2 */ - W_ usize, vsize, size, up, vp; - CInt cmp; - - // paraphrased from __gmpz_cmp() in the GMP sources - usize = R1; - vsize = R3; - - if (usize != vsize) { - R1 = usize - vsize; - jump %ENTRY_CODE(Sp(0)); - } - - if (usize == 0) { - R1 = 0; - jump %ENTRY_CODE(Sp(0)); - } - - if (%lt(usize,0)) { // NB. not <, which is unsigned - size = -usize; - } else { - size = usize; - } - - up = BYTE_ARR_CTS(R2); - vp = BYTE_ARR_CTS(R4); - - (cmp) = foreign "C" __gmpn_cmp(up "ptr", vp "ptr", size) []; - - if (cmp == 0 :: CInt) { - R1 = 0; - jump %ENTRY_CODE(Sp(0)); - } - - if (%lt(cmp,0 :: CInt) == %lt(usize,0)) { - R1 = 1; - } else { - R1 = (-1); - } - /* Result parked in R1, return via info-pointer at TOS */ - jump %ENTRY_CODE(Sp(0)); -} - -integer2Intzh_fast -{ - /* R1 = s; R2 = d */ - W_ r, s; - - s = R1; - if (s == 0) { - r = 0; - } else { - r = W_[R2 + SIZEOF_StgArrWords]; - if (%lt(s,0)) { - r = -r; - } - } - /* Result parked in R1, return via info-pointer at TOS */ - R1 = r; - jump %ENTRY_CODE(Sp(0)); -} - -integer2Wordzh_fast -{ - /* R1 = s; R2 = d */ - W_ r, s; - - s = R1; - if (s == 0) { - r = 0; - } else { - r = W_[R2 + SIZEOF_StgArrWords]; - if (%lt(s,0)) { - r = -r; - } - } - /* Result parked in R1, return via info-pointer at TOS */ - R1 = r; - jump %ENTRY_CODE(Sp(0)); -} - decodeFloatzuIntzh_fast { W_ p; @@ -956,40 +477,6 @@ decodeFloatzuIntzh_fast RET_NN(W_[mp_tmp1], W_[mp_tmp_w]); } -#define DOUBLE_MANTISSA_SIZE SIZEOF_DOUBLE -#define ARR_SIZE (SIZEOF_StgArrWords + DOUBLE_MANTISSA_SIZE) - -decodeDoublezh_fast -{ - D_ arg; - W_ p; - W_ mp_tmp1; - W_ mp_tmp_w; - - STK_CHK_GEN( 2 * SIZEOF_MP_INT, NO_PTRS, decodeDoublezh_fast ); - - mp_tmp1 = Sp - 1 * SIZEOF_MP_INT; - mp_tmp_w = Sp - 2 * SIZEOF_MP_INT; - - /* arguments: D1 = Double# */ - arg = D1; - - ALLOC_PRIM( ARR_SIZE, NO_PTRS, decodeDoublezh_fast ); - - /* Be prepared to tell Lennart-coded __decodeDouble - where mantissa.d can be put (it does not care about the rest) */ - p = Hp - ARR_SIZE + WDS(1); - SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]); - StgArrWords_words(p) = BYTES_TO_WDS(DOUBLE_MANTISSA_SIZE); - MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(p); - - /* Perform the operation */ - foreign "C" __decodeDouble(mp_tmp1 "ptr", mp_tmp_w "ptr",arg) []; - - /* returns: (Int# (expn), Int#, ByteArray#) */ - RET_NNP(W_[mp_tmp_w], TO_W_(MP_INT__mp_size(mp_tmp1)), p); -} - decodeDoublezu2Intzh_fast { D_ arg; diff --git a/rts/StgPrimFloat.c b/rts/StgPrimFloat.c index 743e0ea..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) */ @@ -153,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 */ -- 1.7.10.4