/* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.37 1999/08/25 16:11:43 simonmar Exp $
+ * $Id: PrimOps.h,v 1.68 2000/12/04 12:31:20 simonmar Exp $
*
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
*
* Macros for primitive operations in STG-ish C code.
*
#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 = ((P_)tmp)[i]; \
+ } while (0)
+
+#define indexDoubleOffClosurezh(r,a,i) \
+ do { StgClosure* tmp = (StgClosure*)(a); \
+ CHASE_INDIRECTIONS(tmp); \
+ r = PK_DBL(((P_)tmp + i); \
+ } while (0)
+
+#define indexPtrOffClosurezh(r,a,i) \
+ do { StgClosure* tmp = (StgClosure*)(a); \
+ CHASE_INDIRECTIONS(tmp); \
+ r = ((P_ *)tmp)[i]; \
+ } while (0) \
+
+#define setWordOffClosurezh(r,a,i,b) \
+ do { StgClosure* tmp = (StgClosure*)(a); \
+ CHASE_INDIRECTIONS(tmp); \
+ ((P_)tmp)[i] = b; \
+ r = (P_)tmp; \
+ } while (0)
+
+#define setDoubleOffClosurezh(r,a,i,b) \
+ do { StgClosure* tmp = (StgClosure*)(a); \
+ CHASE_INDIRECTIONS(tmp); \
+ ASSIGN_DBL((P_)tmp + i, b); \
+ r = (P_)tmp; \
+ } while (0)
+
+#define setPtrOffClosurezh(r,a,i,b) \
+ do { StgClosure* tmp = (StgClosure*)(a); \
+ CHASE_INDIRECTIONS(tmp); \
+ ((P_ *)tmp)[i] = b; \
+ r = (P_)tmp; \
+ } while (0)
+
+#else
+
+#endif
+
+/* -----------------------------------------------------------------------------
Comparison PrimOps.
-------------------------------------------------------------------------- */
#define mulIntCzh(r,c,a,b) \
{ \
- __asm__("xor %1,%1\n\t \
+ __asm__("xorl %1,%1\n\t \
imull %2,%3\n\t \
jno 1f\n\t \
movl $1,%1\n\t \
#define int2Addrzh(r,a) r=(A_)(a)
#define addr2Intzh(r,a) r=(I_)(a)
-#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 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]
#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 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 writeWord64OffAddrzh(a,i,v) ((LW_ *)(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]
+#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.
-------------------------------------------------------------------------- */
(r) = RET_PRIM_STGCALL2(I_,mpz_cmp_si,&arg,i); \
}
+/* 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 decodings */
-EF_(decodeFloatzh_fast);
-EF_(decodeDoublezh_fast);
+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; \
- I_ aa; \
- StgWord64 res; \
- \
- 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; \
+#define integerToWord64zh(r, sa,da) \
+{ unsigned long int* d; \
+ I_ s; \
+ StgWord64 res; \
+ \
+ d = (unsigned long int *) (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; \
+ } \
+ (r) = res; \
}
-#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; \
+#define integerToInt64zh(r, sa,da) \
+{ unsigned long int* d; \
+ I_ s; \
+ StgInt64 res; \
+ \
+ d = (unsigned long int *) (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; \
+ } \
+ } \
+ (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.
*/
#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)
/* 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 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 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]
-#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,
#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 unsafeFreezzeByteArrayzh(r,a) r=(a)
-#define unsafeThawByteArrayzh(r,a) r=(a)
-EF_(unsafeThawArrayzh_fast);
+EXTFUN_RTS(unsafeThawArrayzh_fast);
#define sizzeofByteArrayzh(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(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(newArrayzh_fast);
/* encoding and decoding of floats/doubles. */
/* 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 (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);
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 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(tryTakeMVarzh_fast);
+EXTFUN_RTS(putMVarzh_fast);
/* -----------------------------------------------------------------------------
Delay/Wait PrimOps
-------------------------------------------------------------------------- */
-EF_(waitReadzh_fast);
-EF_(waitWritezh_fast);
-EF_(delayzh_fast);
+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));
#ifndef PAR
-EF_(makeStableNamezh_fast);
+EXTFUN_RTS(makeStableNamezh_fast);
#define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn)
r = RET_STGCALL1(StgStablePtr,getStablePtr,a)
#define deRefStablePtrzh(r,sp) do { \
- ASSERT(stable_ptr_table[sp & ~STABLEPTR_WEIGHT_MASK].weight > 0); \
- r = stable_ptr_table[sp & ~STABLEPTR_WEIGHT_MASK].addr; \
+ 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 = ((sp1 & ~STABLEPTR_WEIGHT_MASK) == (sp2 & ~STABLEPTR_WEIGHT_MASK)))
+ (r = ((stgCast(StgWord,sp1) & ~STABLEPTR_WEIGHT_MASK) == (stgCast(StgWord,sp2) & ~STABLEPTR_WEIGHT_MASK)))
#endif
/* -----------------------------------------------------------------------------
- Parallel PrimOps.
+ Concurrency/Exception PrimOps.
-------------------------------------------------------------------------- */
-EF_(forkzh_fast);
-EF_(yieldzh_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);
-/* Hmm, I'll think about these later. */
+/* ------------------------------------------------------------------------
+ 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) PAR(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) \
+ PAR(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)
+
+#define PAR(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
+
/* -----------------------------------------------------------------------------
Pointer equality
-------------------------------------------------------------------------- */
#ifndef PAR
-EF_(mkWeakzh_fast);
-EF_(finalizzeWeakzh_fast);
+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 { \
#define ForeignObj_CLOSURE_DATA(c) (((StgForeignObj *)c)->data)
-EF_(makeForeignObjzh_fast);
+#define foreignObjToAddrzh(r,fo) r=ForeignObj_CLOSURE_DATA(fo)
+#define touchzh(o) /* nothing */
+
+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
+
/* -----------------------------------------------------------------------------
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. */
/* -----------------------------------------------------------------------------
#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
+#endif /* PRIMOPS_H */
projects / ghc-hetmet.git / blobdiff