X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FStorage.h;fp=ghc%2Frts%2FStorage.h;h=861cbeb4342f75cf71bf9e4777a4685ac0f404a1;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=fb84740f08eb6ae3b107c9fea45c6e6aae90b87c;hpb=553e90d9a32ee1b1809430f260c401cc4169c6c7;p=ghc-hetmet.git diff --git a/ghc/rts/Storage.h b/ghc/includes/Storage.h similarity index 54% rename from ghc/rts/Storage.h rename to ghc/includes/Storage.h index fb84740..861cbeb 100644 --- a/ghc/rts/Storage.h +++ b/ghc/includes/Storage.h @@ -1,7 +1,6 @@ /* ----------------------------------------------------------------------------- - * $Id: Storage.h,v 1.53 2003/11/12 17:49:11 sof Exp $ * - * (c) The GHC Team, 1998-2002 + * (c) The GHC Team, 1998-2004 * * External Storage Manger Interface * @@ -10,13 +9,93 @@ #ifndef STORAGE_H #define STORAGE_H -#include "Block.h" -#include "MBlock.h" -#include "BlockAlloc.h" -#include "StoragePriv.h" -#ifdef PROFILING -#include "LdvProfile.h" -#endif +#include + +/* ----------------------------------------------------------------------------- + * Generational GC + * + * We support an arbitrary number of generations, with an arbitrary number + * of steps per generation. Notes (in no particular order): + * + * - all generations except the oldest should have two steps. This gives + * objects a decent chance to age before being promoted, and in + * particular will ensure that we don't end up with too many + * thunks being updated in older generations. + * + * - the oldest generation has one step. There's no point in aging + * objects in the oldest generation. + * + * - generation 0, step 0 (G0S0) is the allocation area. It is given + * a fixed set of blocks during initialisation, and these blocks + * are never freed. + * + * - during garbage collection, each step which is an evacuation + * destination (i.e. all steps except G0S0) is allocated a to-space. + * evacuated objects are allocated into the step's to-space until + * GC is finished, when the original step's contents may be freed + * and replaced by the to-space. + * + * - the mutable-list is per-generation (not per-step). G0 doesn't + * have one (since every garbage collection collects at least G0). + * + * - block descriptors contain pointers to both the step and the + * generation that the block belongs to, for convenience. + * + * - static objects are stored in per-generation lists. See GC.c for + * details of how we collect CAFs in the generational scheme. + * + * - large objects are per-step, and are promoted in the same way + * as small objects, except that we may allocate large objects into + * generation 1 initially. + * + * ------------------------------------------------------------------------- */ + +typedef struct _step { + unsigned int no; /* step number */ + bdescr * blocks; /* blocks in this step */ + unsigned int n_blocks; /* number of blocks */ + struct _step * to; /* destination step for live objects */ + struct _generation * gen; /* generation this step belongs to */ + unsigned int gen_no; /* generation number (cached) */ + bdescr * large_objects; /* large objects (doubly linked) */ + unsigned int n_large_blocks; /* no. of blocks used by large objs */ + int is_compacted; /* compact this step? (old gen only) */ + + /* temporary use during GC: */ + StgPtr hp; /* next free locn in to-space */ + StgPtr hpLim; /* end of current to-space block */ + bdescr * hp_bd; /* bdescr of current to-space block */ + bdescr * to_blocks; /* bdescr of first to-space block */ + unsigned int n_to_blocks; /* number of blocks in to-space */ + bdescr * scan_bd; /* block currently being scanned */ + StgPtr scan; /* scan pointer in current block */ + bdescr * new_large_objects; /* large objects collected so far */ + bdescr * scavenged_large_objects; /* live large objs after GC (d-link) */ + unsigned int n_scavenged_large_blocks;/* size of above */ + bdescr * bitmap; /* bitmap for compacting collection */ +} step; + +typedef struct _generation { + unsigned int no; /* generation number */ + step * steps; /* steps */ + unsigned int n_steps; /* number of steps */ + unsigned int max_blocks; /* max blocks in step 0 */ + StgMutClosure *mut_list; /* mut objects in this gen (not G0)*/ + StgMutClosure *mut_once_list; /* objects that point to younger gens */ + + /* temporary use during GC: */ + StgMutClosure * saved_mut_list; + + /* stats information */ + unsigned int collections; + unsigned int failed_promotions; +} generation; + +extern generation * RTS_VAR(generations); + +extern generation * RTS_VAR(g0); +extern step * RTS_VAR(g0s0); +extern generation * RTS_VAR(oldest_gen); /* ----------------------------------------------------------------------------- Initialisation / De-initialisation @@ -63,6 +142,16 @@ extern StgPtr allocate ( nat n ); extern StgPtr allocatePinned ( nat n ); extern lnat allocated_bytes ( void ); +extern bdescr * RTS_VAR(small_alloc_list); +extern bdescr * RTS_VAR(large_alloc_list); +extern bdescr * RTS_VAR(pinned_object_block); + +extern StgPtr RTS_VAR(alloc_Hp); +extern StgPtr RTS_VAR(alloc_HpLim); + +extern nat RTS_VAR(alloc_blocks); +extern nat RTS_VAR(alloc_blocks_lim); + INLINE_HEADER rtsBool doYouWantToGC( void ) { @@ -70,21 +159,6 @@ doYouWantToGC( void ) } /* ----------------------------------------------------------------------------- - ExtendNursery(hp,hplim) When hplim is reached, try to grab - some more allocation space. Returns - False if the allocation space is - exhausted, and the application should - call GarbageCollect(). - -------------------------------------------------------------------------- */ - -#define ExtendNursery(hp,hplim) \ - (CloseNursery(hp), \ - CurrentNursery->link == NULL ? rtsFalse : \ - (CurrentNursery = CurrentNursery->link, \ - OpenNursery(hp,hplim), \ - rtsTrue)) - -/* ----------------------------------------------------------------------------- Performing Garbage Collection GarbageCollect(get_roots) Performs a garbage collection. @@ -142,8 +216,8 @@ recordMutable(StgMutClosure *p) bd = Bdescr((P_)p); if (bd->gen_no > 0) { - p->mut_link = generations[bd->gen_no].mut_list; - generations[bd->gen_no].mut_list = p; + p->mut_link = RTS_DEREF(generations)[bd->gen_no].mut_list; + RTS_DEREF(generations)[bd->gen_no].mut_list = p; } } @@ -154,180 +228,10 @@ recordOldToNewPtrs(StgMutClosure *p) bd = Bdescr((P_)p); if (bd->gen_no > 0) { - p->mut_link = generations[bd->gen_no].mut_once_list; - generations[bd->gen_no].mut_once_list = p; - } -} - -// @LDV profiling -// We zero out the slop when PROFILING is on. -// #ifndef DEBUG -#if !defined(DEBUG) && !defined(PROFILING) -#define updateWithIndirection(info, ind_info, p1, p2, and_then) \ - { \ - bdescr *bd; \ - \ - bd = Bdescr((P_)p1); \ - if (bd->gen_no == 0) { \ - ((StgInd *)p1)->indirectee = p2; \ - SET_INFO(p1,ind_info); \ - TICK_UPD_NEW_IND(); \ - and_then; \ - } else { \ - ((StgIndOldGen *)p1)->indirectee = p2; \ - if (info != &stg_BLACKHOLE_BQ_info) { \ - ACQUIRE_SM_LOCK; \ - ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list; \ - generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1; \ - RELEASE_SM_LOCK; \ - } \ - SET_INFO(p1,&stg_IND_OLDGEN_info); \ - TICK_UPD_OLD_IND(); \ - and_then; \ - } \ - } -#elif defined(PROFILING) -// @LDV profiling -// We call LDV_recordDead_FILL_SLOP_DYNAMIC(p1) regardless of the generation in -// which p1 resides. -// -// Note: -// After all, we do *NOT* need to call LDV_recordCreate() for both IND and -// IND_OLDGEN closures because they are inherently used. But, it corrupts -// the invariants that every closure keeps its creation time in the profiling -// field. So, we call LDV_recordCreate(). - -#define updateWithIndirection(info, ind_info, p1, p2, and_then) \ - { \ - bdescr *bd; \ - \ - LDV_recordDead_FILL_SLOP_DYNAMIC((p1)); \ - bd = Bdescr((P_)p1); \ - if (bd->gen_no == 0) { \ - ((StgInd *)p1)->indirectee = p2; \ - SET_INFO(p1,ind_info); \ - LDV_recordCreate((p1)); \ - TICK_UPD_NEW_IND(); \ - and_then; \ - } else { \ - ((StgIndOldGen *)p1)->indirectee = p2; \ - if (info != &stg_BLACKHOLE_BQ_info) { \ - ACQUIRE_SM_LOCK; \ - ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list; \ - generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1; \ - RELEASE_SM_LOCK; \ - } \ - SET_INFO(p1,&stg_IND_OLDGEN_info); \ - LDV_recordCreate((p1)); \ - and_then; \ - } \ - } - -#else - -/* In the DEBUG case, we also zero out the slop of the old closure, - * so that the sanity checker can tell where the next closure is. - * - * Two important invariants: we should never try to update a closure - * to point to itself, and the closure being updated should not - * already have been updated (the mutable list will get messed up - * otherwise). - */ -#define updateWithIndirection(info, ind_info, p1, p2, and_then) \ - { \ - bdescr *bd; \ - \ - ASSERT( p1 != p2 && !closure_IND(p1) ); \ - bd = Bdescr((P_)p1); \ - if (bd->gen_no == 0) { \ - ((StgInd *)p1)->indirectee = p2; \ - SET_INFO(p1,ind_info); \ - TICK_UPD_NEW_IND(); \ - and_then; \ - } else { \ - if (info != &stg_BLACKHOLE_BQ_info) { \ - { \ - StgInfoTable *inf = get_itbl(p1); \ - nat np = inf->layout.payload.ptrs, \ - nw = inf->layout.payload.nptrs, i; \ - if (inf->type != THUNK_SELECTOR) { \ - for (i = 0; i < np + nw; i++) { \ - ((StgClosure *)p1)->payload[i] = 0; \ - } \ - } \ - } \ - ACQUIRE_SM_LOCK; \ - ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list; \ - generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1; \ - RELEASE_SM_LOCK; \ - } \ - ((StgIndOldGen *)p1)->indirectee = p2; \ - SET_INFO(p1,&stg_IND_OLDGEN_info); \ - TICK_UPD_OLD_IND(); \ - and_then; \ - } \ - } -#endif - -/* Static objects all live in the oldest generation - */ -#define updateWithStaticIndirection(info, p1, p2) \ - { \ - ASSERT( p1 != p2 && !closure_IND(p1) ); \ - ASSERT( ((StgMutClosure*)p1)->mut_link == NULL ); \ - \ - ACQUIRE_SM_LOCK; \ - ((StgMutClosure *)p1)->mut_link = oldest_gen->mut_once_list; \ - oldest_gen->mut_once_list = (StgMutClosure *)p1; \ - RELEASE_SM_LOCK; \ - \ - ((StgInd *)p1)->indirectee = p2; \ - SET_INFO((StgInd *)p1, &stg_IND_STATIC_info); \ - TICK_UPD_STATIC_IND(); \ - } - -#if defined(TICKY_TICKY) || defined(PROFILING) -INLINE_HEADER void -updateWithPermIndirection(const StgInfoTable *info, StgClosure *p1, StgClosure *p2) -{ - bdescr *bd; - - ASSERT( p1 != p2 && !closure_IND(p1) ); - -#ifdef PROFILING - // @LDV profiling - // Destroy the old closure. - // Nb: LDV_* stuff cannot mix with ticky-ticky - LDV_recordDead_FILL_SLOP_DYNAMIC(p1); -#endif - bd = Bdescr((P_)p1); - if (bd->gen_no == 0) { - ((StgInd *)p1)->indirectee = p2; - SET_INFO(p1,&stg_IND_PERM_info); -#ifdef PROFILING - // @LDV profiling - // We have just created a new closure. - LDV_recordCreate(p1); -#endif - TICK_UPD_NEW_PERM_IND(p1); - } else { - ((StgIndOldGen *)p1)->indirectee = p2; - if (info != &stg_BLACKHOLE_BQ_info) { - ACQUIRE_SM_LOCK; - ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list; - generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1; - RELEASE_SM_LOCK; - } - SET_INFO(p1,&stg_IND_OLDGEN_PERM_info); -#ifdef PROFILING - // @LDV profiling - // We have just created a new closure. - LDV_recordCreate(p1); -#endif - TICK_UPD_OLD_PERM_IND(); + p->mut_link = RTS_DEREF(generations)[bd->gen_no].mut_once_list; + RTS_DEREF(generations)[bd->gen_no].mut_once_list = p; } } -#endif /* ----------------------------------------------------------------------------- The CAF table - used to let us revert CAFs in GHCi @@ -421,7 +325,7 @@ INLINE_HEADER StgWord stack_frame_sizeW( StgClosure *frame ) StgRetDyn *dyn = (StgRetDyn *)frame; return sizeofW(StgRetDyn) + RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE + - GET_PTRS(dyn->liveness) + GET_NONPTRS(dyn->liveness); + RET_DYN_PTRS(dyn->liveness) + RET_DYN_NONPTRS(dyn->liveness); } case RET_FUN: @@ -440,12 +344,68 @@ INLINE_HEADER StgWord stack_frame_sizeW( StgClosure *frame ) } /* ----------------------------------------------------------------------------- - Debugging bits + Nursery manipulation + -------------------------------------------------------------------------- */ + +extern void allocNurseries ( void ); +extern void resetNurseries ( void ); +extern bdescr * allocNursery ( bdescr *last_bd, nat blocks ); +extern void resizeNursery ( nat blocks ); +extern void tidyAllocateLists ( void ); + +/* ----------------------------------------------------------------------------- + MUTABLE LISTS + A mutable list is ended with END_MUT_LIST, so that we can use NULL + as an indication that an object is not on a mutable list. + ------------------------------------------------------------------------- */ + +#define END_MUT_LIST ((StgMutClosure *)(void *)&stg_END_MUT_LIST_closure) + +/* ----------------------------------------------------------------------------- + Functions from GC.c + -------------------------------------------------------------------------- */ + +extern void threadPaused ( StgTSO * ); +extern StgClosure * isAlive ( StgClosure *p ); +extern void markCAFs ( evac_fn evac ); + +/* ----------------------------------------------------------------------------- + Stats 'n' DEBUG stuff -------------------------------------------------------------------------- */ +extern lnat RTS_VAR(total_allocated); + +extern lnat calcAllocated ( void ); +extern lnat calcLive ( void ); +extern lnat calcNeeded ( void ); + +#if defined(DEBUG) +extern void memInventory(void); +extern void checkSanity(void); +extern nat countBlocks(bdescr *); +#endif + #if defined(DEBUG) void printMutOnceList(generation *gen); void printMutableList(generation *gen); #endif +/* ---------------------------------------------------------------------------- + Storage manager internal APIs and globals + ------------------------------------------------------------------------- */ + +#define END_OF_STATIC_LIST stgCast(StgClosure*,1) + +extern void newDynCAF(StgClosure *); + +extern void move_TSO(StgTSO *src, StgTSO *dest); +extern StgTSO *relocate_stack(StgTSO *dest, ptrdiff_t diff); + +extern StgClosure * RTS_VAR(static_objects); +extern StgClosure * RTS_VAR(scavenged_static_objects); +extern StgWeak * RTS_VAR(old_weak_ptr_list); +extern StgWeak * RTS_VAR(weak_ptr_list); +extern StgClosure * RTS_VAR(caf_list); +extern StgTSO * RTS_VAR(resurrected_threads); + #endif // STORAGE_H