rts/sm/Scav.c-inc

   1 /* -----------------------------------------------------------------------*-c-*-
   2  *
   3  * (c) The GHC Team 1998-2008
   4  *
   5  * Generational garbage collector: scavenging functions
   6  *
   7  * Documentation on the architecture of the Garbage Collector can be
   8  * found in the online commentary:
   9  *
  10  *   http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC
  11  *
  12  * ---------------------------------------------------------------------------*/
  13
  14 // This file is #included into Scav.c, twice: firstly with PARALLEL_GC
  15 // defined, the second time without.
  16
  17 #if defined(THREADED_RTS) && !defined(PARALLEL_GC)
  18 #  define scavenge_block(a) scavenge_block1(a)
  19 #  define evacuate(a) evacuate1(a)
  20 #  define recordMutableGen_GC(a,b) recordMutableGen(a,b)
  21 #else
  22 #  undef scavenge_block
  23 #  undef evacuate
  24 #  undef recordMutableGen_GC
  25 #  if !defined(THREADED_RTS)
  26 #    define scavenge_block1(a) scavenge_block(a)
  27 #  endif
  28 #endif
  29
  30
  31 static void scavenge_block (bdescr *bd);
  32
  33 /* -----------------------------------------------------------------------------
  34    Scavenge a block from the given scan pointer up to bd->free.
  35
  36    evac_step is set by the caller to be either zero (for a step in a
  37    generation < N) or G where G is the generation of the step being
  38    scavenged.
  39
  40    We sometimes temporarily change evac_step back to zero if we're
  41    scavenging a mutable object where eager promotion isn't such a good
  42    idea.
  43    -------------------------------------------------------------------------- */
  44
  45 static void
  46 scavenge_block (bdescr *bd)
  47 {
  48   StgPtr p, q;
  49   StgInfoTable *info;
  50   step *saved_evac_step;
  51   rtsBool saved_eager_promotion;
  52   step_workspace *ws;
  53
  54   debugTrace(DEBUG_gc, "scavenging block %p (gen %d, step %d) @ %p",
  55              bd->start, bd->gen_no, bd->step->no, bd->u.scan);
  56
  57   gct->scan_bd = bd;
  58   gct->evac_step = bd->step;
  59   saved_evac_step = gct->evac_step;
  60   saved_eager_promotion = gct->eager_promotion;
  61   gct->failed_to_evac = rtsFalse;
  62
  63   ws = &gct->steps[bd->step->abs_no];
  64
  65   p = bd->u.scan;
  66
  67   // we might be evacuating into the very object that we're
  68   // scavenging, so we have to check the real bd->free pointer each
  69   // time around the loop.
  70   while (p < bd->free || (bd == ws->todo_bd && p < ws->todo_free)) {
  71
  72     ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
  73     info = get_itbl((StgClosure *)p);
  74
  75     ASSERT(gct->thunk_selector_depth == 0);
  76
  77     q = p;
  78     switch (info->type) {
  79
  80     case MVAR_CLEAN:
  81     case MVAR_DIRTY:
  82     {
  83         StgMVar *mvar = ((StgMVar *)p);
  84         gct->eager_promotion = rtsFalse;
  85         evacuate((StgClosure **)&mvar->head);
  86         evacuate((StgClosure **)&mvar->tail);
  87         evacuate((StgClosure **)&mvar->value);
  88         gct->eager_promotion = saved_eager_promotion;
  89
  90         if (gct->failed_to_evac) {
  91             mvar->header.info = &stg_MVAR_DIRTY_info;
  92         } else {
  93             mvar->header.info = &stg_MVAR_CLEAN_info;
  94         }
  95         p += sizeofW(StgMVar);
  96         break;
  97     }
  98
  99     case FUN_2_0:
 100         scavenge_fun_srt(info);
 101         evacuate(&((StgClosure *)p)->payload[1]);
 102         evacuate(&((StgClosure *)p)->payload[0]);
 103         p += sizeofW(StgHeader) + 2;
 104         break;
 105
 106     case THUNK_2_0:
 107         scavenge_thunk_srt(info);
 108         evacuate(&((StgThunk *)p)->payload[1]);
 109         evacuate(&((StgThunk *)p)->payload[0]);
 110         p += sizeofW(StgThunk) + 2;
 111         break;
 112
 113     case CONSTR_2_0:
 114         evacuate(&((StgClosure *)p)->payload[1]);
 115         evacuate(&((StgClosure *)p)->payload[0]);
 116         p += sizeofW(StgHeader) + 2;
 117         break;
 118
 119     case THUNK_1_0:
 120         scavenge_thunk_srt(info);
 121         evacuate(&((StgThunk *)p)->payload[0]);
 122         p += sizeofW(StgThunk) + 1;
 123         break;
 124
 125     case FUN_1_0:
 126         scavenge_fun_srt(info);
 127     case CONSTR_1_0:
 128         evacuate(&((StgClosure *)p)->payload[0]);
 129         p += sizeofW(StgHeader) + 1;
 130         break;
 131
 132     case THUNK_0_1:
 133         scavenge_thunk_srt(info);
 134         p += sizeofW(StgThunk) + 1;
 135         break;
 136
 137     case FUN_0_1:
 138         scavenge_fun_srt(info);
 139     case CONSTR_0_1:
 140         p += sizeofW(StgHeader) + 1;
 141         break;
 142
 143     case THUNK_0_2:
 144         scavenge_thunk_srt(info);
 145         p += sizeofW(StgThunk) + 2;
 146         break;
 147
 148     case FUN_0_2:
 149         scavenge_fun_srt(info);
 150     case CONSTR_0_2:
 151         p += sizeofW(StgHeader) + 2;
 152         break;
 153
 154     case THUNK_1_1:
 155         scavenge_thunk_srt(info);
 156         evacuate(&((StgThunk *)p)->payload[0]);
 157         p += sizeofW(StgThunk) + 2;
 158         break;
 159
 160     case FUN_1_1:
 161         scavenge_fun_srt(info);
 162     case CONSTR_1_1:
 163         evacuate(&((StgClosure *)p)->payload[0]);
 164         p += sizeofW(StgHeader) + 2;
 165         break;
 166
 167     case FUN:
 168         scavenge_fun_srt(info);
 169         goto gen_obj;
 170
 171     case THUNK:
 172     {
 173         StgPtr end;
 174
 175         scavenge_thunk_srt(info);
 176         end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs;
 177         for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
 178             evacuate((StgClosure **)p);
 179         }
 180         p += info->layout.payload.nptrs;
 181         break;
 182     }
 183
 184     gen_obj:
 185     case CONSTR:
 186     case WEAK:
 187     case STABLE_NAME:
 188     {
 189         StgPtr end;
 190
 191         end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
 192         for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
 193             evacuate((StgClosure **)p);
 194         }
 195         p += info->layout.payload.nptrs;
 196         break;
 197     }
 198
 199     case BCO: {
 200         StgBCO *bco = (StgBCO *)p;
 201         evacuate((StgClosure **)&bco->instrs);
 202         evacuate((StgClosure **)&bco->literals);
 203         evacuate((StgClosure **)&bco->ptrs);
 204         p += bco_sizeW(bco);
 205         break;
 206     }
 207
 208     case IND_PERM:
 209       if (bd->gen_no != 0) {
 210 #ifdef PROFILING
 211         // @LDV profiling
 212         // No need to call LDV_recordDead_FILL_SLOP_DYNAMIC() because an
 213         // IND_OLDGEN_PERM closure is larger than an IND_PERM closure.
 214         LDV_recordDead((StgClosure *)p, sizeofW(StgInd));
 215 #endif
 216         //
 217         // Todo: maybe use SET_HDR() and remove LDV_RECORD_CREATE()?
 218         //
 219         SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info);
 220
 221         // We pretend that p has just been created.
 222         LDV_RECORD_CREATE((StgClosure *)p);
 223       }
 224         // fall through
 225     case IND_OLDGEN_PERM:
 226         evacuate(&((StgInd *)p)->indirectee);
 227         p += sizeofW(StgInd);
 228         break;
 229
 230     case MUT_VAR_CLEAN:
 231     case MUT_VAR_DIRTY:
 232         gct->eager_promotion = rtsFalse;
 233         evacuate(&((StgMutVar *)p)->var);
 234         gct->eager_promotion = saved_eager_promotion;
 235
 236         if (gct->failed_to_evac) {
 237             ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
 238         } else {
 239             ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
 240         }
 241         p += sizeofW(StgMutVar);
 242         break;
 243
 244     case CAF_BLACKHOLE:
 245     case SE_CAF_BLACKHOLE:
 246     case SE_BLACKHOLE:
 247     case BLACKHOLE:
 248         p += BLACKHOLE_sizeW();
 249         break;
 250
 251     case THUNK_SELECTOR:
 252     {
 253         StgSelector *s = (StgSelector *)p;
 254         evacuate(&s->selectee);
 255         p += THUNK_SELECTOR_sizeW();
 256         break;
 257     }
 258
 259     // A chunk of stack saved in a heap object
 260     case AP_STACK:
 261     {
 262         StgAP_STACK *ap = (StgAP_STACK *)p;
 263
 264         evacuate(&ap->fun);
 265         scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
 266         p = (StgPtr)ap->payload + ap->size;
 267         break;
 268     }
 269
 270     case PAP:
 271         p = scavenge_PAP((StgPAP *)p);
 272         break;
 273
 274     case AP:
 275         p = scavenge_AP((StgAP *)p);
 276         break;
 277
 278     case ARR_WORDS:
 279         // nothing to follow
 280         p += arr_words_sizeW((StgArrWords *)p);
 281         break;
 282
 283     case MUT_ARR_PTRS_CLEAN:
 284     case MUT_ARR_PTRS_DIRTY:
 285         // follow everything
 286     {
 287         StgPtr next;
 288
 289         // We don't eagerly promote objects pointed to by a mutable
 290         // array, but if we find the array only points to objects in
 291         // the same or an older generation, we mark it "clean" and
 292         // avoid traversing it during minor GCs.
 293         gct->eager_promotion = rtsFalse;
 294         next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
 295         for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
 296             evacuate((StgClosure **)p);
 297         }
 298         gct->eager_promotion = saved_eager_promotion;
 299
 300         if (gct->failed_to_evac) {
 301             ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
 302         } else {
 303             ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
 304         }
 305
 306         gct->failed_to_evac = rtsTrue; // always put it on the mutable list.
 307         break;
 308     }
 309
 310     case MUT_ARR_PTRS_FROZEN:
 311     case MUT_ARR_PTRS_FROZEN0:
 312         // follow everything
 313     {
 314         StgPtr next;
 315
 316         next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
 317         for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
 318             evacuate((StgClosure **)p);
 319         }
 320
 321         // If we're going to put this object on the mutable list, then
 322         // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
 323         if (gct->failed_to_evac) {
 324             ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
 325         } else {
 326             ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
 327         }
 328         break;
 329     }
 330
 331     case TSO:
 332     {
 333         StgTSO *tso = (StgTSO *)p;
 334         scavengeTSO(tso);
 335         p += tso_sizeW(tso);
 336         break;
 337     }
 338
 339     case TVAR_WATCH_QUEUE:
 340       {
 341         StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p);
 342         gct->evac_step = 0;
 343         evacuate((StgClosure **)&wq->closure);
 344         evacuate((StgClosure **)&wq->next_queue_entry);
 345         evacuate((StgClosure **)&wq->prev_queue_entry);
 346         gct->evac_step = saved_evac_step;
 347         gct->failed_to_evac = rtsTrue; // mutable
 348         p += sizeofW(StgTVarWatchQueue);
 349         break;
 350       }
 351
 352     case TVAR:
 353       {
 354         StgTVar *tvar = ((StgTVar *) p);
 355         gct->evac_step = 0;
 356         evacuate((StgClosure **)&tvar->current_value);
 357         evacuate((StgClosure **)&tvar->first_watch_queue_entry);
 358         gct->evac_step = saved_evac_step;
 359         gct->failed_to_evac = rtsTrue; // mutable
 360         p += sizeofW(StgTVar);
 361         break;
 362       }
 363
 364     case TREC_HEADER:
 365       {
 366         StgTRecHeader *trec = ((StgTRecHeader *) p);
 367         gct->evac_step = 0;
 368         evacuate((StgClosure **)&trec->enclosing_trec);
 369         evacuate((StgClosure **)&trec->current_chunk);
 370         evacuate((StgClosure **)&trec->invariants_to_check);
 371         gct->evac_step = saved_evac_step;
 372         gct->failed_to_evac = rtsTrue; // mutable
 373         p += sizeofW(StgTRecHeader);
 374         break;
 375       }
 376
 377     case TREC_CHUNK:
 378       {
 379         StgWord i;
 380         StgTRecChunk *tc = ((StgTRecChunk *) p);
 381         TRecEntry *e = &(tc -> entries[0]);
 382         gct->evac_step = 0;
 383         evacuate((StgClosure **)&tc->prev_chunk);
 384         for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
 385           evacuate((StgClosure **)&e->tvar);
 386           evacuate((StgClosure **)&e->expected_value);
 387           evacuate((StgClosure **)&e->new_value);
 388         }
 389         gct->evac_step = saved_evac_step;
 390         gct->failed_to_evac = rtsTrue; // mutable
 391         p += sizeofW(StgTRecChunk);
 392         break;
 393       }
 394
 395     case ATOMIC_INVARIANT:
 396       {
 397         StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p);
 398         gct->evac_step = 0;
 399         evacuate(&invariant->code);
 400         evacuate((StgClosure **)&invariant->last_execution);
 401         gct->evac_step = saved_evac_step;
 402         gct->failed_to_evac = rtsTrue; // mutable
 403         p += sizeofW(StgAtomicInvariant);
 404         break;
 405       }
 406
 407     case INVARIANT_CHECK_QUEUE:
 408       {
 409         StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p);
 410         gct->evac_step = 0;
 411         evacuate((StgClosure **)&queue->invariant);
 412         evacuate((StgClosure **)&queue->my_execution);
 413         evacuate((StgClosure **)&queue->next_queue_entry);
 414         gct->evac_step = saved_evac_step;
 415         gct->failed_to_evac = rtsTrue; // mutable
 416         p += sizeofW(StgInvariantCheckQueue);
 417         break;
 418       }
 419
 420     default:
 421         barf("scavenge: unimplemented/strange closure type %d @ %p",
 422              info->type, p);
 423     }
 424
 425     /*
 426      * We need to record the current object on the mutable list if
 427      *  (a) It is actually mutable, or
 428      *  (b) It contains pointers to a younger generation.
 429      * Case (b) arises if we didn't manage to promote everything that
 430      * the current object points to into the current generation.
 431      */
 432     if (gct->failed_to_evac) {
 433         gct->failed_to_evac = rtsFalse;
 434         if (bd->gen_no > 0) {
 435             recordMutableGen_GC((StgClosure *)q, &generations[bd->gen_no]);
 436         }
 437     }
 438   }
 439
 440   if (p > bd->free)  {
 441       gct->copied += ws->todo_free - bd->free;
 442       bd->free = p;
 443   }
 444
 445   debugTrace(DEBUG_gc, "   scavenged %ld bytes",
 446              (unsigned long)((bd->free - bd->u.scan) * sizeof(W_)));
 447
 448   // update stats: this is a block that has been scavenged
 449   gct->scanned += bd->free - bd->u.scan;
 450   bd->u.scan = bd->free;
 451
 452   if (bd != ws->todo_bd) {
 453       // we're not going to evac any more objects into
 454       // this block, so push it now.
 455       push_scanned_block(bd, ws);
 456   }
 457
 458   gct->scan_bd = NULL;
 459 }
 460
 461 #undef scavenge_block
 462 #undef evacuate
 463 #undef recordMutableGen_GC