path: root/libraries/integer-gmp/cbits/gmp-wrappers.cmm

/* -----------------------------------------------------------------------------
 *
 * (c) The GHC Team, 1998-2012
 *
 * 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 "GmpDerivedConstants.h"
#include "HsIntegerGmp.h"

import "integer-gmp" __gmpz_add;
import "integer-gmp" __gmpz_add_ui;
import "integer-gmp" __gmpz_sub;
import "integer-gmp" __gmpz_sub_ui;
import "integer-gmp" __gmpz_mul;
import "integer-gmp" __gmpz_mul_2exp;
import "integer-gmp" __gmpz_mul_si;
import "integer-gmp" __gmpz_tstbit;
import "integer-gmp" __gmpz_fdiv_q_2exp;
import "integer-gmp" __gmpz_gcd;
import "integer-gmp" __gmpz_gcdext;
import "integer-gmp" __gmpn_gcd_1;
import "integer-gmp" __gmpn_cmp;
import "integer-gmp" __gmpz_tdiv_q;
import "integer-gmp" __gmpz_tdiv_q_ui;
import "integer-gmp" __gmpz_tdiv_r;
import "integer-gmp" __gmpz_tdiv_r_ui;
import "integer-gmp" __gmpz_fdiv_q;
import "integer-gmp" __gmpz_fdiv_q_ui;
import "integer-gmp" __gmpz_fdiv_r;
import "integer-gmp" __gmpz_fdiv_r_ui;
import "integer-gmp" __gmpz_tdiv_qr;
import "integer-gmp" __gmpz_tdiv_qr_ui;
import "integer-gmp" __gmpz_fdiv_qr;
import "integer-gmp" __gmpz_fdiv_qr_ui;
import "integer-gmp" __gmpz_divexact;
import "integer-gmp" __gmpz_divexact_ui;
import "integer-gmp" __gmpz_and;
import "integer-gmp" __gmpz_xor;
import "integer-gmp" __gmpz_ior;
import "integer-gmp" __gmpz_com;
import "integer-gmp" __gmpz_pow_ui;
import "integer-gmp" __gmpz_powm;
#if HAVE_SECURE_POWM == 1
import "integer-gmp" __gmpz_powm_sec;
#endif
import "integer-gmp" __gmpz_invert;
import "integer-gmp" __gmpz_nextprime;
import "integer-gmp" __gmpz_probab_prime_p;
import "integer-gmp" __gmpz_sizeinbase;
import "integer-gmp" __gmpz_import;
import "integer-gmp" __gmpz_export;

import "integer-gmp" integer_cbits_decodeDouble;

import "rts" stg_INTLIKE_closure;

/* -----------------------------------------------------------------------------
   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.
   -------------------------------------------------------------------------- */

#if SIZEOF_MP_LIMB_T != SIZEOF_W
#error "sizeof(mp_limb_t) != sizeof(W_)"
#endif

/* This is used when a dummy pointer is needed for a ByteArray# return value

   Ideally this would be a statically allocated 'ByteArray#'
   containing SIZEOF_W 0-bytes. However, since in those cases when a
   dummy value is needed, the 'ByteArray#' is not supposed to be
   accessed anyway, this is should be a tolerable hack.
 */
#define DUMMY_BYTE_ARR (stg_INTLIKE_closure+1)

/* set mpz_t from Int#/ByteArray# */
#define MP_INT_SET_FROM_BA(mp_ptr,i,ba)                  \
  MP_INT__mp_alloc(mp_ptr) = W_TO_INT(BYTE_ARR_WDS(ba)); \
  MP_INT__mp_size(mp_ptr)  = W_TO_INT(i);                \
  MP_INT__mp_d(mp_ptr)     = BYTE_ARR_CTS(ba)

/* convert mpz_t to Int#/ByteArray# return pair */
#define MP_INT_AS_PAIR(mp_ptr) \
  TO_W_(MP_INT__mp_size(mp_ptr)),(MP_INT__mp_d(mp_ptr)-SIZEOF_StgArrWords)

#define MP_INT_TO_BA(mp_ptr) \
  (MP_INT__mp_d(mp_ptr)-SIZEOF_StgArrWords)

/* Size of mpz_t with single limb */
#define SIZEOF_MP_INT_1LIMB (SIZEOF_MP_INT+WDS(1))

/* Initialize 0-valued single-limb mpz_t at mp_ptr */
#define MP_INT_1LIMB_INIT0(mp_ptr)                       \
  MP_INT__mp_alloc(mp_ptr) = W_TO_INT(1);                \
  MP_INT__mp_size(mp_ptr)  = W_TO_INT(0);                \
  MP_INT__mp_d(mp_ptr)     = (mp_ptr+SIZEOF_MP_INT)


/* return mpz_t as (# s::Int#, d::ByteArray#, l1::Word# #) tuple
 *
 * semantics:
 *
 *  (#  0, _, 0 #) -> value = 0
 *  (#  1, _, w #) -> value =  w
 *  (# -1, _, w #) -> value = -w
 *  (#  s, d, 0 #) -> value =  J# s d
 *
 */
#define MP_INT_1LIMB_RETURN(mp_ptr)                    \
  CInt __mp_s;                                         \
  __mp_s = MP_INT__mp_size(mp_ptr);                    \
                                                       \
  if (__mp_s == W_TO_INT(0))                           \
  {                                                    \
    return (0,DUMMY_BYTE_ARR,0);                       \
  }                                                    \
                                                       \
  if (__mp_s == W_TO_INT(-1) || __mp_s == W_TO_INT(1)) \
  {                                                    \
    return (TO_W_(__mp_s),DUMMY_BYTE_ARR,W_[MP_INT__mp_d(mp_ptr)]); \
  }                                                    \
                                                       \
  return (TO_W_(__mp_s),MP_INT_TO_BA(mp_ptr),0)

/* Helper macro used by MP_INT_1LIMB_RETURN2 */
#define MP_INT_1LIMB_AS_TUP3(s,d,w,mp_ptr) \
  CInt s; P_ d; W_ w;                            \
  s = MP_INT__mp_size(mp_ptr);                   \
                                                 \
  if (s == W_TO_INT(0))                          \
  {                                              \
    d = DUMMY_BYTE_ARR; w = 0;                            \
  } else {                                       \
    if (s == W_TO_INT(-1) || s == W_TO_INT(1))   \
    {                                            \
      d = DUMMY_BYTE_ARR; w = W_[MP_INT__mp_d(mp_ptr)];   \
    } else {                                     \
      d = MP_INT_TO_BA(mp_ptr); w = 0;           \
    }                                            \
  }

#define MP_INT_1LIMB_RETURN2(mp_ptr1,mp_ptr2)         \
  MP_INT_1LIMB_AS_TUP3(__r1s,__r1d,__r1w,mp_ptr1);    \
  MP_INT_1LIMB_AS_TUP3(__r2s,__r2d,__r2w,mp_ptr2);    \
  return (TO_W_(__r1s),__r1d,__r1w, TO_W_(__r2s),__r2d,__r2w)

/* :: ByteArray# -> Word# -> Word# -> Int# -> (# Int#, ByteArray#, Word# #) */
integer_cmm_importIntegerFromByteArrayzh (P_ ba, W_ of, W_ sz, W_ e)
{
  W_ src_ptr;
  W_ mp_result;

again:
  STK_CHK_GEN_N (SIZEOF_MP_INT_1LIMB);
  MAYBE_GC(again);

  mp_result = Sp - SIZEOF_MP_INT_1LIMB;
  MP_INT_1LIMB_INIT0(mp_result);

  src_ptr = BYTE_ARR_CTS(ba) + of;

  ccall __gmpz_import(mp_result "ptr", sz, W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, src_ptr "ptr");

  MP_INT_1LIMB_RETURN(mp_result);
}

/* :: Addr# -> Word# -> Int# -> State# s -> (# State# s, Int#, ByteArray#, Word# #) */
integer_cmm_importIntegerFromAddrzh (W_ src_ptr, W_ sz, W_ e)
{
  W_ mp_result;

again:
  STK_CHK_GEN_N (SIZEOF_MP_INT_1LIMB);
  MAYBE_GC(again);

  mp_result = Sp - SIZEOF_MP_INT_1LIMB;

  MP_INT_1LIMB_INIT0(mp_result);

  ccall __gmpz_import(mp_result "ptr", sz, W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, src_ptr "ptr");

  MP_INT_1LIMB_RETURN(mp_result);
}

/* :: Int# -> ByteArray# -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #) */
integer_cmm_exportIntegerToMutableByteArrayzh (W_ ws1, P_ d1, P_ mba, W_ of, W_ e)
{
  W_ dst_ptr;
  W_ mp_tmp;
  W_ cnt_result;

again:
  STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_W);
  MAYBE_GC(again);

  mp_tmp = Sp - SIZEOF_MP_INT;
  MP_INT_SET_FROM_BA(mp_tmp, ws1, d1);

  cnt_result = Sp - (SIZEOF_MP_INT + SIZEOF_W);
  W_[cnt_result] = 0;

  dst_ptr = BYTE_ARR_CTS(mba) + of;

  ccall __gmpz_export(dst_ptr "ptr", cnt_result "ptr", W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, mp_tmp "ptr");

  return (W_[cnt_result]);
}

/* :: Int# -> ByteArray# -> Addr# -> Int# -> State# s -> (# State# s, Word# #) */
integer_cmm_exportIntegerToAddrzh (W_ ws1, P_ d1, W_ dst_ptr, W_ e)
{
  W_ mp_tmp;
  W_ cnt_result;

again:
  STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_W);
  MAYBE_GC(again);

  mp_tmp = Sp - SIZEOF_MP_INT;
  MP_INT_SET_FROM_BA(mp_tmp, ws1, d1);

  cnt_result = Sp - (SIZEOF_MP_INT + SIZEOF_W);
  W_[cnt_result] = 0;

  ccall __gmpz_export(dst_ptr "ptr", cnt_result "ptr", W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, mp_tmp "ptr");

  return (W_[cnt_result]);
}

integer_cmm_int2Integerzh (W_ val)
{
   W_ s, p; /* to avoid aliasing */

   ALLOC_PRIM_N (SIZEOF_StgArrWords + WDS(1), integer_cmm_int2Integerzh, val);

   p = Hp - SIZEOF_StgArrWords;
   SET_HDR(p, stg_ARR_WORDS_info, CCCS);
   StgArrWords_bytes(p) = SIZEOF_W;

   /* 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#
               #)
   */
   return (s,p);
}

integer_cmm_word2Integerzh (W_ val)
{
   W_ s, p; /* to avoid aliasing */

   ALLOC_PRIM_N (SIZEOF_StgArrWords + WDS(1), integer_cmm_word2Integerzh, val);

   p = Hp - SIZEOF_StgArrWords;
   SET_HDR(p, stg_ARR_WORDS_info, CCCS);
   StgArrWords_bytes(p) = SIZEOF_W;

   if (val != 0) {
        s = 1;
        W_[Hp] = val;
   } else {
        s = 0;
   }

   /* returns (# size  :: Int#,
                 data  :: ByteArray# #)
   */
   return (s,p);
}


/*
 * 'long long' primops for converting to/from Integers.
 */

#if WORD_SIZE_IN_BITS < 64

integer_cmm_int64ToIntegerzh (L_ val)
{
   W_ hi, lo, s, neg, words_needed, p;

   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));

   p = Hp - SIZEOF_StgArrWords - WDS(words_needed) + WDS(1);
   SET_HDR(p, stg_ARR_WORDS_info, CCCS);
   StgArrWords_bytes(p) = WDS(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# #)
   */
   return (s,p);
}
integer_cmm_word64ToIntegerzh (L_ val)
{
   W_ hi, lo, s, words_needed, p;

   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));

   p = Hp - SIZEOF_StgArrWords - WDS(words_needed) + WDS(1);
   SET_HDR(p, stg_ARR_WORDS_info, CCCS);
   StgArrWords_bytes(p) = WDS(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# #)
   */
   return (s,p);
}

#endif /* WORD_SIZE_IN_BITS < 64 */

#define GMP_TAKE2_RET1(name,mp_fun)                             \
name (W_ ws1, P_ d1, W_ ws2, P_ d2)                             \
{                                                               \
  W_ mp_tmp1;                                                   \
  W_ mp_tmp2;                                                   \
  W_ mp_result1;                                                \
                                                                \
again:                                                          \
  STK_CHK_GEN_N (2*SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);        \
  MAYBE_GC(again);                                              \
                                                                \
  mp_tmp1    = Sp - 1*SIZEOF_MP_INT;                            \
  mp_tmp2    = Sp - 2*SIZEOF_MP_INT;                            \
  mp_result1 = Sp - 2*SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;      \
                                                                \
  MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                           \
  MP_INT_SET_FROM_BA(mp_tmp2,ws2,d2);                           \
                                                                \
  MP_INT_1LIMB_INIT0(mp_result1);                               \
                                                                \
  /* Perform the operation */                                   \
  ccall mp_fun(mp_result1 "ptr",mp_tmp1  "ptr",mp_tmp2  "ptr"); \
                                                                \
  MP_INT_1LIMB_RETURN(mp_result1);                              \
}

#define GMP_TAKE3_RET1(name,mp_fun)                             \
name (W_ ws1, P_ d1, W_ ws2, P_ d2, W_ ws3, P_ d3)              \
{                                                               \
  W_ mp_tmp1;                                                   \
  W_ mp_tmp2;                                                   \
  W_ mp_tmp3;                                                   \
  W_ mp_result1;                                                \
                                                                \
again:                                                          \
  STK_CHK_GEN_N (3*SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);        \
  MAYBE_GC(again);                                              \
                                                                \
  mp_tmp1    = Sp - 1*SIZEOF_MP_INT;                            \
  mp_tmp2    = Sp - 2*SIZEOF_MP_INT;                            \
  mp_tmp3    = Sp - 3*SIZEOF_MP_INT;                            \
  mp_result1 = Sp - 3*SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;      \
                                                                \
  MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                           \
  MP_INT_SET_FROM_BA(mp_tmp2,ws2,d2);                           \
  MP_INT_SET_FROM_BA(mp_tmp3,ws3,d3);                           \
                                                                \
  MP_INT_1LIMB_INIT0(mp_result1);                               \
                                                                \
  /* Perform the operation */                                   \
  ccall mp_fun(mp_result1 "ptr",                                \
               mp_tmp1 "ptr", mp_tmp2 "ptr", mp_tmp3 "ptr");    \
                                                                \
  MP_INT_1LIMB_RETURN(mp_result1);                              \
}

#define GMP_TAKE1_UL1_RET1(name,mp_fun)                         \
name (W_ ws1, P_ d1, W_ wul)                                    \
{                                                               \
  W_ mp_tmp;                                                    \
  W_ mp_result;                                                 \
                                                                \
  /* call doYouWantToGC() */                                    \
again:                                                          \
  STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);          \
  MAYBE_GC(again);                                              \
                                                                \
  mp_tmp     = Sp - SIZEOF_MP_INT;                              \
  mp_result  = Sp - SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;        \
                                                                \
  MP_INT_SET_FROM_BA(mp_tmp,ws1,d1);                            \
                                                                \
  MP_INT_1LIMB_INIT0(mp_result);                                \
                                                                \
  /* Perform the operation */                                   \
  ccall mp_fun(mp_result "ptr", mp_tmp "ptr", W_TO_LONG(wul));  \
                                                                \
  MP_INT_1LIMB_RETURN(mp_result);                               \
}

#define GMP_TAKE1_I1_RETI1(name,mp_fun)                         \
name (W_ ws1, P_ d1, W_ wi)                                     \
{                                                               \
  CInt res;                                                     \
  W_ mp_tmp;                                                    \
                                                                \
again:                                                          \
  STK_CHK_GEN_N (SIZEOF_MP_INT);                                \
  MAYBE_GC(again);                                              \
                                                                \
  mp_tmp     = Sp - 1 * SIZEOF_MP_INT;                          \
  MP_INT_SET_FROM_BA(mp_tmp,ws1,d1);                            \
                                                                \
  /* Perform the operation */                                   \
  (res) = ccall mp_fun(mp_tmp "ptr", W_TO_INT(wi));             \
                                                                \
  return (TO_W_(res));                                          \
}

#define GMP_TAKE1_UL1_RETI1(name,mp_fun)                        \
name (W_ ws1, P_ d1, W_ wul)                                    \
{                                                               \
  CInt res;                                                     \
  W_ mp_tmp;                                                    \
                                                                \
again:                                                          \
  STK_CHK_GEN_N (SIZEOF_MP_INT);                                \
  MAYBE_GC(again);                                              \
                                                                \
  mp_tmp     = Sp - 1 * SIZEOF_MP_INT;                          \
  MP_INT_SET_FROM_BA(mp_tmp,ws1,d1);                            \
                                                                \
  /* Perform the operation */                                   \
  (res) = ccall mp_fun(mp_tmp "ptr", W_TO_LONG(wul));           \
                                                                \
  return (TO_W_(res));                                          \
}

#define GMP_TAKE1_RET1(name,mp_fun)                             \
name (W_ ws1, P_ d1)                                            \
{                                                               \
  W_ mp_tmp1;                                                   \
  W_ mp_result1;                                                \
                                                                \
again:                                                          \
  STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);          \
  MAYBE_GC(again);                                              \
                                                                \
  mp_tmp1    = Sp - SIZEOF_MP_INT;                              \
  mp_result1 = Sp - SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;        \
                                                                \
  MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                           \
                                                                \
  MP_INT_1LIMB_INIT0(mp_result1);                               \
                                                                \
  /* Perform the operation */                                   \
  ccall mp_fun(mp_result1 "ptr",mp_tmp1 "ptr");                 \
                                                                \
  MP_INT_1LIMB_RETURN(mp_result1);                              \
}

#define GMP_TAKE2_RET2(name,mp_fun)                                     \
name (W_ ws1, P_ d1, W_ ws2, P_ d2)                                     \
{                                                                       \
  W_ mp_tmp1;                                                           \
  W_ mp_tmp2;                                                           \
  W_ mp_result1;                                                        \
  W_ mp_result2;                                                        \
                                                                        \
again:                                                                  \
  STK_CHK_GEN_N (2*SIZEOF_MP_INT + 2*SIZEOF_MP_INT_1LIMB);              \
  MAYBE_GC(again);                                                      \
                                                                        \
  mp_tmp1    = Sp - 1*SIZEOF_MP_INT;                                    \
  mp_tmp2    = Sp - 2*SIZEOF_MP_INT;                                    \
  mp_result1 = Sp - 2*SIZEOF_MP_INT - 1*SIZEOF_MP_INT_1LIMB;            \
  mp_result2 = Sp - 2*SIZEOF_MP_INT - 2*SIZEOF_MP_INT_1LIMB;            \
                                                                        \
  MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                                   \
  MP_INT_SET_FROM_BA(mp_tmp2,ws2,d2);                                   \
                                                                        \
  MP_INT_1LIMB_INIT0(mp_result1);                                       \
  MP_INT_1LIMB_INIT0(mp_result2);                                       \
                                                                        \
  /* Perform the operation */                                           \
  ccall mp_fun(mp_result1 "ptr", mp_result2 "ptr",                      \
               mp_tmp1 "ptr", mp_tmp2 "ptr");                           \
                                                                        \
  MP_INT_1LIMB_RETURN2(mp_result1, mp_result2);                         \
}

#define GMP_TAKE1_UL1_RET2(name,mp_fun)                                 \
name (W_ ws1, P_ d1, W_ wul2)                                           \
{                                                                       \
  W_ mp_tmp1;                                                           \
  W_ mp_result1;                                                        \
  W_ mp_result2;                                                        \
                                                                        \
again:                                                                  \
  STK_CHK_GEN_N (SIZEOF_MP_INT + 2*SIZEOF_MP_INT_1LIMB);                \
  MAYBE_GC(again);                                                      \
                                                                        \
  mp_tmp1    = Sp - SIZEOF_MP_INT;                                      \
  mp_result1 = Sp - SIZEOF_MP_INT - 1*SIZEOF_MP_INT_1LIMB;              \
  mp_result2 = Sp - SIZEOF_MP_INT - 2*SIZEOF_MP_INT_1LIMB;              \
                                                                        \
  MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                                   \
                                                                        \
  MP_INT_1LIMB_INIT0(mp_result1);                                       \
  MP_INT_1LIMB_INIT0(mp_result2);                                       \
                                                                        \
  /* Perform the operation */                                           \
  ccall mp_fun(mp_result1 "ptr", mp_result2 "ptr",                      \
               mp_tmp1 "ptr", W_TO_LONG(wul2));                         \
                                                                        \
  MP_INT_1LIMB_RETURN2(mp_result1, mp_result2);                         \
}

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_TAKE1_UL1_RET1(integer_cmm_timesIntegerIntzh,   __gmpz_mul_si)
GMP_TAKE2_RET1(integer_cmm_gcdIntegerzh,            __gmpz_gcd)
#define CMM_GMPZ_GCDEXT(g,s,a,b) __gmpz_gcdext(g,s,NULL,a,b)
GMP_TAKE2_RET2(integer_cmm_gcdExtIntegerzh,         CMM_GMPZ_GCDEXT)
GMP_TAKE2_RET1(integer_cmm_quotIntegerzh,           __gmpz_tdiv_q)
GMP_TAKE1_UL1_RET1(integer_cmm_quotIntegerWordzh,   __gmpz_tdiv_q_ui)
GMP_TAKE2_RET1(integer_cmm_remIntegerzh,            __gmpz_tdiv_r)
GMP_TAKE1_UL1_RET1(integer_cmm_remIntegerWordzh,    __gmpz_tdiv_r_ui)
GMP_TAKE2_RET1(integer_cmm_divIntegerzh,            __gmpz_fdiv_q)
GMP_TAKE1_UL1_RET1(integer_cmm_divIntegerWordzh,    __gmpz_fdiv_q_ui)
GMP_TAKE2_RET1(integer_cmm_modIntegerzh,            __gmpz_fdiv_r)
GMP_TAKE1_UL1_RET1(integer_cmm_modIntegerWordzh,    __gmpz_fdiv_r_ui)
GMP_TAKE2_RET1(integer_cmm_divExactIntegerzh,       __gmpz_divexact)
GMP_TAKE1_UL1_RET1(integer_cmm_divExactIntegerWordzh, __gmpz_divexact_ui)
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_UL1_RETI1(integer_cmm_testBitIntegerzh,   __gmpz_tstbit)
GMP_TAKE1_UL1_RET1(integer_cmm_mul2ExpIntegerzh,    __gmpz_mul_2exp)
GMP_TAKE1_UL1_RET1(integer_cmm_fdivQ2ExpIntegerzh,  __gmpz_fdiv_q_2exp)
GMP_TAKE1_RET1(integer_cmm_complementIntegerzh,     __gmpz_com)

GMP_TAKE2_RET2(integer_cmm_quotRemIntegerzh,        __gmpz_tdiv_qr)
GMP_TAKE1_UL1_RET2(integer_cmm_quotRemIntegerWordzh,__gmpz_tdiv_qr_ui)
GMP_TAKE2_RET2(integer_cmm_divModIntegerzh,         __gmpz_fdiv_qr)
GMP_TAKE1_UL1_RET2(integer_cmm_divModIntegerWordzh, __gmpz_fdiv_qr_ui)

GMP_TAKE3_RET1(integer_cmm_powModIntegerzh,         __gmpz_powm)
#if HAVE_SECURE_POWM == 1
GMP_TAKE3_RET1(integer_cmm_powModSecIntegerzh,      __gmpz_powm_sec)
#else
GMP_TAKE3_RET1(integer_cmm_powModSecIntegerzh,      __gmpz_powm)
#endif

GMP_TAKE2_RET1(integer_cmm_recipModIntegerzh,       __gmpz_invert)
GMP_TAKE1_UL1_RET1(integer_cmm_powIntegerzh,        __gmpz_pow_ui)

GMP_TAKE1_RET1(integer_cmm_nextPrimeIntegerzh,      __gmpz_nextprime)
GMP_TAKE1_I1_RETI1(integer_cmm_testPrimeIntegerzh,  __gmpz_probab_prime_p)

GMP_TAKE1_I1_RETI1(integer_cmm_sizeInBasezh,        __gmpz_sizeinbase)

integer_cmm_gcdIntzh (W_ int1, W_ int2)
{
    W_ r;
    W_ mp_tmp_w;

    STK_CHK_GEN_N (1 * SIZEOF_W);

    mp_tmp_w = Sp - 1 * SIZEOF_W;

    W_[mp_tmp_w] = int1;
    (r) = ccall __gmpn_gcd_1(mp_tmp_w "ptr", 1, int2);

    return (r);
}


integer_cmm_gcdIntegerIntzh (W_ s1, P_ d1, W_ int)
{
    W_ r;
    (r) = ccall __gmpn_gcd_1 (BYTE_ARR_CTS(d1) "ptr", s1, int);
    return (r);
}


integer_cmm_cmpIntegerIntzh (W_ usize, P_ d1, W_ v_digit)
{
    W_ vsize, u_digit;

    vsize = 0;

    // 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) {
        return (usize - vsize);
    }

    if (usize == 0) {
        return (0);
    }

    u_digit = W_[BYTE_ARR_CTS(d1)];

    if (u_digit == v_digit) {
        return (0);
    }

    if (%gtu(u_digit,v_digit)) { // NB. unsigned: these are mp_limb_t's
        return (usize);
    } else {
        return (-usize);
    }
}

integer_cmm_cmpIntegerzh (W_ usize, P_ d1, W_ vsize, P_ d2)
{
    W_ size, up, vp;
    CInt cmp;

    // paraphrased from __gmpz_cmp() in the GMP sources

    if (usize != vsize) {
        return (usize - vsize);
    }

    if (usize == 0) {
        return (0);
    }

    if (%lt(usize,0)) { // NB. not <, which is unsigned
        size = -usize;
    } else {
        size = usize;
    }

    up = BYTE_ARR_CTS(d1);
    vp = BYTE_ARR_CTS(d2);

    (cmp) = ccall __gmpn_cmp(up "ptr", vp "ptr", size);

    if (cmp == 0 :: CInt) {
        return (0);
    }

    if (%lt(cmp,0 :: CInt) == %lt(usize,0)) {
        return (1);
    } else {
        return (-1);
    }
}

#define DOUBLE_MANTISSA_SIZE SIZEOF_DOUBLE
#define ARR_SIZE (SIZEOF_StgArrWords + DOUBLE_MANTISSA_SIZE)

integer_cmm_decodeDoublezh (D_ arg)
{
    W_ mp_tmp1;
    W_ mp_tmp_w;

#if SIZEOF_DOUBLE != SIZEOF_W
    W_ p;

    STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_W);
    ALLOC_PRIM (ARR_SIZE);

    mp_tmp1  = Sp - SIZEOF_MP_INT;
    mp_tmp_w = Sp - SIZEOF_MP_INT - SIZEOF_W;

    /* 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, CCCS);
    StgArrWords_bytes(p) = DOUBLE_MANTISSA_SIZE;
    MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(p);

#else
    /* When SIZEOF_DOUBLE == SIZEOF_W == 8, the result will fit into a
       single 8-byte limb, and so we avoid allocating on the Heap and
       use only the Stack instead */

    STK_CHK_GEN_N (SIZEOF_MP_INT_1LIMB + SIZEOF_W);

    mp_tmp1  = Sp - SIZEOF_MP_INT_1LIMB;
    mp_tmp_w = Sp - SIZEOF_MP_INT_1LIMB - SIZEOF_W;

    MP_INT_1LIMB_INIT0(mp_tmp1);
#endif

    /* Perform the operation */
    ccall integer_cbits_decodeDouble(mp_tmp1 "ptr", mp_tmp_w "ptr", arg);

    /* returns: (Int# (expn), MPZ#) */
    MP_INT_1LIMB_AS_TUP3(r1s, r1d, r1w, mp_tmp1);

    return (W_[mp_tmp_w], TO_W_(r1s), r1d, r1w);
}

/* :: Int# -> ByteArray# -> Int# -> (# Int#, ByteArray#, Word# #) */
#define GMPX_TAKE1_UL1_RET1(name,pos_arg_fun,neg_arg_fun)               \
name(W_ ws1, P_ d1, W_ wl)                                              \
{                                                                       \
  W_ mp_tmp;                                                            \
  W_ mp_result;                                                         \
                                                                        \
again:                                                                  \
  STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);                  \
  MAYBE_GC(again);                                                      \
                                                                        \
  mp_tmp     = Sp - SIZEOF_MP_INT;                                      \
  mp_result  = Sp - SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;                \
                                                                        \
  MP_INT_SET_FROM_BA(mp_tmp,ws1,d1);                                    \
                                                                        \
  MP_INT_1LIMB_INIT0(mp_result);                                        \
                                                                        \
  if(%lt(wl,0)) {                                                       \
      ccall neg_arg_fun(mp_result "ptr", mp_tmp "ptr", W_TO_LONG(-wl)); \
  } else {                                                              \
      ccall pos_arg_fun(mp_result "ptr", mp_tmp "ptr", W_TO_LONG(wl));  \
  }                                                                     \
                                                                        \
  MP_INT_1LIMB_RETURN(mp_result);                                       \
}

/* NB: We need both primitives as we can't express 'minusIntegerInt#'
   in terms of 'plusIntegerInt#' for @minBound :: Int@ */
GMPX_TAKE1_UL1_RET1(integer_cmm_plusIntegerIntzh,__gmpz_add_ui,__gmpz_sub_ui)
GMPX_TAKE1_UL1_RET1(integer_cmm_minusIntegerIntzh,__gmpz_sub_ui,__gmpz_add_ui)