--- /dev/null
+/*************************************************************************
+ MARKING OF ROOTS
+*************************************************************************/
+
+[Something needed here to explain what this is doing. KH]
+
+\begin{code}
+
+#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 */
+
+/* If we are using registers load _SAVE */
+#define Mark SAVE_Mark
+#define MRoot SAVE_MRoot
+#define MStack SAVE_MStack
+#define BitArray SAVE_BitArray
+#define HeapBase SAVE_HeapBase
+#define HeapLim SAVE_HeapLim
+
+#endif /* registerized */
+
+/* These in SMmark.lhc -- need to be in .hc file */
+EXTFUN(_startMarkWorld);
+
+EXTFUN(_PRMarking_MarkNextRoot);
+EXTFUN(_PRMarking_MarkNextCAF);
+EXTDATA(_PRMarking_MarkNextRoot_closure);
+EXTDATA(_PRMarking_MarkNextCAF_closure);
+
+#ifdef CONCURRENT
+EXTFUN(_PRMarking_MarkNextSpark);
+EXTDATA(_PRMarking_MarkNextSpark_closure);
+#endif
+
+#ifdef PAR
+EXTFUN(_PRMarking_MarkNextGA);
+EXTDATA(_PRMarking_MarkNextGA_closure);
+#else
+EXTFUN(_PRMarking_MarkNextAStack);
+EXTFUN(_PRMarking_MarkNextBStack);
+EXTDATA(_PRMarking_MarkNextAStack_closure);
+EXTDATA(_PRMarking_MarkNextBStack_closure);
+#endif /* not parallel */
+
+P_ sm_roots_end;
+
+I_
+markHeapRoots(sm, cafs1, cafs2, base, lim, bit_array)
+ smInfo *sm;
+ P_ cafs1, cafs2; /* Pointer to CAF lists */
+ P_ base; /* Heap closure in range only tested for by GCgn */
+ P_ lim;
+ BitWord *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 */
+
+ BitArray = bit_array;
+ HeapBase = base;
+ HeapLim = lim;
+
+ DEBUG_STRING("Marking Roots:");
+ if (sm->rootno > 0) {
+ sm_roots_end = (P_) &sm->roots[sm->rootno];
+ 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
+ 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
+
+#ifdef PAR
+ DEBUG_STRING("Marking GA Roots:");
+ MRoot = (P_) liveIndirections;
+ while(MRoot != NULL && ((GALA *)MRoot)->ga.weight == MAX_GA_WEIGHT)
+ MRoot = (P_) ((GALA *)MRoot)->next;
+ 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 */
+ 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:");
+ if (SUBTRACT_B_STK(MAIN_SuB, stackInfo.botB) > 0) {
+ MRoot = MAIN_SuB;
+ Mark = GRAB_UPDATEE(MRoot);
+ MStack = (P_) _PRMarking_MarkNextBStack_closure;
+ miniInterpret((StgFunPtr)_startMarkWorld);
+ }
+#endif /* PAR */
+
+ DEBUG_STRING("Marking & Updating CAFs:");
+ if (cafs1) {
+ 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);
+ 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}
+
+
+CODE REQUIRED (expressed as a loop):
+
+MARK ROOTS
+
+ MStack = _PRMarking_MarkNextRoot_closure;
+ for (MRoot = (P_) sm->roots;
+ MRoot < (P_) &sm->roots[sm->rootno];
+ MRoot++) {
+ Mark = (P_) *MRoot;
+ (PRMARK_CODE(INFO_PTR(Mark)))();
+_PRMarking_MarkNextRoot:
+ *MRoot = (W_) Mark;
+ }
+
+
+MARK AStack
+
+ MStack = _PRMarking_MarkNextAStack_closure;
+ for (MRoot = MAIN_SpA;
+ SUBTRACT_A_STK(MRoot, stackInfo.botA) >= 0;
+ MRoot = MRoot + AREL(1)) {
+ Mark = (P_) *MRoot;
+ (PRMARK_CODE(INFO_PTR(Mark)))();
+_PRMarking_MarkNextAStack:
+ *MRoot = (W_) Mark;
+ }
+
+
+MARK BStack
+
+ MStack = _PRMarking_MarkNextBStack_closure;
+ for (MRoot = MAIN_SuB; --- Topmost Update Frame
+ SUBTRACT_B_STK(MRoot, stackInfo.botB) > 0;
+ MRoot = GRAB_SuB(MRoot)) {
+
+ Mark = GRAB_UPDATEE(MRoot);
+ (PRMARK_CODE(INFO_PTR(Mark)))();
+_PRMarking_MarkNextBStack:
+ PUSH_UPDATEE(MRoot, Mark);
+ }
+
+
+MARK CAFs
+
+ MStack = _PRMarking_MarkNextCAF_closure;
+ for (MRoot = sm->CAFlist;
+ MRoot;
+ MRoot = (P_) IND_CLOSURE_LINK(MRoot))
+
+ Mark = IND_CLOSURE_PTR(MRoot);
+ (PRMARK_CODE(INFO_PTR(Mark)))();
+_PRMarking_MarkNextCAF:
+ IND_CLOSURE_PTR(MRoot) = (W_) Mark;
+ }
projects / ghc-hetmet.git / blobdiff