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