/* -----------------------------------------------------------------------------
*
- * (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());
resizeNurseriesFixed(blocks / n_nurseries);
}
+
+/* -----------------------------------------------------------------------------
+ move_TSO is called to update the TSO structure after it has been
+ moved from one place to another.
+ -------------------------------------------------------------------------- */
+
+void
+move_TSO (StgTSO *src, StgTSO *dest)
+{
+ ptrdiff_t diff;
+
+ // relocate the stack pointer...
+ diff = (StgPtr)dest - (StgPtr)src; // In *words*
+ dest->sp = (StgPtr)dest->sp + diff;
+}
+
/* -----------------------------------------------------------------------------
The allocate() interface
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
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 (s = 0; s < generations[g].n_steps; s++) {
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;
+
+ ASSERT(n_alloc_blocks == live_blocks);
+
+ 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);
}
}
projects / ghc-hetmet.git / blobdiff