X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Frts%2FRetainerProfile.c;h=bf52fcee720fa8affb1b58914275eb5aa7af5695;hb=ead9311db6e098b3affdc552269ea52bad8c12b5;hp=10bed44931aeadcac48e9f8ce7b82835bfde55ad;hpb=3f4fd743381cce0b111d92246772f0be8938f7a7;p=ghc-hetmet.git

diff --git a/ghc/rts/RetainerProfile.c b/ghc/rts/RetainerProfile.c
index 10bed44..bf52fce 100644
--- a/ghc/rts/RetainerProfile.c
+++ b/ghc/rts/RetainerProfile.c
@@ -466,11 +466,6 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
     case MUT_VAR:
 	*first_child = ((StgMutVar *)c)->var;
 	return;
-    case BLACKHOLE_BQ:
-	// blocking_queue must be TSO and the head of a linked list of TSOs.
-	// Shoule it be a child? Seems to be yes.
-	*first_child = (StgClosure *)((StgBlockingQueue *)c)->blocking_queue;
-	return;
     case THUNK_SELECTOR:
 	*first_child = ((StgSelector *)c)->selectee;
 	return;
@@ -548,7 +543,8 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
 
     case THUNK:
     case THUNK_2_0:
-	init_ptrs(&se.info, get_itbl(c)->layout.payload.ptrs, (StgPtr)c->payload);
+	init_ptrs(&se.info, get_itbl(c)->layout.payload.ptrs, 
+		  (StgPtr)((StgThunk *)c)->payload);
 	*first_child = find_ptrs(&se.info);
 	if (*first_child == NULL)
 	    // no child from ptrs, so check SRT
@@ -565,7 +561,7 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
 
     case THUNK_1_0:
     case THUNK_1_1:
-	*first_child = c->payload[0];
+	*first_child = ((StgThunk *)c)->payload[0];
 	ASSERT(*first_child != NULL);
 	init_srt_thunk(&se.info, get_thunk_itbl(c));
 	break;
@@ -894,7 +890,6 @@ pop( StgClosure **c, StgClosure **cp, retainer *r )
 	case ARR_WORDS:
 	    // one child (fixed), no SRT
 	case MUT_VAR:
-	case BLACKHOLE_BQ:
 	case THUNK_SELECTOR:
 	case IND_PERM:
 	case IND_OLDGEN_PERM:
@@ -1042,7 +1037,6 @@ isRetainer( StgClosure *c )
     case BLACKHOLE:
     case SE_BLACKHOLE:
     case SE_CAF_BLACKHOLE:
-    case BLACKHOLE_BQ:
 	// indirection
     case IND_PERM:
     case IND_OLDGEN_PERM:
@@ -1416,39 +1410,38 @@ retainStack( StgClosure *c, retainer c_child_r,
  * ------------------------------------------------------------------------- */
 
 static INLINE StgPtr
-retain_PAP (StgPAP *pap, retainer c_child_r)
+retain_PAP_payload (StgClosure *pap,  retainer c_child_r, StgClosure *fun, 
+		    StgClosure** payload, StgWord n_args)
 {
     StgPtr p;
-    StgWord bitmap, size;
+    StgWord bitmap;
     StgFunInfoTable *fun_info;
 
-    retainClosure(pap->fun, (StgClosure *)pap, c_child_r);
-    fun_info = get_fun_itbl(pap->fun);
+    retainClosure(fun, pap, c_child_r);
+    fun_info = get_fun_itbl(fun);
     ASSERT(fun_info->i.type != PAP);
 
-    p = (StgPtr)pap->payload;
-    size = pap->n_args;
+    p = (StgPtr)payload;
 
     switch (fun_info->f.fun_type) {
     case ARG_GEN:
 	bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
-	p = retain_small_bitmap(p, pap->n_args, bitmap, 
-				(StgClosure *)pap, c_child_r);
+	p = retain_small_bitmap(p, n_args, bitmap, 
+				pap, c_child_r);
 	break;
     case ARG_GEN_BIG:
 	retain_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info),
-			    size, (StgClosure *)pap, c_child_r);
-	p += size;
+			    n_args, pap, c_child_r);
+	p += n_args;
 	break;
     case ARG_BCO:
-	retain_large_bitmap((StgPtr)pap->payload, BCO_BITMAP(pap->fun),
-			    size, (StgClosure *)pap, c_child_r);
-	p += size;
+	retain_large_bitmap((StgPtr)payload, BCO_BITMAP(fun),
+			    n_args, pap, c_child_r);
+	p += n_args;
 	break;
     default:
 	bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
-	p = retain_small_bitmap(p, pap->n_args, bitmap, 
-				(StgClosure *)pap, c_child_r);
+	p = retain_small_bitmap(p, n_args, bitmap, pap, c_child_r);
 	break;
     }
     return p;
@@ -1686,9 +1679,18 @@ inner_loop:
 	goto loop;
 
     case PAP:
+    {
+	StgPAP *pap = (StgPAP *)c;
+	retain_PAP_payload(c, c_child_r, pap->fun, pap->payload, pap->n_args);
+	goto loop;
+    }
+
     case AP:
-	retain_PAP((StgPAP *)c, c_child_r);
+    {
+	StgAP *ap = (StgAP *)c;
+	retain_PAP_payload(c, c_child_r, ap->fun, ap->payload, ap->n_args);
 	goto loop;
+    }
 
     case AP_STACK:
 	retainClosure(((StgAP_STACK *)c)->fun, c, c_child_r);
@@ -1849,19 +1851,19 @@ resetStaticObjectForRetainerProfiling( void )
 	    // Since we do not compute the retainer set of any
 	    // IND_STATIC object, we don't have to reset its retainer
 	    // field.
-	    p = IND_STATIC_LINK(p);
+	    p = (StgClosure*)*IND_STATIC_LINK(p);
 	    break;
 	case THUNK_STATIC:
 	    maybeInitRetainerSet(p);
-	    p = THUNK_STATIC_LINK(p);
+	    p = (StgClosure*)*THUNK_STATIC_LINK(p);
 	    break;
 	case FUN_STATIC:
 	    maybeInitRetainerSet(p);
-	    p = FUN_STATIC_LINK(p);
+	    p = (StgClosure*)*FUN_STATIC_LINK(p);
 	    break;
 	case CONSTR_STATIC:
 	    maybeInitRetainerSet(p);
-	    p = STATIC_LINK(get_itbl(p), p);
+	    p = (StgClosure*)*STATIC_LINK(get_itbl(p), p);
 	    break;
 	default:
 	    barf("resetStaticObjectForRetainerProfiling: %p (%s)",
@@ -2102,7 +2104,6 @@ sanityCheckHeapClosure( StgClosure *c )
     case BLACKHOLE:
     case SE_BLACKHOLE:
     case SE_CAF_BLACKHOLE:
-    case BLACKHOLE_BQ:
     case IND_PERM:
     case IND_OLDGEN:
     case IND_OLDGEN_PERM: