X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGCCompact.c;h=4dfe84bbe0fac8fecb8f2aa1772f1d6add15b1f9;hb=3034a6c8cfb50e2b5af4ef57c419986039b53a94;hp=eaefcb746279f1611d77c209e24f1f237af0fc69;hpb=b3f530814c15886a7a010ed871bb1f054a3918b3;p=ghc-hetmet.git diff --git a/ghc/rts/GCCompact.c b/ghc/rts/GCCompact.c index eaefcb7..4dfe84b 100644 --- a/ghc/rts/GCCompact.c +++ b/ghc/rts/GCCompact.c @@ -1,5 +1,4 @@ /* ----------------------------------------------------------------------------- - * $Id: GCCompact.c,v 1.14 2003/03/24 14:46:54 simonmar Exp $ * * (c) The GHC Team 2001 * @@ -11,19 +10,18 @@ #include "Rts.h" #include "RtsUtils.h" #include "RtsFlags.h" +#include "OSThreads.h" #include "Storage.h" #include "BlockAlloc.h" #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 -#define INLINE -#else -#define INLINE inline +# undef STATIC_INLINE +# define STATIC_INLINE static #endif /* ----------------------------------------------------------------------------- @@ -48,7 +46,7 @@ except for the info pointer. -------------------------------------------------------------------------- */ -static INLINE void +STATIC_INLINE void thread( StgPtr p ) { StgPtr q = (StgPtr)*p; @@ -71,21 +69,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); @@ -100,7 +98,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) { @@ -108,48 +106,6 @@ move(StgPtr to, StgPtr from, nat size) } } -static INLINE nat -obj_sizeW( StgClosure *p, StgInfoTable *info ) -{ - switch (info->type) { - case FUN_0_1: - case CONSTR_0_1: - case FUN_1_0: - case CONSTR_1_0: - return sizeofW(StgHeader) + 1; - case THUNK_0_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 - case THUNK_SELECTOR: - return THUNK_SELECTOR_sizeW(); - case AP_STACK: - return ap_stack_sizeW((StgAP_STACK *)p); - case AP: - case PAP: - return pap_sizeW((StgPAP *)p); - case ARR_WORDS: - return arr_words_sizeW((StgArrWords *)p); - case MUT_ARR_PTRS: - case MUT_ARR_PTRS_FROZEN: - return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); - case TSO: - return tso_sizeW((StgTSO *)p); - case BCO: - return bco_sizeW((StgBCO *)p); - default: - return sizeW_fromITBL(info); - } -} - static void thread_static( StgClosure* p ) { @@ -164,17 +120,17 @@ thread_static( StgClosure* p ) case IND_STATIC: thread((StgPtr)&((StgInd *)p)->indirectee); - p = IND_STATIC_LINK(p); + p = *IND_STATIC_LINK(p); continue; case THUNK_STATIC: - p = THUNK_STATIC_LINK(p); + p = *THUNK_STATIC_LINK(p); continue; case FUN_STATIC: - p = FUN_STATIC_LINK(p); + p = *FUN_STATIC_LINK(p); continue; case CONSTR_STATIC: - p = STATIC_LINK(info,p); + p = *STATIC_LINK(info,p); continue; default: @@ -184,7 +140,7 @@ thread_static( StgClosure* p ) } } -static INLINE void +STATIC_INLINE void thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size ) { nat i, b; @@ -207,7 +163,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; @@ -215,19 +171,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.b.bitmap); + size = BITMAP_SIZE(fun_info->f.b.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) { @@ -268,9 +224,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); @@ -281,10 +237,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++; } @@ -292,6 +248,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: @@ -317,8 +276,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); @@ -330,8 +289,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; @@ -340,7 +299,8 @@ thread_stack(StgPtr p, StgPtr stack_end) StgRetFun *ret_fun = (StgRetFun *)p; StgFunInfoTable *fun_info; - fun_info = itbl_to_fun_itbl(get_threaded_info(ret_fun->fun)); + 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); @@ -354,35 +314,33 @@ thread_stack(StgPtr p, StgPtr stack_end) } } -static INLINE StgPtr -thread_PAP (StgPAP *pap) +STATIC_INLINE StgPtr +thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size) { StgPtr p; - StgWord bitmap, size; + StgWord bitmap; StgFunInfoTable *fun_info; - - fun_info = itbl_to_fun_itbl(get_threaded_info(pap->fun)); + + fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)fun)); ASSERT(fun_info->i.type != PAP); - p = (StgPtr)pap->payload; - size = pap->n_args; + p = (StgPtr)payload; - 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.b.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: - thread_large_bitmap((StgPtr)pap->payload, BCO_BITMAP(pap->fun), size); + thread_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size); 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) { if ((bitmap & 1) == 0) { thread(p); @@ -394,11 +352,28 @@ thread_PAP (StgPAP *pap) break; } + return p; +} + +STATIC_INLINE StgPtr +thread_PAP (StgPAP *pap) +{ + StgPtr p; + p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args); thread((StgPtr)&pap->fun); return p; } + +STATIC_INLINE StgPtr +thread_AP (StgAP *ap) +{ + StgPtr p; + p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args); + thread((StgPtr)&ap->fun); + return p; +} -static INLINE StgPtr +STATIC_INLINE StgPtr thread_AP_STACK (StgAP_STACK *ap) { thread((StgPtr)&ap->fun); @@ -426,6 +401,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); } @@ -448,8 +425,10 @@ update_fwd_large( bdescr *bd ) // nothing to follow continue; - case MUT_ARR_PTRS: + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: // follow everything { StgPtr next; @@ -473,16 +452,33 @@ update_fwd_large( bdescr *bd ) thread_PAP((StgPAP *)p); continue; + 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); + } + continue; + } + default: barf("update_fwd_large: unknown/strange object %d", (int)(info->type)); } } } -static INLINE StgPtr +STATIC_INLINE StgPtr thread_obj (StgInfoTable *info, StgPtr p) { switch (info->type) { + case THUNK_0_1: + return p + sizeofW(StgThunk) + 1; + case FUN_0_1: case CONSTR_0_1: return p + sizeofW(StgHeader) + 1; @@ -493,22 +489,30 @@ thread_obj (StgInfoTable *info, StgPtr p) return p + sizeofW(StgHeader) + 1; case THUNK_1_0: - thread((StgPtr)&((StgClosure *)p)->payload[0]); - return p + sizeofW(StgHeader) + 2; // MIN_UPD_SIZE + thread((StgPtr)&((StgThunk *)p)->payload[0]); + return p + sizeofW(StgThunk) + 1; - case THUNK_0_1: // MIN_UPD_SIZE case THUNK_0_2: + return p + sizeofW(StgThunk) + 2; + case FUN_0_2: case CONSTR_0_2: return p + sizeofW(StgHeader) + 2; case THUNK_1_1: + thread((StgPtr)&((StgThunk *)p)->payload[0]); + return p + sizeofW(StgThunk) + 2; + case FUN_1_1: case CONSTR_1_1: thread((StgPtr)&((StgClosure *)p)->payload[0]); return p + sizeofW(StgHeader) + 2; case THUNK_2_0: + thread((StgPtr)&((StgThunk *)p)->payload[0]); + thread((StgPtr)&((StgThunk *)p)->payload[1]); + return p + sizeofW(StgThunk) + 2; + case FUN_2_0: case CONSTR_2_0: thread((StgPtr)&((StgClosure *)p)->payload[0]); @@ -524,19 +528,28 @@ thread_obj (StgInfoTable *info, StgPtr p) return p + bco_sizeW(bco); } - case FUN: case THUNK: + { + StgPtr end; + + end = (P_)((StgThunk *)p)->payload + + info->layout.payload.ptrs; + for (p = (P_)((StgThunk *)p)->payload; p < end; p++) { + thread(p); + } + return p + info->layout.payload.nptrs; + } + + case FUN: case CONSTR: - case FOREIGN: case STABLE_NAME: case IND_PERM: - case MUT_VAR: - case MUT_CONS: + case MUT_VAR_CLEAN: + case MUT_VAR_DIRTY: case CAF_BLACKHOLE: case SE_CAF_BLACKHOLE: case SE_BLACKHOLE: case BLACKHOLE: - case BLACKHOLE_BQ: { StgPtr end; @@ -571,8 +584,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: { @@ -585,14 +598,18 @@ thread_obj (StgInfoTable *info, StgPtr p) return thread_AP_STACK((StgAP_STACK *)p); case PAP: - case AP: return thread_PAP((StgPAP *)p); + + case AP: + return thread_AP((StgAP *)p); case ARR_WORDS: return p + arr_words_sizeW((StgArrWords *)p); - case MUT_ARR_PTRS: + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: // follow everything { StgPtr next; @@ -607,8 +624,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; } } @@ -732,7 +789,7 @@ update_bkwd_compact( step *stp ) StgInfoTable *info; nat size, free_blocks; - bd = free_bd = stp->blocks; + bd = free_bd = stp->old_blocks; free = free_bd->start; free_blocks = 1; @@ -782,17 +839,12 @@ update_bkwd_compact( step *stp ) unthread(p,free); ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info)); info = get_itbl((StgClosure *)p); - size = obj_sizeW((StgClosure *)p,info); + size = closure_sizeW_((StgClosure *)p,info); if (free != p) { move(free,p,size); } - // Rebuild the mutable list for the old generation. - if (ip_MUTABLE(info)) { - recordMutable((StgMutClosure *)free); - } - // relocate TSOs if (info->type == TSO) { move_TSO((StgTSO *)p, (StgTSO *)free); @@ -812,24 +864,10 @@ update_bkwd_compact( step *stp ) freeChain(free_bd->link); free_bd->link = NULL; } - stp->n_blocks = free_blocks; 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) ) { @@ -841,29 +879,36 @@ compact( void (*get_roots)(evac_fn) ) // the weak pointer lists... if (weak_ptr_list != NULL) { - thread((StgPtr)&weak_ptr_list); + thread((StgPtr)(void *)&weak_ptr_list); } if (old_weak_ptr_list != NULL) { - thread((StgPtr)&old_weak_ptr_list); // tmp + thread((StgPtr)(void *)&old_weak_ptr_list); // tmp } // 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 - thread((StgPtr)&all_threads); + thread((StgPtr)(void *)&all_threads); // any threads resurrected during this GC - thread((StgPtr)&resurrected_threads); + thread((StgPtr)(void *)&resurrected_threads); - // the main threads list + // the task list { - StgMainThread *m; - for (m = main_threads; m != NULL; m = m->link) { - thread((StgPtr)&m->tso); + Task *task; + for (task = all_tasks; task != NULL; task = task->all_link) { + if (task->tso) { + thread((StgPtr)&task->tso); + } } } @@ -879,25 +924,26 @@ compact( void (*get_roots)(evac_fn) ) // 2. update forward ptrs for (g = 0; g < RtsFlags.GcFlags.generations; g++) { for (s = 0; s < generations[g].n_steps; s++) { + if (g==0 && s ==0) continue; 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(stp->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);); - update_fwd_compact(stp->blocks); + if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) { + IF_DEBUG(gc, debugBelch("update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no);); + update_fwd_compact(stp->old_blocks); } } } // 3. update backward ptrs stp = &oldest_gen->steps[0]; - if (stp->blocks != NULL) { + if (stp->old_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; + stp->n_old_blocks, blocks);); + stp->n_old_blocks = blocks; } }