X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGCCompact.c;h=30836e3414475337b8281a0e4e0335a16ba3a147;hb=09e2c3a13ed67e2ab69a8e0a3eaa608e19713521;hp=16b8fb180be454339b1702fb2acb79bb42f27373;hpb=0bffc410964e1688ad80d277d53400659e697ab5;p=ghc-hetmet.git diff --git a/ghc/rts/GCCompact.c b/ghc/rts/GCCompact.c index 16b8fb1..30836e3 100644 --- a/ghc/rts/GCCompact.c +++ b/ghc/rts/GCCompact.c @@ -1,5 +1,4 @@ /* ----------------------------------------------------------------------------- - * $Id: GCCompact.c,v 1.13 2002/12/11 15:36:42 simonmar Exp $ * * (c) The GHC Team 2001 * @@ -16,9 +15,14 @@ #include "MBlock.h" #include "GCCompact.h" #include "Schedule.h" -#include "StablePriv.h" #include "Apply.h" +// Turn off inlining when debugging - it obfuscates things +#ifdef DEBUG +# undef STATIC_INLINE +# define STATIC_INLINE static +#endif + /* ----------------------------------------------------------------------------- Threading / unthreading pointers. @@ -41,7 +45,7 @@ except for the info pointer. -------------------------------------------------------------------------- */ -static inline void +STATIC_INLINE void thread( StgPtr p ) { StgPtr q = (StgPtr)*p; @@ -64,21 +68,21 @@ thread( StgPtr p ) } } -static inline void +STATIC_INLINE void unthread( StgPtr p, StgPtr free ) { - StgPtr q = (StgPtr)*p, r; + StgWord q = *p, r; - while (((StgWord)q & 1) != 0) { - (StgWord)q -= 1; // unset the low bit again - r = (StgPtr)*q; - *q = (StgWord)free; + while ((q & 1) != 0) { + q -= 1; // unset the low bit again + r = *((StgPtr)q); + *((StgPtr)q) = (StgWord)free; q = r; } - *p = (StgWord)q; + *p = q; } -static inline StgInfoTable * +STATIC_INLINE StgInfoTable * get_threaded_info( StgPtr p ) { StgPtr q = (P_)GET_INFO((StgClosure *)p); @@ -93,7 +97,7 @@ get_threaded_info( StgPtr p ) // A word-aligned memmove will be faster for small objects than libc's or gcc's. // Remember, the two regions *might* overlap, but: to <= from. -static inline void +STATIC_INLINE void move(StgPtr to, StgPtr from, nat size) { for(; size > 0; --size) { @@ -101,7 +105,7 @@ move(StgPtr to, StgPtr from, nat size) } } -static inline nat +STATIC_INLINE nat obj_sizeW( StgClosure *p, StgInfoTable *info ) { switch (info->type) { @@ -109,19 +113,19 @@ obj_sizeW( StgClosure *p, StgInfoTable *info ) case CONSTR_0_1: case FUN_1_0: case CONSTR_1_0: - return sizeofW(StgHeader) + 1; case THUNK_0_1: + case THUNK_1_0: + return sizeofW(StgHeader) + 1; case THUNK_0_2: case FUN_0_2: case CONSTR_0_2: - case THUNK_1_0: case THUNK_1_1: case FUN_1_1: case CONSTR_1_1: case THUNK_2_0: case FUN_2_0: case CONSTR_2_0: - return sizeofW(StgHeader) + 2; // MIN_UPD_SIZE + return sizeofW(StgHeader) + 2; case THUNK_SELECTOR: return THUNK_SELECTOR_sizeW(); case AP_STACK: @@ -133,9 +137,20 @@ obj_sizeW( StgClosure *p, StgInfoTable *info ) return arr_words_sizeW((StgArrWords *)p); case MUT_ARR_PTRS: case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); case TSO: return tso_sizeW((StgTSO *)p); + case BCO: + return bco_sizeW((StgBCO *)p); + case TVAR_WAIT_QUEUE: + return sizeofW(StgTVarWaitQueue); + case TVAR: + return sizeofW(StgTVar); + case TREC_CHUNK: + return sizeofW(StgTRecChunk); + case TREC_HEADER: + return sizeofW(StgTRecHeader); default: return sizeW_fromITBL(info); } @@ -175,7 +190,7 @@ thread_static( StgClosure* p ) } } -static inline void +STATIC_INLINE void thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size ) { nat i, b; @@ -198,7 +213,7 @@ thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size ) } } -static inline StgPtr +STATIC_INLINE StgPtr thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args) { StgPtr p; @@ -206,19 +221,19 @@ thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args) nat size; p = (StgPtr)args; - switch (fun_info->fun_type) { + switch (fun_info->f.fun_type) { case ARG_GEN: - bitmap = BITMAP_BITS(fun_info->bitmap); - size = BITMAP_SIZE(fun_info->bitmap); + bitmap = BITMAP_BITS(fun_info->f.bitmap); + size = BITMAP_SIZE(fun_info->f.bitmap); goto small_bitmap; case ARG_GEN_BIG: - size = ((StgLargeBitmap *)fun_info->bitmap)->size; - thread_large_bitmap(p, (StgLargeBitmap *)fun_info->bitmap, size); + size = GET_FUN_LARGE_BITMAP(fun_info)->size; + thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size); p += size; break; default: - bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]); - size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->fun_type]); + bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]); + size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]); small_bitmap: while (size > 0) { if ((bitmap & 1) == 0) { @@ -259,9 +274,9 @@ thread_stack(StgPtr p, StgPtr stack_end) dyn = ((StgRetDyn *)p)->liveness; // traverse the bitmap first - bitmap = GET_LIVENESS(dyn); + bitmap = RET_DYN_LIVENESS(dyn); p = (P_)&((StgRetDyn *)p)->payload[0]; - size = RET_DYN_SIZE; + size = RET_DYN_BITMAP_SIZE; while (size > 0) { if ((bitmap & 1) == 0) { thread(p); @@ -272,10 +287,10 @@ thread_stack(StgPtr p, StgPtr stack_end) } // skip over the non-ptr words - p += GET_NONPTRS(dyn); + p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE; // follow the ptr words - for (size = GET_PTRS(dyn); size > 0; size--) { + for (size = RET_DYN_PTRS(dyn); size > 0; size--) { thread(p); p++; } @@ -283,6 +298,9 @@ thread_stack(StgPtr p, StgPtr stack_end) } // small bitmap (<= 32 entries, or 64 on a 64-bit machine) + case CATCH_RETRY_FRAME: + case CATCH_STM_FRAME: + case ATOMICALLY_FRAME: case UPDATE_FRAME: case STOP_FRAME: case CATCH_FRAME: @@ -308,8 +326,8 @@ thread_stack(StgPtr p, StgPtr stack_end) nat size; p++; - thread(p); bco = (StgBCO *)*p; + thread(p); p++; size = BCO_BITMAP_SIZE(bco); thread_large_bitmap(p, BCO_BITMAP(bco), size); @@ -321,8 +339,8 @@ thread_stack(StgPtr p, StgPtr stack_end) case RET_BIG: case RET_VEC_BIG: p++; - size = info->i.layout.large_bitmap->size; - thread_large_bitmap(p, info->i.layout.large_bitmap, size); + size = GET_LARGE_BITMAP(&info->i)->size; + thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size); p += size; continue; @@ -331,7 +349,9 @@ thread_stack(StgPtr p, StgPtr stack_end) StgRetFun *ret_fun = (StgRetFun *)p; StgFunInfoTable *fun_info; - fun_info = get_fun_itbl(ret_fun->fun); // *before* threading it! + fun_info = itbl_to_fun_itbl( + get_threaded_info((StgPtr)ret_fun->fun)); + // *before* threading it! thread((StgPtr)&ret_fun->fun); p = thread_arg_block(fun_info, ret_fun->payload); continue; @@ -344,26 +364,25 @@ thread_stack(StgPtr p, StgPtr stack_end) } } -static inline StgPtr +STATIC_INLINE StgPtr thread_PAP (StgPAP *pap) { StgPtr p; StgWord bitmap, size; StgFunInfoTable *fun_info; - thread((StgPtr)&pap->fun); - fun_info = get_fun_itbl(pap->fun); + fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)pap->fun)); ASSERT(fun_info->i.type != PAP); p = (StgPtr)pap->payload; size = pap->n_args; - switch (fun_info->fun_type) { + switch (fun_info->f.fun_type) { case ARG_GEN: - bitmap = BITMAP_BITS(fun_info->bitmap); + bitmap = BITMAP_BITS(fun_info->f.bitmap); goto small_bitmap; case ARG_GEN_BIG: - thread_large_bitmap(p, (StgLargeBitmap *)fun_info->bitmap, size); + thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size); p += size; break; case ARG_BCO: @@ -371,7 +390,7 @@ thread_PAP (StgPAP *pap) p += size; break; default: - bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]); + bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]); small_bitmap: size = pap->n_args; while (size > 0) { @@ -384,10 +403,12 @@ thread_PAP (StgPAP *pap) } break; } + + thread((StgPtr)&pap->fun); return p; } -static inline StgPtr +STATIC_INLINE StgPtr thread_AP_STACK (StgAP_STACK *ap) { thread((StgPtr)&ap->fun); @@ -415,6 +436,8 @@ thread_TSO (StgTSO *tso) thread((StgPtr)&tso->blocked_exceptions); } + thread((StgPtr)&tso->trec); + thread_stack(tso->sp, &(tso->stack[tso->stack_size])); return (StgPtr)tso + tso_sizeW(tso); } @@ -439,6 +462,7 @@ update_fwd_large( bdescr *bd ) case MUT_ARR_PTRS: case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: // follow everything { StgPtr next; @@ -468,12 +492,13 @@ update_fwd_large( bdescr *bd ) } } -static inline StgPtr +STATIC_INLINE StgPtr thread_obj (StgInfoTable *info, StgPtr p) { switch (info->type) { case FUN_0_1: case CONSTR_0_1: + case THUNK_0_1: return p + sizeofW(StgHeader) + 1; case FUN_1_0: @@ -483,9 +508,8 @@ thread_obj (StgInfoTable *info, StgPtr p) case THUNK_1_0: thread((StgPtr)&((StgClosure *)p)->payload[0]); - return p + sizeofW(StgHeader) + 2; // MIN_UPD_SIZE + return p + sizeofW(StgHeader) + 1; - case THUNK_0_1: // MIN_UPD_SIZE case THUNK_0_2: case FUN_0_2: case CONSTR_0_2: @@ -504,15 +528,22 @@ thread_obj (StgInfoTable *info, StgPtr p) thread((StgPtr)&((StgClosure *)p)->payload[1]); return p + sizeofW(StgHeader) + 2; + case BCO: { + StgBCO *bco = (StgBCO *)p; + thread((StgPtr)&bco->instrs); + thread((StgPtr)&bco->literals); + thread((StgPtr)&bco->ptrs); + thread((StgPtr)&bco->itbls); + return p + bco_sizeW(bco); + } + case FUN: case THUNK: case CONSTR: case FOREIGN: case STABLE_NAME: - case BCO: case IND_PERM: case MUT_VAR: - case MUT_CONS: case CAF_BLACKHOLE: case SE_CAF_BLACKHOLE: case SE_BLACKHOLE: @@ -552,8 +583,8 @@ thread_obj (StgInfoTable *info, StgPtr p) case IND_OLDGEN: case IND_OLDGEN_PERM: - thread((StgPtr)&((StgIndOldGen *)p)->indirectee); - return p + sizeofW(StgIndOldGen); + thread((StgPtr)&((StgInd *)p)->indirectee); + return p + sizeofW(StgInd); case THUNK_SELECTOR: { @@ -574,6 +605,7 @@ thread_obj (StgInfoTable *info, StgPtr p) case MUT_ARR_PTRS: case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: // follow everything { StgPtr next; @@ -588,8 +620,48 @@ thread_obj (StgInfoTable *info, StgPtr p) case TSO: return thread_TSO((StgTSO *)p); + case TVAR_WAIT_QUEUE: + { + StgTVarWaitQueue *wq = (StgTVarWaitQueue *)p; + thread((StgPtr)&wq->waiting_tso); + thread((StgPtr)&wq->next_queue_entry); + thread((StgPtr)&wq->prev_queue_entry); + return p + sizeofW(StgTVarWaitQueue); + } + + case TVAR: + { + StgTVar *tvar = (StgTVar *)p; + thread((StgPtr)&tvar->current_value); + thread((StgPtr)&tvar->first_wait_queue_entry); + return p + sizeofW(StgTVar); + } + + case TREC_HEADER: + { + StgTRecHeader *trec = (StgTRecHeader *)p; + thread((StgPtr)&trec->enclosing_trec); + thread((StgPtr)&trec->current_chunk); + return p + sizeofW(StgTRecHeader); + } + + case TREC_CHUNK: + { + StgWord i; + StgTRecChunk *tc = (StgTRecChunk *)p; + TRecEntry *e = &(tc -> entries[0]); + thread((StgPtr)&tc->prev_chunk); + for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) { + thread((StgPtr)&e->tvar); + thread((StgPtr)&e->expected_value); + thread((StgPtr)&e->new_value); + } + return p + sizeofW(StgTRecChunk); + } + default: barf("update_fwd: unknown/strange object %d", (int)(info->type)); + return NULL; } } @@ -771,7 +843,7 @@ update_bkwd_compact( step *stp ) // Rebuild the mutable list for the old generation. if (ip_MUTABLE(info)) { - recordMutable((StgMutClosure *)free); + recordMutable((StgClosure *)free); } // relocate TSOs @@ -798,19 +870,6 @@ update_bkwd_compact( step *stp ) return free_blocks; } -static void -thread_mut_once_list( generation *g ) -{ - StgMutClosure *p, *next; - - for (p = g->mut_once_list; p != END_MUT_LIST; p = next) { - next = p->mut_link; - thread((StgPtr)&p->mut_link); - } - - thread((StgPtr)&g->mut_once_list); -} - void compact( void (*get_roots)(evac_fn) ) { @@ -830,8 +889,13 @@ compact( void (*get_roots)(evac_fn) ) // mutable lists for (g = 1; g < RtsFlags.GcFlags.generations; g++) { - thread((StgPtr)&generations[g].mut_list); - thread_mut_once_list(&generations[g]); + bdescr *bd; + StgPtr p; + for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) { + for (p = bd->start; p < bd->free; p++) { + thread(p); + } + } } // the global thread list @@ -861,12 +925,12 @@ compact( void (*get_roots)(evac_fn) ) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { for (s = 0; s < generations[g].n_steps; s++) { stp = &generations[g].steps[s]; - IF_DEBUG(gc, fprintf(stderr,"update_fwd: %d.%d\n", stp->gen->no, stp->no);); + IF_DEBUG(gc, debugBelch("update_fwd: %d.%d\n", stp->gen->no, stp->no);); update_fwd(stp->to_blocks); update_fwd_large(stp->scavenged_large_objects); if (g == RtsFlags.GcFlags.generations-1 && stp->blocks != NULL) { - IF_DEBUG(gc, fprintf(stderr,"update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no);); + IF_DEBUG(gc, debugBelch("update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no);); update_fwd_compact(stp->blocks); } } @@ -876,7 +940,7 @@ compact( void (*get_roots)(evac_fn) ) stp = &oldest_gen->steps[0]; if (stp->blocks != NULL) { blocks = update_bkwd_compact(stp); - IF_DEBUG(gc, fprintf(stderr,"update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n", + IF_DEBUG(gc, debugBelch("update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n", stp->gen->no, stp->no, stp->n_blocks, blocks);); stp->n_blocks = blocks;