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

diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c
index 2613b9e..8d6126a 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;
@@ -626,7 +626,6 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
     case FETCH_ME_BQ:
     case RBH:
     case REMOTE_REF:
-    case EVACUATED:
     case INVALID_OBJECT:
     default:
 	barf("Invalid object *c in push()");
@@ -805,7 +804,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 +865,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 +873,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) {
@@ -990,7 +991,6 @@ pop( StgClosure **c, StgClosure **cp, retainer *r )
 	case FETCH_ME_BQ:
 	case RBH:
 	case REMOTE_REF:
-	case EVACUATED:
 	case INVALID_OBJECT:
 	default:
 	    barf("Invalid object *c in pop()");
@@ -1057,7 +1057,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:
@@ -1154,7 +1155,6 @@ isRetainer( StgClosure *c )
     case FETCH_ME_BQ:
     case RBH:
     case REMOTE_REF:
-    case EVACUATED:
     case INVALID_OBJECT:
     default:
 	barf("Invalid object in isRetainer(): %d", get_itbl(c)->type);
@@ -1440,7 +1440,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) {
@@ -1632,7 +1632,7 @@ inner_loop:
 #ifdef DEBUG_RETAINER
 	    debugBelch("ThreadRelocated encountered in retainClosure()\n");
 #endif
-	    c = (StgClosure *)((StgTSO *)c)->link;
+	    c = (StgClosure *)((StgTSO *)c)->_link;
 	    goto inner_loop;
 	}
 	break;
@@ -1797,7 +1797,7 @@ inner_loop:
  *  Compute the retainer set for every object reachable from *tl.
  * -------------------------------------------------------------------------- */
 static void
-retainRoot( StgClosure **tl )
+retainRoot(void *user STG_UNUSED, StgClosure **tl)
 {
     StgClosure *c;
 
@@ -1834,7 +1834,7 @@ computeRetainerSet( void )
     RetainerSet tmpRetainerSet;
 #endif
 
-    GetRoots(retainRoot);	// for scheduler roots
+    markCapabilities(retainRoot, NULL);	// for scheduler roots
 
     // This function is called after a major GC, when key, value, and finalizer
     // all are guaranteed to be valid, or reachable.
@@ -1843,10 +1843,10 @@ computeRetainerSet( void )
     // for retainer profilng.
     for (weak = weak_ptr_list; weak != NULL; weak = weak->link)
 	// retainRoot((StgClosure *)weak);
-	retainRoot((StgClosure **)&weak);
+	retainRoot(NULL, (StgClosure **)&weak);
 
     // Consider roots from the stable ptr table.
-    markStablePtrTable(retainRoot);
+    markStablePtrTable(retainRoot, NULL);
 
     // The following code resets the rs field of each unvisited mutable
     // object (computing sumOfNewCostExtra and updating costArray[] when
@@ -1910,7 +1910,7 @@ computeRetainerSet( void )
  *    they are not taken into consideration in computing retainer sets.
  * -------------------------------------------------------------------------- */
 void
-resetStaticObjectForRetainerProfiling( void )
+resetStaticObjectForRetainerProfiling( StgClosure *static_objects )
 {
 #ifdef DEBUG_RETAINER
     nat count;
@@ -1920,7 +1920,7 @@ resetStaticObjectForRetainerProfiling( void )
 #ifdef DEBUG_RETAINER
     count = 0;
 #endif
-    p = scavenged_static_objects;
+    p = static_objects;
     while (p != END_OF_STATIC_LIST) {
 #ifdef DEBUG_RETAINER
 	count++;
@@ -2167,7 +2167,7 @@ smallObjectPoolCheck(void)
     StgPtr p;
     static nat costSum, size;
 
-    bd = small_alloc_list;
+    bd = g0s0->blocks;
     costSum = 0;
 
     // first block