X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FStorage.c;h=73ef53f036207085e6983084f1361f6e4f9a5995;hb=f9d15f9fccae4706fbdf8ee4ecaef7da9953cb74;hp=eb29b2daf6c96e7cae7dda741b0cfa37772ce2e3;hpb=c1540c3def6281ea67b5a4ce7499b1aa982faa25;p=ghc-hetmet.git diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index eb29b2d..73ef53f 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -1,6 +1,6 @@ /* ----------------------------------------------------------------------------- * - * (c) The GHC Team, 1998-2006 + * (c) The GHC Team, 1998-2008 * * Storage manager front end * @@ -13,26 +13,26 @@ #include "PosixSource.h" #include "Rts.h" + +#include "Storage.h" #include "RtsUtils.h" -#include "RtsFlags.h" #include "Stats.h" -#include "Hooks.h" #include "BlockAlloc.h" -#include "MBlock.h" #include "Weak.h" #include "Sanity.h" #include "Arena.h" -#include "OSThreads.h" #include "Capability.h" -#include "Storage.h" #include "Schedule.h" #include "RetainerProfile.h" // for counting memory blocks (memInventory) #include "OSMem.h" #include "Trace.h" +#include "GC.h" +#include "Evac.h" -#include #include +#include "ffi.h" + /* * All these globals require sm_mutex to access in THREADED_RTS mode. */ @@ -44,11 +44,16 @@ bdescr *pinned_object_block; /* allocate pinned objects into this block */ nat alloc_blocks; /* number of allocate()d blocks since GC */ nat alloc_blocks_lim; /* approximate limit on alloc_blocks */ +static bdescr *exec_block; + generation *generations = NULL; /* all the generations */ generation *g0 = NULL; /* generation 0, for convenience */ 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 */ @@ -60,44 +65,35 @@ step *nurseries = NULL; /* array of nurseries, >1 only if THREADED_RTS * * simultaneous access by two STG threads. */ Mutex sm_mutex; -/* - * This mutex is used by atomicModifyMutVar# only - */ -Mutex atomic_modify_mutvar_mutex; #endif - -/* - * Forward references - */ -static void *stgAllocForGMP (size_t size_in_bytes); -static void *stgReallocForGMP (void *ptr, size_t old_size, size_t new_size); -static void stgDeallocForGMP (void *ptr, size_t size); +static void allocNurseries ( void ); static void 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->live_estimate = 0; stp->old_blocks = NULL; stp->n_old_blocks = 0; stp->gen = &generations[g]; stp->gen_no = g; - stp->hp = NULL; - stp->hpLim = NULL; - stp->hp_bd = NULL; - stp->scavd_hp = NULL; - stp->scavd_hpLim = NULL; - stp->scan = NULL; - stp->scan_bd = NULL; stp->large_objects = NULL; stp->n_large_blocks = 0; - stp->new_large_objects = NULL; stp->scavenged_large_objects = NULL; stp->n_scavenged_large_blocks = 0; - stp->is_compacted = 0; + stp->mark = 0; + stp->compact = 0; stp->bitmap = NULL; +#ifdef THREADED_RTS + initSpinLock(&stp->sync_large_objects); +#endif + stp->threads = END_TSO_QUEUE; + stp->old_threads = END_TSO_QUEUE; } void @@ -116,7 +112,8 @@ initStorage( void ) /* Sanity check to make sure the LOOKS_LIKE_ macros appear to be * doing something reasonable. */ - ASSERT(LOOKS_LIKE_INFO_PTR(&stg_BLACKHOLE_info)); + /* We use the NOT_NULL variant or gcc warns that the test is always true */ + ASSERT(LOOKS_LIKE_INFO_PTR_NOT_NULL((StgWord)&stg_BLACKHOLE_info)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(&stg_dummy_ret_closure)); ASSERT(!HEAP_ALLOCED(&stg_dummy_ret_closure)); @@ -137,7 +134,6 @@ initStorage( void ) #if defined(THREADED_RTS) initMutex(&sm_mutex); - initMutex(&atomic_modify_mutvar_mutex); #endif ACQUIRE_SM_LOCK; @@ -147,12 +143,21 @@ initStorage( void ) * sizeof(struct generation_), "initStorage: gens"); + /* allocate all the steps into an array. It is important that we do + 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. */ + 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 = &generations[g]; gen->no = g; gen->mut_list = allocBlock(); gen->collections = 0; + gen->par_collections = 0; gen->failed_promotions = 0; gen->max_blocks = 0; } @@ -167,21 +172,19 @@ initStorage( void ) /* Oldest generation: one step */ oldest_gen->n_steps = 1; - oldest_gen->steps = - stgMallocBytes(1 * sizeof(struct step_), "initStorage: last step"); + 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 = - stgMallocBytes (RtsFlags.GcFlags.steps * sizeof(struct step_), - "initStorage: 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 = stgMallocBytes (sizeof(struct step_), "initStorage: steps"); + g0->steps = all_steps; } #ifdef THREADED_RTS @@ -217,11 +220,13 @@ initStorage( void ) } /* The oldest generation has one step. */ - if (RtsFlags.GcFlags.compact) { + if (RtsFlags.GcFlags.compact || RtsFlags.GcFlags.sweep) { if (RtsFlags.GcFlags.generations == 1) { - errorBelch("WARNING: compaction is incompatible with -G1; disabled"); + errorBelch("WARNING: compact/sweep is incompatible with -G1; disabled"); } else { - oldest_gen->steps[0].is_compacted = 1; + oldest_gen->steps[0].mark = 1; + if (RtsFlags.GcFlags.compact) + oldest_gen->steps[0].compact = 1; } } @@ -244,8 +249,16 @@ initStorage( void ) alloc_blocks = 0; alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize; - /* Tell GNU multi-precision pkg about our custom alloc functions */ - mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP); + exec_block = NULL; + +#ifdef THREADED_RTS + initSpinLock(&gc_alloc_block_sync); + whitehole_spin = 0; +#endif + + N = 0; + + initGcThreads(); IF_DEBUG(gc, statDescribeGens()); @@ -261,17 +274,14 @@ exitStorage (void) void freeStorage (void) { - nat g; - - for(g = 0; g < RtsFlags.GcFlags.generations; g++) - stgFree(generations[g].steps); + stgFree(g0s0); // frees all the steps stgFree(generations); freeAllMBlocks(); #if defined(THREADED_RTS) closeMutex(&sm_mutex); - closeMutex(&atomic_modify_mutvar_mutex); #endif stgFree(nurseries); + freeGcThreads(); } /* ----------------------------------------------------------------------------- @@ -320,6 +330,7 @@ newCAF(StgClosure* caf) { ACQUIRE_SM_LOCK; +#ifdef DYNAMIC if(keepCAFs) { // HACK: @@ -337,6 +348,7 @@ newCAF(StgClosure* caf) caf_list = caf; } else +#endif { /* Put this CAF on the mutable list for the old generation. * This is a HACK - the IND_STATIC closure doesn't really have @@ -346,7 +358,7 @@ newCAF(StgClosure* caf) * any more and can use it as a STATIC_LINK. */ ((StgIndStatic *)caf)->saved_info = NULL; - recordMutableGen(caf, oldest_gen); + recordMutableGen(caf, oldest_gen->no); } RELEASE_SM_LOCK; @@ -399,8 +411,7 @@ allocNursery (step *stp, bdescr *tail, nat blocks) if (tail != NULL) { tail->u.back = bd; } - bd->step = stp; - bd->gen_no = 0; + initBdescr(bd, stp); bd->flags = 0; bd->free = bd->start; tail = bd; @@ -427,7 +438,7 @@ assignNurseriesToCapabilities (void) #endif } -void +static void allocNurseries( void ) { nat i; @@ -537,6 +548,22 @@ resizeNurseries (nat blocks) 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 @@ -549,7 +576,7 @@ resizeNurseries (nat blocks) -------------------------------------------------------------------------- */ StgPtr -allocateInGen (generation *g, nat n) +allocateInGen (generation *g, lnat n) { step *stp; bdescr *bd; @@ -564,12 +591,27 @@ allocateInGen (generation *g, nat n) if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) { - nat req_blocks = (lnat)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE; + lnat req_blocks = (lnat)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE; + + // Attempting to allocate an object larger than maxHeapSize + // should definitely be disallowed. (bug #1791) + if (RtsFlags.GcFlags.maxHeapSize > 0 && + req_blocks >= RtsFlags.GcFlags.maxHeapSize) { + heapOverflow(); + // heapOverflow() doesn't exit (see #2592), but we aren't + // in a position to do a clean shutdown here: we + // either have to allocate the memory or exit now. + // Allocating the memory would be bad, because the user + // has requested that we not exceed maxHeapSize, so we + // just exit. + stg_exit(EXIT_HEAPOVERFLOW); + } + bd = allocGroup(req_blocks); dbl_link_onto(bd, &stp->large_objects); stp->n_large_blocks += bd->blocks; // might be larger than req_blocks - bd->gen_no = g->no; - bd->step = stp; + alloc_blocks += bd->blocks; + initBdescr(bd, stp); bd->flags = BF_LARGE; bd->free = bd->start + n; ret = bd->start; @@ -580,8 +622,7 @@ allocateInGen (generation *g, nat n) bd = stp->blocks; if (bd == NULL || bd->free + n > bd->start + BLOCK_SIZE_W) { bd = allocBlock(); - bd->gen_no = g->no; - bd->step = stp; + initBdescr(bd, stp); bd->flags = 0; bd->link = stp->blocks; stp->blocks = bd; @@ -598,7 +639,7 @@ allocateInGen (generation *g, nat n) } StgPtr -allocate (nat n) +allocate (lnat n) { return allocateInGen(g0,n); } @@ -617,6 +658,34 @@ allocatedBytes( void ) return allocated; } +// split N blocks off the front of the given bdescr, returning the +// 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; + initBdescr(new_bd, g0s0); + new_bd->flags = BF_LARGE; + new_bd->free = bd->free; + ASSERT(new_bd->free <= new_bd->start + new_bd->blocks * BLOCK_SIZE_W); + + // 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() @@ -631,7 +700,7 @@ allocatedBytes( void ) -------------------------------------------------------------------------- */ StgPtr -allocateLocal (Capability *cap, nat n) +allocateLocal (Capability *cap, lnat n) { bdescr *bd; StgPtr p; @@ -660,10 +729,13 @@ allocateLocal (Capability *cap, nat n) bd = allocBlock(); cap->r.rNursery->n_blocks++; RELEASE_SM_LOCK; - bd->gen_no = 0; - bd->step = cap->r.rNursery; + initBdescr(bd, cap->r.rNursery); bd->flags = 0; - alloc_blocks++; + // NO: alloc_blocks++; + // calcAllocated() uses the size of the nursery, and we've + // already bumpted nursery->n_blocks above. We'll GC + // pretty quickly now anyway, because MAYBE_GC() will + // notice that CurrentNursery->link is NULL. } else { // we have a block in the nursery: take it and put // it at the *front* of the nursery list, and use it @@ -706,7 +778,7 @@ allocateLocal (Capability *cap, nat n) ------------------------------------------------------------------------- */ StgPtr -allocatePinned( nat n ) +allocatePinned( lnat n ) { StgPtr p; bdescr *bd = pinned_object_block; @@ -714,7 +786,9 @@ allocatePinned( nat n ) // If the request is for a large object, then allocate() // will give us a pinned object anyway. if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) { - return allocate(n); + p = allocate(n); + Bdescr(p)->flags |= BF_PINNED; + return p; } ACQUIRE_SM_LOCK; @@ -722,21 +796,13 @@ allocatePinned( nat n ) TICK_ALLOC_HEAP_NOCTR(n); CCS_ALLOC(CCCS,n); - // we always return 8-byte aligned memory. bd->free must be - // 8-byte aligned to begin with, so we just round up n to - // the nearest multiple of 8 bytes. - if (sizeof(StgWord) == 4) { - n = (n+1) & ~1; - } - // If we don't have a block of pinned objects yet, or the current // one isn't large enough to hold the new object, allocate a new one. if (bd == NULL || (bd->free + n) > (bd->start + BLOCK_SIZE_W)) { pinned_object_block = bd = allocBlock(); dbl_link_onto(bd, &g0s0->large_objects); g0s0->n_large_blocks++; - bd->gen_no = 0; - bd->step = g0s0; + initBdescr(bd, g0s0); bd->flags = BF_PINNED | BF_LARGE; bd->free = bd->start; alloc_blocks++; @@ -770,6 +836,35 @@ dirty_MUT_VAR(StgRegTable *reg, StgClosure *p) } } +// 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->dirty == 0 && (tso->flags & 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->dirty == 0 && (tso->flags & TSO_LINK_DIRTY) == 0) { + bd = Bdescr((StgPtr)tso); + if (bd->gen_no > 0) recordMutableCap((StgClosure*)tso,cap,bd->gen_no); + } + tso->dirty = 1; +} + /* 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 @@ -788,61 +883,6 @@ dirty_MVAR(StgRegTable *reg, StgClosure *p) } /* ----------------------------------------------------------------------------- - Allocation functions for GMP. - - These all use the allocate() interface - we can't have any garbage - collection going on during a gmp operation, so we use allocate() - which always succeeds. The gmp operations which might need to - allocate will ask the storage manager (via doYouWantToGC()) whether - a garbage collection is required, in case we get into a loop doing - only allocate() style allocation. - -------------------------------------------------------------------------- */ - -static void * -stgAllocForGMP (size_t size_in_bytes) -{ - StgArrWords* arr; - nat data_size_in_words, total_size_in_words; - - /* round up to a whole number of words */ - data_size_in_words = (size_in_bytes + sizeof(W_) + 1) / sizeof(W_); - total_size_in_words = sizeofW(StgArrWords) + data_size_in_words; - - /* allocate and fill it in. */ -#if defined(THREADED_RTS) - arr = (StgArrWords *)allocateLocal(myTask()->cap, total_size_in_words); -#else - arr = (StgArrWords *)allocateLocal(&MainCapability, total_size_in_words); -#endif - SET_ARR_HDR(arr, &stg_ARR_WORDS_info, CCCS, data_size_in_words); - - /* and return a ptr to the goods inside the array */ - return arr->payload; -} - -static void * -stgReallocForGMP (void *ptr, size_t old_size, size_t new_size) -{ - void *new_stuff_ptr = stgAllocForGMP(new_size); - nat i = 0; - char *p = (char *) ptr; - char *q = (char *) new_stuff_ptr; - - for (; i < old_size; i++, p++, q++) { - *q = *p; - } - - return(new_stuff_ptr); -} - -static void -stgDeallocForGMP (void *ptr STG_UNUSED, - size_t size STG_UNUSED) -{ - /* easy for us: the garbage collector does the dealloc'n */ -} - -/* ----------------------------------------------------------------------------- * Stats and stuff * -------------------------------------------------------------------------- */ @@ -900,15 +940,15 @@ calcAllocated( void ) /* Approximate the amount of live data in the heap. To be called just * after garbage collection (see GarbageCollect()). */ -extern lnat -calcLive(void) +lnat +calcLiveBlocks(void) { nat g, s; lnat live = 0; step *stp; if (RtsFlags.GcFlags.generations == 1) { - return (g0s0->n_large_blocks + g0s0->n_blocks) * BLOCK_SIZE_W; + return g0s0->n_large_blocks + g0s0->n_blocks; } for (g = 0; g < RtsFlags.GcFlags.generations; g++) { @@ -920,12 +960,49 @@ calcLive(void) continue; } stp = &generations[g].steps[s]; - live += (stp->n_large_blocks + stp->n_blocks) * BLOCK_SIZE_W; + live += stp->n_large_blocks + stp->n_blocks; } } return live; } +lnat +countOccupied(bdescr *bd) +{ + lnat words; + + words = 0; + for (; bd != NULL; bd = bd->link) { + ASSERT(bd->free <= bd->start + bd->blocks * BLOCK_SIZE_W); + words += bd->free - bd->start; + } + return words; +} + +// Return an accurate count of the live data in the heap, excluding +// generation 0. +lnat +calcLiveWords(void) +{ + nat g, s; + lnat live; + step *stp; + + if (RtsFlags.GcFlags.generations == 1) { + 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++) { + if (g == 0 && s == 0) continue; + stp = &generations[g].steps[s]; + live += stp->n_words + countOccupied(stp->large_objects); + } + } + return live; +} + /* Approximate the number of blocks that will be needed at the next * garbage collection. * @@ -944,13 +1021,27 @@ calcNeeded(void) 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; - } else { - needed += stp->n_blocks; + + // we need at least this much space + needed += stp->n_blocks + stp->n_large_blocks; + + // any additional space needed to collect this gen next time? + if (g == 0 || // always collect gen 0 + (generations[g].steps[0].n_blocks + + generations[g].steps[0].n_large_blocks + > generations[g].max_blocks)) { + // we will collect this gen next time + if (stp->mark) { + // bitmap: + needed += stp->n_blocks / BITS_IN(W_); + // mark stack: + needed += stp->n_blocks / 100; + } + if (stp->compact) { + continue; // no additional space needed for compaction + } else { + needed += stp->n_blocks; + } } } } @@ -977,9 +1068,37 @@ calcNeeded(void) should be modified to use allocateExec instead of VirtualAlloc. ------------------------------------------------------------------------- */ -static bdescr *exec_block; +#if defined(linux_HOST_OS) + +// On Linux we need to use libffi for allocating executable memory, +// because it knows how to work around the restrictions put in place +// by SELinux. + +void *allocateExec (nat bytes, void **exec_ret) +{ + void **ret, **exec; + ACQUIRE_SM_LOCK; + ret = ffi_closure_alloc (sizeof(void *) + (size_t)bytes, (void**)&exec); + RELEASE_SM_LOCK; + if (ret == NULL) return ret; + *ret = ret; // save the address of the writable mapping, for freeExec(). + *exec_ret = exec + 1; + return (ret + 1); +} -void *allocateExec (nat bytes) +// freeExec gets passed the executable address, not the writable address. +void freeExec (void *addr) +{ + void *writable; + writable = *((void**)addr - 1); + ACQUIRE_SM_LOCK; + ffi_closure_free (writable); + RELEASE_SM_LOCK +} + +#else + +void *allocateExec (nat bytes, void **exec_ret) { void *ret; nat n; @@ -1015,6 +1134,7 @@ void *allocateExec (nat bytes) exec_block->free += n + 1; RELEASE_SM_LOCK + *exec_ret = ret; return ret; } @@ -1052,6 +1172,8 @@ void freeExec (void *addr) RELEASE_SM_LOCK } +#endif /* mingw32_HOST_OS */ + /* ----------------------------------------------------------------------------- Debugging @@ -1062,6 +1184,21 @@ void freeExec (void *addr) #ifdef DEBUG +// Useful for finding partially full blocks in gdb +void findSlop(bdescr *bd); +void findSlop(bdescr *bd) +{ + lnat slop; + + for (; bd != NULL; bd = bd->link) { + slop = (bd->blocks * BLOCK_SIZE_W) - (bd->free - bd->start); + if (slop > (1024/sizeof(W_))) { + debugBelch("block at %p (bdescr %p) has %ldKB slop\n", + bd->start, bd, slop / (1024/sizeof(W_))); + } + } +} + nat countBlocks(bdescr *bd) { @@ -1101,8 +1238,53 @@ stepBlocks (step *stp) countAllocdBlocks(stp->large_objects); } +// If memInventory() calculates that we have a memory leak, this +// function will try to find the block(s) that are leaking by marking +// all the ones that we know about, and search through memory to find +// blocks that are not marked. In the debugger this can help to give +// us a clue about what kind of block leaked. In the future we might +// annotate blocks with their allocation site to give more helpful +// info. +static void +findMemoryLeak (void) +{ + nat g, s, i; + for (g = 0; g < RtsFlags.GcFlags.generations; g++) { + for (i = 0; i < n_capabilities; i++) { + markBlocks(capabilities[i].mut_lists[g]); + } + markBlocks(generations[g].mut_list); + for (s = 0; s < generations[g].n_steps; s++) { + markBlocks(generations[g].steps[s].blocks); + markBlocks(generations[g].steps[s].large_objects); + } + } + + for (i = 0; i < n_nurseries; i++) { + markBlocks(nurseries[i].blocks); + markBlocks(nurseries[i].large_objects); + } + +#ifdef PROFILING + // TODO: + // if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER) { + // markRetainerBlocks(); + // } +#endif + + // count the blocks allocated by the arena allocator + // TODO: + // markArenaBlocks(); + + // count the blocks containing executable memory + markBlocks(exec_block); + + reportUnmarkedBlocks(); +} + + void -memInventory(void) +memInventory (rtsBool show) { nat g, s, i; step *stp; @@ -1110,6 +1292,7 @@ memInventory(void) lnat nursery_blocks, retainer_blocks, arena_blocks, exec_blocks; lnat live_blocks = 0, free_blocks = 0; + rtsBool leak; // count the blocks we current have @@ -1153,21 +1336,45 @@ memInventory(void) 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); } + + if (leak) { + debugBelch("\n"); + findMemoryLeak(); + } + ASSERT(n_alloc_blocks == live_blocks); + ASSERT(!leak); } @@ -1179,7 +1386,7 @@ checkSanity( void ) if (RtsFlags.GcFlags.generations == 1) { checkHeap(g0s0->blocks); - checkChain(g0s0->large_objects); + checkLargeObjects(g0s0->large_objects); } else { for (g = 0; g < RtsFlags.GcFlags.generations; g++) { @@ -1190,10 +1397,7 @@ checkSanity( void ) ASSERT(countBlocks(generations[g].steps[s].large_objects) == generations[g].steps[s].n_large_blocks); checkHeap(generations[g].steps[s].blocks); - checkChain(generations[g].steps[s].large_objects); - if (g > 0) { - checkMutableList(generations[g].mut_list, g); - } + checkLargeObjects(generations[g].steps[s].large_objects); } } @@ -1206,6 +1410,14 @@ checkSanity( void ) checkFreeListSanity(); } + +#if defined(THREADED_RTS) + // check the stacks too in threaded mode, because we don't do a + // full heap sanity check in this case (see checkHeap()) + checkMutableLists(rtsTrue); +#else + checkMutableLists(rtsFalse); +#endif } /* Nursery sanity check */