Implement the gmp primops in the integer-gmp package using cmm

7 files changed, 921 insertions, 12 deletions

diff --git a/libraries/integer-gmp/GHC/Integer.lhs b/libraries/integer-gmp/GHC/Integer.lhs
index 4bb0ece0e8..07f890565e 100644
--- a/libraries/integer-gmp/GHC/Integer.lhs
+++ b/libraries/integer-gmp/GHC/Integer.lhs
@@ -51,14 +51,19 @@ import GHC.Prim (
     -- Operations on Int# that we use for operations on S#
     quotInt#, remInt#, negateInt#,
     (==#), (/=#), (<=#), (>=#), (<#), (>#), (*#), (-#), (+#),
-    mulIntMayOflo#, addIntC#, subIntC#, gcdInt#,
+    mulIntMayOflo#, addIntC#, subIntC#,
     and#, or#, xor#,
     indexIntArray#,
-    -- GMP-related primitives in the RTS
+ )
+
+import GHC.Integer.Internals (
+    Integer(..),
+
+    -- GMP-related primitives
     cmpInteger#, cmpIntegerInt#,
     plusInteger#, minusInteger#, timesInteger#,
     quotRemInteger#, quotInteger#, remInteger#, divModInteger#,
-    gcdInteger#, gcdIntegerInt#, divExactInteger#,
+    gcdInteger#, gcdIntegerInt#, gcdInt#, divExactInteger#,
     decodeDouble#,
     int2Integer#, integer2Int#, word2Integer#, integer2Word#,
     andInteger#, orInteger#, xorInteger#, complementInteger#,
@@ -67,8 +72,6 @@ import GHC.Prim (
 #endif
  )
 
-import GHC.Integer.Internals (Integer(..))
-
 #if WORD_SIZE_IN_BITS < 64
 import GHC.IntWord64 (
             Int64#, Word64#,
@@ -460,12 +463,12 @@ floatFromInteger :: Integer -> Float#
 floatFromInteger (S# i#) = int2Float# i#
 floatFromInteger (J# s# d#) = encodeFloat# s# d# 0#
 
-foreign import ccall unsafe "__encodeFloat"
+foreign import ccall unsafe "integer_cbits_encodeFloat"
         encodeFloat# :: Int# -> ByteArray# -> Int# -> Float#
 foreign import ccall unsafe "__int_encodeFloat"
         int_encodeFloat# :: Int# -> Int# -> Float#
 
-foreign import ccall unsafe "__encodeDouble"
+foreign import ccall unsafe "integer_cbits_encodeDouble"
         encodeDouble# :: Int# -> ByteArray# -> Int# -> Double#
 foreign import ccall unsafe "__int_encodeDouble"
         int_encodeDouble# :: Int# -> Int# -> Double#
diff --git a/libraries/integer-gmp/GHC/Integer/Internals.hs b/libraries/integer-gmp/GHC/Integer/Internals.hs
index f1ffbf9ee0..e0e87be6b2 100644
--- a/libraries/integer-gmp/GHC/Integer/Internals.hs
+++ b/libraries/integer-gmp/GHC/Integer/Internals.hs
@@ -1,9 +1,58 @@
+{-# LANGUAGE ForeignFunctionInterface, GHCForeignImportPrim,
+             MagicHash, UnboxedTuples, UnliftedFFITypes #-}
 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
 {-# OPTIONS_HADDOCK hide #-}
 
-module GHC.Integer.Internals (Integer(..)) where
+#include "MachDeps.h"
+module GHC.Integer.Internals (
+    Integer(..),
 
-import GHC.Prim (Int#, ByteArray#)
+    cmpInteger#,
+    cmpIntegerInt#,
+
+    plusInteger#,
+    minusInteger#,
+    timesInteger#,
+
+    quotRemInteger#,
+    quotInteger#,
+    remInteger#,
+    divModInteger#,
+    divExactInteger#,
+
+    gcdInteger#,
+    gcdIntegerInt#,
+    gcdInt#,
+
+    decodeDouble#,
+
+    int2Integer#,
+    integer2Int#,
+
+    word2Integer#,
+    integer2Word#,
+
+    andInteger#,
+    orInteger#,
+    xorInteger#,
+    complementInteger#,
+
+#if WORD_SIZE_IN_BITS < 64
+    int64ToInteger#,
+    word64ToInteger#,
+#endif
+
+#ifndef WORD_SIZE_IN_BITS
+#error WORD_SIZE_IN_BITS not defined!!!
+#endif
+
+  ) where
+
+import GHC.Prim (Int#, Word#, Double#, ByteArray#)
+
+#if WORD_SIZE_IN_BITS < 64
+import GHC.Prim (Int64#, Word64#)
+#endif
 
 -- Double isn't available yet, and we shouldn't be using defaults anyway:
 default ()
@@ -19,3 +68,126 @@ data Integer
 foreign type dotnet "BigInteger" BigInteger
 #endif
 
+
+-- | Returns -1,0,1 according as first argument is less than, equal to, or greater than second argument.
+--
+foreign import prim "integer_cmm_cmpIntegerzh" cmpInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> Int#
+
+-- | Returns -1,0,1 according as first argument is less than, equal to, or greater than second argument, which
+--   is an ordinary Int\#.
+foreign import prim "integer_cmm_cmpIntegerIntzh" cmpIntegerInt#
+  :: Int# -> ByteArray# -> Int# -> Int#
+
+-- |
+--
+foreign import prim "integer_cmm_plusIntegerzh" plusInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> (# Int#, ByteArray# #)
+
+-- |
+--
+foreign import prim "integer_cmm_minusIntegerzh" minusInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> (# Int#, ByteArray# #)
+
+-- |
+--
+foreign import prim "integer_cmm_timesIntegerzh" timesInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> (# Int#, ByteArray# #)
+
+-- | Compute div and mod simultaneously, where div rounds towards negative
+-- infinity and\ @(q,r) = divModInteger#(x,y)@ implies
+-- @plusInteger# (timesInteger# q y) r = x@.
+--
+foreign import prim "integer_cmm_quotRemIntegerzh" quotRemInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> (# Int#, ByteArray#, Int#, ByteArray# #)
+
+-- | Rounds towards zero.
+--
+foreign import prim "integer_cmm_quotIntegerzh" quotInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> (# Int#, ByteArray# #)
+
+-- | Satisfies \texttt{plusInteger\# (timesInteger\# (quotInteger\# x y) y) (remInteger\# x y) == x}.
+--
+foreign import prim "integer_cmm_remIntegerzh" remInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> (# Int#, ByteArray# #)
+
+-- | Compute div and mod simultaneously, where div rounds towards negative infinity
+-- and\texttt{(q,r) = divModInteger\#(x,y)} implies \texttt{plusInteger\# (timesInteger\# q y) r = x}.
+--
+foreign import prim "integer_cmm_divModIntegerzh" divModInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> (# Int#, ByteArray#, Int#, ByteArray# #)
+
+-- | Divisor is guaranteed to be a factor of dividend.
+--
+foreign import prim "integer_cmm_divExactIntegerzh" divExactInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> (# Int#, ByteArray# #)
+
+-- | Greatest common divisor.
+--
+foreign import prim "integer_cmm_gcdIntegerzh" gcdInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> (# Int#, ByteArray# #)
+
+-- | Greatest common divisor, where second argument is an ordinary {\tt Int\#}.
+--
+foreign import prim "integer_cmm_gcdIntegerIntzh" gcdIntegerInt#
+  :: Int# -> ByteArray# -> Int# -> Int#
+
+-- |
+--
+foreign import prim "integer_cmm_gcdIntzh" gcdInt#
+  :: Int# -> Int# -> Int#
+
+-- | Convert to arbitrary-precision integer.
+--    First {\tt Int\#} in result is the exponent; second {\tt Int\#} and {\tt ByteArray\#}
+--  represent an {\tt Integer\#} holding the mantissa.
+--
+foreign import prim "integer_cmm_decodeDoublezh" decodeDouble#
+  :: Double# -> (# Int#, Int#, ByteArray# #)
+
+-- |
+--
+foreign import prim "integer_cmm_int2Integerzh" int2Integer#
+  :: Int# -> (# Int#, ByteArray# #)
+
+-- |
+--
+foreign import prim "integer_cmm_integer2Intzh" integer2Int#
+  :: Int# -> ByteArray# -> Int#
+
+-- |
+--
+foreign import prim "integer_cmm_word2Integerzh" word2Integer#
+  :: Word# -> (# Int#, ByteArray# #)
+
+-- |
+--
+foreign import prim "integer_cmm_integer2Wordzh" integer2Word#
+  :: Int# -> ByteArray# -> Word#
+
+-- |
+--
+foreign import prim "integer_cmm_andIntegerzh" andInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> (# Int#, ByteArray# #)
+
+-- |
+--
+foreign import prim "integer_cmm_orIntegerzh" orInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> (# Int#, ByteArray# #)
+
+-- |
+--
+foreign import prim "integer_cmm_xorIntegerzh" xorInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> (# Int#, ByteArray# #)
+
+-- |
+--
+foreign import prim "integer_cmm_complementIntegerzh" complementInteger#
+  :: Int# -> ByteArray# -> (# Int#, ByteArray# #)
+
+#if WORD_SIZE_IN_BITS < 64
+foreign import prim "integer_cmm_int64ToIntegerzh" int64ToInteger#
+  :: Int64# -> (# Int#, ByteArray# #)
+
+foreign import prim "integer_cmm_word64ToIntegerzh" word64ToInteger#
+  :: Word64# -> (# Int#, ByteArray# #)
+#endif
diff --git a/libraries/integer-gmp/cbits/alloc.c b/libraries/integer-gmp/cbits/alloc.c
new file mode 100644
index 0000000000..27713865eb
--- /dev/null
+++ b/libraries/integer-gmp/cbits/alloc.c
@@ -0,0 +1,105 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-2008
+ *
+ * ---------------------------------------------------------------------------*/
+
+/* TODO: do we need PosixSource.h ? it lives in rts/ not public includes/ */
+/* #include "PosixSource.h" */
+#include "Rts.h"
+
+#include "gmp.h"
+
+static void * stgAllocForGMP   (size_t size_in_bytes);
+static void * stgReallocForGMP (void *ptr, size_t old_size, size_t new_size);
+static void   stgDeallocForGMP (void *ptr STG_UNUSED, size_t size STG_UNUSED);
+
+static void initAllocForGMP( void ) __attribute__((constructor));
+
+/* -----------------------------------------------------------------------------
+   Tell GMP to use our custom heap allocation functions.
+
+   Our allocation strategy is to use GHC heap allocations rather than malloc
+   and co. The heap objects we use are ByteArray#s which of course have their
+   usual header word or two. But gmp doesn't know about ghc heap objects and
+   header words. So our allocator has to make a ByteArray# and return a pointer
+   to its interior! When the gmp function returns we recieve that interior
+   pointer. Then we look back a couple words to get the propper ByteArray#
+   pointer (which then gets returned as a ByteArray# and thus get tracked
+   properly by the GC).
+
+   WARNING!! WARNING!! WARNING!!
+
+     It is absolutely vital that this initialisation function be called before
+     any of the gmp functions are called. We'd still be looking back a couple
+     words for the ByteArray# header, but if we were accidentally using malloc
+     then it'd all go wrong because of course there would be no ByteArray#
+     header, just malloc's own internal book keeping info. To make things worse
+     we would not notice immediately, it'd only be when the GC comes round to
+     inspect things... BANG!
+
+     > Program received signal SIGSEGV, Segmentation fault.
+     > [Switching to Thread 0x7f5a9ebc76f0 (LWP 17838)]
+     > evacuate1 (p=0x7f5a99acd2e0) at rts/sm/Evac.c:375
+     > 375       switch (info->type) {
+
+   -------------------------------------------------------------------------- */
+
+static void initAllocForGMP( void )
+{
+  mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP);
+}
+
+
+/* -----------------------------------------------------------------------------
+   Allocation functions for GMP.
+
+   These all use the allocate() interface - we can't have any garbage
+   collection going on during a gmp operation, so we use allocate()
+   which always succeeds.  The gmp operations which might need to
+   allocate will ask the storage manager (via doYouWantToGC()) whether
+   a garbage collection is required, in case we get into a loop doing
+   only allocate() style allocation.
+   -------------------------------------------------------------------------- */
+
+static void *
+stgAllocForGMP (size_t size_in_bytes)
+{
+  StgArrWords* arr;
+  nat data_size_in_words, total_size_in_words;
+
+  /* round up to a whole number of words */
+  data_size_in_words  = (size_in_bytes + sizeof(W_) + 1) / sizeof(W_);
+  total_size_in_words = sizeofW(StgArrWords) + data_size_in_words;
+
+  /* allocate and fill it in. */
+  arr = (StgArrWords *)allocateLocal(rts_unsafeGetMyCapability(), total_size_in_words);
+  SET_ARR_HDR(arr, &stg_ARR_WORDS_info, CCCS, data_size_in_words);
+
+  /* and return a ptr to the goods inside the array */
+  return arr->payload;
+}
+
+static void *
+stgReallocForGMP (void *ptr, size_t old_size, size_t new_size)
+{
+    size_t min_size;
+    void *new_stuff_ptr = stgAllocForGMP(new_size);
+    nat i = 0;
+    char *p = (char *) ptr;
+    char *q = (char *) new_stuff_ptr;
+
+    min_size = old_size < new_size ? old_size : new_size;
+    /* TODO: use memcpy */
+    for (; i < min_size; i++, p++, q++) {
+        *q = *p;
+    }
+
+    return(new_stuff_ptr);
+}
+
+static void
+stgDeallocForGMP (void *ptr STG_UNUSED, size_t size STG_UNUSED)
+{
+    /* easy for us: the garbage collector does the dealloc'n */
+}
diff --git a/libraries/integer-gmp/cbits/cbits.c b/libraries/integer-gmp/cbits/cbits.c
new file mode 100644
index 0000000000..4b9fd01480
--- /dev/null
+++ b/libraries/integer-gmp/cbits/cbits.c
@@ -0,0 +1,13 @@
+
+/* We combine the two C files here.
+ *
+ * There is actually a good reason for this, really!
+ * The alloc file contains a __attribute__((constructor)) function. We must
+ * have this function in the same .o file as other stuff that actually gets
+ * used otherwise the static linker doesn't bother to pull in the .o file
+ * containing the constructor function. While we could just stick them in
+ * the same .c file that'd be a bit annoying. So we combine them here.
+ * */
+
+#include "alloc.c"
+#include "float.c"
diff --git a/libraries/integer-gmp/cbits/float.c b/libraries/integer-gmp/cbits/float.c
index efe2755f91..ec82346455 100644
--- a/libraries/integer-gmp/cbits/float.c
+++ b/libraries/integer-gmp/cbits/float.c
@@ -62,7 +62,7 @@
 #define __abs(a)                (( (a) >= 0 ) ? (a) : (-(a)))
 
 StgDouble
-__encodeDouble (I_ size, StgByteArray ba, I_ e) /* result = s * 2^e */
+integer_cbits_encodeDouble (I_ size, StgByteArray ba, I_ e) /* result = s * 2^e */
 {
     StgDouble r;
     const mp_limb_t *const arr = (const mp_limb_t *)ba;
@@ -84,7 +84,7 @@ __encodeDouble (I_ size, StgByteArray ba, I_ e) /* result = s * 2^e */
 }
 
 StgFloat
-__encodeFloat (I_ size, StgByteArray ba, I_ e) /* result = s * 2^e */
+integer_cbits_encodeFloat (I_ size, StgByteArray ba, I_ e) /* result = s * 2^e */
 {
     StgFloat r;
     const mp_limb_t *arr = (const mp_limb_t *)ba;
@@ -104,3 +104,65 @@ __encodeFloat (I_ size, StgByteArray ba, I_ e) /* result = s * 2^e */
 
     return r;
 }
+
+/* This only supports IEEE floating point */
+
+void
+integer_cbits_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;
+    }
+}
diff --git a/libraries/integer-gmp/cbits/gmp-wrappers.cmm b/libraries/integer-gmp/cbits/gmp-wrappers.cmm
new file mode 100644
index 0000000000..fd1e9c49d0
--- /dev/null
+++ b/libraries/integer-gmp/cbits/gmp-wrappers.cmm
@@ -0,0 +1,549 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-2004
+ *
+ * Out-of-line primitive operations
+ *
+ * This file contains the implementations of all the primitive
+ * operations ("primops") which are not expanded inline.  See
+ * ghc/compiler/prelude/primops.txt.pp for a list of all the primops;
+ * this file contains code for most of those with the attribute
+ * out_of_line=True.
+ *
+ * Entry convention: the entry convention for a primop is that all the
+ * args are in Stg registers (R1, R2, etc.).  This is to make writing
+ * the primops easier.  (see compiler/codeGen/CgCallConv.hs).
+ *
+ * Return convention: results from a primop are generally returned
+ * using the ordinary unboxed tuple return convention.  The C-- parser
+ * implements the RET_xxxx() macros to perform unboxed-tuple returns
+ * based on the prevailing return convention.
+ *
+ * This file is written in a subset of C--, extended with various
+ * features specific to GHC.  It is compiled by GHC directly.  For the
+ * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#include "Cmm.h"
+#include "DerivedConstants.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
+#endif
+
+/* -----------------------------------------------------------------------------
+   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.
+   -------------------------------------------------------------------------- */
+
+integer_cmm_int2Integerzh
+{
+   /* arguments: R1 = Int# */
+
+   W_ val, s, p;	/* to avoid aliasing */
+
+   val = R1;
+   ALLOC_PRIM( SIZEOF_StgArrWords + WDS(1), NO_PTRS, integer_cmm_int2Integerzh );
+
+   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);
+}
+
+integer_cmm_word2Integerzh
+{
+   /* arguments: R1 = Word# */
+
+   W_ val, s, p;	/* to avoid aliasing */
+
+   val = R1;
+
+   ALLOC_PRIM( SIZEOF_StgArrWords + WDS(1), NO_PTRS, integer_cmm_word2Integerzh);
+
+   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
+
+integer_cmm_int64ToIntegerzh
+{
+   /* 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, integer_cmm_int64ToIntegerzh );
+
+   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);
+}
+integer_cmm_word64ToIntegerzh
+{
+   /* 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, integer_cmm_word64ToIntegerzh );
+
+   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(integer_cmm_plusIntegerzh,     __gmpz_add)
+GMP_TAKE2_RET1(integer_cmm_minusIntegerzh,    __gmpz_sub)
+GMP_TAKE2_RET1(integer_cmm_timesIntegerzh,    __gmpz_mul)
+GMP_TAKE2_RET1(integer_cmm_gcdIntegerzh,      __gmpz_gcd)
+GMP_TAKE2_RET1(integer_cmm_quotIntegerzh,     __gmpz_tdiv_q)
+GMP_TAKE2_RET1(integer_cmm_remIntegerzh,      __gmpz_tdiv_r)
+GMP_TAKE2_RET1(integer_cmm_divExactIntegerzh, __gmpz_divexact)
+GMP_TAKE2_RET1(integer_cmm_andIntegerzh,      __gmpz_and)
+GMP_TAKE2_RET1(integer_cmm_orIntegerzh,       __gmpz_ior)
+GMP_TAKE2_RET1(integer_cmm_xorIntegerzh,      __gmpz_xor)
+GMP_TAKE1_RET1(integer_cmm_complementIntegerzh, __gmpz_com)
+
+GMP_TAKE2_RET2(integer_cmm_quotRemIntegerzh, __gmpz_tdiv_qr)
+GMP_TAKE2_RET2(integer_cmm_divModIntegerzh,  __gmpz_fdiv_qr)
+
+integer_cmm_gcdIntzh
+{
+    /* R1 = the first Int#; R2 = the second Int# */
+    W_ r;
+    W_ mp_tmp_w;
+
+    STK_CHK_GEN( 1 * SIZEOF_MP_INT, NO_PTRS, integer_cmm_gcdIntzh );
+
+    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));
+}
+
+
+integer_cmm_gcdIntegerIntzh
+{
+    /* 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));
+}
+
+
+integer_cmm_cmpIntegerIntzh
+{
+    /* 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));
+}
+
+integer_cmm_cmpIntegerzh
+{
+    /* 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));
+}
+
+integer_cmm_integer2Intzh
+{
+    /* 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));
+}
+
+integer_cmm_integer2Wordzh
+{
+  /* 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));
+}
+
+#define DOUBLE_MANTISSA_SIZE SIZEOF_DOUBLE
+#define ARR_SIZE (SIZEOF_StgArrWords + DOUBLE_MANTISSA_SIZE)
+
+integer_cmm_decodeDoublezh
+{
+    D_ arg;
+    W_ p;
+    W_ mp_tmp1;
+    W_ mp_tmp_w;
+
+    STK_CHK_GEN( 2 * SIZEOF_MP_INT, NO_PTRS, integer_cmm_decodeDoublezh );
+
+    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, integer_cmm_decodeDoublezh );
+
+    /* Be prepared to tell Lennart-coded integer_cbits_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" integer_cbits_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);
+}
diff --git a/libraries/integer-gmp/integer.cabal b/libraries/integer-gmp/integer.cabal
index 3b36812625..ca323a48dd 100644
--- a/libraries/integer-gmp/integer.cabal
+++ b/libraries/integer-gmp/integer.cabal
@@ -10,6 +10,10 @@ description:
 cabal-version:  >=1.6
 build-type: Simple
 
+extra-source-files:
+  cbits/float.c
+  cbits/alloc.c
+
 source-repository head
     type:     darcs
     location: http://darcs.haskell.org/packages/integer-gmp/
@@ -23,5 +27,6 @@ Library {
     -- We need to set the package name to integer (without a version number)
     -- as it's magic.
     ghc-options: -package-name integer
-    c-sources: cbits/float.c
+    extra-libraries: gmp
+    c-sources: cbits/cbits.c
 }