libraries/integer-gmp/cbits/gmp-wrappers.cmm

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team, 1998-2012
   4  *
   5  * Out-of-line primitive operations
   6  *
   7  * This file contains the implementations of all the primitive
   8  * operations ("primops") which are not expanded inline.  See
   9  * ghc/compiler/prelude/primops.txt.pp for a list of all the primops;
  10  * this file contains code for most of those with the attribute
  11  * out_of_line=True.
  12  *
  13  * Entry convention: the entry convention for a primop is that all the
  14  * args are in Stg registers (R1, R2, etc.).  This is to make writing
  15  * the primops easier.  (see compiler/codeGen/CgCallConv.hs).
  16  *
  17  * Return convention: results from a primop are generally returned
  18  * using the ordinary unboxed tuple return convention.  The C-- parser
  19  * implements the RET_xxxx() macros to perform unboxed-tuple returns
  20  * based on the prevailing return convention.
  21  *
  22  * This file is written in a subset of C--, extended with various
  23  * features specific to GHC.  It is compiled by GHC directly.  For the
  24  * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
  25  *
  26  * ---------------------------------------------------------------------------*/
  27
  28 #include "Cmm.h"
  29 #include "GmpDerivedConstants.h"
  30
  31 import "integer-gmp" __gmpz_init;
  32 import "integer-gmp" __gmpz_add;
  33 import "integer-gmp" __gmpz_sub;
  34 import "integer-gmp" __gmpz_mul;
  35 import "integer-gmp" __gmpz_mul_2exp;
  36 import "integer-gmp" __gmpz_mul_si;
  37 import "integer-gmp" __gmpz_tstbit;
  38 import "integer-gmp" __gmpz_fdiv_q_2exp;
  39 import "integer-gmp" __gmpz_gcd;
  40 import "integer-gmp" __gmpz_gcdext;
  41 import "integer-gmp" __gmpn_gcd_1;
  42 import "integer-gmp" __gmpn_cmp;
  43 import "integer-gmp" __gmpz_tdiv_q;
  44 import "integer-gmp" __gmpz_tdiv_r;
  45 import "integer-gmp" __gmpz_fdiv_q;
  46 import "integer-gmp" __gmpz_fdiv_r;
  47 import "integer-gmp" __gmpz_tdiv_qr;
  48 import "integer-gmp" __gmpz_fdiv_qr;
  49 import "integer-gmp" __gmpz_divexact;
  50 import "integer-gmp" __gmpz_and;
  51 import "integer-gmp" __gmpz_xor;
  52 import "integer-gmp" __gmpz_ior;
  53 import "integer-gmp" __gmpz_com;
  54 import "integer-gmp" __gmpz_pow_ui;
  55 import "integer-gmp" __gmpz_powm;
  56 import "integer-gmp" __gmpz_powm_sec;
  57 import "integer-gmp" __gmpz_invert;
  58 import "integer-gmp" __gmpz_nextprime;
  59 import "integer-gmp" __gmpz_probab_prime_p;
  60 import "integer-gmp" __gmpz_sizeinbase;
  61 import "integer-gmp" __gmpz_import;
  62 import "integer-gmp" __gmpz_export;
  63
  64 import "integer-gmp" integer_cbits_decodeDouble;
  65
  66 /* -----------------------------------------------------------------------------
  67    Arbitrary-precision Integer operations.
  68
  69    There are some assumptions in this code that mp_limb_t == W_.  This is
  70    the case for all the platforms that GHC supports, currently.
  71    -------------------------------------------------------------------------- */
  72
  73 /* set mpz_t from Int#/ByteArray# */
  74 #define MP_INT_SET_FROM_BA(mp_ptr,i,ba)                  \
  75   MP_INT__mp_alloc(mp_ptr) = W_TO_INT(BYTE_ARR_WDS(ba)); \
  76   MP_INT__mp_size(mp_ptr)  = W_TO_INT(i);                \
  77   MP_INT__mp_d(mp_ptr)     = BYTE_ARR_CTS(ba)
  78
  79 /* convert mpz_t to Int#/ByteArray# return pair */
  80 #define MP_INT_AS_PAIR(mp_ptr) \
  81   TO_W_(MP_INT__mp_size(mp_ptr)),(MP_INT__mp_d(mp_ptr)-SIZEOF_StgArrWords)
  82
  83
  84 /* :: ByteArray# -> Word# -> Word# -> Int# -> (# Int#, ByteArray# #) */
  85 integer_cmm_importIntegerFromByteArrayzh (P_ ba, W_ of, W_ sz, W_ e)
  86 {
  87   W_ src_ptr;
  88   W_ mp_result;
  89
  90 again:
  91   STK_CHK_GEN_N (SIZEOF_MP_INT);
  92   MAYBE_GC(again);
  93
  94   mp_result = Sp - SIZEOF_MP_INT;
  95
  96   src_ptr = BYTE_ARR_CTS(ba) + of;
  97
  98   ccall __gmpz_init(mp_result "ptr");
  99   ccall __gmpz_import(mp_result "ptr", sz, W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, src_ptr "ptr");
 100
 101   return(MP_INT_AS_PAIR(mp_result));
 102 }
 103
 104 /* :: Addr# -> Word# -> Int# -> State# s -> (# State# s, Int#, ByteArray# #) */
 105 integer_cmm_importIntegerFromAddrzh (W_ src_ptr, W_ sz, W_ e)
 106 {
 107   W_ mp_result;
 108
 109 again:
 110   STK_CHK_GEN_N (SIZEOF_MP_INT);
 111   MAYBE_GC(again);
 112
 113   mp_result = Sp - SIZEOF_MP_INT;
 114
 115   ccall __gmpz_init(mp_result "ptr");
 116   ccall __gmpz_import(mp_result "ptr", sz, W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, src_ptr "ptr");
 117
 118   return(MP_INT_AS_PAIR(mp_result));
 119 }
 120
 121 /* :: Int# -> ByteArray# -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #) */
 122 integer_cmm_exportIntegerToMutableByteArrayzh (W_ ws1, P_ d1, P_ mba, W_ of, W_ e)
 123 {
 124   W_ dst_ptr;
 125   W_ mp_tmp;
 126   W_ cnt_result;
 127
 128 again:
 129   STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_W);
 130   MAYBE_GC(again);
 131
 132   mp_tmp = Sp - SIZEOF_MP_INT;
 133   MP_INT_SET_FROM_BA(mp_tmp, ws1, d1);
 134
 135   cnt_result = Sp - (SIZEOF_MP_INT + SIZEOF_W);
 136   W_[cnt_result] = 0;
 137
 138   dst_ptr = BYTE_ARR_CTS(mba) + of;
 139
 140   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");
 141
 142   return (W_[cnt_result]);
 143 }
 144
 145 /* :: Int# -> ByteArray# -> Addr# -> Int# -> State# s -> (# State# s, Word# #) */
 146 integer_cmm_exportIntegerToAddrzh (W_ ws1, P_ d1, W_ dst_ptr, W_ e)
 147 {
 148   W_ mp_tmp;
 149   W_ cnt_result;
 150
 151 again:
 152   STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_W);
 153   MAYBE_GC(again);
 154
 155   mp_tmp = Sp - SIZEOF_MP_INT;
 156   MP_INT_SET_FROM_BA(mp_tmp, ws1, d1);
 157
 158   cnt_result = Sp - (SIZEOF_MP_INT + SIZEOF_W);
 159   W_[cnt_result] = 0;
 160
 161   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");
 162
 163   return (W_[cnt_result]);
 164 }
 165
 166 integer_cmm_int2Integerzh (W_ val)
 167 {
 168    W_ s, p; /* to avoid aliasing */
 169
 170    ALLOC_PRIM_N (SIZEOF_StgArrWords + WDS(1), integer_cmm_int2Integerzh, val);
 171
 172    p = Hp - SIZEOF_StgArrWords;
 173    SET_HDR(p, stg_ARR_WORDS_info, CCCS);
 174    StgArrWords_bytes(p) = SIZEOF_W;
 175
 176    /* mpz_set_si is inlined here, makes things simpler */
 177    if (%lt(val,0)) {
 178         s  = -1;
 179         Hp(0) = -val;
 180    } else {
 181      if (%gt(val,0)) {
 182         s = 1;
 183         Hp(0) = val;
 184      } else {
 185         s = 0;
 186      }
 187   }
 188
 189    /* returns (# size  :: Int#,
 190                  data  :: ByteArray#
 191                #)
 192    */
 193    return (s,p);
 194 }
 195
 196 integer_cmm_word2Integerzh (W_ val)
 197 {
 198    W_ s, p; /* to avoid aliasing */
 199
 200    ALLOC_PRIM_N (SIZEOF_StgArrWords + WDS(1), integer_cmm_word2Integerzh, val);
 201
 202    p = Hp - SIZEOF_StgArrWords;
 203    SET_HDR(p, stg_ARR_WORDS_info, CCCS);
 204    StgArrWords_bytes(p) = SIZEOF_W;
 205
 206    if (val != 0) {
 207         s = 1;
 208         W_[Hp] = val;
 209    } else {
 210         s = 0;
 211    }
 212
 213    /* returns (# size  :: Int#,
 214                  data  :: ByteArray# #)
 215    */
 216    return (s,p);
 217 }
 218
 219
 220 /*
 221  * 'long long' primops for converting to/from Integers.
 222  */
 223
 224 #if WORD_SIZE_IN_BITS < 64
 225
 226 integer_cmm_int64ToIntegerzh (L_ val)
 227 {
 228    W_ hi, lo, s, neg, words_needed, p;
 229
 230    neg = 0;
 231
 232    hi = TO_W_(val >> 32);
 233    lo = TO_W_(val);
 234
 235    if ( hi == 0 || (hi == 0xFFFFFFFF && lo != 0) )  {
 236        // minimum is one word
 237        words_needed = 1;
 238    } else {
 239        words_needed = 2;
 240    }
 241
 242    ALLOC_PRIM (SIZEOF_StgArrWords + WDS(words_needed));
 243
 244    p = Hp - SIZEOF_StgArrWords - WDS(words_needed) + WDS(1);
 245    SET_HDR(p, stg_ARR_WORDS_info, CCCS);
 246    StgArrWords_bytes(p) = WDS(words_needed);
 247
 248    if ( %lt(hi,0) ) {
 249      neg = 1;
 250      lo = -lo;
 251      if(lo == 0) {
 252        hi = -hi;
 253      } else {
 254        hi = -hi - 1;
 255      }
 256    }
 257
 258    if ( words_needed == 2 )  {
 259       s = 2;
 260       Hp(-1) = lo;
 261       Hp(0) = hi;
 262    } else {
 263        if ( lo != 0 ) {
 264            s = 1;
 265            Hp(0) = lo;
 266        } else /* val==0 */  {
 267            s = 0;
 268        }
 269    }
 270    if ( neg != 0 ) {
 271         s = -s;
 272    }
 273
 274    /* returns (# size  :: Int#,
 275                  data  :: ByteArray# #)
 276    */
 277    return (s,p);
 278 }
 279 integer_cmm_word64ToIntegerzh (L_ val)
 280 {
 281    W_ hi, lo, s, words_needed, p;
 282
 283    hi = TO_W_(val >> 32);
 284    lo = TO_W_(val);
 285
 286    if ( hi != 0 ) {
 287       words_needed = 2;
 288    } else {
 289       words_needed = 1;
 290    }
 291
 292    ALLOC_PRIM (SIZEOF_StgArrWords + WDS(words_needed));
 293
 294    p = Hp - SIZEOF_StgArrWords - WDS(words_needed) + WDS(1);
 295    SET_HDR(p, stg_ARR_WORDS_info, CCCS);
 296    StgArrWords_bytes(p) = WDS(words_needed);
 297
 298    if ( hi != 0 ) {
 299      s = 2;
 300      Hp(-1) = lo;
 301      Hp(0)  = hi;
 302    } else {
 303       if ( lo != 0 ) {
 304         s = 1;
 305         Hp(0) = lo;
 306      } else /* val==0 */  {
 307       s = 0;
 308      }
 309   }
 310
 311    /* returns (# size  :: Int#,
 312                  data  :: ByteArray# #)
 313    */
 314    return (s,p);
 315 }
 316
 317 #endif /* WORD_SIZE_IN_BITS < 64 */
 318
 319 #define GMP_TAKE2_RET1(name,mp_fun)                             \
 320 name (W_ ws1, P_ d1, W_ ws2, P_ d2)                             \
 321 {                                                               \
 322   W_ mp_tmp1;                                                   \
 323   W_ mp_tmp2;                                                   \
 324   W_ mp_result1;                                                \
 325                                                                 \
 326 again:                                                          \
 327   STK_CHK_GEN_N (3 * SIZEOF_MP_INT);                            \
 328   MAYBE_GC(again);                                              \
 329                                                                 \
 330   mp_tmp1    = Sp - 1 * SIZEOF_MP_INT;                          \
 331   mp_tmp2    = Sp - 2 * SIZEOF_MP_INT;                          \
 332   mp_result1 = Sp - 3 * SIZEOF_MP_INT;                          \
 333                                                                 \
 334   MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                           \
 335   MP_INT_SET_FROM_BA(mp_tmp2,ws2,d2);                           \
 336                                                                 \
 337   ccall __gmpz_init(mp_result1 "ptr");                          \
 338                                                                 \
 339   /* Perform the operation */                                   \
 340   ccall mp_fun(mp_result1 "ptr",mp_tmp1  "ptr",mp_tmp2  "ptr"); \
 341                                                                 \
 342   return (MP_INT_AS_PAIR(mp_result1));                          \
 343 }
 344
 345 #define GMP_TAKE3_RET1(name,mp_fun)                             \
 346 name (W_ ws1, P_ d1, W_ ws2, P_ d2, W_ ws3, P_ d3)              \
 347 {                                                               \
 348   W_ mp_tmp1;                                                   \
 349   W_ mp_tmp2;                                                   \
 350   W_ mp_tmp3;                                                   \
 351   W_ mp_result1;                                                \
 352                                                                 \
 353 again:                                                          \
 354   STK_CHK_GEN_N (4 * SIZEOF_MP_INT);                            \
 355   MAYBE_GC(again);                                              \
 356                                                                 \
 357   mp_tmp1    = Sp - 1 * SIZEOF_MP_INT;                          \
 358   mp_tmp2    = Sp - 2 * SIZEOF_MP_INT;                          \
 359   mp_tmp3    = Sp - 3 * SIZEOF_MP_INT;                          \
 360   mp_result1 = Sp - 4 * SIZEOF_MP_INT;                          \
 361                                                                 \
 362   MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                           \
 363   MP_INT_SET_FROM_BA(mp_tmp2,ws2,d2);                           \
 364   MP_INT_SET_FROM_BA(mp_tmp3,ws3,d3);                           \
 365                                                                 \
 366   ccall __gmpz_init(mp_result1 "ptr");                          \
 367                                                                 \
 368   /* Perform the operation */                                   \
 369   ccall mp_fun(mp_result1 "ptr",mp_tmp1  "ptr",mp_tmp2  "ptr",  \
 370                mp_tmp3  "ptr");                                 \
 371                                                                 \
 372   return (MP_INT_AS_PAIR(mp_result1));                          \
 373 }
 374
 375 #define GMP_TAKE1_UL1_RET1(name,mp_fun)                         \
 376 name (W_ ws1, P_ d1, W_ wul)                                    \
 377 {                                                               \
 378   W_ mp_tmp;                                                    \
 379   W_ mp_result;                                                 \
 380                                                                 \
 381   /* call doYouWantToGC() */                                    \
 382 again:                                                          \
 383   STK_CHK_GEN_N (2 * SIZEOF_MP_INT);                            \
 384   MAYBE_GC(again);                                              \
 385                                                                 \
 386   mp_tmp     = Sp - 1 * SIZEOF_MP_INT;                          \
 387   mp_result  = Sp - 2 * SIZEOF_MP_INT;                          \
 388                                                                 \
 389   MP_INT_SET_FROM_BA(mp_tmp,ws1,d1);                            \
 390                                                                 \
 391   ccall __gmpz_init(mp_result "ptr");                           \
 392                                                                 \
 393   /* Perform the operation */                                   \
 394   ccall mp_fun(mp_result "ptr", mp_tmp "ptr", W_TO_LONG(wul));  \
 395                                                                 \
 396   return (MP_INT_AS_PAIR(mp_result));                           \
 397 }
 398
 399 #define GMP_TAKE1_I1_RETI1(name,mp_fun)                         \
 400 name (W_ ws1, P_ d1, W_ wi)                                     \
 401 {                                                               \
 402   CInt res;                                                     \
 403   W_ mp_tmp;                                                    \
 404                                                                 \
 405 again:                                                          \
 406   STK_CHK_GEN_N (SIZEOF_MP_INT);                                \
 407   MAYBE_GC(again);                                              \
 408                                                                 \
 409   mp_tmp     = Sp - 1 * SIZEOF_MP_INT;                          \
 410   MP_INT_SET_FROM_BA(mp_tmp,ws1,d1);                            \
 411                                                                 \
 412   /* Perform the operation */                                   \
 413   (res) = ccall mp_fun(mp_tmp "ptr", W_TO_INT(wi));             \
 414                                                                 \
 415   return (TO_W_(res));                                          \
 416 }
 417
 418 #define GMP_TAKE1_UL1_RETI1(name,mp_fun)                        \
 419 name (W_ ws1, P_ d1, W_ wul)                                    \
 420 {                                                               \
 421   CInt res;                                                     \
 422   W_ mp_tmp;                                                    \
 423                                                                 \
 424 again:                                                          \
 425   STK_CHK_GEN_N (SIZEOF_MP_INT);                                \
 426   MAYBE_GC(again);                                              \
 427                                                                 \
 428   mp_tmp     = Sp - 1 * SIZEOF_MP_INT;                          \
 429   MP_INT_SET_FROM_BA(mp_tmp,ws1,d1);                            \
 430                                                                 \
 431   /* Perform the operation */                                   \
 432   (res) = ccall mp_fun(mp_tmp "ptr", W_TO_LONG(wul));           \
 433                                                                 \
 434   return (TO_W_(res));                                          \
 435 }
 436
 437 #define GMP_TAKE1_RET1(name,mp_fun)                             \
 438 name (W_ ws1, P_ d1)                                            \
 439 {                                                               \
 440   W_ mp_tmp1;                                                   \
 441   W_ mp_result1;                                                \
 442                                                                 \
 443 again:                                                          \
 444   STK_CHK_GEN_N (2 * SIZEOF_MP_INT);                            \
 445   MAYBE_GC(again);                                              \
 446                                                                 \
 447   mp_tmp1    = Sp - 1 * SIZEOF_MP_INT;                          \
 448   mp_result1 = Sp - 2 * SIZEOF_MP_INT;                          \
 449                                                                 \
 450   MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                           \
 451                                                                 \
 452   ccall __gmpz_init(mp_result1 "ptr");                          \
 453                                                                 \
 454   /* Perform the operation */                                   \
 455   ccall mp_fun(mp_result1 "ptr",mp_tmp1 "ptr");                 \
 456                                                                 \
 457   return(MP_INT_AS_PAIR(mp_result1));                           \
 458 }
 459
 460 #define GMP_TAKE2_RET2(name,mp_fun)                                     \
 461 name (W_ ws1, P_ d1, W_ ws2, P_ d2)                                     \
 462 {                                                                       \
 463   W_ mp_tmp1;                                                           \
 464   W_ mp_tmp2;                                                           \
 465   W_ mp_result1;                                                        \
 466   W_ mp_result2;                                                        \
 467                                                                         \
 468 again:                                                                  \
 469   STK_CHK_GEN_N (4 * SIZEOF_MP_INT);                                    \
 470   MAYBE_GC(again);                                                      \
 471                                                                         \
 472   mp_tmp1    = Sp - 1 * SIZEOF_MP_INT;                                  \
 473   mp_tmp2    = Sp - 2 * SIZEOF_MP_INT;                                  \
 474   mp_result1 = Sp - 3 * SIZEOF_MP_INT;                                  \
 475   mp_result2 = Sp - 4 * SIZEOF_MP_INT;                                  \
 476                                                                         \
 477   MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                                   \
 478   MP_INT_SET_FROM_BA(mp_tmp2,ws2,d2);                                   \
 479                                                                         \
 480   ccall __gmpz_init(mp_result1 "ptr");                                  \
 481   ccall __gmpz_init(mp_result2 "ptr");                                  \
 482                                                                         \
 483   /* Perform the operation */                                           \
 484   ccall mp_fun(mp_result1 "ptr",mp_result2 "ptr",mp_tmp1 "ptr",mp_tmp2 "ptr"); \
 485                                                                         \
 486   return (MP_INT_AS_PAIR(mp_result1),MP_INT_AS_PAIR(mp_result2));       \
 487 }
 488
 489 GMP_TAKE2_RET1(integer_cmm_plusIntegerzh,           __gmpz_add)
 490 GMP_TAKE2_RET1(integer_cmm_minusIntegerzh,          __gmpz_sub)
 491 GMP_TAKE2_RET1(integer_cmm_timesIntegerzh,          __gmpz_mul)
 492 GMP_TAKE1_UL1_RET1(integer_cmm_timesIntegerIntzh,   __gmpz_mul_si)
 493 GMP_TAKE2_RET1(integer_cmm_gcdIntegerzh,            __gmpz_gcd)
 494 #define CMM_GMPZ_GCDEXT(g,s,a,b) __gmpz_gcdext(g,s,NULL,a,b)
 495 GMP_TAKE2_RET2(integer_cmm_gcdExtIntegerzh,         CMM_GMPZ_GCDEXT)
 496 GMP_TAKE2_RET1(integer_cmm_quotIntegerzh,           __gmpz_tdiv_q)
 497 GMP_TAKE2_RET1(integer_cmm_remIntegerzh,            __gmpz_tdiv_r)
 498 GMP_TAKE2_RET1(integer_cmm_divIntegerzh,            __gmpz_fdiv_q)
 499 GMP_TAKE2_RET1(integer_cmm_modIntegerzh,            __gmpz_fdiv_r)
 500 GMP_TAKE2_RET1(integer_cmm_divExactIntegerzh,       __gmpz_divexact)
 501 GMP_TAKE2_RET1(integer_cmm_andIntegerzh,            __gmpz_and)
 502 GMP_TAKE2_RET1(integer_cmm_orIntegerzh,             __gmpz_ior)
 503 GMP_TAKE2_RET1(integer_cmm_xorIntegerzh,            __gmpz_xor)
 504 GMP_TAKE1_UL1_RETI1(integer_cmm_testBitIntegerzh,   __gmpz_tstbit)
 505 GMP_TAKE1_UL1_RET1(integer_cmm_mul2ExpIntegerzh,    __gmpz_mul_2exp)
 506 GMP_TAKE1_UL1_RET1(integer_cmm_fdivQ2ExpIntegerzh,  __gmpz_fdiv_q_2exp)
 507 GMP_TAKE1_RET1(integer_cmm_complementIntegerzh,     __gmpz_com)
 508
 509 GMP_TAKE2_RET2(integer_cmm_quotRemIntegerzh,        __gmpz_tdiv_qr)
 510 GMP_TAKE2_RET2(integer_cmm_divModIntegerzh,         __gmpz_fdiv_qr)
 511
 512 GMP_TAKE3_RET1(integer_cmm_powModIntegerzh,         __gmpz_powm)
 513 GMP_TAKE3_RET1(integer_cmm_powModSecIntegerzh,      __gmpz_powm_sec)
 514 GMP_TAKE2_RET1(integer_cmm_recipModIntegerzh,       __gmpz_invert)
 515 GMP_TAKE1_UL1_RET1(integer_cmm_powIntegerzh,        __gmpz_pow_ui)
 516
 517 GMP_TAKE1_RET1(integer_cmm_nextPrimeIntegerzh,      __gmpz_nextprime)
 518 GMP_TAKE1_I1_RETI1(integer_cmm_testPrimeIntegerzh,  __gmpz_probab_prime_p)
 519
 520 GMP_TAKE1_I1_RETI1(integer_cmm_sizeInBasezh,        __gmpz_sizeinbase)
 521
 522 integer_cmm_gcdIntzh (W_ int1, W_ int2)
 523 {
 524     W_ r;
 525     W_ mp_tmp_w;
 526
 527     STK_CHK_GEN_N (1 * SIZEOF_W);
 528
 529     mp_tmp_w = Sp - 1 * SIZEOF_W;
 530
 531     W_[mp_tmp_w] = int1;
 532     (r) = ccall __gmpn_gcd_1(mp_tmp_w "ptr", 1, int2);
 533
 534     return (r);
 535 }
 536
 537
 538 integer_cmm_gcdIntegerIntzh (W_ s1, P_ d1, W_ int)
 539 {
 540     W_ r;
 541     (r) = ccall __gmpn_gcd_1 (BYTE_ARR_CTS(d1) "ptr", s1, int);
 542     return (r);
 543 }
 544
 545
 546 integer_cmm_cmpIntegerIntzh (W_ usize, P_ d1, W_ v_digit)
 547 {
 548     W_ vsize, u_digit;
 549
 550     vsize = 0;
 551
 552     // paraphrased from __gmpz_cmp_si() in the GMP sources
 553     if (%gt(v_digit,0)) {
 554         vsize = 1;
 555     } else {
 556         if (%lt(v_digit,0)) {
 557             vsize = -1;
 558             v_digit = -v_digit;
 559         }
 560     }
 561
 562     if (usize != vsize) {
 563         return (usize - vsize);
 564     }
 565
 566     if (usize == 0) {
 567         return (0);
 568     }
 569
 570     u_digit = W_[BYTE_ARR_CTS(d1)];
 571
 572     if (u_digit == v_digit) {
 573         return (0);
 574     }
 575
 576     if (%gtu(u_digit,v_digit)) { // NB. unsigned: these are mp_limb_t's
 577         return (usize);
 578     } else {
 579         return (-usize);
 580     }
 581 }
 582
 583 integer_cmm_cmpIntegerzh (W_ usize, P_ d1, W_ vsize, P_ d2)
 584 {
 585     W_ size, up, vp;
 586     CInt cmp;
 587
 588     // paraphrased from __gmpz_cmp() in the GMP sources
 589
 590     if (usize != vsize) {
 591         return (usize - vsize);
 592     }
 593
 594     if (usize == 0) {
 595         return (0);
 596     }
 597
 598     if (%lt(usize,0)) { // NB. not <, which is unsigned
 599         size = -usize;
 600     } else {
 601         size = usize;
 602     }
 603
 604     up = BYTE_ARR_CTS(d1);
 605     vp = BYTE_ARR_CTS(d2);
 606
 607     (cmp) = ccall __gmpn_cmp(up "ptr", vp "ptr", size);
 608
 609     if (cmp == 0 :: CInt) {
 610         return (0);
 611     }
 612
 613     if (%lt(cmp,0 :: CInt) == %lt(usize,0)) {
 614         return (1);
 615     } else {
 616         return (-1);
 617     }
 618 }
 619
 620 #define DOUBLE_MANTISSA_SIZE SIZEOF_DOUBLE
 621 #define ARR_SIZE (SIZEOF_StgArrWords + DOUBLE_MANTISSA_SIZE)
 622
 623 integer_cmm_decodeDoublezh (D_ arg)
 624 {
 625     D_ arg;
 626     W_ p;
 627     W_ mp_tmp1;
 628     W_ mp_tmp_w;
 629
 630     STK_CHK_GEN_N (2 * SIZEOF_MP_INT);
 631     ALLOC_PRIM (ARR_SIZE);
 632
 633     mp_tmp1  = Sp - 1 * SIZEOF_MP_INT;
 634     mp_tmp_w = Sp - 2 * SIZEOF_MP_INT;
 635
 636     /* Be prepared to tell Lennart-coded integer_cbits_decodeDouble
 637        where mantissa.d can be put (it does not care about the rest) */
 638     p = Hp - ARR_SIZE + WDS(1);
 639     SET_HDR(p, stg_ARR_WORDS_info, CCCS);
 640     StgArrWords_bytes(p) = DOUBLE_MANTISSA_SIZE;
 641     MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(p);
 642
 643     /* Perform the operation */
 644     ccall integer_cbits_decodeDouble(mp_tmp1 "ptr", mp_tmp_w "ptr",arg);
 645
 646     /* returns: (Int# (expn), Int#, ByteArray#) */
 647     return (W_[mp_tmp_w], TO_W_(MP_INT__mp_size(mp_tmp1)), p);
 648 }