X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FRetainerProfile.c;h=f75250659cebb9b6806c77c0a98dbaa8095ab7de;hp=9f29acae193b46467fdb44488e4760d29fe96fb4;hb=refs%2Ftags%2FBefore_type_family_merge;hpb=23e5985c3db852981d527d10d6a6271688049790

diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c
index 9f29aca..f752506 100644
--- a/rts/RetainerProfile.c
+++ b/rts/RetainerProfile.c
@@ -364,8 +364,7 @@ find_srt( stackPos *info )
 	bitmap = info->next.srt.srt_bitmap;
 	while (bitmap != 0) {
 	    if ((bitmap & 1) != 0) {
-#ifdef ENABLE_WIN32_DLL_SUPPORT
-		
+#if defined(__PIC__) && defined(mingw32_TARGET_OS)
 		if ((unsigned long)(*(info->next.srt.srt)) & 0x1)
 		    c = (* (StgClosure **)((unsigned long)*(info->next.srt.srt)) & ~0x1);
 		else
@@ -1440,7 +1439,7 @@ retainStack( StgClosure *c, retainer c_child_r,
 	    StgFunInfoTable *fun_info;
 	    
 	    retainClosure(ret_fun->fun, c, c_child_r);
-	    fun_info = get_fun_itbl(ret_fun->fun);
+	    fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
 	    
 	    p = (P_)&ret_fun->payload;
 	    switch (fun_info->f.fun_type) {
@@ -1486,7 +1485,9 @@ retainStack( StgClosure *c, retainer c_child_r,
  * ------------------------------------------------------------------------- */
 
 static INLINE StgPtr
-retain_PAP_payload (StgClosure *pap,  retainer c_child_r, StgClosure *fun, 
+retain_PAP_payload (StgClosure *pap,    /* NOT tagged */
+                    retainer c_child_r, /* NOT tagged */ 
+                    StgClosure *fun,    /* tagged */
 		    StgClosure** payload, StgWord n_args)
 {
     StgPtr p;
@@ -1494,6 +1495,7 @@ retain_PAP_payload (StgClosure *pap,  retainer c_child_r, StgClosure *fun,
     StgFunInfoTable *fun_info;
 
     retainClosure(fun, pap, c_child_r);
+    fun = UNTAG_CLOSURE(fun);
     fun_info = get_fun_itbl(fun);
     ASSERT(fun_info->i.type != PAP);
 
@@ -1542,9 +1544,9 @@ retain_PAP_payload (StgClosure *pap,  retainer c_child_r, StgClosure *fun,
 static void
 retainClosure( StgClosure *c0, StgClosure *cp0, retainer r0 )
 {
-    // c = Current closure
-    // cp = Current closure's Parent
-    // r = current closures' most recent Retainer
+    // c = Current closure                          (possibly tagged)
+    // cp = Current closure's Parent                (NOT tagged)
+    // r = current closures' most recent Retainer   (NOT tagged)
     // c_child_r = current closure's children's most recent retainer
     // first_child = first child of c
     StgClosure *c, *cp, *first_child;
@@ -1582,6 +1584,8 @@ loop:
     //debugBelch("inner_loop");
 
 inner_loop:
+    c = UNTAG_CLOSURE(c);
+
     // c  = current closure under consideration,
     // cp = current closure's parent,
     // r  = current closure's most recent retainer
@@ -1794,16 +1798,19 @@ inner_loop:
 static void
 retainRoot( StgClosure **tl )
 {
+    StgClosure *c;
+
     // We no longer assume that only TSOs and WEAKs are roots; any closure can
     // be a root.
 
     ASSERT(isEmptyRetainerStack());
     currentStackBoundary = stackTop;
 
-    if (*tl != &stg_END_TSO_QUEUE_closure && isRetainer(*tl)) {
-	retainClosure(*tl, *tl, getRetainerFrom(*tl));
+    c = UNTAG_CLOSURE(*tl);
+    if (c != &stg_END_TSO_QUEUE_closure && isRetainer(c)) {
+	retainClosure(c, c, getRetainerFrom(c));
     } else {
-	retainClosure(*tl, *tl, CCS_SYSTEM);
+	retainClosure(c, c, CCS_SYSTEM);
     }
 
     // NOT TRUE: ASSERT(isMember(getRetainerFrom(*tl), retainerSetOf(*tl)));