X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FStorage.c;h=974c075b955938690bdfffe8956de0dfe00bb26e;hb=e7c3f957fd36fd9f6369183b7a31e2a4a4c21b43;hp=f20ea5c643d4e8e87ccd73ea8cb734d9059fb28c;hpb=419f4bd4911d69fa06caec179068838f16c65431;p=ghc-hetmet.git diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c index f20ea5c..974c075 100644 --- a/ghc/rts/Storage.c +++ b/ghc/rts/Storage.c @@ -1,7 +1,6 @@ /* ----------------------------------------------------------------------------- - * $Id: Storage.c,v 1.72 2002/12/13 19:17:02 wolfgang Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2004 * * Storage manager front end * @@ -22,7 +21,6 @@ #include "Storage.h" #include "Schedule.h" #include "OSThreads.h" -#include "StoragePriv.h" #include "RetainerProfile.h" // for counting memory blocks (memInventory) @@ -39,12 +37,12 @@ nat alloc_blocks_lim; /* approximate limit on alloc_blocks */ StgPtr alloc_Hp = NULL; /* next free byte in small_alloc_list */ StgPtr alloc_HpLim = NULL; /* end of block at small_alloc_list */ -generation *generations; /* all the generations */ -generation *g0; /* generation 0, for convenience */ -generation *oldest_gen; /* oldest generation, for convenience */ -step *g0s0; /* generation 0, step 0, for convenience */ +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 */ -lnat total_allocated = 0; /* total memory allocated during run */ +ullong total_allocated = 0; /* total memory allocated during run */ /* * Storage manager mutex: protects all the above state from @@ -68,13 +66,18 @@ initStorage( void ) step *stp; generation *gen; - /* Sanity check to make sure the LOOKS_LIKE_ macros appear to be - * doing something reasonable. - */ - ASSERT(LOOKS_LIKE_INFO_PTR(&stg_BLACKHOLE_info)); - ASSERT(LOOKS_LIKE_CLOSURE_PTR(&stg_dummy_ret_closure)); - ASSERT(!HEAP_ALLOCED(&stg_dummy_ret_closure)); + if (generations != NULL) { + // multi-init protection + return; + } + /* Sanity check to make sure the LOOKS_LIKE_ macros appear to be + * doing something reasonable. + */ + ASSERT(LOOKS_LIKE_INFO_PTR(&stg_BLACKHOLE_info)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(&stg_dummy_ret_closure)); + ASSERT(!HEAP_ALLOCED(&stg_dummy_ret_closure)); + if (RtsFlags.GcFlags.maxHeapSize != 0 && RtsFlags.GcFlags.heapSizeSuggestion > RtsFlags.GcFlags.maxHeapSize) { @@ -84,14 +87,14 @@ initStorage( void ) if (RtsFlags.GcFlags.maxHeapSize != 0 && RtsFlags.GcFlags.minAllocAreaSize > RtsFlags.GcFlags.maxHeapSize) { - prog_belch("maximum heap size (-M) is smaller than minimum alloc area size (-A)"); + errorBelch("maximum heap size (-M) is smaller than minimum alloc area size (-A)"); exit(1); } initBlockAllocator(); #if defined(SMP) - initCondition(&sm_mutex); + initMutex(&sm_mutex); #endif /* allocate generation info array */ @@ -103,8 +106,7 @@ initStorage( void ) for(g = 0; g < RtsFlags.GcFlags.generations; g++) { gen = &generations[g]; gen->no = g; - gen->mut_list = END_MUT_LIST; - gen->mut_once_list = END_MUT_LIST; + gen->mut_list = allocBlock(); gen->collections = 0; gen->failed_promotions = 0; gen->max_blocks = 0; @@ -143,6 +145,7 @@ initStorage( void ) stp = &generations[g].steps[s]; stp->no = s; stp->blocks = NULL; + stp->n_to_blocks = 0; stp->n_blocks = 0; stp->gen = &generations[g]; stp->gen_no = g; @@ -172,7 +175,7 @@ initStorage( void ) /* The oldest generation has one step and it is compacted. */ if (RtsFlags.GcFlags.compact) { if (RtsFlags.GcFlags.generations == 1) { - belch("WARNING: compaction is incompatible with -G1; disabled"); + errorBelch("WARNING: compaction is incompatible with -G1; disabled"); } else { oldest_gen->steps[0].is_compacted = 1; } @@ -203,10 +206,6 @@ initStorage( void ) /* Tell GNU multi-precision pkg about our custom alloc functions */ mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP); -#if defined(SMP) - initMutex(&sm_mutex); -#endif - IF_DEBUG(gc, statDescribeGens()); } @@ -269,28 +268,41 @@ newCAF(StgClosure* caf) */ ACQUIRE_SM_LOCK; - if (0 /*TODO: is_dynamically_loaded_rwdata_ptr((StgPtr)caf)*/) { - ((StgIndStatic *)caf)->saved_info = (StgInfoTable *)caf->header.info; - ((StgIndStatic *)caf)->static_link = caf_list; - caf_list = caf; - } else { - ((StgIndStatic *)caf)->saved_info = NULL; - ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list; - oldest_gen->mut_once_list = (StgMutClosure *)caf; - } + ((StgIndStatic *)caf)->saved_info = NULL; + + recordMutableGen(caf, oldest_gen); RELEASE_SM_LOCK; #ifdef PAR /* If we are PAR or DIST then we never forget a CAF */ { globalAddr *newGA; - //belch("<##> Globalising CAF %08x %s",caf,info_type(caf)); + //debugBelch("<##> Globalising CAF %08x %s",caf,info_type(caf)); newGA=makeGlobal(caf,rtsTrue); /*given full weight*/ ASSERT(newGA); } #endif /* PAR */ } +// An alternate version of newCaf which is used for dynamically loaded +// object code in GHCi. In this case we want to retain *all* CAFs in +// the object code, because they might be demanded at any time from an +// expression evaluated on the command line. +// +// The linker hackily arranges that references to newCaf from dynamic +// code end up pointing to newDynCAF. +void +newDynCAF(StgClosure *caf) +{ + ACQUIRE_SM_LOCK; + + ((StgIndStatic *)caf)->saved_info = (StgInfoTable *)caf->header.info; + ((StgIndStatic *)caf)->static_link = caf_list; + caf_list = caf; + + RELEASE_SM_LOCK; +} + /* ----------------------------------------------------------------------------- Nursery management. -------------------------------------------------------------------------- */ @@ -299,22 +311,20 @@ void allocNurseries( void ) { #ifdef SMP - { - Capability *cap; - bdescr *bd; - - g0s0->blocks = NULL; - g0s0->n_blocks = 0; - for (cap = free_capabilities; cap != NULL; cap = cap->link) { - cap->r.rNursery = allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize); - cap->r.rCurrentNursery = cap->r.rNursery; - for (bd = cap->r.rNursery; bd != NULL; bd = bd->link) { - bd->u.back = (bdescr *)cap; - } - } + Capability *cap; + bdescr *bd; + + g0s0->blocks = NULL; + g0s0->n_blocks = 0; + for (cap = free_capabilities; cap != NULL; cap = cap->link) { + cap->r.rNursery = allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize); + cap->r.rCurrentNursery = cap->r.rNursery; /* Set the back links to be equal to the Capability, * so we can do slightly better informed locking. */ + for (bd = cap->r.rNursery; bd != NULL; bd = bd->link) { + bd->u.back = (bdescr *)cap; + } } #else /* SMP */ g0s0->blocks = allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize); @@ -406,7 +416,7 @@ resizeNursery ( nat blocks ) } else if (nursery_blocks < blocks) { - IF_DEBUG(gc, fprintf(stderr, "Increasing size of nursery to %d blocks\n", + IF_DEBUG(gc, debugBelch("Increasing size of nursery to %d blocks\n", blocks)); g0s0->blocks = allocNursery(g0s0->blocks, blocks-nursery_blocks); } @@ -414,7 +424,7 @@ resizeNursery ( nat blocks ) else { bdescr *next_bd; - IF_DEBUG(gc, fprintf(stderr, "Decreasing size of nursery to %d blocks\n", + IF_DEBUG(gc, debugBelch("Decreasing size of nursery to %d blocks\n", blocks)); bd = g0s0->blocks; @@ -462,15 +472,11 @@ allocate( nat n ) nat req_blocks = (lnat)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE; bd = allocGroup(req_blocks); dbl_link_onto(bd, &g0s0->large_objects); + g0s0->n_large_blocks += req_blocks; bd->gen_no = 0; bd->step = g0s0; bd->flags = BF_LARGE; - bd->free = bd->start; - /* don't add these blocks to alloc_blocks, since we're assuming - * that large objects are likely to remain live for quite a while - * (eg. running threads), so garbage collecting early won't make - * much difference. - */ + bd->free = bd->start + n; alloc_blocks += req_blocks; RELEASE_SM_LOCK; return bd->start; @@ -550,18 +556,17 @@ allocatePinned( nat n ) StgPtr p; bdescr *bd = pinned_object_block; - ACQUIRE_SM_LOCK; - - TICK_ALLOC_HEAP_NOCTR(n); - CCS_ALLOC(CCCS,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_)) { - RELEASE_SM_LOCK; return allocate(n); } + ACQUIRE_SM_LOCK; + + 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. @@ -576,7 +581,7 @@ allocatePinned( nat n ) dbl_link_onto(bd, &g0s0->large_objects); bd->gen_no = 0; bd->step = g0s0; - bd->flags = BF_LARGE; + bd->flags = BF_PINNED | BF_LARGE; bd->free = bd->start; alloc_blocks++; } @@ -613,7 +618,7 @@ stgAllocForGMP (size_t size_in_bytes) SET_ARR_HDR(arr, &stg_ARR_WORDS_info, CCCS, data_size_in_words); /* and return a ptr to the goods inside the array */ - return(BYTE_ARR_CTS(arr)); + return arr->payload; } static void * @@ -785,25 +790,28 @@ memInventory(void) /* count the blocks we current have */ for (g = 0; g < RtsFlags.GcFlags.generations; g++) { - for (s = 0; s < generations[g].n_steps; s++) { - stp = &generations[g].steps[s]; - total_blocks += stp->n_blocks; - if (RtsFlags.GcFlags.generations == 1) { - /* two-space collector has a to-space too :-) */ - total_blocks += g0s0->n_to_blocks; + for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) { + total_blocks += bd->blocks; } - for (bd = stp->large_objects; bd; bd = bd->link) { - total_blocks += bd->blocks; - /* hack for megablock groups: they have an extra block or two in - the second and subsequent megablocks where the block - descriptors would normally go. - */ - if (bd->blocks > BLOCKS_PER_MBLOCK) { - total_blocks -= (MBLOCK_SIZE / BLOCK_SIZE - BLOCKS_PER_MBLOCK) - * (bd->blocks/(MBLOCK_SIZE/BLOCK_SIZE)); - } + for (s = 0; s < generations[g].n_steps; s++) { + stp = &generations[g].steps[s]; + total_blocks += stp->n_blocks; + if (RtsFlags.GcFlags.generations == 1) { + /* two-space collector has a to-space too :-) */ + total_blocks += g0s0->n_to_blocks; + } + for (bd = stp->large_objects; bd; bd = bd->link) { + total_blocks += bd->blocks; + /* hack for megablock groups: they have an extra block or two in + the second and subsequent megablocks where the block + descriptors would normally go. + */ + if (bd->blocks > BLOCKS_PER_MBLOCK) { + total_blocks -= (MBLOCK_SIZE / BLOCK_SIZE - BLOCKS_PER_MBLOCK) + * (bd->blocks/(MBLOCK_SIZE/BLOCK_SIZE)); + } + } } - } } /* any blocks held by allocate() */ @@ -813,8 +821,7 @@ memInventory(void) #ifdef PROFILING if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER) { - for (bd = firstStack; bd != NULL; bd = bd->link) - total_blocks += bd->blocks; + total_blocks += retainerStackBlocks(); } #endif @@ -826,7 +833,7 @@ memInventory(void) if (total_blocks + free_blocks != mblocks_allocated * BLOCKS_PER_MBLOCK) { - fprintf(stderr, "Blocks: %ld live + %ld free = %ld total (%ld around)\n", + debugBelch("Blocks: %ld live + %ld free = %ld total (%ld around)\n", total_blocks, free_blocks, total_blocks + free_blocks, mblocks_allocated * BLOCKS_PER_MBLOCK); } @@ -867,7 +874,6 @@ checkSanity( void ) checkChain(generations[g].steps[s].large_objects); if (g > 0) { checkMutableList(generations[g].mut_list, g); - checkMutOnceList(generations[g].mut_once_list, g); } } }