X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FScav.c;h=54fe9a472a7066e5e73860f9bf6a535c5742e767;hb=53a442f10d80cd85b33620a023c4a8749a7c0b20;hp=26b33f479e5eaa3595fa87ae7b5c1cfcbc2e3926;hpb=ab0e778ccfde61aed4c22679b24d175fc6cc9bf3;p=ghc-hetmet.git

diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index 26b33f4..54fe9a4 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -4,6 +4,11 @@
  *
  * Generational garbage collector: scavenging functions
  *
+ * Documentation on the architecture of the Garbage Collector can be
+ * found in the online commentary:
+ * 
+ *   http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC
+ *
  * ---------------------------------------------------------------------------*/
 
 #include "Rts.h"
@@ -72,7 +77,7 @@ scavenge_srt (StgClosure **srt, nat srt_bitmap)
 
   while (bitmap != 0) {
       if ((bitmap & 1) != 0) {
-#ifdef ENABLE_WIN32_DLL_SUPPORT
+#if defined(__PIC__) && defined(mingw32_TARGET_OS)
 	  // Special-case to handle references to closures hiding out in DLLs, since
 	  // double indirections required to get at those. The code generator knows
 	  // which is which when generating the SRT, so it stores the (indirect)
@@ -128,10 +133,6 @@ scavengeTSO (StgTSO *tso)
     if (   tso->why_blocked == BlockedOnMVar
 	|| tso->why_blocked == BlockedOnBlackHole
 	|| tso->why_blocked == BlockedOnException
-#if defined(PAR)
-	|| tso->why_blocked == BlockedOnGA
-	|| tso->why_blocked == BlockedOnGA_NoSend
-#endif
 	) {
 	tso->block_info.closure = evacuate(tso->block_info.closure);
     }
@@ -199,7 +200,7 @@ scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
     StgWord bitmap;
     StgFunInfoTable *fun_info;
     
-    fun_info = get_fun_itbl(fun);
+    fun_info = get_fun_itbl(UNTAG_CLOSURE(fun));
     ASSERT(fun_info->i.type != PAP);
     p = (StgPtr)payload;
 
@@ -292,15 +293,23 @@ scavenge(step *stp)
     q = p;
     switch (info->type) {
 
-    case MVAR:
+    case MVAR_CLEAN:
+    case MVAR_DIRTY:
     { 
+	rtsBool saved_eager_promotion = eager_promotion;
+
 	StgMVar *mvar = ((StgMVar *)p);
-	evac_gen = 0;
+	eager_promotion = rtsFalse;
 	mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
 	mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
 	mvar->value = evacuate((StgClosure *)mvar->value);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable.
+	eager_promotion = saved_eager_promotion;
+
+	if (failed_to_evac) {
+	    mvar->header.info = &stg_MVAR_DIRTY_info;
+	} else {
+	    mvar->header.info = &stg_MVAR_CLEAN_info;
+	}
 	p += sizeofW(StgMVar);
 	break;
     }
@@ -410,7 +419,6 @@ scavenge(step *stp)
 	bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs);
 	bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals);
 	bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs);
-	bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls);
 	p += bco_sizeW(bco);
 	break;
     }
@@ -563,60 +571,6 @@ scavenge(step *stp)
 	break;
     }
 
-#if defined(PAR)
-    case RBH:
-    { 
-#if 0
-	nat size, ptrs, nonptrs, vhs;
-	char str[80];
-	StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str);
-#endif
-	StgRBH *rbh = (StgRBH *)p;
-	(StgClosure *)rbh->blocking_queue = 
-	    evacuate((StgClosure *)rbh->blocking_queue);
-	failed_to_evac = rtsTrue;  // mutable anyhow.
-	debugTrace(DEBUG_gc, "scavenge: RBH %p (%s) (new blocking_queue link=%p)",
-		   p, info_type(p), (StgClosure *)rbh->blocking_queue);
-	// ToDo: use size of reverted closure here!
-	p += BLACKHOLE_sizeW(); 
-	break;
-    }
-
-    case BLOCKED_FETCH:
-    { 
-	StgBlockedFetch *bf = (StgBlockedFetch *)p;
-	// follow the pointer to the node which is being demanded 
-	(StgClosure *)bf->node = 
-	    evacuate((StgClosure *)bf->node);
-	// follow the link to the rest of the blocking queue 
-	(StgClosure *)bf->link = 
-	    evacuate((StgClosure *)bf->link);
-	debugTrace(DEBUG_gc, "scavenge: %p (%s); node is now %p; exciting, isn't it",
-		   bf, info_type((StgClosure *)bf), 
-		   bf->node, info_type(bf->node)));
-	p += sizeofW(StgBlockedFetch);
-	break;
-    }
-
-#ifdef DIST
-    case REMOTE_REF:
-#endif
-    case FETCH_ME:
-	p += sizeofW(StgFetchMe);
-	break; // nothing to do in this case
-
-    case FETCH_ME_BQ:
-    { 
-	StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
-	(StgClosure *)fmbq->blocking_queue = 
-	    evacuate((StgClosure *)fmbq->blocking_queue);
-	debugTrace(DEBUG_gc, "scavenge: %p (%s) exciting, isn't it",
-		   p, info_type((StgClosure *)p)));
-	p += sizeofW(StgFetchMeBlockingQueue);
-	break;
-    }
-#endif
-
     case TVAR_WATCH_QUEUE:
       {
 	StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p);
@@ -750,17 +704,25 @@ linear_scan:
 	q = p;
 	switch (info->type) {
 	    
-	case MVAR:
-	{
-	    StgMVar *mvar = ((StgMVar *)p);
-	    evac_gen = 0;
-	    mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
-	    mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
-	    mvar->value = evacuate((StgClosure *)mvar->value);
-	    evac_gen = saved_evac_gen;
-	    failed_to_evac = rtsTrue; // mutable.
-	    break;
-	}
+        case MVAR_CLEAN:
+        case MVAR_DIRTY:
+        { 
+            rtsBool saved_eager_promotion = eager_promotion;
+            
+            StgMVar *mvar = ((StgMVar *)p);
+            eager_promotion = rtsFalse;
+            mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
+            mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
+            mvar->value = evacuate((StgClosure *)mvar->value);
+            eager_promotion = saved_eager_promotion;
+            
+            if (failed_to_evac) {
+                mvar->header.info = &stg_MVAR_DIRTY_info;
+            } else {
+                mvar->header.info = &stg_MVAR_CLEAN_info;
+            }
+            break;
+        }
 
 	case FUN_2_0:
 	    scavenge_fun_srt(info);
@@ -845,7 +807,6 @@ linear_scan:
 	    bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs);
 	    bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals);
 	    bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs);
-	    bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls);
 	    break;
 	}
 
@@ -978,55 +939,6 @@ linear_scan:
 	    break;
 	}
 
-#if defined(PAR)
-	case RBH:
-	{ 
-#if 0
-	    nat size, ptrs, nonptrs, vhs;
-	    char str[80];
-	    StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str);
-#endif
-	    StgRBH *rbh = (StgRBH *)p;
-	    bh->blocking_queue = 
-		(StgTSO *)evacuate((StgClosure *)bh->blocking_queue);
-	    failed_to_evac = rtsTrue;  // mutable anyhow.
-	    debugTrace(DEBUG_gc, "scavenge: RBH %p (%s) (new blocking_queue link=%p)",
-		       p, info_type(p), (StgClosure *)rbh->blocking_queue));
-	    break;
-	}
-	
-	case BLOCKED_FETCH:
-	{ 
-	    StgBlockedFetch *bf = (StgBlockedFetch *)p;
-	    // follow the pointer to the node which is being demanded 
-	    (StgClosure *)bf->node = 
-		evacuate((StgClosure *)bf->node);
-	    // follow the link to the rest of the blocking queue 
-	    (StgClosure *)bf->link = 
-		evacuate((StgClosure *)bf->link);
-	    debugTrace(DEBUG_gc, "scavenge: %p (%s); node is now %p; exciting, isn't it",
-		       bf, info_type((StgClosure *)bf), 
-		       bf->node, info_type(bf->node)));
-	    break;
-	}
-
-#ifdef DIST
-	case REMOTE_REF:
-#endif
-	case FETCH_ME:
-	    break; // nothing to do in this case
-
-	case FETCH_ME_BQ:
-	{ 
-	    StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
-	    (StgClosure *)fmbq->blocking_queue = 
-		evacuate((StgClosure *)fmbq->blocking_queue);
-	    debugTrace(DEBUG_gc, "scavenge: %p (%s) exciting, isn't it",
-		       p, info_type((StgClosure *)p)));
-	    break;
-	}
-#endif /* PAR */
-
 	case TVAR_WATCH_QUEUE:
 	  {
 	    StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p);
@@ -1178,15 +1090,23 @@ scavenge_one(StgPtr p)
     
     switch (info->type) {
 	
-    case MVAR:
+    case MVAR_CLEAN:
+    case MVAR_DIRTY:
     { 
+	rtsBool saved_eager_promotion = eager_promotion;
+
 	StgMVar *mvar = ((StgMVar *)p);
-	evac_gen = 0;
+	eager_promotion = rtsFalse;
 	mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
 	mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
 	mvar->value = evacuate((StgClosure *)mvar->value);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable.
+	eager_promotion = saved_eager_promotion;
+
+	if (failed_to_evac) {
+	    mvar->header.info = &stg_MVAR_DIRTY_info;
+	} else {
+	    mvar->header.info = &stg_MVAR_CLEAN_info;
+	}
 	break;
     }
 
@@ -1351,57 +1271,6 @@ scavenge_one(StgPtr p)
 	break;
     }
   
-#if defined(PAR)
-    case RBH:
-    { 
-#if 0
-	nat size, ptrs, nonptrs, vhs;
-	char str[80];
-	StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str);
-#endif
-	StgRBH *rbh = (StgRBH *)p;
-	(StgClosure *)rbh->blocking_queue = 
-	    evacuate((StgClosure *)rbh->blocking_queue);
-	failed_to_evac = rtsTrue;  // mutable anyhow.
-	debugTrace(DEBUG_gc, "scavenge: RBH %p (%s) (new blocking_queue link=%p)",
-		   p, info_type(p), (StgClosure *)rbh->blocking_queue));
-	// ToDo: use size of reverted closure here!
-	break;
-    }
-
-    case BLOCKED_FETCH:
-    { 
-	StgBlockedFetch *bf = (StgBlockedFetch *)p;
-	// follow the pointer to the node which is being demanded 
-	(StgClosure *)bf->node = 
-	    evacuate((StgClosure *)bf->node);
-	// follow the link to the rest of the blocking queue 
-	(StgClosure *)bf->link = 
-	    evacuate((StgClosure *)bf->link);
-	debugTrace(DEBUG_gc,
-		   "scavenge: %p (%s); node is now %p; exciting, isn't it",
-		   bf, info_type((StgClosure *)bf), 
-		   bf->node, info_type(bf->node)));
-	break;
-    }
-
-#ifdef DIST
-    case REMOTE_REF:
-#endif
-    case FETCH_ME:
-	break; // nothing to do in this case
-
-    case FETCH_ME_BQ:
-    { 
-	StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
-	(StgClosure *)fmbq->blocking_queue = 
-	    evacuate((StgClosure *)fmbq->blocking_queue);
-	debugTrace(DEBUG_gc, "scavenge: %p (%s) exciting, isn't it",
-		   p, info_type((StgClosure *)p)));
-	break;
-    }
-#endif
-
     case TVAR_WATCH_QUEUE:
       {
 	StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p);
@@ -1564,6 +1433,10 @@ scavenge_mutable_list(generation *gen)
 	    case MUT_ARR_PTRS_FROZEN:
 	    case MUT_ARR_PTRS_FROZEN0:
 		mutlist_MUTARRS++; break;
+	    case MVAR_CLEAN:
+		barf("MVAR_CLEAN on mutable list");
+	    case MVAR_DIRTY:
+		mutlist_MVARS++; break;
 	    default:
 		mutlist_OTHERS++; break;
 	    }
@@ -1804,7 +1677,6 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
     case STOP_FRAME:
     case CATCH_FRAME:
     case RET_SMALL:
-    case RET_VEC_SMALL:
 	bitmap = BITMAP_BITS(info->i.layout.bitmap);
 	size   = BITMAP_SIZE(info->i.layout.bitmap);
 	// NOTE: the payload starts immediately after the info-ptr, we
@@ -1833,7 +1705,6 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
 
       // large bitmap (> 32 entries, or > 64 on a 64-bit machine) 
     case RET_BIG:
-    case RET_VEC_BIG:
     {
 	nat size;
 
@@ -1877,7 +1748,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
 	StgFunInfoTable *fun_info;
 
 	ret_fun->fun = evacuate(ret_fun->fun);
- 	fun_info = get_fun_itbl(ret_fun->fun);
+ 	fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
 	p = scavenge_arg_block(fun_info, ret_fun->payload);
 	goto follow_srt;
     }