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