/* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.44 2000/01/13 14:34:00 hwloidl Exp $
+ * $Id: PrimOps.h,v 1.53 2000/05/10 11:02:00 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
#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= ((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]
#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 writeWord64OffAddrzh(a,i,v) ((LW_ *)(a))[i] = (v)
#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))
+#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.
-------------------------------------------------------------------------- */
#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 unsafeFreezzeByteArrayzh(r,a) r=(a)
-#define unsafeThawByteArrayzh(r,a) r=(a)
EF_(unsafeThawArrayzh_fast);
#define isEmptyMVarzh(r,a) r=(I_)((GET_INFO((StgMVar*)(a))) == &EMPTY_MVAR_info )
EF_(newMVarzh_fast);
EF_(takeMVarzh_fast);
+EF_(tryTakeMVarzh_fast);
EF_(putMVarzh_fast);
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
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)
-// hash coding changed from 2.10 to 4.00
-#define parzh(r,node) parZh(r,node)
-
-#define parZh(r,node) \
- PARZh(r,node,1,0,0,0,0,0)
+//@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) \
- parATZh(r,node,where,identifier,gran_info,size_info,par_info,rest,1)
+ 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) \
- parATZh(r,node,proc,identifier,gran_info,size_info,par_info,rest,2)
+ 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) \
- parATZh(r,node,proc,identifier,gran_info,size_info,par_info,rest,3)
+ 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) \
- parATZh(r,node,where,identifier,gran_info,size_info,par_info,rest,0)
+ parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,0)
-#define parATZh(r,node,where,identifier,gran_info,size_info,par_info,rest,local) \
-{ \
- rtsSparkQ result; \
- if (closure_SHOULD_SPARK((StgClosure*)node)) { \
+#define parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,local) \
+{ \
+ if (closure_SHOULD_SPARK((StgClosure*)node)) { \
rtsSparkQ result; \
- STGCALL6(newSpark, node,identifier,gran_info,size_info,par_info,local); \
- if (local==2) { /* special case for parAtAbs */ \
- STGCALL3(GranSimSparkAtAbs, result,(I_)where,identifier);\
- } else if (local==3) { /* special case for parAtRel */ \
- STGCALL3(GranSimSparkAtAbs, result,(I_)(CurrentProc+where),identifier); \
- } else { \
- STGCALL3(GranSimSparkAt, result,where,identifier); \
- } \
- } \
+ 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) \
- PARZh(r,node,rest,identifier,gran_info,size_info,par_info,1)
+ 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) \
- PARZh(r,node,rest,identifier,gran_info,size_info,par_info,0)
+ PAR(r,node,rest,identifier,gran_info,size_info,par_info,0)
-#define PARZh(r,node,rest,identifier,gran_info,size_info,par_info,local) \
+#define PAR(r,node,rest,identifier,gran_info,size_info,par_info,local) \
{ \
if (closure_SHOULD_SPARK((StgClosure*)node)) { \
rtsSpark *result; \
#define noFollowzh(r,node) \
/* noFollow not yet implemented!! */
-#endif /* GRAN */
-
-#if 0
-
-# if defined(GRAN)
-/* ToDo: Use a parallel ticky macro for this */
-# define COUNT_SPARK(node) { (CurrentTSO->gran.globalsparks)++; sparksCreated++; }
-# elif defined(PAR)
-# define COUNT_SPARK(node) { (CurrentTSO->par.globalsparks)++; sparksCreated++; }
-# endif
+#elif defined(SMP) || defined(PAR)
-/*
- Note that we must bump the required thread count NOW, rather
- than when the thread is actually created.
-
- forkzh not needed any more; see ghc/rts/PrimOps.hc
-*/
-#define forkzh(r,liveness,node) \
-{ \
- extern nat context_switch; \
- while (pending_sparks_tl[REQUIRED_POOL] == pending_sparks_lim[REQUIRED_POOL]) \
- DO_YIELD((liveness << 1) | 1); \
- if (closure_SHOULD_SPARK((StgClosure *)node)) { \
- *pending_sparks_tl[REQUIRED_POOL]++ = (P_)(node); \
- } else { \
- sparksIgnored++; \
- } \
- context_switch = 1; \
-}
-
-// old version of par (previously used in GUM
-
-#define parzh(r,node) \
-{ \
- extern nat context_switch; \
- COUNT_SPARK(node); \
- if (closure_SHOULD_SPARK((StgClosure *)node) && \
- pending_sparks_tl[ADVISORY_POOL] < pending_sparks_lim[ADVISORY_POOL]) {\
- *pending_sparks_tl[ADVISORY_POOL]++ = (StgClosure *)(node); \
- } else { \
- sparksIgnored++; \
- } \
- r = context_switch = 1; \
-}
-#endif /* 0 */
-
-#if 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 = 1; \
+ r = context_switch = 1; \
}
-#else
+#else /* !GRAN && !SMP && !PAR */
#define parzh(r,node) r = 1
#endif
-/* Hmm, I'll think about these later. */
/* -----------------------------------------------------------------------------
Pointer equality
-------------------------------------------------------------------------- */
#define ForeignObj_CLOSURE_DATA(c) (((StgForeignObj *)c)->data)
-EF_(makeForeignObjzh_fast);
+EF_(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 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