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