X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FRetainerProfile.c;h=e96356734dbb8a8046c61a0d98d7b1a6b6c0ec7b;hb=9d03becc597e5b1ab6c8466209a1263bf8ba6f29;hp=2613b9e4bce455953b4a56a583a9e8ccb4c4727e;hpb=6015a94f9108a502150565577b66c23650796639;p=ghc-hetmet.git

diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c
index 2613b9e..e963567 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
@@ -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) {
@@ -2167,7 +2170,7 @@ smallObjectPoolCheck(void)
     StgPtr p;
     static nat costSum, size;
 
-    bd = small_alloc_list;
+    bd = g0s0->blocks;
     costSum = 0;
 
     // first block