Fix GMP v4 compatibility.
[packages/integer-gmp.git] / 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 #include "HsIntegerGmp.h"
31
32 import "integer-gmp" __gmpz_add;
33 import "integer-gmp" __gmpz_add_ui;
34 import "integer-gmp" __gmpz_sub;
35 import "integer-gmp" __gmpz_sub_ui;
36 import "integer-gmp" __gmpz_mul;
37 import "integer-gmp" __gmpz_mul_2exp;
38 import "integer-gmp" __gmpz_mul_si;
39 import "integer-gmp" __gmpz_tstbit;
40 import "integer-gmp" __gmpz_fdiv_q_2exp;
41 import "integer-gmp" __gmpz_gcd;
42 import "integer-gmp" __gmpz_gcdext;
43 import "integer-gmp" __gmpn_gcd_1;
44 import "integer-gmp" __gmpn_cmp;
45 import "integer-gmp" __gmpz_tdiv_q;
46 import "integer-gmp" __gmpz_tdiv_q_ui;
47 import "integer-gmp" __gmpz_tdiv_r;
48 import "integer-gmp" __gmpz_tdiv_r_ui;
49 import "integer-gmp" __gmpz_fdiv_q;
50 import "integer-gmp" __gmpz_fdiv_q_ui;
51 import "integer-gmp" __gmpz_fdiv_r;
52 import "integer-gmp" __gmpz_fdiv_r_ui;
53 import "integer-gmp" __gmpz_tdiv_qr;
54 import "integer-gmp" __gmpz_tdiv_qr_ui;
55 import "integer-gmp" __gmpz_fdiv_qr;
56 import "integer-gmp" __gmpz_fdiv_qr_ui;
57 import "integer-gmp" __gmpz_divexact;
58 import "integer-gmp" __gmpz_divexact_ui;
59 import "integer-gmp" __gmpz_and;
60 import "integer-gmp" __gmpz_xor;
61 import "integer-gmp" __gmpz_ior;
62 import "integer-gmp" __gmpz_com;
63 import "integer-gmp" __gmpz_pow_ui;
64 import "integer-gmp" __gmpz_powm;
65 #if HAVE_SECURE_POWM == 1
66 import "integer-gmp" __gmpz_powm_sec;
67 #endif
68 import "integer-gmp" __gmpz_invert;
69 import "integer-gmp" __gmpz_nextprime;
70 import "integer-gmp" __gmpz_probab_prime_p;
71 import "integer-gmp" __gmpz_sizeinbase;
72 import "integer-gmp" __gmpz_import;
73 import "integer-gmp" __gmpz_export;
74
75 import "integer-gmp" integer_cbits_decodeDouble;
76
77 import "rts" stg_INTLIKE_closure;
78
79 /* -----------------------------------------------------------------------------
80    Arbitrary-precision Integer operations.
81
82    There are some assumptions in this code that mp_limb_t == W_.  This is
83    the case for all the platforms that GHC supports, currently.
84    -------------------------------------------------------------------------- */
85
86 #if SIZEOF_MP_LIMB_T != SIZEOF_W
87 #error "sizeof(mp_limb_t) != sizeof(W_)"
88 #endif
89
90 /* This is used when a dummy pointer is needed for a ByteArray# return value
91
92    Ideally this would be a statically allocated 'ByteArray#'
93    containing SIZEOF_W 0-bytes. However, since in those cases when a
94    dummy value is needed, the 'ByteArray#' is not supposed to be
95    accessed anyway, this is should be a tolerable hack.
96  */
97 #define DUMMY_BYTE_ARR (stg_INTLIKE_closure+1)
98
99 /* set mpz_t from Int#/ByteArray# */
100 #define MP_INT_SET_FROM_BA(mp_ptr,i,ba)                  \
101   MP_INT__mp_alloc(mp_ptr) = W_TO_INT(BYTE_ARR_WDS(ba)); \
102   MP_INT__mp_size(mp_ptr)  = W_TO_INT(i);                \
103   MP_INT__mp_d(mp_ptr)     = BYTE_ARR_CTS(ba)
104
105 /* convert mpz_t to Int#/ByteArray# return pair */
106 #define MP_INT_AS_PAIR(mp_ptr) \
107   TO_W_(MP_INT__mp_size(mp_ptr)),(MP_INT__mp_d(mp_ptr)-SIZEOF_StgArrWords)
108
109 #define MP_INT_TO_BA(mp_ptr) \
110   (MP_INT__mp_d(mp_ptr)-SIZEOF_StgArrWords)
111
112 /* Size of mpz_t with single limb */
113 #define SIZEOF_MP_INT_1LIMB (SIZEOF_MP_INT+WDS(1))
114
115 /* Initialize 0-valued single-limb mpz_t at mp_ptr */
116 #define MP_INT_1LIMB_INIT0(mp_ptr)                       \
117   MP_INT__mp_alloc(mp_ptr) = W_TO_INT(1);                \
118   MP_INT__mp_size(mp_ptr)  = W_TO_INT(0);                \
119   MP_INT__mp_d(mp_ptr)     = (mp_ptr+SIZEOF_MP_INT)
120
121
122 /* return mpz_t as (# s::Int#, d::ByteArray#, l1::Word# #) tuple
123  *
124  * semantics:
125  *
126  *  (#  0, _, 0 #) -> value = 0
127  *  (#  1, _, w #) -> value =  w
128  *  (# -1, _, w #) -> value = -w
129  *  (#  s, d, 0 #) -> value =  J# s d
130  *
131  */
132 #define MP_INT_1LIMB_RETURN(mp_ptr)                    \
133   CInt __mp_s;                                         \
134   __mp_s = MP_INT__mp_size(mp_ptr);                    \
135                                                        \
136   if (__mp_s == W_TO_INT(0))                           \
137   {                                                    \
138     return (0,DUMMY_BYTE_ARR,0);                       \
139   }                                                    \
140                                                        \
141   if (__mp_s == W_TO_INT(-1) || __mp_s == W_TO_INT(1)) \
142   {                                                    \
143     return (TO_W_(__mp_s),DUMMY_BYTE_ARR,W_[MP_INT__mp_d(mp_ptr)]); \
144   }                                                    \
145                                                        \
146   return (TO_W_(__mp_s),MP_INT_TO_BA(mp_ptr),0)
147
148 /* Helper macro used by MP_INT_1LIMB_RETURN2 */
149 #define MP_INT_1LIMB_AS_TUP3(s,d,w,mp_ptr) \
150   CInt s; P_ d; W_ w;                            \
151   s = MP_INT__mp_size(mp_ptr);                   \
152                                                  \
153   if (s == W_TO_INT(0))                          \
154   {                                              \
155     d = DUMMY_BYTE_ARR; w = 0;                            \
156   } else {                                       \
157     if (s == W_TO_INT(-1) || s == W_TO_INT(1))   \
158     {                                            \
159       d = DUMMY_BYTE_ARR; w = W_[MP_INT__mp_d(mp_ptr)];   \
160     } else {                                     \
161       d = MP_INT_TO_BA(mp_ptr); w = 0;           \
162     }                                            \
163   }
164
165 #define MP_INT_1LIMB_RETURN2(mp_ptr1,mp_ptr2)         \
166   MP_INT_1LIMB_AS_TUP3(__r1s,__r1d,__r1w,mp_ptr1);    \
167   MP_INT_1LIMB_AS_TUP3(__r2s,__r2d,__r2w,mp_ptr2);    \
168   return (TO_W_(__r1s),__r1d,__r1w, TO_W_(__r2s),__r2d,__r2w)
169
170 /* :: ByteArray# -> Word# -> Word# -> Int# -> (# Int#, ByteArray#, Word# #) */
171 integer_cmm_importIntegerFromByteArrayzh (P_ ba, W_ of, W_ sz, W_ e)
172 {
173   W_ src_ptr;
174   W_ mp_result;
175
176 again:
177   STK_CHK_GEN_N (SIZEOF_MP_INT_1LIMB);
178   MAYBE_GC(again);
179
180   mp_result = Sp - SIZEOF_MP_INT_1LIMB;
181   MP_INT_1LIMB_INIT0(mp_result);
182
183   src_ptr = BYTE_ARR_CTS(ba) + of;
184
185   ccall __gmpz_import(mp_result "ptr", sz, W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, src_ptr "ptr");
186
187   MP_INT_1LIMB_RETURN(mp_result);
188 }
189
190 /* :: Addr# -> Word# -> Int# -> State# s -> (# State# s, Int#, ByteArray#, Word# #) */
191 integer_cmm_importIntegerFromAddrzh (W_ src_ptr, W_ sz, W_ e)
192 {
193   W_ mp_result;
194
195 again:
196   STK_CHK_GEN_N (SIZEOF_MP_INT_1LIMB);
197   MAYBE_GC(again);
198
199   mp_result = Sp - SIZEOF_MP_INT_1LIMB;
200
201   MP_INT_1LIMB_INIT0(mp_result);
202
203   ccall __gmpz_import(mp_result "ptr", sz, W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, src_ptr "ptr");
204
205   MP_INT_1LIMB_RETURN(mp_result);
206 }
207
208 /* :: Int# -> ByteArray# -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #) */
209 integer_cmm_exportIntegerToMutableByteArrayzh (W_ ws1, P_ d1, P_ mba, W_ of, W_ e)
210 {
211   W_ dst_ptr;
212   W_ mp_tmp;
213   W_ cnt_result;
214
215 again:
216   STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_W);
217   MAYBE_GC(again);
218
219   mp_tmp = Sp - SIZEOF_MP_INT;
220   MP_INT_SET_FROM_BA(mp_tmp, ws1, d1);
221
222   cnt_result = Sp - (SIZEOF_MP_INT + SIZEOF_W);
223   W_[cnt_result] = 0;
224
225   dst_ptr = BYTE_ARR_CTS(mba) + of;
226
227   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");
228
229   return (W_[cnt_result]);
230 }
231
232 /* :: Int# -> ByteArray# -> Addr# -> Int# -> State# s -> (# State# s, Word# #) */
233 integer_cmm_exportIntegerToAddrzh (W_ ws1, P_ d1, W_ dst_ptr, W_ e)
234 {
235   W_ mp_tmp;
236   W_ cnt_result;
237
238 again:
239   STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_W);
240   MAYBE_GC(again);
241
242   mp_tmp = Sp - SIZEOF_MP_INT;
243   MP_INT_SET_FROM_BA(mp_tmp, ws1, d1);
244
245   cnt_result = Sp - (SIZEOF_MP_INT + SIZEOF_W);
246   W_[cnt_result] = 0;
247
248   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");
249
250   return (W_[cnt_result]);
251 }
252
253 integer_cmm_int2Integerzh (W_ val)
254 {
255    W_ s, p; /* to avoid aliasing */
256
257    ALLOC_PRIM_N (SIZEOF_StgArrWords + WDS(1), integer_cmm_int2Integerzh, val);
258
259    p = Hp - SIZEOF_StgArrWords;
260    SET_HDR(p, stg_ARR_WORDS_info, CCCS);
261    StgArrWords_bytes(p) = SIZEOF_W;
262
263    /* mpz_set_si is inlined here, makes things simpler */
264    if (%lt(val,0)) {
265         s  = -1;
266         Hp(0) = -val;
267    } else {
268      if (%gt(val,0)) {
269         s = 1;
270         Hp(0) = val;
271      } else {
272         s = 0;
273      }
274   }
275
276    /* returns (# size  :: Int#,
277                  data  :: ByteArray#
278                #)
279    */
280    return (s,p);
281 }
282
283 integer_cmm_word2Integerzh (W_ val)
284 {
285    W_ s, p; /* to avoid aliasing */
286
287    ALLOC_PRIM_N (SIZEOF_StgArrWords + WDS(1), integer_cmm_word2Integerzh, val);
288
289    p = Hp - SIZEOF_StgArrWords;
290    SET_HDR(p, stg_ARR_WORDS_info, CCCS);
291    StgArrWords_bytes(p) = SIZEOF_W;
292
293    if (val != 0) {
294         s = 1;
295         W_[Hp] = val;
296    } else {
297         s = 0;
298    }
299
300    /* returns (# size  :: Int#,
301                  data  :: ByteArray# #)
302    */
303    return (s,p);
304 }
305
306
307 /*
308  * 'long long' primops for converting to/from Integers.
309  */
310
311 #if WORD_SIZE_IN_BITS < 64
312
313 integer_cmm_int64ToIntegerzh (L_ val)
314 {
315    W_ hi, lo, s, neg, words_needed, p;
316
317    neg = 0;
318
319    hi = TO_W_(val >> 32);
320    lo = TO_W_(val);
321
322    if ( hi == 0 || (hi == 0xFFFFFFFF && lo != 0) )  {
323        // minimum is one word
324        words_needed = 1;
325    } else {
326        words_needed = 2;
327    }
328
329    ALLOC_PRIM (SIZEOF_StgArrWords + WDS(words_needed));
330
331    p = Hp - SIZEOF_StgArrWords - WDS(words_needed) + WDS(1);
332    SET_HDR(p, stg_ARR_WORDS_info, CCCS);
333    StgArrWords_bytes(p) = WDS(words_needed);
334
335    if ( %lt(hi,0) ) {
336      neg = 1;
337      lo = -lo;
338      if(lo == 0) {
339        hi = -hi;
340      } else {
341        hi = -hi - 1;
342      }
343    }
344
345    if ( words_needed == 2 )  {
346       s = 2;
347       Hp(-1) = lo;
348       Hp(0) = hi;
349    } else {
350        if ( lo != 0 ) {
351            s = 1;
352            Hp(0) = lo;
353        } else /* val==0 */  {
354            s = 0;
355        }
356    }
357    if ( neg != 0 ) {
358         s = -s;
359    }
360
361    /* returns (# size  :: Int#,
362                  data  :: ByteArray# #)
363    */
364    return (s,p);
365 }
366 integer_cmm_word64ToIntegerzh (L_ val)
367 {
368    W_ hi, lo, s, words_needed, p;
369
370    hi = TO_W_(val >> 32);
371    lo = TO_W_(val);
372
373    if ( hi != 0 ) {
374       words_needed = 2;
375    } else {
376       words_needed = 1;
377    }
378
379    ALLOC_PRIM (SIZEOF_StgArrWords + WDS(words_needed));
380
381    p = Hp - SIZEOF_StgArrWords - WDS(words_needed) + WDS(1);
382    SET_HDR(p, stg_ARR_WORDS_info, CCCS);
383    StgArrWords_bytes(p) = WDS(words_needed);
384
385    if ( hi != 0 ) {
386      s = 2;
387      Hp(-1) = lo;
388      Hp(0)  = hi;
389    } else {
390       if ( lo != 0 ) {
391         s = 1;
392         Hp(0) = lo;
393      } else /* val==0 */  {
394       s = 0;
395      }
396   }
397
398    /* returns (# size  :: Int#,
399                  data  :: ByteArray# #)
400    */
401    return (s,p);
402 }
403
404 #endif /* WORD_SIZE_IN_BITS < 64 */
405
406 #define GMP_TAKE2_RET1(name,mp_fun)                             \
407 name (W_ ws1, P_ d1, W_ ws2, P_ d2)                             \
408 {                                                               \
409   W_ mp_tmp1;                                                   \
410   W_ mp_tmp2;                                                   \
411   W_ mp_result1;                                                \
412                                                                 \
413 again:                                                          \
414   STK_CHK_GEN_N (2*SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);        \
415   MAYBE_GC(again);                                              \
416                                                                 \
417   mp_tmp1    = Sp - 1*SIZEOF_MP_INT;                            \
418   mp_tmp2    = Sp - 2*SIZEOF_MP_INT;                            \
419   mp_result1 = Sp - 2*SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;      \
420                                                                 \
421   MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                           \
422   MP_INT_SET_FROM_BA(mp_tmp2,ws2,d2);                           \
423                                                                 \
424   MP_INT_1LIMB_INIT0(mp_result1);                               \
425                                                                 \
426   /* Perform the operation */                                   \
427   ccall mp_fun(mp_result1 "ptr",mp_tmp1  "ptr",mp_tmp2  "ptr"); \
428                                                                 \
429   MP_INT_1LIMB_RETURN(mp_result1);                              \
430 }
431
432 #define GMP_TAKE3_RET1(name,mp_fun)                             \
433 name (W_ ws1, P_ d1, W_ ws2, P_ d2, W_ ws3, P_ d3)              \
434 {                                                               \
435   W_ mp_tmp1;                                                   \
436   W_ mp_tmp2;                                                   \
437   W_ mp_tmp3;                                                   \
438   W_ mp_result1;                                                \
439                                                                 \
440 again:                                                          \
441   STK_CHK_GEN_N (3*SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);        \
442   MAYBE_GC(again);                                              \
443                                                                 \
444   mp_tmp1    = Sp - 1*SIZEOF_MP_INT;                            \
445   mp_tmp2    = Sp - 2*SIZEOF_MP_INT;                            \
446   mp_tmp3    = Sp - 3*SIZEOF_MP_INT;                            \
447   mp_result1 = Sp - 3*SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;      \
448                                                                 \
449   MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                           \
450   MP_INT_SET_FROM_BA(mp_tmp2,ws2,d2);                           \
451   MP_INT_SET_FROM_BA(mp_tmp3,ws3,d3);                           \
452                                                                 \
453   MP_INT_1LIMB_INIT0(mp_result1);                               \
454                                                                 \
455   /* Perform the operation */                                   \
456   ccall mp_fun(mp_result1 "ptr",                                \
457                mp_tmp1 "ptr", mp_tmp2 "ptr", mp_tmp3 "ptr");    \
458                                                                 \
459   MP_INT_1LIMB_RETURN(mp_result1);                              \
460 }
461
462 #define GMP_TAKE1_UL1_RET1(name,mp_fun)                         \
463 name (W_ ws1, P_ d1, W_ wul)                                    \
464 {                                                               \
465   W_ mp_tmp;                                                    \
466   W_ mp_result;                                                 \
467                                                                 \
468   /* call doYouWantToGC() */                                    \
469 again:                                                          \
470   STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);          \
471   MAYBE_GC(again);                                              \
472                                                                 \
473   mp_tmp     = Sp - SIZEOF_MP_INT;                              \
474   mp_result  = Sp - SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;        \
475                                                                 \
476   MP_INT_SET_FROM_BA(mp_tmp,ws1,d1);                            \
477                                                                 \
478   MP_INT_1LIMB_INIT0(mp_result);                                \
479                                                                 \
480   /* Perform the operation */                                   \
481   ccall mp_fun(mp_result "ptr", mp_tmp "ptr", W_TO_LONG(wul));  \
482                                                                 \
483   MP_INT_1LIMB_RETURN(mp_result);                               \
484 }
485
486 #define GMP_TAKE1_I1_RETI1(name,mp_fun)                         \
487 name (W_ ws1, P_ d1, W_ wi)                                     \
488 {                                                               \
489   CInt res;                                                     \
490   W_ mp_tmp;                                                    \
491                                                                 \
492 again:                                                          \
493   STK_CHK_GEN_N (SIZEOF_MP_INT);                                \
494   MAYBE_GC(again);                                              \
495                                                                 \
496   mp_tmp     = Sp - 1 * SIZEOF_MP_INT;                          \
497   MP_INT_SET_FROM_BA(mp_tmp,ws1,d1);                            \
498                                                                 \
499   /* Perform the operation */                                   \
500   (res) = ccall mp_fun(mp_tmp "ptr", W_TO_INT(wi));             \
501                                                                 \
502   return (TO_W_(res));                                          \
503 }
504
505 #define GMP_TAKE1_UL1_RETI1(name,mp_fun)                        \
506 name (W_ ws1, P_ d1, W_ wul)                                    \
507 {                                                               \
508   CInt res;                                                     \
509   W_ mp_tmp;                                                    \
510                                                                 \
511 again:                                                          \
512   STK_CHK_GEN_N (SIZEOF_MP_INT);                                \
513   MAYBE_GC(again);                                              \
514                                                                 \
515   mp_tmp     = Sp - 1 * SIZEOF_MP_INT;                          \
516   MP_INT_SET_FROM_BA(mp_tmp,ws1,d1);                            \
517                                                                 \
518   /* Perform the operation */                                   \
519   (res) = ccall mp_fun(mp_tmp "ptr", W_TO_LONG(wul));           \
520                                                                 \
521   return (TO_W_(res));                                          \
522 }
523
524 #define GMP_TAKE1_RET1(name,mp_fun)                             \
525 name (W_ ws1, P_ d1)                                            \
526 {                                                               \
527   W_ mp_tmp1;                                                   \
528   W_ mp_result1;                                                \
529                                                                 \
530 again:                                                          \
531   STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);          \
532   MAYBE_GC(again);                                              \
533                                                                 \
534   mp_tmp1    = Sp - SIZEOF_MP_INT;                              \
535   mp_result1 = Sp - SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;        \
536                                                                 \
537   MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                           \
538                                                                 \
539   MP_INT_1LIMB_INIT0(mp_result1);                               \
540                                                                 \
541   /* Perform the operation */                                   \
542   ccall mp_fun(mp_result1 "ptr",mp_tmp1 "ptr");                 \
543                                                                 \
544   MP_INT_1LIMB_RETURN(mp_result1);                              \
545 }
546
547 #define GMP_TAKE2_RET2(name,mp_fun)                                     \
548 name (W_ ws1, P_ d1, W_ ws2, P_ d2)                                     \
549 {                                                                       \
550   W_ mp_tmp1;                                                           \
551   W_ mp_tmp2;                                                           \
552   W_ mp_result1;                                                        \
553   W_ mp_result2;                                                        \
554                                                                         \
555 again:                                                                  \
556   STK_CHK_GEN_N (2*SIZEOF_MP_INT + 2*SIZEOF_MP_INT_1LIMB);              \
557   MAYBE_GC(again);                                                      \
558                                                                         \
559   mp_tmp1    = Sp - 1*SIZEOF_MP_INT;                                    \
560   mp_tmp2    = Sp - 2*SIZEOF_MP_INT;                                    \
561   mp_result1 = Sp - 2*SIZEOF_MP_INT - 1*SIZEOF_MP_INT_1LIMB;            \
562   mp_result2 = Sp - 2*SIZEOF_MP_INT - 2*SIZEOF_MP_INT_1LIMB;            \
563                                                                         \
564   MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                                   \
565   MP_INT_SET_FROM_BA(mp_tmp2,ws2,d2);                                   \
566                                                                         \
567   MP_INT_1LIMB_INIT0(mp_result1);                                       \
568   MP_INT_1LIMB_INIT0(mp_result2);                                       \
569                                                                         \
570   /* Perform the operation */                                           \
571   ccall mp_fun(mp_result1 "ptr", mp_result2 "ptr",                      \
572                mp_tmp1 "ptr", mp_tmp2 "ptr");                           \
573                                                                         \
574   MP_INT_1LIMB_RETURN2(mp_result1, mp_result2);                         \
575 }
576
577 #define GMP_TAKE1_UL1_RET2(name,mp_fun)                                 \
578 name (W_ ws1, P_ d1, W_ wul2)                                           \
579 {                                                                       \
580   W_ mp_tmp1;                                                           \
581   W_ mp_result1;                                                        \
582   W_ mp_result2;                                                        \
583                                                                         \
584 again:                                                                  \
585   STK_CHK_GEN_N (SIZEOF_MP_INT + 2*SIZEOF_MP_INT_1LIMB);                \
586   MAYBE_GC(again);                                                      \
587                                                                         \
588   mp_tmp1    = Sp - SIZEOF_MP_INT;                                      \
589   mp_result1 = Sp - SIZEOF_MP_INT - 1*SIZEOF_MP_INT_1LIMB;              \
590   mp_result2 = Sp - SIZEOF_MP_INT - 2*SIZEOF_MP_INT_1LIMB;              \
591                                                                         \
592   MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                                   \
593                                                                         \
594   MP_INT_1LIMB_INIT0(mp_result1);                                       \
595   MP_INT_1LIMB_INIT0(mp_result2);                                       \
596                                                                         \
597   /* Perform the operation */                                           \
598   ccall mp_fun(mp_result1 "ptr", mp_result2 "ptr",                      \
599                mp_tmp1 "ptr", W_TO_LONG(wul2));                         \
600                                                                         \
601   MP_INT_1LIMB_RETURN2(mp_result1, mp_result2);                         \
602 }
603
604 GMP_TAKE2_RET1(integer_cmm_plusIntegerzh,           __gmpz_add)
605 GMP_TAKE2_RET1(integer_cmm_minusIntegerzh,          __gmpz_sub)
606 GMP_TAKE2_RET1(integer_cmm_timesIntegerzh,          __gmpz_mul)
607 GMP_TAKE1_UL1_RET1(integer_cmm_timesIntegerIntzh,   __gmpz_mul_si)
608 GMP_TAKE2_RET1(integer_cmm_gcdIntegerzh,            __gmpz_gcd)
609 #define CMM_GMPZ_GCDEXT(g,s,a,b) __gmpz_gcdext(g,s,NULL,a,b)
610 GMP_TAKE2_RET2(integer_cmm_gcdExtIntegerzh,         CMM_GMPZ_GCDEXT)
611 GMP_TAKE2_RET1(integer_cmm_quotIntegerzh,           __gmpz_tdiv_q)
612 GMP_TAKE1_UL1_RET1(integer_cmm_quotIntegerWordzh,   __gmpz_tdiv_q_ui)
613 GMP_TAKE2_RET1(integer_cmm_remIntegerzh,            __gmpz_tdiv_r)
614 GMP_TAKE1_UL1_RET1(integer_cmm_remIntegerWordzh,    __gmpz_tdiv_r_ui)
615 GMP_TAKE2_RET1(integer_cmm_divIntegerzh,            __gmpz_fdiv_q)
616 GMP_TAKE1_UL1_RET1(integer_cmm_divIntegerWordzh,    __gmpz_fdiv_q_ui)
617 GMP_TAKE2_RET1(integer_cmm_modIntegerzh,            __gmpz_fdiv_r)
618 GMP_TAKE1_UL1_RET1(integer_cmm_modIntegerWordzh,    __gmpz_fdiv_r_ui)
619 GMP_TAKE2_RET1(integer_cmm_divExactIntegerzh,       __gmpz_divexact)
620 GMP_TAKE1_UL1_RET1(integer_cmm_divExactIntegerWordzh, __gmpz_divexact_ui)
621 GMP_TAKE2_RET1(integer_cmm_andIntegerzh,            __gmpz_and)
622 GMP_TAKE2_RET1(integer_cmm_orIntegerzh,             __gmpz_ior)
623 GMP_TAKE2_RET1(integer_cmm_xorIntegerzh,            __gmpz_xor)
624 GMP_TAKE1_UL1_RETI1(integer_cmm_testBitIntegerzh,   __gmpz_tstbit)
625 GMP_TAKE1_UL1_RET1(integer_cmm_mul2ExpIntegerzh,    __gmpz_mul_2exp)
626 GMP_TAKE1_UL1_RET1(integer_cmm_fdivQ2ExpIntegerzh,  __gmpz_fdiv_q_2exp)
627 GMP_TAKE1_RET1(integer_cmm_complementIntegerzh,     __gmpz_com)
628
629 GMP_TAKE2_RET2(integer_cmm_quotRemIntegerzh,        __gmpz_tdiv_qr)
630 GMP_TAKE1_UL1_RET2(integer_cmm_quotRemIntegerWordzh,__gmpz_tdiv_qr_ui)
631 GMP_TAKE2_RET2(integer_cmm_divModIntegerzh,         __gmpz_fdiv_qr)
632 GMP_TAKE1_UL1_RET2(integer_cmm_divModIntegerWordzh, __gmpz_fdiv_qr_ui)
633
634 GMP_TAKE3_RET1(integer_cmm_powModIntegerzh,         __gmpz_powm)
635 #if HAVE_SECURE_POWM == 1
636 GMP_TAKE3_RET1(integer_cmm_powModSecIntegerzh,      __gmpz_powm_sec)
637 #else
638 GMP_TAKE3_RET1(integer_cmm_powModSecIntegerzh,      __gmpz_powm)
639 #endif
640
641 GMP_TAKE2_RET1(integer_cmm_recipModIntegerzh,       __gmpz_invert)
642 GMP_TAKE1_UL1_RET1(integer_cmm_powIntegerzh,        __gmpz_pow_ui)
643
644 GMP_TAKE1_RET1(integer_cmm_nextPrimeIntegerzh,      __gmpz_nextprime)
645 GMP_TAKE1_I1_RETI1(integer_cmm_testPrimeIntegerzh,  __gmpz_probab_prime_p)
646
647 GMP_TAKE1_I1_RETI1(integer_cmm_sizeInBasezh,        __gmpz_sizeinbase)
648
649 integer_cmm_gcdIntzh (W_ int1, W_ int2)
650 {
651     W_ r;
652     W_ mp_tmp_w;
653
654     STK_CHK_GEN_N (1 * SIZEOF_W);
655
656     mp_tmp_w = Sp - 1 * SIZEOF_W;
657
658     W_[mp_tmp_w] = int1;
659     (r) = ccall __gmpn_gcd_1(mp_tmp_w "ptr", 1, int2);
660
661     return (r);
662 }
663
664
665 integer_cmm_gcdIntegerIntzh (W_ s1, P_ d1, W_ int)
666 {
667     W_ r;
668     (r) = ccall __gmpn_gcd_1 (BYTE_ARR_CTS(d1) "ptr", s1, int);
669     return (r);
670 }
671
672
673 integer_cmm_cmpIntegerIntzh (W_ usize, P_ d1, W_ v_digit)
674 {
675     W_ vsize, u_digit;
676
677     vsize = 0;
678
679     // paraphrased from __gmpz_cmp_si() in the GMP sources
680     if (%gt(v_digit,0)) {
681         vsize = 1;
682     } else {
683         if (%lt(v_digit,0)) {
684             vsize = -1;
685             v_digit = -v_digit;
686         }
687     }
688
689     if (usize != vsize) {
690         return (usize - vsize);
691     }
692
693     if (usize == 0) {
694         return (0);
695     }
696
697     u_digit = W_[BYTE_ARR_CTS(d1)];
698
699     if (u_digit == v_digit) {
700         return (0);
701     }
702
703     if (%gtu(u_digit,v_digit)) { // NB. unsigned: these are mp_limb_t's
704         return (usize);
705     } else {
706         return (-usize);
707     }
708 }
709
710 integer_cmm_cmpIntegerzh (W_ usize, P_ d1, W_ vsize, P_ d2)
711 {
712     W_ size, up, vp;
713     CInt cmp;
714
715     // paraphrased from __gmpz_cmp() in the GMP sources
716
717     if (usize != vsize) {
718         return (usize - vsize);
719     }
720
721     if (usize == 0) {
722         return (0);
723     }
724
725     if (%lt(usize,0)) { // NB. not <, which is unsigned
726         size = -usize;
727     } else {
728         size = usize;
729     }
730
731     up = BYTE_ARR_CTS(d1);
732     vp = BYTE_ARR_CTS(d2);
733
734     (cmp) = ccall __gmpn_cmp(up "ptr", vp "ptr", size);
735
736     if (cmp == 0 :: CInt) {
737         return (0);
738     }
739
740     if (%lt(cmp,0 :: CInt) == %lt(usize,0)) {
741         return (1);
742     } else {
743         return (-1);
744     }
745 }
746
747 #define DOUBLE_MANTISSA_SIZE SIZEOF_DOUBLE
748 #define ARR_SIZE (SIZEOF_StgArrWords + DOUBLE_MANTISSA_SIZE)
749
750 integer_cmm_decodeDoublezh (D_ arg)
751 {
752     W_ mp_tmp1;
753     W_ mp_tmp_w;
754
755 #if SIZEOF_DOUBLE != SIZEOF_W
756     W_ p;
757
758     STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_W);
759     ALLOC_PRIM (ARR_SIZE);
760
761     mp_tmp1  = Sp - SIZEOF_MP_INT;
762     mp_tmp_w = Sp - SIZEOF_MP_INT - SIZEOF_W;
763
764     /* Be prepared to tell Lennart-coded integer_cbits_decodeDouble
765        where mantissa.d can be put (it does not care about the rest) */
766     p = Hp - ARR_SIZE + WDS(1);
767     SET_HDR(p, stg_ARR_WORDS_info, CCCS);
768     StgArrWords_bytes(p) = DOUBLE_MANTISSA_SIZE;
769     MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(p);
770
771 #else
772     /* When SIZEOF_DOUBLE == SIZEOF_W == 8, the result will fit into a
773        single 8-byte limb, and so we avoid allocating on the Heap and
774        use only the Stack instead */
775
776     STK_CHK_GEN_N (SIZEOF_MP_INT_1LIMB + SIZEOF_W);
777
778     mp_tmp1  = Sp - SIZEOF_MP_INT_1LIMB;
779     mp_tmp_w = Sp - SIZEOF_MP_INT_1LIMB - SIZEOF_W;
780
781     MP_INT_1LIMB_INIT0(mp_tmp1);
782 #endif
783
784     /* Perform the operation */
785     ccall integer_cbits_decodeDouble(mp_tmp1 "ptr", mp_tmp_w "ptr", arg);
786
787     /* returns: (Int# (expn), MPZ#) */
788     MP_INT_1LIMB_AS_TUP3(r1s, r1d, r1w, mp_tmp1);
789
790     return (W_[mp_tmp_w], TO_W_(r1s), r1d, r1w);
791 }
792
793 /* :: Int# -> ByteArray# -> Int# -> (# Int#, ByteArray#, Word# #) */
794 #define GMPX_TAKE1_UL1_RET1(name,pos_arg_fun,neg_arg_fun)               \
795 name(W_ ws1, P_ d1, W_ wl)                                              \
796 {                                                                       \
797   W_ mp_tmp;                                                            \
798   W_ mp_result;                                                         \
799                                                                         \
800 again:                                                                  \
801   STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);                  \
802   MAYBE_GC(again);                                                      \
803                                                                         \
804   mp_tmp     = Sp - SIZEOF_MP_INT;                                      \
805   mp_result  = Sp - SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;                \
806                                                                         \
807   MP_INT_SET_FROM_BA(mp_tmp,ws1,d1);                                    \
808                                                                         \
809   MP_INT_1LIMB_INIT0(mp_result);                                        \
810                                                                         \
811   if(%lt(wl,0)) {                                                       \
812       ccall neg_arg_fun(mp_result "ptr", mp_tmp "ptr", W_TO_LONG(-wl)); \
813   } else {                                                              \
814       ccall pos_arg_fun(mp_result "ptr", mp_tmp "ptr", W_TO_LONG(wl));  \
815   }                                                                     \
816                                                                         \
817   MP_INT_1LIMB_RETURN(mp_result);                                       \
818 }
819
820 /* NB: We need both primitives as we can't express 'minusIntegerInt#'
821    in terms of 'plusIntegerInt#' for @minBound :: Int@ */
822 GMPX_TAKE1_UL1_RET1(integer_cmm_plusIntegerIntzh,__gmpz_add_ui,__gmpz_sub_ui)
823 GMPX_TAKE1_UL1_RET1(integer_cmm_minusIntegerIntzh,__gmpz_sub_ui,__gmpz_add_ui)