Evac.c 47 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"
Simon Marlow's avatar
Simon Marlow committed
18
#include "Storage.h"
19
#include "GC.h"
20
#include "GCThread.h"
Simon Marlow's avatar
Simon Marlow committed
21
#include "GCTDecl.h"
22 23
#include "GCUtils.h"
#include "Compact.h"
24
#include "MarkStack.h"
25
#include "Prelude.h"
26
#include "Trace.h"
Simon Marlow's avatar
Simon Marlow committed
27
#include "LdvProfile.h"
gcampax's avatar
gcampax committed
28
#include "CNF.h"
29
#include "Scav.h"
30
#include "NonMoving.h"
31

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

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

43 44 45 46 47 48 49 50 51 52 53 54 55
/* 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, _)
 *
56
 */
57
#define MAX_THUNK_SELECTOR_DEPTH 16
58

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

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

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

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

75
    /* Find out where we're going, using the handy "to" pointer in
76
     * the gen of the source object.  If it turns out we need to
Simon Marlow's avatar
Simon Marlow committed
77 78 79
     * evacuate to an older generation, adjust it here (see comment
     * by evacuate()).
     */
Simon Marlow's avatar
Simon Marlow committed
80
    if (gen_no < gct->evac_gen_no) {
81
        if (gct->eager_promotion) {
Simon Marlow's avatar
Simon Marlow committed
82
            gen_no = gct->evac_gen_no;
83 84 85
        } else if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving) && deadlock_detect_gc) {
            /* See Note [Deadlock detection under nonmoving collector]. */
            gen_no = oldest_gen->no;
86
        } else {
Ben Gamari's avatar
Ben Gamari committed
87
            gct->failed_to_evac = true;
88
        }
Simon Marlow's avatar
Simon Marlow committed
89
    }
90

91
    if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving)) {
92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113
        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;
114
        }
115 116
    }

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

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

Simon Marlow's avatar
Simon Marlow committed
129 130
    return to;
}
131

132 133 134 135
/* -----------------------------------------------------------------------------
   The evacuate() code
   -------------------------------------------------------------------------- */

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

Simon Marlow's avatar
Simon Marlow committed
144
    to = alloc_for_copy(size,gen_no);
145

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

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

#if defined(PARALLEL_GC)
    {
        const StgInfoTable *new_info;
159
        new_info = (const StgInfoTable *)cas((StgPtr)&src->header.info, (W_)info, MK_FORWARDING_PTR(to));
160
        if (new_info != info) {
Ben Gamari's avatar
Ben Gamari committed
161
#if defined(PROFILING)
162 163 164 165 166 167 168 169 170 171
            // 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
172
            return evacuate(p); // does the failed_to_evac stuff
173 174 175 176 177 178 179
        } else {
            *p = TAG_CLOSURE(tag,(StgClosure*)to);
        }
    }
#else
    src->header.info = (const StgInfoTable *)MK_FORWARDING_PTR(to);
    *p = TAG_CLOSURE(tag,(StgClosure*)to);
180
#endif  /* defined(PARALLEL_GC) */
181

Ben Gamari's avatar
Ben Gamari committed
182
#if defined(PROFILING)
183 184
    // 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.
185 186
    // 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.
187 188 189 190
    SET_EVACUAEE_FOR_LDV(from, size);
#endif
}

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

Simon Marlow's avatar
Simon Marlow committed
199
    to = alloc_for_copy(size,gen_no);
200

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

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

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

Ben Gamari's avatar
Ben Gamari committed
217
#if defined(PROFILING)
218 219 220 221 222
    // 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
}
223
#endif
224

225 226
/* 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
227
 * used to optimise evacuation of TSOs.
228
 */
Ben Gamari's avatar
Ben Gamari committed
229
static bool
230 231
copyPart(StgClosure **p, StgClosure *src, uint32_t size_to_reserve,
         uint32_t size_to_copy, uint32_t gen_no)
232 233
{
    StgPtr to, from;
234
    uint32_t i;
235
    StgWord info;
236

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

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

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

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

Ben Gamari's avatar
Ben Gamari committed
268
#if defined(PROFILING)
269 270 271 272 273
    // 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)
274
        LDV_FILL_SLOP(to + size_to_copy, (int)(size_to_reserve - size_to_copy));
275
#endif
276

Ben Gamari's avatar
Ben Gamari committed
277
    return true;
278 279 280 281
}


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

289 290 291 292
/* -----------------------------------------------------------------------------
   Evacuate a large object

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

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

300
static void
301 302
evacuate_large(StgPtr p)
{
303
  bdescr *bd;
304
  generation *gen, *new_gen;
305
  uint32_t gen_no, new_gen_no;
306
  gen_workspace *ws;
307

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

313 314
  // already evacuated?
  if (bd->flags & BF_EVACUATED) {
315 316 317
    /* 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
318
    if (gen_no < gct->evac_gen_no) {
Ben Gamari's avatar
Ben Gamari committed
319
        gct->failed_to_evac = true;
320
        TICK_GC_FAILED_PROMOTION();
321
    }
Simon Marlow's avatar
Simon Marlow committed
322
    RELEASE_SPIN_LOCK(&gen->sync);
323 324 325
    return;
  }

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

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

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

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

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

gcampax's avatar
gcampax committed
353 354
  // 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
355 356 357 358
  // 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
359

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

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

372 373 374 375 376 377 378 379 380 381 382 383 384
/* ----------------------------------------------------------------------------
   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)
{
385 386
    if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving)) {
        // See Note [Static objects under the nonmoving collector] in Storage.c.
387
        if (major_gc && !deadlock_detect_gc)
388 389 390 391
            markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, q);
        return;
    }

392 393 394
    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
395
    if (((link & STATIC_BITS) | prev_static_flag) != 3) {
396
        StgWord new_list_head = (StgWord)q | static_flag;
Ben Gamari's avatar
Ben Gamari committed
397
#if !defined(THREADED_RTS)
398 399 400 401 402 403 404 405 406 407 408 409 410
        *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
411 412 413
/* ----------------------------------------------------------------------------
   Evacuate an object inside a CompactNFData

414 415 416
   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
417 418 419 420 421 422 423 424 425 426 427 428

   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;

429 430 431
    // 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
432 433 434 435 436 437
    str = objectGetCompact((StgClosure*)p);
    ASSERT(get_itbl((StgClosure*)str)->type == COMPACT_NFDATA);

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

438 439 440 441 442 443 444 445 446
    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
447 448 449 450 451 452
    // 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()).
         */
453
        debugTrace(DEBUG_compact, "Compact %p already evacuated", str);
gcampax's avatar
gcampax committed
454
        if (gen_no < gct->evac_gen_no) {
Ben Gamari's avatar
Ben Gamari committed
455
            gct->failed_to_evac = true;
gcampax's avatar
gcampax committed
456 457 458 459 460 461 462 463 464 465 466 467 468 469 470
            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
471
            gct->failed_to_evac = true;
gcampax's avatar
gcampax committed
472 473 474 475 476 477
            TICK_GC_FAILED_PROMOTION();
        }
        RELEASE_SPIN_LOCK(&gen->sync);
        return;
    }

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

    /* 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
489
            gct->failed_to_evac = true;
gcampax's avatar
gcampax committed
490 491 492 493 494 495 496 497 498 499 500 501
        }
    }

    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;
502
    if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving && new_gen == oldest_gen)) {
503 504
        bd->flags |= BF_NONMOVING;
    }
gcampax's avatar
gcampax committed
505 506
    initBdescr(bd, new_gen, new_gen->to);

507
    if (str->hash) {
508 509 510
        // 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.
511 512 513 514 515 516 517 518 519
        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
520 521 522 523 524 525 526 527 528 529 530 531 532

    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.
}

533 534 535 536 537 538
/* ----------------------------------------------------------------------------
   Evacuate

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

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

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

547
   if  M < gct->evac_gen      evac to gct->evac_gen, step 0
548 549 550 551

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

552 553 554
   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.
555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574


   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.
   ------------------------------------------------------------------------- */

575
REGPARM1 GNUC_ATTR_HOT void
576 577 578
evacuate(StgClosure **p)
{
  bdescr *bd = NULL;
579
  uint32_t gen_no;
580 581 582 583 584 585 586 587 588 589 590
  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);

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

593
  if (!HEAP_ALLOCED_GC(q)) {
594 595 596 597 598 599
      if (!major_gc) return;

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

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

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

611
      case IND_STATIC:
612 613 614 615
          /* 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).
           */
616
          evacuate_static_object(IND_STATIC_LINK((StgClosure *)q), q);
617 618
          return;

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

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

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

  bd = Bdescr((P_)q);

641 642 643
  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.
644
      if (RTS_UNLIKELY(bd->flags & BF_NONMOVING)) {
645 646 647
          // NOTE: large objects in nonmoving heap are also marked with
          // BF_NONMOVING. Those are moved to scavenged_large_objects list in
          // mark phase.
648
          if (major_gc && !deadlock_detect_gc)
649
              markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, q);
650 651 652
          return;
      }

653 654 655 656 657 658 659 660 661 662
      // 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
663
          if (bd->gen_no < gct->evac_gen_no) {
Ben Gamari's avatar
Ben Gamari committed
664
              gct->failed_to_evac = true;
665 666 667
              TICK_GC_FAILED_PROMOTION();
          }
          return;
668 669
      }

gcampax's avatar
gcampax committed
670 671 672 673 674 675 676 677 678
      // 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;
      }

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

          // 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.
687
          if (major_gc && bd->flags & BF_NONMOVING && !deadlock_detect_gc) {
688 689
              markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, q);
          }
690
          return;
691
      }
692

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

Simon Marlow's avatar
Simon Marlow committed
703
  gen_no = bd->dest_no;
704 705 706 707 708

  info = q->header.info;
  if (IS_FORWARDING_PTR(info))
  {
    /* Already evacuated, just return the forwarding address.
709
     * HOWEVER: if the requested destination generation (gct->evac_gen) is
710 711
     * older than the actual generation (because the object was
     * already evacuated to a younger generation) then we have to
712
     * set the gct->failed_to_evac flag to indicate that we couldn't
713 714
     * manage to promote the object to the desired generation.
     */
715
    /*
716 717 718 719
     * 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
720
     * same or an older generation.  gen is the lowest generation that the
721
     * current object would be evacuated to, so we only do the full
722
     * check if gen is too low.
723 724 725
     */
      StgClosure *e = (StgClosure*)UN_FORWARDING_PTR(info);
      *p = TAG_CLOSURE(tag,e);
Simon Marlow's avatar
Simon Marlow committed
726 727
      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
728
              gct->failed_to_evac = true;
729 730
              TICK_GC_FAILED_PROMOTION();
          }
731 732 733 734 735 736 737 738 739
      }
      return;
  }

  switch (INFO_PTR_TO_STRUCT(info)->type) {

  case WHITEHOLE:
      goto loop;

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

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

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

  case THUNK_1_1:
  case THUNK_2_0:
  case THUNK_0_2:
Simon Marlow's avatar
Simon Marlow committed
786
    copy(p,info,q,sizeofW(StgThunk)+2,gen_no);
787 788 789 790 791 792 793
    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
794
      copy_tag_nolock(p,info,q,sizeofW(StgHeader)+2,gen_no,tag);
795 796 797
      return;

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

  case THUNK:
Simon Marlow's avatar
Simon Marlow committed
802
      copy(p,info,q,thunk_sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),gen_no);
803 804 805 806
      return;

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

811 812 813 814 815 816 817 818 819 820 821 822
  case BLACKHOLE:
  {
      StgClosure *r;
      const StgInfoTable *i;
      r = ((StgInd*)q)->indirectee;
      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
823
              || i == &stg_WHITEHOLE_info
824 825
              || i == &stg_BLOCKING_QUEUE_CLEAN_info
              || i == &stg_BLOCKING_QUEUE_DIRTY_info) {
Simon Marlow's avatar
Simon Marlow committed
826
              copy(p,info,q,sizeofW(StgInd),gen_no);
827 828
              return;
          }
829 830 831 832 833 834 835 836 837 838 839 840 841
          // 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.
842 843 844 845 846 847 848
          ASSERT(i != &stg_IND_info);
      }
      q = r;
      *p = r;
      goto loop;
  }

849 850 851 852 853
  case MUT_VAR_CLEAN:
  case MUT_VAR_DIRTY:
  case MVAR_CLEAN:
  case MVAR_DIRTY:
  case TVAR:
854
  case BLOCKING_QUEUE:
855
  case WEAK:
856 857
  case PRIM:
  case MUT_PRIM:
Simon Marlow's avatar
Simon Marlow committed
858
      copy(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),gen_no);
859 860 861
      return;

  case BCO:
Simon Marlow's avatar
Simon Marlow committed
862
      copy(p,info,q,bco_sizeW((StgBCO *)q),gen_no);
863 864 865
      return;

  case THUNK_SELECTOR:
Ben Gamari's avatar
Ben Gamari committed
866
      eval_thunk_selector(p, (StgSelector *)q, true);
867 868 869
      return;

  case IND:
870
    // follow chains of indirections, don't evacuate them
871 872 873 874 875 876 877 878
    q = ((StgInd*)q)->indirectee;
    *p = q;
    goto loop;

  case RET_BCO:
  case RET_SMALL:
  case RET_BIG:
  case UPDATE_FRAME:
879
  case UNDERFLOW_FRAME:
880 881 882 883 884
  case STOP_FRAME:
  case CATCH_FRAME:
  case CATCH_STM_FRAME:
  case CATCH_RETRY_FRAME:
  case ATOMICALLY_FRAME:
885
    // shouldn't see these
886 887 888
    barf("evacuate: stack frame at %p\n", q);

  case PAP:
Simon Marlow's avatar
Simon Marlow committed
889
      copy(p,info,q,pap_sizeW((StgPAP*)q),gen_no);
890 891 892
      return;

  case AP:
Simon Marlow's avatar
Simon Marlow committed
893
      copy(p,info,q,ap_sizeW((StgAP*)q),gen_no);
894 895 896
      return;

  case AP_STACK:
Simon Marlow's avatar
Simon Marlow committed
897
      copy(p,info,q,ap_stack_sizeW((StgAP_STACK*)q),gen_no);
898 899 900
      return;

  case ARR_WORDS:
901
      // just copy the block
siddhanathan's avatar
siddhanathan committed
902
      copy(p,info,q,arr_words_sizeW((StgArrBytes *)q),gen_no);
903 904 905 906
      return;

  case MUT_ARR_PTRS_CLEAN:
  case MUT_ARR_PTRS_DIRTY:
907 908
  case MUT_ARR_PTRS_FROZEN_CLEAN:
  case MUT_ARR_PTRS_FROZEN_DIRTY:
909
      // just copy the block
Simon Marlow's avatar
Simon Marlow committed
910
      copy(p,info,q,mut_arr_ptrs_sizeW((StgMutArrPtrs *)q),gen_no);
911 912 913 914
      return;

  case SMALL_MUT_ARR_PTRS_CLEAN:
  case SMALL_MUT_ARR_PTRS_DIRTY:
915 916
  case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN:
  case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY:
917
      // just copy the block
918
      copy(p,info,q,small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs *)q),gen_no);
919 920 921
      return;

  case TSO:
Simon Marlow's avatar
Simon Marlow committed
922
      copy(p,info,q,sizeofW(StgTSO),gen_no);
923
      return;
924

925 926 927
  case STACK:
    {
      StgStack *stack = (StgStack *)q;
928

929
      /* To evacuate a small STACK, we need to adjust the stack pointer
930 931
       */
      {
932
          StgStack *new_stack;
933
          StgPtr r, s;
Ben Gamari's avatar
Ben Gamari committed
934
          bool mine;
935

936
          mine = copyPart(p,(StgClosure *)stack, stack_sizeW(stack),
Simon Marlow's avatar
Simon Marlow committed
937
                          sizeofW(StgStack), gen_no);
938
          if (mine) {
939 940 941 942
              new_stack = (StgStack *)*p;
              move_STACK(stack, new_stack);
              for (r = stack->sp, s = new_stack->sp;
                   r < stack->stack + stack->stack_size;) {
943 944 945
                  *s++ = *r++;
              }
          }
946
          return;
947 948 949 950
      }
    }

  case TREC_CHUNK:
Simon Marlow's avatar
Simon Marlow committed
951
      copy(p,info,q,sizeofW(StgTRecChunk),gen_no);
952 953 954 955 956 957 958 959 960
      return;

  default:
    barf("evacuate: strange closure type %d", (int)(INFO_PTR_TO_STRUCT(info)->type));
  }

  barf("evacuate");
}

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
/* -----------------------------------------------------------------------------
   Evacuate a pointer that is guaranteed to point to a BLACKHOLE.

   This is used for evacuating the updatee of an update frame on the stack.  We
   want to copy the blackhole even if it has been updated by another thread and
   is now an indirection, because the original update frame still needs to
   update it.

   See also Note [upd-black-hole] in sm/Scav.c.
   -------------------------------------------------------------------------- */

void
evacuate_BLACKHOLE(StgClosure **p)
{
    bdescr *bd;
    uint32_t gen_no;
    StgClosure *q;
    const StgInfoTable *info;
    q = *p;

    // closure is required to be a heap-allocated BLACKHOLE
    ASSERT(HEAP_ALLOCED_GC(q));
    ASSERT(GET_CLOSURE_TAG(q) == 0);

    bd = Bdescr((P_)q);

987 988 989
    // blackholes can't be in a compact
    ASSERT((bd->flags & BF_COMPACT) == 0);

990
    if (RTS_UNLIKELY(bd->flags & BF_NONMOVING)) {
991
        if (major_gc && !deadlock_detect_gc)
992
            markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, q);
993 994 995
        return;
    }

996 997 998 999 1000 1001 1002
    // blackholes *can* be in a large object: when raiseAsync() creates an
    // AP_STACK the payload might be large enough to create a large object.
    // See #14497.
    if (bd->flags & BF_LARGE) {
        evacuate_large((P_)q);
        return;
    }
1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035
    if (bd->flags & BF_EVACUATED) {
        if (bd->gen_no < gct->evac_gen_no) {
            gct->failed_to_evac = true;
            TICK_GC_FAILED_PROMOTION();
        }
        return;
    }
    if (bd->flags & BF_MARKED) {
        if (!is_marked((P_)q,bd)) {
            mark((P_)q,bd);
            push_mark_stack((P_)q);
        }
        return;
    }
    gen_no = bd->dest_no;
    info = q->header.info;
    if (IS_FORWARDING_PTR(info))
    {
        StgClosure *e = (StgClosure*)UN_FORWARDING_PTR(info);
        *p = e;
        if (gen_no < gct->evac_gen_no) {  // optimisation
            if (Bdescr((P_)e)->gen_no < gct->evac_gen_no) {
                gct->failed_to_evac = true;
                TICK_GC_FAILED_PROMOTION();
            }
        }
        return;
    }

    ASSERT(INFO_PTR_TO_STRUCT(info)->type == BLACKHOLE);
    copy(p,info,q,sizeofW(StgInd),gen_no);
}

1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046
/* ----------------------------------------------------------------------------
   Update a chain of thunk selectors with the given value. All selectors in the
   chain become IND pointing to the value, except when there is a loop (i.e.
   the value of a THUNK_SELECTOR is the THUNK_SELECTOR itself), in that case we
   leave the selector as-is.

   p is the current selector to update. In eval_thunk_selector we make a list
   from selectors using ((StgThunk*)p)->payload[0] for the link field and use
   that field to traverse the chain here.

   val is the final value of the selector chain.
1047

1048
   A chain is formed when we've got something like:
1049

1050 1051 1052 1053 1054 1055 1056 1057 1058
      let x = C1 { f1 = e1 }
          y = C2 { f2 = f1 x }
          z = f2 y

   Here the chain (p) we get when evacuating z is:

      [ f2 y, f1 x ]

   and val is e1.
1059
   -------------------------------------------------------------------------- */
1060

1061 1062 1063 1064 1065
static void
unchain_thunk_selectors(StgSelector *p, StgClosure *val)
{
    while (p)
    {
simonmar@microsoft.com's avatar
simonmar@microsoft.com committed
1066
        ASSERT(p->header.info == &stg_WHITEHOLE_info);
1067
        // val must be in to-space.  Not always: when we recursively
1068
        // invoke eval_thunk_selector(), the recursive calls will not
1069 1070
        // evacuate the value (because we want to select on the value,
        // not evacuate it), so in this case val is in from-space.
1071
        // ASSERT(!HEAP_ALLOCED_GC(val) || Bdescr((P_)val)->gen_no > N || (Bdescr((P_)val)->flags & BF_EVACUATED));
1072

1073
        StgSelector *prev = (StgSelector*)((StgClosure *)p)->payload[0];
1074 1075

        // Update the THUNK_SELECTOR with an indirection to the
1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088
        // value.  The value is still in from-space at this stage.
        //
        // (old note: Why not do upd_evacuee(q,p)?  Because we have an
        // invariant that an EVACUATED closure always points to an
        // object in the same or an older generation (required by
        // the short-cut test in the EVACUATED case, below).
        if ((StgClosure *)p == val) {
            // must be a loop; just leave a BLACKHOLE in place.  This
            // can happen when we have a chain of selectors that
            // eventually loops back on itself.  We can't leave an
            // indirection pointing to itself, and we want the program
            // to deadlock if it ever enters this closure, so
            // BLACKHOLE is correct.
1089 1090 1091 1092 1093 1094

            // XXX we do not have BLACKHOLEs any more; replace with
            // a THUNK_SELECTOR again.  This will go into a loop if it is
            // entered, and should result in a NonTermination exception.
            ((StgThunk *)p)->payload[0] = val;
            write_barrier();
1095
            SET_INFO((StgClosure *)p, &stg_sel_0_upd_info);
1096 1097 1098
        } else {
            ((StgInd *)p)->indirectee = val;
            write_barrier();
1099
            SET_INFO((StgClosure *)p, &stg_IND_info);
1100
        }
1101 1102 1103 1104 1105 1106 1107 1108

        // For the purposes of LDV profiling, we have created an
        // indirection.
        LDV_RECORD_CREATE(p);

        p = prev;
    }
}
1109

1110 1111 1112 1113 1114 1115 1116 1117 1118 1119
/* -----------------------------------------------------------------------------
   Evaluate a THUNK_SELECTOR if possible.

   p points to a THUNK_SELECTOR that we want to evaluate.

   If the THUNK_SELECTOR could not be evaluated (its selectee is still a THUNK,
   for example), then the THUNK_SELECTOR itself will be evacuated depending on
   the evac parameter.
   -------------------------------------------------------------------------- */

1120
static void
1121
eval_thunk_selector (StgClosure **q, StgSelector *p, bool evac)
1122
                 // NB. for legacy reasons, p & q are swapped around :(
1123
{
1124
    uint32_t field;