X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGCCompact.c;h=43768c5c270ca41e784e5d74d89de00bb34bbf82;hb=5f82512925a089d604a6192f559fd764a653fe90;hp=c8bd32f057579493e3968105aeab4245017b85d4;hpb=e7c3f957fd36fd9f6369183b7a31e2a4a4c21b43;p=ghc-hetmet.git diff --git a/ghc/rts/GCCompact.c b/ghc/rts/GCCompact.c index c8bd32f..43768c5 100644 --- a/ghc/rts/GCCompact.c +++ b/ghc/rts/GCCompact.c @@ -10,6 +10,7 @@ #include "Rts.h" #include "RtsUtils.h" #include "RtsFlags.h" +#include "OSThreads.h" #include "Storage.h" #include "BlockAlloc.h" #include "MBlock.h" @@ -109,23 +110,25 @@ 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: @@ -137,6 +140,7 @@ 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); @@ -169,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: @@ -222,8 +226,8 @@ thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args) p = (StgPtr)args; switch (fun_info->f.fun_type) { case ARG_GEN: - bitmap = BITMAP_BITS(fun_info->f.bitmap); - size = BITMAP_SIZE(fun_info->f.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 = GET_FUN_LARGE_BITMAP(fun_info)->size; @@ -364,34 +368,32 @@ 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: - bitmap = BITMAP_BITS(fun_info->f.bitmap); + bitmap = BITMAP_BITS(fun_info->f.b.bitmap); goto small_bitmap; case ARG_GEN_BIG: 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->f.fun_type]); small_bitmap: - size = pap->n_args; while (size > 0) { if ((bitmap & 1) == 0) { thread(p); @@ -403,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) @@ -461,6 +480,7 @@ update_fwd_large( bdescr *bd ) case MUT_ARR_PTRS: case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: // follow everything { StgPtr next; @@ -494,6 +514,9 @@ 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; @@ -504,22 +527,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]); @@ -535,8 +566,19 @@ 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: @@ -546,7 +588,6 @@ thread_obj (StgInfoTable *info, StgPtr p) case SE_CAF_BLACKHOLE: case SE_BLACKHOLE: case BLACKHOLE: - case BLACKHOLE_BQ: { StgPtr end; @@ -595,14 +636,17 @@ 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_FROZEN: + case MUT_ARR_PTRS_FROZEN0: // follow everything { StgPtr next; @@ -838,11 +882,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);