Remove the implementation of gmp primops from the rts
authorDuncan Coutts <duncan@well-typed.com>
Sat, 13 Jun 2009 19:18:51 +0000 (19:18 +0000)
committerDuncan Coutts <duncan@well-typed.com>
Sat, 13 Jun 2009 19:18:51 +0000 (19:18 +0000)
includes/Rts.h
includes/mkDerivedConstants.c
rts/Linker.c
rts/PrimOps.cmm
rts/StgPrimFloat.c

index 0caccc7..6c039f8 100644 (file)
@@ -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);
 
index a771818..89b9b1f 100644 (file)
@@ -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;
 }
index 17c5c3b..b075128 100644 (file)
@@ -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
index 9ebe8fb..84567fe 100644 (file)
 #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;
index 743e0ea..5987aa9 100644 (file)
  * (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 */