/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.112 2001/08/02 15:33:35 ken Exp $
+ * $Id: GC.c,v 1.133 2002/04/13 05:16:25 sof Exp $
*
* (c) The GHC Team 1998-1999
*
*
* ---------------------------------------------------------------------------*/
+#include "PosixSource.h"
#include "Rts.h"
#include "RtsFlags.h"
#include "RtsUtils.h"
#include "FrontPanel.h"
#endif
+#include "RetainerProfile.h"
+#include "LdvProfile.h"
+
/* STATIC OBJECT LIST.
*
* During GC:
/* Weak pointers
*/
StgWeak *old_weak_ptr_list; // also pending finaliser list
-static rtsBool weak_done; // all done for this pass
+
+/* Which stage of processing various kinds of weak pointer are we at?
+ * (see traverse_weak_ptr_list() below for discussion).
+ */
+typedef enum { WeakPtrs, WeakThreads, WeakDone } WeakStage;
+static WeakStage weak_stage;
/* List of all threads during GC
*/
static StgTSO *old_all_threads;
-static StgTSO *resurrected_threads;
+StgTSO *resurrected_threads;
/* Flag indicating failure to evacuate an object to the desired
* generation.
static void scavenge_static ( void );
static void scavenge_mutable_list ( generation *g );
static void scavenge_mut_once_list ( generation *g );
-static void scavengeCAFs ( void );
#if 0 && defined(DEBUG)
static void gcCAFs ( void );
- free from-space in each step, and set from-space = to-space.
+ Locks held: sched_mutex
+
-------------------------------------------------------------------------- */
void
}
}
- scavengeCAFs();
+ /* follow roots from the CAF list (used by GHCi)
+ */
+ evac_gen = 0;
+ markCAFs(mark_root);
/* follow all the roots that the application knows about.
*/
mark_weak_ptr_list(&weak_ptr_list);
old_weak_ptr_list = weak_ptr_list;
weak_ptr_list = NULL;
- weak_done = rtsFalse;
+ weak_stage = WeakPtrs;
/* The all_threads list is like the weak_ptr_list.
* See traverse_weak_ptr_list() for the details.
if (flag) { goto loop; }
- // must be last...
+ // must be last... invariant is that everything is fully
+ // scavenged at this point.
if (traverse_weak_ptr_list()) { // returns rtsTrue if evaced something
goto loop;
}
}
+ /* Update the pointers from the "main thread" list - these are
+ * treated as weak pointers because we want to allow a main thread
+ * to get a BlockedOnDeadMVar exception in the same way as any other
+ * thread. Note that the threads should all have been retained by
+ * GC by virtue of being on the all_threads list, we're just
+ * updating pointers here.
+ */
+ {
+ StgMainThread *m;
+ StgTSO *tso;
+ for (m = main_threads; m != NULL; m = m->link) {
+ tso = (StgTSO *) isAlive((StgClosure *)m->tso);
+ if (tso == NULL) {
+ barf("main thread has been GC'd");
+ }
+ m->tso = tso;
+ }
+ }
+
#if defined(PAR)
// Reconstruct the Global Address tables used in GUM
rebuildGAtables(major_gc);
}
}
+#ifdef PROFILING
+ // We call processHeapClosureForDead() on every closure destroyed during
+ // the current garbage collection, so we invoke LdvCensusForDead().
+ if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV
+ || RtsFlags.ProfFlags.bioSelector != NULL)
+ LdvCensusForDead(N);
+#endif
+
// NO MORE EVACUATION AFTER THIS POINT!
// Finally: compaction of the oldest generation.
- if (major_gc && RtsFlags.GcFlags.compact) {
+ if (major_gc && oldest_gen->steps[0].is_compacted) {
// save number of blocks for stats
oldgen_saved_blocks = oldest_gen->steps[0].n_blocks;
compact(get_roots);
IF_DEBUG(sanity, checkGlobalTSOList(rtsFalse));
- /* Set the maximum blocks for the oldest generation, based on twice
- * the amount of live data now, adjusted to fit the maximum heap
- * size if necessary.
- *
- * This is an approximation, since in the worst case we'll need
- * twice the amount of live data plus whatever space the other
- * generations need.
- */
- if (major_gc && RtsFlags.GcFlags.generations > 1) {
- nat blocks = oldest_gen->steps[0].n_blocks +
- oldest_gen->steps[0].n_large_blocks;
-
- oldest_gen->max_blocks =
- stg_max(blocks * RtsFlags.GcFlags.oldGenFactor,
- RtsFlags.GcFlags.minOldGenSize);
- if (RtsFlags.GcFlags.compact) {
- if ( oldest_gen->max_blocks >
- RtsFlags.GcFlags.maxHeapSize *
- (100 - RtsFlags.GcFlags.pcFreeHeap) / 100 ) {
- oldest_gen->max_blocks =
- RtsFlags.GcFlags.maxHeapSize *
- (100 - RtsFlags.GcFlags.pcFreeHeap) / 100;
- if (oldest_gen->max_blocks < blocks) {
- belch("max_blocks: %ld, blocks: %ld, maxHeapSize: %ld",
- oldest_gen->max_blocks, blocks, RtsFlags.GcFlags.maxHeapSize);
- heapOverflow();
- }
- }
- } else {
- if (oldest_gen->max_blocks > RtsFlags.GcFlags.maxHeapSize / 2) {
- oldest_gen->max_blocks = RtsFlags.GcFlags.maxHeapSize / 2;
- if (((int)oldest_gen->max_blocks - (int)blocks) <
- (RtsFlags.GcFlags.pcFreeHeap *
- RtsFlags.GcFlags.maxHeapSize / 200)) {
- heapOverflow();
- }
- }
- }
- }
-
/* run through all the generations/steps and tidy up
*/
copied = new_blocks * BLOCK_SIZE_W;
stp->large_objects = stp->scavenged_large_objects;
stp->n_large_blocks = stp->n_scavenged_large_blocks;
- /* Set the maximum blocks for this generation, interpolating
- * between the maximum size of the oldest and youngest
- * generations.
- *
- * max_blocks = oldgen_max_blocks * G
- * ----------------------
- * oldest_gen
- */
- if (g != 0) {
-#if 0
- generations[g].max_blocks = (oldest_gen->max_blocks * g)
- / (RtsFlags.GcFlags.generations-1);
-#endif
- generations[g].max_blocks = oldest_gen->max_blocks;
- }
-
- // for older generations...
} else {
+ // for older generations...
/* For older generations, we need to append the
* scavenged_large_object list (i.e. large objects that have been
}
}
- // Guess the amount of live data for stats.
+ /* Reset the sizes of the older generations when we do a major
+ * collection.
+ *
+ * CURRENT STRATEGY: make all generations except zero the same size.
+ * We have to stay within the maximum heap size, and leave a certain
+ * percentage of the maximum heap size available to allocate into.
+ */
+ if (major_gc && RtsFlags.GcFlags.generations > 1) {
+ nat live, size, min_alloc;
+ nat max = RtsFlags.GcFlags.maxHeapSize;
+ nat gens = RtsFlags.GcFlags.generations;
+
+ // live in the oldest generations
+ live = oldest_gen->steps[0].n_blocks +
+ oldest_gen->steps[0].n_large_blocks;
+
+ // default max size for all generations except zero
+ size = stg_max(live * RtsFlags.GcFlags.oldGenFactor,
+ RtsFlags.GcFlags.minOldGenSize);
+
+ // minimum size for generation zero
+ min_alloc = stg_max((RtsFlags.GcFlags.pcFreeHeap * max) / 200,
+ RtsFlags.GcFlags.minAllocAreaSize);
+
+ // Auto-enable compaction when the residency reaches a
+ // certain percentage of the maximum heap size (default: 30%).
+ if (RtsFlags.GcFlags.generations > 1 &&
+ (RtsFlags.GcFlags.compact ||
+ (max > 0 &&
+ oldest_gen->steps[0].n_blocks >
+ (RtsFlags.GcFlags.compactThreshold * max) / 100))) {
+ oldest_gen->steps[0].is_compacted = 1;
+// fprintf(stderr,"compaction: on\n", live);
+ } else {
+ oldest_gen->steps[0].is_compacted = 0;
+// fprintf(stderr,"compaction: off\n", live);
+ }
+
+ // if we're going to go over the maximum heap size, reduce the
+ // size of the generations accordingly. The calculation is
+ // different if compaction is turned on, because we don't need
+ // to double the space required to collect the old generation.
+ if (max != 0) {
+
+ // this test is necessary to ensure that the calculations
+ // below don't have any negative results - we're working
+ // with unsigned values here.
+ if (max < min_alloc) {
+ heapOverflow();
+ }
+
+ if (oldest_gen->steps[0].is_compacted) {
+ if ( (size + (size - 1) * (gens - 2) * 2) + min_alloc > max ) {
+ size = (max - min_alloc) / ((gens - 1) * 2 - 1);
+ }
+ } else {
+ if ( (size * (gens - 1) * 2) + min_alloc > max ) {
+ size = (max - min_alloc) / ((gens - 1) * 2);
+ }
+ }
+
+ if (size < live) {
+ heapOverflow();
+ }
+ }
+
+#if 0
+ fprintf(stderr,"live: %d, min_alloc: %d, size : %d, max = %d\n", live,
+ min_alloc, size, max);
+#endif
+
+ for (g = 0; g < gens; g++) {
+ generations[g].max_blocks = size;
+ }
+ }
+
+ // Guess the amount of live data for stats.
live = calcLive();
/* Free the small objects allocated via allocate(), since this will
alloc_HpLim = NULL;
alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
+ // Start a new pinned_object_block
+ pinned_object_block = NULL;
+
/* Free the mark stack.
*/
if (mark_stack_bdescr != NULL) {
/* For a two-space collector, we need to resize the nursery. */
/* set up a new nursery. Allocate a nursery size based on a
- * function of the amount of live data (currently a factor of 2,
- * should be configurable (ToDo)). Use the blocks from the old
- * nursery if possible, freeing up any left over blocks.
+ * function of the amount of live data (by default a factor of 2)
+ * Use the blocks from the old nursery if possible, freeing up any
+ * left over blocks.
*
* If we get near the maximum heap size, then adjust our nursery
* size accordingly. If the nursery is the same size as the live
*
* A normal 2-space collector would need 4L bytes to give the same
* performance we get from 3L bytes, reducing to the same
- * performance at 2L bytes.
+ * performance at 2L bytes.
*/
blocks = g0s0->n_to_blocks;
- if ( blocks * RtsFlags.GcFlags.oldGenFactor * 2 >
- RtsFlags.GcFlags.maxHeapSize ) {
+ if ( RtsFlags.GcFlags.maxHeapSize != 0 &&
+ blocks * RtsFlags.GcFlags.oldGenFactor * 2 >
+ RtsFlags.GcFlags.maxHeapSize ) {
long adjusted_blocks; // signed on purpose
int pc_free;
}
resizeNursery((nat)blocks);
+
+ } else {
+ // we might have added extra large blocks to the nursery, so
+ // resize back to minAllocAreaSize again.
+ resizeNursery(RtsFlags.GcFlags.minAllocAreaSize);
}
}
if (major_gc) { gcCAFs(); }
#endif
+#ifdef PROFILING
+ // resetStaticObjectForRetainerProfiling() must be called before
+ // zeroing below.
+ resetStaticObjectForRetainerProfiling();
+#endif
+
// zero the scavenged static object list
if (major_gc) {
zero_static_object_list(scavenged_static_objects);
}
- /* Reset the nursery
- */
+ // Reset the nursery
resetNurseries();
+ RELEASE_LOCK(&sched_mutex);
+
// start any pending finalizers
scheduleFinalizers(old_weak_ptr_list);
+ ACQUIRE_LOCK(&sched_mutex);
+
// send exceptions to any threads which were about to die
resurrectThreads(resurrected_threads);
-
+
// Update the stable pointer hash table.
updateStablePtrTable(major_gc);
// restore enclosing cost centre
#ifdef PROFILING
- heapCensus();
CCCS = prev_CCS;
#endif
older generations than the one we're collecting. This could
probably be optimised by keeping per-generation lists of weak
pointers, but for a few weak pointers this scheme will work.
+
+ There are three distinct stages to processing weak pointers:
+
+ - weak_stage == WeakPtrs
+
+ We process all the weak pointers whos keys are alive (evacuate
+ their values and finalizers), and repeat until we can find no new
+ live keys. If no live keys are found in this pass, then we
+ evacuate the finalizers of all the dead weak pointers in order to
+ run them.
+
+ - weak_stage == WeakThreads
+
+ Now, we discover which *threads* are still alive. Pointers to
+ threads from the all_threads and main thread lists are the
+ weakest of all: a pointers from the finalizer of a dead weak
+ pointer can keep a thread alive. Any threads found to be unreachable
+ are evacuated and placed on the resurrected_threads list so we
+ can send them a signal later.
+
+ - weak_stage == WeakDone
+
+ No more evacuation is done.
+
-------------------------------------------------------------------------- */
static rtsBool
StgClosure *new;
rtsBool flag = rtsFalse;
- if (weak_done) { return rtsFalse; }
-
- /* doesn't matter where we evacuate values/finalizers to, since
- * these pointers are treated as roots (iff the keys are alive).
- */
- evac_gen = 0;
-
- last_w = &old_weak_ptr_list;
- for (w = old_weak_ptr_list; w != NULL; w = next_w) {
-
- /* There might be a DEAD_WEAK on the list if finalizeWeak# was
- * called on a live weak pointer object. Just remove it.
- */
- if (w->header.info == &stg_DEAD_WEAK_info) {
- next_w = ((StgDeadWeak *)w)->link;
- *last_w = next_w;
- continue;
- }
+ switch (weak_stage) {
- ASSERT(get_itbl(w)->type == WEAK);
+ case WeakDone:
+ return rtsFalse;
- /* Now, check whether the key is reachable.
- */
- if ((new = isAlive(w->key))) {
- w->key = new;
- // evacuate the value and finalizer
- w->value = evacuate(w->value);
- w->finalizer = evacuate(w->finalizer);
- // remove this weak ptr from the old_weak_ptr list
- *last_w = w->link;
- // and put it on the new weak ptr list
- next_w = w->link;
- w->link = weak_ptr_list;
- weak_ptr_list = w;
- flag = rtsTrue;
- IF_DEBUG(weak, belch("Weak pointer still alive at %p -> %p", w, w->key));
- continue;
- }
- else {
- last_w = &(w->link);
- next_w = w->link;
- continue;
- }
- }
-
- /* Now deal with the all_threads list, which behaves somewhat like
- * the weak ptr list. If we discover any threads that are about to
- * become garbage, we wake them up and administer an exception.
- */
- {
- StgTSO *t, *tmp, *next, **prev;
-
- prev = &old_all_threads;
- for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
-
- (StgClosure *)tmp = isAlive((StgClosure *)t);
+ case WeakPtrs:
+ /* doesn't matter where we evacuate values/finalizers to, since
+ * these pointers are treated as roots (iff the keys are alive).
+ */
+ evac_gen = 0;
- if (tmp != NULL) {
- t = tmp;
- }
-
- ASSERT(get_itbl(t)->type == TSO);
- switch (t->what_next) {
- case ThreadRelocated:
- next = t->link;
- *prev = next;
- continue;
- case ThreadKilled:
- case ThreadComplete:
- // finshed or died. The thread might still be alive, but we
- // don't keep it on the all_threads list. Don't forget to
- // stub out its global_link field.
- next = t->global_link;
- t->global_link = END_TSO_QUEUE;
- *prev = next;
- continue;
- default:
- ;
+ last_w = &old_weak_ptr_list;
+ for (w = old_weak_ptr_list; w != NULL; w = next_w) {
+
+ /* There might be a DEAD_WEAK on the list if finalizeWeak# was
+ * called on a live weak pointer object. Just remove it.
+ */
+ if (w->header.info == &stg_DEAD_WEAK_info) {
+ next_w = ((StgDeadWeak *)w)->link;
+ *last_w = next_w;
+ continue;
+ }
+
+ ASSERT(get_itbl(w)->type == WEAK);
+
+ /* Now, check whether the key is reachable.
+ */
+ new = isAlive(w->key);
+ if (new != NULL) {
+ w->key = new;
+ // evacuate the value and finalizer
+ w->value = evacuate(w->value);
+ w->finalizer = evacuate(w->finalizer);
+ // remove this weak ptr from the old_weak_ptr list
+ *last_w = w->link;
+ // and put it on the new weak ptr list
+ next_w = w->link;
+ w->link = weak_ptr_list;
+ weak_ptr_list = w;
+ flag = rtsTrue;
+ IF_DEBUG(weak, belch("Weak pointer still alive at %p -> %p",
+ w, w->key));
+ continue;
+ }
+ else {
+ last_w = &(w->link);
+ next_w = w->link;
+ continue;
+ }
}
+
+ /* If we didn't make any changes, then we can go round and kill all
+ * the dead weak pointers. The old_weak_ptr list is used as a list
+ * of pending finalizers later on.
+ */
+ if (flag == rtsFalse) {
+ for (w = old_weak_ptr_list; w; w = w->link) {
+ w->finalizer = evacuate(w->finalizer);
+ }
- if (tmp == NULL) {
- // not alive (yet): leave this thread on the old_all_threads list.
- prev = &(t->global_link);
- next = t->global_link;
- continue;
- }
- else {
- // alive: move this thread onto the all_threads list.
- next = t->global_link;
- t->global_link = all_threads;
- all_threads = t;
- *prev = next;
- break;
+ // Next, move to the WeakThreads stage after fully
+ // scavenging the finalizers we've just evacuated.
+ weak_stage = WeakThreads;
}
- }
- }
- /* If we didn't make any changes, then we can go round and kill all
- * the dead weak pointers. The old_weak_ptr list is used as a list
- * of pending finalizers later on.
- */
- if (flag == rtsFalse) {
- for (w = old_weak_ptr_list; w; w = w->link) {
- w->finalizer = evacuate(w->finalizer);
- }
+ return rtsTrue;
- /* And resurrect any threads which were about to become garbage.
- */
- {
- StgTSO *t, *tmp, *next;
- for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
- next = t->global_link;
- (StgClosure *)tmp = evacuate((StgClosure *)t);
- tmp->global_link = resurrected_threads;
- resurrected_threads = tmp;
+ case WeakThreads:
+ /* Now deal with the all_threads list, which behaves somewhat like
+ * the weak ptr list. If we discover any threads that are about to
+ * become garbage, we wake them up and administer an exception.
+ */
+ {
+ StgTSO *t, *tmp, *next, **prev;
+
+ prev = &old_all_threads;
+ for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
+
+ (StgClosure *)tmp = isAlive((StgClosure *)t);
+
+ if (tmp != NULL) {
+ t = tmp;
+ }
+
+ ASSERT(get_itbl(t)->type == TSO);
+ switch (t->what_next) {
+ case ThreadRelocated:
+ next = t->link;
+ *prev = next;
+ continue;
+ case ThreadKilled:
+ case ThreadComplete:
+ // finshed or died. The thread might still be alive, but we
+ // don't keep it on the all_threads list. Don't forget to
+ // stub out its global_link field.
+ next = t->global_link;
+ t->global_link = END_TSO_QUEUE;
+ *prev = next;
+ continue;
+ default:
+ ;
+ }
+
+ if (tmp == NULL) {
+ // not alive (yet): leave this thread on the
+ // old_all_threads list.
+ prev = &(t->global_link);
+ next = t->global_link;
+ }
+ else {
+ // alive: move this thread onto the all_threads list.
+ next = t->global_link;
+ t->global_link = all_threads;
+ all_threads = t;
+ *prev = next;
+ }
+ }
}
- }
+
+ /* And resurrect any threads which were about to become garbage.
+ */
+ {
+ StgTSO *t, *tmp, *next;
+ for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
+ next = t->global_link;
+ (StgClosure *)tmp = evacuate((StgClosure *)t);
+ tmp->global_link = resurrected_threads;
+ resurrected_threads = tmp;
+ }
+ }
+
+ weak_stage = WeakDone; // *now* we're done,
+ return rtsTrue; // but one more round of scavenging, please
- weak_done = rtsTrue;
+ default:
+ barf("traverse_weak_ptr_list");
}
- return rtsTrue;
}
/* -----------------------------------------------------------------------------
copy(StgClosure *src, nat size, step *stp)
{
P_ to, from, dest;
+#ifdef PROFILING
+ // @LDV profiling
+ nat size_org = size;
+#endif
TICK_GC_WORDS_COPIED(size);
/* Find out where we're going, using the handy "to" pointer in
dest = stp->hp;
stp->hp = to;
upd_evacuee(src,(StgClosure *)dest);
+#ifdef PROFILING
+ // 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(src, size_org);
+#endif
return (StgClosure *)dest;
}
*/
-static __inline__ StgClosure *
+static StgClosure *
copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp)
{
P_ dest, to, from;
+#ifdef PROFILING
+ // @LDV profiling
+ nat size_to_copy_org = size_to_copy;
+#endif
TICK_GC_WORDS_COPIED(size_to_copy);
if (stp->gen_no < evac_gen) {
dest = stp->hp;
stp->hp += size_to_reserve;
upd_evacuee(src,(StgClosure *)dest);
+#ifdef PROFILING
+ // 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.
+ // size_to_copy_org is wrong because the closure already occupies size_to_reserve
+ // words.
+ SET_EVACUAEE_FOR_LDV(src, size_to_reserve);
+ // fill the slop
+ if (size_to_reserve - size_to_copy_org > 0)
+ FILL_SLOP(stp->hp - 1, (int)(size_to_reserve - size_to_copy_org));
+#endif
return (StgClosure *)dest;
}
bdescr *bd = Bdescr(p);
step *stp;
- // should point to the beginning of the block
- ASSERT(((W_)p & BLOCK_MASK) == 0);
-
+ // object must be at the beginning of the block (or be a ByteArray)
+ ASSERT(get_itbl((StgClosure *)p)->type == ARR_WORDS ||
+ (((W_)p & BLOCK_MASK) == 0));
+
// already evacuated?
if (bd->flags & BF_EVACUATED) {
/* Don't forget to set the failed_to_evac flag if we didn't get
if (HEAP_ALLOCED(q)) {
bd = Bdescr((P_)q);
+ // not a group head: find the group head
+ if (bd->blocks == 0) { bd = bd->link; }
+
if (bd->gen_no > N) {
/* Can't evacuate this object, because it's in a generation
* older than the ones we're collecting. Let's hope that it's
case CONSTR_1_1:
case CONSTR_0_2:
case CONSTR_STATIC:
+ case CONSTR_NOCAF_STATIC:
{
StgWord offset = info->layout.selector_offset;
// perform the selection!
q = selectee->payload[offset];
+ if (major_gc==rtsTrue) {TICK_GC_SEL_MAJOR();} else {TICK_GC_SEL_MINOR();}
/* if we're already in to-space, there's no need to continue
* with the evacuation, just update the source address with
thunk_selector_depth--;
goto selector_loop;
}
- }
- // otherwise, fall through...
+ } else {
+ TICK_GC_SEL_ABANDONED();
+ // and fall through...
+ }
# endif
case AP_UPD:
}
case IND_PERM:
- if (stp->gen_no != 0) {
- SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info);
- }
+ if (stp->gen->no != 0) {
+#ifdef PROFILING
+ // @LDV profiling
+ // No need to call LDV_recordDead_FILL_SLOP_DYNAMIC() because an
+ // IND_OLDGEN_PERM closure is larger than an IND_PERM closure.
+ LDV_recordDead((StgClosure *)p, sizeofW(StgInd));
+#endif
+ //
+ // Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
+ //
+ SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info);
+#ifdef PROFILING
+ // @LDV profiling
+ // We pretend that p has just been created.
+ LDV_recordCreate((StgClosure *)p);
+#endif
+ }
// fall through
case IND_OLDGEN_PERM:
((StgIndOldGen *)p)->indirectee =
}
void
-scavengeCAFs( void )
+markCAFs( evac_fn evac )
{
StgIndStatic *c;
- evac_gen = 0;
for (c = (StgIndStatic *)caf_list; c != NULL;
c = (StgIndStatic *)c->static_link)
{
- c->indirectee = evacuate(c->indirectee);
+ evac(&c->indirectee);
}
}
#if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
belch("Unexpected lazy BHing required at 0x%04x",(int)bh);
#endif
+#ifdef PROFILING
+ // @LDV profiling
+ // We pretend that bh is now dead.
+ LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
+#endif
SET_INFO(bh,&stg_BLACKHOLE_info);
+#ifdef PROFILING
+ // @LDV profiling
+ // We pretend that bh has just been created.
+ LDV_recordCreate(bh);
+#endif
}
update_frame = update_frame->link;
{
StgInfoTable *info = get_itbl(bh);
nat np = info->layout.payload.ptrs, nw = info->layout.payload.nptrs, i;
- /* don't zero out slop for a THUNK_SELECTOR, because it's layout
+ /* don't zero out slop for a THUNK_SELECTOR, because its layout
* info is used for a different purpose, and it's exactly the
* same size as a BLACKHOLE in any case.
*/
}
}
#endif
+#ifdef PROFILING
+ // @LDV profiling
+ // We pretend that bh is now dead.
+ LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
+#endif
+ //
+ // Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
+ //
SET_INFO(bh,&stg_BLACKHOLE_info);
+#ifdef PROFILING
+ // @LDV profiling
+ // We pretend that bh has just been created.
+ LDV_recordCreate(bh);
+#endif
}
}
projects / ghc-hetmet.git / blobdiff