X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGCCompact.c;h=b5bcc19360956c0e3a780c4169e230e4e146ce83;hb=91b07216be1cb09230b7d1b417899ddea8620ff3;hp=16b8fb180be454339b1702fb2acb79bb42f27373;hpb=0bffc410964e1688ad80d277d53400659e697ab5;p=ghc-hetmet.git diff --git a/ghc/rts/GCCompact.c b/ghc/rts/GCCompact.c index 16b8fb1..b5bcc19 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 * @@ -11,14 +10,20 @@ #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 +# undef STATIC_INLINE +# define STATIC_INLINE static +#endif + /* ----------------------------------------------------------------------------- Threading / unthreading pointers. @@ -41,7 +46,7 @@ except for the info pointer. -------------------------------------------------------------------------- */ -static inline void +STATIC_INLINE void thread( StgPtr p ) { StgPtr q = (StgPtr)*p; @@ -64,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); @@ -93,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) { @@ -101,27 +106,29 @@ move(StgPtr to, StgPtr from, nat size) } } -static inline nat +STATIC_INLINE nat obj_sizeW( StgClosure *p, StgInfoTable *info ) { switch (info->type) { + case THUNK_0_1: + case THUNK_1_0: + return sizeofW(StgThunk) + 1; 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 THUNK_1_1: + case THUNK_2_0: + return sizeofW(StgThunk) + 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: @@ -131,11 +138,23 @@ obj_sizeW( StgClosure *p, StgInfoTable *info ) return pap_sizeW((StgPAP *)p); case ARR_WORDS: return 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: 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); } @@ -155,17 +174,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: @@ -175,7 +194,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 +217,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 +225,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) { @@ -259,9 +278,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 +291,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 +302,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 +330,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 +343,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 +353,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,36 +368,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; - - thread((StgPtr)&pap->fun); - fun_info = get_fun_itbl(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); @@ -384,10 +405,29 @@ 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); @@ -415,6 +455,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); } @@ -437,8 +479,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; @@ -462,16 +506,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; @@ -482,42 +543,67 @@ 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]); thread((StgPtr)&((StgClosure *)p)->payload[1]); return p + sizeofW(StgHeader) + 2; - case FUN: + 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 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 BCO: 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; @@ -552,8 +638,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: { @@ -566,14 +652,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; @@ -588,8 +678,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; } } @@ -713,7 +843,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; @@ -769,11 +899,6 @@ update_bkwd_compact( step *stp ) 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); @@ -793,24 +918,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) ) { @@ -822,29 +933,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); + } } } @@ -860,25 +978,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; } }