X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSanity.c;h=25a76c00002d1f44df85b13b1fa4dc25e8ed88e0;hb=50c4d03919a9d5c37c14004e964083251f655e93;hp=0e68a86ba78d8b7edefd8c61b8e895e29f8cd04a;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/rts/Sanity.c b/rts/Sanity.c
index 0e68a86..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));
@@ -307,8 +314,6 @@ checkClosure( StgClosure* p )
     case STABLE_NAME:
     case MUT_VAR_CLEAN:
     case MUT_VAR_DIRTY:
-    case CONSTR_INTLIKE:
-    case CONSTR_CHARLIKE:
     case CONSTR_STATIC:
     case CONSTR_NOCAF_STATIC:
     case THUNK_STATIC:
@@ -326,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);
     }
 
@@ -364,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:
@@ -449,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);
       }
 
@@ -805,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));