X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FStorage.c;h=367530fcb6a0467b109b9e891b0cc49769e0196b;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=5a015d94092b2f5f0d9ac4a2257e4366d56d53ee;hpb=b2421c0cbb75a9dfeabd7030cd0dcb8af7f7ee73;p=ghc-hetmet.git diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c index 5a015d9..367530f 100644 --- a/ghc/rts/Storage.c +++ b/ghc/rts/Storage.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Storage.c,v 1.68 2002/08/16 13:20:36 simonmar Exp $ + * $Id: Storage.c,v 1.84 2004/08/13 13:11:01 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -22,29 +22,12 @@ #include "Storage.h" #include "Schedule.h" #include "OSThreads.h" -#include "StoragePriv.h" #include "RetainerProfile.h" // for counting memory blocks (memInventory) #include #include -#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 - StgClosure *caf_list = NULL; bdescr *small_alloc_list; /* allocate()d small objects */ @@ -55,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 @@ -84,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) { @@ -124,7 +95,7 @@ initStorage( void ) initBlockAllocator(); #if defined(SMP) - initCondition(&sm_mutex); + initMutex(&sm_mutex); #endif /* allocate generation info array */ @@ -176,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; @@ -236,10 +208,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()); } @@ -302,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; @@ -324,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. -------------------------------------------------------------------------- */ @@ -332,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); @@ -495,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; @@ -533,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; + } } /* --------------------------------------------------------------------------- @@ -565,18 +558,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. @@ -591,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++; } @@ -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 * @@ -828,8 +820,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