#include "Prelude.h"
#include "ParTicky.h" // ToDo: move into Rts.h
#include "GCCompact.h"
-#include "Signals.h"
+#include "RtsSignals.h"
#include "STM.h"
#if defined(GRAN) || defined(PAR)
# include "GranSimRts.h"
- free from-space in each step, and set from-space = to-space.
- Locks held: sched_mutex
+ Locks held: all capabilities are held throughout GarbageCollect().
-------------------------------------------------------------------------- */
step *stp;
lnat live, allocated, collected = 0, copied = 0, scavd_copied = 0;
lnat oldgen_saved_blocks = 0;
- nat g, s;
+ nat g, s, i;
+
+ ACQUIRE_SM_LOCK;
#ifdef PROFILING
CostCentreStack *prev_CCS;
// tell the stats department that we've started a GC
stat_startGC();
+#ifdef DEBUG
+ // check for memory leaks if DEBUG is on
+ memInventory();
+#endif
+
// Init stats and print par specific (timing) info
PAR_TICKY_PAR_START();
if (g != 0) {
freeChain(generations[g].mut_list);
generations[g].mut_list = allocBlock();
+ for (i = 0; i < n_capabilities; i++) {
+ freeChain(capabilities[i].mut_lists[g]);
+ capabilities[i].mut_lists[g] = allocBlock();
+ }
}
for (s = 0; s < generations[g].n_steps; s++) {
stp->scavenged_large_objects = NULL;
stp->n_scavenged_large_blocks = 0;
}
+
+ /* Move the private mutable lists from each capability onto the
+ * main mutable list for the generation.
+ */
+ for (i = 0; i < n_capabilities; i++) {
+ for (bd = capabilities[i].mut_lists[g];
+ bd->link != NULL; bd = bd->link) {
+ /* nothing */
+ }
+ bd->link = generations[g].mut_list;
+ generations[g].mut_list = capabilities[i].mut_lists[g];
+ capabilities[i].mut_lists[g] = allocBlock();
+ }
}
/* Allocate a mark stack if we're doing a major collection.
}
}
- /* Update the pointers from the "main thread" list - these are
+ /* Update the pointers from the task 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
* updating pointers here.
*/
{
- StgMainThread *m;
+ Task *task;
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");
+ for (task = all_tasks; task != NULL; task = task->all_link) {
+ if (!task->stopped && task->tso) {
+ ASSERT(task->tso->bound == task);
+ tso = (StgTSO *) isAlive((StgClosure *)task->tso);
+ if (tso == NULL) {
+ barf("task %p: main thread %d has been GC'd",
+#ifdef THREADED_RTS
+ (void *)task->id,
+#else
+ (void *)task,
+#endif
+ task->tso->id);
+ }
+ task->tso = tso;
}
- m->tso = tso;
}
}
// tack the new blocks on the end of the existing blocks
if (stp->old_blocks != NULL) {
for (bd = stp->old_blocks; bd != NULL; bd = next) {
- next = bd->link;
- if (next == NULL) {
- bd->link = stp->blocks;
- }
// NB. this step might not be compacted next
// time, so reset the BF_COMPACTED flags.
// They are set before GC if we're going to
// compact. (search for BF_COMPACTED above).
bd->flags &= ~BF_COMPACTED;
+ next = bd->link;
+ if (next == NULL) {
+ bd->link = stp->blocks;
+ }
}
stp->blocks = stp->old_blocks;
}
// add the new blocks to the block tally
stp->n_blocks += stp->n_old_blocks;
+ ASSERT(countBlocks(stp->blocks) == stp->n_blocks);
} else {
freeChain(stp->old_blocks);
for (bd = stp->blocks; bd != NULL; bd = bd->link) {
for (g = 0; g <= N; g++) {
for (s = 0; s < generations[g].n_steps; s++) {
stp = &generations[g].steps[s];
- if (stp->is_compacted && stp->bitmap != NULL) {
+ if (stp->bitmap != NULL) {
freeGroup(stp->bitmap);
+ stp->bitmap = NULL;
}
}
}
// Reset the nursery
resetNurseries();
- RELEASE_LOCK(&sched_mutex);
-
// start any pending finalizers
- scheduleFinalizers(old_weak_ptr_list);
+ RELEASE_SM_LOCK;
+ scheduleFinalizers(last_free_capability, old_weak_ptr_list);
+ ACQUIRE_SM_LOCK;
// send exceptions to any threads which were about to die
resurrectThreads(resurrected_threads);
-
- ACQUIRE_LOCK(&sched_mutex);
// Update the stable pointer hash table.
updateStablePtrTable(major_gc);
CCCS = prev_CCS;
#endif
- // check for memory leaks if sanity checking is on
- IF_DEBUG(sanity, memInventory());
+#ifdef DEBUG
+ // check for memory leaks if DEBUG is on
+ memInventory();
+#endif
#ifdef RTS_GTK_FRONTPANEL
if (RtsFlags.GcFlags.frontpanel) {
unblockUserSignals();
#endif
+ RELEASE_SM_LOCK;
+
//PAR_TICKY_TP();
}
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
}
- // it's tempting to recordMutable() if failed_to_evac is
- // false, but that breaks some assumptions (eg. every
- // closure on the mutable list is supposed to have the MUT
- // flag set, and MUT_ARR_PTRS_FROZEN doesn't).
+
+ // If we're going to put this object on the mutable list, then
+ // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
+ if (failed_to_evac) {
+ ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
+ } else {
+ ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
+ }
break;
}
case MUT_ARR_PTRS_FROZEN0:
// follow everything
{
- StgPtr next;
+ StgPtr next, q = p;
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
}
+
+ // If we're going to put this object on the mutable list, then
+ // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
+ if (failed_to_evac) {
+ ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
+ } else {
+ ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
+ }
break;
}
if (mark_stack_overflowed && oldgen_scan_bd == NULL) {
IF_DEBUG(gc, debugBelch("scavenge_mark_stack: starting linear scan"));
mark_stack_overflowed = rtsFalse;
- oldgen_scan_bd = oldest_gen->steps[0].blocks;
+ oldgen_scan_bd = oldest_gen->steps[0].old_blocks;
oldgen_scan = oldgen_scan_bd->start;
}
case MUT_ARR_PTRS_FROZEN0:
{
// follow everything
- StgPtr next;
+ StgPtr next, q=p;
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
}
+
+ // If we're going to put this object on the mutable list, then
+ // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
+ if (failed_to_evac) {
+ ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
+ } else {
+ ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
+ }
break;
}
/* -----------------------------------------------------------------------------
- Lazy black holing.
-
- Whenever a thread returns to the scheduler after possibly doing
- some work, we have to run down the stack and black-hole all the
- closures referred to by update frames.
- -------------------------------------------------------------------------- */
-
-static void
-threadLazyBlackHole(StgTSO *tso)
-{
- StgClosure *frame;
- StgRetInfoTable *info;
- StgClosure *bh;
- StgPtr stack_end;
-
- stack_end = &tso->stack[tso->stack_size];
-
- frame = (StgClosure *)tso->sp;
-
- while (1) {
- info = get_ret_itbl(frame);
-
- switch (info->i.type) {
-
- case UPDATE_FRAME:
- bh = ((StgUpdateFrame *)frame)->updatee;
-
- /* if the thunk is already blackholed, it means we've also
- * already blackholed the rest of the thunks on this stack,
- * so we can stop early.
- *
- * The blackhole made for a CAF is a CAF_BLACKHOLE, so they
- * don't interfere with this optimisation.
- */
- if (bh->header.info == &stg_BLACKHOLE_info) {
- return;
- }
-
- if (bh->header.info != &stg_CAF_BLACKHOLE_info) {
-#if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
- debugBelch("Unexpected lazy BHing required at 0x%04x\n",(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);
-
- // We pretend that bh has just been created.
- LDV_RECORD_CREATE(bh);
- }
-
- frame = (StgClosure *) ((StgUpdateFrame *)frame + 1);
- break;
-
- case STOP_FRAME:
- return;
-
- // normal stack frames; do nothing except advance the pointer
- default:
- frame = (StgClosure *)((StgPtr)frame + stack_frame_sizeW(frame));
- }
- }
-}
-
-
-/* -----------------------------------------------------------------------------
* Stack squeezing
*
* Code largely pinched from old RTS, then hacked to bits. We also do
struct stack_gap { StgWord gap_size; struct stack_gap *next_gap; };
static void
-threadSqueezeStack(StgTSO *tso)
+stackSqueeze(StgTSO *tso, StgPtr bottom)
{
StgPtr frame;
rtsBool prev_was_update_frame;
StgClosure *updatee = NULL;
- StgPtr bottom;
StgRetInfoTable *info;
StgWord current_gap_size;
struct stack_gap *gap;
// contains two values: the size of the gap, and the distance
// to the next gap (or the stack top).
- bottom = &(tso->stack[tso->stack_size]);
-
frame = tso->sp;
ASSERT(frame < bottom);
{
StgUpdateFrame *upd = (StgUpdateFrame *)frame;
- if (upd->updatee->header.info == &stg_BLACKHOLE_info) {
-
- // found a BLACKHOLE'd update frame; we've been here
- // before, in a previous GC, so just break out.
-
- // Mark the end of the gap, if we're in one.
- if (current_gap_size != 0) {
- gap = (struct stack_gap *)(frame-sizeofW(StgUpdateFrame));
- }
-
- frame += sizeofW(StgUpdateFrame);
- goto done_traversing;
- }
-
if (prev_was_update_frame) {
TICK_UPD_SQUEEZED();
// single update frame, or the topmost update frame in a series
else {
- StgClosure *bh = upd->updatee;
-
- // Do lazy black-holing
- if (bh->header.info != &stg_BLACKHOLE_info &&
- bh->header.info != &stg_CAF_BLACKHOLE_info) {
-#if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
- debugBelch("Unexpected lazy BHing required at 0x%04x",(int)bh);
-#endif
-#ifdef DEBUG
- // zero out the slop so that the sanity checker can tell
- // where the next closure is.
- DEBUG_FILL_SLOP(bh);
-#endif
-#ifdef PROFILING
- // We pretend that bh is now dead.
- // ToDo: is the slop filling the same as DEBUG_FILL_SLOP?
- LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
-#endif
- // Todo: maybe use SET_HDR() and remove LDV_RECORD_CREATE()?
- SET_INFO(bh,&stg_BLACKHOLE_info);
-
- // We pretend that bh has just been created.
- LDV_RECORD_CREATE(bh);
- }
-
prev_was_update_frame = rtsTrue;
updatee = upd->updatee;
frame += sizeofW(StgUpdateFrame);
}
}
-done_traversing:
-
+ if (current_gap_size != 0) {
+ gap = (struct stack_gap *) (frame - sizeofW(StgUpdateFrame));
+ }
+
// Now we have a stack with gaps in it, and we have to walk down
// shoving the stack up to fill in the gaps. A diagram might
// help:
* turned on.
* -------------------------------------------------------------------------- */
void
-threadPaused(StgTSO *tso)
+threadPaused(Capability *cap, StgTSO *tso)
{
- if ( RtsFlags.GcFlags.squeezeUpdFrames == rtsTrue )
- threadSqueezeStack(tso); // does black holing too
- else
- threadLazyBlackHole(tso);
+ StgClosure *frame;
+ StgRetInfoTable *info;
+ StgClosure *bh;
+ StgPtr stack_end;
+ nat words_to_squeeze = 0;
+ nat weight = 0;
+ nat weight_pending = 0;
+ rtsBool prev_was_update_frame;
+
+ stack_end = &tso->stack[tso->stack_size];
+
+ frame = (StgClosure *)tso->sp;
+
+ while (1) {
+ // If we've already marked this frame, then stop here.
+ if (frame->header.info == (StgInfoTable *)&stg_marked_upd_frame_info) {
+ goto end;
+ }
+
+ info = get_ret_itbl(frame);
+
+ switch (info->i.type) {
+
+ case UPDATE_FRAME:
+
+ SET_INFO(frame, (StgInfoTable *)&stg_marked_upd_frame_info);
+
+ bh = ((StgUpdateFrame *)frame)->updatee;
+
+ if (closure_IND(bh) || bh->header.info == &stg_BLACKHOLE_info) {
+ IF_DEBUG(squeeze, debugBelch("suspending duplicate work: %d words of stack\n", (StgPtr)frame - tso->sp));
+
+ // If this closure is already an indirection, then
+ // suspend the computation up to this point:
+ suspendComputation(cap,tso,(StgPtr)frame);
+
+ // Now drop the update frame, and arrange to return
+ // the value to the frame underneath:
+ tso->sp = (StgPtr)frame + sizeofW(StgUpdateFrame) - 2;
+ tso->sp[1] = (StgWord)bh;
+ tso->sp[0] = (W_)&stg_enter_info;
+
+ // And continue with threadPaused; there might be
+ // yet more computation to suspend.
+ threadPaused(cap,tso);
+ return;
+ }
+
+ if (bh->header.info != &stg_CAF_BLACKHOLE_info) {
+#if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
+ debugBelch("Unexpected lazy BHing required at 0x%04lx\n",(long)bh);
+#endif
+ // zero out the slop so that the sanity checker can tell
+ // where the next closure is.
+ DEBUG_FILL_SLOP(bh);
+#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);
+
+ // We pretend that bh has just been created.
+ LDV_RECORD_CREATE(bh);
+ }
+
+ frame = (StgClosure *) ((StgUpdateFrame *)frame + 1);
+ if (prev_was_update_frame) {
+ words_to_squeeze += sizeofW(StgUpdateFrame);
+ weight += weight_pending;
+ weight_pending = 0;
+ }
+ prev_was_update_frame = rtsTrue;
+ break;
+
+ case STOP_FRAME:
+ goto end;
+
+ // normal stack frames; do nothing except advance the pointer
+ default:
+ {
+ nat frame_size = stack_frame_sizeW(frame);
+ weight_pending += frame_size;
+ frame = (StgClosure *)((StgPtr)frame + frame_size);
+ prev_was_update_frame = rtsFalse;
+ }
+ }
+ }
+
+end:
+ IF_DEBUG(squeeze,
+ debugBelch("words_to_squeeze: %d, weight: %d, squeeze: %s\n",
+ words_to_squeeze, weight,
+ weight < words_to_squeeze ? "YES" : "NO"));
+
+ // Should we squeeze or not? Arbitrary heuristic: we squeeze if
+ // the number of words we have to shift down is less than the
+ // number of stack words we squeeze away by doing so.
+ if (1 /*RtsFlags.GcFlags.squeezeUpdFrames == rtsTrue &&
+ weight < words_to_squeeze*/) {
+ stackSqueeze(tso, (StgPtr)frame);
+ }
}
/* -----------------------------------------------------------------------------
projects / ghc-hetmet.git / blobdiff