diff options
author | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2019-08-14 12:12:36 +0300 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-08-18 16:40:03 -0400 |
commit | 5b713aa3d0159f5190e197e57765195a98ce9520 (patch) | |
tree | 18c7c7f2b2e4c10851864395fe1e63e721336de1 /rts | |
parent | 993804bf40dea77c36f50ff772d112ec69c8a222 (diff) | |
download | haskell-5b713aa3d0159f5190e197e57765195a98ce9520.tar.gz |
Fix COMPACT_NFDATA closure size, more CNF sanity checking
We now do a shallow closure check on objects in compact regions.
See the new comment on why we can't do a "normal" closure check.
Diffstat (limited to 'rts')
-rw-r--r-- | rts/StgMiscClosures.cmm | 4 | ||||
-rw-r--r-- | rts/sm/Sanity.c | 46 |
2 files changed, 30 insertions, 20 deletions
diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm index b58cdc3874..03ea91fcb6 100644 --- a/rts/StgMiscClosures.cmm +++ b/rts/StgMiscClosures.cmm @@ -695,11 +695,11 @@ INFO_TABLE_CONSTR(stg_MVAR_TSO_QUEUE,2,0,0,PRIM,"MVAR_TSO_QUEUE","MVAR_TSO_QUEUE compaction is in progress and the hash table needs to be scanned by the GC. ------------------------------------------------------------------------- */ -INFO_TABLE( stg_COMPACT_NFDATA_CLEAN, 0, 5, COMPACT_NFDATA, "COMPACT_NFDATA", "COMPACT_NFDATA") +INFO_TABLE( stg_COMPACT_NFDATA_CLEAN, 0, 8, COMPACT_NFDATA, "COMPACT_NFDATA", "COMPACT_NFDATA") () { foreign "C" barf("COMPACT_NFDATA_CLEAN object (%p) entered!", R1) never returns; } -INFO_TABLE( stg_COMPACT_NFDATA_DIRTY, 0, 5, COMPACT_NFDATA, "COMPACT_NFDATA", "COMPACT_NFDATA") +INFO_TABLE( stg_COMPACT_NFDATA_DIRTY, 0, 8, COMPACT_NFDATA, "COMPACT_NFDATA", "COMPACT_NFDATA") () { foreign "C" barf("COMPACT_NFDATA_DIRTY object (%p) entered!", R1) never returns; } diff --git a/rts/sm/Sanity.c b/rts/sm/Sanity.c index ff76f747c9..3585bd93b4 100644 --- a/rts/sm/Sanity.c +++ b/rts/sm/Sanity.c @@ -79,14 +79,10 @@ checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap, uint32_t size ) * used to avoid recursion between checking PAPs and checking stack * chunks. */ - static void checkClosureShallow( const StgClosure* p ) { - const StgClosure *q; - - q = UNTAG_CONST_CLOSURE(p); - ASSERT(LOOKS_LIKE_CLOSURE_PTR(q)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(UNTAG_CONST_CLOSURE(p))); } // check an individual stack object @@ -223,6 +219,7 @@ checkClosureProfSanity(const StgClosure *p) } #endif +// Returns closure size in words StgOffset checkClosure( const StgClosure* p ) { @@ -464,11 +461,9 @@ checkClosure( const StgClosure* p ) void checkHeapChain (bdescr *bd) { - StgPtr p; - for (; bd != NULL; bd = bd->link) { if(!(bd->flags & BF_SWEPT)) { - p = bd->start; + StgPtr p = bd->start; while (p < bd->free) { uint32_t size = checkClosure((StgClosure *)p); /* This is the smallest size of closure that can live in the heap */ @@ -511,27 +506,42 @@ checkLargeObjects(bdescr *bd) static void checkCompactObjects(bdescr *bd) { - // Compact objects are similar to large objects, - // but they have a StgCompactNFDataBlock at the beginning, - // before the actual closure + // Compact objects are similar to large objects, but they have a + // StgCompactNFDataBlock at the beginning, before the actual closure for ( ; bd != NULL; bd = bd->link) { - StgCompactNFDataBlock *block, *last; - StgCompactNFData *str; - StgWord totalW; - ASSERT(bd->flags & BF_COMPACT); - block = (StgCompactNFDataBlock*)bd->start; - str = block->owner; + StgCompactNFDataBlock *block = (StgCompactNFDataBlock*)bd->start; + StgCompactNFData *str = block->owner; ASSERT((W_)str == (W_)block + sizeof(StgCompactNFDataBlock)); - totalW = 0; + StgWord totalW = 0; + StgCompactNFDataBlock *last; for ( ; block ; block = block->next) { last = block; ASSERT(block->owner == str); totalW += Bdescr((P_)block)->blocks * BLOCK_SIZE_W; + + StgPtr start = Bdescr((P_)block)->start + sizeofW(StgCompactNFDataBlock); + StgPtr free; + if (Bdescr((P_)block)->start == (P_)str->nursery) { + free = str->hp; + } else { + free = Bdescr((P_)block)->free; + } + StgPtr p = start; + while (p < free) { + // We can't use checkClosure() here because in + // compactAdd#/compactAddWithSharing# when we see a non- + // compactable object (a function, mutable object, or pinned + // object) we leave the location for the object in the payload + // empty. + StgClosure *c = (StgClosure*)p; + checkClosureShallow(c); + p += closure_sizeW(c); + } } ASSERT(str->totalW == totalW); |