1 /* -----------------------------------------------------------------------------
2 * $Id: PrimOps.h,v 1.82 2001/08/18 11:55:48 qrczak Exp $
4 * (c) The GHC Team, 1998-2000
6 * Macros for primitive operations in STG-ish C code.
8 * ---------------------------------------------------------------------------*/
15 #if WORD_SIZE_IN_BITS < 32
16 #error GHC C backend requires 32+-bit words
19 /* -----------------------------------------------------------------------------
20 Helpers for the bytecode linker.
21 -------------------------------------------------------------------------- */
23 #define addrToHValuezh(r,a) r=(P_)a
26 /* -----------------------------------------------------------------------------
28 -------------------------------------------------------------------------- */
30 #define gtCharzh(r,a,b) r=(a)> (b)
31 #define geCharzh(r,a,b) r=(a)>=(b)
32 #define eqCharzh(r,a,b) r=(a)==(b)
33 #define neCharzh(r,a,b) r=(a)!=(b)
34 #define ltCharzh(r,a,b) r=(a)< (b)
35 #define leCharzh(r,a,b) r=(a)<=(b)
37 /* Int comparisons: >#, >=# etc */
38 #define zgzh(r,a,b) r=(a)> (b)
39 #define zgzezh(r,a,b) r=(a)>=(b)
40 #define zezezh(r,a,b) r=(a)==(b)
41 #define zszezh(r,a,b) r=(a)!=(b)
42 #define zlzh(r,a,b) r=(a)< (b)
43 #define zlzezh(r,a,b) r=(a)<=(b)
45 #define gtWordzh(r,a,b) r=(a)> (b)
46 #define geWordzh(r,a,b) r=(a)>=(b)
47 #define eqWordzh(r,a,b) r=(a)==(b)
48 #define neWordzh(r,a,b) r=(a)!=(b)
49 #define ltWordzh(r,a,b) r=(a)< (b)
50 #define leWordzh(r,a,b) r=(a)<=(b)
52 #define gtAddrzh(r,a,b) r=(a)> (b)
53 #define geAddrzh(r,a,b) r=(a)>=(b)
54 #define eqAddrzh(r,a,b) r=(a)==(b)
55 #define neAddrzh(r,a,b) r=(a)!=(b)
56 #define ltAddrzh(r,a,b) r=(a)< (b)
57 #define leAddrzh(r,a,b) r=(a)<=(b)
59 #define gtFloatzh(r,a,b) r=(a)> (b)
60 #define geFloatzh(r,a,b) r=(a)>=(b)
61 #define eqFloatzh(r,a,b) r=(a)==(b)
62 #define neFloatzh(r,a,b) r=(a)!=(b)
63 #define ltFloatzh(r,a,b) r=(a)< (b)
64 #define leFloatzh(r,a,b) r=(a)<=(b)
66 /* Double comparisons: >##, >=## etc */
67 #define zgzhzh(r,a,b) r=(a)> (b)
68 #define zgzezhzh(r,a,b) r=(a)>=(b)
69 #define zezezhzh(r,a,b) r=(a)==(b)
70 #define zszezhzh(r,a,b) r=(a)!=(b)
71 #define zlzhzh(r,a,b) r=(a)< (b)
72 #define zlzezhzh(r,a,b) r=(a)<=(b)
74 /* -----------------------------------------------------------------------------
76 -------------------------------------------------------------------------- */
78 #define ordzh(r,a) r=(I_)(a)
79 #define chrzh(r,a) r=(C_)(a)
81 /* -----------------------------------------------------------------------------
83 -------------------------------------------------------------------------- */
85 #define zpzh(r,a,b) r=(a)+(b)
86 #define zmzh(r,a,b) r=(a)-(b)
87 #define ztzh(r,a,b) r=(a)*(b)
88 #define quotIntzh(r,a,b) r=(a)/(b)
89 #define remIntzh(r,a,b) r=(a)%(b)
90 #define negateIntzh(r,a) r=-(a)
92 /* -----------------------------------------------------------------------------
93 * Int operations with carry.
94 * -------------------------------------------------------------------------- */
96 /* With some bit-twiddling, we can define int{Add,Sub}Czh portably in
97 * C, and without needing any comparisons. This may not be the
98 * fastest way to do it - if you have better code, please send it! --SDM
100 * Return : r = a + b, c = 0 if no overflow, 1 on overflow.
102 * We currently don't make use of the r value if c is != 0 (i.e.
103 * overflow), we just convert to big integers and try again. This
104 * could be improved by making r and c the correct values for
105 * plugging into a new J#.
107 #define addIntCzh(r,c,a,b) \
108 { r = (I_)a + (I_)b; \
109 c = ((StgWord)(~((I_)a^(I_)b) & ((I_)a^r))) \
110 >> (BITS_IN (I_) - 1); \
114 #define subIntCzh(r,c,a,b) \
116 c = ((StgWord)((a^b) & (a^r))) \
117 >> (BITS_IN (I_) - 1); \
120 /* Multiply with overflow checking.
122 * This is slightly more tricky - the usual sign rules for add/subtract
125 * On x86 hardware we use a hand-crafted assembly fragment to do the job.
127 * On other 32-bit machines we use gcc's 'long long' types, finding
128 * overflow with some careful bit-twiddling.
130 * On 64-bit machines where gcc's 'long long' type is also 64-bits,
131 * we use a crude approximation, testing whether either operand is
132 * larger than 32-bits; if neither is, then we go ahead with the
138 #define mulIntCzh(r,c,a,b) \
140 __asm__("xorl %1,%1\n\t \
145 : "=r" (r), "=&r" (c) : "r" (a), "0" (b)); \
148 #elif SIZEOF_VOID_P == 4
150 #ifdef WORDS_BIGENDIAN
163 #define mulIntCzh(r,c,a,b) \
166 z.l = (StgInt64)a * (StgInt64)b; \
169 if (c == 0 || c == -1) { \
170 c = ((StgWord)((a^b) ^ r)) \
171 >> (BITS_IN (I_) - 1); \
174 /* Careful: the carry calculation above is extremely delicate. Make sure
175 * you test it thoroughly after changing it.
180 #define HALF_INT (1LL << (BITS_IN (I_) / 2))
182 #define stg_abs(a) ((a) < 0 ? -(a) : (a))
184 #define mulIntCzh(r,c,a,b) \
186 if (stg_abs(a) >= HALF_INT || \
187 stg_abs(b) >= HALF_INT) { \
196 /* -----------------------------------------------------------------------------
198 -------------------------------------------------------------------------- */
200 #define plusWordzh(r,a,b) r=(a)+(b)
201 #define minusWordzh(r,a,b) r=(a)-(b)
202 #define timesWordzh(r,a,b) r=(a)*(b)
203 #define quotWordzh(r,a,b) r=(a)/(b)
204 #define remWordzh(r,a,b) r=(a)%(b)
206 #define andzh(r,a,b) r=(a)&(b)
207 #define orzh(r,a,b) r=(a)|(b)
208 #define xorzh(r,a,b) r=(a)^(b)
209 #define notzh(r,a) r=~(a)
211 /* The extra tests below properly define the behaviour when shifting
212 * by offsets larger than the width of the value being shifted. Doing
213 * so is undefined in C (and in fact gives different answers depending
214 * on whether the operation is constant folded or not with gcc on x86!)
217 #define shiftLzh(r,a,b) r=((b) >= BITS_IN(W_)) ? 0 : (a)<<(b)
218 #define shiftRLzh(r,a,b) r=((b) >= BITS_IN(W_)) ? 0 : (a)>>(b)
219 #define iShiftLzh(r,a,b) r=((b) >= BITS_IN(W_)) ? 0 : (a)<<(b)
220 /* Right shifting of signed quantities is not portable in C, so
221 the behaviour you'll get from using these primops depends
222 on the whatever your C compiler is doing. ToDo: fix/document. -- sof 8/98
224 #define iShiftRAzh(r,a,b) r=((b) >= BITS_IN(I_)) ? (((a) < 0) ? -1 : 0) : (a)>>(b)
225 #define iShiftRLzh(r,a,b) r=((b) >= BITS_IN(I_)) ? 0 : (I_)((W_)(a)>>(b))
227 #define int2Wordzh(r,a) r=(W_)(a)
228 #define word2Intzh(r,a) r=(I_)(a)
230 /* -----------------------------------------------------------------------------
231 Explicitly sized Int# and Word# PrimOps.
232 -------------------------------------------------------------------------- */
234 #define narrow8Intzh(r,a) r=(StgInt8)(a)
235 #define narrow16Intzh(r,a) r=(StgInt16)(a)
236 #define narrow32Intzh(r,a) r=(StgInt32)(a)
237 #define narrow8Wordzh(r,a) r=(StgWord8)(a)
238 #define narrow16Wordzh(r,a) r=(StgWord16)(a)
239 #define narrow32Wordzh(r,a) r=(StgWord32)(a)
241 /* -----------------------------------------------------------------------------
243 -------------------------------------------------------------------------- */
245 #define nullAddrzh(r,i) r=(A_)(0)
246 #define plusAddrzh(r,a,i) r=((char *)(a)) + (i)
247 #define minusAddrzh(r,a,b) r=((char *)(a)) - ((char *)(b))
248 #define remAddrzh(r,a,i) r=((W_)(a))%(i)
249 #define int2Addrzh(r,a) r=(A_)(a)
250 #define addr2Intzh(r,a) r=(I_)(a)
252 #define readCharOffAddrzh(r,a,i) r=((StgWord8 *)(a))[i]
253 #define readWideCharOffAddrzh(r,a,i) r=((C_ *)(a))[i]
254 #define readIntOffAddrzh(r,a,i) r=((I_ *)(a))[i]
255 #define readWordOffAddrzh(r,a,i) r=((W_ *)(a))[i]
256 #define readAddrOffAddrzh(r,a,i) r=((PP_)(a))[i]
257 #define readFloatOffAddrzh(r,a,i) r=PK_FLT((P_) (((StgFloat *)(a)) + i))
258 #define readDoubleOffAddrzh(r,a,i) r=PK_DBL((P_) (((StgDouble *)(a)) + i))
259 #define readStablePtrOffAddrzh(r,a,i) r=((StgStablePtr *)(a))[i]
260 #define readInt8OffAddrzh(r,a,i) r=((StgInt8 *)(a))[i]
261 #define readInt16OffAddrzh(r,a,i) r=((StgInt16 *)(a))[i]
262 #define readWord8OffAddrzh(r,a,i) r=((StgWord8 *)(a))[i]
263 #define readWord16OffAddrzh(r,a,i) r=((StgWord16 *)(a))[i]
264 #define readInt32OffAddrzh(r,a,i) r=((StgInt32 *)(a))[i]
265 #define readWord32OffAddrzh(r,a,i) r=((StgWord32 *)(a))[i]
266 #ifdef SUPPORT_LONG_LONGS
267 #define readInt64OffAddrzh(r,a,i) r=((LI_ *)(a))[i]
268 #define readWord64OffAddrzh(r,a,i) r=((LW_ *)(a))[i]
270 #define readInt64OffAddrzh(r,a,i) r=((I_ *)(a))[i]
271 #define readWord64OffAddrzh(r,a,i) r=((W_ *)(a))[i]
274 #define writeCharOffAddrzh(a,i,v) ((StgWord8 *)(a))[i] = (v)
275 #define writeWideCharOffAddrzh(a,i,v) ((C_ *)(a))[i] = (v)
276 #define writeIntOffAddrzh(a,i,v) ((I_ *)(a))[i] = (v)
277 #define writeWordOffAddrzh(a,i,v) ((W_ *)(a))[i] = (v)
278 #define writeAddrOffAddrzh(a,i,v) ((PP_)(a))[i] = (v)
279 #define writeForeignObjOffAddrzh(a,i,v) ((PP_)(a))[i] = ForeignObj_CLOSURE_DATA(v)
280 #define writeFloatOffAddrzh(a,i,v) ASSIGN_FLT((P_) (((StgFloat *)(a)) + i),v)
281 #define writeDoubleOffAddrzh(a,i,v) ASSIGN_DBL((P_) (((StgDouble *)(a)) + i),v)
282 #define writeStablePtrOffAddrzh(a,i,v) ((StgStablePtr *)(a))[i] = (v)
283 #define writeInt8OffAddrzh(a,i,v) ((StgInt8 *)(a))[i] = (v)
284 #define writeInt16OffAddrzh(a,i,v) ((StgInt16 *)(a))[i] = (v)
285 #define writeInt32OffAddrzh(a,i,v) ((StgInt32 *)(a))[i] = (v)
286 #define writeWord8OffAddrzh(a,i,v) ((StgWord8 *)(a))[i] = (v)
287 #define writeWord16OffAddrzh(a,i,v) ((StgWord16 *)(a))[i] = (v)
288 #define writeWord32OffAddrzh(a,i,v) ((StgWord32 *)(a))[i] = (v)
289 #ifdef SUPPORT_LONG_LONGS
290 #define writeInt64OffAddrzh(a,i,v) ((LI_ *)(a))[i] = (v)
291 #define writeWord64OffAddrzh(a,i,v) ((LW_ *)(a))[i] = (v)
293 #define writeInt64OffAddrzh(a,i,v) ((I_ *)(a))[i] = (v)
294 #define writeWord64OffAddrzh(a,i,v) ((W_ *)(a))[i] = (v)
297 #define indexCharOffAddrzh(r,a,i) r=((StgWord8 *)(a))[i]
298 #define indexWideCharOffAddrzh(r,a,i) r=((C_ *)(a))[i]
299 #define indexIntOffAddrzh(r,a,i) r=((I_ *)(a))[i]
300 #define indexWordOffAddrzh(r,a,i) r=((W_ *)(a))[i]
301 #define indexAddrOffAddrzh(r,a,i) r=((PP_)(a))[i]
302 #define indexFloatOffAddrzh(r,a,i) r=PK_FLT((P_) (((StgFloat *)(a)) + i))
303 #define indexDoubleOffAddrzh(r,a,i) r=PK_DBL((P_) (((StgDouble *)(a)) + i))
304 #define indexStablePtrOffAddrzh(r,a,i) r=((StgStablePtr *)(a))[i]
305 #define indexInt8OffAddrzh(r,a,i) r=((StgInt8 *)(a))[i]
306 #define indexInt16OffAddrzh(r,a,i) r=((StgInt16 *)(a))[i]
307 #define indexInt32OffAddrzh(r,a,i) r=((StgInt32 *)(a))[i]
308 #define indexWord8OffAddrzh(r,a,i) r=((StgWord8 *)(a))[i]
309 #define indexWord16OffAddrzh(r,a,i) r=((StgWord16 *)(a))[i]
310 #define indexWord32OffAddrzh(r,a,i) r=((StgWord32 *)(a))[i]
311 #ifdef SUPPORT_LONG_LONGS
312 #define indexInt64OffAddrzh(r,a,i) r=((LI_ *)(a))[i]
313 #define indexWord64OffAddrzh(r,a,i) r=((LW_ *)(a))[i]
315 #define indexInt64OffAddrzh(r,a,i) r=((I_ *)(a))[i]
316 #define indexWord64OffAddrzh(r,a,i) r=((W_ *)(a))[i]
319 /* -----------------------------------------------------------------------------
321 -------------------------------------------------------------------------- */
323 #define plusFloatzh(r,a,b) r=(a)+(b)
324 #define minusFloatzh(r,a,b) r=(a)-(b)
325 #define timesFloatzh(r,a,b) r=(a)*(b)
326 #define divideFloatzh(r,a,b) r=(a)/(b)
327 #define negateFloatzh(r,a) r=-(a)
329 #define int2Floatzh(r,a) r=(StgFloat)(a)
330 #define float2Intzh(r,a) r=(I_)(a)
332 #define expFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,exp,a)
333 #define logFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,log,a)
334 #define sqrtFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sqrt,a)
335 #define sinFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sin,a)
336 #define cosFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,cos,a)
337 #define tanFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,tan,a)
338 #define asinFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,asin,a)
339 #define acosFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,acos,a)
340 #define atanFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,atan,a)
341 #define sinhFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sinh,a)
342 #define coshFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,cosh,a)
343 #define tanhFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,tanh,a)
344 #define powerFloatzh(r,a,b) r=(StgFloat) RET_PRIM_STGCALL2(StgDouble,pow,a,b)
346 /* -----------------------------------------------------------------------------
348 -------------------------------------------------------------------------- */
350 #define zpzhzh(r,a,b) r=(a)+(b)
351 #define zmzhzh(r,a,b) r=(a)-(b)
352 #define ztzhzh(r,a,b) r=(a)*(b)
353 #define zszhzh(r,a,b) r=(a)/(b)
354 #define negateDoublezh(r,a) r=-(a)
356 #define int2Doublezh(r,a) r=(StgDouble)(a)
357 #define double2Intzh(r,a) r=(I_)(a)
359 #define float2Doublezh(r,a) r=(StgDouble)(a)
360 #define double2Floatzh(r,a) r=(StgFloat)(a)
362 #define expDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,exp,a)
363 #define logDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,log,a)
364 #define sqrtDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sqrt,a)
365 #define sinDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sin,a)
366 #define cosDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,cos,a)
367 #define tanDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,tan,a)
368 #define asinDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,asin,a)
369 #define acosDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,acos,a)
370 #define atanDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,atan,a)
371 #define sinhDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sinh,a)
372 #define coshDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,cosh,a)
373 #define tanhDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,tanh,a)
375 #define ztztzhzh(r,a,b) r=(StgDouble) RET_PRIM_STGCALL2(StgDouble,pow,a,b)
377 /* -----------------------------------------------------------------------------
379 -------------------------------------------------------------------------- */
381 /* We can do integer2Int and cmpInteger inline, since they don't need
382 * to allocate any memory.
384 * integer2Int# is now modular.
387 #define integer2Intzh(r, sa,da) \
394 res = ((mp_limb_t *) (BYTE_ARR_CTS(da)))[0]; \
395 if (s < 0) res = -res; \
400 #define integer2Wordzh(r, sa,da) \
408 res = ((mp_limb_t *) (BYTE_ARR_CTS(da)))[0]; \
409 if (s < 0) res = -res; \
414 #define cmpIntegerzh(r, s1,d1, s2,d2) \
418 arg1._mp_size = (s1); \
419 arg1._mp_alloc= ((StgArrWords *)d1)->words; \
420 arg1._mp_d = (mp_limb_t *) (BYTE_ARR_CTS(d1)); \
421 arg2._mp_size = (s2); \
422 arg2._mp_alloc= ((StgArrWords *)d2)->words; \
423 arg2._mp_d = (mp_limb_t *) (BYTE_ARR_CTS(d2)); \
425 (r) = RET_PRIM_STGCALL2(I_,mpz_cmp,&arg1,&arg2); \
428 #define cmpIntegerIntzh(r, s,d, i) \
431 arg._mp_size = (s); \
432 arg._mp_alloc = ((StgArrWords *)d)->words; \
433 arg._mp_d = (mp_limb_t *) (BYTE_ARR_CTS(d)); \
435 (r) = RET_PRIM_STGCALL2(I_,mpz_cmp_si,&arg,i); \
438 /* NOTE: gcdIntzh and gcdIntegerIntzh work only for positive inputs! */
440 /* mp_limb_t must be able to hold an StgInt for this to work properly */
441 #define gcdIntzh(r,a,b) \
442 { mp_limb_t aa = (mp_limb_t)(a); \
443 r = RET_STGCALL3(StgInt, mpn_gcd_1, (mp_limb_t *)(&aa), 1, (mp_limb_t)(b)); \
446 #define gcdIntegerIntzh(r,sa,a,b) \
447 r = RET_STGCALL3(StgInt, mpn_gcd_1, (mp_limb_t *)(BYTE_ARR_CTS(a)), sa, b)
449 /* The rest are all out-of-line: -------- */
451 /* Integer arithmetic */
452 EXTFUN_RTS(plusIntegerzh_fast);
453 EXTFUN_RTS(minusIntegerzh_fast);
454 EXTFUN_RTS(timesIntegerzh_fast);
455 EXTFUN_RTS(gcdIntegerzh_fast);
456 EXTFUN_RTS(quotRemIntegerzh_fast);
457 EXTFUN_RTS(quotIntegerzh_fast);
458 EXTFUN_RTS(remIntegerzh_fast);
459 EXTFUN_RTS(divExactIntegerzh_fast);
460 EXTFUN_RTS(divModIntegerzh_fast);
463 EXTFUN_RTS(int2Integerzh_fast);
464 EXTFUN_RTS(word2Integerzh_fast);
466 /* Floating-point decodings */
467 EXTFUN_RTS(decodeFloatzh_fast);
468 EXTFUN_RTS(decodeDoublezh_fast);
471 EXTFUN_RTS(andIntegerzh_fast);
472 EXTFUN_RTS(orIntegerzh_fast);
473 EXTFUN_RTS(xorIntegerzh_fast);
474 EXTFUN_RTS(complementIntegerzh_fast);
476 /* -----------------------------------------------------------------------------
478 -------------------------------------------------------------------------- */
480 #ifdef SUPPORT_LONG_LONGS
482 #define integerToWord64zh(r,sa,da) \
487 d = (mp_limb_t *) (BYTE_ARR_CTS(da)); \
490 case 0: res = 0; break; \
491 case 1: res = d[0]; break; \
492 case -1: res = -d[0]; break; \
494 res = d[0] + ((StgWord64) d[1] << (BITS_IN (mp_limb_t))); \
495 if (s < 0) res = -res; \
500 #define integerToInt64zh(r,sa,da) \
505 d = (mp_limb_t *) (BYTE_ARR_CTS(da)); \
508 case 0: res = 0; break; \
509 case 1: res = d[0]; break; \
510 case -1: res = -d[0]; break; \
512 res = d[0] + ((StgWord64) d[1] << (BITS_IN (mp_limb_t))); \
513 if (s < 0) res = -res; \
519 EXTFUN_RTS(int64ToIntegerzh_fast);
520 EXTFUN_RTS(word64ToIntegerzh_fast);
522 /* The rest are (way!) out of line, implemented via C entry points.
524 I_ stg_gtWord64 (StgWord64, StgWord64);
525 I_ stg_geWord64 (StgWord64, StgWord64);
526 I_ stg_eqWord64 (StgWord64, StgWord64);
527 I_ stg_neWord64 (StgWord64, StgWord64);
528 I_ stg_ltWord64 (StgWord64, StgWord64);
529 I_ stg_leWord64 (StgWord64, StgWord64);
531 I_ stg_gtInt64 (StgInt64, StgInt64);
532 I_ stg_geInt64 (StgInt64, StgInt64);
533 I_ stg_eqInt64 (StgInt64, StgInt64);
534 I_ stg_neInt64 (StgInt64, StgInt64);
535 I_ stg_ltInt64 (StgInt64, StgInt64);
536 I_ stg_leInt64 (StgInt64, StgInt64);
538 LW_ stg_remWord64 (StgWord64, StgWord64);
539 LW_ stg_quotWord64 (StgWord64, StgWord64);
541 LI_ stg_remInt64 (StgInt64, StgInt64);
542 LI_ stg_quotInt64 (StgInt64, StgInt64);
543 LI_ stg_negateInt64 (StgInt64);
544 LI_ stg_plusInt64 (StgInt64, StgInt64);
545 LI_ stg_minusInt64 (StgInt64, StgInt64);
546 LI_ stg_timesInt64 (StgInt64, StgInt64);
548 LW_ stg_and64 (StgWord64, StgWord64);
549 LW_ stg_or64 (StgWord64, StgWord64);
550 LW_ stg_xor64 (StgWord64, StgWord64);
551 LW_ stg_not64 (StgWord64);
553 LW_ stg_shiftL64 (StgWord64, StgInt);
554 LW_ stg_shiftRL64 (StgWord64, StgInt);
555 LI_ stg_iShiftL64 (StgInt64, StgInt);
556 LI_ stg_iShiftRL64 (StgInt64, StgInt);
557 LI_ stg_iShiftRA64 (StgInt64, StgInt);
559 LI_ stg_intToInt64 (StgInt);
560 I_ stg_int64ToInt (StgInt64);
561 LW_ stg_int64ToWord64 (StgInt64);
563 LW_ stg_wordToWord64 (StgWord);
564 W_ stg_word64ToWord (StgWord64);
565 LI_ stg_word64ToInt64 (StgWord64);
568 /* -----------------------------------------------------------------------------
570 -------------------------------------------------------------------------- */
572 /* We cast to void* instead of StgChar* because this avoids a warning
573 * about increasing the alignment requirements.
575 #define REAL_BYTE_ARR_CTS(a) ((void *) (((StgArrWords *)(a))->payload))
576 #define REAL_PTRS_ARR_CTS(a) ((P_) (((StgMutArrPtrs *)(a))->payload))
579 #define BYTE_ARR_CTS(a) \
580 ({ ASSERT(GET_INFO((StgArrWords *)(a)) == &stg_ARR_WORDS_info); \
581 REAL_BYTE_ARR_CTS(a); })
582 #define PTRS_ARR_CTS(a) \
583 ({ ASSERT((GET_INFO((StgMutArrPtrs *)(a)) == &stg_MUT_ARR_PTRS_FROZEN_info) \
584 || (GET_INFO((StgMutArrPtrs *)(a)) == &stg_MUT_ARR_PTRS_info)); \
585 REAL_PTRS_ARR_CTS(a); })
587 #define BYTE_ARR_CTS(a) REAL_BYTE_ARR_CTS(a)
588 #define PTRS_ARR_CTS(a) REAL_PTRS_ARR_CTS(a)
591 extern I_ genSymZh(void);
592 extern I_ resetGenSymZh(void);
594 /*--- everything except new*Array is done inline: */
596 #define sameMutableArrayzh(r,a,b) r=(I_)((a)==(b))
597 #define sameMutableByteArrayzh(r,a,b) r=(I_)((a)==(b))
599 #define readArrayzh(r,a,i) r=((PP_) PTRS_ARR_CTS(a))[(i)]
601 #define readCharArrayzh(r,a,i) indexCharOffAddrzh(r,BYTE_ARR_CTS(a),i)
602 #define readWideCharArrayzh(r,a,i) indexWideCharOffAddrzh(r,BYTE_ARR_CTS(a),i)
603 #define readIntArrayzh(r,a,i) indexIntOffAddrzh(r,BYTE_ARR_CTS(a),i)
604 #define readWordArrayzh(r,a,i) indexWordOffAddrzh(r,BYTE_ARR_CTS(a),i)
605 #define readAddrArrayzh(r,a,i) indexAddrOffAddrzh(r,BYTE_ARR_CTS(a),i)
606 #define readFloatArrayzh(r,a,i) indexFloatOffAddrzh(r,BYTE_ARR_CTS(a),i)
607 #define readDoubleArrayzh(r,a,i) indexDoubleOffAddrzh(r,BYTE_ARR_CTS(a),i)
608 #define readStablePtrArrayzh(r,a,i) indexStablePtrOffAddrzh(r,BYTE_ARR_CTS(a),i)
609 #define readInt8Arrayzh(r,a,i) indexInt8OffAddrzh(r,BYTE_ARR_CTS(a),i)
610 #define readInt16Arrayzh(r,a,i) indexInt16OffAddrzh(r,BYTE_ARR_CTS(a),i)
611 #define readInt32Arrayzh(r,a,i) indexInt32OffAddrzh(r,BYTE_ARR_CTS(a),i)
612 #define readWord8Arrayzh(r,a,i) indexWord8OffAddrzh(r,BYTE_ARR_CTS(a),i)
613 #define readWord16Arrayzh(r,a,i) indexWord16OffAddrzh(r,BYTE_ARR_CTS(a),i)
614 #define readWord32Arrayzh(r,a,i) indexWord32OffAddrzh(r,BYTE_ARR_CTS(a),i)
615 #define readInt64Arrayzh(r,a,i) indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i)
616 #define readWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i)
618 /* result ("r") arg ignored in write macros! */
619 #define writeArrayzh(a,i,v) ((PP_) PTRS_ARR_CTS(a))[(i)]=(v)
621 #define writeCharArrayzh(a,i,v) writeCharOffAddrzh(BYTE_ARR_CTS(a),i,v)
622 #define writeWideCharArrayzh(a,i,v) writeWideCharOffAddrzh(BYTE_ARR_CTS(a),i,v)
623 #define writeIntArrayzh(a,i,v) writeIntOffAddrzh(BYTE_ARR_CTS(a),i,v)
624 #define writeWordArrayzh(a,i,v) writeWordOffAddrzh(BYTE_ARR_CTS(a),i,v)
625 #define writeAddrArrayzh(a,i,v) writeAddrOffAddrzh(BYTE_ARR_CTS(a),i,v)
626 #define writeFloatArrayzh(a,i,v) writeFloatOffAddrzh(BYTE_ARR_CTS(a),i,v)
627 #define writeDoubleArrayzh(a,i,v) writeDoubleOffAddrzh(BYTE_ARR_CTS(a),i,v)
628 #define writeStablePtrArrayzh(a,i,v) writeStablePtrOffAddrzh(BYTE_ARR_CTS(a),i,v)
629 #define writeInt8Arrayzh(a,i,v) writeInt8OffAddrzh(BYTE_ARR_CTS(a),i,v)
630 #define writeInt16Arrayzh(a,i,v) writeInt16OffAddrzh(BYTE_ARR_CTS(a),i,v)
631 #define writeInt32Arrayzh(a,i,v) writeInt32OffAddrzh(BYTE_ARR_CTS(a),i,v)
632 #define writeWord8Arrayzh(a,i,v) writeWord8OffAddrzh(BYTE_ARR_CTS(a),i,v)
633 #define writeWord16Arrayzh(a,i,v) writeWord16OffAddrzh(BYTE_ARR_CTS(a),i,v)
634 #define writeWord32Arrayzh(a,i,v) writeWord32OffAddrzh(BYTE_ARR_CTS(a),i,v)
635 #define writeInt64Arrayzh(a,i,v) writeInt64OffAddrzh(BYTE_ARR_CTS(a),i,v)
636 #define writeWord64Arrayzh(a,i,v) writeWord64OffAddrzh(BYTE_ARR_CTS(a),i,v)
638 #define indexArrayzh(r,a,i) r=((PP_) PTRS_ARR_CTS(a))[(i)]
640 #define indexCharArrayzh(r,a,i) indexCharOffAddrzh(r,BYTE_ARR_CTS(a),i)
641 #define indexWideCharArrayzh(r,a,i) indexWideCharOffAddrzh(r,BYTE_ARR_CTS(a),i)
642 #define indexIntArrayzh(r,a,i) indexIntOffAddrzh(r,BYTE_ARR_CTS(a),i)
643 #define indexWordArrayzh(r,a,i) indexWordOffAddrzh(r,BYTE_ARR_CTS(a),i)
644 #define indexAddrArrayzh(r,a,i) indexAddrOffAddrzh(r,BYTE_ARR_CTS(a),i)
645 #define indexFloatArrayzh(r,a,i) indexFloatOffAddrzh(r,BYTE_ARR_CTS(a),i)
646 #define indexDoubleArrayzh(r,a,i) indexDoubleOffAddrzh(r,BYTE_ARR_CTS(a),i)
647 #define indexStablePtrArrayzh(r,a,i) indexStablePtrOffAddrzh(r,BYTE_ARR_CTS(a),i)
648 #define indexInt8Arrayzh(r,a,i) indexInt8OffAddrzh(r,BYTE_ARR_CTS(a),i)
649 #define indexInt16Arrayzh(r,a,i) indexInt16OffAddrzh(r,BYTE_ARR_CTS(a),i)
650 #define indexInt32Arrayzh(r,a,i) indexInt32OffAddrzh(r,BYTE_ARR_CTS(a),i)
651 #define indexWord8Arrayzh(r,a,i) indexWord8OffAddrzh(r,BYTE_ARR_CTS(a),i)
652 #define indexWord16Arrayzh(r,a,i) indexWord16OffAddrzh(r,BYTE_ARR_CTS(a),i)
653 #define indexWord32Arrayzh(r,a,i) indexWord32OffAddrzh(r,BYTE_ARR_CTS(a),i)
654 #define indexInt64Arrayzh(r,a,i) indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i)
655 #define indexWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i)
657 /* Freezing arrays-of-ptrs requires changing an info table, for the
658 benefit of the generational collector. It needs to scavenge mutable
659 objects, even if they are in old space. When they become immutable,
660 they can be removed from this scavenge list. */
662 #define unsafeFreezzeArrayzh(r,a) \
664 SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN_info); \
668 #define unsafeFreezzeByteArrayzh(r,a) r=(a)
670 EXTFUN_RTS(unsafeThawArrayzh_fast);
672 #define sizzeofByteArrayzh(r,a) \
673 r = (((StgArrWords *)(a))->words * sizeof(W_))
674 #define sizzeofMutableByteArrayzh(r,a) \
675 r = (((StgArrWords *)(a))->words * sizeof(W_))
677 /* and the out-of-line ones... */
679 EXTFUN_RTS(newByteArrayzh_fast);
680 EXTFUN_RTS(newPinnedByteArrayzh_fast);
681 EXTFUN_RTS(newArrayzh_fast);
683 // Highly unsafe, for use with a pinned ByteArray
684 // being kept alive with touch#
685 #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
687 /* encoding and decoding of floats/doubles. */
689 /* We only support IEEE floating point format */
690 #include "ieee-flpt.h"
692 /* The decode operations are out-of-line because they need to allocate
695 EXTFUN_RTS(decodeFloatzh_fast);
696 EXTFUN_RTS(decodeDoublezh_fast);
698 /* grimy low-level support functions defined in StgPrimFloat.c */
700 extern StgDouble __encodeDouble (I_ size, StgByteArray arr, I_ e);
701 extern StgDouble __int_encodeDouble (I_ j, I_ e);
702 extern StgFloat __encodeFloat (I_ size, StgByteArray arr, I_ e);
703 extern StgFloat __int_encodeFloat (I_ j, I_ e);
704 extern void __decodeDouble (MP_INT *man, I_ *_exp, StgDouble dbl);
705 extern void __decodeFloat (MP_INT *man, I_ *_exp, StgFloat flt);
706 extern StgInt isDoubleNaN(StgDouble d);
707 extern StgInt isDoubleInfinite(StgDouble d);
708 extern StgInt isDoubleDenormalized(StgDouble d);
709 extern StgInt isDoubleNegativeZero(StgDouble d);
710 extern StgInt isFloatNaN(StgFloat f);
711 extern StgInt isFloatInfinite(StgFloat f);
712 extern StgInt isFloatDenormalized(StgFloat f);
713 extern StgInt isFloatNegativeZero(StgFloat f);
715 /* -----------------------------------------------------------------------------
718 newMutVar is out of line.
719 -------------------------------------------------------------------------- */
721 EXTFUN_RTS(newMutVarzh_fast);
723 #define readMutVarzh(r,a) r=(P_)(((StgMutVar *)(a))->var)
724 #define writeMutVarzh(a,v) (P_)(((StgMutVar *)(a))->var)=(v)
725 #define sameMutVarzh(r,a,b) r=(I_)((a)==(b))
727 /* -----------------------------------------------------------------------------
730 All out of line, because they either allocate or may block.
731 -------------------------------------------------------------------------- */
732 #define sameMVarzh(r,a,b) r=(I_)((a)==(b))
734 /* Assume external decl of EMPTY_MVAR_info is in scope by now */
735 #define isEmptyMVarzh(r,a) r=(I_)((GET_INFO((StgMVar*)(a))) == &stg_EMPTY_MVAR_info )
736 EXTFUN_RTS(newMVarzh_fast);
737 EXTFUN_RTS(takeMVarzh_fast);
738 EXTFUN_RTS(putMVarzh_fast);
739 EXTFUN_RTS(tryTakeMVarzh_fast);
740 EXTFUN_RTS(tryPutMVarzh_fast);
742 /* -----------------------------------------------------------------------------
744 -------------------------------------------------------------------------- */
746 EXTFUN_RTS(waitReadzh_fast);
747 EXTFUN_RTS(waitWritezh_fast);
748 EXTFUN_RTS(delayzh_fast);
750 /* -----------------------------------------------------------------------------
751 Primitive I/O, error-handling PrimOps
752 -------------------------------------------------------------------------- */
754 EXTFUN_RTS(catchzh_fast);
755 EXTFUN_RTS(raisezh_fast);
757 extern void stg_exit(I_ n) __attribute__ ((noreturn));
759 /* -----------------------------------------------------------------------------
760 Stable Name / Stable Pointer PrimOps
761 -------------------------------------------------------------------------- */
763 EXTFUN_RTS(makeStableNamezh_fast);
765 #define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn)
767 #define eqStableNamezh(r,sn1,sn2) \
768 (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
770 #define makeStablePtrzh(r,a) \
771 r = RET_STGCALL1(StgStablePtr,getStablePtr,a)
773 #define deRefStablePtrzh(r,sp) do { \
774 ASSERT(stable_ptr_table[stgCast(StgWord,sp) & ~STABLEPTR_WEIGHT_MASK].weight > 0); \
775 r = stable_ptr_table[stgCast(StgWord,sp) & ~STABLEPTR_WEIGHT_MASK].addr; \
778 #define eqStablePtrzh(r,sp1,sp2) \
779 (r = ((stgCast(StgWord,sp1) & ~STABLEPTR_WEIGHT_MASK) == (stgCast(StgWord,sp2) & ~STABLEPTR_WEIGHT_MASK)))
781 /* -----------------------------------------------------------------------------
782 Concurrency/Exception PrimOps.
783 -------------------------------------------------------------------------- */
785 EXTFUN_RTS(forkzh_fast);
786 EXTFUN_RTS(yieldzh_fast);
787 EXTFUN_RTS(killThreadzh_fast);
788 EXTFUN_RTS(seqzh_fast);
789 EXTFUN_RTS(blockAsyncExceptionszh_fast);
790 EXTFUN_RTS(unblockAsyncExceptionszh_fast);
792 #define myThreadIdzh(t) (t = CurrentTSO)
794 extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2);
796 /* ------------------------------------------------------------------------
799 A par in the Haskell code is ultimately translated to a parzh macro
800 (with a case wrapped around it to guarantee that the macro is actually
801 executed; see compiler/prelude/PrimOps.lhs)
802 In GUM and SMP we only add a pointer to the spark pool.
803 In GranSim we call an RTS fct, forwarding additional parameters which
804 supply info on granularity of the computation, size of the result value
805 and the degree of parallelism in the sparked expression.
806 ---------------------------------------------------------------------- */
810 #define parzh(r,node) parAny(r,node,1,0,0,0,0,0)
813 #define parAtzh(r,node,where,identifier,gran_info,size_info,par_info,rest) \
814 parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,1)
817 #define parAtAbszh(r,node,proc,identifier,gran_info,size_info,par_info,rest) \
818 parAT(r,node,proc,identifier,gran_info,size_info,par_info,rest,2)
821 #define parAtRelzh(r,node,proc,identifier,gran_info,size_info,par_info,rest) \
822 parAT(r,node,proc,identifier,gran_info,size_info,par_info,rest,3)
824 //@cindex _parAtForNow_
825 #define parAtForNowzh(r,node,where,identifier,gran_info,size_info,par_info,rest) \
826 parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,0)
828 #define parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,local) \
830 if (closure_SHOULD_SPARK((StgClosure*)node)) { \
834 STGCALL6(newSpark, node,identifier,gran_info,size_info,par_info,local); \
836 case 2: p = where; /* parAtAbs means absolute PE no. expected */ \
838 case 3: p = CurrentProc+where; /* parAtRel means rel PE no. expected */\
840 default: p = where_is(where); /* parAt means closure expected */ \
843 /* update GranSim state according to this spark */ \
844 STGCALL3(GranSimSparkAtAbs, result, (I_)p, identifier); \
849 #define parLocalzh(r,node,identifier,gran_info,size_info,par_info,rest) \
850 parAny(r,node,rest,identifier,gran_info,size_info,par_info,1)
852 //@cindex _parGlobal_
853 #define parGlobalzh(r,node,identifier,gran_info,size_info,par_info,rest) \
854 parAny(r,node,rest,identifier,gran_info,size_info,par_info,0)
856 #define parAny(r,node,rest,identifier,gran_info,size_info,par_info,local) \
858 if (closure_SHOULD_SPARK((StgClosure*)node)) { \
860 result = RET_STGCALL6(rtsSpark*, newSpark, \
861 node,identifier,gran_info,size_info,par_info,local);\
862 STGCALL1(add_to_spark_queue,result); \
863 STGCALL2(GranSimSpark, local,(P_)node); \
867 #define copyablezh(r,node) \
868 /* copyable not yet implemented!! */
870 #define noFollowzh(r,node) \
871 /* noFollow not yet implemented!! */
873 #elif defined(SMP) || defined(PAR)
875 #define parzh(r,node) \
877 extern unsigned int context_switch; \
878 if (closure_SHOULD_SPARK((StgClosure *)node) && \
879 SparkTl < SparkLim) { \
880 *SparkTl++ = (StgClosure *)(node); \
882 r = context_switch = 1; \
884 #else /* !GRAN && !SMP && !PAR */
885 #define parzh(r,node) r = 1
888 /* -----------------------------------------------------------------------------
890 -------------------------------------------------------------------------- */
892 /* warning: extremely non-referentially transparent, need to hide in
893 an appropriate monad.
895 ToDo: follow indirections.
898 #define reallyUnsafePtrEqualityzh(r,a,b) r=((StgPtr)(a) == (StgPtr)(b))
900 /* -----------------------------------------------------------------------------
901 Weak Pointer PrimOps.
902 -------------------------------------------------------------------------- */
904 EXTFUN_RTS(mkWeakzh_fast);
905 EXTFUN_RTS(finalizzeWeakzh_fast);
907 #define deRefWeakzh(code,val,w) \
908 if (((StgWeak *)w)->header.info == &stg_WEAK_info) { \
910 val = (P_)((StgWeak *)w)->value; \
916 #define sameWeakzh(w1,w2) ((w1)==(w2))
919 /* -----------------------------------------------------------------------------
920 Foreign Object PrimOps.
921 -------------------------------------------------------------------------- */
923 #define ForeignObj_CLOSURE_DATA(c) (((StgForeignObj *)c)->data)
925 #define foreignObjToAddrzh(r,fo) r=ForeignObj_CLOSURE_DATA(fo)
926 #define touchzh(o) /* nothing */
928 EXTFUN_RTS(mkForeignObjzh_fast);
930 #define writeForeignObjzh(res,datum) \
931 (ForeignObj_CLOSURE_DATA(res) = (P_)(datum))
933 #define eqForeignObjzh(r,f1,f2) r=(f1)==(f2)
934 #define indexCharOffForeignObjzh(r,fo,i) indexCharOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
935 #define indexWideCharOffForeignObjzh(r,fo,i) indexWideCharOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
936 #define indexIntOffForeignObjzh(r,fo,i) indexIntOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
937 #define indexWordOffForeignObjzh(r,fo,i) indexWordOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
938 #define indexAddrOffForeignObjzh(r,fo,i) indexAddrOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
939 #define indexFloatOffForeignObjzh(r,fo,i) indexFloatOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
940 #define indexDoubleOffForeignObjzh(r,fo,i) indexDoubleOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
941 #define indexStablePtrOffForeignObjzh(r,fo,i) indexStablePtrOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
942 #define indexInt8OffForeignObjzh(r,fo,i) indexInt8OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
943 #define indexInt16OffForeignObjzh(r,fo,i) indexInt16OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
944 #define indexInt32OffForeignObjzh(r,fo,i) indexInt32OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
945 #define indexWord8OffForeignObjzh(r,fo,i) indexWord8OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
946 #define indexWord16OffForeignObjzh(r,fo,i) indexWord16OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
947 #define indexWord32OffForeignObjzh(r,fo,i) indexWord32OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
948 #define indexInt64OffForeignObjzh(r,fo,i) indexInt64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
949 #define indexWord64OffForeignObjzh(r,fo,i) indexWord64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
951 /* -----------------------------------------------------------------------------
953 -------------------------------------------------------------------------- */
955 #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info))
957 /* tagToEnum# is handled directly by the code generator. */
959 /* -----------------------------------------------------------------------------
961 -------------------------------------------------------------------------- */
963 EXTFUN_RTS(newBCOzh_fast);
964 EXTFUN_RTS(mkApUpd0zh_fast);
966 /* -----------------------------------------------------------------------------
967 Signal processing. Not really primops, but called directly from
969 -------------------------------------------------------------------------- */
971 #define STG_SIG_DFL (-1)
972 #define STG_SIG_IGN (-2)
973 #define STG_SIG_ERR (-3)
974 #define STG_SIG_HAN (-4)
976 extern StgInt stg_sig_install (StgInt, StgInt, StgStablePtr, sigset_t *);
977 #define stg_sig_default(sig,mask) stg_sig_install(sig,STG_SIG_DFL,0,(sigset_t *)mask)
978 #define stg_sig_ignore(sig,mask) stg_sig_install(sig,STG_SIG_IGN,0,(sigset_t *)mask)
979 #define stg_sig_catch(sig,ptr,mask) stg_sig_install(sig,STG_SIG_HAN,ptr,(sigset_t *)mask)
981 #endif /* PRIMOPS_H */