rts/sm/Scav.c

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