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         scavengeTSO(tso);
 331         p += tso_sizeW(tso);
 332         break;
 333     }
 334
 335     case TVAR_WATCH_QUEUE:
 336       {
 337         StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p);
 338         gct->evac_step = 0;
 339         evacuate((StgClosure **)&wq->closure);
 340         evacuate((StgClosure **)&wq->next_queue_entry);
 341         evacuate((StgClosure **)&wq->prev_queue_entry);
 342         gct->evac_step = saved_evac_step;
 343         gct->failed_to_evac = rtsTrue; // mutable
 344         p += sizeofW(StgTVarWatchQueue);
 345         break;
 346       }
 347
 348     case TVAR:
 349       {
 350         StgTVar *tvar = ((StgTVar *) p);
 351         gct->evac_step = 0;
 352         evacuate((StgClosure **)&tvar->current_value);
 353         evacuate((StgClosure **)&tvar->first_watch_queue_entry);
 354         gct->evac_step = saved_evac_step;
 355         gct->failed_to_evac = rtsTrue; // mutable
 356         p += sizeofW(StgTVar);
 357         break;
 358       }
 359
 360     case TREC_HEADER:
 361       {
 362         StgTRecHeader *trec = ((StgTRecHeader *) p);
 363         gct->evac_step = 0;
 364         evacuate((StgClosure **)&trec->enclosing_trec);
 365         evacuate((StgClosure **)&trec->current_chunk);
 366         evacuate((StgClosure **)&trec->invariants_to_check);
 367         gct->evac_step = saved_evac_step;
 368         gct->failed_to_evac = rtsTrue; // mutable
 369         p += sizeofW(StgTRecHeader);
 370         break;
 371       }
 372
 373     case TREC_CHUNK:
 374       {
 375         StgWord i;
 376         StgTRecChunk *tc = ((StgTRecChunk *) p);
 377         TRecEntry *e = &(tc -> entries[0]);
 378         gct->evac_step = 0;
 379         evacuate((StgClosure **)&tc->prev_chunk);
 380         for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
 381           evacuate((StgClosure **)&e->tvar);
 382           evacuate((StgClosure **)&e->expected_value);
 383           evacuate((StgClosure **)&e->new_value);
 384         }
 385         gct->evac_step = saved_evac_step;
 386         gct->failed_to_evac = rtsTrue; // mutable
 387         p += sizeofW(StgTRecChunk);
 388         break;
 389       }
 390
 391     case ATOMIC_INVARIANT:
 392       {
 393         StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p);
 394         gct->evac_step = 0;
 395         evacuate(&invariant->code);
 396         evacuate((StgClosure **)&invariant->last_execution);
 397         gct->evac_step = saved_evac_step;
 398         gct->failed_to_evac = rtsTrue; // mutable
 399         p += sizeofW(StgAtomicInvariant);
 400         break;
 401       }
 402
 403     case INVARIANT_CHECK_QUEUE:
 404       {
 405         StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p);
 406         gct->evac_step = 0;
 407         evacuate((StgClosure **)&queue->invariant);
 408         evacuate((StgClosure **)&queue->my_execution);
 409         evacuate((StgClosure **)&queue->next_queue_entry);
 410         gct->evac_step = saved_evac_step;
 411         gct->failed_to_evac = rtsTrue; // mutable
 412         p += sizeofW(StgInvariantCheckQueue);
 413         break;
 414       }
 415
 416     default:
 417         barf("scavenge: unimplemented/strange closure type %d @ %p",
 418              info->type, p);
 419     }
 420
 421     /*
 422      * We need to record the current object on the mutable list if
 423      *  (a) It is actually mutable, or
 424      *  (b) It contains pointers to a younger generation.
 425      * Case (b) arises if we didn't manage to promote everything that
 426      * the current object points to into the current generation.
 427      */
 428     if (gct->failed_to_evac) {
 429         gct->failed_to_evac = rtsFalse;
 430         if (bd->gen_no > 0) {
 431             recordMutableGen_GC((StgClosure *)q, &generations[bd->gen_no]);
 432         }
 433     }
 434   }
 435
 436   if (p > bd->free)  {
 437       gct->copied += ws->todo_free - bd->free;
 438       bd->free = p;
 439   }
 440
 441   debugTrace(DEBUG_gc, "   scavenged %ld bytes",
 442              (unsigned long)((bd->free - bd->u.scan) * sizeof(W_)));
 443
 444   // update stats: this is a block that has been scavenged
 445   gct->scanned += bd->free - bd->u.scan;
 446   bd->u.scan = bd->free;
 447
 448   if (bd != ws->todo_bd) {
 449       // we're not going to evac any more objects into
 450       // this block, so push it now.
 451       push_scanned_block(bd, ws);
 452   }
 453
 454   gct->scan_bd = NULL;
 455 }
 456
 457 #undef scavenge_block
 458 #undef evacuate
 459 #undef recordMutableGen_GC