/* #define MARK_REG_MAP -- Must be done on command line for threaded code */
#include "SMinternal.h"
#include "SMmarkDefs.h"
+
+#if defined(GRAN)
+extern P_ ret_MRoot, ret_Mark;
+#endif
\end{code}
Define appropriate variables as potential register variables.
\begin{code}
-#ifdef PAR
+#if defined(PAR) || defined(GRAN)
#define SPEC_RBH_PRStart_N_CODE(ptrs) \
STGFUN(CAT2(_PRStart_RBH_,ptrs)) \
{ \
In code for revertible black holes with underlying @SPEC@ types.
\begin{code}
-#ifdef PAR
+#if defined(PAR) || defined(GRAN)
#define SPEC_RBH_PRIn_N_CODE(ptrs) \
STGFUN(CAT2(_PRIn_RBH_,ptrs)) \
{ \
\end{code}
-Malloc Ptrs are in the sequential world only.
+Foreign Objs are in the non-parallel world only.
\begin{code}
#ifndef PAR
-STGFUN(_PRStart_MallocPtr)
+STGFUN(_PRStart_ForeignObj)
{
FUNBEGIN;
if (IS_MARK_BIT_SET(Mark)) {
DEBUG_PR_MARKED;
} else
- INIT_MARK_NODE("MallocPtr ",0);
+ INIT_MARK_NODE("ForeignObj ",0);
JUMP_MARK_RETURN;
FUNEND;
}
\begin{code}
-#ifdef PAR
+#if defined(PAR) || defined(GRAN)
STGFUN(_PRStart_RBH_N)
{
{
FUNBEGIN;
DEBUG_PR_IND;
+ GC_SHORT_IND(); /* ticky: record that we shorted an indirection */
+
Mark = (P_) IND_CLOSURE_PTR(Mark);
JUMP_MARK;
FUNEND;
``Permanent indirection''---used in profiling. Works basically
like @_PRStart_1@ (one pointer).
\begin{code}
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING) || defined(TICKY_TICKY)
+
STGFUN(_PRStart_PI)
{
FUNBEGIN;
-/* This test would be here if it really was like a PRStart_1.
- But maybe it is not needed because a PI cannot have two
- things pointing at it (so no need to mark it), because
- they are only created in exactly one place in UpdatePAP.
- ??? WDP 95/07
if (IS_MARK_BIT_SET(Mark)) {
DEBUG_PR_MARKED;
JUMP_MARK_RETURN;
} else {
-*/
INIT_MARK_NODE("PI ",1);
/* the "1" above is dodgy (i.e. wrong), but it is never
used except in debugging info. ToDo??? WDP 95/07
*/
INIT_MSTACK(PERM_IND_CLOSURE_PTR);
-/* } */
+ }
FUNEND;
}
+
STGFUN(_PRIn_PI)
{
FUNBEGIN;
*/
FUNEND;
}
-#endif
+
+#endif /* PROFILING or TICKY */
\end{code}
Marking a ``selector closure'': This is a size-2 SPEC thunk that
or ``on the way back up'' (\tr{_PRIn_Selector})?} Answer: probably on
the way down. Downside: we are flummoxed by indirections, so we'll
have to wait until the {\em next} major GC to do the selections (after
-the indirections are sorted out in this GC). But the downside of
+the indirections are shorted out in this GC). But the downside of
doing selections on the way back up is that we are then in a world of
reversed pointers, and selecting a reversed pointer---we've see this
on selectors for very recursive structures---is a total disaster.
(WDP 94/12)
\begin{code}
-#if defined(_GC_DEBUG)
+#if defined(DEBUG)
#define IF_GC_DEBUG(x) x
#else
#define IF_GC_DEBUG(x) /*nothing*/
#endif
-/* _PRStartSelector_<n> is a (very) glorified _PRStart_1 */
+#if !defined(CONCURRENT)
+# define NOT_BLACKHOLING (! RTSflags.GcFlags.lazyBlackHoling)
+#else
+# define NOT_BLACKHOLING 0
+#endif
-#if 0
-/* testing */
-#define MARK_SELECTOR(n) \
-STGFUN(CAT2(_PRStartSelector_,n)) \
-{ \
- P_ maybe_con; \
- FUNBEGIN; \
- \
- /* must be a SPEC 2 1 closure */ \
- ASSERT(INFO_SIZE(INFO_PTR(Mark)) == 2); \
- ASSERT(INFO_NoPTRS(INFO_PTR(Mark)) == 1); \
- ASSERT(MIN_UPD_SIZE == 2); /* otherwise you are hosed */ \
- \
- JMP_(_PRStart_1); \
- \
- FUNEND; \
-}
-#endif /* 0 */
+/* _PRStartSelector_<n> is a (very) glorified _PRStart_1 */
#define MARK_SELECTOR(n) \
STGFUN(CAT2(_PRStartSelector_,n)) \
maybe_con = (P_) *(Mark + _FHS); \
\
IF_GC_DEBUG( \
- if (SM_trace & 2) { \
- fprintf(stderr, "Start Selector %d: 0x%lx, info 0x%lx, size %ld, ptrs %ld, maybe_con 0x%lx, marked? 0x%%lx, info 0x%lx", \
+ if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) { \
+ fprintf(stderr, "Start Selector %d: 0x%lx, info 0x%lx, size %ld, ptrs %ld, maybe_con 0x%lx, info 0x%lx", \
(n), Mark, INFO_PTR(Mark), INFO_SIZE(INFO_PTR(Mark)), \
INFO_NoPTRS(INFO_PTR(Mark)), \
maybe_con, /*danger:IS_MARK_BIT_SET(maybe_con),*/ \
INFO_SIZE(INFO_PTR(maybe_con)), \
INFO_NoPTRS(INFO_PTR(maybe_con))); \
if (INFO_TAG(INFO_PTR(maybe_con)) >=0) { \
- /* int i; */ \
- /* for (i = 0; i < INFO_SIZE(INFO_PTR(maybe_con)); i++) { */ \
- /* fprintf(stderr, ", 0x%lx", maybe_con[_FHS + i]); */ \
- /*}*/ \
fprintf(stderr, "=> 0x%lx", maybe_con[_FHS + (n)]); \
} \
fprintf(stderr, "\n"); \
\
if (IS_STATIC(INFO_PTR(maybe_con)) /* static: cannot chk mark bit */\
|| IS_MARK_BIT_SET(maybe_con) /* been here: may be mangled */ \
- || INFO_TAG(INFO_PTR(maybe_con)) < 0) /* not in WHNF */ \
+ || INFO_TAG(INFO_PTR(maybe_con)) < 0 /* not in WHNF */ \
+ || NOT_BLACKHOLING /* see "price of laziness" paper */ \
+ || (! RTSflags.GcFlags.doSelectorsAtGC )) \
/* see below for OLD test we used here (WDP 95/04) */ \
/* ToDo: decide WHNFness another way? */ \
JMP_(_PRStart_1); \
/* ASSERT((n) < INFO_SIZE(INFO_PTR(maybe_con))); not true if static */ \
\
/* OK, it is evaluated: behave just like an indirection */ \
+ GC_SEL_MAJOR(); /* ticky-ticky */ \
\
Mark = (P_) (maybe_con[_FHS + (n)]); \
/* Mark now has the result of the selection */ \
{
FUNBEGIN;
DEBUG_PR_CONST;
+
+#ifndef TICKY_TICKY
+ /* normal stuff */
Mark = (P_) CONST_STATIC_CLOSURE(INFO_PTR(Mark));
+
+#else /* TICKY */
+ if (IS_MARK_BIT_SET(Mark)) {
+ DEBUG_PR_MARKED;
+ } else {
+ if (!AllFlags.doUpdEntryCounts) {
+
+ GC_COMMON_CONST(); /* ticky */
+
+ Mark = (P_) CONST_STATIC_CLOSURE(INFO_PTR(Mark));
+
+ } else { /* no commoning */
+ INIT_MARK_NODE("CONST ",0);
+ }
+ }
+#endif /* TICKY */
+
JUMP_MARK_RETURN;
FUNEND;
}
\begin{code}
STGFUN(_PRStart_CharLike)
{
+#ifdef TICKY_TICKY
+ I_ val;
+#endif
+
FUNBEGIN;
+
DEBUG_PR_CHARLIKE;
+
+#ifndef TICKY_TICKY
+ /* normal stuff */
+
Mark = (P_) CHARLIKE_CLOSURE(CHARLIKE_VALUE(Mark));
+
+#else /* TICKY */
+
+ if (IS_MARK_BIT_SET(Mark)) {
+ DEBUG_PR_MARKED;
+ } else {
+ val = CHARLIKE_VALUE(Mark);
+
+ if (!AllFlags.doUpdEntryCounts) {
+ GC_COMMON_CHARLIKE(); /* ticky */
+
+ INFO_PTR(Mark) = (W_) Ind_info;
+ IND_CLOSURE_PTR(Mark) = (W_) CHARLIKE_CLOSURE(val);
+ Mark = (P_) IND_CLOSURE_PTR(Mark);
+
+ } else { /* no commoning */
+ INIT_MARK_NODE("CHAR ",0);
+ }
+ }
+#endif /* TICKY */
+
JUMP_MARK_RETURN;
FUNEND;
}
if (IS_MARK_BIT_SET(Mark)) {
DEBUG_PR_MARKED;
} else {
- val = INTLIKE_VALUE(Mark);
+ val = INTLIKE_VALUE(Mark);
+
+ if (val >= MIN_INTLIKE
+ && val <= MAX_INTLIKE
+#ifdef TICKY_TICKY
+ && !AllFlags.doUpdEntryCounts
+#endif
+ ) {
+ DEBUG_PR_INTLIKE_TO_STATIC;
+ GC_COMMON_INTLIKE(); /* ticky */
- if ((val <= MAX_INTLIKE) && (val >= MIN_INTLIKE)) {
- DEBUG_PR_INTLIKE_TO_STATIC;
INFO_PTR(Mark) = (W_) Ind_info;
IND_CLOSURE_PTR(Mark) = (W_) INTLIKE_CLOSURE(val);
Mark = (P_) IND_CLOSURE_PTR(Mark);
- } else {
- /* out of range of static closures */
- DEBUG_PR_INTLIKE_IN_HEAP;
+
+ } else { /* out of range of static closures */
+ DEBUG_PR_INTLIKE_IN_HEAP;
+#ifdef TICKY_TICKY
+ if (!AllFlags.doUpdEntryCounts) GC_COMMON_INTLIKE_FAIL();
+#endif
INIT_MARK_NODE("INT ",0);
- }
+ }
}
JUMP_MARK_RETURN;
FUNEND;
}
\end{code}
-CHANGE THIS FOR THE @COMMON_ITBLS@ WORLD!
-
-\begin{code}
-#if defined(GCgn)
-
-/* Marking an OldGen root -- treat as indirection if it references the old generation */
-
-STGFUN(_PRStart_OldRoot)
-{
- P_ oldroot;
-
- FUNBEGIN;
- oldroot = (P_) IND_CLOSURE_PTR(Mark);
-
- if (oldroot <= HeapLim) /* does the root reference the old generation ? */
- {
- DEBUG_PR_OLDIND;
- Mark = oldroot; /* short circut if the old generation root */
- JUMP_MARK; /* references an old generation closure */
- }
-
- else
- {
- INIT_MARK_NODE("OldRoot",1); /* oldroot to new generation */
- INIT_MSTACK(SPEC_CLOSURE_PTR); /* treat as _PRStart_1 */
- }
- FUNEND;
-}
-
-#endif /* GCgn */
-
-\end{code}
-
Special error routine, used for closures which should never call their
``in'' code.
I_ cts_size;
FUNBEGIN;
+
+ /* ToDo: ASSERT(sanityChk_StkO(Mark)); ??? */
+
if (IS_MARK_BIT_SET(Mark)) {
DEBUG_PR_MARKED;
JUMP_MARK_RETURN;
%
%****************************************************************************
-A CAF is shorted out as if it is an indirection.
+A CAF is shorted out as if it were an indirection.
The CAF reference is explicitly updated by the garbage collector.
\begin{code}
{
FUNBEGIN;
DEBUG_PR_CAF;
- Mark = (P_) IND_CLOSURE_PTR(Mark);
- JUMP_MARK;
- FUNEND;
-}
-
-#if 0 /* Code to avoid explicit updating of CAF references */
- /* We need auxiliary mark and update reference info table */
-
-CAF_MARK_UPD_ITBL(Caf_Mark_Upd_info,const);
-
-/* Start marking a CAF -- special mark upd info table */
-/* Change to marking state and mark reference */
-
-STGFUN(_PRStart_Caf)
-{
- FUNBEGIN;
- if (IS_MARK_BIT_SET(Mark)) {
- DEBUG_PR_MARKED;
- JUMP_MARK_RETURN;
- } else {
- INIT_MARK_NODE("CAF ",1);
- INIT_MSTACK(IND_CLOSURE_PTR2);
- }
- FUNEND;
-}
-
-/* Completed marking a CAF -- special mark upd info table */
-/* Change info table back to normal CAF info, return reference (Mark) */
-
-STGFUN(_PRInLast_Caf)
-{
- P_ temp;
+ GC_SHORT_CAF(); /* ticky */
- FUNBEGIN;
- DEBUG_PRLAST_CAF;
- SET_INFO_PTR(MStack, Caf_info); /* normal marked CAF */
-
- /* Like POP_MSTACK */
- temp = MStack;
- MStack = (P_) IND_CLOSURE_PTR(temp);
- IND_CLOSURE_PTR(temp) = (W_) Mark;
-
- /* Mark left unmodified so CAF reference is returned */
- JUMP_MARK_RETURN;
- FUNEND;
-}
-
-/* Marking a CAF currently being marked -- special mark upd info table */
-/* Just return CAF as if marked -- wont be shorted out */
-/* Marking once reference marked and updated -- normal CAF info table */
-/* Return reference to short CAF out */
-
-STGFUN(_PRStart_Caf)
-{
- FUNBEGIN;
- if (IS_MARK_BIT_SET(Mark)) {
- DEBUG_PR_MARKING_CAF;
- JUMP_MARK_RETURN;
- } else {
- DEBUG_PR_MARKED_CAF;
Mark = (P_) IND_CLOSURE_PTR(Mark);
- JUMP_MARK_RETURN;
- }
+ JUMP_MARK;
FUNEND;
}
-
-#define DEBUG_PR_MARKED_CAF \
- if (SM_trace & 8) \
- fprintf(stderr, "PRMark CAF (Marked): 0x%lx -> 0x%lx, info 0x%lx\n", \
- Mark, IND_CLOSURE_PTR(Mark), INFO_PTR(Mark))
-
-#define DEBUG_PR_MARKING_CAF \
- if (SM_trace & 8) \
- fprintf(stderr, "PRMark CAF (Marking): 0x%lx -> 0x%lx, info 0x%lx\n", \
- Mark, Mark, INFO_PTR(Mark))
-
-#define DEBUG_PRLAST_CAF \
- if (SM_trace & 8) \
- fprintf(stderr, "PRRet Last (CAF ): 0x%lx -> 0x%lx, info 0x%lx -> 0x%lx ptrs 1\n", \
- MStack, Mark, INFO_PTR(MStack), Caf_info)
-
-#endif /* 0 */
-
\end{code}
%****************************************************************************
FUNBEGIN;
fprintf(stderr,"Called _Dummy_PRReturn_entry\nShould never occur!\n");
abort();
- return(0); /* won't happen; quiets compiler warnings */
FUNEND;
}
+/* various ways to call _Dummy_PRReturn_entry: */
+
+INTFUN(_PRMarking_MarkNextRoot_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
+#ifdef CONCURRENT
+INTFUN(_PRMarking_MarkNextSpark_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
+#endif
+#ifdef PAR
+INTFUN(_PRMarking_MarkNextGA_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
+#endif
+# if 1 /* !defined(CONCURRENT) */ /* HWL */
+INTFUN(_PRMarking_MarkNextAStack_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
+INTFUN(_PRMarking_MarkNextBStack_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
+# endif
+INTFUN(_PRMarking_MarkNextCAF_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
+
+#if defined(GRAN)
+INTFUN(_PRMarking_MarkNextEvent_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
+INTFUN(_PRMarking_MarkNextClosureInFetchBuffer_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
+#endif
+
+/* end of various ways to call _Dummy_PRReturn_entry */
+
EXTFUN(_PRMarking_MarkNextRoot);
EXTFUN(_PRMarking_MarkNextCAF);
#ifdef PAR
EXTFUN(_PRMarking_MarkNextGA);
#else
+# if 1 /* !defined(CONCURRENT) */ /* HWL */
EXTFUN(_PRMarking_MarkNextAStack);
EXTFUN(_PRMarking_MarkNextBStack);
+# endif
#endif /* not parallel */
CAT_DECLARE(Dummy_PrReturn,INTERNAL_KIND,"DUMMY_PRRETURN","DUMMY_PRRETURN")
DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextRoot_closure,
_PRMarking_MarkNextRoot_info,
_PRMarking_MarkNextRoot,
- _Dummy_PRReturn_entry);
+ _PRMarking_MarkNextRoot_entry);
#ifdef CONCURRENT
DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextSpark_closure,
_PRMarking_MarkNextSpark_info,
_PRMarking_MarkNextSpark,
- _Dummy_PRReturn_entry);
+ _PRMarking_MarkNextSpark_entry);
+#endif
+
+#if defined(GRAN)
+DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextEvent_closure,
+ _PRMarking_MarkNextEvent_info,
+ _PRMarking_MarkNextEvent,
+ _PRMarking_MarkNextEvent_entry);
+DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextClosureInFetchBuffer_closure,
+ _PRMarking_MarkNextClosureInFetchBuffer_info,
+ _PRMarking_MarkNextClosureInFetchBuffer,
+ _PRMarking_MarkNextClosureInFetchBuffer_entry);
#endif
#ifdef PAR
DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextGA_closure,
_PRMarking_MarkNextGA_info,
_PRMarking_MarkNextGA,
- _Dummy_PRReturn_entry);
+ _PRMarking_MarkNextGA_entry);
#else
+# if 1 /* !defined(CONCURRENT) */ /* HWL */
DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextAStack_closure,
_PRMarking_MarkNextAStack_info,
_PRMarking_MarkNextAStack,
- _Dummy_PRReturn_entry);
+ _PRMarking_MarkNextAStack_entry);
DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextBStack_closure,
_PRMarking_MarkNextBStack_info,
_PRMarking_MarkNextBStack,
- _Dummy_PRReturn_entry);
-
+ _PRMarking_MarkNextBStack_entry);
+# endif
#endif /* PAR */
DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextCAF_closure,
_PRMarking_MarkNextCAF_info,
_PRMarking_MarkNextCAF,
- _Dummy_PRReturn_entry);
+ _PRMarking_MarkNextCAF_entry);
+
+extern P_ sm_roots_end; /* &roots[rootno] -- one beyond the end */
STGFUN(_PRMarking_MarkNextRoot)
{
- extern P_ sm_roots_end; /* &roots[rootno] -- one beyond the end */
-
FUNBEGIN;
/* Update root -- may have short circuited Ind */
*MRoot = (W_) Mark;
FUNEND;
}
-#ifdef CONCURRENT
+#if defined(CONCURRENT)
+# if !defined(GRAN)
+extern P_ sm_roots_end; /* PendingSparksTl[pool] */
+
STGFUN(_PRMarking_MarkNextSpark)
{
- extern P_ sm_roots_end; /* PendingSparksTl[pool] */
-
FUNBEGIN;
/* Update root -- may have short circuited Ind */
*MRoot = (W_) Mark;
JUMP_MARK;
FUNEND;
}
+#else /* GRAN */
+STGFUN(_PRMarking_MarkNextSpark)
+{
+ /* This is more similar to MarkNextGA than to the MarkNextSpark in
+ concurrent-but-not-gran land
+ NB: MRoot is a spark (with an embedded pointer to a closure) */
+ FUNBEGIN;
+ /* Update root -- may have short circuited Ind */
+ SPARK_NODE( ((sparkq) MRoot) ) = Mark;
+ MRoot = (P_) SPARK_NEXT( ((sparkq) MRoot) );
+
+ /* Is the next off the end */
+ if (MRoot == NULL)
+ RESUME_(miniInterpretEnd);
+
+ Mark = (P_) SPARK_NODE( ((sparkq) MRoot) );
+ JUMP_MARK;
+ FUNEND;
+}
+#endif /* GRAN */
+#endif /* CONCURRENT */
+\end{code}
+
+Note: Events are GranSim-only.
+Marking events is similar to marking GALA entries in parallel-land.
+The major difference is that depending on the type of the event we have
+to mark different field of the event (possibly several fields).
+Even worse, in the case of bulk fetching
+(@RTSflags.GranFlags.DoGUMMFetching@) we find a buffer of pointers to
+closures we have to mark (similar to sparks in concurrent-but-not-gransim
+setup).
+
+\begin{code}
+#if defined(GRAN)
+STGFUN(_PRMarking_MarkNextEvent)
+{
+ rtsBool found = rtsFalse;
+
+ FUNBEGIN;
+
+ /* First update the right component of the old event */
+ switch (EVENT_TYPE( ((eventq) MRoot) )) {
+ case CONTINUETHREAD:
+ case STARTTHREAD:
+ case RESUMETHREAD:
+ case MOVETHREAD:
+ EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark;
+ break;
+ case MOVESPARK:
+ SPARK_NODE(EVENT_SPARK( ((eventq) MRoot) )) = (P_) Mark;
+ break;
+ case FETCHNODE:
+ switch (EVENT_GC_INFO( ((eventq) MRoot) )) {
+ case 0:
+ EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark;
+ EVENT_GC_INFO( ((eventq) MRoot) ) = 1;
+ Mark = (P_) EVENT_NODE( ((eventq) MRoot) );
+ JUMP_MARK;
+ break;
+ case 1:
+ EVENT_NODE( ((eventq) MRoot) ) = (P_) Mark;
+ EVENT_GC_INFO( ((eventq) MRoot) ) = 0; /* reset flag */
+ break;
+ default:
+ fprintf(stderr,"PRMarking_MarkNextEvent: Illegal gc_info field of FETCHNODE event @ %#x\n",
+ ((eventq) MRoot) );
+ EXIT(EXIT_FAILURE);
+ }
+ break;
+ case FETCHREPLY:
+ switch (EVENT_GC_INFO( ((eventq) MRoot) )) {
+ case 0:
+ EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark;
+ EVENT_GC_INFO( ((eventq) MRoot) ) = 1;
+ /* In the case of packet fetching, EVENT_NODE(event) points to */
+ /* the packet (currently, malloced). The packet is just a list of */
+ /* closure addresses, with the length of the list at index 1 (the */
+ /* structure of the packet is defined in Pack.lc). */
+ if ( RTSflags.GranFlags.DoGUMMFetching ) {
+ P_ buffer = (P_) EVENT_NODE( ((eventq) MRoot) );
+ int size = (int) buffer[PACK_SIZE_LOCN];
+
+ /* was: for (i = PACK_HDR_SIZE; i <= size-1; i++) ... */
+ sm_roots_end = buffer + PACK_HDR_SIZE + size;
+ MRoot = (P_) buffer + PACK_HDR_SIZE;
+ ret_MRoot = MRoot;
+ Mark = (P_) *MRoot;
+ ret_Mark = Mark;
+ MStack = (P_) _PRMarking_MarkNextClosureInFetchBuffer_closure;
+ JUMP_MARK;
+ } else {
+ Mark = (P_) EVENT_NODE( ((eventq) MRoot) );
+ JUMP_MARK;
+ }
+ break;
+ case 1:
+ if ( RTSflags.GranFlags.DoGUMMFetching ) {
+ /* no update necessary; fetch buffers are malloced */
+ } else {
+ EVENT_NODE( ((eventq) MRoot) ) = (P_) Mark;
+ }
+ EVENT_GC_INFO( ((eventq) MRoot) ) = 0; /* reset flag */
+ break;
+ default:
+ fprintf(stderr,"PRMarking_MarkNextEvent: Illegal gc_info field of FETCHREPLY event @ %#x\n",
+ ((eventq) MRoot) );
+ EXIT(EXIT_FAILURE);
+ }
+ break;
+
+ case GLOBALBLOCK:
+ switch (EVENT_GC_INFO( ((eventq) MRoot) )) {
+ case 0:
+ EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark;
+ EVENT_GC_INFO( ((eventq) MRoot) ) = 1;
+ Mark = (P_) EVENT_NODE( ((eventq) MRoot) );
+ JUMP_MARK;
+ break;
+ break;
+ case 1:
+ EVENT_NODE( ((eventq) MRoot) ) = (P_) Mark;
+ EVENT_GC_INFO( ((eventq) MRoot) ) = 0; /* reset flag */
+ break;
+ default:
+ fprintf(stderr,"PRMarking_MarkNextEvent: Illegal gc_info field of GLOBALBLOCK event @ %#x\n",
+ ((eventq) MRoot) );
+ EXIT(EXIT_FAILURE);
+ }
+ break;
+ case UNBLOCKTHREAD:
+ EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark;
+ break;
+ case FINDWORK:
+ break;
+ default:
+ fprintf(stderr,"PRMarking_MarkNextEvent: Illegal gc_info field of FETCHNODE event @ %#x\n",
+ ((eventq) MRoot) );
+ EXIT(EXIT_FAILURE);
+ }
+
+ do {
+ MRoot = (P_) EVENT_NEXT( ((eventq) MRoot) );
+ /* Is the next off the end */
+ if (MRoot == NULL)
+ RESUME_(miniInterpretEnd);
+
+ switch (EVENT_TYPE( ((eventq) MRoot) )) {
+ case CONTINUETHREAD:
+ case STARTTHREAD:
+ case RESUMETHREAD:
+ case MOVETHREAD:
+ EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
+ Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
+ found = rtsTrue;
+ break;
+ case MOVESPARK:
+ EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
+ Mark = (P_) SPARK_NODE(EVENT_SPARK( ((eventq) MRoot) ));
+ found = rtsTrue;
+ break;
+ case FETCHNODE:
+ EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
+ Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
+ found = rtsTrue;
+ break;
+ case FETCHREPLY:
+ EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
+ Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
+ found = rtsTrue;
+ break;
+ case GLOBALBLOCK:
+ EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
+ Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
+ found = rtsTrue;
+ break;
+ case UNBLOCKTHREAD:
+ Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
+ found = rtsTrue;
+ break;
+ case FINDWORK:
+ found = rtsFalse;
+ break;
+ default:
+ fprintf(stderr,"Unknown event type %d (event @ %#x) in SMmarking_NextEvent\n",
+ EVENT_TYPE( ((eventq) MRoot) ), MRoot);
+ EXIT(EXIT_FAILURE);
+ }
+ } while (!found && MRoot!=NULL);
+
+ JUMP_MARK;
+
+ FUNEND;
+}
+
+STGFUN(_PRMarking_MarkNextClosureInFetchBuffer)
+{
+ FUNBEGIN;
+ /* Update root -- may have short circuited Ind */
+ *MRoot = Mark;
+
+ /* Is the next off the end */
+ if (++MRoot >= sm_roots_end) {
+ /* We know that marking a fetch buffer is only called from within
+ marking a FETCHREPLY event; we have saved the important
+ registers before that */
+ MRoot = ret_MRoot;
+ Mark = ret_Mark;
+ MStack = (P_) _PRMarking_MarkNextEvent_closure;
+ JUMP_MARK;
+ }
+
+ Mark = *MRoot;
+ JUMP_MARK;
+ FUNEND;
+}
#endif
#ifdef PAR
}
#else
-
STGFUN(_PRMarking_MarkNextAStack)
{
FUNBEGIN;
STGFUN(_PRMarking_MarkNextCAF)
{
FUNBEGIN;
- /* Update root -- may have short circuted Ind */
+
+ /* Update root -- may have short circuited Ind */
IND_CLOSURE_PTR(MRoot) = (W_) Mark;
MRoot = (P_) IND_CLOSURE_LINK(MRoot);
if (MRoot == 0)
RESUME_(miniInterpretEnd);
- Mark = (P_) IND_CLOSURE_PTR(MRoot);
- JUMP_MARK;
- FUNEND;
-}
-\end{code}
-
-\begin{code}
-#if 0 /* Code to avoid explicit updating of CAF references */
-
-STGFUN(_PRMarking_MarkNextCAF)
-{
- FUNBEGIN;
- MRoot = (P_) IND_CLOSURE_LINK(MRoot);
+ GC_SHORT_CAF(); /* ticky (ToDo: wrong?) */
- /* Is the next CAF the end of the list */
- if (MRoot == 0)
- RESUME_(miniInterpretEnd);
-
- Mark = MRoot;
+ Mark = (P_) IND_CLOSURE_PTR(MRoot);
JUMP_MARK;
FUNEND;
}
-#endif /* 0 */
\end{code}
Multi-slurp protection.
projects / ghc-hetmet.git / blobdiff