don't make -ddump-if-trace imply -no-recomp

[ghc-hetmet.git] / rts / RetainerProfile.c

diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c
index 9f29aca..e963567 100644 (file)
--- 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
@@ -492,7 +491,8 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
 
        // three children (fixed), no SRT
        // need to push a stackElement
-    case MVAR:
+    case MVAR_CLEAN:
+    case MVAR_DIRTY:
        // head must be TSO and the head of a linked list of TSOs.
        // Shoule it be a child? Seems to be yes.
        *first_child = (StgClosure *)((StgMVar *)c)->head;
@@ -805,7 +805,8 @@ pop( StgClosure **c, StgClosure **cp, retainer *r )
 
            // three children (fixed), no SRT
            // need to push a stackElement
-       case MVAR:
+        case MVAR_CLEAN:
+        case MVAR_DIRTY:
            if (se->info.next.step == 2) {
                *c = (StgClosure *)((StgMVar *)se->c)->tail;
                se->info.next.step++;             // move to the next step
@@ -865,6 +866,7 @@ pop( StgClosure **c, StgClosure **cp, retainer *r )
            // we divide the step counter: the 2 low bits indicate
            // which field, and the rest of the bits indicate the
            // entry number (starting from zero).
+           TRecEntry *entry;
            nat entry_no = se->info.next.step >> 2;
            nat field_no = se->info.next.step & 3;
            if (entry_no == ((StgTRecChunk *)se->c)->next_entry_idx) {
@@ -872,7 +874,7 @@ pop( StgClosure **c, StgClosure **cp, retainer *r )
                popOff();
                return;
            }
-           TRecEntry *entry = &((StgTRecChunk *)se->c)->entries[entry_no];
+           entry = &((StgTRecChunk *)se->c)->entries[entry_no];
            if (field_no == 0) {
                *c = (StgClosure *)entry->tvar;
            } else if (field_no == 1) {
@@ -1057,7 +1059,8 @@ isRetainer( StgClosure *c )
     case TSO:
 
        // mutable objects
-    case MVAR:
+    case MVAR_CLEAN:
+    case MVAR_DIRTY:
     case MUT_VAR_CLEAN:
     case MUT_VAR_DIRTY:
     case MUT_ARR_PTRS_CLEAN:
@@ -1440,7 +1443,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 +1489,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 +1499,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 +1548,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 +1588,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 +1802,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)));
@@ -2159,7 +2170,7 @@ smallObjectPoolCheck(void)
     StgPtr p;
     static nat costSum, size;
 
-    bd = small_alloc_list;
+    bd = g0s0->blocks;
     costSum = 0;
 
     // first block