X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FGC.c;h=47c30ae5e7ed00e654e0f310981cf6130a7565c8;hb=1ed01a871030f05905a9595e4837dfffc087ef64;hp=17211ac323a46a298e7f06a4af6d284b432c9585;hpb=354672b03f0d765145ada7821b5e001db22274dd;p=ghc-hetmet.git

diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 17211ac..47c30ae 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -124,6 +124,7 @@ static lnat g0s0_pcnt_kept = 30; // percentage of g0s0 live at last minor GC
 #ifdef DEBUG
 nat mutlist_MUTVARS,
     mutlist_MUTARRS,
+    mutlist_MVARS,
     mutlist_OTHERS;
 #endif
 
@@ -199,17 +200,19 @@ GarbageCollect ( rtsBool force_major_gc )
   lnat oldgen_saved_blocks = 0;
   nat g, s, i;
 
-  ACQUIRE_SM_LOCK;
-
 #ifdef PROFILING
   CostCentreStack *prev_CCS;
 #endif
 
+  ACQUIRE_SM_LOCK;
+
   debugTrace(DEBUG_gc, "starting GC");
 
 #if defined(RTS_USER_SIGNALS)
-  // block signals
-  blockUserSignals();
+  if (RtsFlags.MiscFlags.install_signal_handlers) {
+    // block signals
+    blockUserSignals();
+  }
 #endif
 
   // tell the STM to discard any cached closures its hoping to re-use
@@ -635,9 +638,9 @@ GarbageCollect ( rtsBool force_major_gc )
 	copied +=  mut_list_size;
 
 	debugTrace(DEBUG_gc,
-		   "mut_list_size: %lu (%d vars, %d arrays, %d others)",
+		   "mut_list_size: %lu (%d vars, %d arrays, %d MVARs, %d others)",
 		   (unsigned long)(mut_list_size * sizeof(W_)),
-		   mutlist_MUTVARS, mutlist_MUTARRS, mutlist_OTHERS);
+		   mutlist_MUTVARS, mutlist_MUTARRS, mutlist_MVARS, mutlist_OTHERS);
     }
 
     for (s = 0; s < generations[g].n_steps; s++) {
@@ -649,7 +652,7 @@ GarbageCollect ( rtsBool force_major_gc )
 	if (g <= N) {
 	  copied -= stp->hp_bd->start + BLOCK_SIZE_W -
 	    stp->hp_bd->free;
-	  scavd_copied -= (P_)(BLOCK_ROUND_UP(stp->scavd_hp)) - stp->scavd_hp;
+	  scavd_copied -= stp->scavd_hpLim - stp->scavd_hp;
 	}
       }
 
@@ -1014,8 +1017,10 @@ GarbageCollect ( rtsBool force_major_gc )
   stat_endGC(allocated, live, copied, scavd_copied, N);
 
 #if defined(RTS_USER_SIGNALS)
-  // unblock signals again
-  unblockUserSignals();
+  if (RtsFlags.MiscFlags.install_signal_handlers) {
+    // unblock signals again
+    unblockUserSignals();
+  }
 #endif
 
   RELEASE_SM_LOCK;
@@ -1027,6 +1032,7 @@ GarbageCollect ( rtsBool force_major_gc )
    closure if it is alive, or NULL otherwise.
 
    NOTE: Use it before compaction only!
+         It untags and (if needed) retags pointers to closures.
    -------------------------------------------------------------------------- */
 
 
@@ -1035,8 +1041,12 @@ isAlive(StgClosure *p)
 {
   const StgInfoTable *info;
   bdescr *bd;
+  StgWord tag;
 
   while (1) {
+    /* The tag and the pointer are split, to be merged later when needed. */
+    tag = GET_CLOSURE_TAG(p);
+    p = UNTAG_CLOSURE(p);
 
     ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
     info = get_itbl(p);
@@ -1048,18 +1058,18 @@ isAlive(StgClosure *p)
     // for static closures with an empty SRT or CONSTR_STATIC_NOCAFs.
     //
     if (!HEAP_ALLOCED(p)) {
-	return p;
+	return TAG_CLOSURE(tag,p);
     }
 
     // ignore closures in generations that we're not collecting. 
     bd = Bdescr((P_)p);
     if (bd->gen_no > N) {
-	return p;
+	return TAG_CLOSURE(tag,p);
     }
 
     // if it's a pointer into to-space, then we're done
     if (bd->flags & BF_EVACUATED) {
-	return p;
+	return TAG_CLOSURE(tag,p);
     }
 
     // large objects use the evacuated flag
@@ -1069,7 +1079,7 @@ isAlive(StgClosure *p)
 
     // check the mark bit for compacted steps
     if ((bd->flags & BF_COMPACTED) && is_marked((P_)p,bd)) {
-	return p;
+	return TAG_CLOSURE(tag,p);
     }
 
     switch (info->type) {