rts/sm/Scav.c-inc

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