X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FStorage.c;h=0e25b4200a7cfca82afc4e7ba10abd522f0879b0;hb=1621421619df6f19dce3b8cb29471e5d3c731acb;hp=770b43a82219e57f247deaa7571b202b9f9071d6;hpb=95ca6bff6fc9918203173b442192d9298ef9757a;p=ghc-hetmet.git diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c index 770b43a..0e25b42 100644 --- a/ghc/rts/Storage.c +++ b/ghc/rts/Storage.c @@ -17,17 +17,18 @@ #include "Weak.h" #include "Sanity.h" #include "Arena.h" - +#include "OSThreads.h" +#include "Capability.h" #include "Storage.h" #include "Schedule.h" -#include "OSThreads.h" - #include "RetainerProfile.h" // for counting memory blocks (memInventory) #include #include StgClosure *caf_list = NULL; +StgClosure *revertible_caf_list = NULL; +rtsBool keepCAFs; bdescr *small_alloc_list; /* allocate()d small objects */ bdescr *pinned_object_block; /* allocate pinned objects into this block */ @@ -59,6 +60,18 @@ 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); +/* + * Storage manager mutex + */ +#if defined(SMP) +extern Mutex sm_mutex; +#define ACQUIRE_SM_LOCK ACQUIRE_LOCK(&sm_mutex) +#define RELEASE_SM_LOCK RELEASE_LOCK(&sm_mutex) +#else +#define ACQUIRE_SM_LOCK +#define RELEASE_SM_LOCK +#endif + void initStorage( void ) { @@ -106,8 +119,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; @@ -198,6 +210,7 @@ initStorage( void ) weak_ptr_list = NULL; caf_list = NULL; + revertible_caf_list = NULL; /* initialise the allocate() interface */ small_alloc_list = NULL; @@ -260,19 +273,37 @@ exitStorage (void) void newCAF(StgClosure* caf) { - /* Put this CAF on the mutable list for the old generation. - * This is a HACK - the IND_STATIC closure doesn't really have - * a mut_link field, but we pretend it has - in fact we re-use - * the STATIC_LINK field for the time being, because when we - * come to do a major GC we won't need the mut_link field - * any more and can use it as a STATIC_LINK. - */ ACQUIRE_SM_LOCK; - ((StgIndStatic *)caf)->saved_info = NULL; - ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list; - oldest_gen->mut_once_list = (StgMutClosure *)caf; - + if(keepCAFs) + { + // HACK: + // If we are in GHCi _and_ we are using dynamic libraries, + // then we can't redirect newCAF calls to newDynCAF (see below), + // so we make newCAF behave almost like newDynCAF. + // The dynamic libraries might be used by both the interpreted + // program and GHCi itself, so they must not be reverted. + // This also means that in GHCi with dynamic libraries, CAFs are not + // garbage collected. If this turns out to be a problem, we could + // do another hack here and do an address range test on caf to figure + // out whether it is from a dynamic library. + ((StgIndStatic *)caf)->saved_info = (StgInfoTable *)caf->header.info; + ((StgIndStatic *)caf)->static_link = caf_list; + caf_list = caf; + } + else + { + /* Put this CAF on the mutable list for the old generation. + * This is a HACK - the IND_STATIC closure doesn't really have + * a mut_link field, but we pretend it has - in fact we re-use + * the STATIC_LINK field for the time being, because when we + * come to do a major GC we won't need the mut_link field + * any more and can use it as a STATIC_LINK. + */ + ((StgIndStatic *)caf)->saved_info = NULL; + recordMutableGen(caf, oldest_gen); + } + RELEASE_SM_LOCK; #ifdef PAR @@ -289,6 +320,8 @@ newCAF(StgClosure* caf) // 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. +// Also, GHCi might want to revert CAFs, so we add these to the +// revertible_caf_list. // // The linker hackily arranges that references to newCaf from dynamic // code end up pointing to newDynCAF. @@ -298,8 +331,8 @@ newDynCAF(StgClosure *caf) ACQUIRE_SM_LOCK; ((StgIndStatic *)caf)->saved_info = (StgInfoTable *)caf->header.info; - ((StgIndStatic *)caf)->static_link = caf_list; - caf_list = caf; + ((StgIndStatic *)caf)->static_link = revertible_caf_list; + revertible_caf_list = caf; RELEASE_SM_LOCK; } @@ -313,19 +346,12 @@ 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; - /* 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); @@ -346,7 +372,7 @@ resetNurseries( void ) Capability *cap; /* All tasks must be stopped */ - ASSERT(n_free_capabilities == RtsFlags.ParFlags.nNodes); + ASSERT(rts_n_free_capabilities == RtsFlags.ParFlags.nNodes); for (cap = free_capabilities; cap != NULL; cap = cap->link) { for (bd = cap->r.rNursery; bd; bd = bd->link) { @@ -673,7 +699,7 @@ calcAllocated( void ) /* ASSERT(n_free_capabilities == RtsFlags.ParFlags.nNodes); */ allocated = - n_free_capabilities * RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W + rts_n_free_capabilities * RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W + allocated_bytes(); for (cap = free_capabilities; cap != NULL; cap = cap->link) { @@ -791,25 +817,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() */ @@ -872,7 +901,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); } } }