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     rtsBool saved_eager = gct->eager_promotion;
 138
 139     gct->eager_promotion = rtsFalse;
 140
 141     if (   tso->why_blocked == BlockedOnMVar
 142         || tso->why_blocked == BlockedOnBlackHole
 143         || tso->why_blocked == BlockedOnException
 144         ) {
 145         evacuate(&tso->block_info.closure);
 146     }
 147     evacuate((StgClosure **)&tso->blocked_exceptions);
 148
 149     // We don't always chase the link field: TSOs on the blackhole
 150     // queue are not automatically alive, so the link field is a
 151     // "weak" pointer in that case.
 152     if (tso->why_blocked != BlockedOnBlackHole) {
 153         evacuate((StgClosure **)&tso->link);
 154     }
 155
 156     // scavange current transaction record
 157     evacuate((StgClosure **)&tso->trec);
 158
 159     // scavenge this thread's stack
 160     scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
 161
 162     if (gct->failed_to_evac) {
 163         tso->flags |= TSO_DIRTY;
 164     } else {
 165         tso->flags &= ~TSO_DIRTY;
 166     }
 167
 168     gct->eager_promotion = saved_eager;
 169 }
 170
 171 /* -----------------------------------------------------------------------------
 172    Blocks of function args occur on the stack (at the top) and
 173    in PAPs.
 174    -------------------------------------------------------------------------- */
 175
 176 STATIC_INLINE StgPtr
 177 scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
 178 {
 179     StgPtr p;
 180     StgWord bitmap;
 181     nat size;
 182
 183     p = (StgPtr)args;
 184     switch (fun_info->f.fun_type) {
 185     case ARG_GEN:
 186         bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
 187         size = BITMAP_SIZE(fun_info->f.b.bitmap);
 188         goto small_bitmap;
 189     case ARG_GEN_BIG:
 190         size = GET_FUN_LARGE_BITMAP(fun_info)->size;
 191         scavenge_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
 192         p += size;
 193         break;
 194     default:
 195         bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
 196         size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
 197     small_bitmap:
 198         while (size > 0) {
 199             if ((bitmap & 1) == 0) {
 200                 evacuate((StgClosure **)p);
 201             }
 202             p++;
 203             bitmap = bitmap >> 1;
 204             size--;
 205         }
 206         break;
 207     }
 208     return p;
 209 }
 210
 211 STATIC_INLINE StgPtr
 212 scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
 213 {
 214     StgPtr p;
 215     StgWord bitmap;
 216     StgFunInfoTable *fun_info;
 217
 218     fun_info = get_fun_itbl(UNTAG_CLOSURE(fun));
 219     ASSERT(fun_info->i.type != PAP);
 220     p = (StgPtr)payload;
 221
 222     switch (fun_info->f.fun_type) {
 223     case ARG_GEN:
 224         bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
 225         goto small_bitmap;
 226     case ARG_GEN_BIG:
 227         scavenge_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
 228         p += size;
 229         break;
 230     case ARG_BCO:
 231         scavenge_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
 232         p += size;
 233         break;
 234     default:
 235         bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
 236     small_bitmap:
 237         while (size > 0) {
 238             if ((bitmap & 1) == 0) {
 239                 evacuate((StgClosure **)p);
 240             }
 241             p++;
 242             bitmap = bitmap >> 1;
 243             size--;
 244         }
 245         break;
 246     }
 247     return p;
 248 }
 249
 250 STATIC_INLINE StgPtr
 251 scavenge_PAP (StgPAP *pap)
 252 {
 253     evacuate(&pap->fun);
 254     return scavenge_PAP_payload (pap->fun, pap->payload, pap->n_args);
 255 }
 256
 257 STATIC_INLINE StgPtr
 258 scavenge_AP (StgAP *ap)
 259 {
 260     evacuate(&ap->fun);
 261     return scavenge_PAP_payload (ap->fun, ap->payload, ap->n_args);
 262 }
 263
 264 /* -----------------------------------------------------------------------------
 265    Scavenge everything on the mark stack.
 266
 267    This is slightly different from scavenge():
 268       - we don't walk linearly through the objects, so the scavenger
 269         doesn't need to advance the pointer on to the next object.
 270    -------------------------------------------------------------------------- */
 271
 272 static void
 273 scavenge_mark_stack(void)
 274 {
 275     StgPtr p, q;
 276     StgInfoTable *info;
 277     step *saved_evac_step;
 278
 279     gct->evac_step = &oldest_gen->steps[0];
 280     saved_evac_step = gct->evac_step;
 281
 282 linear_scan:
 283     while (!mark_stack_empty()) {
 284         p = pop_mark_stack();
 285
 286         ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
 287         info = get_itbl((StgClosure *)p);
 288
 289         q = p;
 290         switch (((volatile StgWord *)info)[1] & 0xffff) {
 291
 292         case MVAR_CLEAN:
 293         case MVAR_DIRTY:
 294         {
 295             rtsBool saved_eager_promotion = gct->eager_promotion;
 296
 297             StgMVar *mvar = ((StgMVar *)p);
 298             gct->eager_promotion = rtsFalse;
 299             evacuate((StgClosure **)&mvar->head);
 300             evacuate((StgClosure **)&mvar->tail);
 301             evacuate((StgClosure **)&mvar->value);
 302             gct->eager_promotion = saved_eager_promotion;
 303
 304             if (gct->failed_to_evac) {
 305                 mvar->header.info = &stg_MVAR_DIRTY_info;
 306             } else {
 307                 mvar->header.info = &stg_MVAR_CLEAN_info;
 308             }
 309             break;
 310         }
 311
 312         case FUN_2_0:
 313             scavenge_fun_srt(info);
 314             evacuate(&((StgClosure *)p)->payload[1]);
 315             evacuate(&((StgClosure *)p)->payload[0]);
 316             break;
 317
 318         case THUNK_2_0:
 319             scavenge_thunk_srt(info);
 320             evacuate(&((StgThunk *)p)->payload[1]);
 321             evacuate(&((StgThunk *)p)->payload[0]);
 322             break;
 323
 324         case CONSTR_2_0:
 325             evacuate(&((StgClosure *)p)->payload[1]);
 326             evacuate(&((StgClosure *)p)->payload[0]);
 327             break;
 328
 329         case FUN_1_0:
 330         case FUN_1_1:
 331             scavenge_fun_srt(info);
 332             evacuate(&((StgClosure *)p)->payload[0]);
 333             break;
 334
 335         case THUNK_1_0:
 336         case THUNK_1_1:
 337             scavenge_thunk_srt(info);
 338             evacuate(&((StgThunk *)p)->payload[0]);
 339             break;
 340
 341         case CONSTR_1_0:
 342         case CONSTR_1_1:
 343             evacuate(&((StgClosure *)p)->payload[0]);
 344             break;
 345
 346         case FUN_0_1:
 347         case FUN_0_2:
 348             scavenge_fun_srt(info);
 349             break;
 350
 351         case THUNK_0_1:
 352         case THUNK_0_2:
 353             scavenge_thunk_srt(info);
 354             break;
 355
 356         case CONSTR_0_1:
 357         case CONSTR_0_2:
 358             break;
 359
 360         case FUN:
 361             scavenge_fun_srt(info);
 362             goto gen_obj;
 363
 364         case THUNK:
 365         {
 366             StgPtr end;
 367
 368             scavenge_thunk_srt(info);
 369             end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs;
 370             for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
 371                 evacuate((StgClosure **)p);
 372             }
 373             break;
 374         }
 375
 376         gen_obj:
 377         case CONSTR:
 378         case WEAK:
 379         case STABLE_NAME:
 380         {
 381             StgPtr end;
 382
 383             end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
 384             for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
 385                 evacuate((StgClosure **)p);
 386             }
 387             break;
 388         }
 389
 390         case BCO: {
 391             StgBCO *bco = (StgBCO *)p;
 392             evacuate((StgClosure **)&bco->instrs);
 393             evacuate((StgClosure **)&bco->literals);
 394             evacuate((StgClosure **)&bco->ptrs);
 395             break;
 396         }
 397
 398         case IND_PERM:
 399             // don't need to do anything here: the only possible case
 400             // is that we're in a 1-space compacting collector, with
 401             // no "old" generation.
 402             break;
 403
 404         case IND_OLDGEN:
 405         case IND_OLDGEN_PERM:
 406             evacuate(&((StgInd *)p)->indirectee);
 407             break;
 408
 409         case MUT_VAR_CLEAN:
 410         case MUT_VAR_DIRTY: {
 411             rtsBool saved_eager_promotion = gct->eager_promotion;
 412
 413             gct->eager_promotion = rtsFalse;
 414             evacuate(&((StgMutVar *)p)->var);
 415             gct->eager_promotion = saved_eager_promotion;
 416
 417             if (gct->failed_to_evac) {
 418                 ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
 419             } else {
 420                 ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
 421             }
 422             break;
 423         }
 424
 425         case CAF_BLACKHOLE:
 426         case SE_CAF_BLACKHOLE:
 427         case SE_BLACKHOLE:
 428         case BLACKHOLE:
 429         case ARR_WORDS:
 430             break;
 431
 432         case THUNK_SELECTOR:
 433         {
 434             StgSelector *s = (StgSelector *)p;
 435             evacuate(&s->selectee);
 436             break;
 437         }
 438
 439         // A chunk of stack saved in a heap object
 440         case AP_STACK:
 441         {
 442             StgAP_STACK *ap = (StgAP_STACK *)p;
 443
 444             evacuate(&ap->fun);
 445             scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
 446             break;
 447         }
 448
 449         case PAP:
 450             scavenge_PAP((StgPAP *)p);
 451             break;
 452
 453         case AP:
 454             scavenge_AP((StgAP *)p);
 455             break;
 456
 457         case MUT_ARR_PTRS_CLEAN:
 458         case MUT_ARR_PTRS_DIRTY:
 459             // follow everything
 460         {
 461             StgPtr next;
 462             rtsBool saved_eager;
 463
 464             // We don't eagerly promote objects pointed to by a mutable
 465             // array, but if we find the array only points to objects in
 466             // the same or an older generation, we mark it "clean" and
 467             // avoid traversing it during minor GCs.
 468             saved_eager = gct->eager_promotion;
 469             gct->eager_promotion = rtsFalse;
 470             next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
 471             for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
 472                 evacuate((StgClosure **)p);
 473             }
 474             gct->eager_promotion = saved_eager;
 475
 476             if (gct->failed_to_evac) {
 477                 ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
 478             } else {
 479                 ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
 480             }
 481
 482             gct->failed_to_evac = rtsTrue; // mutable anyhow.
 483             break;
 484         }
 485
 486         case MUT_ARR_PTRS_FROZEN:
 487         case MUT_ARR_PTRS_FROZEN0:
 488             // follow everything
 489         {
 490             StgPtr next, q = p;
 491
 492             next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
 493             for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
 494                 evacuate((StgClosure **)p);
 495             }
 496
 497             // If we're going to put this object on the mutable list, then
 498             // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
 499             if (gct->failed_to_evac) {
 500                 ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
 501             } else {
 502                 ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
 503             }
 504             break;
 505         }
 506
 507         case TSO:
 508         {
 509             scavengeTSO((StgTSO*)p);
 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         scavengeTSO((StgTSO*)p);
 830         gct->failed_to_evac = rtsTrue; // always on the mutable list
 831         break;
 832     }
 833
 834     case TVAR_WATCH_QUEUE:
 835       {
 836         StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p);
 837         gct->evac_step = 0;
 838         evacuate((StgClosure **)&wq->closure);
 839         evacuate((StgClosure **)&wq->next_queue_entry);
 840         evacuate((StgClosure **)&wq->prev_queue_entry);
 841         gct->evac_step = saved_evac_step;
 842         gct->failed_to_evac = rtsTrue; // mutable
 843         break;
 844       }
 845
 846     case TVAR:
 847       {
 848         StgTVar *tvar = ((StgTVar *) p);
 849         gct->evac_step = 0;
 850         evacuate((StgClosure **)&tvar->current_value);
 851         evacuate((StgClosure **)&tvar->first_watch_queue_entry);
 852         gct->evac_step = saved_evac_step;
 853         gct->failed_to_evac = rtsTrue; // mutable
 854         break;
 855       }
 856
 857     case TREC_HEADER:
 858       {
 859         StgTRecHeader *trec = ((StgTRecHeader *) p);
 860         gct->evac_step = 0;
 861         evacuate((StgClosure **)&trec->enclosing_trec);
 862         evacuate((StgClosure **)&trec->current_chunk);
 863         evacuate((StgClosure **)&trec->invariants_to_check);
 864         gct->evac_step = saved_evac_step;
 865         gct->failed_to_evac = rtsTrue; // mutable
 866         break;
 867       }
 868
 869     case TREC_CHUNK:
 870       {
 871         StgWord i;
 872         StgTRecChunk *tc = ((StgTRecChunk *) p);
 873         TRecEntry *e = &(tc -> entries[0]);
 874         gct->evac_step = 0;
 875         evacuate((StgClosure **)&tc->prev_chunk);
 876         for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
 877           evacuate((StgClosure **)&e->tvar);
 878           evacuate((StgClosure **)&e->expected_value);
 879           evacuate((StgClosure **)&e->new_value);
 880         }
 881         gct->evac_step = saved_evac_step;
 882         gct->failed_to_evac = rtsTrue; // mutable
 883         break;
 884       }
 885
 886     case ATOMIC_INVARIANT:
 887     {
 888       StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p);
 889       gct->evac_step = 0;
 890       evacuate(&invariant->code);
 891       evacuate((StgClosure **)&invariant->last_execution);
 892       gct->evac_step = saved_evac_step;
 893       gct->failed_to_evac = rtsTrue; // mutable
 894       break;
 895     }
 896
 897     case INVARIANT_CHECK_QUEUE:
 898     {
 899       StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p);
 900       gct->evac_step = 0;
 901       evacuate((StgClosure **)&queue->invariant);
 902       evacuate((StgClosure **)&queue->my_execution);
 903       evacuate((StgClosure **)&queue->next_queue_entry);
 904       gct->evac_step = saved_evac_step;
 905       gct->failed_to_evac = rtsTrue; // mutable
 906       break;
 907     }
 908
 909     case IND_OLDGEN:
 910     case IND_OLDGEN_PERM:
 911     case IND_STATIC:
 912     {
 913         /* Careful here: a THUNK can be on the mutable list because
 914          * it contains pointers to young gen objects.  If such a thunk
 915          * is updated, the IND_OLDGEN will be added to the mutable
 916          * list again, and we'll scavenge it twice.  evacuate()
 917          * doesn't check whether the object has already been
 918          * evacuated, so we perform that check here.
 919          */
 920         StgClosure *q = ((StgInd *)p)->indirectee;
 921         if (HEAP_ALLOCED(q) && Bdescr((StgPtr)q)->flags & BF_EVACUATED) {
 922             break;
 923         }
 924         evacuate(&((StgInd *)p)->indirectee);
 925     }
 926
 927 #if 0 && defined(DEBUG)
 928       if (RtsFlags.DebugFlags.gc)
 929       /* Debugging code to print out the size of the thing we just
 930        * promoted
 931        */
 932       {
 933         StgPtr start = gen->steps[0].scan;
 934         bdescr *start_bd = gen->steps[0].scan_bd;
 935         nat size = 0;
 936         scavenge(&gen->steps[0]);
 937         if (start_bd != gen->steps[0].scan_bd) {
 938           size += (P_)BLOCK_ROUND_UP(start) - start;
 939           start_bd = start_bd->link;
 940           while (start_bd != gen->steps[0].scan_bd) {
 941             size += BLOCK_SIZE_W;
 942             start_bd = start_bd->link;
 943           }
 944           size += gen->steps[0].scan -
 945             (P_)BLOCK_ROUND_DOWN(gen->steps[0].scan);
 946         } else {
 947           size = gen->steps[0].scan - start;
 948         }
 949         debugBelch("evac IND_OLDGEN: %ld bytes", size * sizeof(W_));
 950       }
 951 #endif
 952       break;
 953
 954     default:
 955         barf("scavenge_one: strange object %d", (int)(info->type));
 956     }
 957
 958     no_luck = gct->failed_to_evac;
 959     gct->failed_to_evac = rtsFalse;
 960     return (no_luck);
 961 }
 962
 963 /* -----------------------------------------------------------------------------
 964    Scavenging mutable lists.
 965
 966    We treat the mutable list of each generation > N (i.e. all the
 967    generations older than the one being collected) as roots.  We also
 968    remove non-mutable objects from the mutable list at this point.
 969    -------------------------------------------------------------------------- */
 970
 971 void
 972 scavenge_mutable_list(generation *gen)
 973 {
 974     bdescr *bd;
 975     StgPtr p, q;
 976
 977     bd = gen->saved_mut_list;
 978
 979     gct->evac_step = &gen->steps[0];
 980     for (; bd != NULL; bd = bd->link) {
 981         for (q = bd->start; q < bd->free; q++) {
 982             p = (StgPtr)*q;
 983             ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
 984
 985 #ifdef DEBUG
 986             switch (get_itbl((StgClosure *)p)->type) {
 987             case MUT_VAR_CLEAN:
 988                 barf("MUT_VAR_CLEAN on mutable list");
 989             case MUT_VAR_DIRTY:
 990                 mutlist_MUTVARS++; break;
 991             case MUT_ARR_PTRS_CLEAN:
 992             case MUT_ARR_PTRS_DIRTY:
 993             case MUT_ARR_PTRS_FROZEN:
 994             case MUT_ARR_PTRS_FROZEN0:
 995                 mutlist_MUTARRS++; break;
 996             case MVAR_CLEAN:
 997                 barf("MVAR_CLEAN on mutable list");
 998             case MVAR_DIRTY:
 999                 mutlist_MVARS++; break;
1000             default:
1001                 mutlist_OTHERS++; break;
1002             }
1003 #endif
1004
1005             // Check whether this object is "clean", that is it
1006             // definitely doesn't point into a young generation.
1007             // Clean objects don't need to be scavenged.  Some clean
1008             // objects (MUT_VAR_CLEAN) are not kept on the mutable
1009             // list at all; others, such as MUT_ARR_PTRS_CLEAN and
1010             // TSO, are always on the mutable list.
1011             //
1012             switch (get_itbl((StgClosure *)p)->type) {
1013             case MUT_ARR_PTRS_CLEAN:
1014                 recordMutableGen_GC((StgClosure *)p,gen);
1015                 continue;
1016             case TSO: {
1017                 StgTSO *tso = (StgTSO *)p;
1018                 if ((tso->flags & TSO_DIRTY) == 0) {
1019                     // A clean TSO: we don't have to traverse its
1020                     // stack.  However, we *do* follow the link field:
1021                     // we don't want to have to mark a TSO dirty just
1022                     // because we put it on a different queue.
1023                     if (tso->why_blocked != BlockedOnBlackHole) {
1024                         evacuate((StgClosure **)&tso->link);
1025                     }
1026                     recordMutableGen_GC((StgClosure *)p,gen);
1027                     continue;
1028                 }
1029             }
1030             default:
1031                 ;
1032             }
1033
1034             if (scavenge_one(p)) {
1035                 // didn't manage to promote everything, so put the
1036                 // object back on the list.
1037                 recordMutableGen_GC((StgClosure *)p,gen);
1038             }
1039         }
1040     }
1041
1042     // free the old mut_list
1043     freeChain_sync(gen->saved_mut_list);
1044     gen->saved_mut_list = NULL;
1045 }
1046
1047 /* -----------------------------------------------------------------------------
1048    Scavenging the static objects.
1049
1050    We treat the mutable list of each generation > N (i.e. all the
1051    generations older than the one being collected) as roots.  We also
1052    remove non-mutable objects from the mutable list at this point.
1053    -------------------------------------------------------------------------- */
1054
1055 static void
1056 scavenge_static(void)
1057 {
1058   StgClosure* p;
1059   const StgInfoTable *info;
1060
1061   /* Always evacuate straight to the oldest generation for static
1062    * objects */
1063   gct->evac_step = &oldest_gen->steps[0];
1064
1065   /* keep going until we've scavenged all the objects on the linked
1066      list... */
1067
1068   while (1) {
1069
1070     ACQUIRE_SPIN_LOCK(&static_objects_sync);
1071
1072     /* get the next static object from the list.  Remember, there might
1073      * be more stuff on this list after each evacuation...
1074      * (static_objects is a global)
1075      */
1076     p = static_objects;
1077     if (p == END_OF_STATIC_LIST) {
1078           RELEASE_SPIN_LOCK(&static_objects_sync);
1079           break;
1080     }
1081
1082     ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
1083     info = get_itbl(p);
1084     /*
1085         if (info->type==RBH)
1086         info = REVERT_INFOPTR(info); // if it's an RBH, look at the orig closure
1087     */
1088     // make sure the info pointer is into text space
1089
1090     /* Take this object *off* the static_objects list,
1091      * and put it on the scavenged_static_objects list.
1092      */
1093     static_objects = *STATIC_LINK(info,p);
1094     *STATIC_LINK(info,p) = scavenged_static_objects;
1095     scavenged_static_objects = p;
1096
1097     RELEASE_SPIN_LOCK(&static_objects_sync);
1098
1099     switch (info -> type) {
1100
1101     case IND_STATIC:
1102       {
1103         StgInd *ind = (StgInd *)p;
1104         evacuate(&ind->indirectee);
1105
1106         /* might fail to evacuate it, in which case we have to pop it
1107          * back on the mutable list of the oldest generation.  We
1108          * leave it *on* the scavenged_static_objects list, though,
1109          * in case we visit this object again.
1110          */
1111         if (gct->failed_to_evac) {
1112           gct->failed_to_evac = rtsFalse;
1113           recordMutableGen_GC((StgClosure *)p,oldest_gen);
1114         }
1115         break;
1116       }
1117
1118     case THUNK_STATIC:
1119       scavenge_thunk_srt(info);
1120       break;
1121
1122     case FUN_STATIC:
1123       scavenge_fun_srt(info);
1124       break;
1125
1126     case CONSTR_STATIC:
1127       {
1128         StgPtr q, next;
1129
1130         next = (P_)p->payload + info->layout.payload.ptrs;
1131         // evacuate the pointers
1132         for (q = (P_)p->payload; q < next; q++) {
1133             evacuate((StgClosure **)q);
1134         }
1135         break;
1136       }
1137
1138     default:
1139       barf("scavenge_static: strange closure %d", (int)(info->type));
1140     }
1141
1142     ASSERT(gct->failed_to_evac == rtsFalse);
1143   }
1144 }
1145
1146 /* -----------------------------------------------------------------------------
1147    scavenge a chunk of memory described by a bitmap
1148    -------------------------------------------------------------------------- */
1149
1150 static void
1151 scavenge_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
1152 {
1153     nat i, b;
1154     StgWord bitmap;
1155
1156     b = 0;
1157     bitmap = large_bitmap->bitmap[b];
1158     for (i = 0; i < size; ) {
1159         if ((bitmap & 1) == 0) {
1160             evacuate((StgClosure **)p);
1161         }
1162         i++;
1163         p++;
1164         if (i % BITS_IN(W_) == 0) {
1165             b++;
1166             bitmap = large_bitmap->bitmap[b];
1167         } else {
1168             bitmap = bitmap >> 1;
1169         }
1170     }
1171 }
1172
1173 STATIC_INLINE StgPtr
1174 scavenge_small_bitmap (StgPtr p, nat size, StgWord bitmap)
1175 {
1176     while (size > 0) {
1177         if ((bitmap & 1) == 0) {
1178             evacuate((StgClosure **)p);
1179         }
1180         p++;
1181         bitmap = bitmap >> 1;
1182         size--;
1183     }
1184     return p;
1185 }
1186
1187 /* -----------------------------------------------------------------------------
1188    scavenge_stack walks over a section of stack and evacuates all the
1189    objects pointed to by it.  We can use the same code for walking
1190    AP_STACK_UPDs, since these are just sections of copied stack.
1191    -------------------------------------------------------------------------- */
1192
1193 static void
1194 scavenge_stack(StgPtr p, StgPtr stack_end)
1195 {
1196   const StgRetInfoTable* info;
1197   StgWord bitmap;
1198   nat size;
1199
1200   /*
1201    * Each time around this loop, we are looking at a chunk of stack
1202    * that starts with an activation record.
1203    */
1204
1205   while (p < stack_end) {
1206     info  = get_ret_itbl((StgClosure *)p);
1207
1208     switch (info->i.type) {
1209
1210     case UPDATE_FRAME:
1211         // In SMP, we can get update frames that point to indirections
1212         // when two threads evaluate the same thunk.  We do attempt to
1213         // discover this situation in threadPaused(), but it's
1214         // possible that the following sequence occurs:
1215         //
1216         //        A             B
1217         //                  enter T
1218         //     enter T
1219         //     blackhole T
1220         //                  update T
1221         //     GC
1222         //
1223         // Now T is an indirection, and the update frame is already
1224         // marked on A's stack, so we won't traverse it again in
1225         // threadPaused().  We could traverse the whole stack again
1226         // before GC, but that seems like overkill.
1227         //
1228         // Scavenging this update frame as normal would be disastrous;
1229         // the updatee would end up pointing to the value.  So we turn
1230         // the indirection into an IND_PERM, so that evacuate will
1231         // copy the indirection into the old generation instead of
1232         // discarding it.
1233     {
1234         nat type;
1235         type = get_itbl(((StgUpdateFrame *)p)->updatee)->type;
1236         if (type == IND) {
1237             ((StgUpdateFrame *)p)->updatee->header.info =
1238                 (StgInfoTable *)&stg_IND_PERM_info;
1239         } else if (type == IND_OLDGEN) {
1240             ((StgUpdateFrame *)p)->updatee->header.info =
1241                 (StgInfoTable *)&stg_IND_OLDGEN_PERM_info;
1242         }
1243         evacuate(&((StgUpdateFrame *)p)->updatee);
1244         p += sizeofW(StgUpdateFrame);
1245         continue;
1246     }
1247
1248       // small bitmap (< 32 entries, or 64 on a 64-bit machine)
1249     case CATCH_STM_FRAME:
1250     case CATCH_RETRY_FRAME:
1251     case ATOMICALLY_FRAME:
1252     case STOP_FRAME:
1253     case CATCH_FRAME:
1254     case RET_SMALL:
1255         bitmap = BITMAP_BITS(info->i.layout.bitmap);
1256         size   = BITMAP_SIZE(info->i.layout.bitmap);
1257         // NOTE: the payload starts immediately after the info-ptr, we
1258         // don't have an StgHeader in the same sense as a heap closure.
1259         p++;
1260         p = scavenge_small_bitmap(p, size, bitmap);
1261
1262     follow_srt:
1263         if (major_gc)
1264             scavenge_srt((StgClosure **)GET_SRT(info), info->i.srt_bitmap);
1265         continue;
1266
1267     case RET_BCO: {
1268         StgBCO *bco;
1269         nat size;
1270
1271         p++;
1272         evacuate((StgClosure **)p);
1273         bco = (StgBCO *)*p;
1274         p++;
1275         size = BCO_BITMAP_SIZE(bco);
1276         scavenge_large_bitmap(p, BCO_BITMAP(bco), size);
1277         p += size;
1278         continue;
1279     }
1280
1281       // large bitmap (> 32 entries, or > 64 on a 64-bit machine)
1282     case RET_BIG:
1283     {
1284         nat size;
1285
1286         size = GET_LARGE_BITMAP(&info->i)->size;
1287         p++;
1288         scavenge_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
1289         p += size;
1290         // and don't forget to follow the SRT
1291         goto follow_srt;
1292     }
1293
1294       // Dynamic bitmap: the mask is stored on the stack, and
1295       // there are a number of non-pointers followed by a number
1296       // of pointers above the bitmapped area.  (see StgMacros.h,
1297       // HEAP_CHK_GEN).
1298     case RET_DYN:
1299     {
1300         StgWord dyn;
1301         dyn = ((StgRetDyn *)p)->liveness;
1302
1303         // traverse the bitmap first
1304         bitmap = RET_DYN_LIVENESS(dyn);
1305         p      = (P_)&((StgRetDyn *)p)->payload[0];
1306         size   = RET_DYN_BITMAP_SIZE;
1307         p = scavenge_small_bitmap(p, size, bitmap);
1308
1309         // skip over the non-ptr words
1310         p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
1311
1312         // follow the ptr words
1313         for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
1314             evacuate((StgClosure **)p);
1315             p++;
1316         }
1317         continue;
1318     }
1319
1320     case RET_FUN:
1321     {
1322         StgRetFun *ret_fun = (StgRetFun *)p;
1323         StgFunInfoTable *fun_info;
1324
1325         evacuate(&ret_fun->fun);
1326         fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
1327         p = scavenge_arg_block(fun_info, ret_fun->payload);
1328         goto follow_srt;
1329     }
1330
1331     default:
1332         barf("scavenge_stack: weird activation record found on stack: %d", (int)(info->i.type));
1333     }
1334   }
1335 }
1336
1337 /*-----------------------------------------------------------------------------
1338   scavenge the large object list.
1339
1340   evac_step set by caller; similar games played with evac_step as with
1341   scavenge() - see comment at the top of scavenge().  Most large
1342   objects are (repeatedly) mutable, so most of the time evac_step will
1343   be zero.
1344   --------------------------------------------------------------------------- */
1345
1346 static void
1347 scavenge_large (step_workspace *ws)
1348 {
1349     bdescr *bd;
1350     StgPtr p;
1351
1352     gct->evac_step = ws->stp;
1353
1354     bd = ws->todo_large_objects;
1355
1356     for (; bd != NULL; bd = ws->todo_large_objects) {
1357
1358         // take this object *off* the large objects list and put it on
1359         // the scavenged large objects list.  This is so that we can
1360         // treat new_large_objects as a stack and push new objects on
1361         // the front when evacuating.
1362         ws->todo_large_objects = bd->link;
1363
1364         ACQUIRE_SPIN_LOCK(&ws->stp->sync_large_objects);
1365         dbl_link_onto(bd, &ws->stp->scavenged_large_objects);
1366         ws->stp->n_scavenged_large_blocks += bd->blocks;
1367         RELEASE_SPIN_LOCK(&ws->stp->sync_large_objects);
1368
1369         p = bd->start;
1370         if (scavenge_one(p)) {
1371             if (ws->stp->gen_no > 0) {
1372                 recordMutableGen_GC((StgClosure *)p, ws->stp->gen);
1373             }
1374         }
1375     }
1376 }
1377
1378 /* ----------------------------------------------------------------------------
1379    Scavenge a block
1380    ------------------------------------------------------------------------- */
1381
1382 #define MINOR_GC
1383 #include "Scav.c-inc"
1384 #undef MINOR_GC
1385 #include "Scav.c-inc"
1386
1387 /* ----------------------------------------------------------------------------
1388    Find the oldest full block to scavenge, and scavenge it.
1389    ------------------------------------------------------------------------- */
1390
1391 static rtsBool
1392 scavenge_find_global_work (void)
1393 {
1394     bdescr *bd;
1395     int g, s;
1396     rtsBool flag;
1397     step_workspace *ws;
1398
1399     flag = rtsFalse;
1400     for (g = RtsFlags.GcFlags.generations-1; g >= 0; g--) {
1401         for (s = generations[g].n_steps-1; s >= 0; s--) {
1402             if (g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1) {
1403                 continue;
1404             }
1405             ws = &gct->steps[g][s];
1406
1407             // If we have any large objects to scavenge, do them now.
1408             if (ws->todo_large_objects) {
1409                 scavenge_large(ws);
1410                 flag = rtsTrue;
1411             }
1412
1413             if ((bd = grab_todo_block(ws)) != NULL) {
1414                 // no need to assign this to ws->scan_bd, we're going
1415                 // to scavenge the whole thing and then push it on
1416                 // our scavd list.  This saves pushing out the
1417                 // scan_bd block, which might be partial.
1418                 if (N == 0) {
1419                     scavenge_block0(bd, bd->start);
1420                 } else {
1421                     scavenge_block(bd, bd->start);
1422                 }
1423                 push_scan_block(bd, ws);
1424                 return rtsTrue;
1425             }
1426
1427             if (flag) return rtsTrue;
1428         }
1429     }
1430     return rtsFalse;
1431 }
1432
1433 /* ----------------------------------------------------------------------------
1434    Look for local work to do.
1435
1436    We can have outstanding scavenging to do if, for any of the workspaces,
1437
1438      - the scan block is the same as the todo block, and new objects
1439        have been evacuated to the todo block.
1440
1441      - the scan block *was* the same as the todo block, but the todo
1442        block filled up and a new one has been allocated.
1443    ------------------------------------------------------------------------- */
1444
1445 static rtsBool
1446 scavenge_find_local_work (void)
1447 {
1448     int g, s;
1449     step_workspace *ws;
1450     rtsBool flag;
1451
1452     flag = rtsFalse;
1453     for (g = RtsFlags.GcFlags.generations; --g >= 0; ) {
1454         for (s = generations[g].n_steps; --s >= 0; ) {
1455             if (g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1) {
1456                 continue;
1457             }
1458             ws = &gct->steps[g][s];
1459
1460             if (ws->todo_bd != NULL)
1461             {
1462                 ws->todo_bd->free = ws->todo_free;
1463             }
1464
1465             // If we have a todo block and no scan block, start
1466             // scanning the todo block.
1467             if (ws->scan_bd == NULL && ws->todo_bd != NULL)
1468             {
1469                 ws->scan_bd = ws->todo_bd;
1470                 ws->scan = ws->scan_bd->start;
1471             }
1472
1473             // If we have a scan block with some work to do,
1474             // scavenge everything up to the free pointer.
1475             if (ws->scan != NULL && ws->scan < ws->scan_bd->free)
1476             {
1477                 if (N == 0) {
1478                     scavenge_block0(ws->scan_bd, ws->scan);
1479                 } else {
1480                     scavenge_block(ws->scan_bd, ws->scan);
1481                 }
1482                 ws->scan = ws->scan_bd->free;
1483                 flag = rtsTrue;
1484             }
1485
1486             if (ws->scan_bd != NULL && ws->scan == ws->scan_bd->free
1487                 && ws->scan_bd != ws->todo_bd)
1488             {
1489                 // we're not going to evac any more objects into
1490                 // this block, so push it now.
1491                 push_scan_block(ws->scan_bd, ws);
1492                 ws->scan_bd = NULL;
1493                 ws->scan = NULL;
1494                 // we might be able to scan the todo block now.  But
1495                 // don't do it right away: there might be full blocks
1496                 // waiting to be scanned as a result of scavenge_block above.
1497                 flag = rtsTrue;
1498             }
1499
1500             if (flag) return rtsTrue;
1501         }
1502     }
1503     return rtsFalse;
1504 }
1505
1506 /* ----------------------------------------------------------------------------
1507    Scavenge until we can't find anything more to scavenge.
1508    ------------------------------------------------------------------------- */
1509
1510 void
1511 scavenge_loop(void)
1512 {
1513     rtsBool work_to_do;
1514
1515 loop:
1516     work_to_do = rtsFalse;
1517
1518     // scavenge static objects
1519     if (major_gc && static_objects != END_OF_STATIC_LIST) {
1520         IF_DEBUG(sanity, checkStaticObjects(static_objects));
1521         scavenge_static();
1522     }
1523
1524     // scavenge objects in compacted generation
1525     if (mark_stack_overflowed || oldgen_scan_bd != NULL ||
1526         (mark_stack_bdescr != NULL && !mark_stack_empty())) {
1527         scavenge_mark_stack();
1528         work_to_do = rtsTrue;
1529     }
1530
1531     // Order is important here: we want to deal in full blocks as
1532     // much as possible, so go for global work in preference to
1533     // local work.  Only if all the global work has been exhausted
1534     // do we start scavenging the fragments of blocks in the local
1535     // workspaces.
1536     if (scavenge_find_global_work()) goto loop;
1537     if (scavenge_find_local_work())  goto loop;
1538
1539     if (work_to_do) goto loop;
1540 }
1541
1542 rtsBool
1543 any_work (void)
1544 {
1545     int g, s;
1546     step_workspace *ws;
1547
1548     write_barrier();
1549
1550     // scavenge static objects
1551     if (major_gc && static_objects != END_OF_STATIC_LIST) {
1552         return rtsTrue;
1553     }
1554
1555     // scavenge objects in compacted generation
1556     if (mark_stack_overflowed || oldgen_scan_bd != NULL ||
1557         (mark_stack_bdescr != NULL && !mark_stack_empty())) {
1558         return rtsTrue;
1559     }
1560
1561     // Check for global work in any step.  We don't need to check for
1562     // local work, because we have already exited scavenge_loop(),
1563     // which means there is no local work for this thread.
1564     for (g = RtsFlags.GcFlags.generations-1; g >= 0; g--) {
1565         for (s = generations[g].n_steps-1; s >= 0; s--) {
1566             if (g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1) {
1567                 continue;
1568             }
1569             ws = &gct->steps[g][s];
1570             if (ws->todo_large_objects) return rtsTrue;
1571             if (ws->stp->todos) return rtsTrue;
1572         }
1573     }
1574
1575     return rtsFalse;
1576 }