#define MARK_REG_MAP
#include "SMinternal.h"
-extern I_ doSanityChks; /* ToDo: move tidily */
-
#if defined(_INFO_MARKING)
#if defined (__STG_GCC_REGS__) /* If we are using registers load _SAVE */
EXTDATA(_PRMarking_MarkNextSpark_closure);
#endif
+#if defined(GRAN)
+EXTFUN(_PRMarking_MarkNextEvent);
+EXTDATA(_PRMarking_MarkNextEvent_closure);
+EXTFUN(_PRMarking_MarkNextClosureInFetchBuffer);
+EXTDATA(_PRMarking_MarkNextClosureInFetchBuffer_closure);
+#endif
+
#ifdef PAR
EXTFUN(_PRMarking_MarkNextGA);
EXTDATA(_PRMarking_MarkNextGA_closure);
#endif /* not parallel */
P_ sm_roots_end;
+#if defined(GRAN)
+P_ ret_MRoot, ret_Mark;
+#endif
I_
markHeapRoots(sm, cafs1, cafs2, base, lim, bit_array)
#ifdef CONCURRENT
int pool;
#endif
-
-#if 0 /* Code to avoid explicit updating of CAF references */
-
- /* Before marking have to modify CAFs to auxillary info table */
- P_ CAFptr;
- DEBUG_STRING("Setting Mark & Upd CAFs:");
- for (CAFptr = cafs1; CAFptr;
- CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) {
- INFO_PTR(CAFptr) = (W_) Caf_Mark_Upd_info;
- }
- for (CAFptr = cafs2; CAFptr;
- CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) {
- INFO_PTR(CAFptr) = (W_) Caf_Mark_Upd_info;
- }
- DEBUG_STRING("Marking CAFs:");
- if (cafs1) {
- MRoot = (P_) cafs1;
- Mark = (P_) MRoot;
- MStack = (P_) _PRMarking_MarkNextCAF_closure;
- /*ToDo: debugify */
- miniInterpret((StgFunPtr)_startMarkWorld);
- }
- if (cafs2) {
- MRoot = (P_) cafs2;
- Mark = (P_) MRoot;
- MStack = (P_) _PRMarking_MarkNextCAF_closure;
- /*ToDo: debugify */
- miniInterpret((StgFunPtr)_startMarkWorld);
- }
-
-#endif /* 0 */
+#if defined(GRAN)
+ PROC proc;
+ eventq event;
+ sparkq spark;
+ rtsBool found = rtsFalse;
+#endif
BitArray = bit_array;
HeapBase = base;
MRoot = (P_) sm->roots;
Mark = (P_) *MRoot;
MStack = (P_) _PRMarking_MarkNextRoot_closure;
-#if defined(__STG_TAILJUMPS__)
- miniInterpret((StgFunPtr)_startMarkWorld);
-#else
- if (doSanityChks)
- miniInterpret_debug((StgFunPtr)_startMarkWorld, NULL);
- else
+
miniInterpret((StgFunPtr)_startMarkWorld);
-#endif /* ! tail-jumping */
}
-#ifdef CONCURRENT
+#if defined(GRAN)
+ DEBUG_STRING("Marking Events (GRAN): ");
+ MRoot = (P_) EventHd;
+ found = rtsFalse;
+ do {
+ if (MRoot != NULL) {
+ /* inlined version of MarkNextEvent */
+ 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) );
+ MStack = (P_) _PRMarking_MarkNextEvent_closure;
+ miniInterpret((StgFunPtr)_startMarkWorld);
+ found = rtsTrue;
+ break;
+ case MOVESPARK:
+ EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
+ Mark = (P_) SPARK_NODE(EVENT_SPARK( ((eventq) MRoot) ));
+ MStack = (P_) _PRMarking_MarkNextEvent_closure;
+ miniInterpret((StgFunPtr)_startMarkWorld);
+ found = rtsTrue;
+ break;
+ case FETCHNODE:
+ EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
+ Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
+ MStack = (P_) _PRMarking_MarkNextEvent_closure;
+ miniInterpret((StgFunPtr)_startMarkWorld);
+ found = rtsTrue;
+ break;
+ case FETCHREPLY:
+ EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
+ Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
+ MStack = (P_) _PRMarking_MarkNextEvent_closure;
+ miniInterpret((StgFunPtr)_startMarkWorld);
+ found = rtsTrue;
+ break;
+ case GLOBALBLOCK:
+ EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
+ Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
+ MStack = (P_) _PRMarking_MarkNextEvent_closure;
+ miniInterpret((StgFunPtr)_startMarkWorld);
+ found = rtsTrue;
+ break;
+ case UNBLOCKTHREAD:
+ Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
+ MStack = (P_) _PRMarking_MarkNextEvent_closure;
+ miniInterpret((StgFunPtr)_startMarkWorld);
+ found = rtsTrue;
+ break;
+ case FINDWORK:
+ MRoot = (P_) EVENT_NEXT( ((eventq) MRoot) );
+ 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);
+
+ DEBUG_STRING("Marking Sparks (GRAN):");
+ for(proc = 0; proc < RTSflags.GranFlags.proc; ++proc) {
+ for(pool = 0; pool < SPARK_POOLS; pool++) {
+ MRoot = (P_) PendingSparksHd[proc][pool];
+ if (MRoot != NULL) {
+ Mark = (P_) SPARK_NODE( ((sparkq) MRoot) );
+ MStack = (P_) _PRMarking_MarkNextSpark_closure;
+ miniInterpret((StgFunPtr)_startMarkWorld);
+ }
+ } /* forall pool .. */
+ } /* forall proc ... */
+#endif /* GRAN */
+
+#if defined(CONCURRENT) && !defined(GRAN)
for(pool = 0; pool < SPARK_POOLS; pool++) {
if (PendingSparksHd[pool] < PendingSparksTl[pool]) {
sm_roots_end = (P_) PendingSparksTl[pool];
MRoot = (P_) PendingSparksHd[pool];
Mark = (P_) *MRoot;
MStack = (P_) _PRMarking_MarkNextSpark_closure;
-#if defined(__STG_TAILJUMPS__)
- miniInterpret((StgFunPtr)_startMarkWorld);
-#else
- if (doSanityChks)
- miniInterpret_debug((StgFunPtr)_startMarkWorld, NULL);
- else
+
miniInterpret((StgFunPtr)_startMarkWorld);
-#endif /* ! tail-jumping */
}
}
#endif
if (MRoot != NULL) {
Mark = ((GALA *)MRoot)->la;
MStack = (P_) _PRMarking_MarkNextGA_closure;
-#if defined(__STG_TAILJUMPS__)
+
miniInterpret((StgFunPtr) _startMarkWorld);
-#else
- if (doSanityChks)
- miniInterpret_debug((StgFunPtr) _startMarkWorld, NULL);
- else
- miniInterpret((StgFunPtr) _startMarkWorld);
-#endif /* ! tail-jumping */
}
#else
- /* Note: no *external* stacks in parallel world */
+ /* Note: no *external* stacks in parallel/concurrent world */
+
DEBUG_STRING("Marking A Stack:");
if (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) >= 0) {
MRoot = (P_) MAIN_SpA;
Mark = (P_) *MRoot;
MStack = (P_) _PRMarking_MarkNextAStack_closure;
-#if defined(__STG_TAILJUMPS__)
- miniInterpret((StgFunPtr)_startMarkWorld);
-#else
- if (doSanityChks)
- miniInterpret_debug((StgFunPtr)_startMarkWorld, NULL);
- else
+
miniInterpret((StgFunPtr)_startMarkWorld);
-#endif /* ! tail-jumping */
}
DEBUG_STRING("Marking B Stack:");
DEBUG_STRING("Marking & Updating CAFs:");
if (cafs1) {
- MRoot = cafs1;
- Mark = (P_) IND_CLOSURE_PTR(MRoot);
+ MRoot = cafs1;
+ Mark = (P_) IND_CLOSURE_PTR(MRoot);
MStack = (P_) _PRMarking_MarkNextCAF_closure;
-#if defined(__STG_TAILJUMPS__)
- miniInterpret((StgFunPtr)_startMarkWorld);
-#else
- if (doSanityChks)
- miniInterpret_debug((StgFunPtr)_startMarkWorld, NULL);
- else
+
miniInterpret((StgFunPtr)_startMarkWorld);
-#endif /* ! tail-jumping */
}
if (cafs2) {
- MRoot = cafs2;
- Mark = (P_) IND_CLOSURE_PTR(MRoot);
+ MRoot = cafs2;
+ Mark = (P_) IND_CLOSURE_PTR(MRoot);
MStack = (P_) _PRMarking_MarkNextCAF_closure;
-#if defined(__STG_TAILJUMPS__)
- miniInterpret((StgFunPtr)_startMarkWorld);
-#else
- if (doSanityChks)
- miniInterpret_debug((StgFunPtr)_startMarkWorld, NULL);
- else
+
miniInterpret((StgFunPtr)_startMarkWorld);
-#endif /* ! tail-jumping */
}
+
return 0;
}
#endif /* _INFO_MARKING */
-
\end{code}
projects / ghc-hetmet.git / blobdiff