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