X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FPrimOps.h;h=9c975bd10b36543d59152c8a6e57b42b2f878643;hb=88f53e66a48db654fcc60f3d72cdedd78b6c7079;hp=3411d51699e26afc661345be57de8cf259f88b3e;hpb=d4993e8b9cee0e2e2a7e16a9f20b55d8985575a3;p=ghc-hetmet.git diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h index 3411d51..9c975bd 100644 --- a/ghc/includes/PrimOps.h +++ b/ghc/includes/PrimOps.h @@ -1,7 +1,7 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.h,v 1.62 2000/09/11 11:17:09 sewardj Exp $ + * $Id: PrimOps.h,v 1.82 2001/08/18 11:55:48 qrczak Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2000 * * Macros for primitive operations in STG-ish C code. * @@ -10,113 +10,82 @@ #ifndef PRIMOPS_H #define PRIMOPS_H -/* ----------------------------------------------------------------------------- - Helpers for the metacircular interpreter. - -------------------------------------------------------------------------- */ - -#ifdef GHCI - -#define CHASE_INDIRECTIONS(lval) \ - do { \ - int again; \ - do { \ - again = 0; \ - if (get_itbl((StgClosure*)lval)->type == IND) \ - { again = 1; lval = ((StgInd*)lval)->indirectee; } \ - else \ - if (get_itbl((StgClosure*)lval)->type == IND_OLDGEN) \ - { again = 1; lval = ((StgIndOldGen*)lval)->indirectee; } \ - } while (again); \ - } while (0) - -#define indexWordOffClosurezh(r,a,i) \ - do { StgClosure* tmp = (StgClosure*)(a); \ - CHASE_INDIRECTIONS(tmp); \ - r = ((W_ *)tmp)[i]; \ - } while (0) - -#define indexPtrOffClosurezh(r,a,i) \ - do { StgClosure* tmp = (StgClosure*)(a); \ - CHASE_INDIRECTIONS(tmp); \ - r = ((P_ *)tmp)[i]; \ - } while (0) - +#include "MachDeps.h" -#else +#if WORD_SIZE_IN_BITS < 32 +#error GHC C backend requires 32+-bit words +#endif -/* These are the original definitions. They don't chase indirections. */ -#define indexWordOffClosurezh(r,a,i) r= ((W_ *)(a))[i] -#define indexPtrOffClosurezh(r,a,i) r= ((P_ *)(a))[i] +/* ----------------------------------------------------------------------------- + Helpers for the bytecode linker. + -------------------------------------------------------------------------- */ -#endif +#define addrToHValuezh(r,a) r=(P_)a /* ----------------------------------------------------------------------------- Comparison PrimOps. -------------------------------------------------------------------------- */ -#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)) +#define gtCharzh(r,a,b) r=(a)> (b) +#define geCharzh(r,a,b) r=(a)>=(b) +#define eqCharzh(r,a,b) r=(a)==(b) +#define neCharzh(r,a,b) r=(a)!=(b) +#define ltCharzh(r,a,b) r=(a)< (b) +#define leCharzh(r,a,b) r=(a)<=(b) /* Int comparisons: >#, >=# etc */ -#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)) - -/* Double comparisons: >##, >=#@ etc */ -#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)) +#define zgzh(r,a,b) r=(a)> (b) +#define zgzezh(r,a,b) r=(a)>=(b) +#define zezezh(r,a,b) r=(a)==(b) +#define zszezh(r,a,b) r=(a)!=(b) +#define zlzh(r,a,b) r=(a)< (b) +#define zlzezh(r,a,b) r=(a)<=(b) + +#define gtWordzh(r,a,b) r=(a)> (b) +#define geWordzh(r,a,b) r=(a)>=(b) +#define eqWordzh(r,a,b) r=(a)==(b) +#define neWordzh(r,a,b) r=(a)!=(b) +#define ltWordzh(r,a,b) r=(a)< (b) +#define leWordzh(r,a,b) r=(a)<=(b) + +#define gtAddrzh(r,a,b) r=(a)> (b) +#define geAddrzh(r,a,b) r=(a)>=(b) +#define eqAddrzh(r,a,b) r=(a)==(b) +#define neAddrzh(r,a,b) r=(a)!=(b) +#define ltAddrzh(r,a,b) r=(a)< (b) +#define leAddrzh(r,a,b) r=(a)<=(b) + +#define gtFloatzh(r,a,b) r=(a)> (b) +#define geFloatzh(r,a,b) r=(a)>=(b) +#define eqFloatzh(r,a,b) r=(a)==(b) +#define neFloatzh(r,a,b) r=(a)!=(b) +#define ltFloatzh(r,a,b) r=(a)< (b) +#define leFloatzh(r,a,b) r=(a)<=(b) + +/* Double comparisons: >##, >=## etc */ +#define zgzhzh(r,a,b) r=(a)> (b) +#define zgzezhzh(r,a,b) r=(a)>=(b) +#define zezezhzh(r,a,b) r=(a)==(b) +#define zszezhzh(r,a,b) r=(a)!=(b) +#define zlzhzh(r,a,b) r=(a)< (b) +#define zlzezhzh(r,a,b) r=(a)<=(b) /* ----------------------------------------------------------------------------- Char# PrimOps. -------------------------------------------------------------------------- */ -#define ordzh(r,a) r=(I_)((W_) (a)) -#define chrzh(r,a) r=(StgChar)((W_)(a)) +#define ordzh(r,a) r=(I_)(a) +#define chrzh(r,a) r=(C_)(a) /* ----------------------------------------------------------------------------- Int# PrimOps. -------------------------------------------------------------------------- */ -I_ stg_div (I_ a, I_ b); - #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) @@ -136,16 +105,16 @@ I_ stg_div (I_ a, I_ b); * 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); \ +{ r = (I_)a + (I_)b; \ + c = ((StgWord)(~((I_)a^(I_)b) & ((I_)a^r))) \ + >> (BITS_IN (I_) - 1); \ } #define subIntCzh(r,c,a,b) \ { r = a - b; \ c = ((StgWord)((a^b) & (a^r))) \ - >> (BITS_PER_BYTE * sizeof(I_) - 1); \ + >> (BITS_IN (I_) - 1); \ } /* Multiply with overflow checking. @@ -199,7 +168,7 @@ typedef union { c = z.i[C]; \ if (c == 0 || c == -1) { \ c = ((StgWord)((a^b) ^ r)) \ - >> (BITS_PER_BYTE * sizeof(I_) - 1); \ + >> (BITS_IN (I_) - 1); \ } \ } /* Careful: the carry calculation above is extremely delicate. Make sure @@ -208,13 +177,13 @@ typedef union { #else -#define HALF_INT (1 << (BITS_PER_BYTE * sizeof(I_) / 2)) +#define HALF_INT (1LL << (BITS_IN (I_) / 2)) #define stg_abs(a) ((a) < 0 ? -(a) : (a)) #define mulIntCzh(r,c,a,b) \ { \ - if (stg_abs(a) >= HALF_INT \ + if (stg_abs(a) >= HALF_INT || \ stg_abs(b) >= HALF_INT) { \ c = 1; \ } else { \ @@ -225,11 +194,14 @@ typedef union { #endif /* ----------------------------------------------------------------------------- - Word PrimOps. + Word# PrimOps. -------------------------------------------------------------------------- */ -#define quotWordzh(r,a,b) r=((W_)a)/((W_)b) -#define remWordzh(r,a,b) r=((W_)a)%((W_)b) +#define plusWordzh(r,a,b) r=(a)+(b) +#define minusWordzh(r,a,b) r=(a)-(b) +#define timesWordzh(r,a,b) r=(a)*(b) +#define quotWordzh(r,a,b) r=(a)/(b) +#define remWordzh(r,a,b) r=(a)%(b) #define andzh(r,a,b) r=(a)&(b) #define orzh(r,a,b) r=(a)|(b) @@ -250,56 +222,98 @@ typedef union { on the whatever your C compiler is doing. ToDo: fix/document. -- sof 8/98 */ #define iShiftRAzh(r,a,b) r=((b) >= BITS_IN(I_)) ? (((a) < 0) ? -1 : 0) : (a)>>(b) -#define iShiftRLzh(r,a,b) r=((b) >= BITS_IN(I_)) ? 0 : ((W_)(a))>>(b) +#define iShiftRLzh(r,a,b) r=((b) >= BITS_IN(I_)) ? 0 : (I_)((W_)(a)>>(b)) #define int2Wordzh(r,a) r=(W_)(a) #define word2Intzh(r,a) r=(I_)(a) /* ----------------------------------------------------------------------------- - Addr PrimOps. + Explicitly sized Int# and Word# PrimOps. + -------------------------------------------------------------------------- */ + +#define narrow8Intzh(r,a) r=(StgInt8)(a) +#define narrow16Intzh(r,a) r=(StgInt16)(a) +#define narrow32Intzh(r,a) r=(StgInt32)(a) +#define narrow8Wordzh(r,a) r=(StgWord8)(a) +#define narrow16Wordzh(r,a) r=(StgWord16)(a) +#define narrow32Wordzh(r,a) r=(StgWord32)(a) + +/* ----------------------------------------------------------------------------- + Addr# PrimOps. -------------------------------------------------------------------------- */ +#define nullAddrzh(r,i) r=(A_)(0) +#define plusAddrzh(r,a,i) r=((char *)(a)) + (i) +#define minusAddrzh(r,a,b) r=((char *)(a)) - ((char *)(b)) +#define remAddrzh(r,a,i) r=((W_)(a))%(i) #define int2Addrzh(r,a) r=(A_)(a) #define addr2Intzh(r,a) r=(I_)(a) -#define readCharOffAddrzh(r,a,i) r= ((unsigned char *)(a))[i] -/* unsigned char is for compatibility: the index is still in bytes. */ -#define readIntOffAddrzh(r,a,i) r= ((I_ *)(a))[i] -#define readWordOffAddrzh(r,a,i) r= ((W_ *)(a))[i] -#define readAddrOffAddrzh(r,a,i) r= ((PP_)(a))[i] -#define readFloatOffAddrzh(r,a,i) r= PK_FLT((P_) (((StgFloat *)(a)) + i)) -#define readDoubleOffAddrzh(r,a,i) r= PK_DBL((P_) (((StgDouble *)(a)) + i)) -#define readStablePtrOffAddrzh(r,a,i) r= ((StgStablePtr *)(a))[i] +#define readCharOffAddrzh(r,a,i) r=((StgWord8 *)(a))[i] +#define readWideCharOffAddrzh(r,a,i) r=((C_ *)(a))[i] +#define readIntOffAddrzh(r,a,i) r=((I_ *)(a))[i] +#define readWordOffAddrzh(r,a,i) r=((W_ *)(a))[i] +#define readAddrOffAddrzh(r,a,i) r=((PP_)(a))[i] +#define readFloatOffAddrzh(r,a,i) r=PK_FLT((P_) (((StgFloat *)(a)) + i)) +#define readDoubleOffAddrzh(r,a,i) r=PK_DBL((P_) (((StgDouble *)(a)) + i)) +#define readStablePtrOffAddrzh(r,a,i) r=((StgStablePtr *)(a))[i] +#define readInt8OffAddrzh(r,a,i) r=((StgInt8 *)(a))[i] +#define readInt16OffAddrzh(r,a,i) r=((StgInt16 *)(a))[i] +#define readWord8OffAddrzh(r,a,i) r=((StgWord8 *)(a))[i] +#define readWord16OffAddrzh(r,a,i) r=((StgWord16 *)(a))[i] +#define readInt32OffAddrzh(r,a,i) r=((StgInt32 *)(a))[i] +#define readWord32OffAddrzh(r,a,i) r=((StgWord32 *)(a))[i] #ifdef SUPPORT_LONG_LONGS -#define readInt64OffAddrzh(r,a,i) r= ((LI_ *)(a))[i] -#define readWord64OffAddrzh(r,a,i) r= ((LW_ *)(a))[i] +#define readInt64OffAddrzh(r,a,i) r=((LI_ *)(a))[i] +#define readWord64OffAddrzh(r,a,i) r=((LW_ *)(a))[i] +#else +#define readInt64OffAddrzh(r,a,i) r=((I_ *)(a))[i] +#define readWord64OffAddrzh(r,a,i) r=((W_ *)(a))[i] #endif -#define writeCharOffAddrzh(a,i,v) ((unsigned char *)(a))[i] = (unsigned char)(v) -/* unsigned char is for compatibility: the index is still in bytes. */ -#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 writeCharOffAddrzh(a,i,v) ((StgWord8 *)(a))[i] = (v) +#define writeWideCharOffAddrzh(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) +#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) +#define writeInt8OffAddrzh(a,i,v) ((StgInt8 *)(a))[i] = (v) +#define writeInt16OffAddrzh(a,i,v) ((StgInt16 *)(a))[i] = (v) +#define writeInt32OffAddrzh(a,i,v) ((StgInt32 *)(a))[i] = (v) +#define writeWord8OffAddrzh(a,i,v) ((StgWord8 *)(a))[i] = (v) +#define writeWord16OffAddrzh(a,i,v) ((StgWord16 *)(a))[i] = (v) +#define writeWord32OffAddrzh(a,i,v) ((StgWord32 *)(a))[i] = (v) #ifdef SUPPORT_LONG_LONGS -#define writeInt64OffAddrzh(a,i,v) ((LI_ *)(a))[i] = (v) -#define writeWord64OffAddrzh(a,i,v) ((LW_ *)(a))[i] = (v) +#define writeInt64OffAddrzh(a,i,v) ((LI_ *)(a))[i] = (v) +#define writeWord64OffAddrzh(a,i,v) ((LW_ *)(a))[i] = (v) +#else +#define writeInt64OffAddrzh(a,i,v) ((I_ *)(a))[i] = (v) +#define writeWord64OffAddrzh(a,i,v) ((W_ *)(a))[i] = (v) #endif -#define indexCharOffAddrzh(r,a,i) r= ((unsigned char *)(a))[i] -/* unsigned char is for compatibility: the index is still in bytes. */ -#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)) -#define indexStablePtrOffAddrzh(r,a,i) r= ((StgStablePtr *)(a))[i] +#define indexCharOffAddrzh(r,a,i) r=((StgWord8 *)(a))[i] +#define indexWideCharOffAddrzh(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)) +#define indexStablePtrOffAddrzh(r,a,i) r=((StgStablePtr *)(a))[i] +#define indexInt8OffAddrzh(r,a,i) r=((StgInt8 *)(a))[i] +#define indexInt16OffAddrzh(r,a,i) r=((StgInt16 *)(a))[i] +#define indexInt32OffAddrzh(r,a,i) r=((StgInt32 *)(a))[i] +#define indexWord8OffAddrzh(r,a,i) r=((StgWord8 *)(a))[i] +#define indexWord16OffAddrzh(r,a,i) r=((StgWord16 *)(a))[i] +#define indexWord32OffAddrzh(r,a,i) r=((StgWord32 *)(a))[i] #ifdef SUPPORT_LONG_LONGS -#define indexInt64OffAddrzh(r,a,i) r= ((LI_ *)(a))[i] -#define indexWord64OffAddrzh(r,a,i) r= ((LW_ *)(a))[i] +#define indexInt64OffAddrzh(r,a,i) r=((LI_ *)(a))[i] +#define indexWord64OffAddrzh(r,a,i) r=((LW_ *)(a))[i] +#else +#define indexInt64OffAddrzh(r,a,i) r=((I_ *)(a))[i] +#define indexWord64OffAddrzh(r,a,i) r=((W_ *)(a))[i] #endif /* ----------------------------------------------------------------------------- @@ -371,21 +385,30 @@ typedef union { */ #define integer2Intzh(r, sa,da) \ -{ StgWord word0 = ((StgWord *)BYTE_ARR_CTS(da))[0]; \ - int size = sa; \ +{ I_ s, res; \ \ - (r) = \ - ( size == 0 ) ? \ - 0 : \ - ( size < 0 && word0 != 0x8000000 ) ? \ - -(I_)word0 : \ - (I_)word0; \ + s = (sa); \ + if (s == 0) \ + res = 0; \ + else { \ + res = ((mp_limb_t *) (BYTE_ARR_CTS(da)))[0]; \ + if (s < 0) res = -res; \ + } \ + (r) = res; \ } #define integer2Wordzh(r, sa,da) \ -{ StgWord word0 = ((StgWord *)BYTE_ARR_CTS(da))[0]; \ - int size = sa; \ - (r) = ( size == 0 ) ? 0 : word0 ; \ +{ I_ s; \ + W_ res; \ + \ + s = (sa); \ + if (s == 0) \ + res = 0; \ + else { \ + res = ((mp_limb_t *) (BYTE_ARR_CTS(da)))[0]; \ + if (s < 0) res = -res; \ + } \ + (r) = res; \ } #define cmpIntegerzh(r, s1,d1, s2,d2) \ @@ -394,10 +417,10 @@ typedef union { \ arg1._mp_size = (s1); \ arg1._mp_alloc= ((StgArrWords *)d1)->words; \ - arg1._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d1)); \ + arg1._mp_d = (mp_limb_t *) (BYTE_ARR_CTS(d1)); \ arg2._mp_size = (s2); \ arg2._mp_alloc= ((StgArrWords *)d2)->words; \ - arg2._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d2)); \ + arg2._mp_d = (mp_limb_t *) (BYTE_ARR_CTS(d2)); \ \ (r) = RET_PRIM_STGCALL2(I_,mpz_cmp,&arg1,&arg2); \ } @@ -407,7 +430,7 @@ typedef union { \ arg._mp_size = (s); \ arg._mp_alloc = ((StgArrWords *)d)->words; \ - arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d)); \ + arg._mp_d = (mp_limb_t *) (BYTE_ARR_CTS(d)); \ \ (r) = RET_PRIM_STGCALL2(I_,mpz_cmp_si,&arg,i); \ } @@ -439,51 +462,55 @@ EXTFUN_RTS(divModIntegerzh_fast); /* Conversions */ EXTFUN_RTS(int2Integerzh_fast); EXTFUN_RTS(word2Integerzh_fast); -EXTFUN_RTS(addr2Integerzh_fast); /* Floating-point decodings */ EXTFUN_RTS(decodeFloatzh_fast); EXTFUN_RTS(decodeDoublezh_fast); +/* Bit operations */ +EXTFUN_RTS(andIntegerzh_fast); +EXTFUN_RTS(orIntegerzh_fast); +EXTFUN_RTS(xorIntegerzh_fast); +EXTFUN_RTS(complementIntegerzh_fast); + /* ----------------------------------------------------------------------------- Word64 PrimOps. -------------------------------------------------------------------------- */ #ifdef SUPPORT_LONG_LONGS -#define integerToWord64zh(r, sa,da) \ -{ unsigned long int* d; \ +#define integerToWord64zh(r,sa,da) \ +{ mp_limb_t* d; \ I_ s; \ StgWord64 res; \ \ - d = (unsigned long int *) (BYTE_ARR_CTS(da)); \ + d = (mp_limb_t *) (BYTE_ARR_CTS(da)); \ s = (sa); \ - if ( s == 0 ) { \ - res = (LW_)0; \ - } else if ( s == 1) { \ - res = (LW_)d[0]; \ - } else { \ - res = (LW_)d[0] + (LW_)d[1] * 0x100000000ULL; \ + switch (s) { \ + case 0: res = 0; break; \ + case 1: res = d[0]; break; \ + case -1: res = -d[0]; break; \ + default: \ + res = d[0] + ((StgWord64) d[1] << (BITS_IN (mp_limb_t))); \ + if (s < 0) res = -res; \ } \ (r) = res; \ } -#define integerToInt64zh(r, sa,da) \ -{ unsigned long int* d; \ +#define integerToInt64zh(r,sa,da) \ +{ mp_limb_t* d; \ I_ s; \ StgInt64 res; \ \ - d = (unsigned long int *) (BYTE_ARR_CTS(da)); \ + d = (mp_limb_t *) (BYTE_ARR_CTS(da)); \ s = (sa); \ - if ( s == 0 ) { \ - res = (LI_)0; \ - } else if ( s == 1) { \ - res = (LI_)d[0]; \ - } else { \ - res = (LI_)d[0] + (LI_)d[1] * 0x100000000LL; \ - if ( s < 0 ) { \ - res = (LI_)-res; \ - } \ + switch (s) { \ + case 0: res = 0; break; \ + case 1: res = d[0]; break; \ + case -1: res = -d[0]; break; \ + default: \ + res = d[0] + ((StgWord64) d[1] << (BITS_IN (mp_limb_t))); \ + if (s < 0) res = -res; \ } \ (r) = res; \ } @@ -530,7 +557,7 @@ LI_ stg_iShiftRL64 (StgInt64, StgInt); LI_ stg_iShiftRA64 (StgInt64, StgInt); LI_ stg_intToInt64 (StgInt); -I_ stg_int64ToInt (StgInt64); +I_ stg_int64ToInt (StgInt64); LW_ stg_int64ToWord64 (StgInt64); LW_ stg_wordToWord64 (StgWord); @@ -550,11 +577,11 @@ LI_ stg_word64ToInt64 (StgWord64); #ifdef DEBUG #define BYTE_ARR_CTS(a) \ - ({ ASSERT(GET_INFO((StgArrWords *)(a)) == &ARR_WORDS_info); \ + ({ ASSERT(GET_INFO((StgArrWords *)(a)) == &stg_ARR_WORDS_info); \ REAL_BYTE_ARR_CTS(a); }) #define PTRS_ARR_CTS(a) \ - ({ ASSERT((GET_INFO((StgMutArrPtrs *)(a)) == &MUT_ARR_PTRS_FROZEN_info) \ - || (GET_INFO((StgMutArrPtrs *)(a)) == &MUT_ARR_PTRS_info)); \ + ({ ASSERT((GET_INFO((StgMutArrPtrs *)(a)) == &stg_MUT_ARR_PTRS_FROZEN_info) \ + || (GET_INFO((StgMutArrPtrs *)(a)) == &stg_MUT_ARR_PTRS_info)); \ REAL_PTRS_ARR_CTS(a); }) #else #define BYTE_ARR_CTS(a) REAL_BYTE_ARR_CTS(a) @@ -569,51 +596,63 @@ extern I_ resetGenSymZh(void); #define sameMutableArrayzh(r,a,b) r=(I_)((a)==(b)) #define sameMutableByteArrayzh(r,a,b) r=(I_)((a)==(b)) -#define readArrayzh(r,a,i) r=((PP_) PTRS_ARR_CTS(a))[(i)] - -#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) -#ifdef SUPPORT_LONG_LONGS -#define readInt64Arrayzh(r,a,i) indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i) -#define readWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i) -#endif +#define readArrayzh(r,a,i) r=((PP_) PTRS_ARR_CTS(a))[(i)] + +#define readCharArrayzh(r,a,i) indexCharOffAddrzh(r,BYTE_ARR_CTS(a),i) +#define readWideCharArrayzh(r,a,i) indexWideCharOffAddrzh(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) +#define readInt8Arrayzh(r,a,i) indexInt8OffAddrzh(r,BYTE_ARR_CTS(a),i) +#define readInt16Arrayzh(r,a,i) indexInt16OffAddrzh(r,BYTE_ARR_CTS(a),i) +#define readInt32Arrayzh(r,a,i) indexInt32OffAddrzh(r,BYTE_ARR_CTS(a),i) +#define readWord8Arrayzh(r,a,i) indexWord8OffAddrzh(r,BYTE_ARR_CTS(a),i) +#define readWord16Arrayzh(r,a,i) indexWord16OffAddrzh(r,BYTE_ARR_CTS(a),i) +#define readWord32Arrayzh(r,a,i) indexWord32OffAddrzh(r,BYTE_ARR_CTS(a),i) +#define readInt64Arrayzh(r,a,i) indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i) +#define readWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i) /* result ("r") arg ignored in write macros! */ -#define writeArrayzh(a,i,v) ((PP_) PTRS_ARR_CTS(a))[(i)]=(v) - -#define writeCharArrayzh(a,i,v) ((unsigned char *)(BYTE_ARR_CTS(a)))[i] = (unsigned char)(v) -/* unsigned char is for compatibility: the index is still in bytes. */ -#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) \ - ASSIGN_FLT((P_) (((StgFloat *)(BYTE_ARR_CTS(a))) + i),v) -#define writeDoubleArrayzh(a,i,v) \ - ASSIGN_DBL((P_) (((StgDouble *)(BYTE_ARR_CTS(a))) + i),v) -#define writeStablePtrArrayzh(a,i,v) ((StgStablePtr *)(BYTE_ARR_CTS(a)))[i] = (v) -#ifdef SUPPORT_LONG_LONGS -#define writeInt64Arrayzh(a,i,v) ((LI_ *)(BYTE_ARR_CTS(a)))[i] = (v) -#define writeWord64Arrayzh(a,i,v) ((LW_ *)(BYTE_ARR_CTS(a)))[i] = (v) -#endif - -#define indexArrayzh(r,a,i) r=((PP_) PTRS_ARR_CTS(a))[(i)] - -#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) -#ifdef SUPPORT_LONG_LONGS -#define indexInt64Arrayzh(r,a,i) indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i) -#define indexWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i) -#endif +#define writeArrayzh(a,i,v) ((PP_) PTRS_ARR_CTS(a))[(i)]=(v) + +#define writeCharArrayzh(a,i,v) writeCharOffAddrzh(BYTE_ARR_CTS(a),i,v) +#define writeWideCharArrayzh(a,i,v) writeWideCharOffAddrzh(BYTE_ARR_CTS(a),i,v) +#define writeIntArrayzh(a,i,v) writeIntOffAddrzh(BYTE_ARR_CTS(a),i,v) +#define writeWordArrayzh(a,i,v) writeWordOffAddrzh(BYTE_ARR_CTS(a),i,v) +#define writeAddrArrayzh(a,i,v) writeAddrOffAddrzh(BYTE_ARR_CTS(a),i,v) +#define writeFloatArrayzh(a,i,v) writeFloatOffAddrzh(BYTE_ARR_CTS(a),i,v) +#define writeDoubleArrayzh(a,i,v) writeDoubleOffAddrzh(BYTE_ARR_CTS(a),i,v) +#define writeStablePtrArrayzh(a,i,v) writeStablePtrOffAddrzh(BYTE_ARR_CTS(a),i,v) +#define writeInt8Arrayzh(a,i,v) writeInt8OffAddrzh(BYTE_ARR_CTS(a),i,v) +#define writeInt16Arrayzh(a,i,v) writeInt16OffAddrzh(BYTE_ARR_CTS(a),i,v) +#define writeInt32Arrayzh(a,i,v) writeInt32OffAddrzh(BYTE_ARR_CTS(a),i,v) +#define writeWord8Arrayzh(a,i,v) writeWord8OffAddrzh(BYTE_ARR_CTS(a),i,v) +#define writeWord16Arrayzh(a,i,v) writeWord16OffAddrzh(BYTE_ARR_CTS(a),i,v) +#define writeWord32Arrayzh(a,i,v) writeWord32OffAddrzh(BYTE_ARR_CTS(a),i,v) +#define writeInt64Arrayzh(a,i,v) writeInt64OffAddrzh(BYTE_ARR_CTS(a),i,v) +#define writeWord64Arrayzh(a,i,v) writeWord64OffAddrzh(BYTE_ARR_CTS(a),i,v) + +#define indexArrayzh(r,a,i) r=((PP_) PTRS_ARR_CTS(a))[(i)] + +#define indexCharArrayzh(r,a,i) indexCharOffAddrzh(r,BYTE_ARR_CTS(a),i) +#define indexWideCharArrayzh(r,a,i) indexWideCharOffAddrzh(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) +#define indexInt8Arrayzh(r,a,i) indexInt8OffAddrzh(r,BYTE_ARR_CTS(a),i) +#define indexInt16Arrayzh(r,a,i) indexInt16OffAddrzh(r,BYTE_ARR_CTS(a),i) +#define indexInt32Arrayzh(r,a,i) indexInt32OffAddrzh(r,BYTE_ARR_CTS(a),i) +#define indexWord8Arrayzh(r,a,i) indexWord8OffAddrzh(r,BYTE_ARR_CTS(a),i) +#define indexWord16Arrayzh(r,a,i) indexWord16OffAddrzh(r,BYTE_ARR_CTS(a),i) +#define indexWord32Arrayzh(r,a,i) indexWord32OffAddrzh(r,BYTE_ARR_CTS(a),i) +#define indexInt64Arrayzh(r,a,i) indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i) +#define indexWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i) /* Freezing arrays-of-ptrs requires changing an info table, for the benefit of the generational collector. It needs to scavenge mutable @@ -622,7 +661,7 @@ extern I_ resetGenSymZh(void); #define unsafeFreezzeArrayzh(r,a) \ { \ - SET_INFO((StgClosure *)a,&MUT_ARR_PTRS_FROZEN_info); \ + SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN_info); \ r = a; \ } @@ -637,15 +676,14 @@ EXTFUN_RTS(unsafeThawArrayzh_fast); /* and the out-of-line ones... */ -EXTFUN_RTS(newCharArrayzh_fast); -EXTFUN_RTS(newIntArrayzh_fast); -EXTFUN_RTS(newWordArrayzh_fast); -EXTFUN_RTS(newAddrArrayzh_fast); -EXTFUN_RTS(newFloatArrayzh_fast); -EXTFUN_RTS(newDoubleArrayzh_fast); -EXTFUN_RTS(newStablePtrArrayzh_fast); +EXTFUN_RTS(newByteArrayzh_fast); +EXTFUN_RTS(newPinnedByteArrayzh_fast); EXTFUN_RTS(newArrayzh_fast); +// Highly unsafe, for use with a pinned ByteArray +// being kept alive with touch# +#define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a) + /* encoding and decoding of floats/doubles. */ /* We only support IEEE floating point format */ @@ -654,22 +692,15 @@ EXTFUN_RTS(newArrayzh_fast); /* The decode operations are out-of-line because they need to allocate * a byte array. */ -#ifdef FLOATS_AS_DOUBLES -#define decodeFloatzh_fast decodeDoublezh_fast -#else EXTFUN_RTS(decodeFloatzh_fast); -#endif - EXTFUN_RTS(decodeDoublezh_fast); /* grimy low-level support functions defined in StgPrimFloat.c */ 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 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); @@ -701,12 +732,12 @@ EXTFUN_RTS(newMutVarzh_fast); #define sameMVarzh(r,a,b) r=(I_)((a)==(b)) /* Assume external decl of EMPTY_MVAR_info is in scope by now */ -#define isEmptyMVarzh(r,a) r=(I_)((GET_INFO((StgMVar*)(a))) == &EMPTY_MVAR_info ) +#define isEmptyMVarzh(r,a) r=(I_)((GET_INFO((StgMVar*)(a))) == &stg_EMPTY_MVAR_info ) EXTFUN_RTS(newMVarzh_fast); EXTFUN_RTS(takeMVarzh_fast); -EXTFUN_RTS(tryTakeMVarzh_fast); EXTFUN_RTS(putMVarzh_fast); - +EXTFUN_RTS(tryTakeMVarzh_fast); +EXTFUN_RTS(tryPutMVarzh_fast); /* ----------------------------------------------------------------------------- Delay/Wait PrimOps @@ -729,8 +760,6 @@ extern void stg_exit(I_ n) __attribute__ ((noreturn)); Stable Name / Stable Pointer PrimOps -------------------------------------------------------------------------- */ -#ifndef PAR - EXTFUN_RTS(makeStableNamezh_fast); #define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn) @@ -749,8 +778,6 @@ EXTFUN_RTS(makeStableNamezh_fast); #define eqStablePtrzh(r,sp1,sp2) \ (r = ((stgCast(StgWord,sp1) & ~STABLEPTR_WEIGHT_MASK) == (stgCast(StgWord,sp2) & ~STABLEPTR_WEIGHT_MASK))) -#endif - /* ----------------------------------------------------------------------------- Concurrency/Exception PrimOps. -------------------------------------------------------------------------- */ @@ -780,7 +807,7 @@ extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2); #if defined(GRAN) //@cindex _par_ -#define parzh(r,node) PAR(r,node,1,0,0,0,0,0) +#define parzh(r,node) parAny(r,node,1,0,0,0,0,0) //@cindex _parAt_ #define parAtzh(r,node,where,identifier,gran_info,size_info,par_info,rest) \ @@ -820,13 +847,13 @@ extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2); //@cindex _parLocal_ #define parLocalzh(r,node,identifier,gran_info,size_info,par_info,rest) \ - PAR(r,node,rest,identifier,gran_info,size_info,par_info,1) + parAny(r,node,rest,identifier,gran_info,size_info,par_info,1) //@cindex _parGlobal_ #define parGlobalzh(r,node,identifier,gran_info,size_info,par_info,rest) \ - PAR(r,node,rest,identifier,gran_info,size_info,par_info,0) + parAny(r,node,rest,identifier,gran_info,size_info,par_info,0) -#define PAR(r,node,rest,identifier,gran_info,size_info,par_info,local) \ +#define parAny(r,node,rest,identifier,gran_info,size_info,par_info,local) \ { \ if (closure_SHOULD_SPARK((StgClosure*)node)) { \ rtsSpark *result; \ @@ -874,13 +901,11 @@ extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2); Weak Pointer PrimOps. -------------------------------------------------------------------------- */ -#ifndef PAR - EXTFUN_RTS(mkWeakzh_fast); EXTFUN_RTS(finalizzeWeakzh_fast); #define deRefWeakzh(code,val,w) \ - if (((StgWeak *)w)->header.info == &WEAK_info) { \ + if (((StgWeak *)w)->header.info == &stg_WEAK_info) { \ code = 1; \ val = (P_)((StgWeak *)w)->value; \ } else { \ @@ -890,14 +915,11 @@ EXTFUN_RTS(finalizzeWeakzh_fast); #define sameWeakzh(w1,w2) ((w1)==(w2)) -#endif /* ----------------------------------------------------------------------------- Foreign Object PrimOps. -------------------------------------------------------------------------- */ -#ifndef PAR - #define ForeignObj_CLOSURE_DATA(c) (((StgForeignObj *)c)->data) #define foreignObjToAddrzh(r,fo) r=ForeignObj_CLOSURE_DATA(fo) @@ -908,41 +930,40 @@ EXTFUN_RTS(mkForeignObjzh_fast); #define writeForeignObjzh(res,datum) \ (ForeignObj_CLOSURE_DATA(res) = (P_)(datum)) -#define eqForeignObj(f1,f2) ((f1)==(f2)) - -#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) -#ifdef SUPPORT_LONG_LONGS -#define indexInt64OffForeignObjzh(r,fo,i) indexInt64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) -#define indexWord64OffForeignObjzh(r,fo,i) indexWord64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) -#endif - -#endif - +#define eqForeignObjzh(r,f1,f2) r=(f1)==(f2) +#define indexCharOffForeignObjzh(r,fo,i) indexCharOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexWideCharOffForeignObjzh(r,fo,i) indexWideCharOffAddrzh(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) +#define indexInt8OffForeignObjzh(r,fo,i) indexInt8OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexInt16OffForeignObjzh(r,fo,i) indexInt16OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexInt32OffForeignObjzh(r,fo,i) indexInt32OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexWord8OffForeignObjzh(r,fo,i) indexWord8OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexWord16OffForeignObjzh(r,fo,i) indexWord16OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexWord32OffForeignObjzh(r,fo,i) indexWord32OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexInt64OffForeignObjzh(r,fo,i) indexInt64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexWord64OffForeignObjzh(r,fo,i) indexWord64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) /* ----------------------------------------------------------------------------- Constructor tags -------------------------------------------------------------------------- */ -#ifdef GHCI -#define dataToTagzh(r,a) \ - do { StgClosure* tmp = (StgClosure*)(a); \ - CHASE_INDIRECTIONS(tmp); \ - r = (GET_TAG(((StgClosure *)tmp)->header.info)); \ - } while (0) -#else -/* Original version doesn't chase indirections. */ #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info)) -#endif /* tagToEnum# is handled directly by the code generator. */ /* ----------------------------------------------------------------------------- + BCOs and BCO linkery + -------------------------------------------------------------------------- */ + +EXTFUN_RTS(newBCOzh_fast); +EXTFUN_RTS(mkApUpd0zh_fast); + +/* ----------------------------------------------------------------------------- Signal processing. Not really primops, but called directly from Haskell. -------------------------------------------------------------------------- */ @@ -952,9 +973,9 @@ EXTFUN_RTS(mkForeignObjzh_fast); #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) +extern StgInt stg_sig_install (StgInt, StgInt, StgStablePtr, sigset_t *); +#define stg_sig_default(sig,mask) stg_sig_install(sig,STG_SIG_DFL,0,(sigset_t *)mask) +#define stg_sig_ignore(sig,mask) stg_sig_install(sig,STG_SIG_IGN,0,(sigset_t *)mask) +#define stg_sig_catch(sig,ptr,mask) stg_sig_install(sig,STG_SIG_HAN,ptr,(sigset_t *)mask) #endif /* PRIMOPS_H */