Add new `mpz_mul_si`-based primop (re #8647)
[ghc.git] / 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 }