/*************************************************************************
                           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;
    }