/* -----------------------------------------------------------------------------
*
- * (c) The GHC Team, 1998-2006
+ * (c) The GHC Team, 1998-2008
*
* Storage manager front end
*
#include "OSMem.h"
#include "Trace.h"
#include "GC.h"
-#include "GCUtils.h"
+#include "Evac.h"
#include <stdlib.h>
#include <string.h>
generation *oldest_gen = NULL; /* oldest generation, for convenience */
step *g0s0 = NULL; /* generation 0, step 0, for convenience */
+nat total_steps = 0;
+step *all_steps = NULL; /* single array of steps */
+
ullong total_allocated = 0; /* total memory allocated during run */
nat n_nurseries = 0; /* == RtsFlags.ParFlags.nNodes, convenience */
initStep (step *stp, int g, int s)
{
stp->no = s;
+ stp->abs_no = RtsFlags.GcFlags.steps * g + s;
stp->blocks = NULL;
stp->n_blocks = 0;
+ stp->n_words = 0;
stp->old_blocks = NULL;
stp->n_old_blocks = 0;
stp->gen = &generations[g];
initSpinLock(&stp->sync_todo);
initSpinLock(&stp->sync_large_objects);
#endif
+ stp->threads = END_TSO_QUEUE;
+ stp->old_threads = END_TSO_QUEUE;
}
void
{
nat g, s;
generation *gen;
- step *step_arr;
if (generations != NULL) {
// multi-init protection
it this way, because we need the invariant that two step pointers
can be directly compared to see which is the oldest.
Remember that the last generation has only one step. */
- step_arr = stgMallocBytes(sizeof(struct step_)
- * (1 + ((RtsFlags.GcFlags.generations - 1)
- * RtsFlags.GcFlags.steps)),
- "initStorage: steps");
+ total_steps = 1 + (RtsFlags.GcFlags.generations - 1) * RtsFlags.GcFlags.steps;
+ all_steps = stgMallocBytes(total_steps * sizeof(struct step_),
+ "initStorage: steps");
/* Initialise all generations */
for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
gen->no = g;
gen->mut_list = allocBlock();
gen->collections = 0;
+ gen->par_collections = 0;
gen->failed_promotions = 0;
gen->max_blocks = 0;
}
/* Oldest generation: one step */
oldest_gen->n_steps = 1;
- oldest_gen->steps = step_arr + (RtsFlags.GcFlags.generations - 1)
+ oldest_gen->steps = all_steps + (RtsFlags.GcFlags.generations - 1)
* RtsFlags.GcFlags.steps;
/* set up all except the oldest generation with 2 steps */
for(g = 0; g < RtsFlags.GcFlags.generations-1; g++) {
generations[g].n_steps = RtsFlags.GcFlags.steps;
- generations[g].steps = step_arr + g * RtsFlags.GcFlags.steps;
+ generations[g].steps = all_steps + g * RtsFlags.GcFlags.steps;
}
} else {
/* single generation, i.e. a two-space collector */
g0->n_steps = 1;
- g0->steps = step_arr;
+ g0->steps = all_steps;
}
#ifdef THREADED_RTS
#ifdef THREADED_RTS
initSpinLock(&gc_alloc_block_sync);
+ initSpinLock(&recordMutableGen_sync);
+ whitehole_spin = 0;
#endif
IF_DEBUG(gc, statDescribeGens());
return allocated;
}
+// split N blocks off the start of the given bdescr, returning the
+// remainder as a new block group. We treat the remainder as if it
+// had been freshly allocated in generation 0.
+bdescr *
+splitLargeBlock (bdescr *bd, nat blocks)
+{
+ bdescr *new_bd;
+
+ // subtract the original number of blocks from the counter first
+ bd->step->n_large_blocks -= bd->blocks;
+
+ new_bd = splitBlockGroup (bd, blocks);
+
+ dbl_link_onto(new_bd, &g0s0->large_objects);
+ g0s0->n_large_blocks += new_bd->blocks;
+ new_bd->gen_no = g0s0->no;
+ new_bd->step = g0s0;
+ new_bd->flags = BF_LARGE;
+ new_bd->free = bd->free;
+
+ // add the new number of blocks to the counter. Due to the gaps
+ // for block descriptor, new_bd->blocks + bd->blocks might not be
+ // equal to the original bd->blocks, which is why we do it this way.
+ bd->step->n_large_blocks += bd->blocks;
+
+ return new_bd;
+}
+
/* -----------------------------------------------------------------------------
allocateLocal()
}
}
+// Setting a TSO's link field with a write barrier.
+// It is *not* necessary to call this function when
+// * setting the link field to END_TSO_QUEUE
+// * putting a TSO on the blackhole_queue
+// * setting the link field of the currently running TSO, as it
+// will already be dirty.
+void
+setTSOLink (Capability *cap, StgTSO *tso, StgTSO *target)
+{
+ bdescr *bd;
+ if ((tso->flags & (TSO_DIRTY|TSO_LINK_DIRTY)) == 0) {
+ tso->flags |= TSO_LINK_DIRTY;
+ bd = Bdescr((StgPtr)tso);
+ if (bd->gen_no > 0) recordMutableCap((StgClosure*)tso,cap,bd->gen_no);
+ }
+ tso->_link = target;
+}
+
+void
+dirty_TSO (Capability *cap, StgTSO *tso)
+{
+ bdescr *bd;
+ if ((tso->flags & (TSO_DIRTY|TSO_LINK_DIRTY)) == 0) {
+ bd = Bdescr((StgPtr)tso);
+ if (bd->gen_no > 0) recordMutableCap((StgClosure*)tso,cap,bd->gen_no);
+ }
+ tso->flags |= TSO_DIRTY;
+}
+
/*
This is the write barrier for MVARs. An MVAR_CLEAN objects is not
on the mutable list; a MVAR_DIRTY is. When written to, a
return words;
}
+// Return an accurate count of the live data in the heap, excluding
+// generation 0.
lnat
calcLiveWords(void)
{
step *stp;
if (RtsFlags.GcFlags.generations == 1) {
- return countOccupied(g0s0->blocks) + countOccupied(g0s0->large_objects);
+ return g0s0->n_words + countOccupied(g0s0->large_objects);
}
live = 0;
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
for (s = 0; s < generations[g].n_steps; s++) {
- /* approximate amount of live data (doesn't take into account slop
- * at end of each block).
- */
if (g == 0 && s == 0) continue;
stp = &generations[g].steps[s];
- live += countOccupied(stp->blocks) +
- countOccupied(stp->large_objects);
+ live += stp->n_words + countOccupied(stp->large_objects);
}
}
return live;
for (s = 0; s < generations[g].n_steps; s++) {
if (g == 0 && s == 0) { continue; }
stp = &generations[g].steps[s];
- if (generations[g].steps[0].n_blocks +
- generations[g].steps[0].n_large_blocks
- > generations[g].max_blocks
- && stp->is_compacted == 0) {
- needed += 2 * stp->n_blocks;
+ if (g == 0 || // always collect gen 0
+ (generations[g].steps[0].n_blocks +
+ generations[g].steps[0].n_large_blocks
+ > generations[g].max_blocks
+ && stp->is_compacted == 0)) {
+ needed += 2 * stp->n_blocks + stp->n_large_blocks;
} else {
- needed += stp->n_blocks;
+ needed += stp->n_blocks + stp->n_large_blocks;
}
}
}
}
void
-memInventory(void)
+memInventory (rtsBool show)
{
nat g, s, i;
step *stp;
lnat nursery_blocks, retainer_blocks,
arena_blocks, exec_blocks;
lnat live_blocks = 0, free_blocks = 0;
+ rtsBool leak;
// count the blocks we current have
live_blocks += nursery_blocks +
+ retainer_blocks + arena_blocks + exec_blocks;
- if (live_blocks + free_blocks != mblocks_allocated * BLOCKS_PER_MBLOCK)
+#define MB(n) (((n) * BLOCK_SIZE_W) / ((1024*1024)/sizeof(W_)))
+
+ leak = live_blocks + free_blocks != mblocks_allocated * BLOCKS_PER_MBLOCK;
+ if (show || leak)
{
- debugBelch("Memory leak detected\n");
+ if (leak) {
+ debugBelch("Memory leak detected:\n");
+ } else {
+ debugBelch("Memory inventory:\n");
+ }
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
- debugBelch(" gen %d blocks : %4lu\n", g, gen_blocks[g]);
+ debugBelch(" gen %d blocks : %5lu blocks (%lu MB)\n", g,
+ gen_blocks[g], MB(gen_blocks[g]));
+ }
+ debugBelch(" nursery : %5lu blocks (%lu MB)\n",
+ nursery_blocks, MB(nursery_blocks));
+ debugBelch(" retainer : %5lu blocks (%lu MB)\n",
+ retainer_blocks, MB(retainer_blocks));
+ debugBelch(" arena blocks : %5lu blocks (%lu MB)\n",
+ arena_blocks, MB(arena_blocks));
+ debugBelch(" exec : %5lu blocks (%lu MB)\n",
+ exec_blocks, MB(exec_blocks));
+ debugBelch(" free : %5lu blocks (%lu MB)\n",
+ free_blocks, MB(free_blocks));
+ debugBelch(" total : %5lu blocks (%lu MB)\n",
+ live_blocks + free_blocks, MB(live_blocks+free_blocks));
+ if (leak) {
+ debugBelch("\n in system : %5lu blocks (%lu MB)\n",
+ mblocks_allocated * BLOCKS_PER_MBLOCK, mblocks_allocated);
}
- debugBelch(" nursery : %4lu\n", nursery_blocks);
- debugBelch(" retainer : %4lu\n", retainer_blocks);
- debugBelch(" arena blocks : %4lu\n", arena_blocks);
- debugBelch(" exec : %4lu\n", exec_blocks);
- debugBelch(" free : %4lu\n", free_blocks);
- debugBelch(" total : %4lu\n\n", live_blocks + free_blocks);
- debugBelch(" in system : %4lu\n", mblocks_allocated * BLOCKS_PER_MBLOCK);
- ASSERT(0);
}
}