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