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
  47   p = scan;
  48
  49   debugTrace(DEBUG_gc, "scavenging block %p (gen %d, step %d) @ %p",
  50              bd->start, bd->gen_no, bd->step->no, scan);
  51
  52   gct->evac_step = bd->step;
  53   saved_evac_step = gct->evac_step;
  54   saved_eager_promotion = gct->eager_promotion;
  55   gct->failed_to_evac = rtsFalse;
  56
  57   // we might be evacuating into the very object that we're
  58   // scavenging, so we have to check the real bd->free pointer each
  59   // time around the loop.
  60   while (p < bd->free) {
  61
  62     ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
  63     info = get_itbl((StgClosure *)p);
  64
  65     ASSERT(gct->thunk_selector_depth == 0);
  66
  67     q = p;
  68     switch (info->type) {
  69
  70     case MVAR_CLEAN:
  71     case MVAR_DIRTY:
  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         gct->eager_promotion = rtsFalse;
 247         evacuate(&((StgMutVar *)p)->var);
 248         gct->eager_promotion = saved_eager_promotion;
 249
 250         if (gct->failed_to_evac) {
 251             ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
 252         } else {
 253             ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
 254         }
 255         p += sizeofW(StgMutVar);
 256         break;
 257
 258     case CAF_BLACKHOLE:
 259     case SE_CAF_BLACKHOLE:
 260     case SE_BLACKHOLE:
 261     case BLACKHOLE:
 262         p += BLACKHOLE_sizeW();
 263         break;
 264
 265     case THUNK_SELECTOR:
 266     {
 267         StgSelector *s = (StgSelector *)p;
 268         evacuate(&s->selectee);
 269         p += THUNK_SELECTOR_sizeW();
 270         break;
 271     }
 272
 273     // A chunk of stack saved in a heap object
 274     case AP_STACK:
 275     {
 276         StgAP_STACK *ap = (StgAP_STACK *)p;
 277
 278         evacuate(&ap->fun);
 279         scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
 280         p = (StgPtr)ap->payload + ap->size;
 281         break;
 282     }
 283
 284     case PAP:
 285         p = scavenge_PAP((StgPAP *)p);
 286         break;
 287
 288     case AP:
 289         p = scavenge_AP((StgAP *)p);
 290         break;
 291
 292     case ARR_WORDS:
 293         // nothing to follow
 294         p += arr_words_sizeW((StgArrWords *)p);
 295         break;
 296
 297     case MUT_ARR_PTRS_CLEAN:
 298     case MUT_ARR_PTRS_DIRTY:
 299         // follow everything
 300     {
 301         StgPtr next;
 302
 303         // We don't eagerly promote objects pointed to by a mutable
 304         // array, but if we find the array only points to objects in
 305         // the same or an older generation, we mark it "clean" and
 306         // avoid traversing it during minor GCs.
 307         gct->eager_promotion = rtsFalse;
 308         next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
 309         for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
 310             evacuate((StgClosure **)p);
 311         }
 312         gct->eager_promotion = saved_eager_promotion;
 313
 314         if (gct->failed_to_evac) {
 315             ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
 316         } else {
 317             ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
 318         }
 319
 320         gct->failed_to_evac = rtsTrue; // always put it on the mutable list.
 321         break;
 322     }
 323
 324     case MUT_ARR_PTRS_FROZEN:
 325     case MUT_ARR_PTRS_FROZEN0:
 326         // follow everything
 327     {
 328         StgPtr next;
 329
 330         next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
 331         for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
 332             evacuate((StgClosure **)p);
 333         }
 334
 335         // If we're going to put this object on the mutable list, then
 336         // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
 337         if (gct->failed_to_evac) {
 338             ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
 339         } else {
 340             ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
 341         }
 342         break;
 343     }
 344
 345     case TSO:
 346     {
 347         StgTSO *tso = (StgTSO *)p;
 348
 349         gct->eager_promotion = rtsFalse;
 350         scavengeTSO(tso);
 351         gct->eager_promotion = saved_eager_promotion;
 352
 353         if (gct->failed_to_evac) {
 354             tso->flags |= TSO_DIRTY;
 355         } else {
 356             tso->flags &= ~TSO_DIRTY;
 357         }
 358
 359         gct->failed_to_evac = rtsTrue; // always on the mutable list
 360         p += tso_sizeW(tso);
 361         break;
 362     }
 363
 364     case TVAR_WATCH_QUEUE:
 365       {
 366         StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p);
 367         gct->evac_step = 0;
 368         evacuate((StgClosure **)&wq->closure);
 369         evacuate((StgClosure **)&wq->next_queue_entry);
 370         evacuate((StgClosure **)&wq->prev_queue_entry);
 371         gct->evac_step = saved_evac_step;
 372         gct->failed_to_evac = rtsTrue; // mutable
 373         p += sizeofW(StgTVarWatchQueue);
 374         break;
 375       }
 376
 377     case TVAR:
 378       {
 379         StgTVar *tvar = ((StgTVar *) p);
 380         gct->evac_step = 0;
 381         evacuate((StgClosure **)&tvar->current_value);
 382         evacuate((StgClosure **)&tvar->first_watch_queue_entry);
 383         gct->evac_step = saved_evac_step;
 384         gct->failed_to_evac = rtsTrue; // mutable
 385         p += sizeofW(StgTVar);
 386         break;
 387       }
 388
 389     case TREC_HEADER:
 390       {
 391         StgTRecHeader *trec = ((StgTRecHeader *) p);
 392         gct->evac_step = 0;
 393         evacuate((StgClosure **)&trec->enclosing_trec);
 394         evacuate((StgClosure **)&trec->current_chunk);
 395         evacuate((StgClosure **)&trec->invariants_to_check);
 396         gct->evac_step = saved_evac_step;
 397         gct->failed_to_evac = rtsTrue; // mutable
 398         p += sizeofW(StgTRecHeader);
 399         break;
 400       }
 401
 402     case TREC_CHUNK:
 403       {
 404         StgWord i;
 405         StgTRecChunk *tc = ((StgTRecChunk *) p);
 406         TRecEntry *e = &(tc -> entries[0]);
 407         gct->evac_step = 0;
 408         evacuate((StgClosure **)&tc->prev_chunk);
 409         for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
 410           evacuate((StgClosure **)&e->tvar);
 411           evacuate((StgClosure **)&e->expected_value);
 412           evacuate((StgClosure **)&e->new_value);
 413         }
 414         gct->evac_step = saved_evac_step;
 415         gct->failed_to_evac = rtsTrue; // mutable
 416         p += sizeofW(StgTRecChunk);
 417         break;
 418       }
 419
 420     case ATOMIC_INVARIANT:
 421       {
 422         StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p);
 423         gct->evac_step = 0;
 424         evacuate(&invariant->code);
 425         evacuate((StgClosure **)&invariant->last_execution);
 426         gct->evac_step = saved_evac_step;
 427         gct->failed_to_evac = rtsTrue; // mutable
 428         p += sizeofW(StgAtomicInvariant);
 429         break;
 430       }
 431
 432     case INVARIANT_CHECK_QUEUE:
 433       {
 434         StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p);
 435         gct->evac_step = 0;
 436         evacuate((StgClosure **)&queue->invariant);
 437         evacuate((StgClosure **)&queue->my_execution);
 438         evacuate((StgClosure **)&queue->next_queue_entry);
 439         gct->evac_step = saved_evac_step;
 440         gct->failed_to_evac = rtsTrue; // mutable
 441         p += sizeofW(StgInvariantCheckQueue);
 442         break;
 443       }
 444
 445     default:
 446         barf("scavenge: unimplemented/strange closure type %d @ %p",
 447              info->type, p);
 448     }
 449
 450     /*
 451      * We need to record the current object on the mutable list if
 452      *  (a) It is actually mutable, or
 453      *  (b) It contains pointers to a younger generation.
 454      * Case (b) arises if we didn't manage to promote everything that
 455      * the current object points to into the current generation.
 456      */
 457     if (gct->failed_to_evac) {
 458         gct->failed_to_evac = rtsFalse;
 459         if (bd->gen_no > 0) {
 460             recordMutableGen_GC((StgClosure *)q, &generations[bd->gen_no]);
 461         }
 462     }
 463   }
 464
 465   debugTrace(DEBUG_gc, "   scavenged %ld bytes",
 466              (unsigned long)((bd->free - scan) * sizeof(W_)));
 467 }