rts/sm/Scav.c-inc

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