← Back to branch summary

~ubuntu-branches/ubuntu/precise/ghc/precise

« back to all changes in this revision

Viewing changes to libraries/integer-gmp/cbits/gmp-wrappers.cmm

  • Committer: Bazaar Package Importer
  • Author(s): Joachim Breitner
  • Date: 2011-01-17 12:49:24 UTC
  • Revision ID: james.westby@ubuntu.com-20110117124924-do1pym1jlf5o636m
Tags: upstream-7.0.1
Import upstream version 7.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
libraries/integer-gmp/cbits/gmp-wrappers.cmm
 
1
/* -----------------------------------------------------------------------------
 
2
 *
 
3
 * (c) The GHC Team, 1998-2004
 
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_fdiv_q_2exp;
 
37
import "integer-gmp" __gmpz_gcd;
 
38
import "integer-gmp" __gmpn_gcd_1;
 
39
import "integer-gmp" __gmpn_cmp;
 
40
import "integer-gmp" __gmpz_tdiv_q;
 
41
import "integer-gmp" __gmpz_tdiv_r;
 
42
import "integer-gmp" __gmpz_tdiv_qr;
 
43
import "integer-gmp" __gmpz_fdiv_qr;
 
44
import "integer-gmp" __gmpz_divexact;
 
45
import "integer-gmp" __gmpz_and;
 
46
import "integer-gmp" __gmpz_xor;
 
47
import "integer-gmp" __gmpz_ior;
 
48
import "integer-gmp" __gmpz_com;
 
49
 
 
50
import "integer-gmp" integer_cbits_decodeDouble;
 
51
 
 
52
/* -----------------------------------------------------------------------------
 
53
   Arbitrary-precision Integer operations.
 
54
 
 
55
   There are some assumptions in this code that mp_limb_t == W_.  This is
 
56
   the case for all the platforms that GHC supports, currently.
 
57
   -------------------------------------------------------------------------- */
 
58
 
 
59
integer_cmm_int2Integerzh
 
60
{
 
61
   /* arguments: R1 = Int# */
 
62
 
 
63
   W_ val, s, p; /* to avoid aliasing */
 
64
 
 
65
   val = R1;
 
66
   ALLOC_PRIM( SIZEOF_StgArrWords + WDS(1), NO_PTRS, integer_cmm_int2Integerzh );
 
67
 
 
68
   p = Hp - SIZEOF_StgArrWords;
 
69
   SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
 
70
   StgArrWords_bytes(p) = SIZEOF_W;
 
71
 
 
72
   /* mpz_set_si is inlined here, makes things simpler */
 
73
   if (%lt(val,0)) {
 
74
        s  = -1;
 
75
        Hp(0) = -val;
 
76
   } else {
 
77
     if (%gt(val,0)) {
 
78
        s = 1;
 
79
        Hp(0) = val;
 
80
     } else {
 
81
        s = 0;
 
82
     }
 
83
  }
 
84
 
 
85
   /* returns (# size  :: Int#,
 
86
                 data  :: ByteArray#
 
87
               #)
 
88
   */
 
89
   RET_NP(s,p);
 
90
}
 
91
 
 
92
integer_cmm_word2Integerzh
 
93
{
 
94
   /* arguments: R1 = Word# */
 
95
 
 
96
   W_ val, s, p; /* to avoid aliasing */
 
97
 
 
98
   val = R1;
 
99
 
 
100
   ALLOC_PRIM( SIZEOF_StgArrWords + WDS(1), NO_PTRS, integer_cmm_word2Integerzh);
 
101
 
 
102
   p = Hp - SIZEOF_StgArrWords;
 
103
   SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
 
104
   StgArrWords_bytes(p) = SIZEOF_W;
 
105
 
 
106
   if (val != 0) {
 
107
        s = 1;
 
108
        W_[Hp] = val;
 
109
   } else {
 
110
        s = 0;
 
111
   }
 
112
 
 
113
   /* returns (# size  :: Int#,
 
114
                 data  :: ByteArray# #)
 
115
   */
 
116
   RET_NP(s,p);
 
117
}
 
118
 
 
119
 
 
120
/*
 
121
 * 'long long' primops for converting to/from Integers.
 
122
 */
 
123
 
 
124
#if WORD_SIZE_IN_BITS < 64
 
125
 
 
126
integer_cmm_int64ToIntegerzh
 
127
{
 
128
   /* arguments: L1 = Int64# */
 
129
 
 
130
   L_ val;
 
131
   W_ hi, lo, s, neg, words_needed, p;
 
132
 
 
133
   val = L1;
 
134
   neg = 0;
 
135
 
 
136
   hi = TO_W_(val >> 32);
 
137
   lo = TO_W_(val);
 
138
 
 
139
   if ( hi == 0 || (hi == 0xFFFFFFFF && lo != 0) )  {
 
140
       // minimum is one word
 
141
       words_needed = 1;
 
142
   } else {
 
143
       words_needed = 2;
 
144
   }
 
145
 
 
146
   ALLOC_PRIM( SIZEOF_StgArrWords + WDS(words_needed),
 
147
               NO_PTRS, integer_cmm_int64ToIntegerzh );
 
148
 
 
149
   p = Hp - SIZEOF_StgArrWords - WDS(words_needed) + WDS(1);
 
150
   SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
 
151
   StgArrWords_bytes(p) = WDS(words_needed);
 
152
 
 
153
   if ( %lt(hi,0) ) {
 
154
     neg = 1;
 
155
     lo = -lo;
 
156
     if(lo == 0) {
 
157
       hi = -hi;
 
158
     } else {
 
159
       hi = -hi - 1;
 
160
     }
 
161
   }
 
162
 
 
163
   if ( words_needed == 2 )  {
 
164
      s = 2;
 
165
      Hp(-1) = lo;
 
166
      Hp(0) = hi;
 
167
   } else {
 
168
       if ( lo != 0 ) {
 
169
           s = 1;
 
170
           Hp(0) = lo;
 
171
       } else /* val==0 */  {
 
172
           s = 0;
 
173
       }
 
174
   }
 
175
   if ( neg != 0 ) {
 
176
        s = -s;
 
177
   }
 
178
 
 
179
   /* returns (# size  :: Int#,
 
180
                 data  :: ByteArray# #)
 
181
   */
 
182
   RET_NP(s,p);
 
183
}
 
184
integer_cmm_word64ToIntegerzh
 
185
{
 
186
   /* arguments: L1 = Word64# */
 
187
 
 
188
   L_ val;
 
189
   W_ hi, lo, s, words_needed, p;
 
190
 
 
191
   val = L1;
 
192
   hi = TO_W_(val >> 32);
 
193
   lo = TO_W_(val);
 
194
 
 
195
   if ( hi != 0 ) {
 
196
      words_needed = 2;
 
197
   } else {
 
198
      words_needed = 1;
 
199
   }
 
200
 
 
201
   ALLOC_PRIM( SIZEOF_StgArrWords + WDS(words_needed),
 
202
               NO_PTRS, integer_cmm_word64ToIntegerzh );
 
203
 
 
204
   p = Hp - SIZEOF_StgArrWords - WDS(words_needed) + WDS(1);
 
205
   SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
 
206
   StgArrWords_bytes(p) = WDS(words_needed);
 
207
 
 
208
   if ( hi != 0 ) {
 
209
     s = 2;
 
210
     Hp(-1) = lo;
 
211
     Hp(0)  = hi;
 
212
   } else {
 
213
      if ( lo != 0 ) {
 
214
        s = 1;
 
215
        Hp(0) = lo;
 
216
     } else /* val==0 */  {
 
217
      s = 0;
 
218
     }
 
219
  }
 
220
 
 
221
   /* returns (# size  :: Int#,
 
222
                 data  :: ByteArray# #)
 
223
   */
 
224
   RET_NP(s,p);
 
225
}
 
226
 
 
227
#endif /* WORD_SIZE_IN_BITS < 64 */
 
228
 
 
229
#define GMP_TAKE2_RET1(name,mp_fun)                                     \
 
230
name                                                                    \
 
231
{                                                                       \
 
232
  CInt s1, s2;                                                          \
 
233
  W_ d1, d2;                                                            \
 
234
  W_ mp_tmp1;                                                           \
 
235
  W_ mp_tmp2;                                                           \
 
236
  W_ mp_result1;                                                        \
 
237
                                                                        \
 
238
  /* call doYouWantToGC() */                                            \
 
239
  MAYBE_GC(R2_PTR & R4_PTR, name);                                      \
 
240
                                                                        \
 
241
  STK_CHK_GEN( 3 * SIZEOF_MP_INT, R2_PTR & R4_PTR, name );              \
 
242
                                                                        \
 
243
  s1 = W_TO_INT(R1);                                                    \
 
244
  d1 = R2;                                                              \
 
245
  s2 = W_TO_INT(R3);                                                    \
 
246
  d2 = R4;                                                              \
 
247
                                                                        \
 
248
  mp_tmp1    = Sp - 1 * SIZEOF_MP_INT;                                  \
 
249
  mp_tmp2    = Sp - 2 * SIZEOF_MP_INT;                                  \
 
250
  mp_result1 = Sp - 3 * SIZEOF_MP_INT;                                  \
 
251
  MP_INT__mp_alloc(mp_tmp1) = W_TO_INT(BYTE_ARR_WDS(d1));               \
 
252
  MP_INT__mp_size(mp_tmp1)  = (s1);                                     \
 
253
  MP_INT__mp_d(mp_tmp1)     = BYTE_ARR_CTS(d1);                         \
 
254
  MP_INT__mp_alloc(mp_tmp2) = W_TO_INT(BYTE_ARR_WDS(d2));               \
 
255
  MP_INT__mp_size(mp_tmp2)  = (s2);                                     \
 
256
  MP_INT__mp_d(mp_tmp2)     = BYTE_ARR_CTS(d2);                         \
 
257
                                                                        \
 
258
  foreign "C" __gmpz_init(mp_result1 "ptr") [];                         \
 
259
                                                                        \
 
260
  /* Perform the operation */                                           \
 
261
  foreign "C" mp_fun(mp_result1 "ptr",mp_tmp1  "ptr",mp_tmp2  "ptr") []; \
 
262
                                                                        \
 
263
  RET_NP(TO_W_(MP_INT__mp_size(mp_result1)),                            \
 
264
         MP_INT__mp_d(mp_result1) - SIZEOF_StgArrWords);                \
 
265
}
 
266
 
 
267
#define GMP_TAKE1_UL1_RET1(name,mp_fun)                                 \
 
268
name                                                                    \
 
269
{                                                                       \
 
270
  CInt s1;                                                              \
 
271
  W_ d1;                                                                \
 
272
  CLong ul;                                                             \
 
273
  W_ mp_tmp;                                                            \
 
274
  W_ mp_result;                                                         \
 
275
                                                                        \
 
276
  /* call doYouWantToGC() */                                            \
 
277
  MAYBE_GC(R2_PTR, name);                                               \
 
278
                                                                        \
 
279
  STK_CHK_GEN( 2 * SIZEOF_MP_INT, R2_PTR, name );                       \
 
280
                                                                        \
 
281
  s1 = W_TO_INT(R1);                                                    \
 
282
  d1 = R2;                                                              \
 
283
  ul = R3;                                                              \
 
284
                                                                        \
 
285
  mp_tmp     = Sp - 1 * SIZEOF_MP_INT;                                  \
 
286
  mp_result  = Sp - 2 * SIZEOF_MP_INT;                                  \
 
287
  MP_INT__mp_alloc(mp_tmp) = W_TO_INT(BYTE_ARR_WDS(d1));                \
 
288
  MP_INT__mp_size(mp_tmp)  = (s1);                                      \
 
289
  MP_INT__mp_d(mp_tmp)     = BYTE_ARR_CTS(d1);                          \
 
290
                                                                        \
 
291
  foreign "C" __gmpz_init(mp_result "ptr") [];                          \
 
292
                                                                        \
 
293
  /* Perform the operation */                                           \
 
294
  foreign "C" mp_fun(mp_result "ptr",mp_tmp "ptr", ul) [];              \
 
295
                                                                        \
 
296
  RET_NP(TO_W_(MP_INT__mp_size(mp_result)),                             \
 
297
         MP_INT__mp_d(mp_result) - SIZEOF_StgArrWords);                 \
 
298
}
 
299
 
 
300
#define GMP_TAKE1_RET1(name,mp_fun)                                     \
 
301
name                                                                    \
 
302
{                                                                       \
 
303
  CInt s1;                                                              \
 
304
  W_ d1;                                                                \
 
305
  W_ mp_tmp1;                                                           \
 
306
  W_ mp_result1;                                                        \
 
307
                                                                        \
 
308
  /* call doYouWantToGC() */                                            \
 
309
  MAYBE_GC(R2_PTR, name);                                               \
 
310
                                                                        \
 
311
  STK_CHK_GEN( 2 * SIZEOF_MP_INT, R2_PTR, name );                       \
 
312
                                                                        \
 
313
  d1 = R2;                                                              \
 
314
  s1 = W_TO_INT(R1);                                                    \
 
315
                                                                        \
 
316
  mp_tmp1    = Sp - 1 * SIZEOF_MP_INT;                                  \
 
317
  mp_result1 = Sp - 2 * SIZEOF_MP_INT;                                  \
 
318
  MP_INT__mp_alloc(mp_tmp1)     = W_TO_INT(BYTE_ARR_WDS(d1));           \
 
319
  MP_INT__mp_size(mp_tmp1)      = (s1);                                 \
 
320
  MP_INT__mp_d(mp_tmp1)         = BYTE_ARR_CTS(d1);                     \
 
321
                                                                        \
 
322
  foreign "C" __gmpz_init(mp_result1 "ptr") [];                         \
 
323
                                                                        \
 
324
  /* Perform the operation */                                           \
 
325
  foreign "C" mp_fun(mp_result1 "ptr",mp_tmp1 "ptr") [];                \
 
326
                                                                        \
 
327
  RET_NP(TO_W_(MP_INT__mp_size(mp_result1)),                            \
 
328
         MP_INT__mp_d(mp_result1) - SIZEOF_StgArrWords);                \
 
329
}
 
330
 
 
331
#define GMP_TAKE2_RET2(name,mp_fun)                                                     \
 
332
name                                                                                    \
 
333
{                                                                                       \
 
334
  CInt s1, s2;                                                                          \
 
335
  W_ d1, d2;                                                                            \
 
336
  W_ mp_tmp1;                                                                           \
 
337
  W_ mp_tmp2;                                                                           \
 
338
  W_ mp_result1;                                                                        \
 
339
  W_ mp_result2;                                                                        \
 
340
                                                                                        \
 
341
  /* call doYouWantToGC() */                                                            \
 
342
  MAYBE_GC(R2_PTR & R4_PTR, name);                                                      \
 
343
                                                                                        \
 
344
  STK_CHK_GEN( 4 * SIZEOF_MP_INT, R2_PTR & R4_PTR, name );                              \
 
345
                                                                                        \
 
346
  s1 = W_TO_INT(R1);                                                                    \
 
347
  d1 = R2;                                                                              \
 
348
  s2 = W_TO_INT(R3);                                                                    \
 
349
  d2 = R4;                                                                              \
 
350
                                                                                        \
 
351
  mp_tmp1    = Sp - 1 * SIZEOF_MP_INT;                                                  \
 
352
  mp_tmp2    = Sp - 2 * SIZEOF_MP_INT;                                                  \
 
353
  mp_result1 = Sp - 3 * SIZEOF_MP_INT;                                                  \
 
354
  mp_result2 = Sp - 4 * SIZEOF_MP_INT;                                                  \
 
355
  MP_INT__mp_alloc(mp_tmp1)     = W_TO_INT(BYTE_ARR_WDS(d1));                           \
 
356
  MP_INT__mp_size(mp_tmp1)      = (s1);                                                 \
 
357
  MP_INT__mp_d(mp_tmp1)         = BYTE_ARR_CTS(d1);                                     \
 
358
  MP_INT__mp_alloc(mp_tmp2)     = W_TO_INT(BYTE_ARR_WDS(d2));                           \
 
359
  MP_INT__mp_size(mp_tmp2)      = (s2);                                                 \
 
360
  MP_INT__mp_d(mp_tmp2)         = BYTE_ARR_CTS(d2);                                     \
 
361
                                                                                        \
 
362
  foreign "C" __gmpz_init(mp_result1 "ptr") [];                                         \
 
363
  foreign "C" __gmpz_init(mp_result2 "ptr") [];                                         \
 
364
                                                                                        \
 
365
  /* Perform the operation */                                                           \
 
366
  foreign "C" mp_fun(mp_result1 "ptr",mp_result2 "ptr",mp_tmp1 "ptr",mp_tmp2 "ptr") []; \
 
367
                                                                                        \
 
368
  RET_NPNP(TO_W_(MP_INT__mp_size(mp_result1)),                                          \
 
369
           MP_INT__mp_d(mp_result1) - SIZEOF_StgArrWords,                               \
 
370
           TO_W_(MP_INT__mp_size(mp_result2)),                                          \
 
371
           MP_INT__mp_d(mp_result2) - SIZEOF_StgArrWords);                              \
 
372
}
 
373
 
 
374
GMP_TAKE2_RET1(integer_cmm_plusIntegerzh,     __gmpz_add)
 
375
GMP_TAKE2_RET1(integer_cmm_minusIntegerzh,    __gmpz_sub)
 
376
GMP_TAKE2_RET1(integer_cmm_timesIntegerzh,    __gmpz_mul)
 
377
GMP_TAKE2_RET1(integer_cmm_gcdIntegerzh,      __gmpz_gcd)
 
378
GMP_TAKE2_RET1(integer_cmm_quotIntegerzh,     __gmpz_tdiv_q)
 
379
GMP_TAKE2_RET1(integer_cmm_remIntegerzh,      __gmpz_tdiv_r)
 
380
GMP_TAKE2_RET1(integer_cmm_divExactIntegerzh, __gmpz_divexact)
 
381
GMP_TAKE2_RET1(integer_cmm_andIntegerzh,      __gmpz_and)
 
382
GMP_TAKE2_RET1(integer_cmm_orIntegerzh,       __gmpz_ior)
 
383
GMP_TAKE2_RET1(integer_cmm_xorIntegerzh,      __gmpz_xor)
 
384
GMP_TAKE1_UL1_RET1(integer_cmm_mul2ExpIntegerzh, __gmpz_mul_2exp)
 
385
GMP_TAKE1_UL1_RET1(integer_cmm_fdivQ2ExpIntegerzh, __gmpz_fdiv_q_2exp)
 
386
GMP_TAKE1_RET1(integer_cmm_complementIntegerzh, __gmpz_com)
 
387
 
 
388
GMP_TAKE2_RET2(integer_cmm_quotRemIntegerzh, __gmpz_tdiv_qr)
 
389
GMP_TAKE2_RET2(integer_cmm_divModIntegerzh,  __gmpz_fdiv_qr)
 
390
 
 
391
integer_cmm_gcdIntzh
 
392
{
 
393
    /* R1 = the first Int#; R2 = the second Int# */
 
394
    W_ r;
 
395
    W_ mp_tmp_w;
 
396
 
 
397
    STK_CHK_GEN( 1 * SIZEOF_MP_INT, NO_PTRS, integer_cmm_gcdIntzh );
 
398
 
 
399
    mp_tmp_w = Sp - 1 * SIZEOF_MP_INT;
 
400
 
 
401
    W_[mp_tmp_w] = R1;
 
402
    (r) = foreign "C" __gmpn_gcd_1(mp_tmp_w "ptr", 1, R2) [];
 
403
 
 
404
    R1 = r;
 
405
    /* Result parked in R1, return via info-pointer at TOS */
 
406
    jump %ENTRY_CODE(Sp(0));
 
407
}
 
408
 
 
409
 
 
410
integer_cmm_gcdIntegerIntzh
 
411
{
 
412
    /* R1 = s1; R2 = d1; R3 = the int */
 
413
    W_ s1;
 
414
    (s1) = foreign "C" __gmpn_gcd_1( BYTE_ARR_CTS(R2) "ptr", R1, R3) [];
 
415
    R1 = s1;
 
416
 
 
417
    /* Result parked in R1, return via info-pointer at TOS */
 
418
    jump %ENTRY_CODE(Sp(0));
 
419
}
 
420
 
 
421
 
 
422
integer_cmm_cmpIntegerIntzh
 
423
{
 
424
    /* R1 = s1; R2 = d1; R3 = the int */
 
425
    W_ usize, vsize, v_digit, u_digit;
 
426
 
 
427
    usize = R1;
 
428
    vsize = 0;
 
429
    v_digit = R3;
 
430
 
 
431
    // paraphrased from __gmpz_cmp_si() in the GMP sources
 
432
    if (%gt(v_digit,0)) {
 
433
        vsize = 1;
 
434
    } else {
 
435
        if (%lt(v_digit,0)) {
 
436
            vsize = -1;
 
437
            v_digit = -v_digit;
 
438
        }
 
439
    }
 
440
 
 
441
    if (usize != vsize) {
 
442
        R1 = usize - vsize;
 
443
        jump %ENTRY_CODE(Sp(0));
 
444
    }
 
445
 
 
446
    if (usize == 0) {
 
447
        R1 = 0;
 
448
        jump %ENTRY_CODE(Sp(0));
 
449
    }
 
450
 
 
451
    u_digit = W_[BYTE_ARR_CTS(R2)];
 
452
 
 
453
    if (u_digit == v_digit) {
 
454
        R1 = 0;
 
455
        jump %ENTRY_CODE(Sp(0));
 
456
    }
 
457
 
 
458
    if (%gtu(u_digit,v_digit)) { // NB. unsigned: these are mp_limb_t's
 
459
        R1 = usize;
 
460
    } else {
 
461
        R1 = -usize;
 
462
    }
 
463
 
 
464
    jump %ENTRY_CODE(Sp(0));
 
465
}
 
466
 
 
467
integer_cmm_cmpIntegerzh
 
468
{
 
469
    /* R1 = s1; R2 = d1; R3 = s2; R4 = d2 */
 
470
    W_ usize, vsize, size, up, vp;
 
471
    CInt cmp;
 
472
 
 
473
    // paraphrased from __gmpz_cmp() in the GMP sources
 
474
    usize = R1;
 
475
    vsize = R3;
 
476
 
 
477
    if (usize != vsize) {
 
478
        R1 = usize - vsize;
 
479
        jump %ENTRY_CODE(Sp(0));
 
480
    }
 
481
 
 
482
    if (usize == 0) {
 
483
        R1 = 0;
 
484
        jump %ENTRY_CODE(Sp(0));
 
485
    }
 
486
 
 
487
    if (%lt(usize,0)) { // NB. not <, which is unsigned
 
488
        size = -usize;
 
489
    } else {
 
490
        size = usize;
 
491
    }
 
492
 
 
493
    up = BYTE_ARR_CTS(R2);
 
494
    vp = BYTE_ARR_CTS(R4);
 
495
 
 
496
    (cmp) = foreign "C" __gmpn_cmp(up "ptr", vp "ptr", size) [];
 
497
 
 
498
    if (cmp == 0 :: CInt) {
 
499
        R1 = 0;
 
500
        jump %ENTRY_CODE(Sp(0));
 
501
    }
 
502
 
 
503
    if (%lt(cmp,0 :: CInt) == %lt(usize,0)) {
 
504
        R1 = 1;
 
505
    } else {
 
506
        R1 = (-1);
 
507
    }
 
508
    /* Result parked in R1, return via info-pointer at TOS */
 
509
    jump %ENTRY_CODE(Sp(0));
 
510
}
 
511
 
 
512
#define DOUBLE_MANTISSA_SIZE SIZEOF_DOUBLE
 
513
#define ARR_SIZE (SIZEOF_StgArrWords + DOUBLE_MANTISSA_SIZE)
 
514
 
 
515
integer_cmm_decodeDoublezh
 
516
{
 
517
    D_ arg;
 
518
    W_ p;
 
519
    W_ mp_tmp1;
 
520
    W_ mp_tmp_w;
 
521
 
 
522
    STK_CHK_GEN( 2 * SIZEOF_MP_INT, NO_PTRS, integer_cmm_decodeDoublezh );
 
523
 
 
524
    mp_tmp1  = Sp - 1 * SIZEOF_MP_INT;
 
525
    mp_tmp_w = Sp - 2 * SIZEOF_MP_INT;
 
526
 
 
527
    /* arguments: D1 = Double# */
 
528
    arg = D1;
 
529
 
 
530
    ALLOC_PRIM( ARR_SIZE, NO_PTRS, integer_cmm_decodeDoublezh );
 
531
 
 
532
    /* Be prepared to tell Lennart-coded integer_cbits_decodeDouble
 
533
       where mantissa.d can be put (it does not care about the rest) */
 
534
    p = Hp - ARR_SIZE + WDS(1);
 
535
    SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
 
536
    StgArrWords_bytes(p) = DOUBLE_MANTISSA_SIZE;
 
537
    MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(p);
 
538
 
 
539
    /* Perform the operation */
 
540
    foreign "C" integer_cbits_decodeDouble(mp_tmp1 "ptr", mp_tmp_w "ptr",arg) [];
 
541
 
 
542
    /* returns: (Int# (expn), Int#, ByteArray#) */
 
543
    RET_NNP(W_[mp_tmp_w], TO_W_(MP_INT__mp_size(mp_tmp1)), p);
 
544
}