ghc/includes/PrimOps.h

   1 /* -----------------------------------------------------------------------------
   2  * $Id: PrimOps.h,v 1.61 2000/08/21 14:16:57 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 1998-1999
   5  *
   6  * Macros for primitive operations in STG-ish C code.
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #ifndef PRIMOPS_H
  11 #define PRIMOPS_H
  12
  13 /* -----------------------------------------------------------------------------
  14    Comparison PrimOps.
  15    -------------------------------------------------------------------------- */
  16
  17 #define gtCharzh(r,a,b) r=(I_)((a)> (b))
  18 #define geCharzh(r,a,b) r=(I_)((a)>=(b))
  19 #define eqCharzh(r,a,b) r=(I_)((a)==(b))
  20 #define neCharzh(r,a,b) r=(I_)((a)!=(b))
  21 #define ltCharzh(r,a,b) r=(I_)((a)< (b))
  22 #define leCharzh(r,a,b) r=(I_)((a)<=(b))
  23
  24 /* Int comparisons: >#, >=# etc */
  25 #define zgzh(r,a,b)     r=(I_)((I_)(a) >(I_)(b))
  26 #define zgzezh(r,a,b)   r=(I_)((I_)(a)>=(I_)(b))
  27 #define zezezh(r,a,b)   r=(I_)((I_)(a)==(I_)(b))
  28 #define zszezh(r,a,b)   r=(I_)((I_)(a)!=(I_)(b))
  29 #define zlzh(r,a,b)     r=(I_)((I_)(a) <(I_)(b))
  30 #define zlzezh(r,a,b)   r=(I_)((I_)(a)<=(I_)(b))
  31
  32 #define gtWordzh(r,a,b) r=(I_)((W_)(a) >(W_)(b))
  33 #define geWordzh(r,a,b) r=(I_)((W_)(a)>=(W_)(b))
  34 #define eqWordzh(r,a,b) r=(I_)((W_)(a)==(W_)(b))
  35 #define neWordzh(r,a,b) r=(I_)((W_)(a)!=(W_)(b))
  36 #define ltWordzh(r,a,b) r=(I_)((W_)(a) <(W_)(b))
  37 #define leWordzh(r,a,b) r=(I_)((W_)(a)<=(W_)(b))
  38
  39 #define gtAddrzh(r,a,b) r=(I_)((a) >(b))
  40 #define geAddrzh(r,a,b) r=(I_)((a)>=(b))
  41 #define eqAddrzh(r,a,b) r=(I_)((a)==(b))
  42 #define neAddrzh(r,a,b) r=(I_)((a)!=(b))
  43 #define ltAddrzh(r,a,b) r=(I_)((a) <(b))
  44 #define leAddrzh(r,a,b) r=(I_)((a)<=(b))
  45
  46 #define gtFloatzh(r,a,b)  r=(I_)((a)> (b))
  47 #define geFloatzh(r,a,b)  r=(I_)((a)>=(b))
  48 #define eqFloatzh(r,a,b)  r=(I_)((a)==(b))
  49 #define neFloatzh(r,a,b)  r=(I_)((a)!=(b))
  50 #define ltFloatzh(r,a,b)  r=(I_)((a)< (b))
  51 #define leFloatzh(r,a,b)  r=(I_)((a)<=(b))
  52
  53 /* Double comparisons: >##, >=#@ etc */
  54 #define zgzhzh(r,a,b)   r=(I_)((a) >(b))
  55 #define zgzezhzh(r,a,b) r=(I_)((a)>=(b))
  56 #define zezezhzh(r,a,b) r=(I_)((a)==(b))
  57 #define zszezhzh(r,a,b) r=(I_)((a)!=(b))
  58 #define zlzhzh(r,a,b)   r=(I_)((a) <(b))
  59 #define zlzezhzh(r,a,b) r=(I_)((a)<=(b))
  60
  61 /* -----------------------------------------------------------------------------
  62    Char# PrimOps.
  63    -------------------------------------------------------------------------- */
  64
  65 #define ordzh(r,a)      r=(I_)((W_) (a))
  66 #define chrzh(r,a)      r=(StgChar)((W_)(a))
  67
  68 /* -----------------------------------------------------------------------------
  69    Int# PrimOps.
  70    -------------------------------------------------------------------------- */
  71
  72 I_ stg_div (I_ a, I_ b);
  73
  74 #define zpzh(r,a,b)             r=(a)+(b)
  75 #define zmzh(r,a,b)             r=(a)-(b)
  76 #define ztzh(r,a,b)             r=(a)*(b)
  77 #define quotIntzh(r,a,b)        r=(a)/(b)
  78 #define zszh(r,a,b)             r=ULTRASAFESTGCALL2(I_,(void *, I_, I_),stg_div,(a),(b))
  79 #define remIntzh(r,a,b)         r=(a)%(b)
  80 #define negateIntzh(r,a)        r=-(a)
  81
  82 /* -----------------------------------------------------------------------------
  83  * Int operations with carry.
  84  * -------------------------------------------------------------------------- */
  85
  86 /* With some bit-twiddling, we can define int{Add,Sub}Czh portably in
  87  * C, and without needing any comparisons.  This may not be the
  88  * fastest way to do it - if you have better code, please send it! --SDM
  89  *
  90  * Return : r = a + b,  c = 0 if no overflow, 1 on overflow.
  91  *
  92  * We currently don't make use of the r value if c is != 0 (i.e.
  93  * overflow), we just convert to big integers and try again.  This
  94  * could be improved by making r and c the correct values for
  95  * plugging into a new J#.
  96  */
  97 #define addIntCzh(r,c,a,b)                      \
  98 { r = a + b;                                    \
  99   c = ((StgWord)(~(a^b) & (a^r)))               \
 100     >> (BITS_PER_BYTE * sizeof(I_) - 1);        \
 101 }
 102
 103
 104 #define subIntCzh(r,c,a,b)                      \
 105 { r = a - b;                                    \
 106   c = ((StgWord)((a^b) & (a^r)))                \
 107     >> (BITS_PER_BYTE * sizeof(I_) - 1);        \
 108 }
 109
 110 /* Multiply with overflow checking.
 111  *
 112  * This is slightly more tricky - the usual sign rules for add/subtract
 113  * don't apply.
 114  *
 115  * On x86 hardware we use a hand-crafted assembly fragment to do the job.
 116  *
 117  * On other 32-bit machines we use gcc's 'long long' types, finding
 118  * overflow with some careful bit-twiddling.
 119  *
 120  * On 64-bit machines where gcc's 'long long' type is also 64-bits,
 121  * we use a crude approximation, testing whether either operand is
 122  * larger than 32-bits; if neither is, then we go ahead with the
 123  * multiplication.
 124  */
 125
 126 #if i386_TARGET_ARCH
 127
 128 #define mulIntCzh(r,c,a,b)                              \
 129 {                                                       \
 130   __asm__("xorl %1,%1\n\t                               \
 131            imull %2,%3\n\t                              \
 132            jno 1f\n\t                                   \
 133            movl $1,%1\n\t                               \
 134            1:"                                          \
 135         : "=r" (r), "=&r" (c) : "r" (a), "0" (b));      \
 136 }
 137
 138 #elif SIZEOF_VOID_P == 4
 139
 140 #ifdef WORDS_BIGENDIAN
 141 #define C 0
 142 #define R 1
 143 #else
 144 #define C 1
 145 #define R 0
 146 #endif
 147
 148 typedef union {
 149     StgInt64 l;
 150     StgInt32 i[2];
 151 } long_long_u ;
 152
 153 #define mulIntCzh(r,c,a,b)                      \
 154 {                                               \
 155   long_long_u z;                                \
 156   z.l = (StgInt64)a * (StgInt64)b;              \
 157   r = z.i[R];                                   \
 158   c = z.i[C];                                   \
 159   if (c == 0 || c == -1) {                      \
 160     c = ((StgWord)((a^b) ^ r))                  \
 161       >> (BITS_PER_BYTE * sizeof(I_) - 1);      \
 162   }                                             \
 163 }
 164 /* Careful: the carry calculation above is extremely delicate.  Make sure
 165  * you test it thoroughly after changing it.
 166  */
 167
 168 #else
 169
 170 #define HALF_INT  (1 << (BITS_PER_BYTE * sizeof(I_) / 2))
 171
 172 #define stg_abs(a) ((a) < 0 ? -(a) : (a))
 173
 174 #define mulIntCzh(r,c,a,b)                      \
 175 {                                               \
 176   if (stg_abs(a) >= HALF_INT                    \
 177       stg_abs(b) >= HALF_INT) {                 \
 178     c = 1;                                      \
 179   } else {                                      \
 180     r = a * b;                                  \
 181     c = 0;                                      \
 182   }                                             \
 183 }
 184 #endif
 185
 186 /* -----------------------------------------------------------------------------
 187    Word PrimOps.
 188    -------------------------------------------------------------------------- */
 189
 190 #define quotWordzh(r,a,b)       r=((W_)a)/((W_)b)
 191 #define remWordzh(r,a,b)        r=((W_)a)%((W_)b)
 192
 193 #define andzh(r,a,b)            r=(a)&(b)
 194 #define orzh(r,a,b)             r=(a)|(b)
 195 #define xorzh(r,a,b)            r=(a)^(b)
 196 #define notzh(r,a)              r=~(a)
 197
 198 /* The extra tests below properly define the behaviour when shifting
 199  * by offsets larger than the width of the value being shifted.  Doing
 200  * so is undefined in C (and in fact gives different answers depending
 201  * on whether the operation is constant folded or not with gcc on x86!)
 202  */
 203
 204 #define shiftLzh(r,a,b)         r=((b) >= BITS_IN(W_)) ? 0 : (a)<<(b)
 205 #define shiftRLzh(r,a,b)        r=((b) >= BITS_IN(W_)) ? 0 : (a)>>(b)
 206 #define iShiftLzh(r,a,b)        r=((b) >= BITS_IN(W_)) ? 0 : (a)<<(b)
 207 /* Right shifting of signed quantities is not portable in C, so
 208    the behaviour you'll get from using these primops depends
 209    on the whatever your C compiler is doing. ToDo: fix/document. -- sof 8/98
 210 */
 211 #define iShiftRAzh(r,a,b)       r=((b) >= BITS_IN(I_)) ? (((a) < 0) ? -1 : 0) : (a)>>(b)
 212 #define iShiftRLzh(r,a,b)       r=((b) >= BITS_IN(I_)) ? 0 : ((W_)(a))>>(b)
 213
 214 #define int2Wordzh(r,a)         r=(W_)(a)
 215 #define word2Intzh(r,a)         r=(I_)(a)
 216
 217 /* -----------------------------------------------------------------------------
 218    Addr PrimOps.
 219    -------------------------------------------------------------------------- */
 220
 221 #define int2Addrzh(r,a)         r=(A_)(a)
 222 #define addr2Intzh(r,a)         r=(I_)(a)
 223
 224 #define readCharOffAddrzh(r,a,i)        r= ((unsigned char *)(a))[i]
 225 /* unsigned char is for compatibility: the index is still in bytes. */
 226 #define readIntOffAddrzh(r,a,i)         r= ((I_ *)(a))[i]
 227 #define readWordOffAddrzh(r,a,i)        r= ((W_ *)(a))[i]
 228 #define readAddrOffAddrzh(r,a,i)        r= ((PP_)(a))[i]
 229 #define readFloatOffAddrzh(r,a,i)       r= PK_FLT((P_) (((StgFloat *)(a)) + i))
 230 #define readDoubleOffAddrzh(r,a,i)      r= PK_DBL((P_) (((StgDouble *)(a)) + i))
 231 #define readStablePtrOffAddrzh(r,a,i)   r= ((StgStablePtr *)(a))[i]
 232 #ifdef SUPPORT_LONG_LONGS
 233 #define readInt64OffAddrzh(r,a,i)       r= ((LI_ *)(a))[i]
 234 #define readWord64OffAddrzh(r,a,i)      r= ((LW_ *)(a))[i]
 235 #endif
 236
 237 #define writeCharOffAddrzh(a,i,v)       ((unsigned char *)(a))[i] = (unsigned char)(v)
 238 /* unsigned char is for compatibility: the index is still in bytes. */
 239 #define writeIntOffAddrzh(a,i,v)        ((I_ *)(a))[i] = (v)
 240 #define writeWordOffAddrzh(a,i,v)       ((W_ *)(a))[i] = (v)
 241 #define writeAddrOffAddrzh(a,i,v)       ((PP_)(a))[i] = (v)
 242 #define writeForeignObjOffAddrzh(a,i,v) ((PP_)(a))[i] = ForeignObj_CLOSURE_DATA(v)
 243 #define writeFloatOffAddrzh(a,i,v)      ASSIGN_FLT((P_) (((StgFloat *)(a)) + i),v)
 244 #define writeDoubleOffAddrzh(a,i,v)     ASSIGN_DBL((P_) (((StgDouble *)(a)) + i),v)
 245 #define writeStablePtrOffAddrzh(a,i,v)  ((StgStablePtr *)(a))[i] = (v)
 246 #ifdef SUPPORT_LONG_LONGS
 247 #define writeInt64OffAddrzh(a,i,v)   ((LI_ *)(a))[i] = (v)
 248 #define writeWord64OffAddrzh(a,i,v)  ((LW_ *)(a))[i] = (v)
 249 #endif
 250
 251 #define indexCharOffAddrzh(r,a,i)       r= ((unsigned char *)(a))[i]
 252 /* unsigned char is for compatibility: the index is still in bytes. */
 253 #define indexIntOffAddrzh(r,a,i)        r= ((I_ *)(a))[i]
 254 #define indexWordOffAddrzh(r,a,i)       r= ((W_ *)(a))[i]
 255 #define indexAddrOffAddrzh(r,a,i)       r= ((PP_)(a))[i]
 256 #define indexFloatOffAddrzh(r,a,i)      r= PK_FLT((P_) (((StgFloat *)(a)) + i))
 257 #define indexDoubleOffAddrzh(r,a,i)     r= PK_DBL((P_) (((StgDouble *)(a)) + i))
 258 #define indexStablePtrOffAddrzh(r,a,i)  r= ((StgStablePtr *)(a))[i]
 259 #ifdef SUPPORT_LONG_LONGS
 260 #define indexInt64OffAddrzh(r,a,i)      r= ((LI_ *)(a))[i]
 261 #define indexWord64OffAddrzh(r,a,i)     r= ((LW_ *)(a))[i]
 262 #endif
 263
 264 /* -----------------------------------------------------------------------------
 265    Float PrimOps.
 266    -------------------------------------------------------------------------- */
 267
 268 #define plusFloatzh(r,a,b)   r=(a)+(b)
 269 #define minusFloatzh(r,a,b)  r=(a)-(b)
 270 #define timesFloatzh(r,a,b)  r=(a)*(b)
 271 #define divideFloatzh(r,a,b) r=(a)/(b)
 272 #define negateFloatzh(r,a)   r=-(a)
 273
 274 #define int2Floatzh(r,a)     r=(StgFloat)(a)
 275 #define float2Intzh(r,a)     r=(I_)(a)
 276
 277 #define expFloatzh(r,a)      r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,exp,a)
 278 #define logFloatzh(r,a)      r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,log,a)
 279 #define sqrtFloatzh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sqrt,a)
 280 #define sinFloatzh(r,a)      r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sin,a)
 281 #define cosFloatzh(r,a)      r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,cos,a)
 282 #define tanFloatzh(r,a)      r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,tan,a)
 283 #define asinFloatzh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,asin,a)
 284 #define acosFloatzh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,acos,a)
 285 #define atanFloatzh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,atan,a)
 286 #define sinhFloatzh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sinh,a)
 287 #define coshFloatzh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,cosh,a)
 288 #define tanhFloatzh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,tanh,a)
 289 #define powerFloatzh(r,a,b)  r=(StgFloat) RET_PRIM_STGCALL2(StgDouble,pow,a,b)
 290
 291 /* -----------------------------------------------------------------------------
 292    Double PrimOps.
 293    -------------------------------------------------------------------------- */
 294
 295 #define zpzhzh(r,a,b)        r=(a)+(b)
 296 #define zmzhzh(r,a,b)        r=(a)-(b)
 297 #define ztzhzh(r,a,b)        r=(a)*(b)
 298 #define zszhzh(r,a,b)        r=(a)/(b)
 299 #define negateDoublezh(r,a)  r=-(a)
 300
 301 #define int2Doublezh(r,a)    r=(StgDouble)(a)
 302 #define double2Intzh(r,a)    r=(I_)(a)
 303
 304 #define float2Doublezh(r,a)  r=(StgDouble)(a)
 305 #define double2Floatzh(r,a)  r=(StgFloat)(a)
 306
 307 #define expDoublezh(r,a)     r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,exp,a)
 308 #define logDoublezh(r,a)     r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,log,a)
 309 #define sqrtDoublezh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sqrt,a)
 310 #define sinDoublezh(r,a)     r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sin,a)
 311 #define cosDoublezh(r,a)     r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,cos,a)
 312 #define tanDoublezh(r,a)     r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,tan,a)
 313 #define asinDoublezh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,asin,a)
 314 #define acosDoublezh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,acos,a)
 315 #define atanDoublezh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,atan,a)
 316 #define sinhDoublezh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sinh,a)
 317 #define coshDoublezh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,cosh,a)
 318 #define tanhDoublezh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,tanh,a)
 319 /* Power: **## */
 320 #define ztztzhzh(r,a,b) r=(StgDouble) RET_PRIM_STGCALL2(StgDouble,pow,a,b)
 321
 322 /* -----------------------------------------------------------------------------
 323    Integer PrimOps.
 324    -------------------------------------------------------------------------- */
 325
 326 /* We can do integer2Int and cmpInteger inline, since they don't need
 327  * to allocate any memory.
 328  *
 329  * integer2Int# is now modular.
 330  */
 331
 332 #define integer2Intzh(r, sa,da)                         \
 333 { StgWord word0 = ((StgWord *)BYTE_ARR_CTS(da))[0];     \
 334   int size = sa;                                        \
 335                                                         \
 336   (r) =                                                 \
 337     ( size == 0 ) ?                                     \
 338        0 :                                              \
 339        ( size < 0 && word0 != 0x8000000 ) ?             \
 340          -(I_)word0 :                                   \
 341           (I_)word0;                                    \
 342 }
 343
 344 #define integer2Wordzh(r, sa,da)                        \
 345 { StgWord word0 = ((StgWord *)BYTE_ARR_CTS(da))[0];     \
 346   int size = sa;                                        \
 347   (r) = ( size == 0 ) ? 0 : word0 ;                     \
 348 }
 349
 350 #define cmpIntegerzh(r, s1,d1, s2,d2)                           \
 351 { MP_INT arg1;                                                  \
 352   MP_INT arg2;                                                  \
 353                                                                 \
 354   arg1._mp_size = (s1);                                         \
 355   arg1._mp_alloc= ((StgArrWords *)d1)->words;                   \
 356   arg1._mp_d    = (unsigned long int *) (BYTE_ARR_CTS(d1));     \
 357   arg2._mp_size = (s2);                                         \
 358   arg2._mp_alloc= ((StgArrWords *)d2)->words;                   \
 359   arg2._mp_d    = (unsigned long int *) (BYTE_ARR_CTS(d2));     \
 360                                                                 \
 361   (r) = RET_PRIM_STGCALL2(I_,mpz_cmp,&arg1,&arg2);              \
 362 }
 363
 364 #define cmpIntegerIntzh(r, s,d, i)                              \
 365 { MP_INT arg;                                                   \
 366                                                                 \
 367   arg._mp_size  = (s);                                          \
 368   arg._mp_alloc = ((StgArrWords *)d)->words;                    \
 369   arg._mp_d     = (unsigned long int *) (BYTE_ARR_CTS(d));      \
 370                                                                 \
 371   (r) = RET_PRIM_STGCALL2(I_,mpz_cmp_si,&arg,i);                \
 372 }
 373
 374 /* NOTE: gcdIntzh and gcdIntegerIntzh work only for positive inputs! */
 375
 376 /* mp_limb_t must be able to hold an StgInt for this to work properly */
 377 #define gcdIntzh(r,a,b) \
 378 { mp_limb_t aa = (mp_limb_t)(a); \
 379   r = RET_STGCALL3(StgInt, mpn_gcd_1, (mp_limb_t *)(&aa), 1, (mp_limb_t)(b)); \
 380 }
 381
 382 #define gcdIntegerIntzh(r,sa,a,b) \
 383   r = RET_STGCALL3(StgInt, mpn_gcd_1, (mp_limb_t *)(BYTE_ARR_CTS(a)), sa, b)
 384
 385 /* The rest are all out-of-line: -------- */
 386
 387 /* Integer arithmetic */
 388 EXTFUN_RTS(plusIntegerzh_fast);
 389 EXTFUN_RTS(minusIntegerzh_fast);
 390 EXTFUN_RTS(timesIntegerzh_fast);
 391 EXTFUN_RTS(gcdIntegerzh_fast);
 392 EXTFUN_RTS(quotRemIntegerzh_fast);
 393 EXTFUN_RTS(quotIntegerzh_fast);
 394 EXTFUN_RTS(remIntegerzh_fast);
 395 EXTFUN_RTS(divExactIntegerzh_fast);
 396 EXTFUN_RTS(divModIntegerzh_fast);
 397
 398 /* Conversions */
 399 EXTFUN_RTS(int2Integerzh_fast);
 400 EXTFUN_RTS(word2Integerzh_fast);
 401 EXTFUN_RTS(addr2Integerzh_fast);
 402
 403 /* Floating-point decodings */
 404 EXTFUN_RTS(decodeFloatzh_fast);
 405 EXTFUN_RTS(decodeDoublezh_fast);
 406
 407 /* -----------------------------------------------------------------------------
 408    Word64 PrimOps.
 409    -------------------------------------------------------------------------- */
 410
 411 #ifdef SUPPORT_LONG_LONGS
 412
 413 #define integerToWord64zh(r, sa,da)                     \
 414 { unsigned long int* d;                                 \
 415   I_ s;                                                 \
 416   StgWord64 res;                                        \
 417                                                         \
 418   d = (unsigned long int *) (BYTE_ARR_CTS(da));         \
 419   s = (sa);                                             \
 420   if ( s == 0 ) {                                       \
 421      res = (LW_)0;                                      \
 422   } else if ( s == 1) {                                 \
 423      res = (LW_)d[0];                                   \
 424   } else {                                              \
 425      res = (LW_)d[0] + (LW_)d[1] * 0x100000000ULL;      \
 426   }                                                     \
 427   (r) = res;                                            \
 428 }
 429
 430 #define integerToInt64zh(r, sa,da)                      \
 431 { unsigned long int* d;                                 \
 432   I_ s;                                                 \
 433   StgInt64 res;                                         \
 434                                                         \
 435   d = (unsigned long int *) (BYTE_ARR_CTS(da));         \
 436   s = (sa);                                             \
 437   if ( s == 0 ) {                                       \
 438      res = (LI_)0;                                      \
 439   } else if ( s == 1) {                                 \
 440      res = (LI_)d[0];                                   \
 441   } else {                                              \
 442      res = (LI_)d[0] + (LI_)d[1] * 0x100000000LL;       \
 443      if ( s < 0 ) {                                     \
 444            res = (LI_)-res;                             \
 445      }                                                  \
 446   }                                                     \
 447   (r) = res;                                            \
 448 }
 449
 450 /* Conversions */
 451 EXTFUN_RTS(int64ToIntegerzh_fast);
 452 EXTFUN_RTS(word64ToIntegerzh_fast);
 453
 454 /* The rest are (way!) out of line, implemented via C entry points.
 455  */
 456 I_ stg_gtWord64 (StgWord64, StgWord64);
 457 I_ stg_geWord64 (StgWord64, StgWord64);
 458 I_ stg_eqWord64 (StgWord64, StgWord64);
 459 I_ stg_neWord64 (StgWord64, StgWord64);
 460 I_ stg_ltWord64 (StgWord64, StgWord64);
 461 I_ stg_leWord64 (StgWord64, StgWord64);
 462
 463 I_ stg_gtInt64 (StgInt64, StgInt64);
 464 I_ stg_geInt64 (StgInt64, StgInt64);
 465 I_ stg_eqInt64 (StgInt64, StgInt64);
 466 I_ stg_neInt64 (StgInt64, StgInt64);
 467 I_ stg_ltInt64 (StgInt64, StgInt64);
 468 I_ stg_leInt64 (StgInt64, StgInt64);
 469
 470 LW_ stg_remWord64  (StgWord64, StgWord64);
 471 LW_ stg_quotWord64 (StgWord64, StgWord64);
 472
 473 LI_ stg_remInt64    (StgInt64, StgInt64);
 474 LI_ stg_quotInt64   (StgInt64, StgInt64);
 475 LI_ stg_negateInt64 (StgInt64);
 476 LI_ stg_plusInt64   (StgInt64, StgInt64);
 477 LI_ stg_minusInt64  (StgInt64, StgInt64);
 478 LI_ stg_timesInt64  (StgInt64, StgInt64);
 479
 480 LW_ stg_and64  (StgWord64, StgWord64);
 481 LW_ stg_or64   (StgWord64, StgWord64);
 482 LW_ stg_xor64  (StgWord64, StgWord64);
 483 LW_ stg_not64  (StgWord64);
 484
 485 LW_ stg_shiftL64   (StgWord64, StgInt);
 486 LW_ stg_shiftRL64  (StgWord64, StgInt);
 487 LI_ stg_iShiftL64  (StgInt64, StgInt);
 488 LI_ stg_iShiftRL64 (StgInt64, StgInt);
 489 LI_ stg_iShiftRA64 (StgInt64, StgInt);
 490
 491 LI_ stg_intToInt64    (StgInt);
 492 I_ stg_int64ToInt     (StgInt64);
 493 LW_ stg_int64ToWord64 (StgInt64);
 494
 495 LW_ stg_wordToWord64  (StgWord);
 496 W_  stg_word64ToWord  (StgWord64);
 497 LI_ stg_word64ToInt64 (StgWord64);
 498 #endif
 499
 500 /* -----------------------------------------------------------------------------
 501    Array PrimOps.
 502    -------------------------------------------------------------------------- */
 503
 504 /* We cast to void* instead of StgChar* because this avoids a warning
 505  * about increasing the alignment requirements.
 506  */
 507 #define REAL_BYTE_ARR_CTS(a)   ((void *) (((StgArrWords *)(a))->payload))
 508 #define REAL_PTRS_ARR_CTS(a)   ((P_)   (((StgMutArrPtrs  *)(a))->payload))
 509
 510 #ifdef DEBUG
 511 #define BYTE_ARR_CTS(a)                           \
 512  ({ ASSERT(GET_INFO((StgArrWords *)(a)) == &ARR_WORDS_info);      \
 513     REAL_BYTE_ARR_CTS(a); })
 514 #define PTRS_ARR_CTS(a)                           \
 515  ({ ASSERT((GET_INFO((StgMutArrPtrs  *)(a)) == &MUT_ARR_PTRS_FROZEN_info)         \
 516         || (GET_INFO((StgMutArrPtrs  *)(a)) == &MUT_ARR_PTRS_info));  \
 517     REAL_PTRS_ARR_CTS(a); })
 518 #else
 519 #define BYTE_ARR_CTS(a)         REAL_BYTE_ARR_CTS(a)
 520 #define PTRS_ARR_CTS(a)         REAL_PTRS_ARR_CTS(a)
 521 #endif
 522
 523 extern I_ genSymZh(void);
 524 extern I_ resetGenSymZh(void);
 525
 526 /*--- everything except new*Array is done inline: */
 527
 528 #define sameMutableArrayzh(r,a,b)       r=(I_)((a)==(b))
 529 #define sameMutableByteArrayzh(r,a,b)   r=(I_)((a)==(b))
 530
 531 #define readArrayzh(r,a,i)       r=((PP_) PTRS_ARR_CTS(a))[(i)]
 532
 533 #define readCharArrayzh(r,a,i)   indexCharOffAddrzh(r,BYTE_ARR_CTS(a),i)
 534 #define readIntArrayzh(r,a,i)    indexIntOffAddrzh(r,BYTE_ARR_CTS(a),i)
 535 #define readWordArrayzh(r,a,i)   indexWordOffAddrzh(r,BYTE_ARR_CTS(a),i)
 536 #define readAddrArrayzh(r,a,i)   indexAddrOffAddrzh(r,BYTE_ARR_CTS(a),i)
 537 #define readFloatArrayzh(r,a,i)  indexFloatOffAddrzh(r,BYTE_ARR_CTS(a),i)
 538 #define readDoubleArrayzh(r,a,i) indexDoubleOffAddrzh(r,BYTE_ARR_CTS(a),i)
 539 #define readStablePtrArrayzh(r,a,i) indexStablePtrOffAddrzh(r,BYTE_ARR_CTS(a),i)
 540 #ifdef SUPPORT_LONG_LONGS
 541 #define readInt64Arrayzh(r,a,i)  indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i)
 542 #define readWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i)
 543 #endif
 544
 545 /* result ("r") arg ignored in write macros! */
 546 #define writeArrayzh(a,i,v)     ((PP_) PTRS_ARR_CTS(a))[(i)]=(v)
 547
 548 #define writeCharArrayzh(a,i,v)   ((unsigned char *)(BYTE_ARR_CTS(a)))[i] = (unsigned char)(v)
 549 /* unsigned char is for compatibility: the index is still in bytes. */
 550 #define writeIntArrayzh(a,i,v)    ((I_ *)(BYTE_ARR_CTS(a)))[i] = (v)
 551 #define writeWordArrayzh(a,i,v)   ((W_ *)(BYTE_ARR_CTS(a)))[i] = (v)
 552 #define writeAddrArrayzh(a,i,v)   ((PP_)(BYTE_ARR_CTS(a)))[i] = (v)
 553 #define writeFloatArrayzh(a,i,v)  \
 554         ASSIGN_FLT((P_) (((StgFloat *)(BYTE_ARR_CTS(a))) + i),v)
 555 #define writeDoubleArrayzh(a,i,v) \
 556         ASSIGN_DBL((P_) (((StgDouble *)(BYTE_ARR_CTS(a))) + i),v)
 557 #define writeStablePtrArrayzh(a,i,v)      ((StgStablePtr *)(BYTE_ARR_CTS(a)))[i] = (v)
 558 #ifdef SUPPORT_LONG_LONGS
 559 #define writeInt64Arrayzh(a,i,v)  ((LI_ *)(BYTE_ARR_CTS(a)))[i] = (v)
 560 #define writeWord64Arrayzh(a,i,v) ((LW_ *)(BYTE_ARR_CTS(a)))[i] = (v)
 561 #endif
 562
 563 #define indexArrayzh(r,a,i)       r=((PP_) PTRS_ARR_CTS(a))[(i)]
 564
 565 #define indexCharArrayzh(r,a,i)   indexCharOffAddrzh(r,BYTE_ARR_CTS(a),i)
 566 #define indexIntArrayzh(r,a,i)    indexIntOffAddrzh(r,BYTE_ARR_CTS(a),i)
 567 #define indexWordArrayzh(r,a,i)   indexWordOffAddrzh(r,BYTE_ARR_CTS(a),i)
 568 #define indexAddrArrayzh(r,a,i)   indexAddrOffAddrzh(r,BYTE_ARR_CTS(a),i)
 569 #define indexFloatArrayzh(r,a,i)  indexFloatOffAddrzh(r,BYTE_ARR_CTS(a),i)
 570 #define indexDoubleArrayzh(r,a,i) indexDoubleOffAddrzh(r,BYTE_ARR_CTS(a),i)
 571 #define indexStablePtrArrayzh(r,a,i) indexStablePtrOffAddrzh(r,BYTE_ARR_CTS(a),i)
 572 #ifdef SUPPORT_LONG_LONGS
 573 #define indexInt64Arrayzh(r,a,i)  indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i)
 574 #define indexWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i)
 575 #endif
 576
 577 /* Freezing arrays-of-ptrs requires changing an info table, for the
 578    benefit of the generational collector.  It needs to scavenge mutable
 579    objects, even if they are in old space.  When they become immutable,
 580    they can be removed from this scavenge list.  */
 581
 582 #define unsafeFreezzeArrayzh(r,a)                                       \
 583         {                                                               \
 584         SET_INFO((StgClosure *)a,&MUT_ARR_PTRS_FROZEN_info);            \
 585         r = a;                                                          \
 586         }
 587
 588 #define unsafeFreezzeByteArrayzh(r,a)   r=(a)
 589
 590 EXTFUN_RTS(unsafeThawArrayzh_fast);
 591
 592 #define sizzeofByteArrayzh(r,a) \
 593      r = (((StgArrWords *)(a))->words * sizeof(W_))
 594 #define sizzeofMutableByteArrayzh(r,a) \
 595      r = (((StgArrWords *)(a))->words * sizeof(W_))
 596
 597 /* and the out-of-line ones... */
 598
 599 EXTFUN_RTS(newCharArrayzh_fast);
 600 EXTFUN_RTS(newIntArrayzh_fast);
 601 EXTFUN_RTS(newWordArrayzh_fast);
 602 EXTFUN_RTS(newAddrArrayzh_fast);
 603 EXTFUN_RTS(newFloatArrayzh_fast);
 604 EXTFUN_RTS(newDoubleArrayzh_fast);
 605 EXTFUN_RTS(newStablePtrArrayzh_fast);
 606 EXTFUN_RTS(newArrayzh_fast);
 607
 608 /* encoding and decoding of floats/doubles. */
 609
 610 /* We only support IEEE floating point format */
 611 #include "ieee-flpt.h"
 612
 613 /* The decode operations are out-of-line because they need to allocate
 614  * a byte array.
 615  */
 616 #ifdef FLOATS_AS_DOUBLES
 617 #define decodeFloatzh_fast decodeDoublezh_fast
 618 #else
 619 EXTFUN_RTS(decodeFloatzh_fast);
 620 #endif
 621
 622 EXTFUN_RTS(decodeDoublezh_fast);
 623
 624 /* grimy low-level support functions defined in StgPrimFloat.c */
 625
 626 extern StgDouble __encodeDouble (I_ size, StgByteArray arr, I_ e);
 627 extern StgDouble __int_encodeDouble (I_ j, I_ e);
 628 #ifndef FLOATS_AS_DOUBLES
 629 extern StgFloat  __encodeFloat (I_ size, StgByteArray arr, I_ e);
 630 extern StgFloat  __int_encodeFloat (I_ j, I_ e);
 631 #endif
 632 extern void      __decodeDouble (MP_INT *man, I_ *_exp, StgDouble dbl);
 633 extern void      __decodeFloat  (MP_INT *man, I_ *_exp, StgFloat flt);
 634 extern StgInt    isDoubleNaN(StgDouble d);
 635 extern StgInt    isDoubleInfinite(StgDouble d);
 636 extern StgInt    isDoubleDenormalized(StgDouble d);
 637 extern StgInt    isDoubleNegativeZero(StgDouble d);
 638 extern StgInt    isFloatNaN(StgFloat f);
 639 extern StgInt    isFloatInfinite(StgFloat f);
 640 extern StgInt    isFloatDenormalized(StgFloat f);
 641 extern StgInt    isFloatNegativeZero(StgFloat f);
 642
 643 /* -----------------------------------------------------------------------------
 644    Mutable variables
 645
 646    newMutVar is out of line.
 647    -------------------------------------------------------------------------- */
 648
 649 EXTFUN_RTS(newMutVarzh_fast);
 650
 651 #define readMutVarzh(r,a)        r=(P_)(((StgMutVar *)(a))->var)
 652 #define writeMutVarzh(a,v)       (P_)(((StgMutVar *)(a))->var)=(v)
 653 #define sameMutVarzh(r,a,b)      r=(I_)((a)==(b))
 654
 655 /* -----------------------------------------------------------------------------
 656    MVar PrimOps.
 657
 658    All out of line, because they either allocate or may block.
 659    -------------------------------------------------------------------------- */
 660 #define sameMVarzh(r,a,b)        r=(I_)((a)==(b))
 661
 662 /* Assume external decl of EMPTY_MVAR_info is in scope by now */
 663 #define isEmptyMVarzh(r,a)       r=(I_)((GET_INFO((StgMVar*)(a))) == &EMPTY_MVAR_info )
 664 EXTFUN_RTS(newMVarzh_fast);
 665 EXTFUN_RTS(takeMVarzh_fast);
 666 EXTFUN_RTS(tryTakeMVarzh_fast);
 667 EXTFUN_RTS(putMVarzh_fast);
 668
 669
 670 /* -----------------------------------------------------------------------------
 671    Delay/Wait PrimOps
 672    -------------------------------------------------------------------------- */
 673
 674 EXTFUN_RTS(waitReadzh_fast);
 675 EXTFUN_RTS(waitWritezh_fast);
 676 EXTFUN_RTS(delayzh_fast);
 677
 678 /* -----------------------------------------------------------------------------
 679    Primitive I/O, error-handling PrimOps
 680    -------------------------------------------------------------------------- */
 681
 682 EXTFUN_RTS(catchzh_fast);
 683 EXTFUN_RTS(raisezh_fast);
 684
 685 extern void stg_exit(I_ n)  __attribute__ ((noreturn));
 686
 687 /* -----------------------------------------------------------------------------
 688    Stable Name / Stable Pointer  PrimOps
 689    -------------------------------------------------------------------------- */
 690
 691 #ifndef PAR
 692
 693 EXTFUN_RTS(makeStableNamezh_fast);
 694
 695 #define stableNameToIntzh(r,s)   (r = ((StgStableName *)s)->sn)
 696
 697 #define eqStableNamezh(r,sn1,sn2)                                       \
 698     (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
 699
 700 #define makeStablePtrzh(r,a) \
 701    r = RET_STGCALL1(StgStablePtr,getStablePtr,a)
 702
 703 #define deRefStablePtrzh(r,sp) do {             \
 704   ASSERT(stable_ptr_table[stgCast(StgWord,sp) & ~STABLEPTR_WEIGHT_MASK].weight > 0);    \
 705   r = stable_ptr_table[stgCast(StgWord,sp) & ~STABLEPTR_WEIGHT_MASK].addr; \
 706 } while (0);
 707
 708 #define eqStablePtrzh(r,sp1,sp2) \
 709     (r = ((stgCast(StgWord,sp1) & ~STABLEPTR_WEIGHT_MASK) == (stgCast(StgWord,sp2) & ~STABLEPTR_WEIGHT_MASK)))
 710
 711 #endif
 712
 713 /* -----------------------------------------------------------------------------
 714    Concurrency/Exception PrimOps.
 715    -------------------------------------------------------------------------- */
 716
 717 EXTFUN_RTS(forkzh_fast);
 718 EXTFUN_RTS(yieldzh_fast);
 719 EXTFUN_RTS(killThreadzh_fast);
 720 EXTFUN_RTS(seqzh_fast);
 721 EXTFUN_RTS(blockAsyncExceptionszh_fast);
 722 EXTFUN_RTS(unblockAsyncExceptionszh_fast);
 723
 724 #define myThreadIdzh(t) (t = CurrentTSO)
 725
 726 extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2);
 727
 728 /* ------------------------------------------------------------------------
 729    Parallel PrimOps
 730
 731    A par in the Haskell code is ultimately translated to a parzh macro
 732    (with a case wrapped around it to guarantee that the macro is actually
 733     executed; see compiler/prelude/PrimOps.lhs)
 734    In GUM and SMP we only add a pointer to the spark pool.
 735    In GranSim we call an RTS fct, forwarding additional parameters which
 736    supply info on granularity of the computation, size of the result value
 737    and the degree of parallelism in the sparked expression.
 738    ---------------------------------------------------------------------- */
 739
 740 #if defined(GRAN)
 741 //@cindex _par_
 742 #define parzh(r,node)             PAR(r,node,1,0,0,0,0,0)
 743
 744 //@cindex _parAt_
 745 #define parAtzh(r,node,where,identifier,gran_info,size_info,par_info,rest) \
 746         parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,1)
 747
 748 //@cindex _parAtAbs_
 749 #define parAtAbszh(r,node,proc,identifier,gran_info,size_info,par_info,rest) \
 750         parAT(r,node,proc,identifier,gran_info,size_info,par_info,rest,2)
 751
 752 //@cindex _parAtRel_
 753 #define parAtRelzh(r,node,proc,identifier,gran_info,size_info,par_info,rest) \
 754         parAT(r,node,proc,identifier,gran_info,size_info,par_info,rest,3)
 755
 756 //@cindex _parAtForNow_
 757 #define parAtForNowzh(r,node,where,identifier,gran_info,size_info,par_info,rest)        \
 758         parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,0)
 759
 760 #define parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,local)  \
 761 {                                                               \
 762   if (closure_SHOULD_SPARK((StgClosure*)node)) {                \
 763     rtsSparkQ result;                                           \
 764     PEs p;                                                      \
 765                                                                 \
 766     STGCALL6(newSpark, node,identifier,gran_info,size_info,par_info,local); \
 767     switch (local) {                                                        \
 768       case 2: p = where;  /* parAtAbs means absolute PE no. expected */     \
 769               break;                                                        \
 770       case 3: p = CurrentProc+where; /* parAtRel means rel PE no. expected */\
 771               break;                                                        \
 772       default: p = where_is(where); /* parAt means closure expected */      \
 773               break;                                                        \
 774     }                                                                       \
 775     /* update GranSim state according to this spark */                      \
 776     STGCALL3(GranSimSparkAtAbs, result, (I_)p, identifier);                 \
 777   }                                                                         \
 778 }
 779
 780 //@cindex _parLocal_
 781 #define parLocalzh(r,node,identifier,gran_info,size_info,par_info,rest) \
 782         PAR(r,node,rest,identifier,gran_info,size_info,par_info,1)
 783
 784 //@cindex _parGlobal_
 785 #define parGlobalzh(r,node,identifier,gran_info,size_info,par_info,rest) \
 786         PAR(r,node,rest,identifier,gran_info,size_info,par_info,0)
 787
 788 #define PAR(r,node,rest,identifier,gran_info,size_info,par_info,local) \
 789 {                                                                        \
 790   if (closure_SHOULD_SPARK((StgClosure*)node)) {                         \
 791     rtsSpark *result;                                                    \
 792     result = RET_STGCALL6(rtsSpark*, newSpark,                           \
 793                           node,identifier,gran_info,size_info,par_info,local);\
 794     STGCALL1(add_to_spark_queue,result);                                \
 795     STGCALL2(GranSimSpark, local,(P_)node);                             \
 796   }                                                                     \
 797 }
 798
 799 #define copyablezh(r,node)                              \
 800   /* copyable not yet implemented!! */
 801
 802 #define noFollowzh(r,node)                              \
 803   /* noFollow not yet implemented!! */
 804
 805 #elif defined(SMP) || defined(PAR)
 806
 807 #define parzh(r,node)                                   \
 808 {                                                       \
 809   extern unsigned int context_switch;                   \
 810   if (closure_SHOULD_SPARK((StgClosure *)node) &&       \
 811       SparkTl < SparkLim) {                             \
 812     *SparkTl++ = (StgClosure *)(node);                  \
 813   }                                                     \
 814   r = context_switch = 1;                               \
 815 }
 816 #else /* !GRAN && !SMP && !PAR */
 817 #define parzh(r,node) r = 1
 818 #endif
 819
 820 /* -----------------------------------------------------------------------------
 821    Pointer equality
 822    -------------------------------------------------------------------------- */
 823
 824 /* warning: extremely non-referentially transparent, need to hide in
 825    an appropriate monad.
 826
 827    ToDo: follow indirections.
 828 */
 829
 830 #define reallyUnsafePtrEqualityzh(r,a,b) r=((StgPtr)(a) == (StgPtr)(b))
 831
 832 /* -----------------------------------------------------------------------------
 833    Weak Pointer PrimOps.
 834    -------------------------------------------------------------------------- */
 835
 836 #ifndef PAR
 837
 838 EXTFUN_RTS(mkWeakzh_fast);
 839 EXTFUN_RTS(finalizzeWeakzh_fast);
 840
 841 #define deRefWeakzh(code,val,w)                         \
 842   if (((StgWeak *)w)->header.info == &WEAK_info) {      \
 843         code = 1;                                       \
 844         val = (P_)((StgWeak *)w)->value;                \
 845   } else {                                              \
 846         code = 0;                                       \
 847         val = (P_)w;                                    \
 848   }
 849
 850 #define sameWeakzh(w1,w2)  ((w1)==(w2))
 851
 852 #endif
 853
 854 /* -----------------------------------------------------------------------------
 855    Foreign Object PrimOps.
 856    -------------------------------------------------------------------------- */
 857
 858 #ifndef PAR
 859
 860 #define ForeignObj_CLOSURE_DATA(c)  (((StgForeignObj *)c)->data)
 861
 862 #define foreignObjToAddrzh(r,fo)    r=ForeignObj_CLOSURE_DATA(fo)
 863 #define touchzh(o)                  /* nothing */
 864
 865 EXTFUN_RTS(mkForeignObjzh_fast);
 866
 867 #define writeForeignObjzh(res,datum) \
 868    (ForeignObj_CLOSURE_DATA(res) = (P_)(datum))
 869
 870 #define eqForeignObj(f1,f2)  ((f1)==(f2))
 871
 872 #define indexCharOffForeignObjzh(r,fo,i)   indexCharOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
 873 #define indexIntOffForeignObjzh(r,fo,i)    indexIntOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
 874 #define indexWordOffForeignObjzh(r,fo,i)   indexWordOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
 875 #define indexAddrOffForeignObjzh(r,fo,i)   indexAddrOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
 876 #define indexFloatOffForeignObjzh(r,fo,i)  indexFloatOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
 877 #define indexDoubleOffForeignObjzh(r,fo,i) indexDoubleOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
 878 #define indexStablePtrOffForeignObjzh(r,fo,i)  indexStablePtrOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
 879 #ifdef SUPPORT_LONG_LONGS
 880 #define indexInt64OffForeignObjzh(r,fo,i)  indexInt64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
 881 #define indexWord64OffForeignObjzh(r,fo,i) indexWord64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
 882 #endif
 883
 884 #endif
 885
 886
 887 /* -----------------------------------------------------------------------------
 888    Constructor tags
 889    -------------------------------------------------------------------------- */
 890
 891 #define dataToTagzh(r,a)  r=(GET_TAG(((StgClosure *)a)->header.info))
 892 /*  tagToEnum# is handled directly by the code generator. */
 893
 894 /* -----------------------------------------------------------------------------
 895    Signal processing.  Not really primops, but called directly from
 896    Haskell.
 897    -------------------------------------------------------------------------- */
 898
 899 #define STG_SIG_DFL  (-1)
 900 #define STG_SIG_IGN  (-2)
 901 #define STG_SIG_ERR  (-3)
 902 #define STG_SIG_HAN  (-4)
 903
 904 extern StgInt sig_install (StgInt, StgInt, StgStablePtr, sigset_t *);
 905 #define stg_sig_default(sig,mask) sig_install(sig,STG_SIG_DFL,0,(sigset_t *)mask)
 906 #define stg_sig_ignore(sig,mask) sig_install(sig,STG_SIG_IGN,0,(sigset_t *)mask)
 907 #define stg_sig_catch(sig,ptr,mask) sig_install(sig,STG_SIG_HAN,ptr,(sigset_t *)mask)
 908
 909 #endif /* PRIMOPS_H */