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