X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FStorage.c;h=367530fcb6a0467b109b9e891b0cc49769e0196b;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=f492931309e83413a2bd09f23da885395d205be2;hpb=0d365572037bf986630c81ee8c64640e1e451501;p=ghc-hetmet.git diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c index f492931..367530f 100644 --- a/ghc/rts/Storage.c +++ b/ghc/rts/Storage.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Storage.c,v 1.62 2002/04/23 11:21:39 simonmar Exp $ + * $Id: Storage.c,v 1.84 2004/08/13 13:11:01 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -22,30 +22,15 @@ #include "Storage.h" #include "Schedule.h" #include "OSThreads.h" -#include "StoragePriv.h" #include "RetainerProfile.h" // for counting memory blocks (memInventory) -#ifdef darwin_TARGET_OS -#include -unsigned long macho_etext = 0; -unsigned long macho_edata = 0; - -static void macosx_get_memory_layout(void) -{ - struct segment_command *seg; - - seg = getsegbyname("__TEXT"); - macho_etext = seg->vmaddr + seg->vmsize; - seg = getsegbyname("__DATA"); - macho_edata = seg->vmaddr + seg->vmsize; -} -#endif +#include +#include StgClosure *caf_list = NULL; bdescr *small_alloc_list; /* allocate()d small objects */ -bdescr *large_alloc_list; /* allocate()d large objects */ 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 */ @@ -53,12 +38,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 @@ -82,30 +67,18 @@ initStorage( void ) step *stp; generation *gen; -#if defined(darwin_TARGET_OS) - macosx_get_memory_layout(); -#endif - - /* Sanity check to make sure we are able to make the distinction - * between closures and infotables - */ - if (!LOOKS_LIKE_GHC_INFO(&stg_BLACKHOLE_info)) { - barf("LOOKS_LIKE_GHC_INFO+ is incorrectly defined"); - exit(0); - } - if (LOOKS_LIKE_GHC_INFO(&stg_dummy_ret_closure)) { - barf("LOOKS_LIKE_GHC_INFO- is incorrectly defined"); - exit(0); - } - if (LOOKS_LIKE_STATIC_CLOSURE(&stg_BLACKHOLE_info)) { - barf("LOOKS_LIKE_STATIC_CLOSURE- is incorrectly defined"); - exit(0); - } - if (!LOOKS_LIKE_STATIC_CLOSURE(&stg_dummy_ret_closure)) { - barf("LOOKS_LIKE_STATIC_CLOSURE+ is incorrectly defined"); - exit(0); + 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) { @@ -122,7 +95,7 @@ initStorage( void ) initBlockAllocator(); #if defined(SMP) - initCondition(&sm_mutex); + initMutex(&sm_mutex); #endif /* allocate generation info array */ @@ -174,6 +147,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; @@ -228,17 +202,12 @@ initStorage( void ) /* initialise the allocate() interface */ small_alloc_list = NULL; - large_alloc_list = NULL; 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); -#if defined(SMP) - initMutex(&sm_mutex); -#endif - IF_DEBUG(gc, statDescribeGens()); } @@ -301,15 +270,9 @@ newCAF(StgClosure* caf) */ ACQUIRE_SM_LOCK; - if (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; + ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list; + oldest_gen->mut_once_list = (StgMutClosure *)caf; RELEASE_SM_LOCK; @@ -323,6 +286,25 @@ newCAF(StgClosure* caf) #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. -------------------------------------------------------------------------- */ @@ -331,22 +313,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); @@ -494,15 +474,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; @@ -532,7 +508,25 @@ allocate( nat n ) lnat allocated_bytes( void ) { - return (alloc_blocks * BLOCK_SIZE_W - (alloc_HpLim - alloc_Hp)); + lnat allocated; + + allocated = alloc_blocks * BLOCK_SIZE_W - (alloc_HpLim - alloc_Hp); + if (pinned_object_block != NULL) { + allocated -= (pinned_object_block->start + BLOCK_SIZE_W) - + pinned_object_block->free; + } + + return allocated; +} + +void +tidyAllocateLists (void) +{ + if (small_alloc_list != NULL) { + ASSERT(alloc_Hp >= small_alloc_list->start && + alloc_Hp <= small_alloc_list->start + BLOCK_SIZE); + small_alloc_list->free = alloc_Hp; + } } /* --------------------------------------------------------------------------- @@ -564,23 +558,23 @@ 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. - ASSERT(((StgWord)bd->free & 7) == 0); - n = (n+7) & ~8; + 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. @@ -589,7 +583,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++; } @@ -617,10 +611,8 @@ stgAllocForGMP (size_t size_in_bytes) StgArrWords* arr; nat data_size_in_words, total_size_in_words; - /* should be a multiple of sizeof(StgWord) (whole no. of limbs) */ - ASSERT(size_in_bytes % sizeof(W_) == 0); - - data_size_in_words = size_in_bytes / sizeof(W_); + /* 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. */ @@ -628,7 +620,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 * @@ -825,14 +817,10 @@ memInventory(void) for (bd = small_alloc_list; bd; bd = bd->link) { total_blocks += bd->blocks; } - for (bd = large_alloc_list; bd; bd = bd->link) { - total_blocks += bd->blocks; - } #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