X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSanity.c;h=c9a07725430cba314aac8b0d185239d2d4924a59;hb=eb78c4c6e41782beaa27c44225ca8d459978319c;hp=7de8ec7d0a906d1b48c617e2e10e427269b3ceec;hpb=9ff76535edb25ab7434284adddb5c64708ecb547;p=ghc-hetmet.git

diff --git a/rts/Sanity.c b/rts/Sanity.c
index 7de8ec7..c9a0772 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));
     }
 }
 
@@ -162,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:
@@ -201,11 +204,13 @@ checkStackChunk( StgPtr sp, StgPtr stack_end )
 }
 
 static void
-checkPAP (StgClosure *fun, StgClosure** payload, StgWord n_args)
+checkPAP (StgClosure *tagged_fun, StgClosure** payload, StgWord n_args)
 { 
+    StgClosure *fun;
     StgClosure *p;
     StgFunInfoTable *fun_info;
     
+    fun = UNTAG_CLOSURE(tagged_fun);
     ASSERT(LOOKS_LIKE_CLOSURE_PTR(fun));
     fun_info = get_fun_itbl(fun);
     
@@ -231,6 +236,9 @@ checkPAP (StgClosure *fun, StgClosure** payload, StgWord n_args)
 			  n_args );
 	break;
     }
+
+    ASSERT(fun_info->f.arity > TAG_MASK ? GET_CLOSURE_TAG(tagged_fun) == 1
+           : GET_CLOSURE_TAG(tagged_fun) == fun_info->f.arity);
 }
 
 
@@ -241,6 +249,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));
@@ -251,7 +260,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));
@@ -815,7 +825,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));