X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FStorage.c;h=eb9e98960d2fb9b6d7a8f52fe645faf4fbad70f7;hb=e95a551db710952fd25736055ea889eb8d65141a;hp=51e1fb071f9f04e0aa0d41d459ab3ed74883af4f;hpb=45936dbd56b8bb846e14d8f38ef8153ec91a3457;p=ghc-hetmet.git diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c index 51e1fb0..eb9e989 100644 --- a/ghc/rts/Storage.c +++ b/ghc/rts/Storage.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Storage.c,v 1.30 2000/12/11 12:37:00 simonmar Exp $ + * $Id: Storage.c,v 1.35 2001/01/31 11:04:29 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -61,7 +61,7 @@ void initStorage (void) { nat g, s; - step *step; + step *stp; generation *gen; /* If we're doing heap profiling, we want a two-space heap with a @@ -130,19 +130,19 @@ initStorage (void) /* Initialise all steps */ for (g = 0; g < RtsFlags.GcFlags.generations; g++) { for (s = 0; s < generations[g].n_steps; s++) { - step = &generations[g].steps[s]; - step->no = s; - step->blocks = NULL; - step->n_blocks = 0; - step->gen = &generations[g]; - step->hp = NULL; - step->hpLim = NULL; - step->hp_bd = NULL; - step->scan = NULL; - step->scan_bd = NULL; - step->large_objects = NULL; - step->new_large_objects = NULL; - step->scavenged_large_objects = NULL; + stp = &generations[g].steps[s]; + stp->no = s; + stp->blocks = NULL; + stp->n_blocks = 0; + stp->gen = &generations[g]; + stp->hp = NULL; + stp->hpLim = NULL; + stp->hp_bd = NULL; + stp->scan = NULL; + stp->scan_bd = NULL; + stp->large_objects = NULL; + stp->new_large_objects = NULL; + stp->scavenged_large_objects = NULL; } } @@ -197,22 +197,44 @@ exitStorage (void) } /* ----------------------------------------------------------------------------- - Setting the heap size. This function is callable from Haskell (GHC - uses it to implement the -H option). - -------------------------------------------------------------------------- */ + CAF management. -void -setHeapSize( HsInt size ) -{ - RtsFlags.GcFlags.heapSizeSuggestion = size / BLOCK_SIZE; - if (RtsFlags.GcFlags.heapSizeSuggestion > - RtsFlags.GcFlags.maxHeapSize) { - RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion; - } -} + The entry code for every CAF does the following: + + - builds a CAF_BLACKHOLE in the heap + - pushes an update frame pointing to the CAF_BLACKHOLE + - invokes UPD_CAF(), which: + - calls newCaf, below + - updates the CAF with a static indirection to the CAF_BLACKHOLE + + Why do we build a BLACKHOLE in the heap rather than just updating + the thunk directly? It's so that we only need one kind of update + frame - otherwise we'd need a static version of the update frame too. + + newCaf() does the following: + + - it puts the CAF on the oldest generation's mut-once list. + This is so that we can treat the CAF as a root when collecting + younger generations. + + For GHCI, we have additional requirements when dealing with CAFs: + + - we must *retain* all dynamically-loaded CAFs ever entered, + just in case we need them again. + - we must be able to *revert* CAFs that have been evaluated, to + their pre-evaluated form. + + To do this, we use an additional CAF list. When newCaf() is + called on a dynamically-loaded CAF, we add it to the CAF list + instead of the old-generation mutable list, and save away its + old info pointer (in caf->saved_info) for later reversion. + + To revert all the CAFs, we traverse the CAF list and reset the + info pointer to caf->saved_info, then throw away the CAF list. + (see GC.c:revertCAFs()). + + -- SDM 29/1/01 -/* ----------------------------------------------------------------------------- - CAF management. -------------------------------------------------------------------------- */ void @@ -227,77 +249,25 @@ newCAF(StgClosure* caf) */ ACQUIRE_LOCK(&sm_mutex); +#ifdef GHCI + 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; + } +#else ASSERT( ((StgMutClosure*)caf)->mut_link == NULL ); ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list; oldest_gen->mut_once_list = (StgMutClosure *)caf; - -#ifdef INTERPRETER - /* If we're Hugs, we also have to put it in the CAF table, so that - the CAF can be reverted. When reverting, CAFs created by compiled - code are recorded in the CAF table, which lives outside the - heap, in mallocville. CAFs created by interpreted code are - chained together via the link fields in StgCAFs, and are not - recorded in the CAF table. - */ - ASSERT( get_itbl(caf)->type == THUNK_STATIC ); - addToECafTable ( caf, get_itbl(caf) ); #endif RELEASE_LOCK(&sm_mutex); } -#ifdef INTERPRETER -void -newCAF_made_by_Hugs(StgCAF* caf) -{ - ACQUIRE_LOCK(&sm_mutex); - - ASSERT( get_itbl(caf)->type == CAF_ENTERED ); - recordOldToNewPtrs((StgMutClosure*)caf); - caf->link = ecafList; - ecafList = caf->link; - - RELEASE_LOCK(&sm_mutex); -} -#endif - -#ifdef INTERPRETER -/* These initialisations are critical for correct operation - on the first call of addToECafTable. -*/ -StgCAF* ecafList = END_ECAF_LIST; -StgCAFTabEntry* ecafTable = NULL; -StgInt usedECafTable = 0; -StgInt sizeECafTable = 0; - - -void clearECafTable ( void ) -{ - usedECafTable = 0; -} - -void addToECafTable ( StgClosure* closure, StgInfoTable* origItbl ) -{ - StgInt i; - StgCAFTabEntry* et2; - if (usedECafTable == sizeECafTable) { - /* Make the initial table size be 8 */ - sizeECafTable *= 2; - if (sizeECafTable == 0) sizeECafTable = 8; - et2 = stgMallocBytes ( - sizeECafTable * sizeof(StgCAFTabEntry), - "addToECafTable" ); - for (i = 0; i < usedECafTable; i++) - et2[i] = ecafTable[i]; - if (ecafTable) free(ecafTable); - ecafTable = et2; - } - ecafTable[usedECafTable].closure = closure; - ecafTable[usedECafTable].origItbl = origItbl; - usedECafTable++; -} -#endif - /* ----------------------------------------------------------------------------- Nursery management. -------------------------------------------------------------------------- */ @@ -606,7 +576,7 @@ calcLive(void) { nat g, s; lnat live = 0; - step *step; + step *stp; if (RtsFlags.GcFlags.generations == 1) { live = (g0s0->to_blocks - 1) * BLOCK_SIZE_W + @@ -622,9 +592,9 @@ calcLive(void) if (g == 0 && s == 0) { continue; } - step = &generations[g].steps[s]; - live += (step->n_blocks - 1) * BLOCK_SIZE_W + - ((lnat)step->hp_bd->free - (lnat)step->hp_bd->start) / sizeof(W_); + stp = &generations[g].steps[s]; + live += (stp->n_blocks - 1) * BLOCK_SIZE_W + + ((lnat)stp->hp_bd->free - (lnat)stp->hp_bd->start) / sizeof(W_); } } return live; @@ -642,16 +612,16 @@ calcNeeded(void) { lnat needed = 0; nat g, s; - step *step; + step *stp; for (g = 0; g < RtsFlags.GcFlags.generations; g++) { for (s = 0; s < generations[g].n_steps; s++) { if (g == 0 && s == 0) { continue; } - step = &generations[g].steps[s]; + stp = &generations[g].steps[s]; if (generations[g].steps[0].n_blocks > generations[g].max_blocks) { - needed += 2 * step->n_blocks; + needed += 2 * stp->n_blocks; } else { - needed += step->n_blocks; + needed += stp->n_blocks; } } } @@ -672,7 +642,7 @@ extern void memInventory(void) { nat g, s; - step *step; + step *stp; bdescr *bd; lnat total_blocks = 0, free_blocks = 0; @@ -680,13 +650,13 @@ memInventory(void) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { for (s = 0; s < generations[g].n_steps; s++) { - step = &generations[g].steps[s]; - total_blocks += step->n_blocks; + 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->to_blocks; } - for (bd = step->large_objects; bd; bd = bd->link) { + 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