/* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.8 1999/01/21 10:31:42 simonm Exp $
+ * $Id: PrimOps.h,v 1.80 2001/08/08 10:50:37 simonmar Exp $
+ *
+ * (c) The GHC Team, 1998-2000
*
* Macros for primitive operations in STG-ish C code.
*
#define PRIMOPS_H
/* -----------------------------------------------------------------------------
+ Helpers for the bytecode linker.
+ -------------------------------------------------------------------------- */
+
+#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_)((a) >(b))
-#define ZgZeZh(r,a,b) r=(I_)((a)>=(b))
-#define ZeZeZh(r,a,b) r=(I_)((a)==(b))
-#define ZdZeZh(r,a,b) r=(I_)((a)!=(b))
-#define ZlZh(r,a,b) r=(I_)((a) <(b))
-#define ZlZeZh(r,a,b) r=(I_)((a)<=(b))
-
-#define gtWordZh(r,a,b) r=(I_)((a) >(b))
-#define geWordZh(r,a,b) r=(I_)((a)>=(b))
-#define eqWordZh(r,a,b) r=(I_)((a)==(b))
-#define neWordZh(r,a,b) r=(I_)((a)!=(b))
-#define ltWordZh(r,a,b) r=(I_)((a) <(b))
-#define leWordZh(r,a,b) r=(I_)((a)<=(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 ZdZeZhZh(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))
-
-/* used by returning comparison primops, defined in Prims.hc. */
-extern const StgClosure *PrelBase_Bool_closure_tbl[];
+#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 remIntzh(r,a,b) r=(a)%(b)
+#define negateIntzh(r,a) r=-(a)
-#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 ZdZh(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)
+/* -----------------------------------------------------------------------------
+ * Int operations with carry.
+ * -------------------------------------------------------------------------- */
-/* The following operations are the standard add,subtract and multiply
- * except that they return a carry if the operation overflows.
+/* 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.
*
- * They are all defined in terms of 32-bit integers and use the GCC
- * 'long long' extension to get a 64-bit result. We'd like to use
- * 64-bit integers on 64-bit architectures, but it seems that gcc's
- * 'long long' type is set at 64-bits even on a 64-bit machine.
+ * 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 = (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_IN (I_) - 1); \
+}
+
+/* Multiply with overflow checking.
+ *
+ * This is slightly more tricky - the usual sign rules for add/subtract
+ * don't apply.
+ *
+ * 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.
+ */
+
+#if i386_TARGET_ARCH
+
+#define mulIntCzh(r,c,a,b) \
+{ \
+ __asm__("xorl %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
#ifdef WORDS_BIGENDIAN
#define C 0
StgInt32 i[2];
} long_long_u ;
-#define addWithCarryZh(r,c,a,b) \
-{ long_long_u z; \
- z.l = a + b; \
+#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_IN (I_) - 1); \
+ } \
}
+/* Careful: the carry calculation above is extremely delicate. Make sure
+ * you test it thoroughly after changing it.
+ */
+#else
+#define HALF_INT (1LL << (BITS_IN (I_) / 2))
-#define subWithCarryZh(r,c,a,b) \
-{ long_long_u z; \
- z.l = a + b; \
- r = z.i[R]; \
- c = z.i[C]; \
-}
+#define stg_abs(a) ((a) < 0 ? -(a) : (a))
-#define mulWithCarryZh(r,c,a,b) \
-{ long_long_u z; \
- z.l = a * b; \
- r = z.i[R]; \
- c = z.i[C]; \
+#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; \
+ } \
}
+#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 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)
+#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)
+#define xorzh(r,a,b) r=(a)^(b)
+#define notzh(r,a) r=~(a)
+
+/* The extra tests below properly define the behaviour when shifting
+ * by offsets larger than the width of the value being shifted. Doing
+ * so is undefined in C (and in fact gives different answers depending
+ * on whether the operation is constant folded or not with gcc on x86!)
+ */
-#define shiftLZh(r,a,b) r=(a)<<(b)
-#define shiftRLZh(r,a,b) r=(a)>>(b)
-#define iShiftLZh(r,a,b) r=(a)<<(b)
+#define shiftLzh(r,a,b) r=((b) >= BITS_IN(W_)) ? 0 : (a)<<(b)
+#define shiftRLzh(r,a,b) r=((b) >= BITS_IN(W_)) ? 0 : (a)>>(b)
+#define iShiftLzh(r,a,b) r=((b) >= BITS_IN(W_)) ? 0 : (a)<<(b)
/* 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
*/
-#define iShiftRAZh(r,a,b) r=(a)>>(b)
-#define iShiftRLZh(r,a,b) r=(a)>>(b)
+#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 : (I_)((W_)(a)>>(b))
-#define int2WordZh(r,a) r=(W_)(a)
-#define word2IntZh(r,a) r=(I_)(a)
+#define int2Wordzh(r,a) r=(W_)(a)
+#define word2Intzh(r,a) r=(I_)(a)
/* -----------------------------------------------------------------------------
- Addr PrimOps.
+ Explicitly sized Int# and Word# PrimOps.
-------------------------------------------------------------------------- */
-#define int2AddrZh(r,a) r=(A_)(a)
-#define addr2IntZh(r,a) r=(I_)(a)
+#define intToInt8zh(r,a) r=(StgInt8)(a)
+#define intToInt16zh(r,a) r=(StgInt16)(a)
+#define intToInt32zh(r,a) r=(StgInt32)(a)
+#define wordToWord8zh(r,a) r=(StgWord8)(a)
+#define wordToWord16zh(r,a) r=(StgWord16)(a)
+#define wordToWord32zh(r,a) r=(StgWord32)(a)
+
+/* -----------------------------------------------------------------------------
+ Addr# PrimOps.
+ -------------------------------------------------------------------------- */
-#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]
+#define int2Addrzh(r,a) r=(A_)(a)
+#define addr2Intzh(r,a) r=(I_)(a)
+
+#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 readInt32OffAddrzh(r,a,i) r=((StgInt32 *)(a))[i]
+#define readWord8OffAddrzh(r,a,i) r=((StgWord8 *)(a))[i]
+#define readWord16OffAddrzh(r,a,i) r=((StgWord16 *)(a))[i]
+#define readWord32OffAddrzh(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 readInt64OffAddrzh(r,a,i) r=((LI_ *)(a))[i]
+#define readWord64OffAddrzh(r,a,i) r=((LW_ *)(a))[i]
#endif
-#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)
+#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 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)
+#endif
+
+#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]
#endif
/* -----------------------------------------------------------------------------
Float PrimOps.
-------------------------------------------------------------------------- */
-#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)
+#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)
-#define int2FloatZh(r,a) r=(StgFloat)(a)
-#define float2IntZh(r,a) r=(I_)(a)
+#define int2Floatzh(r,a) r=(StgFloat)(a)
+#define float2Intzh(r,a) r=(I_)(a)
-#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)
+#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)
/* -----------------------------------------------------------------------------
Double PrimOps.
-------------------------------------------------------------------------- */
-#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 ZdZhZh(r,a,b) r=(a)/(b)
-#define negateDoubleZh(r,a) r=-(a)
+#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)
-#define int2DoubleZh(r,a) r=(StgDouble)(a)
-#define double2IntZh(r,a) r=(I_)(a)
+#define int2Doublezh(r,a) r=(StgDouble)(a)
+#define double2Intzh(r,a) r=(I_)(a)
-#define float2DoubleZh(r,a) r=(StgDouble)(a)
-#define double2FloatZh(r,a) r=(StgFloat)(a)
+#define float2Doublezh(r,a) r=(StgDouble)(a)
+#define double2Floatzh(r,a) r=(StgFloat)(a)
-#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)
+#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)
/* Power: **## */
-#define ZtZtZhZh(r,a,b) r=(StgDouble) RET_PRIM_STGCALL2(StgDouble,pow,a,b)
+#define ztztzhzh(r,a,b) r=(StgDouble) RET_PRIM_STGCALL2(StgDouble,pow,a,b)
/* -----------------------------------------------------------------------------
Integer PrimOps.
/* We can do integer2Int and cmpInteger inline, since they don't need
* to allocate any memory.
+ *
+ * integer2Int# is now modular.
*/
-#define integer2IntZh(r, aa,sa,da) \
-{ MP_INT arg; \
- \
- arg._mp_alloc = (aa); \
- arg._mp_size = (sa); \
- arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
- \
- (r) = RET_PRIM_STGCALL1(I_,mpz_get_si,&arg); \
+#define integer2Intzh(r, sa,da) \
+{ I_ s, 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 integer2WordZh(r, aa,sa,da) \
-{ MP_INT arg; \
- \
- arg._mp_alloc = (aa); \
- arg._mp_size = (sa); \
- arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
- \
- (r) = RET_PRIM_STGCALL1(I_,mpz_get_ui,&arg); \
+#define integer2Wordzh(r, sa,da) \
+{ 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, a1,s1,d1, a2,s2,d2) \
-{ MP_INT arg1; \
- MP_INT arg2; \
- \
- arg1._mp_alloc= (a1); \
- arg1._mp_size = (s1); \
- arg1._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d1)); \
- arg2._mp_alloc= (a2); \
- arg2._mp_size = (s2); \
- arg2._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d2)); \
- \
- (r) = RET_PRIM_STGCALL2(I_,mpz_cmp,&arg1,&arg2); \
+#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 = (mp_limb_t *) (BYTE_ARR_CTS(d1)); \
+ arg2._mp_size = (s2); \
+ arg2._mp_alloc= ((StgArrWords *)d2)->words; \
+ arg2._mp_d = (mp_limb_t *) (BYTE_ARR_CTS(d2)); \
+ \
+ (r) = RET_PRIM_STGCALL2(I_,mpz_cmp,&arg1,&arg2); \
}
-/* A glorious hack: calling mpz_neg would entail allocation and
- * copying, but by looking at what mpz_neg actually does, we can
- * derive a better version:
- */
+#define cmpIntegerIntzh(r, s,d, i) \
+{ MP_INT arg; \
+ \
+ arg._mp_size = (s); \
+ arg._mp_alloc = ((StgArrWords *)d)->words; \
+ arg._mp_d = (mp_limb_t *) (BYTE_ARR_CTS(d)); \
+ \
+ (r) = RET_PRIM_STGCALL2(I_,mpz_cmp_si,&arg,i); \
+}
-#define negateIntegerZh(ra, rs, rd, a, s, d) \
-{ \
- (ra) = (a); \
- (rs) = -(s); \
- (rd) = d; \
+/* NOTE: gcdIntzh and gcdIntegerIntzh work only for positive inputs! */
+
+/* mp_limb_t must be able to hold an StgInt for this to work properly */
+#define gcdIntzh(r,a,b) \
+{ mp_limb_t aa = (mp_limb_t)(a); \
+ r = RET_STGCALL3(StgInt, mpn_gcd_1, (mp_limb_t *)(&aa), 1, (mp_limb_t)(b)); \
}
+#define gcdIntegerIntzh(r,sa,a,b) \
+ r = RET_STGCALL3(StgInt, mpn_gcd_1, (mp_limb_t *)(BYTE_ARR_CTS(a)), sa, b)
+
/* The rest are all out-of-line: -------- */
/* Integer arithmetic */
-EF_(plusIntegerZh_fast);
-EF_(minusIntegerZh_fast);
-EF_(timesIntegerZh_fast);
-EF_(gcdIntegerZh_fast);
-EF_(quotRemIntegerZh_fast);
-EF_(divModIntegerZh_fast);
+EXTFUN_RTS(plusIntegerzh_fast);
+EXTFUN_RTS(minusIntegerzh_fast);
+EXTFUN_RTS(timesIntegerzh_fast);
+EXTFUN_RTS(gcdIntegerzh_fast);
+EXTFUN_RTS(quotRemIntegerzh_fast);
+EXTFUN_RTS(quotIntegerzh_fast);
+EXTFUN_RTS(remIntegerzh_fast);
+EXTFUN_RTS(divExactIntegerzh_fast);
+EXTFUN_RTS(divModIntegerzh_fast);
/* Conversions */
-EF_(int2IntegerZh_fast);
-EF_(word2IntegerZh_fast);
-EF_(addr2IntegerZh_fast);
+EXTFUN_RTS(int2Integerzh_fast);
+EXTFUN_RTS(word2Integerzh_fast);
-/* Floating-point encodings/decodings */
-EF_(encodeFloatZh_fast);
-EF_(decodeFloatZh_fast);
+/* Floating-point decodings */
+EXTFUN_RTS(decodeFloatzh_fast);
+EXTFUN_RTS(decodeDoublezh_fast);
-EF_(encodeDoubleZh_fast);
-EF_(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, aa,sa,da) \
-{ unsigned long int* d; \
- StgNat64 res; \
- \
- d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
- 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; \
+#define integerToWord64zh(r,sa,da) \
+{ mp_limb_t* d; \
+ I_ s; \
+ StgWord64 res; \
+ \
+ d = (mp_limb_t *) (BYTE_ARR_CTS(da)); \
+ s = (sa); \
+ 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, aa,sa,da) \
-{ unsigned long int* d; \
- StgInt64 res; \
- \
- d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
- if ( (aa) == 0 ) { \
- res = (LI_)0; \
- } else if ( (aa) == 1) { \
- res = (LI_)d[0]; \
- } else { \
- res = (LI_)d[0] + (LI_)d[1] * 0x100000000LL; \
- } \
- (r) = res; \
+#define integerToInt64zh(r,sa,da) \
+{ mp_limb_t* d; \
+ I_ s; \
+ StgInt64 res; \
+ \
+ d = (mp_limb_t *) (BYTE_ARR_CTS(da)); \
+ s = (sa); \
+ 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; \
}
/* Conversions */
-EF_(int64ToIntegerZh_fast);
-EF_(word64ToIntegerZh_fast);
+EXTFUN_RTS(int64ToIntegerzh_fast);
+EXTFUN_RTS(word64ToIntegerzh_fast);
/* The rest are (way!) out of line, implemented via C entry points.
*/
-I_ stg_gtWord64 (StgNat64, StgNat64);
-I_ stg_geWord64 (StgNat64, StgNat64);
-I_ stg_eqWord64 (StgNat64, StgNat64);
-I_ stg_neWord64 (StgNat64, StgNat64);
-I_ stg_ltWord64 (StgNat64, StgNat64);
-I_ stg_leWord64 (StgNat64, StgNat64);
+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);
I_ stg_gtInt64 (StgInt64, StgInt64);
I_ stg_geInt64 (StgInt64, StgInt64);
I_ stg_ltInt64 (StgInt64, StgInt64);
I_ stg_leInt64 (StgInt64, StgInt64);
-LW_ stg_remWord64 (StgNat64, StgNat64);
-LW_ stg_quotWord64 (StgNat64, StgNat64);
+LW_ stg_remWord64 (StgWord64, StgWord64);
+LW_ stg_quotWord64 (StgWord64, StgWord64);
LI_ stg_remInt64 (StgInt64, StgInt64);
LI_ stg_quotInt64 (StgInt64, StgInt64);
LI_ stg_minusInt64 (StgInt64, StgInt64);
LI_ stg_timesInt64 (StgInt64, StgInt64);
-LW_ stg_and64 (StgNat64, StgNat64);
-LW_ stg_or64 (StgNat64, StgNat64);
-LW_ stg_xor64 (StgNat64, StgNat64);
-LW_ stg_not64 (StgNat64);
+LW_ stg_and64 (StgWord64, StgWord64);
+LW_ stg_or64 (StgWord64, StgWord64);
+LW_ stg_xor64 (StgWord64, StgWord64);
+LW_ stg_not64 (StgWord64);
-LW_ stg_shiftL64 (StgNat64, StgInt);
-LW_ stg_shiftRL64 (StgNat64, StgInt);
+LW_ stg_shiftL64 (StgWord64, StgInt);
+LW_ stg_shiftRL64 (StgWord64, StgInt);
LI_ stg_iShiftL64 (StgInt64, StgInt);
LI_ stg_iShiftRL64 (StgInt64, StgInt);
LI_ stg_iShiftRA64 (StgInt64, StgInt);
LW_ stg_int64ToWord64 (StgInt64);
LW_ stg_wordToWord64 (StgWord);
-W_ stg_word64ToWord (StgNat64);
-LI_ stg_word64ToInt64 (StgNat64);
+W_ stg_word64ToWord (StgWord64);
+LI_ stg_word64ToInt64 (StgWord64);
#endif
/* -----------------------------------------------------------------------------
#ifdef DEBUG
#define BYTE_ARR_CTS(a) \
- ({ ASSERT((GET_INFO(a) == &ARR_WORDS_info) \
- || (GET_INFO(a) == &MUT_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(a) == &ARR_PTRS_info) \
- || (GET_INFO(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)
/*--- everything except new*Array is done inline: */
-#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)
+#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 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)
#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)
+#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
/* result ("r") arg ignored in write macros! */
-#define writeArrayZh(a,i,v) ((PP_) PTRS_ARR_CTS(a))[(i)]=(v)
-
-#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) \
- 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)
+#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)
#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)
+#define writeInt64Arrayzh(a,i,v) writeInt64OffAddrzh(BYTE_ARR_CTS(a),i,v)
+#define writeWord64Arrayzh(a,i,v) writeWord64OffAddrzh(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)
+#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)
#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 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
-
-#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))
-#ifdef SUPPORT_LONG_LONGS
-#define indexInt64OffAddrZh(r,a,i) r= ((LI_ *)(a))[i]
-#define indexWord64OffAddrZh(r,a,i) r= ((LW_ *)(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)
#endif
/* Freezing arrays-of-ptrs requires changing an info table, for the
objects, even if they are in old space. When they become immutable,
they can be removed from this scavenge list. */
-#define unsafeFreezeArrayZh(r,a) \
+#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; \
}
-#define unsafeFreezeByteArrayZh(r,a) r=(a)
+#define unsafeFreezzeByteArrayzh(r,a) r=(a)
-#define sizeofByteArrayZh(r,a) \
+EXTFUN_RTS(unsafeThawArrayzh_fast);
+
+#define sizzeofByteArrayzh(r,a) \
r = (((StgArrWords *)(a))->words * sizeof(W_))
-#define sizeofMutableByteArrayZh(r,a) \
+#define sizzeofMutableByteArrayzh(r,a) \
r = (((StgArrWords *)(a))->words * sizeof(W_))
/* and the out-of-line ones... */
-EF_(newCharArrayZh_fast);
-EF_(newIntArrayZh_fast);
-EF_(newWordArrayZh_fast);
-EF_(newAddrArrayZh_fast);
-EF_(newFloatArrayZh_fast);
-EF_(newDoubleArrayZh_fast);
-EF_(newStablePtrArrayZh_fast);
-EF_(newArrayZh_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 */
#include "ieee-flpt.h"
-#if FLOATS_AS_DOUBLES /* i.e. 64-bit machines */
-#define encodeFloatZh(r, aa,sa,da, expon) encodeDoubleZh(r, aa,sa,da, expon)
-#else
-#define encodeFloatZh(r, aa,sa,da, expon) \
-{ MP_INT arg; \
- /* Does not allocate memory */ \
- \
- arg._mp_alloc = aa; \
- arg._mp_size = sa; \
- arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
- \
- r = RET_PRIM_STGCALL2(StgFloat, __encodeFloat,&arg,(expon));\
-}
-#endif /* FLOATS_AS_DOUBLES */
-
-#define encodeDoubleZh(r, aa,sa,da, expon) \
-{ MP_INT arg; \
- /* Does not allocate memory */ \
- \
- arg._mp_alloc = aa; \
- arg._mp_size = sa; \
- arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
- \
- r = RET_PRIM_STGCALL2(StgDouble, __encodeDouble,&arg,(expon));\
-}
-
/* 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
-EF_(decodeFloatZh_fast);
-#endif
-
-EF_(decodeDoubleZh_fast);
+EXTFUN_RTS(decodeFloatzh_fast);
+EXTFUN_RTS(decodeDoublezh_fast);
/* grimy low-level support functions defined in StgPrimFloat.c */
-extern StgDouble __encodeDouble (MP_INT *s, I_ e);
-extern StgFloat __encodeFloat (MP_INT *s, I_ e);
+extern StgDouble __encodeDouble (I_ size, StgByteArray arr, I_ e);
+extern StgDouble __int_encodeDouble (I_ j, I_ e);
+extern StgFloat __encodeFloat (I_ size, StgByteArray arr, I_ e);
+extern StgFloat __int_encodeFloat (I_ j, I_ e);
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);
newMutVar is out of line.
-------------------------------------------------------------------------- */
-EF_(newMutVarZh_fast);
+EXTFUN_RTS(newMutVarzh_fast);
-#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))
+#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))
/* -----------------------------------------------------------------------------
MVar PrimOps.
All out of line, because they either allocate or may block.
-------------------------------------------------------------------------- */
-
-#define sameMVarZh(r,a,b) r=(I_)((a)==(b))
+#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 )
-EF_(newMVarZh_fast);
-EF_(takeMVarZh_fast);
-EF_(putMVarZh_fast);
+#define isEmptyMVarzh(r,a) r=(I_)((GET_INFO((StgMVar*)(a))) == &stg_EMPTY_MVAR_info )
+EXTFUN_RTS(newMVarzh_fast);
+EXTFUN_RTS(takeMVarzh_fast);
+EXTFUN_RTS(putMVarzh_fast);
+EXTFUN_RTS(tryTakeMVarzh_fast);
+EXTFUN_RTS(tryPutMVarzh_fast);
/* -----------------------------------------------------------------------------
Delay/Wait PrimOps
-------------------------------------------------------------------------- */
-/* Hmm, I'll think about these later. */
+EXTFUN_RTS(waitReadzh_fast);
+EXTFUN_RTS(waitWritezh_fast);
+EXTFUN_RTS(delayzh_fast);
/* -----------------------------------------------------------------------------
Primitive I/O, error-handling PrimOps
-------------------------------------------------------------------------- */
-EF_(catchZh_fast);
-EF_(raiseZh_fast);
+EXTFUN_RTS(catchzh_fast);
+EXTFUN_RTS(raisezh_fast);
extern void stg_exit(I_ n) __attribute__ ((noreturn));
/* -----------------------------------------------------------------------------
- Stable Pointer PrimOps.
+ Stable Name / Stable Pointer PrimOps
-------------------------------------------------------------------------- */
-#ifndef PAR
-
-extern StgPtr *stable_ptr_table;
-extern StgPtr *stable_ptr_free;
-#define deRefStablePtrZh(r,sp) (r=stable_ptr_table[(sp)])
-#define eqStablePtrZh(r,sp1,sp2) (r=(sp1==sp2))
-
-#define freeStablePointer(stable_ptr) \
- { \
- stable_ptr_table[stable_ptr] = (P_)stable_ptr_free; \
- stable_ptr_free = &stable_ptr_table[stable_ptr]; \
- }
-
-EF_(makeStablePtrZh_fast);
-
-#else /* PAR */
-#define deRefStablePtrZh(ri,sp) \
-do { \
- fflush(stdout); \
- fprintf(stderr, "deRefStablePtr#: no stable pointer support.\n");\
- stg_exit(EXIT_FAILURE); \
-} while(0)
-
-#define eqStablePtrZh(ri,sp1,sp2) \
-do { \
- fflush(stdout); \
- fprintf(stderr, "eqStablePtr#: no stable pointer support.\n"); \
- stg_exit(EXIT_FAILURE); \
-} while(0)
-
-#define makeStablePtrZh(stablePtr,liveness,unstablePtr) \
-do { \
- fflush(stdout); \
- fprintf(stderr, "makeStablePtr#: no stable pointer support.\n");\
- EXIT(EXIT_FAILURE); \
-} while(0)
-
-#define freeStablePtrZh(stablePtr,liveness,unstablePtr) \
-do { \
- fflush(stdout); \
- fprintf(stderr, "makeStablePtr#: no stable pointer support.\n");\
- EXIT(EXIT_FAILURE); \
-} while(0)
-#endif
+EXTFUN_RTS(makeStableNamezh_fast);
+
+#define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn)
+#define eqStableNamezh(r,sn1,sn2) \
+ (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
+
+#define makeStablePtrzh(r,a) \
+ r = RET_STGCALL1(StgStablePtr,getStablePtr,a)
+
+#define deRefStablePtrzh(r,sp) do { \
+ ASSERT(stable_ptr_table[stgCast(StgWord,sp) & ~STABLEPTR_WEIGHT_MASK].weight > 0); \
+ r = stable_ptr_table[stgCast(StgWord,sp) & ~STABLEPTR_WEIGHT_MASK].addr; \
+} while (0);
+
+#define eqStablePtrzh(r,sp1,sp2) \
+ (r = ((stgCast(StgWord,sp1) & ~STABLEPTR_WEIGHT_MASK) == (stgCast(StgWord,sp2) & ~STABLEPTR_WEIGHT_MASK)))
/* -----------------------------------------------------------------------------
- Parallel PrimOps.
+ Concurrency/Exception PrimOps.
-------------------------------------------------------------------------- */
-EF_(forkZh_fast);
-EF_(killThreadZh_fast);
-EF_(seqZh_fast);
+EXTFUN_RTS(forkzh_fast);
+EXTFUN_RTS(yieldzh_fast);
+EXTFUN_RTS(killThreadzh_fast);
+EXTFUN_RTS(seqzh_fast);
+EXTFUN_RTS(blockAsyncExceptionszh_fast);
+EXTFUN_RTS(unblockAsyncExceptionszh_fast);
+
+#define myThreadIdzh(t) (t = CurrentTSO)
+
+extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2);
+
+/* ------------------------------------------------------------------------
+ Parallel PrimOps
+
+ A par in the Haskell code is ultimately translated to a parzh macro
+ (with a case wrapped around it to guarantee that the macro is actually
+ executed; see compiler/prelude/PrimOps.lhs)
+ In GUM and SMP we only add a pointer to the spark pool.
+ In GranSim we call an RTS fct, forwarding additional parameters which
+ supply info on granularity of the computation, size of the result value
+ and the degree of parallelism in the sparked expression.
+ ---------------------------------------------------------------------- */
+
+#if defined(GRAN)
+//@cindex _par_
+#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) \
+ parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,1)
+
+//@cindex _parAtAbs_
+#define parAtAbszh(r,node,proc,identifier,gran_info,size_info,par_info,rest) \
+ parAT(r,node,proc,identifier,gran_info,size_info,par_info,rest,2)
+
+//@cindex _parAtRel_
+#define parAtRelzh(r,node,proc,identifier,gran_info,size_info,par_info,rest) \
+ parAT(r,node,proc,identifier,gran_info,size_info,par_info,rest,3)
+
+//@cindex _parAtForNow_
+#define parAtForNowzh(r,node,where,identifier,gran_info,size_info,par_info,rest) \
+ parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,0)
+
+#define parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,local) \
+{ \
+ if (closure_SHOULD_SPARK((StgClosure*)node)) { \
+ rtsSparkQ result; \
+ PEs p; \
+ \
+ STGCALL6(newSpark, node,identifier,gran_info,size_info,par_info,local); \
+ switch (local) { \
+ case 2: p = where; /* parAtAbs means absolute PE no. expected */ \
+ break; \
+ case 3: p = CurrentProc+where; /* parAtRel means rel PE no. expected */\
+ break; \
+ default: p = where_is(where); /* parAt means closure expected */ \
+ break; \
+ } \
+ /* update GranSim state according to this spark */ \
+ STGCALL3(GranSimSparkAtAbs, result, (I_)p, identifier); \
+ } \
+}
+
+//@cindex _parLocal_
+#define parLocalzh(r,node,identifier,gran_info,size_info,par_info,rest) \
+ 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) \
+ parAny(r,node,rest,identifier,gran_info,size_info,par_info,0)
+
+#define parAny(r,node,rest,identifier,gran_info,size_info,par_info,local) \
+{ \
+ if (closure_SHOULD_SPARK((StgClosure*)node)) { \
+ rtsSpark *result; \
+ result = RET_STGCALL6(rtsSpark*, newSpark, \
+ node,identifier,gran_info,size_info,par_info,local);\
+ STGCALL1(add_to_spark_queue,result); \
+ STGCALL2(GranSimSpark, local,(P_)node); \
+ } \
+}
+
+#define copyablezh(r,node) \
+ /* copyable not yet implemented!! */
+
+#define noFollowzh(r,node) \
+ /* noFollow not yet implemented!! */
+
+#elif defined(SMP) || defined(PAR)
+
+#define parzh(r,node) \
+{ \
+ extern unsigned int context_switch; \
+ if (closure_SHOULD_SPARK((StgClosure *)node) && \
+ SparkTl < SparkLim) { \
+ *SparkTl++ = (StgClosure *)(node); \
+ } \
+ r = context_switch = 1; \
+}
+#else /* !GRAN && !SMP && !PAR */
+#define parzh(r,node) r = 1
+#endif
-/* Hmm, I'll think about these later. */
/* -----------------------------------------------------------------------------
Pointer equality
-------------------------------------------------------------------------- */
ToDo: follow indirections.
*/
-#define reallyUnsafePtrEqualityZh(r,a,b) r=((StgPtr)(a) == (StgPtr)(b))
+#define reallyUnsafePtrEqualityzh(r,a,b) r=((StgPtr)(a) == (StgPtr)(b))
/* -----------------------------------------------------------------------------
Weak Pointer PrimOps.
-------------------------------------------------------------------------- */
-#ifndef PAR
+EXTFUN_RTS(mkWeakzh_fast);
+EXTFUN_RTS(finalizzeWeakzh_fast);
-EF_(mkWeakZh_fast);
-EF_(deRefWeakZh_fast);
-#define sameWeakZh(w1,w2) ((w1)==(w2))
+#define deRefWeakzh(code,val,w) \
+ if (((StgWeak *)w)->header.info == &stg_WEAK_info) { \
+ code = 1; \
+ val = (P_)((StgWeak *)w)->value; \
+ } else { \
+ code = 0; \
+ val = (P_)w; \
+ }
+
+#define sameWeakzh(w1,w2) ((w1)==(w2))
-#endif
/* -----------------------------------------------------------------------------
Foreign Object PrimOps.
-------------------------------------------------------------------------- */
-#ifndef PAR
-
#define ForeignObj_CLOSURE_DATA(c) (((StgForeignObj *)c)->data)
-EF_(makeForeignObjZh_fast);
+#define foreignObjToAddrzh(r,fo) r=ForeignObj_CLOSURE_DATA(fo)
+#define touchzh(o) /* nothing */
-#define writeForeignObjZh(res,datum) \
- (ForeignObj_CLOSURE_DATA(res) = (P_)(datum))
+EXTFUN_RTS(mkForeignObjzh_fast);
-#define eqForeignObj(f1,f2) ((f1)==(f2))
+#define writeForeignObjzh(res,datum) \
+ (ForeignObj_CLOSURE_DATA(res) = (P_)(datum))
+#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)
+#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
/* -----------------------------------------------------------------------------
+ Constructor tags
+ -------------------------------------------------------------------------- */
+
+#define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info))
+
+/* 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.
-------------------------------------------------------------------------- */
#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
+#endif /* PRIMOPS_H */
projects / ghc-hetmet.git / blobdiff