rts/sm/Scav.c

   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 #include "Rts.h"
  15 #include "Storage.h"
  16 #include "MBlock.h"
  17 #include "GC.h"
  18 #include "Compact.h"
  19 #include "Evac.h"
  20 #include "Scav.h"
  21 #include "Apply.h"
  22 #include "Trace.h"
  23 #include "LdvProfile.h"
  24
  25 static void scavenge_stack (StgPtr p, StgPtr stack_end);
  26
  27 static void scavenge_large_bitmap (StgPtr p,
  28                                    StgLargeBitmap *large_bitmap,
  29                                    nat size );
  30
  31 /* Similar to scavenge_large_bitmap(), but we don't write back the
  32  * pointers we get back from evacuate().
  33  */
  34 static void
  35 scavenge_large_srt_bitmap( StgLargeSRT *large_srt )
  36 {
  37     nat i, b, size;
  38     StgWord bitmap;
  39     StgClosure **p;
  40
  41     b = 0;
  42     bitmap = large_srt->l.bitmap[b];
  43     size   = (nat)large_srt->l.size;
  44     p      = (StgClosure **)large_srt->srt;
  45     for (i = 0; i < size; ) {
  46         if ((bitmap & 1) != 0) {
  47             evacuate(*p);
  48         }
  49         i++;
  50         p++;
  51         if (i % BITS_IN(W_) == 0) {
  52             b++;
  53             bitmap = large_srt->l.bitmap[b];
  54         } else {
  55             bitmap = bitmap >> 1;
  56         }
  57     }
  58 }
  59
  60 /* evacuate the SRT.  If srt_bitmap is zero, then there isn't an
  61  * srt field in the info table.  That's ok, because we'll
  62  * never dereference it.
  63  */
  64 STATIC_INLINE void
  65 scavenge_srt (StgClosure **srt, nat srt_bitmap)
  66 {
  67   nat bitmap;
  68   StgClosure **p;
  69
  70   bitmap = srt_bitmap;
  71   p = srt;
  72
  73   if (bitmap == (StgHalfWord)(-1)) {
  74       scavenge_large_srt_bitmap( (StgLargeSRT *)srt );
  75       return;
  76   }
  77
  78   while (bitmap != 0) {
  79       if ((bitmap & 1) != 0) {
  80 #ifdef ENABLE_WIN32_DLL_SUPPORT
  81           // Special-case to handle references to closures hiding out in DLLs, since
  82           // double indirections required to get at those. The code generator knows
  83           // which is which when generating the SRT, so it stores the (indirect)
  84           // reference to the DLL closure in the table by first adding one to it.
  85           // We check for this here, and undo the addition before evacuating it.
  86           //
  87           // If the SRT entry hasn't got bit 0 set, the SRT entry points to a
  88           // closure that's fixed at link-time, and no extra magic is required.
  89           if ( (unsigned long)(*srt) & 0x1 ) {
  90               evacuate(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)));
  91           } else {
  92               evacuate(*p);
  93           }
  94 #else
  95           evacuate(*p);
  96 #endif
  97       }
  98       p++;
  99       bitmap = bitmap >> 1;
 100   }
 101 }
 102
 103
 104 STATIC_INLINE void
 105 scavenge_thunk_srt(const StgInfoTable *info)
 106 {
 107     StgThunkInfoTable *thunk_info;
 108
 109     if (!major_gc) return;
 110
 111     thunk_info = itbl_to_thunk_itbl(info);
 112     scavenge_srt((StgClosure **)GET_SRT(thunk_info), thunk_info->i.srt_bitmap);
 113 }
 114
 115 STATIC_INLINE void
 116 scavenge_fun_srt(const StgInfoTable *info)
 117 {
 118     StgFunInfoTable *fun_info;
 119
 120     if (!major_gc) return;
 121
 122     fun_info = itbl_to_fun_itbl(info);
 123     scavenge_srt((StgClosure **)GET_FUN_SRT(fun_info), fun_info->i.srt_bitmap);
 124 }
 125
 126 /* -----------------------------------------------------------------------------
 127    Scavenge a TSO.
 128    -------------------------------------------------------------------------- */
 129
 130 static void
 131 scavengeTSO (StgTSO *tso)
 132 {
 133     if (   tso->why_blocked == BlockedOnMVar
 134         || tso->why_blocked == BlockedOnBlackHole
 135         || tso->why_blocked == BlockedOnException
 136         ) {
 137         tso->block_info.closure = evacuate(tso->block_info.closure);
 138     }
 139     tso->blocked_exceptions =
 140         (StgTSO *)evacuate((StgClosure *)tso->blocked_exceptions);
 141
 142     // We don't always chase the link field: TSOs on the blackhole
 143     // queue are not automatically alive, so the link field is a
 144     // "weak" pointer in that case.
 145     if (tso->why_blocked != BlockedOnBlackHole) {
 146         tso->link = (StgTSO *)evacuate((StgClosure *)tso->link);
 147     }
 148
 149     // scavange current transaction record
 150     tso->trec = (StgTRecHeader *)evacuate((StgClosure *)tso->trec);
 151
 152     // scavenge this thread's stack
 153     scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
 154 }
 155
 156 /* -----------------------------------------------------------------------------
 157    Blocks of function args occur on the stack (at the top) and
 158    in PAPs.
 159    -------------------------------------------------------------------------- */
 160
 161 STATIC_INLINE StgPtr
 162 scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
 163 {
 164     StgPtr p;
 165     StgWord bitmap;
 166     nat size;
 167
 168     p = (StgPtr)args;
 169     switch (fun_info->f.fun_type) {
 170     case ARG_GEN:
 171         bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
 172         size = BITMAP_SIZE(fun_info->f.b.bitmap);
 173         goto small_bitmap;
 174     case ARG_GEN_BIG:
 175         size = GET_FUN_LARGE_BITMAP(fun_info)->size;
 176         scavenge_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
 177         p += size;
 178         break;
 179     default:
 180         bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
 181         size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
 182     small_bitmap:
 183         while (size > 0) {
 184             if ((bitmap & 1) == 0) {
 185                 *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
 186             }
 187             p++;
 188             bitmap = bitmap >> 1;
 189             size--;
 190         }
 191         break;
 192     }
 193     return p;
 194 }
 195
 196 STATIC_INLINE StgPtr
 197 scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
 198 {
 199     StgPtr p;
 200     StgWord bitmap;
 201     StgFunInfoTable *fun_info;
 202
 203     fun_info = get_fun_itbl(fun);
 204     ASSERT(fun_info->i.type != PAP);
 205     p = (StgPtr)payload;
 206
 207     switch (fun_info->f.fun_type) {
 208     case ARG_GEN:
 209         bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
 210         goto small_bitmap;
 211     case ARG_GEN_BIG:
 212         scavenge_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
 213         p += size;
 214         break;
 215     case ARG_BCO:
 216         scavenge_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
 217         p += size;
 218         break;
 219     default:
 220         bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
 221     small_bitmap:
 222         while (size > 0) {
 223             if ((bitmap & 1) == 0) {
 224                 *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
 225             }
 226             p++;
 227             bitmap = bitmap >> 1;
 228             size--;
 229         }
 230         break;
 231     }
 232     return p;
 233 }
 234
 235 STATIC_INLINE StgPtr
 236 scavenge_PAP (StgPAP *pap)
 237 {
 238     pap->fun = evacuate(pap->fun);
 239     return scavenge_PAP_payload (pap->fun, pap->payload, pap->n_args);
 240 }
 241
 242 STATIC_INLINE StgPtr
 243 scavenge_AP (StgAP *ap)
 244 {
 245     ap->fun = evacuate(ap->fun);
 246     return scavenge_PAP_payload (ap->fun, ap->payload, ap->n_args);
 247 }
 248
 249 /* -----------------------------------------------------------------------------
 250    Scavenge a given step until there are no more objects in this step
 251    to scavenge.
 252
 253    evac_gen is set by the caller to be either zero (for a step in a
 254    generation < N) or G where G is the generation of the step being
 255    scavenged.
 256
 257    We sometimes temporarily change evac_gen back to zero if we're
 258    scavenging a mutable object where early promotion isn't such a good
 259    idea.
 260    -------------------------------------------------------------------------- */
 261
 262 void
 263 scavenge(step *stp)
 264 {
 265   StgPtr p, q;
 266   StgInfoTable *info;
 267   bdescr *bd;
 268   nat saved_evac_gen = evac_gen;
 269
 270   p = stp->scan;
 271   bd = stp->scan_bd;
 272
 273   failed_to_evac = rtsFalse;
 274
 275   /* scavenge phase - standard breadth-first scavenging of the
 276    * evacuated objects
 277    */
 278
 279   while (bd != stp->hp_bd || p < stp->hp) {
 280
 281     // If we're at the end of this block, move on to the next block
 282     if (bd != stp->hp_bd && p == bd->free) {
 283       bd = bd->link;
 284       p = bd->start;
 285       continue;
 286     }
 287
 288     ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
 289     info = get_itbl((StgClosure *)p);
 290
 291     ASSERT(thunk_selector_depth == 0);
 292
 293     q = p;
 294     switch (info->type) {
 295
 296     case MVAR:
 297     {
 298         StgMVar *mvar = ((StgMVar *)p);
 299         evac_gen = 0;
 300         mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
 301         mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
 302         mvar->value = evacuate((StgClosure *)mvar->value);
 303         evac_gen = saved_evac_gen;
 304         failed_to_evac = rtsTrue; // mutable.
 305         p += sizeofW(StgMVar);
 306         break;
 307     }
 308
 309     case FUN_2_0:
 310         scavenge_fun_srt(info);
 311         ((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]);
 312         ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
 313         p += sizeofW(StgHeader) + 2;
 314         break;
 315
 316     case THUNK_2_0:
 317         scavenge_thunk_srt(info);
 318         ((StgThunk *)p)->payload[1] = evacuate(((StgThunk *)p)->payload[1]);
 319         ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
 320         p += sizeofW(StgThunk) + 2;
 321         break;
 322
 323     case CONSTR_2_0:
 324         ((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]);
 325         ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
 326         p += sizeofW(StgHeader) + 2;
 327         break;
 328
 329     case THUNK_1_0:
 330         scavenge_thunk_srt(info);
 331         ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
 332         p += sizeofW(StgThunk) + 1;
 333         break;
 334
 335     case FUN_1_0:
 336         scavenge_fun_srt(info);
 337     case CONSTR_1_0:
 338         ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
 339         p += sizeofW(StgHeader) + 1;
 340         break;
 341
 342     case THUNK_0_1:
 343         scavenge_thunk_srt(info);
 344         p += sizeofW(StgThunk) + 1;
 345         break;
 346
 347     case FUN_0_1:
 348         scavenge_fun_srt(info);
 349     case CONSTR_0_1:
 350         p += sizeofW(StgHeader) + 1;
 351         break;
 352
 353     case THUNK_0_2:
 354         scavenge_thunk_srt(info);
 355         p += sizeofW(StgThunk) + 2;
 356         break;
 357
 358     case FUN_0_2:
 359         scavenge_fun_srt(info);
 360     case CONSTR_0_2:
 361         p += sizeofW(StgHeader) + 2;
 362         break;
 363
 364     case THUNK_1_1:
 365         scavenge_thunk_srt(info);
 366         ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
 367         p += sizeofW(StgThunk) + 2;
 368         break;
 369
 370     case FUN_1_1:
 371         scavenge_fun_srt(info);
 372     case CONSTR_1_1:
 373         ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
 374         p += sizeofW(StgHeader) + 2;
 375         break;
 376
 377     case FUN:
 378         scavenge_fun_srt(info);
 379         goto gen_obj;
 380
 381     case THUNK:
 382     {
 383         StgPtr end;
 384
 385         scavenge_thunk_srt(info);
 386         end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs;
 387         for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
 388             *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
 389         }
 390         p += info->layout.payload.nptrs;
 391         break;
 392     }
 393
 394     gen_obj:
 395     case CONSTR:
 396     case WEAK:
 397     case STABLE_NAME:
 398     {
 399         StgPtr end;
 400
 401         end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
 402         for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
 403             *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
 404         }
 405         p += info->layout.payload.nptrs;
 406         break;
 407     }
 408
 409     case BCO: {
 410         StgBCO *bco = (StgBCO *)p;
 411         bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs);
 412         bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals);
 413         bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs);
 414         bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls);
 415         p += bco_sizeW(bco);
 416         break;
 417     }
 418
 419     case IND_PERM:
 420       if (stp->gen->no != 0) {
 421 #ifdef PROFILING
 422         // @LDV profiling
 423         // No need to call LDV_recordDead_FILL_SLOP_DYNAMIC() because an
 424         // IND_OLDGEN_PERM closure is larger than an IND_PERM closure.
 425         LDV_recordDead((StgClosure *)p, sizeofW(StgInd));
 426 #endif
 427         //
 428         // Todo: maybe use SET_HDR() and remove LDV_RECORD_CREATE()?
 429         //
 430         SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info);
 431
 432         // We pretend that p has just been created.
 433         LDV_RECORD_CREATE((StgClosure *)p);
 434       }
 435         // fall through
 436     case IND_OLDGEN_PERM:
 437         ((StgInd *)p)->indirectee = evacuate(((StgInd *)p)->indirectee);
 438         p += sizeofW(StgInd);
 439         break;
 440
 441     case MUT_VAR_CLEAN:
 442     case MUT_VAR_DIRTY: {
 443         rtsBool saved_eager_promotion = eager_promotion;
 444
 445         eager_promotion = rtsFalse;
 446         ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
 447         eager_promotion = saved_eager_promotion;
 448
 449         if (failed_to_evac) {
 450             ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
 451         } else {
 452             ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
 453         }
 454         p += sizeofW(StgMutVar);
 455         break;
 456     }
 457
 458     case CAF_BLACKHOLE:
 459     case SE_CAF_BLACKHOLE:
 460     case SE_BLACKHOLE:
 461     case BLACKHOLE:
 462         p += BLACKHOLE_sizeW();
 463         break;
 464
 465     case THUNK_SELECTOR:
 466     {
 467         StgSelector *s = (StgSelector *)p;
 468         s->selectee = evacuate(s->selectee);
 469         p += THUNK_SELECTOR_sizeW();
 470         break;
 471     }
 472
 473     // A chunk of stack saved in a heap object
 474     case AP_STACK:
 475     {
 476         StgAP_STACK *ap = (StgAP_STACK *)p;
 477
 478         ap->fun = evacuate(ap->fun);
 479         scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
 480         p = (StgPtr)ap->payload + ap->size;
 481         break;
 482     }
 483
 484     case PAP:
 485         p = scavenge_PAP((StgPAP *)p);
 486         break;
 487
 488     case AP:
 489         p = scavenge_AP((StgAP *)p);
 490         break;
 491
 492     case ARR_WORDS:
 493         // nothing to follow
 494         p += arr_words_sizeW((StgArrWords *)p);
 495         break;
 496
 497     case MUT_ARR_PTRS_CLEAN:
 498     case MUT_ARR_PTRS_DIRTY:
 499         // follow everything
 500     {
 501         StgPtr next;
 502         rtsBool saved_eager;
 503
 504         // We don't eagerly promote objects pointed to by a mutable
 505         // array, but if we find the array only points to objects in
 506         // the same or an older generation, we mark it "clean" and
 507         // avoid traversing it during minor GCs.
 508         saved_eager = eager_promotion;
 509         eager_promotion = rtsFalse;
 510         next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
 511         for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
 512             *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
 513         }
 514         eager_promotion = saved_eager;
 515
 516         if (failed_to_evac) {
 517             ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
 518         } else {
 519             ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
 520         }
 521
 522         failed_to_evac = rtsTrue; // always put it on the mutable list.
 523         break;
 524     }
 525
 526     case MUT_ARR_PTRS_FROZEN:
 527     case MUT_ARR_PTRS_FROZEN0:
 528         // follow everything
 529     {
 530         StgPtr next;
 531
 532         next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
 533         for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
 534             *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
 535         }
 536
 537         // If we're going to put this object on the mutable list, then
 538         // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
 539         if (failed_to_evac) {
 540             ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
 541         } else {
 542             ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
 543         }
 544         break;
 545     }
 546
 547     case TSO:
 548     {
 549         StgTSO *tso = (StgTSO *)p;
 550         rtsBool saved_eager = eager_promotion;
 551
 552         eager_promotion = rtsFalse;
 553         scavengeTSO(tso);
 554         eager_promotion = saved_eager;
 555
 556         if (failed_to_evac) {
 557             tso->flags |= TSO_DIRTY;
 558         } else {
 559             tso->flags &= ~TSO_DIRTY;
 560         }
 561
 562         failed_to_evac = rtsTrue; // always on the mutable list
 563         p += tso_sizeW(tso);
 564         break;
 565     }
 566
 567     case TVAR_WATCH_QUEUE:
 568       {
 569         StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p);
 570         evac_gen = 0;
 571         wq->closure = (StgClosure*)evacuate((StgClosure*)wq->closure);
 572         wq->next_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->next_queue_entry);
 573         wq->prev_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
 574         evac_gen = saved_evac_gen;
 575         failed_to_evac = rtsTrue; // mutable
 576         p += sizeofW(StgTVarWatchQueue);
 577         break;
 578       }
 579
 580     case TVAR:
 581       {
 582         StgTVar *tvar = ((StgTVar *) p);
 583         evac_gen = 0;
 584         tvar->current_value = evacuate((StgClosure*)tvar->current_value);
 585         tvar->first_watch_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)tvar->first_watch_queue_entry);
 586         evac_gen = saved_evac_gen;
 587         failed_to_evac = rtsTrue; // mutable
 588         p += sizeofW(StgTVar);
 589         break;
 590       }
 591
 592     case TREC_HEADER:
 593       {
 594         StgTRecHeader *trec = ((StgTRecHeader *) p);
 595         evac_gen = 0;
 596         trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec);
 597         trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk);
 598         trec->invariants_to_check = (StgInvariantCheckQueue *)evacuate((StgClosure*)trec->invariants_to_check);
 599         evac_gen = saved_evac_gen;
 600         failed_to_evac = rtsTrue; // mutable
 601         p += sizeofW(StgTRecHeader);
 602         break;
 603       }
 604
 605     case TREC_CHUNK:
 606       {
 607         StgWord i;
 608         StgTRecChunk *tc = ((StgTRecChunk *) p);
 609         TRecEntry *e = &(tc -> entries[0]);
 610         evac_gen = 0;
 611         tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk);
 612         for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
 613           e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar);
 614           e->expected_value = evacuate((StgClosure*)e->expected_value);
 615           e->new_value = evacuate((StgClosure*)e->new_value);
 616         }
 617         evac_gen = saved_evac_gen;
 618         failed_to_evac = rtsTrue; // mutable
 619         p += sizeofW(StgTRecChunk);
 620         break;
 621       }
 622
 623     case ATOMIC_INVARIANT:
 624       {
 625         StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p);
 626         evac_gen = 0;
 627         invariant->code = (StgClosure *)evacuate(invariant->code);
 628         invariant->last_execution = (StgTRecHeader *)evacuate((StgClosure*)invariant->last_execution);
 629         evac_gen = saved_evac_gen;
 630         failed_to_evac = rtsTrue; // mutable
 631         p += sizeofW(StgAtomicInvariant);
 632         break;
 633       }
 634
 635     case INVARIANT_CHECK_QUEUE:
 636       {
 637         StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p);
 638         evac_gen = 0;
 639         queue->invariant = (StgAtomicInvariant *)evacuate((StgClosure*)queue->invariant);
 640         queue->my_execution = (StgTRecHeader *)evacuate((StgClosure*)queue->my_execution);
 641         queue->next_queue_entry = (StgInvariantCheckQueue *)evacuate((StgClosure*)queue->next_queue_entry);
 642         evac_gen = saved_evac_gen;
 643         failed_to_evac = rtsTrue; // mutable
 644         p += sizeofW(StgInvariantCheckQueue);
 645         break;
 646       }
 647
 648     default:
 649         barf("scavenge: unimplemented/strange closure type %d @ %p",
 650              info->type, p);
 651     }
 652
 653     /*
 654      * We need to record the current object on the mutable list if
 655      *  (a) It is actually mutable, or
 656      *  (b) It contains pointers to a younger generation.
 657      * Case (b) arises if we didn't manage to promote everything that
 658      * the current object points to into the current generation.
 659      */
 660     if (failed_to_evac) {
 661         failed_to_evac = rtsFalse;
 662         if (stp->gen_no > 0) {
 663             recordMutableGen((StgClosure *)q, stp->gen);
 664         }
 665     }
 666   }
 667
 668   stp->scan_bd = bd;
 669   stp->scan = p;
 670 }
 671
 672 /* -----------------------------------------------------------------------------
 673    Scavenge everything on the mark stack.
 674
 675    This is slightly different from scavenge():
 676       - we don't walk linearly through the objects, so the scavenger
 677         doesn't need to advance the pointer on to the next object.
 678    -------------------------------------------------------------------------- */
 679
 680 void
 681 scavenge_mark_stack(void)
 682 {
 683     StgPtr p, q;
 684     StgInfoTable *info;
 685     nat saved_evac_gen;
 686
 687     evac_gen = oldest_gen->no;
 688     saved_evac_gen = evac_gen;
 689
 690 linear_scan:
 691     while (!mark_stack_empty()) {
 692         p = pop_mark_stack();
 693
 694         ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
 695         info = get_itbl((StgClosure *)p);
 696
 697         q = p;
 698         switch (info->type) {
 699
 700         case MVAR:
 701         {
 702             StgMVar *mvar = ((StgMVar *)p);
 703             evac_gen = 0;
 704             mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
 705             mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
 706             mvar->value = evacuate((StgClosure *)mvar->value);
 707             evac_gen = saved_evac_gen;
 708             failed_to_evac = rtsTrue; // mutable.
 709             break;
 710         }
 711
 712         case FUN_2_0:
 713             scavenge_fun_srt(info);
 714             ((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]);
 715             ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
 716             break;
 717
 718         case THUNK_2_0:
 719             scavenge_thunk_srt(info);
 720             ((StgThunk *)p)->payload[1] = evacuate(((StgThunk *)p)->payload[1]);
 721             ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
 722             break;
 723
 724         case CONSTR_2_0:
 725             ((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]);
 726             ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
 727             break;
 728
 729         case FUN_1_0:
 730         case FUN_1_1:
 731             scavenge_fun_srt(info);
 732             ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
 733             break;
 734
 735         case THUNK_1_0:
 736         case THUNK_1_1:
 737             scavenge_thunk_srt(info);
 738             ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
 739             break;
 740
 741         case CONSTR_1_0:
 742         case CONSTR_1_1:
 743             ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
 744             break;
 745
 746         case FUN_0_1:
 747         case FUN_0_2:
 748             scavenge_fun_srt(info);
 749             break;
 750
 751         case THUNK_0_1:
 752         case THUNK_0_2:
 753             scavenge_thunk_srt(info);
 754             break;
 755
 756         case CONSTR_0_1:
 757         case CONSTR_0_2:
 758             break;
 759
 760         case FUN:
 761             scavenge_fun_srt(info);
 762             goto gen_obj;
 763
 764         case THUNK:
 765         {
 766             StgPtr end;
 767
 768             scavenge_thunk_srt(info);
 769             end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs;
 770             for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
 771                 *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
 772             }
 773             break;
 774         }
 775
 776         gen_obj:
 777         case CONSTR:
 778         case WEAK:
 779         case STABLE_NAME:
 780         {
 781             StgPtr end;
 782
 783             end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
 784             for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
 785                 *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
 786             }
 787             break;
 788         }
 789
 790         case BCO: {
 791             StgBCO *bco = (StgBCO *)p;
 792             bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs);
 793             bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals);
 794             bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs);
 795             bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls);
 796             break;
 797         }
 798
 799         case IND_PERM:
 800             // don't need to do anything here: the only possible case
 801             // is that we're in a 1-space compacting collector, with
 802             // no "old" generation.
 803             break;
 804
 805         case IND_OLDGEN:
 806         case IND_OLDGEN_PERM:
 807             ((StgInd *)p)->indirectee =
 808                 evacuate(((StgInd *)p)->indirectee);
 809             break;
 810
 811         case MUT_VAR_CLEAN:
 812         case MUT_VAR_DIRTY: {
 813             rtsBool saved_eager_promotion = eager_promotion;
 814
 815             eager_promotion = rtsFalse;
 816             ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
 817             eager_promotion = saved_eager_promotion;
 818
 819             if (failed_to_evac) {
 820                 ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
 821             } else {
 822                 ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
 823             }
 824             break;
 825         }
 826
 827         case CAF_BLACKHOLE:
 828         case SE_CAF_BLACKHOLE:
 829         case SE_BLACKHOLE:
 830         case BLACKHOLE:
 831         case ARR_WORDS:
 832             break;
 833
 834         case THUNK_SELECTOR:
 835         {
 836             StgSelector *s = (StgSelector *)p;
 837             s->selectee = evacuate(s->selectee);
 838             break;
 839         }
 840
 841         // A chunk of stack saved in a heap object
 842         case AP_STACK:
 843         {
 844             StgAP_STACK *ap = (StgAP_STACK *)p;
 845
 846             ap->fun = evacuate(ap->fun);
 847             scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
 848             break;
 849         }
 850
 851         case PAP:
 852             scavenge_PAP((StgPAP *)p);
 853             break;
 854
 855         case AP:
 856             scavenge_AP((StgAP *)p);
 857             break;
 858
 859         case MUT_ARR_PTRS_CLEAN:
 860         case MUT_ARR_PTRS_DIRTY:
 861             // follow everything
 862         {
 863             StgPtr next;
 864             rtsBool saved_eager;
 865
 866             // We don't eagerly promote objects pointed to by a mutable
 867             // array, but if we find the array only points to objects in
 868             // the same or an older generation, we mark it "clean" and
 869             // avoid traversing it during minor GCs.
 870             saved_eager = eager_promotion;
 871             eager_promotion = rtsFalse;
 872             next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
 873             for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
 874                 *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
 875             }
 876             eager_promotion = saved_eager;
 877
 878             if (failed_to_evac) {
 879                 ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
 880             } else {
 881                 ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
 882             }
 883
 884             failed_to_evac = rtsTrue; // mutable anyhow.
 885             break;
 886         }
 887
 888         case MUT_ARR_PTRS_FROZEN:
 889         case MUT_ARR_PTRS_FROZEN0:
 890             // follow everything
 891         {
 892             StgPtr next, q = p;
 893
 894             next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
 895             for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
 896                 *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
 897             }
 898
 899             // If we're going to put this object on the mutable list, then
 900             // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
 901             if (failed_to_evac) {
 902                 ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
 903             } else {
 904                 ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
 905             }
 906             break;
 907         }
 908
 909         case TSO:
 910         {
 911             StgTSO *tso = (StgTSO *)p;
 912             rtsBool saved_eager = eager_promotion;
 913
 914             eager_promotion = rtsFalse;
 915             scavengeTSO(tso);
 916             eager_promotion = saved_eager;
 917
 918             if (failed_to_evac) {
 919                 tso->flags |= TSO_DIRTY;
 920             } else {
 921                 tso->flags &= ~TSO_DIRTY;
 922             }
 923
 924             failed_to_evac = rtsTrue; // always on the mutable list
 925             break;
 926         }
 927
 928         case TVAR_WATCH_QUEUE:
 929           {
 930             StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p);
 931             evac_gen = 0;
 932             wq->closure = (StgClosure*)evacuate((StgClosure*)wq->closure);
 933             wq->next_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->next_queue_entry);
 934             wq->prev_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
 935             evac_gen = saved_evac_gen;
 936             failed_to_evac = rtsTrue; // mutable
 937             break;
 938           }
 939
 940         case TVAR:
 941           {
 942             StgTVar *tvar = ((StgTVar *) p);
 943             evac_gen = 0;
 944             tvar->current_value = evacuate((StgClosure*)tvar->current_value);
 945             tvar->first_watch_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)tvar->first_watch_queue_entry);
 946             evac_gen = saved_evac_gen;
 947             failed_to_evac = rtsTrue; // mutable
 948             break;
 949           }
 950
 951         case TREC_CHUNK:
 952           {
 953             StgWord i;
 954             StgTRecChunk *tc = ((StgTRecChunk *) p);
 955             TRecEntry *e = &(tc -> entries[0]);
 956             evac_gen = 0;
 957             tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk);
 958             for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
 959               e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar);
 960               e->expected_value = evacuate((StgClosure*)e->expected_value);
 961               e->new_value = evacuate((StgClosure*)e->new_value);
 962             }
 963             evac_gen = saved_evac_gen;
 964             failed_to_evac = rtsTrue; // mutable
 965             break;
 966           }
 967
 968         case TREC_HEADER:
 969           {
 970             StgTRecHeader *trec = ((StgTRecHeader *) p);
 971             evac_gen = 0;
 972             trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec);
 973             trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk);
 974             trec->invariants_to_check = (StgInvariantCheckQueue *)evacuate((StgClosure*)trec->invariants_to_check);
 975             evac_gen = saved_evac_gen;
 976             failed_to_evac = rtsTrue; // mutable
 977             break;
 978           }
 979
 980         case ATOMIC_INVARIANT:
 981           {
 982             StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p);
 983             evac_gen = 0;
 984             invariant->code = (StgClosure *)evacuate(invariant->code);
 985             invariant->last_execution = (StgTRecHeader *)evacuate((StgClosure*)invariant->last_execution);
 986             evac_gen = saved_evac_gen;
 987             failed_to_evac = rtsTrue; // mutable
 988             break;
 989           }
 990
 991         case INVARIANT_CHECK_QUEUE:
 992           {
 993             StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p);
 994             evac_gen = 0;
 995             queue->invariant = (StgAtomicInvariant *)evacuate((StgClosure*)queue->invariant);
 996             queue->my_execution = (StgTRecHeader *)evacuate((StgClosure*)queue->my_execution);
 997             queue->next_queue_entry = (StgInvariantCheckQueue *)evacuate((StgClosure*)queue->next_queue_entry);
 998             evac_gen = saved_evac_gen;
 999             failed_to_evac = rtsTrue; // mutable
1000             break;
1001           }
1002
1003         default:
1004             barf("scavenge_mark_stack: unimplemented/strange closure type %d @ %p",
1005                  info->type, p);
1006         }
1007
1008         if (failed_to_evac) {
1009             failed_to_evac = rtsFalse;
1010             if (evac_gen > 0) {
1011                 recordMutableGen((StgClosure *)q, &generations[evac_gen]);
1012             }
1013         }
1014
1015         // mark the next bit to indicate "scavenged"
1016         mark(q+1, Bdescr(q));
1017
1018     } // while (!mark_stack_empty())
1019
1020     // start a new linear scan if the mark stack overflowed at some point
1021     if (mark_stack_overflowed && oldgen_scan_bd == NULL) {
1022         debugTrace(DEBUG_gc, "scavenge_mark_stack: starting linear scan");
1023         mark_stack_overflowed = rtsFalse;
1024         oldgen_scan_bd = oldest_gen->steps[0].old_blocks;
1025         oldgen_scan = oldgen_scan_bd->start;
1026     }
1027
1028     if (oldgen_scan_bd) {
1029         // push a new thing on the mark stack
1030     loop:
1031         // find a closure that is marked but not scavenged, and start
1032         // from there.
1033         while (oldgen_scan < oldgen_scan_bd->free
1034                && !is_marked(oldgen_scan,oldgen_scan_bd)) {
1035             oldgen_scan++;
1036         }
1037
1038         if (oldgen_scan < oldgen_scan_bd->free) {
1039
1040             // already scavenged?
1041             if (is_marked(oldgen_scan+1,oldgen_scan_bd)) {
1042                 oldgen_scan += sizeofW(StgHeader) + MIN_PAYLOAD_SIZE;
1043                 goto loop;
1044             }
1045             push_mark_stack(oldgen_scan);
1046             // ToDo: bump the linear scan by the actual size of the object
1047             oldgen_scan += sizeofW(StgHeader) + MIN_PAYLOAD_SIZE;
1048             goto linear_scan;
1049         }
1050
1051         oldgen_scan_bd = oldgen_scan_bd->link;
1052         if (oldgen_scan_bd != NULL) {
1053             oldgen_scan = oldgen_scan_bd->start;
1054             goto loop;
1055         }
1056     }
1057 }
1058
1059 /* -----------------------------------------------------------------------------
1060    Scavenge one object.
1061
1062    This is used for objects that are temporarily marked as mutable
1063    because they contain old-to-new generation pointers.  Only certain
1064    objects can have this property.
1065    -------------------------------------------------------------------------- */
1066
1067 static rtsBool
1068 scavenge_one(StgPtr p)
1069 {
1070     const StgInfoTable *info;
1071     nat saved_evac_gen = evac_gen;
1072     rtsBool no_luck;
1073
1074     ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
1075     info = get_itbl((StgClosure *)p);
1076
1077     switch (info->type) {
1078
1079     case MVAR:
1080     {
1081         StgMVar *mvar = ((StgMVar *)p);
1082         evac_gen = 0;
1083         mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
1084         mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
1085         mvar->value = evacuate((StgClosure *)mvar->value);
1086         evac_gen = saved_evac_gen;
1087         failed_to_evac = rtsTrue; // mutable.
1088         break;
1089     }
1090
1091     case THUNK:
1092     case THUNK_1_0:
1093     case THUNK_0_1:
1094     case THUNK_1_1:
1095     case THUNK_0_2:
1096     case THUNK_2_0:
1097     {
1098         StgPtr q, end;
1099
1100         end = (StgPtr)((StgThunk *)p)->payload + info->layout.payload.ptrs;
1101         for (q = (StgPtr)((StgThunk *)p)->payload; q < end; q++) {
1102             *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q);
1103         }
1104         break;
1105     }
1106
1107     case FUN:
1108     case FUN_1_0:                       // hardly worth specialising these guys
1109     case FUN_0_1:
1110     case FUN_1_1:
1111     case FUN_0_2:
1112     case FUN_2_0:
1113     case CONSTR:
1114     case CONSTR_1_0:
1115     case CONSTR_0_1:
1116     case CONSTR_1_1:
1117     case CONSTR_0_2:
1118     case CONSTR_2_0:
1119     case WEAK:
1120     case IND_PERM:
1121     {
1122         StgPtr q, end;
1123
1124         end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs;
1125         for (q = (StgPtr)((StgClosure *)p)->payload; q < end; q++) {
1126             *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q);
1127         }
1128         break;
1129     }
1130
1131     case MUT_VAR_CLEAN:
1132     case MUT_VAR_DIRTY: {
1133         StgPtr q = p;
1134         rtsBool saved_eager_promotion = eager_promotion;
1135
1136         eager_promotion = rtsFalse;
1137         ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
1138         eager_promotion = saved_eager_promotion;
1139
1140         if (failed_to_evac) {
1141             ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
1142         } else {
1143             ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
1144         }
1145         break;
1146     }
1147
1148     case CAF_BLACKHOLE:
1149     case SE_CAF_BLACKHOLE:
1150     case SE_BLACKHOLE:
1151     case BLACKHOLE:
1152         break;
1153
1154     case THUNK_SELECTOR:
1155     {
1156         StgSelector *s = (StgSelector *)p;
1157         s->selectee = evacuate(s->selectee);
1158         break;
1159     }
1160
1161     case AP_STACK:
1162     {
1163         StgAP_STACK *ap = (StgAP_STACK *)p;
1164
1165         ap->fun = evacuate(ap->fun);
1166         scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
1167         p = (StgPtr)ap->payload + ap->size;
1168         break;
1169     }
1170
1171     case PAP:
1172         p = scavenge_PAP((StgPAP *)p);
1173         break;
1174
1175     case AP:
1176         p = scavenge_AP((StgAP *)p);
1177         break;
1178
1179     case ARR_WORDS:
1180         // nothing to follow
1181         break;
1182
1183     case MUT_ARR_PTRS_CLEAN:
1184     case MUT_ARR_PTRS_DIRTY:
1185     {
1186         StgPtr next, q;
1187         rtsBool saved_eager;
1188
1189         // We don't eagerly promote objects pointed to by a mutable
1190         // array, but if we find the array only points to objects in
1191         // the same or an older generation, we mark it "clean" and
1192         // avoid traversing it during minor GCs.
1193         saved_eager = eager_promotion;
1194         eager_promotion = rtsFalse;
1195         q = p;
1196         next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1197         for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
1198             *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
1199         }
1200         eager_promotion = saved_eager;
1201
1202         if (failed_to_evac) {
1203             ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
1204         } else {
1205             ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
1206         }
1207
1208         failed_to_evac = rtsTrue;
1209         break;
1210     }
1211
1212     case MUT_ARR_PTRS_FROZEN:
1213     case MUT_ARR_PTRS_FROZEN0:
1214     {
1215         // follow everything
1216         StgPtr next, q=p;
1217
1218         next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1219         for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
1220             *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
1221         }
1222
1223         // If we're going to put this object on the mutable list, then
1224         // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
1225         if (failed_to_evac) {
1226             ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
1227         } else {
1228             ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
1229         }
1230         break;
1231     }
1232
1233     case TSO:
1234     {
1235         StgTSO *tso = (StgTSO *)p;
1236         rtsBool saved_eager = eager_promotion;
1237
1238         eager_promotion = rtsFalse;
1239         scavengeTSO(tso);
1240         eager_promotion = saved_eager;
1241
1242         if (failed_to_evac) {
1243             tso->flags |= TSO_DIRTY;
1244         } else {
1245             tso->flags &= ~TSO_DIRTY;
1246         }
1247
1248         failed_to_evac = rtsTrue; // always on the mutable list
1249         break;
1250     }
1251
1252     case TVAR_WATCH_QUEUE:
1253       {
1254         StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p);
1255         evac_gen = 0;
1256         wq->closure = (StgClosure*)evacuate((StgClosure*)wq->closure);
1257         wq->next_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->next_queue_entry);
1258         wq->prev_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
1259         evac_gen = saved_evac_gen;
1260         failed_to_evac = rtsTrue; // mutable
1261         break;
1262       }
1263
1264     case TVAR:
1265       {
1266         StgTVar *tvar = ((StgTVar *) p);
1267         evac_gen = 0;
1268         tvar->current_value = evacuate((StgClosure*)tvar->current_value);
1269         tvar->first_watch_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)tvar->first_watch_queue_entry);
1270         evac_gen = saved_evac_gen;
1271         failed_to_evac = rtsTrue; // mutable
1272         break;
1273       }
1274
1275     case TREC_HEADER:
1276       {
1277         StgTRecHeader *trec = ((StgTRecHeader *) p);
1278         evac_gen = 0;
1279         trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec);
1280         trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk);
1281         trec->invariants_to_check = (StgInvariantCheckQueue *)evacuate((StgClosure*)trec->invariants_to_check);
1282         evac_gen = saved_evac_gen;
1283         failed_to_evac = rtsTrue; // mutable
1284         break;
1285       }
1286
1287     case TREC_CHUNK:
1288       {
1289         StgWord i;
1290         StgTRecChunk *tc = ((StgTRecChunk *) p);
1291         TRecEntry *e = &(tc -> entries[0]);
1292         evac_gen = 0;
1293         tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk);
1294         for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
1295           e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar);
1296           e->expected_value = evacuate((StgClosure*)e->expected_value);
1297           e->new_value = evacuate((StgClosure*)e->new_value);
1298         }
1299         evac_gen = saved_evac_gen;
1300         failed_to_evac = rtsTrue; // mutable
1301         break;
1302       }
1303
1304     case ATOMIC_INVARIANT:
1305     {
1306       StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p);
1307       evac_gen = 0;
1308       invariant->code = (StgClosure *)evacuate(invariant->code);
1309       invariant->last_execution = (StgTRecHeader *)evacuate((StgClosure*)invariant->last_execution);
1310       evac_gen = saved_evac_gen;
1311       failed_to_evac = rtsTrue; // mutable
1312       break;
1313     }
1314
1315     case INVARIANT_CHECK_QUEUE:
1316     {
1317       StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p);
1318       evac_gen = 0;
1319       queue->invariant = (StgAtomicInvariant *)evacuate((StgClosure*)queue->invariant);
1320       queue->my_execution = (StgTRecHeader *)evacuate((StgClosure*)queue->my_execution);
1321       queue->next_queue_entry = (StgInvariantCheckQueue *)evacuate((StgClosure*)queue->next_queue_entry);
1322       evac_gen = saved_evac_gen;
1323       failed_to_evac = rtsTrue; // mutable
1324       break;
1325     }
1326
1327     case IND_OLDGEN:
1328     case IND_OLDGEN_PERM:
1329     case IND_STATIC:
1330     {
1331         /* Careful here: a THUNK can be on the mutable list because
1332          * it contains pointers to young gen objects.  If such a thunk
1333          * is updated, the IND_OLDGEN will be added to the mutable
1334          * list again, and we'll scavenge it twice.  evacuate()
1335          * doesn't check whether the object has already been
1336          * evacuated, so we perform that check here.
1337          */
1338         StgClosure *q = ((StgInd *)p)->indirectee;
1339         if (HEAP_ALLOCED(q) && Bdescr((StgPtr)q)->flags & BF_EVACUATED) {
1340             break;
1341         }
1342         ((StgInd *)p)->indirectee = evacuate(q);
1343     }
1344
1345 #if 0 && defined(DEBUG)
1346       if (RtsFlags.DebugFlags.gc)
1347       /* Debugging code to print out the size of the thing we just
1348        * promoted
1349        */
1350       {
1351         StgPtr start = gen->steps[0].scan;
1352         bdescr *start_bd = gen->steps[0].scan_bd;
1353         nat size = 0;
1354         scavenge(&gen->steps[0]);
1355         if (start_bd != gen->steps[0].scan_bd) {
1356           size += (P_)BLOCK_ROUND_UP(start) - start;
1357           start_bd = start_bd->link;
1358           while (start_bd != gen->steps[0].scan_bd) {
1359             size += BLOCK_SIZE_W;
1360             start_bd = start_bd->link;
1361           }
1362           size += gen->steps[0].scan -
1363             (P_)BLOCK_ROUND_DOWN(gen->steps[0].scan);
1364         } else {
1365           size = gen->steps[0].scan - start;
1366         }
1367         debugBelch("evac IND_OLDGEN: %ld bytes", size * sizeof(W_));
1368       }
1369 #endif
1370       break;
1371
1372     default:
1373         barf("scavenge_one: strange object %d", (int)(info->type));
1374     }
1375
1376     no_luck = failed_to_evac;
1377     failed_to_evac = rtsFalse;
1378     return (no_luck);
1379 }
1380
1381 /* -----------------------------------------------------------------------------
1382    Scavenging mutable lists.
1383
1384    We treat the mutable list of each generation > N (i.e. all the
1385    generations older than the one being collected) as roots.  We also
1386    remove non-mutable objects from the mutable list at this point.
1387    -------------------------------------------------------------------------- */
1388
1389 void
1390 scavenge_mutable_list(generation *gen)
1391 {
1392     bdescr *bd;
1393     StgPtr p, q;
1394
1395     bd = gen->saved_mut_list;
1396
1397     evac_gen = gen->no;
1398     for (; bd != NULL; bd = bd->link) {
1399         for (q = bd->start; q < bd->free; q++) {
1400             p = (StgPtr)*q;
1401             ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
1402
1403 #ifdef DEBUG
1404             switch (get_itbl((StgClosure *)p)->type) {
1405             case MUT_VAR_CLEAN:
1406                 barf("MUT_VAR_CLEAN on mutable list");
1407             case MUT_VAR_DIRTY:
1408                 mutlist_MUTVARS++; break;
1409             case MUT_ARR_PTRS_CLEAN:
1410             case MUT_ARR_PTRS_DIRTY:
1411             case MUT_ARR_PTRS_FROZEN:
1412             case MUT_ARR_PTRS_FROZEN0:
1413                 mutlist_MUTARRS++; break;
1414             default:
1415                 mutlist_OTHERS++; break;
1416             }
1417 #endif
1418
1419             // Check whether this object is "clean", that is it
1420             // definitely doesn't point into a young generation.
1421             // Clean objects don't need to be scavenged.  Some clean
1422             // objects (MUT_VAR_CLEAN) are not kept on the mutable
1423             // list at all; others, such as MUT_ARR_PTRS_CLEAN and
1424             // TSO, are always on the mutable list.
1425             //
1426             switch (get_itbl((StgClosure *)p)->type) {
1427             case MUT_ARR_PTRS_CLEAN:
1428                 recordMutableGen((StgClosure *)p,gen);
1429                 continue;
1430             case TSO: {
1431                 StgTSO *tso = (StgTSO *)p;
1432                 if ((tso->flags & TSO_DIRTY) == 0) {
1433                     // A clean TSO: we don't have to traverse its
1434                     // stack.  However, we *do* follow the link field:
1435                     // we don't want to have to mark a TSO dirty just
1436                     // because we put it on a different queue.
1437                     if (tso->why_blocked != BlockedOnBlackHole) {
1438                         tso->link = (StgTSO *)evacuate((StgClosure *)tso->link);
1439                     }
1440                     recordMutableGen((StgClosure *)p,gen);
1441                     continue;
1442                 }
1443             }
1444             default:
1445                 ;
1446             }
1447
1448             if (scavenge_one(p)) {
1449                 // didn't manage to promote everything, so put the
1450                 // object back on the list.
1451                 recordMutableGen((StgClosure *)p,gen);
1452             }
1453         }
1454     }
1455
1456     // free the old mut_list
1457     freeChain(gen->saved_mut_list);
1458     gen->saved_mut_list = NULL;
1459 }
1460
1461 /* -----------------------------------------------------------------------------
1462    Scavenging the static objects.
1463
1464    We treat the mutable list of each generation > N (i.e. all the
1465    generations older than the one being collected) as roots.  We also
1466    remove non-mutable objects from the mutable list at this point.
1467    -------------------------------------------------------------------------- */
1468
1469 void
1470 scavenge_static(void)
1471 {
1472   StgClosure* p = static_objects;
1473   const StgInfoTable *info;
1474
1475   /* Always evacuate straight to the oldest generation for static
1476    * objects */
1477   evac_gen = oldest_gen->no;
1478
1479   /* keep going until we've scavenged all the objects on the linked
1480      list... */
1481   while (p != END_OF_STATIC_LIST) {
1482
1483     ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
1484     info = get_itbl(p);
1485     /*
1486     if (info->type==RBH)
1487       info = REVERT_INFOPTR(info); // if it's an RBH, look at the orig closure
1488     */
1489     // make sure the info pointer is into text space
1490
1491     /* Take this object *off* the static_objects list,
1492      * and put it on the scavenged_static_objects list.
1493      */
1494     static_objects = *STATIC_LINK(info,p);
1495     *STATIC_LINK(info,p) = scavenged_static_objects;
1496     scavenged_static_objects = p;
1497
1498     switch (info -> type) {
1499
1500     case IND_STATIC:
1501       {
1502         StgInd *ind = (StgInd *)p;
1503         ind->indirectee = evacuate(ind->indirectee);
1504
1505         /* might fail to evacuate it, in which case we have to pop it
1506          * back on the mutable list of the oldest generation.  We
1507          * leave it *on* the scavenged_static_objects list, though,
1508          * in case we visit this object again.
1509          */
1510         if (failed_to_evac) {
1511           failed_to_evac = rtsFalse;
1512           recordMutableGen((StgClosure *)p,oldest_gen);
1513         }
1514         break;
1515       }
1516
1517     case THUNK_STATIC:
1518       scavenge_thunk_srt(info);
1519       break;
1520
1521     case FUN_STATIC:
1522       scavenge_fun_srt(info);
1523       break;
1524
1525     case CONSTR_STATIC:
1526       {
1527         StgPtr q, next;
1528
1529         next = (P_)p->payload + info->layout.payload.ptrs;
1530         // evacuate the pointers
1531         for (q = (P_)p->payload; q < next; q++) {
1532             *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q);
1533         }
1534         break;
1535       }
1536
1537     default:
1538       barf("scavenge_static: strange closure %d", (int)(info->type));
1539     }
1540
1541     ASSERT(failed_to_evac == rtsFalse);
1542
1543     /* get the next static object from the list.  Remember, there might
1544      * be more stuff on this list now that we've done some evacuating!
1545      * (static_objects is a global)
1546      */
1547     p = static_objects;
1548   }
1549 }
1550
1551 /* -----------------------------------------------------------------------------
1552    scavenge a chunk of memory described by a bitmap
1553    -------------------------------------------------------------------------- */
1554
1555 static void
1556 scavenge_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
1557 {
1558     nat i, b;
1559     StgWord bitmap;
1560
1561     b = 0;
1562     bitmap = large_bitmap->bitmap[b];
1563     for (i = 0; i < size; ) {
1564         if ((bitmap & 1) == 0) {
1565             *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
1566         }
1567         i++;
1568         p++;
1569         if (i % BITS_IN(W_) == 0) {
1570             b++;
1571             bitmap = large_bitmap->bitmap[b];
1572         } else {
1573             bitmap = bitmap >> 1;
1574         }
1575     }
1576 }
1577
1578 STATIC_INLINE StgPtr
1579 scavenge_small_bitmap (StgPtr p, nat size, StgWord bitmap)
1580 {
1581     while (size > 0) {
1582         if ((bitmap & 1) == 0) {
1583             *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
1584         }
1585         p++;
1586         bitmap = bitmap >> 1;
1587         size--;
1588     }
1589     return p;
1590 }
1591
1592 /* -----------------------------------------------------------------------------
1593    scavenge_stack walks over a section of stack and evacuates all the
1594    objects pointed to by it.  We can use the same code for walking
1595    AP_STACK_UPDs, since these are just sections of copied stack.
1596    -------------------------------------------------------------------------- */
1597
1598 static void
1599 scavenge_stack(StgPtr p, StgPtr stack_end)
1600 {
1601   const StgRetInfoTable* info;
1602   StgWord bitmap;
1603   nat size;
1604
1605   /*
1606    * Each time around this loop, we are looking at a chunk of stack
1607    * that starts with an activation record.
1608    */
1609
1610   while (p < stack_end) {
1611     info  = get_ret_itbl((StgClosure *)p);
1612
1613     switch (info->i.type) {
1614
1615     case UPDATE_FRAME:
1616         // In SMP, we can get update frames that point to indirections
1617         // when two threads evaluate the same thunk.  We do attempt to
1618         // discover this situation in threadPaused(), but it's
1619         // possible that the following sequence occurs:
1620         //
1621         //        A             B
1622         //                  enter T
1623         //     enter T
1624         //     blackhole T
1625         //                  update T
1626         //     GC
1627         //
1628         // Now T is an indirection, and the update frame is already
1629         // marked on A's stack, so we won't traverse it again in
1630         // threadPaused().  We could traverse the whole stack again
1631         // before GC, but that seems like overkill.
1632         //
1633         // Scavenging this update frame as normal would be disastrous;
1634         // the updatee would end up pointing to the value.  So we turn
1635         // the indirection into an IND_PERM, so that evacuate will
1636         // copy the indirection into the old generation instead of
1637         // discarding it.
1638         if (get_itbl(((StgUpdateFrame *)p)->updatee)->type == IND) {
1639             ((StgUpdateFrame *)p)->updatee->header.info =
1640                 (StgInfoTable *)&stg_IND_PERM_info;
1641         }
1642         ((StgUpdateFrame *)p)->updatee
1643             = evacuate(((StgUpdateFrame *)p)->updatee);
1644         p += sizeofW(StgUpdateFrame);
1645         continue;
1646
1647       // small bitmap (< 32 entries, or 64 on a 64-bit machine)
1648     case CATCH_STM_FRAME:
1649     case CATCH_RETRY_FRAME:
1650     case ATOMICALLY_FRAME:
1651     case STOP_FRAME:
1652     case CATCH_FRAME:
1653     case RET_SMALL:
1654     case RET_VEC_SMALL:
1655         bitmap = BITMAP_BITS(info->i.layout.bitmap);
1656         size   = BITMAP_SIZE(info->i.layout.bitmap);
1657         // NOTE: the payload starts immediately after the info-ptr, we
1658         // don't have an StgHeader in the same sense as a heap closure.
1659         p++;
1660         p = scavenge_small_bitmap(p, size, bitmap);
1661
1662     follow_srt:
1663         if (major_gc)
1664             scavenge_srt((StgClosure **)GET_SRT(info), info->i.srt_bitmap);
1665         continue;
1666
1667     case RET_BCO: {
1668         StgBCO *bco;
1669         nat size;
1670
1671         p++;
1672         *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
1673         bco = (StgBCO *)*p;
1674         p++;
1675         size = BCO_BITMAP_SIZE(bco);
1676         scavenge_large_bitmap(p, BCO_BITMAP(bco), size);
1677         p += size;
1678         continue;
1679     }
1680
1681       // large bitmap (> 32 entries, or > 64 on a 64-bit machine)
1682     case RET_BIG:
1683     case RET_VEC_BIG:
1684     {
1685         nat size;
1686
1687         size = GET_LARGE_BITMAP(&info->i)->size;
1688         p++;
1689         scavenge_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
1690         p += size;
1691         // and don't forget to follow the SRT
1692         goto follow_srt;
1693     }
1694
1695       // Dynamic bitmap: the mask is stored on the stack, and
1696       // there are a number of non-pointers followed by a number
1697       // of pointers above the bitmapped area.  (see StgMacros.h,
1698       // HEAP_CHK_GEN).
1699     case RET_DYN:
1700     {
1701         StgWord dyn;
1702         dyn = ((StgRetDyn *)p)->liveness;
1703
1704         // traverse the bitmap first
1705         bitmap = RET_DYN_LIVENESS(dyn);
1706         p      = (P_)&((StgRetDyn *)p)->payload[0];
1707         size   = RET_DYN_BITMAP_SIZE;
1708         p = scavenge_small_bitmap(p, size, bitmap);
1709
1710         // skip over the non-ptr words
1711         p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
1712
1713         // follow the ptr words
1714         for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
1715             *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
1716             p++;
1717         }
1718         continue;
1719     }
1720
1721     case RET_FUN:
1722     {
1723         StgRetFun *ret_fun = (StgRetFun *)p;
1724         StgFunInfoTable *fun_info;
1725
1726         ret_fun->fun = evacuate(ret_fun->fun);
1727         fun_info = get_fun_itbl(ret_fun->fun);
1728         p = scavenge_arg_block(fun_info, ret_fun->payload);
1729         goto follow_srt;
1730     }
1731
1732     default:
1733         barf("scavenge_stack: weird activation record found on stack: %d", (int)(info->i.type));
1734     }
1735   }
1736 }
1737
1738 /*-----------------------------------------------------------------------------
1739   scavenge the large object list.
1740
1741   evac_gen set by caller; similar games played with evac_gen as with
1742   scavenge() - see comment at the top of scavenge().  Most large
1743   objects are (repeatedly) mutable, so most of the time evac_gen will
1744   be zero.
1745   --------------------------------------------------------------------------- */
1746
1747 void
1748 scavenge_large(step *stp)
1749 {
1750   bdescr *bd;
1751   StgPtr p;
1752
1753   bd = stp->new_large_objects;
1754
1755   for (; bd != NULL; bd = stp->new_large_objects) {
1756
1757     /* take this object *off* the large objects list and put it on
1758      * the scavenged large objects list.  This is so that we can
1759      * treat new_large_objects as a stack and push new objects on
1760      * the front when evacuating.
1761      */
1762     stp->new_large_objects = bd->link;
1763     dbl_link_onto(bd, &stp->scavenged_large_objects);
1764
1765     // update the block count in this step.
1766     stp->n_scavenged_large_blocks += bd->blocks;
1767
1768     p = bd->start;
1769     if (scavenge_one(p)) {
1770         if (stp->gen_no > 0) {
1771             recordMutableGen((StgClosure *)p, stp->gen);
1772         }
1773     }
1774   }
1775 }
1776