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