Compact.c 24.6 KB
Newer Older
1 2
/* -----------------------------------------------------------------------------
 *
3
 * (c) The GHC Team 2001-2008
4 5 6
 *
 * Compacting garbage collector
 *
7 8
 * Documentation on the architecture of the Garbage Collector can be
 * found in the online commentary:
9
 *
10
 *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/rts/storage/gc
11
 *
12 13
 * ---------------------------------------------------------------------------*/

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

Simon Marlow's avatar
Simon Marlow committed
17
#include "GCThread.h"
Simon Marlow's avatar
Simon Marlow committed
18
#include "Storage.h"
19 20
#include "RtsUtils.h"
#include "BlockAlloc.h"
21 22
#include "GC.h"
#include "Compact.h"
23
#include "Schedule.h"
24
#include "Apply.h"
Simon Marlow's avatar
Simon Marlow committed
25
#include "Trace.h"
Simon Marlow's avatar
Simon Marlow committed
26 27
#include "Weak.h"
#include "MarkWeak.h"
David Feuer's avatar
David Feuer committed
28 29
#include "StablePtr.h"
#include "StableName.h"
30

31
// Turn off inlining when debugging - it obfuscates things
Ben Gamari's avatar
Ben Gamari committed
32
#if defined(DEBUG)
sof's avatar
sof committed
33 34
# undef  STATIC_INLINE
# define STATIC_INLINE static
35 36
#endif

37
/* ----------------------------------------------------------------------------
38 39 40 41 42 43 44 45 46 47 48 49 50 51 52
   Threading / unthreading pointers.

   The basic idea here is to chain together all the fields pointing at
   a particular object, with the root of the chain in the object's
   info table field.  The original contents of the info pointer goes
   at the end of the chain.

   Adding a new field to the chain is a matter of swapping the
   contents of the field with the contents of the object's info table
   field.

   To unthread the chain, we walk down it updating all the fields on
   the chain with the new location of the object.  We stop when we
   reach the info pointer at the end.

53 54 55 56 57 58 59
   The main difficulty here is that we need to be able to identify the
   info pointer at the end of the chain.  We can't use the low bits of
   the pointer for this; they are already being used for
   pointer-tagging.  What's more, we need to retain the
   pointer-tagging tag bits on each pointer during the
   threading/unthreading process.

60
   Our solution is as follows:
61 62 63 64 65 66 67 68 69 70 71
     - an info pointer (chain length zero) is identified by having tag 0
     - in a threaded chain of length > 0:
        - the pointer-tagging tag bits are attached to the info pointer
        - the first entry in the chain has tag 1
        - second and subsequent entries in the chain have tag 2

   This exploits the fact that the tag on each pointer to a given
   closure is normally the same (if they are not the same, then
   presumably the tag is not essential and it therefore doesn't matter
   if we throw away some of the tags).
   ------------------------------------------------------------------------- */
72

Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
73 74 75 76 77 78 79 80 81 82 83 84
STATIC_INLINE W_
UNTAG_PTR(W_ p)
{
    return p & ~TAG_MASK;
}

STATIC_INLINE W_
GET_PTR_TAG(W_ p)
{
    return p & TAG_MASK;
}

sof's avatar
sof committed
85
STATIC_INLINE void
86
thread (StgClosure **p)
87
{
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
88 89
    StgClosure *q0  = *p;
    P_ q = (P_)UNTAG_CLOSURE(q0);
90

91 92 93
    // It doesn't look like a closure at the moment, because the info
    // ptr is possibly threaded:
    // ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
94

95
    if (HEAP_ALLOCED(q)) {
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
96
        bdescr *bd = Bdescr(q);
97

98
        if (bd->flags & BF_MARKED)
Simon Marlow's avatar
Simon Marlow committed
99
        {
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
100 101
            W_ iptr = *q;
            switch (GET_PTR_TAG(iptr))
102
            {
103
            case 0:
104 105
                // this is the info pointer; we are creating a new chain.
                // save the original tag at the end of the chain.
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
106 107
                *p = (StgClosure *)((W_)iptr + GET_CLOSURE_TAG(q0));
                *q = (W_)p + 1;
108 109 110 111 112
                break;
            case 1:
            case 2:
                // this is a chain of length 1 or more
                *p = (StgClosure *)iptr;
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
113
                *q = (W_)p + 2;
114 115 116
                break;
            }
        }
117 118 119
    }
}

120 121 122 123 124 125
static void
thread_root (void *user STG_UNUSED, StgClosure **p)
{
    thread(p);
}

126 127 128 129
// This version of thread() takes a (void *), used to circumvent
// warnings from gcc about pointer punning and strict aliasing.
STATIC_INLINE void thread_ (void *p) { thread((StgClosure **)p); }

sof's avatar
sof committed
130
STATIC_INLINE void
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
131
unthread( P_ p, W_ free )
132
{
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
133
    W_ q = *p;
134
loop:
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
135
    switch (GET_PTR_TAG(q))
136 137 138 139 140
    {
    case 0:
        // nothing to do; the chain is length zero
        return;
    case 1:
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
141 142 143
    {
        P_ q0 = (P_)(q-1);
        W_ r = *q0;  // r is the info ptr, tagged with the pointer-tag
144
        *q0 = free;
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
145
        *p = (W_)UNTAG_PTR(r);
146
        return;
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
147
    }
148
    case 2:
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
149 150 151
    {
        P_ q0 = (P_)(q-2);
        W_ r = *q0;
152 153 154
        *q0 = free;
        q = r;
        goto loop;
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
155
    }
156 157
    default:
        barf("unthread");
158 159 160
    }
}

161 162 163 164
// Traverse a threaded chain and pull out the info pointer at the end.
// The info pointer is also tagged with the appropriate pointer tag
// for this closure, which should be attached to the pointer
// subsequently passed to unthread().
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
165 166
STATIC_INLINE W_
get_threaded_info( P_ p )
167
{
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
168
    W_ q = (W_)GET_INFO(UNTAG_CLOSURE((StgClosure *)p));
169

170
loop:
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
171
    switch (GET_PTR_TAG(q))
172 173 174 175 176 177
    {
    case 0:
        ASSERT(LOOKS_LIKE_INFO_PTR(q));
        return q;
    case 1:
    {
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
178 179
        W_ r = *(P_)(q-1);
        ASSERT(LOOKS_LIKE_INFO_PTR((W_)UNTAG_CONST_CLOSURE((StgClosure *)r)));
180 181 182
        return r;
    }
    case 2:
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
183
        q = *(P_)(q-2);
184 185 186
        goto loop;
    default:
        barf("get_threaded_info");
187 188 189 190 191
    }
}

// A word-aligned memmove will be faster for small objects than libc's or gcc's.
// Remember, the two regions *might* overlap, but: to <= from.
sof's avatar
sof committed
192
STATIC_INLINE void
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
193
move(P_ to, P_ from, W_ size)
194 195
{
    for(; size > 0; --size) {
196
        *to++ = *from++;
197 198 199 200 201 202 203
    }
}

static void
thread_static( StgClosure* p )
{
  // keep going until we've threaded all the objects on the linked
204
  // list...
205 206
  while (p != END_OF_STATIC_OBJECT_LIST) {
    p = UNTAG_STATIC_LIST_PTR(p);
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
207
    const StgInfoTable *info = get_itbl(p);
208
    switch (info->type) {
209

210
    case IND_STATIC:
211 212 213 214
        thread(&((StgInd *)p)->indirectee);
        p = *IND_STATIC_LINK(p);
        continue;

215
    case THUNK_STATIC:
216 217
        p = *THUNK_STATIC_LINK(p);
        continue;
218
    case FUN_STATIC:
219
        p = *STATIC_LINK(info,p);
220
        continue;
Simon Marlow's avatar
Simon Marlow committed
221 222 223 224 225 226 227
    case CONSTR:
    case CONSTR_NOCAF:
    case CONSTR_1_0:
    case CONSTR_0_1:
    case CONSTR_2_0:
    case CONSTR_1_1:
    case CONSTR_0_2:
228 229 230
        p = *STATIC_LINK(info,p);
        continue;

231
    default:
232
        barf("thread_static: strange closure %d", (int)(info->type));
233 234 235 236 237
    }

  }
}

sof's avatar
sof committed
238
STATIC_INLINE void
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
239
thread_large_bitmap( P_ p, StgLargeBitmap *large_bitmap, W_ size )
240
{
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
241 242 243
    W_ b = 0;
    W_ bitmap = large_bitmap->bitmap[b];
    for (W_ i = 0; i < size; ) {
244 245 246 247 248 249 250 251 252 253 254
        if ((bitmap & 1) == 0) {
            thread((StgClosure **)p);
        }
        i++;
        p++;
        if (i % BITS_IN(W_) == 0) {
            b++;
            bitmap = large_bitmap->bitmap[b];
        } else {
            bitmap = bitmap >> 1;
        }
255 256 257
    }
}

Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
258 259
STATIC_INLINE P_
thread_small_bitmap (P_ p, W_ size, W_ bitmap)
260 261 262 263 264 265 266 267 268 269 270 271
{
    while (size > 0) {
        if ((bitmap & 1) == 0) {
            thread((StgClosure **)p);
        }
        p++;
        bitmap = bitmap >> 1;
        size--;
    }
    return p;
}

Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
272
STATIC_INLINE P_
273 274
thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
{
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
275 276
    W_ bitmap;
    W_ size;
277

Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
278
    P_ p = (P_)args;
279
    switch (fun_info->f.fun_type) {
280
    case ARG_GEN:
281 282 283
        bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
        size = BITMAP_SIZE(fun_info->f.b.bitmap);
        goto small_bitmap;
284
    case ARG_GEN_BIG:
285 286 287 288
        size = GET_FUN_LARGE_BITMAP(fun_info)->size;
        thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
        p += size;
        break;
289
    default:
290 291
        bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
        size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
292
    small_bitmap:
293
        p = thread_small_bitmap(p, size, bitmap);
294
        break;
295 296 297 298
    }
    return p;
}

299
static void
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
300
thread_stack(P_ p, P_ stack_end)
301 302
{
    // highly similar to scavenge_stack, but we do pointer threading here.
303

304 305
    while (p < stack_end) {

306 307 308 309
        // *p must be the info pointer of an activation
        // record.  All activation records have 'bitmap' style layout
        // info.
        //
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
310
        const StgRetInfoTable *info  = get_ret_itbl((StgClosure *)p);
311 312 313

        switch (info->i.type) {

314
            // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
315 316 317
        case CATCH_RETRY_FRAME:
        case CATCH_STM_FRAME:
        case ATOMICALLY_FRAME:
318
        case UPDATE_FRAME:
319 320 321
        case UNDERFLOW_FRAME:
        case STOP_FRAME:
        case CATCH_FRAME:
322
        case RET_SMALL:
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
323 324 325
        {
            W_ bitmap = BITMAP_BITS(info->i.layout.bitmap);
            W_ size   = BITMAP_SIZE(info->i.layout.bitmap);
326 327 328
            p++;
            // NOTE: the payload starts immediately after the info-ptr, we
            // don't have an StgHeader in the same sense as a heap closure.
329
            p = thread_small_bitmap(p, size, bitmap);
330
            continue;
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
331
        }
332 333 334

        case RET_BCO: {
            p++;
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
335
            StgBCO *bco = (StgBCO *)*p;
336 337
            thread((StgClosure **)p);
            p++;
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
338
            W_ size = BCO_BITMAP_SIZE(bco);
339 340 341 342 343 344 345 346
            thread_large_bitmap(p, BCO_BITMAP(bco), size);
            p += size;
            continue;
        }

            // large bitmap (> 32 entries, or 64 on a 64-bit machine)
        case RET_BIG:
            p++;
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
347
            W_ size = GET_LARGE_BITMAP(&info->i)->size;
348 349 350 351 352 353 354
            thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
            p += size;
            continue;

        case RET_FUN:
        {
            StgRetFun *ret_fun = (StgRetFun *)p;
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
355 356 357
            StgFunInfoTable *fun_info =
                FUN_INFO_PTR_TO_STRUCT((StgInfoTable *)UNTAG_PTR(
                           get_threaded_info((P_)ret_fun->fun)));
358 359 360 361 362 363 364 365 366 367
                 // *before* threading it!
            thread(&ret_fun->fun);
            p = thread_arg_block(fun_info, ret_fun->payload);
            continue;
        }

        default:
            barf("thread_stack: weird activation record found on stack: %d",
                 (int)(info->i.type));
        }
368 369 370
    }
}

Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
371 372
STATIC_INLINE P_
thread_PAP_payload (StgClosure *fun, StgClosure **payload, W_ size)
373
{
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
374 375
    StgFunInfoTable *fun_info =
        FUN_INFO_PTR_TO_STRUCT((StgInfoTable *)UNTAG_PTR(get_threaded_info((P_)fun)));
376 377
    ASSERT(fun_info->i.type != PAP);

Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
378
    P_ p = (P_)payload;
379

Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
380
    W_ bitmap;
381
    switch (fun_info->f.fun_type) {
382
    case ARG_GEN:
383 384
        bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
        goto small_bitmap;
385
    case ARG_GEN_BIG:
386 387 388
        thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
        p += size;
        break;
389
    case ARG_BCO:
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
390
        thread_large_bitmap((P_)payload, BCO_BITMAP(fun), size);
391 392
        p += size;
        break;
393
    default:
394
        bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
395
    small_bitmap:
396
        p = thread_small_bitmap(p, size, bitmap);
397
        break;
398
    }
399

400 401 402
    return p;
}

Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
403
STATIC_INLINE P_
404 405
thread_PAP (StgPAP *pap)
{
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
406
    P_ p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args);
407
    thread(&pap->fun);
408 409
    return p;
}
410

Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
411
STATIC_INLINE P_
412 413
thread_AP (StgAP *ap)
{
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
414
    P_ p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args);
415
    thread(&ap->fun);
416
    return p;
417
}
418

Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
419
STATIC_INLINE P_
420 421
thread_AP_STACK (StgAP_STACK *ap)
{
422
    thread(&ap->fun);
423 424 425 426
    thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
    return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
}

Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
427
static P_
428 429
thread_TSO (StgTSO *tso)
{
430
    thread_(&tso->_link);
431
    thread_(&tso->global_link);
432 433

    if (   tso->why_blocked == BlockedOnMVar
434
        || tso->why_blocked == BlockedOnMVarRead
435 436
        || tso->why_blocked == BlockedOnBlackHole
        || tso->why_blocked == BlockedOnMsgThrowTo
437 438
        || tso->why_blocked == NotBlocked
        ) {
439
        thread_(&tso->block_info.closure);
440
    }
441
    thread_(&tso->blocked_exceptions);
442
    thread_(&tso->bq);
443

444
    thread_(&tso->trec);
445

446
    thread_(&tso->stackobj);
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
447
    return (P_)tso + sizeofW(StgTSO);
448 449 450
}


451 452 453 454 455
static void
update_fwd_large( bdescr *bd )
{
  for (; bd != NULL; bd = bd->link) {

Simon Marlow's avatar
Simon Marlow committed
456 457 458 459
    // nothing to do in a pinned block; it might not even have an object
    // at the beginning.
    if (bd->flags & BF_PINNED) continue;

Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
460 461
    P_ p = bd->start;
    const StgInfoTable *info = get_itbl((StgClosure *)p);
462 463 464 465

    switch (info->type) {

    case ARR_WORDS:
gcampax's avatar
gcampax committed
466
    case COMPACT_NFDATA:
467
      // nothing to follow
468 469
      continue;

470 471
    case MUT_ARR_PTRS_CLEAN:
    case MUT_ARR_PTRS_DIRTY:
472 473
    case MUT_ARR_PTRS_FROZEN_CLEAN:
    case MUT_ARR_PTRS_FROZEN_DIRTY:
474
      // follow everything
475
      {
476
          StgMutArrPtrs *a;
477

478 479 480 481 482
          a = (StgMutArrPtrs*)p;
          for (p = (P_)a->payload; p < (P_)&a->payload[a->ptrs]; p++) {
              thread((StgClosure **)p);
          }
          continue;
483 484
      }

485 486
    case SMALL_MUT_ARR_PTRS_CLEAN:
    case SMALL_MUT_ARR_PTRS_DIRTY:
487 488
    case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN:
    case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY:
489
      // follow everything
490
      {
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
491
          StgSmallMutArrPtrs *a = (StgSmallMutArrPtrs*)p;
492 493 494 495 496 497
          for (p = (P_)a->payload; p < (P_)&a->payload[a->ptrs]; p++) {
              thread((StgClosure **)p);
          }
          continue;
      }

498 499 500 501 502 503
    case STACK:
    {
        StgStack *stack = (StgStack*)p;
        thread_stack(stack->sp, stack->stack + stack->stack_size);
        continue;
    }
504 505

    case AP_STACK:
506 507
        thread_AP_STACK((StgAP_STACK *)p);
        continue;
508 509

    case PAP:
510 511
        thread_PAP((StgPAP *)p);
        continue;
512

513 514 515
    case TREC_CHUNK:
    {
        StgTRecChunk *tc = (StgTRecChunk *)p;
516 517
        TRecEntry *e = &(tc -> entries[0]);
        thread_(&tc->prev_chunk);
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
518
        for (W_ i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
519 520 521 522 523
          thread_(&e->tvar);
          thread(&e->expected_value);
          thread(&e->new_value);
        }
        continue;
524 525
    }

526 527 528 529 530 531
    default:
      barf("update_fwd_large: unknown/strange object  %d", (int)(info->type));
    }
  }
}

532
// ToDo: too big to inline
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
533 534
static /* STATIC_INLINE */ P_
thread_obj (const StgInfoTable *info, P_ p)
535 536
{
    switch (info->type) {
537
    case THUNK_0_1:
538
        return p + sizeofW(StgThunk) + 1;
539

540 541
    case FUN_0_1:
    case CONSTR_0_1:
542 543
        return p + sizeofW(StgHeader) + 1;

544 545
    case FUN_1_0:
    case CONSTR_1_0:
546 547 548
        thread(&((StgClosure *)p)->payload[0]);
        return p + sizeofW(StgHeader) + 1;

549
    case THUNK_1_0:
550 551 552
        thread(&((StgThunk *)p)->payload[0]);
        return p + sizeofW(StgThunk) + 1;

553
    case THUNK_0_2:
554
        return p + sizeofW(StgThunk) + 2;
555

556 557
    case FUN_0_2:
    case CONSTR_0_2:
558 559
        return p + sizeofW(StgHeader) + 2;

560
    case THUNK_1_1:
561 562
        thread(&((StgThunk *)p)->payload[0]);
        return p + sizeofW(StgThunk) + 2;
563

564 565
    case FUN_1_1:
    case CONSTR_1_1:
566 567 568
        thread(&((StgClosure *)p)->payload[0]);
        return p + sizeofW(StgHeader) + 2;

569
    case THUNK_2_0:
570 571 572
        thread(&((StgThunk *)p)->payload[0]);
        thread(&((StgThunk *)p)->payload[1]);
        return p + sizeofW(StgThunk) + 2;
573

574 575
    case FUN_2_0:
    case CONSTR_2_0:
576 577 578 579
        thread(&((StgClosure *)p)->payload[0]);
        thread(&((StgClosure *)p)->payload[1]);
        return p + sizeofW(StgHeader) + 2;

580
    case BCO: {
581 582 583 584 585
        StgBCO *bco = (StgBCO *)p;
        thread_(&bco->instrs);
        thread_(&bco->literals);
        thread_(&bco->ptrs);
        return p + bco_sizeW(bco);
586 587
    }

588
    case THUNK:
589
    {
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
590
        P_ end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs;
591 592 593 594
        for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
            thread((StgClosure **)p);
        }
        return p + info->layout.payload.nptrs;
595 596 597
    }

    case FUN:
598
    case CONSTR:
Simon Marlow's avatar
Simon Marlow committed
599
    case CONSTR_NOCAF:
600 601
    case PRIM:
    case MUT_PRIM:
602 603
    case MUT_VAR_CLEAN:
    case MUT_VAR_DIRTY:
604
    case TVAR:
605
    case BLACKHOLE:
606
    case BLOCKING_QUEUE:
607
    {
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
608
        P_ end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
609 610 611 612
        for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
            thread((StgClosure **)p);
        }
        return p + info->layout.payload.nptrs;
613
    }
614

615 616
    case WEAK:
    {
617 618 619 620 621 622 623 624 625
        StgWeak *w = (StgWeak *)p;
        thread(&w->cfinalizers);
        thread(&w->key);
        thread(&w->value);
        thread(&w->finalizer);
        if (w->link != NULL) {
            thread_(&w->link);
        }
        return p + sizeofW(StgWeak);
626
    }
627

628 629
    case MVAR_CLEAN:
    case MVAR_DIRTY:
630 631 632 633 634 635
    {
        StgMVar *mvar = (StgMVar *)p;
        thread_(&mvar->head);
        thread_(&mvar->tail);
        thread(&mvar->value);
        return p + sizeofW(StgMVar);
636
    }
637

638
    case IND:
639 640
        thread(&((StgInd *)p)->indirectee);
        return p + sizeofW(StgInd);
641 642

    case THUNK_SELECTOR:
643 644 645 646
    {
        StgSelector *s = (StgSelector *)p;
        thread(&s->selectee);
        return p + THUNK_SELECTOR_sizeW();
647
    }
648

649
    case AP_STACK:
650 651
        return thread_AP_STACK((StgAP_STACK *)p);

652
    case PAP:
653
        return thread_PAP((StgPAP *)p);
654 655

    case AP:
656 657
        return thread_AP((StgAP *)p);

658
    case ARR_WORDS:
siddhanathan's avatar
siddhanathan committed
659
        return p + arr_words_sizeW((StgArrBytes *)p);
660

661 662
    case MUT_ARR_PTRS_CLEAN:
    case MUT_ARR_PTRS_DIRTY:
663 664
    case MUT_ARR_PTRS_FROZEN_CLEAN:
    case MUT_ARR_PTRS_FROZEN_DIRTY:
665
        // follow everything
666
    {
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
667
        StgMutArrPtrs *a = (StgMutArrPtrs *)p;
668 669 670
        for (p = (P_)a->payload; p < (P_)&a->payload[a->ptrs]; p++) {
            thread((StgClosure **)p);
        }
671

Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
672
        return (P_)a + mut_arr_ptrs_sizeW(a);
673
    }
674 675 676

    case SMALL_MUT_ARR_PTRS_CLEAN:
    case SMALL_MUT_ARR_PTRS_DIRTY:
677 678
    case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN:
    case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY:
679
        // follow everything
680
    {
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
681
        StgSmallMutArrPtrs *a = (StgSmallMutArrPtrs *)p;
682 683 684
        for (p = (P_)a->payload; p < (P_)&a->payload[a->ptrs]; p++) {
            thread((StgClosure **)p);
        }
685

Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
686
        return (P_)a + small_mut_arr_ptrs_sizeW(a);
687
    }
688

689
    case TSO:
690 691
        return thread_TSO((StgTSO *)p);

692 693 694 695 696 697 698
    case STACK:
    {
        StgStack *stack = (StgStack*)p;
        thread_stack(stack->sp, stack->stack + stack->stack_size);
        return p + stack_sizeW(stack);
    }

699 700 701
    case TREC_CHUNK:
    {
        StgTRecChunk *tc = (StgTRecChunk *)p;
702 703
        TRecEntry *e = &(tc -> entries[0]);
        thread_(&tc->prev_chunk);
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
704
        for (W_ i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
705 706 707 708 709
          thread_(&e->tvar);
          thread(&e->expected_value);
          thread(&e->new_value);
        }
        return p + sizeofW(StgTRecChunk);
710 711
    }

712
    default:
713 714
        barf("update_fwd: unknown/strange object  %d", (int)(info->type));
        return NULL;
715 716 717
    }
}

718 719 720
static void
update_fwd( bdescr *blocks )
{
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
721
    bdescr *bd = blocks;
722 723 724

    // cycle through all the blocks in the step
    for (; bd != NULL; bd = bd->link) {
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
725
        P_ p = bd->start;
726 727 728 729

        // linearly scan the objects in this block
        while (p < bd->free) {
            ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
730
            const StgInfoTable *info = get_itbl((StgClosure *)p);
731 732
            p = thread_obj(info, p);
        }
733
    }
734
}
735 736 737 738

static void
update_fwd_compact( bdescr *blocks )
{
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
739 740 741
    bdescr *bd = blocks;
    bdescr *free_bd = blocks;
    P_ free = free_bd->start;
742 743 744

    // cycle through all the blocks in the step
    for (; bd != NULL; bd = bd->link) {
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
745
        P_ p = bd->start;
746

747
        while (p < bd->free ) {
748

749 750 751 752 753 754
            while ( p < bd->free && !is_marked(p,bd) ) {
                p++;
            }
            if (p >= bd->free) {
                break;
            }
755

756 757 758 759 760
            // Problem: we need to know the destination for this cell
            // in order to unthread its info pointer.  But we can't
            // know the destination without the size, because we may
            // spill into the next block.  So we have to run down the
            // threaded list and get the info ptr first.
Simon Marlow's avatar
Simon Marlow committed
761 762 763 764
            //
            // ToDo: one possible avenue of attack is to use the fact
            // that if (p&BLOCK_MASK) >= (free&BLOCK_MASK), then we
            // definitely have enough room.  Also see bug #1147.
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
765 766
            W_ iptr = get_threaded_info(p);
            StgInfoTable *info = INFO_PTR_TO_STRUCT((StgInfoTable *)UNTAG_PTR(iptr));
767

Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
768
            P_ q = p;
769 770 771

            p = thread_obj(info, p);

Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
772
            W_ size = p - q;
773
            if (free + size > free_bd->start + BLOCK_SIZE_W) {
774 775 776 777 778
                // set the next bit in the bitmap to indicate that this object
                // needs to be pushed into the next block.  This saves us having
                // to run down the threaded info pointer list twice during the
                // next pass. See Note [Mark bits in mark-compact collector] in
                // Compact.h.
779 780 781 782 783 784 785
                mark(q+1,bd);
                free_bd = free_bd->link;
                free = free_bd->start;
            } else {
                ASSERT(!is_marked(q+1,bd));
            }

Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
786
            unthread(q,(W_)free + GET_PTR_TAG(iptr));
787 788
            free += size;
        }
789 790 791
    }
}

Simon Marlow's avatar
Simon Marlow committed
792
static W_
Simon Marlow's avatar
Simon Marlow committed
793
update_bkwd_compact( generation *gen )
794 795
{
    bdescr *bd, *free_bd;
Simon Marlow's avatar
Simon Marlow committed
796
    bd = free_bd = gen->old_blocks;
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
797 798 799

    P_ free = free_bd->start;
    W_ free_blocks = 1;
800 801 802

    // cycle through all the blocks in the step
    for (; bd != NULL; bd = bd->link) {
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
803
        P_ p = bd->start;
804

805
        while (p < bd->free ) {
806

807 808 809 810 811 812
            while ( p < bd->free && !is_marked(p,bd) ) {
                p++;
            }
            if (p >= bd->free) {
                break;
            }
813

814 815 816 817 818 819 820
            if (is_marked(p+1,bd)) {
                // don't forget to update the free ptr in the block desc.
                free_bd->free = free;
                free_bd = free_bd->link;
                free = free_bd->start;
                free_blocks++;
            }
821

Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
822 823 824 825 826
            W_ iptr = get_threaded_info(p);
            unthread(p, (W_)free + GET_PTR_TAG(iptr));
            ASSERT(LOOKS_LIKE_INFO_PTR((W_)((StgClosure *)p)->header.info));
            const StgInfoTable *info = get_itbl((StgClosure *)p);
            W_ size = closure_sizeW_((StgClosure *)p,info);
827

828 829 830
            if (free != p) {
                move(free,p,size);
            }
831

832
            // relocate TSOs
833 834
            if (info->type == STACK) {
                move_STACK((StgStack *)p, (StgStack *)free);
835
            }
836

837 838 839
            free += size;
            p += size;
        }
840 841 842 843 844
    }

    // free the remaining blocks and count what's left.
    free_bd->free = free;
    if (free_bd->link != NULL) {
845 846
        freeChain(free_bd->link);
        free_bd->link = NULL;
simonmar's avatar