X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGCCompact.c;h=e53429c6f3117090cff7bbceeefd1a8592213729;hb=911d4df2301c55d9901ff128a29f5e8e968cf173;hp=f126cfee2c88a89778ccc274a3f3857ac684397e;hpb=1621421619df6f19dce3b8cb29471e5d3c731acb;p=ghc-hetmet.git diff --git a/ghc/rts/GCCompact.c b/ghc/rts/GCCompact.c index f126cfe..e53429c 100644 --- a/ghc/rts/GCCompact.c +++ b/ghc/rts/GCCompact.c @@ -110,20 +110,22 @@ 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: - case THUNK_0_1: - case THUNK_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 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; @@ -171,17 +173,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: @@ -366,17 +368,16 @@ thread_stack(StgPtr p, StgPtr stack_end) } STATIC_INLINE StgPtr -thread_PAP (StgPAP *pap) +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((StgPtr)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->f.fun_type) { case ARG_GEN: @@ -387,13 +388,12 @@ thread_PAP (StgPAP *pap) 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->f.fun_type]); small_bitmap: - size = pap->n_args; while (size > 0) { if ((bitmap & 1) == 0) { thread(p); @@ -405,9 +405,26 @@ 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 thread_AP_STACK (StgAP_STACK *ap) @@ -487,6 +504,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)); } @@ -497,9 +528,11 @@ 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: - case THUNK_0_1: return p + sizeofW(StgHeader) + 1; case FUN_1_0: @@ -508,21 +541,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) + 1; + thread((StgPtr)&((StgThunk *)p)->payload[0]); + return p + sizeofW(StgThunk) + 1; 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]); @@ -538,10 +580,20 @@ 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: @@ -597,8 +649,10 @@ 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); @@ -785,7 +839,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; @@ -841,11 +895,6 @@ update_bkwd_compact( step *stp ) move(free,p,size); } - // Rebuild the mutable list for the old generation. - if (ip_MUTABLE(info)) { - recordMutable((StgClosure *)free); - } - // relocate TSOs if (info->type == TSO) { move_TSO((StgTSO *)p, (StgTSO *)free); @@ -865,7 +914,6 @@ update_bkwd_compact( step *stp ) freeChain(free_bd->link); free_bd->link = NULL; } - stp->n_blocks = free_blocks; return free_blocks; } @@ -904,11 +952,13 @@ compact( void (*get_roots)(evac_fn) ) // any threads resurrected during this GC thread((StgPtr)&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); + } } } @@ -924,25 +974,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; } }