+++ /dev/null
-/*************************************************************************
- MARKING OF ROOTS
-*************************************************************************/
-
-[Something needed here to explain what this is doing. KH]
-
-\begin{code}
-
-#define MARK_REG_MAP
-#include "SMinternal.h"
-
-#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
-
-#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);
-#else
-EXTFUN(_PRMarking_MarkNextAStack);
-EXTFUN(_PRMarking_MarkNextBStack);
-EXTDATA(_PRMarking_MarkNextAStack_closure);
-EXTDATA(_PRMarking_MarkNextBStack_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)
- 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 defined(GRAN)
- PROC proc;
- eventq event;
- sparkq spark;
- rtsBool found = rtsFalse;
-#endif
-
- 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;
-
- miniInterpret((StgFunPtr)_startMarkWorld);
- }
-
-#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;
-
- miniInterpret((StgFunPtr)_startMarkWorld);
- }
- }
-#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;
-
- miniInterpret((StgFunPtr) _startMarkWorld);
- }
-#else
- /* 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;
-
- miniInterpret((StgFunPtr)_startMarkWorld);
- }
-
- 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;
-
- miniInterpret((StgFunPtr)_startMarkWorld);
- }
-
- if (cafs2) {
- MRoot = cafs2;
- Mark = (P_) IND_CLOSURE_PTR(MRoot);
- MStack = (P_) _PRMarking_MarkNextCAF_closure;
-
- miniInterpret((StgFunPtr)_startMarkWorld);
- }
-
- 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