X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSanity.c;h=3f4b3cf7b05a81f0edf68b26f493f4d276f0028d;hb=de75026f5a48d3d052135a973ab4dff76c5b20f5;hp=3eea3cd11c82ed7cfea411560af1fc460b45c638;hpb=fef454a0f84acdf9e4efbce6425a04fbbb577dbe;p=ghc-hetmet.git diff --git a/rts/Sanity.c b/rts/Sanity.c index 3eea3cd..3f4b3cf 100644 --- a/rts/Sanity.c +++ b/rts/Sanity.c @@ -312,10 +312,6 @@ checkClosure( StgClosure* p ) case IND_PERM: case IND_OLDGEN: case IND_OLDGEN_PERM: -#ifdef TICKY_TICKY - case SE_BLACKHOLE: - case SE_CAF_BLACKHOLE: -#endif case BLACKHOLE: case CAF_BLACKHOLE: case STABLE_NAME: @@ -637,10 +633,12 @@ checkHeapChunk(StgPtr start, StgPtr end) #endif void -checkChain(bdescr *bd) +checkLargeObjects(bdescr *bd) { while (bd != NULL) { - checkClosure((StgClosure *)bd->start); + if (!(bd->flags & BF_PINNED)) { + checkClosure((StgClosure *)bd->start); + } bd = bd->link; } } @@ -793,6 +791,14 @@ checkGlobalTSOList (rtsBool checkTSOs) ASSERT(get_itbl(tso)->type == TSO); if (checkTSOs) checkTSO(tso); + + // If this TSO is dirty and in an old generation, it better + // be on the mutable list. + if (tso->what_next == ThreadRelocated) continue; + if (tso->flags & (TSO_DIRTY|TSO_LINK_DIRTY)) { + ASSERT(Bdescr((P_)tso)->gen_no == 0 || (tso->flags & TSO_MARKED)); + tso->flags &= ~TSO_MARKED; + } } } } @@ -812,10 +818,27 @@ checkMutableList( bdescr *mut_bd, nat gen ) for (q = bd->start; q < bd->free; q++) { p = (StgClosure *)*q; ASSERT(!HEAP_ALLOCED(p) || Bdescr((P_)p)->gen_no == gen); + if (get_itbl(p)->type == TSO) { + ((StgTSO *)p)->flags |= TSO_MARKED; + } } } } +void +checkMutableLists (rtsBool checkTSOs) +{ + nat g, i; + + for (g = 0; g < RtsFlags.GcFlags.generations; g++) { + checkMutableList(generations[g].mut_list, g); + for (i = 0; i < n_capabilities; i++) { + checkMutableList(capabilities[i].mut_lists[g], g); + } + } + checkGlobalTSOList(checkTSOs); +} + /* Check the static objects list. */