Evac.c 47.1 KB
Newer Older
1 2
/* -----------------------------------------------------------------------------
 *
3
 * (c) The GHC Team 1998-2008
4 5 6
 *
 * Generational garbage collector: evacuation functions
 *
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
 * ---------------------------------------------------------------------------*/

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

17
#include "Evac.h"
Ben Gamari's avatar
Ben Gamari committed
18
#include "TraceDump.h"
Simon Marlow's avatar
Simon Marlow committed
19
#include "Storage.h"
20
#include "GC.h"
21
#include "GCThread.h"
Simon Marlow's avatar
Simon Marlow committed
22
#include "GCTDecl.h"
23 24
#include "GCUtils.h"
#include "Compact.h"
25
#include "MarkStack.h"
26
#include "Prelude.h"
27
#include "Trace.h"
Simon Marlow's avatar
Simon Marlow committed
28
#include "LdvProfile.h"
gcampax's avatar
gcampax committed
29
#include "CNF.h"
30
#include "Scav.h"
31
#include "NonMoving.h"
32

33 34
#if defined(THREADED_RTS) && !defined(PARALLEL_GC)
#define evacuate(p) evacuate1(p)
35
#define evacuate_BLACKHOLE(p) evacuate_BLACKHOLE1(p)
36
#define HEAP_ALLOCED_GC(p) HEAP_ALLOCED(p)
37 38
#endif

39
#if !defined(PARALLEL_GC) || defined(PROFILING)
40 41 42 43
#define copy_tag_nolock(p, info, src, size, stp, tag) \
        copy_tag(p, info, src, size, stp, tag)
#endif

44 45 46 47 48 49 50 51 52 53 54 55 56
/* Note [Selector optimisation depth limit]
 * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 *
 * MAX_THUNK_SELECTOR_DEPTH is used to avoid long recursion of
 * eval_thunk_selector due to nested selector thunks. Note that this *only*
 * counts nested selector thunks, e.g. `fst (fst (... (fst x)))`. The collector
 * will traverse interleaved selector-constructor pairs without limit, e.g.
 *
 *     a = (fst b, _)
 *     b = (fst c, _)
 *     c = (fst d, _)
 *     d = (x, _)
 *
57
 */
58
#define MAX_THUNK_SELECTOR_DEPTH 16
59

60
static void eval_thunk_selector (StgClosure **q, StgSelector *p, bool);
61 62 63 64 65
STATIC_INLINE void evacuate_large(StgPtr p);

/* -----------------------------------------------------------------------------
   Allocate some space in which to copy an object.
   -------------------------------------------------------------------------- */
66

67
/* size is in words */
Simon Marlow's avatar
Simon Marlow committed
68
STATIC_INLINE StgPtr
69
alloc_for_copy (uint32_t size, uint32_t gen_no)
70
{
71 72
    ASSERT(gen_no < RtsFlags.GcFlags.generations);

Simon Marlow's avatar
Simon Marlow committed
73
    StgPtr to;
Simon Marlow's avatar
Simon Marlow committed
74
    gen_workspace *ws;
Simon Marlow's avatar
Simon Marlow committed
75

76
    /* Find out where we're going, using the handy "to" pointer in
Simon Marlow's avatar
Simon Marlow committed
77
     * the gen of the source object.  If it turns out we need to
Simon Marlow's avatar
Simon Marlow committed
78 79 80
     * evacuate to an older generation, adjust it here (see comment
     * by evacuate()).
     */
Simon Marlow's avatar
Simon Marlow committed
81
    if (gen_no < gct->evac_gen_no) {
82
        if (gct->eager_promotion) {
Simon Marlow's avatar
Simon Marlow committed
83
            gen_no = gct->evac_gen_no;
84
        } else {
Ben Gamari's avatar
Ben Gamari committed
85
            gct->failed_to_evac = true;
86
        }
Simon Marlow's avatar
Simon Marlow committed
87
    }
88

89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115
    if (RtsFlags.GcFlags.useNonmoving) {
        /* See Note [Deadlock detection under nonmoving collector]. */
        if (deadlock_detect_gc)
            gen_no = oldest_gen->no;

        if (gen_no == oldest_gen->no) {
            gct->copied += size;
            to = nonmovingAllocate(gct->cap, size);

            // Add segment to the todo list unless it's already there
            // current->todo_link == NULL means not in todo list
            struct NonmovingSegment *seg = nonmovingGetSegment(to);
            if (!seg->todo_link) {
                gen_workspace *ws = &gct->gens[oldest_gen->no];
                seg->todo_link = ws->todo_seg;
                ws->todo_seg = seg;
            }

            // The object which refers to this closure may have been aged (i.e.
            // retained in a younger generation). Consequently, we must add the
            // closure to the mark queue to ensure that it will be marked.
            //
            // However, if we are in a deadlock detection GC then we disable aging
            // so there is no need.
            if (major_gc && !deadlock_detect_gc)
                markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) to);
            return to;
116
        }
117 118
    }

Simon Marlow's avatar
Simon Marlow committed
119 120
    ws = &gct->gens[gen_no];  // zero memory references here

Simon Marlow's avatar
Simon Marlow committed
121
    /* chain a new block onto the to-space for the destination gen if
Simon Marlow's avatar
Simon Marlow committed
122 123
     * necessary.
     */
124
    to = ws->todo_free;
Simon Marlow's avatar
Simon Marlow committed
125 126
    ws->todo_free += size;
    if (ws->todo_free > ws->todo_lim) {
127
        to = todo_block_full(size, ws);
Simon Marlow's avatar
Simon Marlow committed
128
    }
129
    ASSERT(ws->todo_free >= ws->todo_bd->free && ws->todo_free <= ws->todo_lim);
130

Simon Marlow's avatar
Simon Marlow committed
131 132
    return to;
}
133

134 135 136 137
/* -----------------------------------------------------------------------------
   The evacuate() code
   -------------------------------------------------------------------------- */

138
/* size is in words */
Simon Marlow's avatar
Simon Marlow committed
139
STATIC_INLINE GNUC_ATTR_HOT void
140
copy_tag(StgClosure **p, const StgInfoTable *info,
141
         StgClosure *src, uint32_t size, uint32_t gen_no, StgWord tag)
142 143
{
    StgPtr to, from;
144
    uint32_t i;
145

Simon Marlow's avatar
Simon Marlow committed
146
    to = alloc_for_copy(size,gen_no);
147

148 149 150
    from = (StgPtr)src;
    to[0] = (W_)info;
    for (i = 1; i < size; i++) { // unroll for small i
151
        to[i] = from[i];
152 153 154 155 156 157 158 159 160
    }

//  if (to+size+2 < bd->start + BLOCK_SIZE_W) {
//      __builtin_prefetch(to + size + 2, 1);
//  }

#if defined(PARALLEL_GC)
    {
        const StgInfoTable *new_info;
161
        new_info = (const StgInfoTable *)cas((StgPtr)&src->header.info, (W_)info, MK_FORWARDING_PTR(to));
162
        if (new_info != info) {
Ben Gamari's avatar
Ben Gamari committed
163
#if defined(PROFILING)
164 165 166 167 168 169 170 171 172 173
            // We copied this object at the same time as another
            // thread.  We'll evacuate the object again and the copy
            // we just made will be discarded at the next GC, but we
            // may have copied it after the other thread called
            // SET_EVACUAEE_FOR_LDV(), which would confuse the LDV
            // profiler when it encounters this closure in
            // processHeapClosureForDead.  So we reset the LDVW field
            // here.
            LDVW(to) = 0;
#endif
174
            return evacuate(p); // does the failed_to_evac stuff
175 176 177 178 179 180 181
        } else {
            *p = TAG_CLOSURE(tag,(StgClosure*)to);
        }
    }
#else
    src->header.info = (const StgInfoTable *)MK_FORWARDING_PTR(to);
    *p = TAG_CLOSURE(tag,(StgClosure*)to);
182
#endif  /* defined(PARALLEL_GC) */
183

Ben Gamari's avatar
Ben Gamari committed
184
#if defined(PROFILING)
185 186
    // We store the size of the just evacuated object in the LDV word so that
    // the profiler can guess the position of the next object later.
187 188
    // This is safe only if we are sure that no other thread evacuates
    // the object again, so we cannot use copy_tag_nolock when PROFILING.
189 190 191 192
    SET_EVACUAEE_FOR_LDV(from, size);
#endif
}

193
#if defined(PARALLEL_GC) && !defined(PROFILING)
194
STATIC_INLINE void
195
copy_tag_nolock(StgClosure **p, const StgInfoTable *info,
196
         StgClosure *src, uint32_t size, uint32_t gen_no, StgWord tag)
197 198
{
    StgPtr to, from;
199
    uint32_t i;
200

Simon Marlow's avatar
Simon Marlow committed
201
    to = alloc_for_copy(size,gen_no);
202

203 204 205
    from = (StgPtr)src;
    to[0] = (W_)info;
    for (i = 1; i < size; i++) { // unroll for small i
206
        to[i] = from[i];
207 208
    }

209 210 211
    // if somebody else reads the forwarding pointer, we better make
    // sure there's a closure at the end of it.
    write_barrier();
212
    *p = TAG_CLOSURE(tag,(StgClosure*)to);
213 214
    src->header.info = (const StgInfoTable *)MK_FORWARDING_PTR(to);

215 216 217 218
//  if (to+size+2 < bd->start + BLOCK_SIZE_W) {
//      __builtin_prefetch(to + size + 2, 1);
//  }

Ben Gamari's avatar
Ben Gamari committed
219
#if defined(PROFILING)
220 221 222 223 224
    // We store the size of the just evacuated object in the LDV word so that
    // the profiler can guess the position of the next object later.
    SET_EVACUAEE_FOR_LDV(from, size);
#endif
}
225
#endif
226

227 228
/* Special version of copy() for when we only want to copy the info
 * pointer of an object, but reserve some padding after it.  This is
229
 * used to optimise evacuation of TSOs.
230
 */
Ben Gamari's avatar
Ben Gamari committed
231
static bool
232 233
copyPart(StgClosure **p, StgClosure *src, uint32_t size_to_reserve,
         uint32_t size_to_copy, uint32_t gen_no)
234 235
{
    StgPtr to, from;
236
    uint32_t i;
237
    StgWord info;
238

239 240
#if defined(PARALLEL_GC)
spin:
241 242
        info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info);
        if (info == (W_)&stg_WHITEHOLE_info) {
Ben Gamari's avatar
Ben Gamari committed
243
#if defined(PROF_SPIN)
duog's avatar
duog committed
244
            whitehole_gc_spin++;
245
#endif /* PROF_SPIN */
duog's avatar
duog committed
246
            busy_wait_nop();
247 248
            goto spin;
        }
249
    if (IS_FORWARDING_PTR(info)) {
250 251
        src->header.info = (const StgInfoTable *)info;
        evacuate(p); // does the failed_to_evac stuff
Ben Gamari's avatar
Ben Gamari committed
252
        return false;
253 254 255
    }
#else
    info = (W_)src->header.info;
256
#endif /* PARALLEL_GC */
257

Simon Marlow's avatar
Simon Marlow committed
258
    to = alloc_for_copy(size_to_reserve, gen_no);
259 260

    from = (StgPtr)src;
261
    to[0] = info;
262
    for (i = 1; i < size_to_copy; i++) { // unroll for small i
263
        to[i] = from[i];
264
    }
265

266
    write_barrier();
267
    *p = (StgClosure *)to;
268
    src->header.info = (const StgInfoTable*)MK_FORWARDING_PTR(to);
269

Ben Gamari's avatar
Ben Gamari committed
270
#if defined(PROFILING)
271 272 273 274 275
    // We store the size of the just evacuated object in the LDV word so that
    // the profiler can guess the position of the next object later.
    SET_EVACUAEE_FOR_LDV(from, size_to_reserve);
    // fill the slop
    if (size_to_reserve - size_to_copy > 0)
276
        LDV_FILL_SLOP(to + size_to_copy, (int)(size_to_reserve - size_to_copy));
277
#endif
278

Ben Gamari's avatar
Ben Gamari committed
279
    return true;
280 281 282 283
}


/* Copy wrappers that don't tag the closure after copying */
Simon Marlow's avatar
Simon Marlow committed
284
STATIC_INLINE GNUC_ATTR_HOT void
285
copy(StgClosure **p, const StgInfoTable *info,
286
     StgClosure *src, uint32_t size, uint32_t gen_no)
287
{
Simon Marlow's avatar
Simon Marlow committed
288
    copy_tag(p,info,src,size,gen_no,0);
289 290
}

291 292 293 294
/* -----------------------------------------------------------------------------
   Evacuate a large object

   This just consists of removing the object from the (doubly-linked)
Simon Marlow's avatar
Simon Marlow committed
295
   gen->large_objects list, and linking it on to the (singly-linked)
gcampax's avatar
gcampax committed
296
   gct->todo_large_objects list, from where it will be scavenged later.
297 298 299 300 301 302 303 304

   Convention: bd->flags has BF_EVACUATED set for a large object
   that has been evacuated, or unset otherwise.
   -------------------------------------------------------------------------- */

STATIC_INLINE void
evacuate_large(StgPtr p)
{
305
  bdescr *bd;
Simon Marlow's avatar
Simon Marlow committed
306
  generation *gen, *new_gen;
307
  uint32_t gen_no, new_gen_no;
Simon Marlow's avatar
Simon Marlow committed
308
  gen_workspace *ws;
309

310
  bd = Bdescr(p);
Simon Marlow's avatar
Simon Marlow committed
311
  gen = bd->gen;
Simon Marlow's avatar
Simon Marlow committed
312
  gen_no = bd->gen_no;
Simon Marlow's avatar
Simon Marlow committed
313
  ACQUIRE_SPIN_LOCK(&gen->sync);
314

315 316
  // already evacuated?
  if (bd->flags & BF_EVACUATED) {
317 318 319
    /* Don't forget to set the gct->failed_to_evac flag if we didn't get
     * the desired destination (see comments in evacuate()).
     */
Simon Marlow's avatar
Simon Marlow committed
320
    if (gen_no < gct->evac_gen_no) {
Ben Gamari's avatar
Ben Gamari committed
321
        gct->failed_to_evac = true;
322
        TICK_GC_FAILED_PROMOTION();
323
    }
Simon Marlow's avatar
Simon Marlow committed
324
    RELEASE_SPIN_LOCK(&gen->sync);
325 326 327
    return;
  }

328
  // remove from large_object list
329
  dbl_link_remove(bd, &gen->large_objects);
330

Simon Marlow's avatar
Simon Marlow committed
331
  /* link it on to the evacuated large object list of the destination gen
332
   */
Simon Marlow's avatar
Simon Marlow committed
333 334
  new_gen_no = bd->dest_no;

335 336 337 338
  if (deadlock_detect_gc) {
      /* See Note [Deadlock detection under nonmoving collector]. */
      new_gen_no = oldest_gen->no;
  } else  if (new_gen_no < gct->evac_gen_no) {
339
      if (gct->eager_promotion) {
Simon Marlow's avatar
Simon Marlow committed
340
          new_gen_no = gct->evac_gen_no;
341
      } else {
Ben Gamari's avatar
Ben Gamari committed
342
          gct->failed_to_evac = true;
343 344 345
      }
  }

Simon Marlow's avatar
Simon Marlow committed
346 347
  ws = &gct->gens[new_gen_no];
  new_gen = &generations[new_gen_no];
Simon Marlow's avatar
Simon Marlow committed
348

349
  bd->flags |= BF_EVACUATED;
350 351 352
  if (RtsFlags.GcFlags.useNonmoving && new_gen == oldest_gen) {
      bd->flags |= BF_NONMOVING;
  }
Simon Marlow's avatar
Simon Marlow committed
353
  initBdescr(bd, new_gen, new_gen->to);
Simon Marlow's avatar
Simon Marlow committed
354

gcampax's avatar
gcampax committed
355 356
  // If this is a block of pinned or compact objects, we don't have to scan
  // these objects, because they aren't allowed to contain any outgoing
Simon Marlow's avatar
Simon Marlow committed
357 358 359 360
  // pointers.  For these blocks, we skip the scavenge stage and put
  // them straight on the scavenged_large_objects list.
  if (bd->flags & BF_PINNED) {
      ASSERT(get_itbl((StgClosure *)p)->type == ARR_WORDS);
gcampax's avatar
gcampax committed
361

Simon Marlow's avatar
Simon Marlow committed
362
      if (new_gen != gen) { ACQUIRE_SPIN_LOCK(&new_gen->sync); }
Simon Marlow's avatar
Simon Marlow committed
363 364
      dbl_link_onto(bd, &new_gen->scavenged_large_objects);
      new_gen->n_scavenged_large_blocks += bd->blocks;
Simon Marlow's avatar
Simon Marlow committed
365
      if (new_gen != gen) { RELEASE_SPIN_LOCK(&new_gen->sync); }
Simon Marlow's avatar
Simon Marlow committed
366 367 368 369
  } else {
      bd->link = ws->todo_large_objects;
      ws->todo_large_objects = bd;
  }
370

Simon Marlow's avatar
Simon Marlow committed
371
  RELEASE_SPIN_LOCK(&gen->sync);
372 373
}

374 375 376 377 378 379 380 381 382 383 384 385 386
/* ----------------------------------------------------------------------------
   Evacuate static objects

   When a static object is visited for the first time in this GC, it
   is chained on to the gct->static_objects list.

   evacuate_static_object (link_field, q)
     - link_field must be STATIC_LINK(q)
   ------------------------------------------------------------------------- */

STATIC_INLINE void
evacuate_static_object (StgClosure **link_field, StgClosure *q)
{
387 388
    if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving)) {
        // See Note [Static objects under the nonmoving collector] in Storage.c.
389
        if (major_gc && !deadlock_detect_gc)
390 391 392 393
            markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, q);
        return;
    }

394 395 396
    StgWord link = (StgWord)*link_field;

    // See Note [STATIC_LINK fields] for how the link field bits work
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
397
    if (((link & STATIC_BITS) | prev_static_flag) != 3) {
398
        StgWord new_list_head = (StgWord)q | static_flag;
Ben Gamari's avatar
Ben Gamari committed
399
#if !defined(THREADED_RTS)
400 401 402 403 404 405 406 407 408 409 410 411 412
        *link_field = gct->static_objects;
        gct->static_objects = (StgClosure *)new_list_head;
#else
        StgWord prev;
        prev = cas((StgVolatilePtr)link_field, link,
                   (StgWord)gct->static_objects);
        if (prev == link) {
            gct->static_objects = (StgClosure *)new_list_head;
        }
#endif
    }
}

gcampax's avatar
gcampax committed
413 414 415
/* ----------------------------------------------------------------------------
   Evacuate an object inside a CompactNFData

416 417 418
   These are treated in a similar way to large objects.  We remove the block
   from the compact_objects list of the generation it is on, and link it onto
   the live_compact_objects list of the destination generation.
gcampax's avatar
gcampax committed
419 420 421 422 423 424 425 426 427 428 429 430

   It is assumed that objects in the struct live in the same generation
   as the struct itself all the time.
   ------------------------------------------------------------------------- */
STATIC_INLINE void
evacuate_compact (StgPtr p)
{
    StgCompactNFData *str;
    bdescr *bd;
    generation *gen, *new_gen;
    uint32_t gen_no, new_gen_no;

431 432 433
    // We need to find the Compact# corresponding to this pointer, because it
    // will give us the first block in the compact chain, which is the one we
    // that gets linked onto the compact_objects list.
gcampax's avatar
gcampax committed
434 435 436 437 438 439
    str = objectGetCompact((StgClosure*)p);
    ASSERT(get_itbl((StgClosure*)str)->type == COMPACT_NFDATA);

    bd = Bdescr((StgPtr)str);
    gen_no = bd->gen_no;

440 441 442 443 444 445 446 447 448
    if (bd->flags & BF_NONMOVING) {
        // We may have evacuated the block to the nonmoving generation. If so
        // we need to make sure it is added to the mark queue since the only
        // reference to it may be from the moving heap.
        if (major_gc && !deadlock_detect_gc)
            markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) str);
        return;
    }

gcampax's avatar
gcampax committed
449 450 451 452 453 454
    // already evacuated? (we're about to do the same check,
    // but we avoid taking the spin-lock)
    if (bd->flags & BF_EVACUATED) {
        /* Don't forget to set the gct->failed_to_evac flag if we didn't get
         * the desired destination (see comments in evacuate()).
         */
455
        debugTrace(DEBUG_compact, "Compact %p already evacuated", str);
gcampax's avatar
gcampax committed
456
        if (gen_no < gct->evac_gen_no) {
Ben Gamari's avatar
Ben Gamari committed
457
            gct->failed_to_evac = true;
gcampax's avatar
gcampax committed
458 459 460 461 462 463 464 465 466 467 468 469 470 471 472
            TICK_GC_FAILED_PROMOTION();
        }
        return;
    }

    gen = bd->gen;
    gen_no = bd->gen_no;
    ACQUIRE_SPIN_LOCK(&gen->sync);

    // already evacuated?
    if (bd->flags & BF_EVACUATED) {
        /* Don't forget to set the gct->failed_to_evac flag if we didn't get
         * the desired destination (see comments in evacuate()).
         */
        if (gen_no < gct->evac_gen_no) {
Ben Gamari's avatar
Ben Gamari committed
473
            gct->failed_to_evac = true;
gcampax's avatar
gcampax committed
474 475 476 477 478 479
            TICK_GC_FAILED_PROMOTION();
        }
        RELEASE_SPIN_LOCK(&gen->sync);
        return;
    }

480
    // remove from compact_objects list
481
    dbl_link_remove(bd, &gen->compact_objects);
gcampax's avatar
gcampax committed
482 483 484 485 486 487 488 489 490

    /* link it on to the evacuated compact object list of the destination gen
     */
    new_gen_no = bd->dest_no;

    if (new_gen_no < gct->evac_gen_no) {
        if (gct->eager_promotion) {
            new_gen_no = gct->evac_gen_no;
        } else {
Ben Gamari's avatar
Ben Gamari committed
491
            gct->failed_to_evac = true;
gcampax's avatar
gcampax committed
492 493 494 495 496 497 498 499 500 501 502 503
        }
    }

    new_gen = &generations[new_gen_no];

    // Note: for speed we only update the generation of the first block here
    // This means that bdescr of subsequent blocks will think they are in
    // the wrong generation
    // (This should not be a problem because there is no code that checks
    // for that - the only code touching the generation of the block is
    // in the GC, and that should never see blocks other than the first)
    bd->flags |= BF_EVACUATED;
504 505 506
    if (RtsFlags.GcFlags.useNonmoving && new_gen == oldest_gen) {
        bd->flags |= BF_NONMOVING;
    }
gcampax's avatar
gcampax committed
507 508
    initBdescr(bd, new_gen, new_gen->to);

509
    if (str->hash) {
510 511 512
        // If there is a hash-table for sharing preservation then we need to add
        // the compact to the scavenging work list to ensure that the hashtable
        // is scavenged.
513 514 515 516 517 518 519 520 521
        gen_workspace *ws = &gct->gens[new_gen_no];
        bd->link = ws->todo_large_objects;
        ws->todo_large_objects = bd;
    } else {
        if (new_gen != gen) { ACQUIRE_SPIN_LOCK(&new_gen->sync); }
        dbl_link_onto(bd, &new_gen->live_compact_objects);
        new_gen->n_live_compact_blocks += str->totalW / BLOCK_SIZE_W;
        if (new_gen != gen) { RELEASE_SPIN_LOCK(&new_gen->sync); }
    }
gcampax's avatar
gcampax committed
522 523 524 525 526 527 528 529 530 531 532 533 534

    RELEASE_SPIN_LOCK(&gen->sync);

    // Note: the object did not move in memory, because it lives
    // in pinned (BF_COMPACT) allocation, so we do not need to rewrite it
    // or muck with forwarding pointers
    // Also there is no tag to worry about on the struct (tags are used
    // for constructors and functions, but a struct is neither). There
    // might be a tag on the object pointer, but again we don't change
    // the pointer because we don't move the object so we don't need to
    // rewrite the tag.
}

535 536 537 538 539 540
/* ----------------------------------------------------------------------------
   Evacuate

   This is called (eventually) for every live object in the system.

   The caller to evacuate specifies a desired generation in the
Simon Marlow's avatar
Simon Marlow committed
541
   gct->evac_gen thread-local variable.  The following conditions apply to
542 543 544
   evacuating an object which resides in generation M when we're
   collecting up to generation N

545
   if  M >= gct->evac_gen
546
           if  M > N     do nothing
547
           else          evac to gen->to
548

Simon Marlow's avatar
Simon Marlow committed
549
   if  M < gct->evac_gen      evac to gct->evac_gen, step 0
550 551 552 553

   if the object is already evacuated, then we check which generation
   it now resides in.

Simon Marlow's avatar
Simon Marlow committed
554 555 556
   if  M >= gct->evac_gen     do nothing
   if  M <  gct->evac_gen     set gct->failed_to_evac flag to indicate that we
                         didn't manage to evacuate this object into gct->evac_gen.
557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576


   OPTIMISATION NOTES:

   evacuate() is the single most important function performance-wise
   in the GC.  Various things have been tried to speed it up, but as
   far as I can tell the code generated by gcc 3.2 with -O2 is about
   as good as it's going to get.  We pass the argument to evacuate()
   in a register using the 'regparm' attribute (see the prototype for
   evacuate() near the top of this file).

   Changing evacuate() to take an (StgClosure **) rather than
   returning the new pointer seems attractive, because we can avoid
   writing back the pointer when it hasn't changed (eg. for a static
   object, or an object in a generation > N).  However, I tried it and
   it doesn't help.  One reason is that the (StgClosure **) pointer
   gets spilled to the stack inside evacuate(), resulting in far more
   extra reads/writes than we save.
   ------------------------------------------------------------------------- */

577
REGPARM1 GNUC_ATTR_HOT void
578 579 580
evacuate(StgClosure **p)
{
  bdescr *bd = NULL;
581
  uint32_t gen_no;
582 583 584 585 586 587 588 589 590 591
  StgClosure *q;
  const StgInfoTable *info;
  StgWord tag;

  q = *p;

loop:
  /* The tag and the pointer are split, to be merged after evacing */
  tag = GET_CLOSURE_TAG(q);
  q = UNTAG_CLOSURE(q);
Ben Gamari's avatar
Ben Gamari committed
592
  trace_dump_edge(q);
593

594
  ASSERTM(LOOKS_LIKE_CLOSURE_PTR(q), "invalid closure, info=%p", q->header.info);
595

596
  if (!HEAP_ALLOCED_GC(q)) {
597 598 599 600 601 602
      if (!major_gc) return;

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

      case THUNK_STATIC:
603
          if (info->srt != 0) {
604
              evacuate_static_object(THUNK_STATIC_LINK((StgClosure *)q), q);
605 606
          }
          return;
607 608

      case FUN_STATIC:
609 610
          if (info->srt != 0 || info->layout.payload.ptrs != 0) {
              evacuate_static_object(STATIC_LINK(info,(StgClosure *)q), q);
611 612 613
          }
          return;

614
      case IND_STATIC:
615 616 617 618
          /* If q->saved_info != NULL, then it's a revertible CAF - it'll be
           * on the CAF list, so don't do anything with it here (we'll
           * scavenge it later).
           */
619
          evacuate_static_object(IND_STATIC_LINK((StgClosure *)q), q);
620 621
          return;

Simon Marlow's avatar
Simon Marlow committed
622 623 624 625
      case CONSTR:
      case CONSTR_1_0:
      case CONSTR_2_0:
      case CONSTR_1_1:
626
          evacuate_static_object(STATIC_LINK(info,(StgClosure *)q), q);
627
          return;
628

Simon Marlow's avatar
Simon Marlow committed
629 630 631
      case CONSTR_0_1:
      case CONSTR_0_2:
      case CONSTR_NOCAF:
632 633 634 635 636
          /* no need to put these on the static linked list, they don't need
           * to be scavenged.
           */
          return;

637
      default:
638
          barf("evacuate(static): strange closure type %d", (int)(info->type));
639 640 641 642 643
      }
  }

  bd = Bdescr((P_)q);

644 645 646 647 648 649 650
  if ((bd->flags & (BF_LARGE | BF_MARKED | BF_EVACUATED | BF_COMPACT | BF_NONMOVING)) != 0) {
      // Pointer to non-moving heap. Non-moving heap is collected using
      // mark-sweep so this object should be marked and then retained in sweep.
      if (bd->flags & BF_NONMOVING) {
          // NOTE: large objects in nonmoving heap are also marked with
          // BF_NONMOVING. Those are moved to scavenged_large_objects list in
          // mark phase.
651
          if (major_gc && !deadlock_detect_gc)
652
              markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, q);
653 654 655
          return;
      }

656 657 658 659 660 661 662 663 664 665
      // pointer into to-space: just return it.  It might be a pointer
      // into a generation that we aren't collecting (> N), or it
      // might just be a pointer into to-space.  The latter doesn't
      // happen often, but allowing it makes certain things a bit
      // easier; e.g. scavenging an object is idempotent, so it's OK to
      // have an object on the mutable list multiple times.
      if (bd->flags & BF_EVACUATED) {
          // We aren't copying this object, so we have to check
          // whether it is already in the target generation.  (this is
          // the write barrier).
Simon Marlow's avatar
Simon Marlow committed
666
          if (bd->gen_no < gct->evac_gen_no) {
Ben Gamari's avatar
Ben Gamari committed
667
              gct->failed_to_evac = true;
668 669 670
              TICK_GC_FAILED_PROMOTION();
          }
          return;
671 672
      }

gcampax's avatar
gcampax committed
673 674 675 676 677 678 679 680 681
      // Check for compact before checking for large, this allows doing the
      // right thing for objects that are half way in the middle of the first
      // block of a compact (and would be treated as large objects even though
      // they are not)
      if (bd->flags & BF_COMPACT) {
          evacuate_compact((P_)q);
          return;
      }

682 683 684
      /* evacuate large objects by re-linking them onto a different list.
       */
      if (bd->flags & BF_LARGE) {
685
          evacuate_large((P_)q);
686 687 688 689

          // We may have evacuated the block to the nonmoving generation. If so
          // we need to make sure it is added to the mark queue since the only
          // reference to it may be from the moving heap.
690
          if (major_gc && bd->flags & BF_NONMOVING && !deadlock_detect_gc) {
691 692
              markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, q);
          }
693
          return;
694
      }
695

Simon Marlow's avatar
Simon Marlow committed
696
      /* If the object is in a gen that we're compacting, then we
697 698
       * need to use an alternative evacuate procedure.
       */
699 700 701
      if (!is_marked((P_)q,bd)) {
          mark((P_)q,bd);
          push_mark_stack((P_)q);
702
      }
703
      return;
704
  }
705

Simon Marlow's avatar
Simon Marlow committed
706
  gen_no = bd->dest_no;
707 708 709 710 711

  info = q->header.info;
  if (IS_FORWARDING_PTR(info))
  {
    /* Already evacuated, just return the forwarding address.
Simon Marlow's avatar
Simon Marlow committed
712
     * HOWEVER: if the requested destination generation (gct->evac_gen) is
713 714
     * older than the actual generation (because the object was
     * already evacuated to a younger generation) then we have to
715
     * set the gct->failed_to_evac flag to indicate that we couldn't
716 717
     * manage to promote the object to the desired generation.
     */
718
    /*
719 720 721 722
     * Optimisation: the check is fairly expensive, but we can often
     * shortcut it if either the required generation is 0, or the
     * current object (the EVACUATED) is in a high enough generation.
     * We know that an EVACUATED always points to an object in the
Simon Marlow's avatar
Simon Marlow committed
723
     * same or an older generation.  gen is the lowest generation that the
724
     * current object would be evacuated to, so we only do the full
Simon Marlow's avatar
Simon Marlow committed
725
     * check if gen is too low.
726 727 728
     */
      StgClosure *e = (StgClosure*)UN_FORWARDING_PTR(info);
      *p = TAG_CLOSURE(tag,e);
Simon Marlow's avatar
Simon Marlow committed
729 730
      if (gen_no < gct->evac_gen_no) {  // optimisation
          if (Bdescr((P_)e)->gen_no < gct->evac_gen_no) {
Ben Gamari's avatar
Ben Gamari committed
731
              gct->failed_to_evac = true;
732 733
              TICK_GC_FAILED_PROMOTION();
          }
734 735 736 737 738 739 740 741 742
      }
      return;
  }

  switch (INFO_PTR_TO_STRUCT(info)->type) {

  case WHITEHOLE:
      goto loop;

743
  // For ints and chars of low value, save space by replacing references to
744
  //    these with closures with references to common, shared ones in the RTS.
745 746
  //
  // * Except when compiling into Windows DLLs which don't support cross-package
747
  //    data references very well.
748
  //
749
  case CONSTR_0_1:
750
  {
751
#if defined(COMPILING_WINDOWS_DLL)
Simon Marlow's avatar
Simon Marlow committed
752
      copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,gen_no,tag);
753
#else
754 755
      StgWord w = (StgWord)q->payload[0];
      if (info == Czh_con_info &&
756 757 758
          // unsigned, so always true:  (StgChar)w >= MIN_CHARLIKE &&
          (StgChar)w <= MAX_CHARLIKE) {
          *p =  TAG_CLOSURE(tag,
759
                            (StgClosure *)CHARLIKE_CLOSURE((StgChar)w)
760
                           );
761 762
      }
      else if (info == Izh_con_info &&
763 764 765 766
          (StgInt)w >= MIN_INTLIKE && (StgInt)w <= MAX_INTLIKE) {
          *p = TAG_CLOSURE(tag,
                             (StgClosure *)INTLIKE_CLOSURE((StgInt)w)
                             );
767 768
      }
      else {
Simon Marlow's avatar
Simon Marlow committed
769
          copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,gen_no,tag);
770
      }
771
#endif
772 773 774 775 776 777
      return;
  }

  case FUN_0_1:
  case FUN_1_0:
  case CONSTR_1_0:
Simon Marlow's avatar
Simon Marlow committed
778
      copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,gen_no,tag);
779 780 781 782
      return;

  case THUNK_1_0:
  case THUNK_0_1:
Simon Marlow's avatar
Simon Marlow committed
783
      copy(p,info,q,sizeofW(StgThunk)+1,gen_no);
784 785 786 787 788
      return;

  case THUNK_1_1:
  case THUNK_2_0:
  case THUNK_0_2:
Simon Marlow's avatar
Simon Marlow committed
789
    copy(p,info,q,sizeofW(StgThunk)+2,gen_no);
790 791 792 793 794 795 796
    return;

  case FUN_1_1:
  case FUN_2_0:
  case FUN_0_2:
  case CONSTR_1_1:
  case CONSTR_2_0:
Simon Marlow's avatar
Simon Marlow committed
797
      copy_tag_nolock(p,info,q,sizeofW(StgHeader)+2,gen_no,tag);
798 799 800
      return;

  case CONSTR_0_2:
Simon Marlow's avatar
Simon Marlow committed
801
      copy_tag_nolock(p,info,q,sizeofW(StgHeader)+2,gen_no,tag);
802 803 804
      return;

  case THUNK:
Simon Marlow's avatar
Simon Marlow committed
805
      copy(p,info,q,thunk_sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),gen_no);
806 807 808 809
      return;

  case FUN:
  case CONSTR:
Simon Marlow's avatar
Simon Marlow committed
810
  case CONSTR_NOCAF:
Simon Marlow's avatar
Simon Marlow committed
811
      copy_tag_nolock(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),gen_no,tag);
812 813
      return;

814 815 816 817 818
  case BLACKHOLE:
  {
      StgClosure *r;
      const StgInfoTable *i;
      r = ((StgInd*)q)->indirectee;
819 820 821
      // XXX: disable shortcutting
      copy(p,info,q,sizeofW(StgInd),gen_no);
      return;
822 823 824 825 826 827 828
      if (GET_CLOSURE_TAG(r) == 0) {
          i = r->header.info;
          if (IS_FORWARDING_PTR(i)) {
              r = (StgClosure *)UN_FORWARDING_PTR(i);
              i = r->header.info;
          }
          if (i == &stg_TSO_info
829
              || i == &stg_WHITEHOLE_info
830 831
              || i == &stg_BLOCKING_QUEUE_CLEAN_info
              || i == &stg_BLOCKING_QUEUE_DIRTY_info) {
Simon Marlow's avatar
Simon Marlow committed
832
              copy(p,info,q,sizeofW(StgInd),gen_no);
833 834
              return;
          }
835 836 837 838 839 840 841 842 843 844 845 846 847
          // Note [BLACKHOLE pointing to IND]
          //
          // BLOCKING_QUEUE can be overwritten by IND (see
          // wakeBlockingQueue()). However, when this happens we must
          // be updating the BLACKHOLE, so the BLACKHOLE's indirectee
          // should now point to the value.
          //
          // The mutator might observe an inconsistent state, because
          // the writes are happening in another thread, so it's
          // possible for the mutator to follow an indirectee and find
          // an IND. But this should never happen in the GC, because
          // the mutators are all stopped and the writes have
          // completed.
848 849 850 851 852 853 854
          ASSERT(i != &stg_IND_info);
      }
      q = r;
      *p = r;
      goto loop;
  }

855 856 857 858 859
  case MUT_VAR_CLEAN:
  case MUT_VAR_DIRTY:
  case MVAR_CLEAN:
  case MVAR_DIRTY:
  case TVAR:
860
  case BLOCKING_QUEUE:
861
  case WEAK:
862 863
  case PRIM:
  case MUT_PRIM:
Simon Marlow's avatar
Simon Marlow committed
864
      copy(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),gen_no);
865 866 867
      return;

  case BCO:
Simon Marlow's avatar
Simon Marlow committed
868
      copy(p,info,q,bco_sizeW((StgBCO *)q),gen_no);
869 870 871
      return;

  case THUNK_SELECTOR:
Ben Gamari's avatar
Ben Gamari committed
872
      eval_thunk_selector(p, (StgSelector *)q, true);
873 874 875
      return;

  case IND:
876 877
    // XXX: disable shortcutting
    copy(p,info,q,sizeofW(StgInd),gen_no);
878
    // follow chains of indirections, don't evacuate them
879 880 881 882 883 884 885 886
    q = ((StgInd*)q)->indirectee;
    *p = q;
    goto loop;

  case RET_BCO:
  case RET_SMALL:
  case RET_BIG:
  case UPDATE_FRAME:
887
  case UNDERFLOW_FRAME:
888 889 890 891 892
  case STOP_FRAME:
  case CATCH_FRAME:
  case CATCH_STM_FRAME:
  case CATCH_RETRY_FRAME:
  case ATOMICALLY_FRAME:
893
    // shouldn't see these
894 895 896
    barf("evacuate: stack frame at %p\n", q);

  case PAP:
Simon Marlow's avatar
Simon Marlow committed
897
      copy(p,info,q,pap_sizeW((StgPAP*)q),gen_no);
898 899 900
      return;

  case AP:
Simon Marlow's avatar
Simon Marlow committed
901
      copy(p,info,q,ap_sizeW((StgAP*)q),gen_no);
902 903 904
      return;

  case AP_STACK:
Simon Marlow's avatar
Simon Marlow committed
905
      copy(p,info,q,ap_stack_sizeW((StgAP_STACK*)q),gen_no);
906 907 908
      return;

  case ARR_WORDS:
909
      // just copy the block
siddhanathan's avatar
siddhanathan committed
910
      copy(p,info,q,arr_words_sizeW((StgArrBytes *)q),gen_no);
911 912 913 914
      return;

  case MUT_ARR_PTRS_CLEAN:
  case MUT_ARR_PTRS_DIRTY:
915 916
  case MUT_ARR_PTRS_FROZEN_CLEAN:
  case MUT_ARR_PTRS_FROZEN_DIRTY:
917
      // just copy the block
Simon Marlow's avatar
Simon Marlow committed
918
      copy(p,info,q,mut_arr_ptrs_sizeW((StgMutArrPtrs *)q),gen_no);
919 920 921 922
      return;

  case SMALL_MUT_ARR_PTRS_CLEAN:
  case SMALL_MUT_ARR_PTRS_DIRTY:
923 924
  case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN:
  case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY:
925
      // just copy the block
926
      copy(p,info,q,small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs *)q),gen_no);
927 928 929
      return;

  case TSO:
Simon Marlow's avatar
Simon Marlow committed
930
      copy(p,info,q,sizeofW(StgTSO),gen_no);
931
      return;
932

933 934 935
  case STACK:
    {
      StgStack *stack = (StgStack *)q;
936

937
      /* To evacuate a small STACK, we need to adjust the stack pointer
938 939
       */
      {
940
          StgStack *new_stack;
941
          StgPtr r, s;
Ben Gamari's avatar
Ben Gamari committed
942
          bool mine;
943

944
          mine = copyPart(p,(StgClosure *)stack, stack_sizeW(stack),
Simon Marlow's avatar
Simon Marlow committed
945
                          sizeofW(StgStack), gen_no);
946
          if (mine) {
947 948 949 950
              new_stack = (StgStack *)*p;
              move_STACK(stack, new_stack);
              for (r = stack->sp, s = new_stack->sp;
                   r < stack->stack + stack->stack_size;) {
951 952 953
                  *s++ = *r++;
              }
          }
954
          return;
955 956 957 958
      }
    }

  case TREC_CHUNK: