Scav.c 64.2 KB
Newer Older
1 2
/* -----------------------------------------------------------------------------
 *
3
 * (c) The GHC Team 1998-2008
4 5 6
 *
 * Generational garbage collector: scavenging functions
 *
7 8
 * Documentation on the architecture of the Garbage Collector can be
 * found in the online commentary:
9
 *
10
 *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC
11
 *
12 13
 * ---------------------------------------------------------------------------*/

Simon Marlow's avatar
Simon Marlow committed
14
#include "PosixSource.h"
15
#include "Rts.h"
Simon Marlow's avatar
Simon Marlow committed
16

17 18
#include "Storage.h"
#include "GC.h"
19
#include "GCThread.h"
20
#include "GCUtils.h"
21
#include "Compact.h"
22
#include "MarkStack.h"
23 24 25 26
#include "Evac.h"
#include "Scav.h"
#include "Apply.h"
#include "Trace.h"
27
#include "Sanity.h"
28
#include "Capability.h"
Simon Marlow's avatar
Simon Marlow committed
29
#include "LdvProfile.h"
30
#include "Hash.h"
31

32 33
#include "sm/MarkWeak.h"

34 35
static void scavenge_stack (StgPtr p, StgPtr stack_end);

36 37 38
static void scavenge_large_bitmap (StgPtr p,
                                   StgLargeBitmap *large_bitmap,
                                   StgWord size );
39

40 41
#if defined(THREADED_RTS) && !defined(PARALLEL_GC)
# define evacuate(a) evacuate1(a)
42
# define evacuate_BLACKHOLE(a) evacuate_BLACKHOLE1(a)
43
# define scavenge_loop(a) scavenge_loop1(a)
Simon Marlow's avatar
Simon Marlow committed
44
# define scavenge_block(a) scavenge_block1(a)
45 46
# define scavenge_mutable_list(bd,g) scavenge_mutable_list1(bd,g)
# define scavenge_capability_mut_lists(cap) scavenge_capability_mut_Lists1(cap)
47 48 49 50 51 52 53 54 55
#endif

/* -----------------------------------------------------------------------------
   Scavenge a TSO.
   -------------------------------------------------------------------------- */

static void
scavengeTSO (StgTSO *tso)
{
Ben Gamari's avatar
Ben Gamari committed
56
    bool saved_eager;
57

Simon Marlow's avatar
Simon Marlow committed
58
    debugTrace(DEBUG_gc,"scavenging thread %d",(int)tso->id);
59

Simon Marlow's avatar
Simon Marlow committed
60
    // update the pointer from the InCall.
61
    if (tso->bound != NULL) {
Simon Marlow's avatar
Simon Marlow committed
62 63 64 65 66 67
        // NB. We can't just set tso->bound->tso = tso, because this
        // might be an invalid copy the TSO resulting from multiple
        // threads evacuating the TSO simultaneously (see
        // Evac.c:copy_tag()).  Calling evacuate() on this pointer
        // will ensure that we update it to point to the correct copy.
        evacuate((StgClosure **)&tso->bound->tso);
68 69
    }

70
    saved_eager = gct->eager_promotion;
Ben Gamari's avatar
Ben Gamari committed
71
    gct->eager_promotion = false;
simonmar@microsoft.com's avatar
simonmar@microsoft.com committed
72

73 74
    evacuate((StgClosure **)&tso->blocked_exceptions);
    evacuate((StgClosure **)&tso->bq);
75

76 77 78
    // scavange current transaction record
    evacuate((StgClosure **)&tso->trec);

79
    evacuate((StgClosure **)&tso->stackobj);
80 81

    evacuate((StgClosure **)&tso->_link);
82
    if (   tso->why_blocked == BlockedOnMVar
83
        || tso->why_blocked == BlockedOnMVarRead
84 85
        || tso->why_blocked == BlockedOnBlackHole
        || tso->why_blocked == BlockedOnMsgThrowTo
86
        || tso->why_blocked == NotBlocked
87 88
        ) {
        evacuate(&tso->block_info.closure);
89
    }
Ben Gamari's avatar
Ben Gamari committed
90
#if defined(THREADED_RTS)
91 92 93 94 95 96 97 98 99
    // in the THREADED_RTS, block_info.closure must always point to a
    // valid closure, because we assume this in throwTo().  In the
    // non-threaded RTS it might be a FD (for
    // BlockedOnRead/BlockedOnWrite) or a time value (BlockedOnDelay)
    else {
        tso->block_info.closure = (StgClosure *)END_TSO_QUEUE;
    }
#endif

100
    tso->dirty = gct->failed_to_evac;
simonmar@microsoft.com's avatar
simonmar@microsoft.com committed
101 102

    gct->eager_promotion = saved_eager;
103 104
}

105 106 107 108
/* ----------------------------------------------------------------------------
   Scavenging compact objects
   ------------------------------------------------------------------------- */

109 110 111 112 113 114 115 116
typedef struct {
    // We must save gct when calling mapHashTable(), which is compiled
    // without GCThread.h and so uses a different calling convention.
    // See also GC.c:mark_root where we do a similar thing.
    gc_thread *saved_gct;
    HashTable *newHash;
} MapHashData;

117
static void
118
evacuate_hash_entry(MapHashData *dat, StgWord key, const void *value)
119 120
{
    StgClosure *p = (StgClosure*)key;
Ben Gamari's avatar
Ben Gamari committed
121
#if defined(THREADED_RTS)
122 123
    gc_thread *old_gct = gct;
#endif
124

125
    SET_GCT(dat->saved_gct);
126
    evacuate(&p);
127 128
    insertHashTable(dat->newHash, (StgWord)p, value);
    SET_GCT(old_gct);
129 130 131 132 133 134 135 136 137 138
}

static void
scavenge_compact(StgCompactNFData *str)
{
    bool saved_eager;
    saved_eager = gct->eager_promotion;
    gct->eager_promotion = false;

    if (str->hash) {
139 140
        MapHashData dat;
        dat.saved_gct = gct;
141
        HashTable *newHash = allocHashTable();
142 143
        dat.newHash = newHash;
        mapHashTable(str->hash, (void*)&dat, (MapHashFn)evacuate_hash_entry);
144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
        freeHashTable(str->hash, NULL);
        str->hash = newHash;
    }

    debugTrace(DEBUG_compact,
               "compact alive @%p, gen %d, %" FMT_Word " bytes",
               str, Bdescr((P_)str)->gen_no, str->totalW * sizeof(W_))

    gct->eager_promotion = saved_eager;
    if (gct->failed_to_evac) {
        ((StgClosure *)str)->header.info = &stg_COMPACT_NFDATA_DIRTY_info;
    } else {
        ((StgClosure *)str)->header.info = &stg_COMPACT_NFDATA_CLEAN_info;
    }
}

160 161 162 163 164 165
/* -----------------------------------------------------------------------------
   Mutable arrays of pointers
   -------------------------------------------------------------------------- */

static StgPtr scavenge_mut_arr_ptrs (StgMutArrPtrs *a)
{
166
    W_ m;
Ben Gamari's avatar
Ben Gamari committed
167
    bool any_failed;
168 169
    StgPtr p, q;

Ben Gamari's avatar
Ben Gamari committed
170
    any_failed = false;
171 172 173 174 175 176 177 178
    p = (StgPtr)&a->payload[0];
    for (m = 0; (int)m < (int)mutArrPtrsCards(a->ptrs) - 1; m++)
    {
        q = p + (1 << MUT_ARR_PTRS_CARD_BITS);
        for (; p < q; p++) {
            evacuate((StgClosure**)p);
        }
        if (gct->failed_to_evac) {
Ben Gamari's avatar
Ben Gamari committed
179
            any_failed = true;
180
            *mutArrPtrsCard(a,m) = 1;
Ben Gamari's avatar
Ben Gamari committed
181
            gct->failed_to_evac = false;
182 183 184 185 186 187 188 189 190 191 192
        } else {
            *mutArrPtrsCard(a,m) = 0;
        }
    }

    q = (StgPtr)&a->payload[a->ptrs];
    if (p < q) {
        for (; p < q; p++) {
            evacuate((StgClosure**)p);
        }
        if (gct->failed_to_evac) {
Ben Gamari's avatar
Ben Gamari committed
193
            any_failed = true;
194
            *mutArrPtrsCard(a,m) = 1;
Ben Gamari's avatar
Ben Gamari committed
195
            gct->failed_to_evac = false;
196 197 198 199 200 201 202 203
        } else {
            *mutArrPtrsCard(a,m) = 0;
        }
    }

    gct->failed_to_evac = any_failed;
    return (StgPtr)a + mut_arr_ptrs_sizeW(a);
}
204

205 206 207
// scavenge only the marked areas of a MUT_ARR_PTRS
static StgPtr scavenge_mut_arr_ptrs_marked (StgMutArrPtrs *a)
{
208
    W_ m;
209
    StgPtr p, q;
Ben Gamari's avatar
Ben Gamari committed
210
    bool any_failed;
211

Ben Gamari's avatar
Ben Gamari committed
212
    any_failed = false;
213 214 215 216 217 218 219 220 221 222
    for (m = 0; m < mutArrPtrsCards(a->ptrs); m++)
    {
        if (*mutArrPtrsCard(a,m) != 0) {
            p = (StgPtr)&a->payload[m << MUT_ARR_PTRS_CARD_BITS];
            q = stg_min(p + (1 << MUT_ARR_PTRS_CARD_BITS),
                        (StgPtr)&a->payload[a->ptrs]);
            for (; p < q; p++) {
                evacuate((StgClosure**)p);
            }
            if (gct->failed_to_evac) {
Ben Gamari's avatar
Ben Gamari committed
223 224
                any_failed = true;
                gct->failed_to_evac = false;
225 226 227 228 229 230 231 232 233 234
            } else {
                *mutArrPtrsCard(a,m) = 0;
            }
        }
    }

    gct->failed_to_evac = any_failed;
    return (StgPtr)a + mut_arr_ptrs_sizeW(a);
}

235 236 237 238 239 240 241 242 243 244 245 246 247 248
STATIC_INLINE StgPtr
scavenge_small_bitmap (StgPtr p, StgWord size, StgWord bitmap)
{
    while (size > 0) {
        if ((bitmap & 1) == 0) {
            evacuate((StgClosure **)p);
        }
        p++;
        bitmap = bitmap >> 1;
        size--;
    }
    return p;
}

249 250 251 252 253 254
/* -----------------------------------------------------------------------------
   Blocks of function args occur on the stack (at the top) and
   in PAPs.
   -------------------------------------------------------------------------- */

STATIC_INLINE StgPtr
255
scavenge_arg_block (const StgFunInfoTable *fun_info, StgClosure **args)
256 257 258
{
    StgPtr p;
    StgWord bitmap;
259
    StgWord size;
260 261 262 263

    p = (StgPtr)args;
    switch (fun_info->f.fun_type) {
    case ARG_GEN:
264 265 266
        bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
        size = BITMAP_SIZE(fun_info->f.b.bitmap);
        goto small_bitmap;
267
    case ARG_GEN_BIG:
268 269 270 271
        size = GET_FUN_LARGE_BITMAP(fun_info)->size;
        scavenge_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
        p += size;
        break;
272
    default:
273 274
        bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
        size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
275
    small_bitmap:
276
        p = scavenge_small_bitmap(p, size, bitmap);
277
        break;
278 279 280 281
    }
    return p;
}

Simon Marlow's avatar
Simon Marlow committed
282
STATIC_INLINE GNUC_ATTR_HOT StgPtr
283 284 285 286
scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
{
    StgPtr p;
    StgWord bitmap;
287
    const StgFunInfoTable *fun_info;
288

289
    fun_info = get_fun_itbl(UNTAG_CONST_CLOSURE(fun));
290 291 292 293 294
    ASSERT(fun_info->i.type != PAP);
    p = (StgPtr)payload;

    switch (fun_info->f.fun_type) {
    case ARG_GEN:
295 296
        bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
        goto small_bitmap;
297
    case ARG_GEN_BIG:
298 299 300
        scavenge_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
        p += size;
        break;
301
    case ARG_BCO:
302 303 304
        scavenge_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
        p += size;
        break;
305
    default:
306
        bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
307
    small_bitmap:
308
        p = scavenge_small_bitmap(p, size, bitmap);
309
        break;
310 311 312 313
    }
    return p;
}

Simon Marlow's avatar
Simon Marlow committed
314
STATIC_INLINE GNUC_ATTR_HOT StgPtr
315 316
scavenge_PAP (StgPAP *pap)
{
317
    evacuate(&pap->fun);
318 319 320 321 322 323
    return scavenge_PAP_payload (pap->fun, pap->payload, pap->n_args);
}

STATIC_INLINE StgPtr
scavenge_AP (StgAP *ap)
{
324
    evacuate(&ap->fun);
325 326 327
    return scavenge_PAP_payload (ap->fun, ap->payload, ap->n_args);
}

328 329 330 331 332 333 334 335 336 337
/* -----------------------------------------------------------------------------
   Scavenge SRTs
   -------------------------------------------------------------------------- */

/* Similar to scavenge_large_bitmap(), but we don't write back the
 * pointers we get back from evacuate().
 */
static void
scavenge_large_srt_bitmap( StgLargeSRT *large_srt )
{
338
    uint32_t i, j, size;
339 340
    StgWord bitmap;
    StgClosure **p;
341

342
    size   = (uint32_t)large_srt->l.size;
343
    p      = (StgClosure **)large_srt->srt;
344 345 346

    for (i = 0; i < size / BITS_IN(W_); i++) {
        bitmap = large_srt->l.bitmap[i];
Simon Marlow's avatar
Simon Marlow committed
347 348
        // skip zero words: bitmaps can be very sparse, and this helps
        // performance a lot in some cases.
349 350 351 352 353 354 355 356
        if (bitmap != 0) {
            for (j = 0; j < BITS_IN(W_); j++) {
                if ((bitmap & 1) != 0) {
                    evacuate(p);
                }
                p++;
                bitmap = bitmap >> 1;
            }
357
        } else {
358 359 360 361 362 363 364 365 366 367
            p += BITS_IN(W_);
        }
    }
    if (size % BITS_IN(W_) != 0) {
        bitmap = large_srt->l.bitmap[i];
        for (j = 0; j < size % BITS_IN(W_); j++) {
            if ((bitmap & 1) != 0) {
                evacuate(p);
            }
            p++;
368 369
            bitmap = bitmap >> 1;
        }
370 371 372 373 374 375 376
    }
}

/* evacuate the SRT.  If srt_bitmap is zero, then there isn't an
 * srt field in the info table.  That's ok, because we'll
 * never dereference it.
 */
Simon Marlow's avatar
Simon Marlow committed
377
STATIC_INLINE GNUC_ATTR_HOT void
378
scavenge_srt (StgClosure **srt, uint32_t srt_bitmap)
379
{
380
  uint32_t bitmap;
381 382 383 384 385
  StgClosure **p;

  bitmap = srt_bitmap;
  p = srt;

386
  if (bitmap == (StgHalfWord)(-1)) {
387 388 389 390 391 392
      scavenge_large_srt_bitmap( (StgLargeSRT *)srt );
      return;
  }

  while (bitmap != 0) {
      if ((bitmap & 1) != 0) {
393
#if defined(COMPILING_WINDOWS_DLL)
394 395 396 397 398 399 400 401 402 403 404 405 406
          // Special-case to handle references to closures hiding out in DLLs, since
          // double indirections required to get at those. The code generator knows
          // which is which when generating the SRT, so it stores the (indirect)
          // reference to the DLL closure in the table by first adding one to it.
          // We check for this here, and undo the addition before evacuating it.
          //
          // If the SRT entry hasn't got bit 0 set, the SRT entry points to a
          // closure that's fixed at link-time, and no extra magic is required.
          if ( (W_)(*srt) & 0x1 ) {
              evacuate( (StgClosure**) ((W_) (*srt) & ~0x1));
          } else {
              evacuate(p);
          }
407
#else
408
          evacuate(p);
409 410 411 412 413 414 415 416
#endif
      }
      p++;
      bitmap = bitmap >> 1;
  }
}


Simon Marlow's avatar
Simon Marlow committed
417
STATIC_INLINE GNUC_ATTR_HOT void
418 419 420
scavenge_thunk_srt(const StgInfoTable *info)
{
    StgThunkInfoTable *thunk_info;
421
    uint32_t bitmap;
422 423 424 425

    if (!major_gc) return;

    thunk_info = itbl_to_thunk_itbl(info);
426 427 428 429 430 431
    bitmap = thunk_info->i.srt_bitmap;
    if (bitmap) {
        // don't read srt_offset if bitmap==0, because it doesn't exist
        // and so the memory might not be readable.
        scavenge_srt((StgClosure **)GET_SRT(thunk_info), bitmap);
    }
432 433
}

Simon Marlow's avatar
Simon Marlow committed
434
STATIC_INLINE GNUC_ATTR_HOT void
435 436 437
scavenge_fun_srt(const StgInfoTable *info)
{
    StgFunInfoTable *fun_info;
438
    uint32_t bitmap;
439 440

    if (!major_gc) return;
441

442
    fun_info = itbl_to_fun_itbl(info);
443 444 445 446 447 448
    bitmap = fun_info->i.srt_bitmap;
    if (bitmap) {
        // don't read srt_offset if bitmap==0, because it doesn't exist
        // and so the memory might not be readable.
        scavenge_srt((StgClosure **)GET_FUN_SRT(fun_info), bitmap);
    }
449 450 451 452 453
}

/* -----------------------------------------------------------------------------
   Scavenge a block from the given scan pointer up to bd->free.

Simon Marlow's avatar
Simon Marlow committed
454
   evac_gen_no is set by the caller to be either zero (for a step in a
455
   generation < N) or G where G is the generation of the step being
456
   scavenged.
457

Simon Marlow's avatar
Simon Marlow committed
458
   We sometimes temporarily change evac_gen_no back to zero if we're
459
   scavenging a mutable object where eager promotion isn't such a good
460
   idea.
461 462
   -------------------------------------------------------------------------- */

Simon Marlow's avatar
Simon Marlow committed
463
static GNUC_ATTR_HOT void
464 465 466
scavenge_block (bdescr *bd)
{
  StgPtr p, q;
467
  const StgInfoTable *info;
Ben Gamari's avatar
Ben Gamari committed
468
  bool saved_eager_promotion;
Simon Marlow's avatar
Simon Marlow committed
469
  gen_workspace *ws;
470

Simon Marlow's avatar
Simon Marlow committed
471
  debugTrace(DEBUG_gc, "scavenging block %p (gen %d) @ %p",
472
             bd->start, bd->gen_no, bd->u.scan);
473 474

  gct->scan_bd = bd;
Simon Marlow's avatar
Simon Marlow committed
475
  gct->evac_gen_no = bd->gen_no;
476
  saved_eager_promotion = gct->eager_promotion;
Ben Gamari's avatar
Ben Gamari committed
477
  gct->failed_to_evac = false;
478

Simon Marlow's avatar
Simon Marlow committed
479
  ws = &gct->gens[bd->gen->no];
480 481

  p = bd->u.scan;
482

483 484 485 486 487
  // we might be evacuating into the very object that we're
  // scavenging, so we have to check the real bd->free pointer each
  // time around the loop.
  while (p < bd->free || (bd == ws->todo_bd && p < ws->todo_free)) {

488
      ASSERT(bd->link == NULL);
489 490
    ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
    info = get_itbl((StgClosure *)p);
491

492 493 494 495 496 497 498
    ASSERT(gct->thunk_selector_depth == 0);

    q = p;
    switch (info->type) {

    case MVAR_CLEAN:
    case MVAR_DIRTY:
499 500
    {
        StgMVar *mvar = ((StgMVar *)p);
Ben Gamari's avatar
Ben Gamari committed
501
        gct->eager_promotion = false;
502 503 504 505 506 507 508 509 510 511 512 513
        evacuate((StgClosure **)&mvar->head);
        evacuate((StgClosure **)&mvar->tail);
        evacuate((StgClosure **)&mvar->value);
        gct->eager_promotion = saved_eager_promotion;

        if (gct->failed_to_evac) {
            mvar->header.info = &stg_MVAR_DIRTY_info;
        } else {
            mvar->header.info = &stg_MVAR_CLEAN_info;
        }
        p += sizeofW(StgMVar);
        break;
514 515
    }

516 517
    case TVAR:
    {
518
        StgTVar *tvar = ((StgTVar *)p);
Ben Gamari's avatar
Ben Gamari committed
519
        gct->eager_promotion = false;
520 521
        evacuate((StgClosure **)&tvar->current_value);
        evacuate((StgClosure **)&tvar->first_watch_queue_entry);
522 523 524 525 526 527 528 529 530
        gct->eager_promotion = saved_eager_promotion;

        if (gct->failed_to_evac) {
            tvar->header.info = &stg_TVAR_DIRTY_info;
        } else {
            tvar->header.info = &stg_TVAR_CLEAN_info;
        }
        p += sizeofW(StgTVar);
        break;
531 532
    }

533
    case FUN_2_0:
534 535 536 537 538
        scavenge_fun_srt(info);
        evacuate(&((StgClosure *)p)->payload[1]);
        evacuate(&((StgClosure *)p)->payload[0]);
        p += sizeofW(StgHeader) + 2;
        break;
539 540

    case THUNK_2_0:
541 542 543 544 545
        scavenge_thunk_srt(info);
        evacuate(&((StgThunk *)p)->payload[1]);
        evacuate(&((StgThunk *)p)->payload[0]);
        p += sizeofW(StgThunk) + 2;
        break;
546 547

    case CONSTR_2_0:
548 549 550 551 552
        evacuate(&((StgClosure *)p)->payload[1]);
        evacuate(&((StgClosure *)p)->payload[0]);
        p += sizeofW(StgHeader) + 2;
        break;

553
    case THUNK_1_0:
554 555 556 557 558
        scavenge_thunk_srt(info);
        evacuate(&((StgThunk *)p)->payload[0]);
        p += sizeofW(StgThunk) + 1;
        break;

559
    case FUN_1_0:
560
        scavenge_fun_srt(info);
561
        /* fallthrough */
562
    case CONSTR_1_0:
563 564 565 566
        evacuate(&((StgClosure *)p)->payload[0]);
        p += sizeofW(StgHeader) + 1;
        break;

567
    case THUNK_0_1:
568 569 570 571
        scavenge_thunk_srt(info);
        p += sizeofW(StgThunk) + 1;
        break;

572
    case FUN_0_1:
573
        scavenge_fun_srt(info);
574
        /* fallthrough */
575
    case CONSTR_0_1:
576 577 578
        p += sizeofW(StgHeader) + 1;
        break;

579
    case THUNK_0_2:
580 581 582 583
        scavenge_thunk_srt(info);
        p += sizeofW(StgThunk) + 2;
        break;

584
    case FUN_0_2:
585
        scavenge_fun_srt(info);
586
        /* fallthrough */
587
    case CONSTR_0_2:
588 589 590
        p += sizeofW(StgHeader) + 2;
        break;

591
    case THUNK_1_1:
592 593 594 595
        scavenge_thunk_srt(info);
        evacuate(&((StgThunk *)p)->payload[0]);
        p += sizeofW(StgThunk) + 2;
        break;
596 597

    case FUN_1_1:
598
        scavenge_fun_srt(info);
599
        /* fallthrough */
600
    case CONSTR_1_1:
601 602 603 604
        evacuate(&((StgClosure *)p)->payload[0]);
        p += sizeofW(StgHeader) + 2;
        break;

605
    case FUN:
606 607
        scavenge_fun_srt(info);
        goto gen_obj;
608 609 610

    case THUNK:
    {
611 612 613 614 615 616 617 618 619
        StgPtr end;

        scavenge_thunk_srt(info);
        end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs;
        for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
            evacuate((StgClosure **)p);
        }
        p += info->layout.payload.nptrs;
        break;
620
    }
621

622 623
    gen_obj:
    case CONSTR:
Simon Marlow's avatar
Simon Marlow committed
624
    case CONSTR_NOCAF:
625
    case WEAK:
626
    case PRIM:
627
    {
628 629 630 631 632 633 634 635
        StgPtr end;

        end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
        for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
            evacuate((StgClosure **)p);
        }
        p += info->layout.payload.nptrs;
        break;
636 637 638
    }

    case BCO: {
639 640 641 642 643 644
        StgBCO *bco = (StgBCO *)p;
        evacuate((StgClosure **)&bco->instrs);
        evacuate((StgClosure **)&bco->literals);
        evacuate((StgClosure **)&bco->ptrs);
        p += bco_sizeW(bco);
        break;
645 646
    }

647
    case BLACKHOLE:
648 649 650
        evacuate(&((StgInd *)p)->indirectee);
        p += sizeofW(StgInd);
        break;
651 652 653

    case MUT_VAR_CLEAN:
    case MUT_VAR_DIRTY:
Ben Gamari's avatar
Ben Gamari committed
654
        gct->eager_promotion = false;
655 656 657 658 659 660 661 662 663 664
        evacuate(&((StgMutVar *)p)->var);
        gct->eager_promotion = saved_eager_promotion;

        if (gct->failed_to_evac) {
            ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
        } else {
            ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
        }
        p += sizeofW(StgMutVar);
        break;
665

666 667 668
    case BLOCKING_QUEUE:
    {
        StgBlockingQueue *bq = (StgBlockingQueue *)p;
669

Ben Gamari's avatar
Ben Gamari committed
670
        gct->eager_promotion = false;
671 672 673 674
        evacuate(&bq->bh);
        evacuate((StgClosure**)&bq->owner);
        evacuate((StgClosure**)&bq->queue);
        evacuate((StgClosure**)&bq->link);
675
        gct->eager_promotion = saved_eager_promotion;
676

677 678 679 680 681
        if (gct->failed_to_evac) {
            bq->header.info = &stg_BLOCKING_QUEUE_DIRTY_info;
        } else {
            bq->header.info = &stg_BLOCKING_QUEUE_CLEAN_info;
        }
682 683 684
        p += sizeofW(StgBlockingQueue);
        break;
    }
685 686

    case THUNK_SELECTOR:
687 688 689 690 691
    {
        StgSelector *s = (StgSelector *)p;
        evacuate(&s->selectee);
        p += THUNK_SELECTOR_sizeW();
        break;
692 693 694 695 696
    }

    // A chunk of stack saved in a heap object
    case AP_STACK:
    {
697
        StgAP_STACK *ap = (StgAP_STACK *)p;
698

699 700 701 702
        evacuate(&ap->fun);
        scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
        p = (StgPtr)ap->payload + ap->size;
        break;
703 704 705
    }

    case PAP:
706 707
        p = scavenge_PAP((StgPAP *)p);
        break;
708 709

    case AP:
710 711
        p = scavenge_AP((StgAP *)p);
        break;
712 713

    case ARR_WORDS:
714
        // nothing to follow
siddhanathan's avatar
siddhanathan committed
715
        p += arr_words_sizeW((StgArrBytes *)p);
716
        break;
717 718 719 720

    case MUT_ARR_PTRS_CLEAN:
    case MUT_ARR_PTRS_DIRTY:
    {
721 722 723 724
        // We don't eagerly promote objects pointed to by a mutable
        // array, but if we find the array only points to objects in
        // the same or an older generation, we mark it "clean" and
        // avoid traversing it during minor GCs.
Ben Gamari's avatar
Ben Gamari committed
725
        gct->eager_promotion = false;
726

727
        p = scavenge_mut_arr_ptrs((StgMutArrPtrs*)p);
728

729 730 731 732 733
        if (gct->failed_to_evac) {
            ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
        } else {
            ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
        }
734

735
        gct->eager_promotion = saved_eager_promotion;
Ben Gamari's avatar
Ben Gamari committed
736
        gct->failed_to_evac = true; // always put it on the mutable list.
737
        break;
738 739 740 741
    }

    case MUT_ARR_PTRS_FROZEN:
    case MUT_ARR_PTRS_FROZEN0:
742
        // follow everything
743
    {
744
        p = scavenge_mut_arr_ptrs((StgMutArrPtrs*)p);
745

746 747 748
        // If we're going to put this object on the mutable list, then
        // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
        if (gct->failed_to_evac) {
749
            ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
750 751 752 753
        } else {
            ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
        }
        break;
754 755
    }

756 757 758 759 760 761 762 763 764 765
    case SMALL_MUT_ARR_PTRS_CLEAN:
    case SMALL_MUT_ARR_PTRS_DIRTY:
        // follow everything
    {
        StgPtr next;

        // We don't eagerly promote objects pointed to by a mutable
        // array, but if we find the array only points to objects in
        // the same or an older generation, we mark it "clean" and
        // avoid traversing it during minor GCs.
Ben Gamari's avatar
Ben Gamari committed
766
        gct->eager_promotion = false;
767 768 769 770 771 772 773 774 775 776 777 778
        next = p + small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs*)p);
        for (p = (P_)((StgSmallMutArrPtrs *)p)->payload; p < next; p++) {
            evacuate((StgClosure **)p);
        }
        gct->eager_promotion = saved_eager_promotion;

        if (gct->failed_to_evac) {
            ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_DIRTY_info;
        } else {
            ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_CLEAN_info;
        }

Ben Gamari's avatar
Ben Gamari committed
779
        gct->failed_to_evac = true; // always put it on the mutable list.
780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803
        break;
    }

    case SMALL_MUT_ARR_PTRS_FROZEN:
    case SMALL_MUT_ARR_PTRS_FROZEN0:
        // follow everything
    {
        StgPtr next;

        next = p + small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs*)p);
        for (p = (P_)((StgSmallMutArrPtrs *)p)->payload; p < next; p++) {
            evacuate((StgClosure **)p);
        }

        // If we're going to put this object on the mutable list, then
        // set its info ptr to SMALL_MUT_ARR_PTRS_FROZEN0 to indicate that.
        if (gct->failed_to_evac) {
            ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_FROZEN0_info;
        } else {
            ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_FROZEN_info;
        }
        break;
    }

804
    case TSO:
805
    {
806 807
        scavengeTSO((StgTSO *)p);
        p += sizeofW(StgTSO);
808
        break;
809 810
    }

811 812 813 814
    case STACK:
    {
        StgStack *stack = (StgStack*)p;

Ben Gamari's avatar
Ben Gamari committed
815
        gct->eager_promotion = false;
816 817 818 819 820 821 822 823 824

        scavenge_stack(stack->sp, stack->stack + stack->stack_size);
        stack->dirty = gct->failed_to_evac;
        p += stack_sizeW(stack);

        gct->eager_promotion = saved_eager_promotion;
        break;
    }

825
    case MUT_PRIM:
826
      {
827
        StgPtr end;
828

Ben Gamari's avatar
Ben Gamari committed
829
        gct->eager_promotion = false;
830

831 832 833 834 835
        end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
        for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
            evacuate((StgClosure **)p);
        }
        p += info->layout.payload.nptrs;
836

837
        gct->eager_promotion = saved_eager_promotion;
Ben Gamari's avatar
Ben Gamari committed
838
        gct->failed_to_evac = true; // mutable
839
        break;
840 841 842 843
      }

    case TREC_CHUNK:
      {
844 845 846
        StgWord i;
        StgTRecChunk *tc = ((StgTRecChunk *) p);
        TRecEntry *e = &(tc -> entries[0]);
Ben Gamari's avatar
Ben Gamari committed
847
        gct->eager_promotion = false;
848 849 850 851 852 853 854
        evacuate((StgClosure **)&tc->prev_chunk);
        for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
          evacuate((StgClosure **)&e->tvar);
          evacuate((StgClosure **)&e->expected_value);
          evacuate((StgClosure **)&e->new_value);
        }
        gct->eager_promotion = saved_eager_promotion;
Ben Gamari's avatar
Ben Gamari committed
855
        gct->failed_to_evac = true; // mutable
856 857
        p += sizeofW(StgTRecChunk);
        break;
858 859 860
      }

    default:
861 862
        barf("scavenge: unimplemented/strange closure type %d @ %p",
             info->type, p);
863 864 865 866
    }

    /*
     * We need to record the current object on the mutable list if
867
     *  (a) It is actually mutable, or
868 869 870 871 872
     *  (b) It contains pointers to a younger generation.
     * Case (b) arises if we didn't manage to promote everything that
     * the current object points to into the current generation.
     */
    if (gct->failed_to_evac) {
Ben Gamari's avatar
Ben Gamari committed
873
        gct->failed_to_evac = false;
874 875 876
        if (bd->gen_no > 0) {
            recordMutableGen_GC((StgClosure *)q, bd->gen_no);
        }
877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899
    }
  }

  if (p > bd->free)  {
      gct->copied += ws->todo_free - bd->free;
      bd->free = p;
  }

  debugTrace(DEBUG_gc, "   scavenged %ld bytes",
             (unsigned long)((bd->free - bd->u.scan) * sizeof(W_)));

  // update stats: this is a block that has been scavenged
  gct->scanned += bd->free - bd->u.scan;
  bd->u.scan = bd->free;

  if (bd != ws->todo_bd) {
      // we're not going to evac any more objects into
      // this block, so push it now.
      push_scanned_block(bd, ws);
  }

  gct->scan_bd = NULL;
}
900 901 902 903 904 905 906 907
/* -----------------------------------------------------------------------------
   Scavenge everything on the mark stack.

   This is slightly different from scavenge():
      - we don't walk linearly through the objects, so the scavenger
        doesn't need to advance the pointer on to the next object.
   -------------------------------------------------------------------------- */

908
static void
909 910 911
scavenge_mark_stack(void)
{
    StgPtr p, q;
912
    const StgInfoTable *info;
Ben Gamari's avatar
Ben Gamari committed
913
    bool saved_eager_promotion;
914

Simon Marlow's avatar
Simon Marlow committed
915
    gct->evac_gen_no = oldest_gen->no;
916
    saved_eager_promotion = gct->eager_promotion;
917

918
    while ((p = pop_mark_stack())) {
919

920 921 922 923
        ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
        info = get_itbl((StgClosure *)p);

        q = p;
924
        switch (info->type) {
925

926 927
        case MVAR_CLEAN:
        case MVAR_DIRTY:
928
        {
929
            StgMVar *mvar = ((StgMVar *)p);
Ben Gamari's avatar
Ben Gamari committed
930
            gct->eager_promotion = false;
931 932 933
            evacuate((StgClosure **)&mvar->head);
            evacuate((StgClosure **)&mvar->tail);
            evacuate((StgClosure **)&mvar->value);
934
            gct->eager_promotion = saved_eager_promotion;
935

936
            if (gct->failed_to_evac) {
937 938 939 940 941 942
                mvar->header.info = &stg_MVAR_DIRTY_info;
            } else {
                mvar->header.info = &stg_MVAR_CLEAN_info;
            }
            break;
        }
943

944 945 946
        case TVAR:
        {
            StgTVar *tvar = ((StgTVar *)p);
Ben Gamari's avatar
Ben Gamari committed
947
            gct->eager_promotion = false;
948 949 950 951 952 953 954 955 956 957 958 959
            evacuate((StgClosure **)&tvar->current_value);
            evacuate((StgClosure **)&tvar->first_watch_queue_entry);
            gct->eager_promotion = saved_eager_promotion;

            if (gct->failed_to_evac) {
                tvar->header.info = &stg_TVAR_DIRTY_info;
            } else {
                tvar->header.info = &stg_TVAR_CLEAN_info;
            }
            break;
        }

960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025
        case FUN_2_0:
            scavenge_fun_srt(info);
            evacuate(&((StgClosure *)p)->payload[1]);
            evacuate(&((StgClosure *)p)->payload[0]);
            break;

        case THUNK_2_0:
            scavenge_thunk_srt(info);
            evacuate(&((StgThunk *)p)->payload[1]);
            evacuate(&((StgThunk *)p)->payload[0]);
            break;

        case CONSTR_2_0:
            evacuate(&((StgClosure *)p)->payload[1]);
            evacuate(&((StgClosure *)p)->payload[0]);
            break;

        case FUN_1_0:
        case FUN_1_1:
            scavenge_fun_srt(info);
            evacuate(&((StgClosure *)p)->payload[0]);
            break;

        case THUNK_1_0:
        case THUNK_1_1:
            scavenge_thunk_srt(info);
            evacuate(&((StgThunk *)p)->payload[0]);
            break;