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