rts/sm/Scav.c

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