X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSanity.c;h=25a76c00002d1f44df85b13b1fa4dc25e8ed88e0;hb=d5a9ee0e98a76bca1b41bbc5252e851c88b3ff4c;hp=33ec988106b164efb3d3097e46b2c85e3775d02c;hpb=a0be7e7ccd602efd9b7d35b3e0747a2c4f155ce9;p=ghc-hetmet.git diff --git a/rts/Sanity.c b/rts/Sanity.c index 33ec988..25a76c0 100644 --- a/rts/Sanity.c +++ b/rts/Sanity.c @@ -80,13 +80,16 @@ checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap, nat size ) static void checkClosureShallow( StgClosure* p ) { - ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); + StgClosure *q; + + q = UNTAG_CLOSURE(p); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(q)); /* Is it a static closure? */ - if (!HEAP_ALLOCED(p)) { - ASSERT(closure_STATIC(p)); + if (!HEAP_ALLOCED(q)) { + ASSERT(closure_STATIC(q)); } else { - ASSERT(!closure_STATIC(p)); + ASSERT(!closure_STATIC(q)); } } @@ -137,7 +140,6 @@ checkStackFrame( StgPtr c ) // small bitmap cases (<= 32 entries) case STOP_FRAME: case RET_SMALL: - case RET_VEC_SMALL: size = BITMAP_SIZE(info->i.layout.bitmap); checkSmallBitmap((StgPtr)c + 1, BITMAP_BITS(info->i.layout.bitmap), size); @@ -153,7 +155,6 @@ checkStackFrame( StgPtr c ) } case RET_BIG: // large bitmap (> 32 entries) - case RET_VEC_BIG: size = GET_LARGE_BITMAP(&info->i)->size; checkLargeBitmap((StgPtr)c + 1, GET_LARGE_BITMAP(&info->i), size); return 1 + size; @@ -164,7 +165,7 @@ checkStackFrame( StgPtr c ) StgRetFun *ret_fun; ret_fun = (StgRetFun *)c; - fun_info = get_fun_itbl(ret_fun->fun); + fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun)); size = ret_fun->size; switch (fun_info->f.fun_type) { case ARG_GEN: @@ -208,6 +209,7 @@ checkPAP (StgClosure *fun, StgClosure** payload, StgWord n_args) StgClosure *p; StgFunInfoTable *fun_info; + fun = UNTAG_CLOSURE(fun); ASSERT(LOOKS_LIKE_CLOSURE_PTR(fun)); fun_info = get_fun_itbl(fun); @@ -233,6 +235,9 @@ checkPAP (StgClosure *fun, StgClosure** payload, StgWord n_args) n_args ); break; } + + ASSERT(fun_info->f.arity > TAG_MASK ? GET_CLOSURE_TAG(fun) == 1 + : GET_CLOSURE_TAG(fun) == fun_info->f.arity); } @@ -243,6 +248,7 @@ checkClosure( StgClosure* p ) ASSERT(LOOKS_LIKE_INFO_PTR(p->header.info)); + p = UNTAG_CLOSURE(p); /* Is it a static closure (i.e. in the data segment)? */ if (!HEAP_ALLOCED(p)) { ASSERT(closure_STATIC(p)); @@ -253,7 +259,8 @@ checkClosure( StgClosure* p ) info = get_itbl(p); switch (info->type) { - case MVAR: + case MVAR_CLEAN: + case MVAR_DIRTY: { StgMVar *mvar = (StgMVar *)p; ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->head)); @@ -324,7 +331,6 @@ checkClosure( StgClosure* p ) ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->instrs)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->literals)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->ptrs)); - ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->itbls)); return bco_sizeW(bco); } @@ -362,9 +368,7 @@ checkClosure( StgClosure* p ) case RET_BCO: case RET_SMALL: - case RET_VEC_SMALL: case RET_BIG: - case RET_VEC_BIG: case RET_DYN: case UPDATE_FRAME: case STOP_FRAME: @@ -447,19 +451,36 @@ checkClosure( StgClosure* p ) #endif - case TVAR_WAIT_QUEUE: + case TVAR_WATCH_QUEUE: { - StgTVarWaitQueue *wq = (StgTVarWaitQueue *)p; + StgTVarWatchQueue *wq = (StgTVarWatchQueue *)p; ASSERT(LOOKS_LIKE_CLOSURE_PTR(wq->next_queue_entry)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(wq->prev_queue_entry)); - return sizeofW(StgTVarWaitQueue); + return sizeofW(StgTVarWatchQueue); + } + + case INVARIANT_CHECK_QUEUE: + { + StgInvariantCheckQueue *q = (StgInvariantCheckQueue *)p; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(q->invariant)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(q->my_execution)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(q->next_queue_entry)); + return sizeofW(StgInvariantCheckQueue); + } + + case ATOMIC_INVARIANT: + { + StgAtomicInvariant *invariant = (StgAtomicInvariant *)p; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(invariant->code)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(invariant->last_execution)); + return sizeofW(StgAtomicInvariant); } case TVAR: { StgTVar *tv = (StgTVar *)p; ASSERT(LOOKS_LIKE_CLOSURE_PTR(tv->current_value)); - ASSERT(LOOKS_LIKE_CLOSURE_PTR(tv->first_wait_queue_entry)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tv->first_watch_queue_entry)); return sizeofW(StgTVar); } @@ -803,7 +824,7 @@ checkStaticObjects ( StgClosure* static_objects ) switch (info->type) { case IND_STATIC: { - StgClosure *indirectee = ((StgIndStatic *)p)->indirectee; + StgClosure *indirectee = UNTAG_CLOSURE(((StgIndStatic *)p)->indirectee); ASSERT(LOOKS_LIKE_CLOSURE_PTR(indirectee)); ASSERT(LOOKS_LIKE_INFO_PTR(indirectee->header.info));