X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGCCompact.c;h=4dfe84bbe0fac8fecb8f2aa1772f1d6add15b1f9;hb=0372ac231bd18e993a2533f784805046876d5527;hp=43768c5c270ca41e784e5d74d89de00bb34bbf82;hpb=0f3205e6c40575910d50bc2cc42020ccf55e07ba;p=ghc-hetmet.git diff --git a/ghc/rts/GCCompact.c b/ghc/rts/GCCompact.c index 43768c5..4dfe84b 100644 --- a/ghc/rts/GCCompact.c +++ b/ghc/rts/GCCompact.c @@ -106,59 +106,6 @@ move(StgPtr to, StgPtr from, nat size) } } -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_2: - case THUNK_1_1: - case THUNK_2_0: - return sizeofW(StgThunk) + 2; - case FUN_0_2: - case CONSTR_0_2: - case FUN_1_1: - case CONSTR_1_1: - case FUN_2_0: - case CONSTR_2_0: - return sizeofW(StgHeader) + 2; - 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: - 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); - } -} - static void thread_static( StgClosure* p ) { @@ -478,7 +425,8 @@ 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 @@ -504,6 +452,20 @@ 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)); } @@ -580,10 +542,10 @@ thread_obj (StgInfoTable *info, StgPtr p) case FUN: case CONSTR: - case FOREIGN: case STABLE_NAME: case IND_PERM: - case MUT_VAR: + case MUT_VAR_CLEAN: + case MUT_VAR_DIRTY: case CAF_BLACKHOLE: case SE_CAF_BLACKHOLE: case SE_BLACKHOLE: @@ -644,7 +606,8 @@ thread_obj (StgInfoTable *info, StgPtr 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 @@ -826,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; @@ -876,7 +839,7 @@ 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); @@ -901,7 +864,6 @@ update_bkwd_compact( step *stp ) freeChain(free_bd->link); free_bd->link = NULL; } - stp->n_blocks = free_blocks; return free_blocks; } @@ -917,10 +879,10 @@ 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 @@ -935,16 +897,18 @@ compact( void (*get_roots)(evac_fn) ) } // 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); + } } } @@ -960,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, 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 (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->blocks); + 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, 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; } }