ghc/runtime/storage/SMmarking.lc

   1 /*************************************************************************
   2                            MARKING OF ROOTS
   3 *************************************************************************/
   4
   5 [Something needed here to explain what this is doing.  KH]
   6
   7 \begin{code}
   8
   9 #define MARK_REG_MAP
  10 #include "SMinternal.h"
  11
  12 #if defined(_INFO_MARKING)
  13
  14 #if defined (__STG_GCC_REGS__) /* If we are using registers load _SAVE */
  15
  16 /* If we are using registers load _SAVE */
  17 #define Mark     SAVE_Mark
  18 #define MRoot    SAVE_MRoot
  19 #define MStack   SAVE_MStack
  20 #define BitArray SAVE_BitArray
  21 #define HeapBase SAVE_HeapBase
  22 #define HeapLim  SAVE_HeapLim
  23
  24 #endif /* registerized */
  25
  26 /* These in SMmark.lhc -- need to be in .hc file */
  27 EXTFUN(_startMarkWorld);
  28
  29 EXTFUN(_PRMarking_MarkNextRoot);
  30 EXTFUN(_PRMarking_MarkNextCAF);
  31 EXTDATA(_PRMarking_MarkNextRoot_closure);
  32 EXTDATA(_PRMarking_MarkNextCAF_closure);
  33
  34 #ifdef CONCURRENT
  35 EXTFUN(_PRMarking_MarkNextSpark);
  36 EXTDATA(_PRMarking_MarkNextSpark_closure);
  37 #endif
  38
  39 #if defined(GRAN)
  40 EXTFUN(_PRMarking_MarkNextEvent);
  41 EXTDATA(_PRMarking_MarkNextEvent_closure);
  42 EXTFUN(_PRMarking_MarkNextClosureInFetchBuffer);
  43 EXTDATA(_PRMarking_MarkNextClosureInFetchBuffer_closure);
  44 #endif
  45
  46 #ifdef PAR
  47 EXTFUN(_PRMarking_MarkNextGA);
  48 EXTDATA(_PRMarking_MarkNextGA_closure);
  49 #else
  50 # if 1 /* !defined(GRAN) */ /* HWL */
  51 EXTFUN(_PRMarking_MarkNextAStack);
  52 EXTFUN(_PRMarking_MarkNextBStack);
  53 EXTDATA(_PRMarking_MarkNextAStack_closure);
  54 EXTDATA(_PRMarking_MarkNextBStack_closure);
  55 # endif
  56 #endif /* not parallel */
  57
  58 P_ sm_roots_end;
  59 #if defined(GRAN)
  60 P_ ret_MRoot, ret_Mark;
  61 #endif
  62
  63 I_
  64 markHeapRoots(sm, cafs1, cafs2, base, lim, bit_array)
  65     smInfo *sm;
  66     P_ cafs1, cafs2;  /* Pointer to CAF lists */
  67     P_ base;          /* Heap closure in range only tested for by GCgn */
  68     P_ lim;
  69     BitWord *bit_array;
  70 {
  71 #ifdef CONCURRENT
  72     int pool;
  73 #endif
  74 #if defined(GRAN)
  75     PROC proc;
  76     eventq event;
  77     sparkq spark;
  78     rtsBool found = rtsFalse;
  79 #endif
  80
  81     BitArray = bit_array;
  82     HeapBase = base;
  83     HeapLim = lim;
  84
  85     DEBUG_STRING("Marking Roots:");
  86     if (sm->rootno > 0) {
  87         sm_roots_end = (P_) &sm->roots[sm->rootno];
  88         MRoot = (P_) sm->roots;
  89         Mark = (P_) *MRoot;
  90         MStack = (P_) _PRMarking_MarkNextRoot_closure;
  91
  92         miniInterpret((StgFunPtr)_startMarkWorld);
  93     }
  94
  95 #if defined(GRAN)
  96     DEBUG_STRING("Marking Events (GRAN): ");
  97     MRoot = (P_) EventHd;
  98     found = rtsFalse;
  99     do {
 100       if (MRoot != NULL) {
 101         /* inlined version of MarkNextEvent */
 102         switch (EVENT_TYPE( ((eventq) MRoot) )) {
 103           case CONTINUETHREAD:
 104           case STARTTHREAD:
 105           case RESUMETHREAD:
 106           case MOVETHREAD:
 107              EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
 108              Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
 109              MStack = (P_) _PRMarking_MarkNextEvent_closure;
 110              miniInterpret((StgFunPtr)_startMarkWorld);
 111              found = rtsTrue;
 112              break;
 113           case MOVESPARK:
 114              EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
 115              Mark = (P_) SPARK_NODE(EVENT_SPARK( ((eventq) MRoot) ));
 116              MStack = (P_) _PRMarking_MarkNextEvent_closure;
 117              miniInterpret((StgFunPtr)_startMarkWorld);
 118              found = rtsTrue;
 119              break;
 120           case FETCHNODE:
 121              EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
 122              Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
 123              MStack = (P_) _PRMarking_MarkNextEvent_closure;
 124              miniInterpret((StgFunPtr)_startMarkWorld);
 125              found = rtsTrue;
 126              break;
 127           case FETCHREPLY:
 128              EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
 129              Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
 130              MStack = (P_) _PRMarking_MarkNextEvent_closure;
 131              miniInterpret((StgFunPtr)_startMarkWorld);
 132              found = rtsTrue;
 133              break;
 134            case GLOBALBLOCK:
 135              EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
 136              Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
 137              MStack = (P_) _PRMarking_MarkNextEvent_closure;
 138              miniInterpret((StgFunPtr)_startMarkWorld);
 139              found = rtsTrue;
 140              break;
 141           case UNBLOCKTHREAD:
 142              Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
 143              MStack = (P_) _PRMarking_MarkNextEvent_closure;
 144              miniInterpret((StgFunPtr)_startMarkWorld);
 145              found = rtsTrue;
 146              break;
 147           case FINDWORK:
 148              MRoot = (P_) EVENT_NEXT( ((eventq) MRoot) );
 149              found = rtsFalse;
 150              break;
 151           default:
 152              fprintf(stderr,"Unknown event type %d (event @ %#x) in SMmarking_NextEvent\n",
 153                               EVENT_TYPE( ((eventq) MRoot) ), MRoot);
 154                EXIT(EXIT_FAILURE);
 155         }
 156       }
 157     } while (!found && MRoot != NULL);
 158
 159     DEBUG_STRING("Marking Sparks (GRAN):");
 160     /* ToDo: Check this code */
 161     for(proc = 0; proc < RTSflags.GranFlags.proc; ++proc) {
 162       for(pool = 0; pool < SPARK_POOLS; pool++) {
 163          MRoot = (P_) PendingSparksHd[proc][pool];
 164          if (MRoot != NULL) {
 165            Mark = (P_) SPARK_NODE( ((sparkq) MRoot) );
 166            MStack = (P_) _PRMarking_MarkNextSpark_closure;
 167            miniInterpret((StgFunPtr)_startMarkWorld);
 168          }
 169       }    /* forall pool ..   */
 170     }     /* forall proc ...  */
 171 #endif /* GRAN */
 172
 173 #if defined(CONCURRENT) && !defined(GRAN)
 174     for(pool = 0; pool < SPARK_POOLS; pool++) {
 175         if (PendingSparksHd[pool] < PendingSparksTl[pool]) {
 176             sm_roots_end = (P_) PendingSparksTl[pool];
 177             MRoot = (P_) PendingSparksHd[pool];
 178             Mark = (P_) *MRoot;
 179             MStack = (P_) _PRMarking_MarkNextSpark_closure;
 180
 181             miniInterpret((StgFunPtr)_startMarkWorld);
 182         }
 183     }
 184 #endif
 185
 186 #ifdef PAR
 187     DEBUG_STRING("Marking GA Roots:");
 188     MRoot = (P_) liveIndirections;
 189     while(MRoot != NULL && ((GALA *)MRoot)->ga.weight == MAX_GA_WEIGHT)
 190         MRoot = (P_) ((GALA *)MRoot)->next;
 191     if (MRoot != NULL) {
 192         Mark = ((GALA *)MRoot)->la;
 193         MStack = (P_) _PRMarking_MarkNextGA_closure;
 194
 195         miniInterpret((StgFunPtr) _startMarkWorld);
 196     }
 197 #else
 198 # if 1  /* !defined(GRAN) */  /* HWL */
 199     /* Note: no *external* stacks in parallel/concurrent world */
 200
 201     DEBUG_STRING("Marking A Stack:");
 202     if (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) >= 0) {
 203         MRoot = (P_) MAIN_SpA;
 204         Mark = (P_) *MRoot;
 205         MStack = (P_) _PRMarking_MarkNextAStack_closure;
 206
 207         miniInterpret((StgFunPtr)_startMarkWorld);
 208     }
 209
 210     DEBUG_STRING("Marking B Stack:");
 211     if (SUBTRACT_B_STK(MAIN_SuB, stackInfo.botB) > 0) {
 212         MRoot = MAIN_SuB;
 213         Mark = GRAB_UPDATEE(MRoot);
 214         MStack = (P_) _PRMarking_MarkNextBStack_closure;
 215         miniInterpret((StgFunPtr)_startMarkWorld);
 216     }
 217 # endif /* ! CONCURRENT */
 218 #endif /* PAR */
 219
 220     DEBUG_STRING("Marking & Updating CAFs:");
 221     if (cafs1) {
 222         MRoot  = cafs1;
 223         Mark   = (P_) IND_CLOSURE_PTR(MRoot);
 224         MStack = (P_) _PRMarking_MarkNextCAF_closure;
 225
 226         miniInterpret((StgFunPtr)_startMarkWorld);
 227     }
 228
 229     if (cafs2) {
 230         MRoot  = cafs2;
 231         Mark   = (P_) IND_CLOSURE_PTR(MRoot);
 232         MStack = (P_) _PRMarking_MarkNextCAF_closure;
 233
 234         miniInterpret((StgFunPtr)_startMarkWorld);
 235     }
 236
 237     return 0;
 238 }
 239
 240 #endif /* _INFO_MARKING */
 241 \end{code}
 242
 243
 244 CODE REQUIRED (expressed as a loop):
 245
 246 MARK ROOTS
 247
 248     MStack = _PRMarking_MarkNextRoot_closure;
 249     for (MRoot = (P_) sm->roots;
 250          MRoot < (P_) &sm->roots[sm->rootno];
 251          MRoot++) {
 252         Mark = (P_) *MRoot;
 253         (PRMARK_CODE(INFO_PTR(Mark)))();
 254 _PRMarking_MarkNextRoot:
 255         *MRoot = (W_) Mark;
 256     }
 257
 258
 259 MARK AStack
 260
 261     MStack = _PRMarking_MarkNextAStack_closure;
 262     for (MRoot = MAIN_SpA;
 263          SUBTRACT_A_STK(MRoot, stackInfo.botA) >= 0;
 264          MRoot = MRoot + AREL(1)) {
 265         Mark = (P_) *MRoot;
 266         (PRMARK_CODE(INFO_PTR(Mark)))();
 267 _PRMarking_MarkNextAStack:
 268         *MRoot = (W_) Mark;
 269     }
 270
 271
 272 MARK BStack
 273
 274     MStack = _PRMarking_MarkNextBStack_closure;
 275     for (MRoot = MAIN_SuB;  --- Topmost Update Frame
 276          SUBTRACT_B_STK(MRoot, stackInfo.botB) > 0;
 277          MRoot = GRAB_SuB(MRoot)) {
 278
 279         Mark = GRAB_UPDATEE(MRoot);
 280         (PRMARK_CODE(INFO_PTR(Mark)))();
 281 _PRMarking_MarkNextBStack:
 282         PUSH_UPDATEE(MRoot, Mark);
 283     }
 284
 285
 286 MARK CAFs
 287
 288     MStack = _PRMarking_MarkNextCAF_closure;
 289     for (MRoot = sm->CAFlist;
 290          MRoot;
 291          MRoot = (P_) IND_CLOSURE_LINK(MRoot))
 292
 293         Mark = IND_CLOSURE_PTR(MRoot);
 294         (PRMARK_CODE(INFO_PTR(Mark)))();
 295 _PRMarking_MarkNextCAF:
 296         IND_CLOSURE_PTR(MRoot) = (W_) Mark;
 297     }