X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Frts%2FGCCompact.c;h=ea2e474a1dd797e3fd0dc0f62197259c4f3702b8;hb=5ac854ef908d3f93164bad991b18944fc3a9db35;hp=9ddd4140508e589e8a2bf9d692381335626cfdcc;hpb=cf0bdd4b5f3633874ac49b499f3d4914c705dc8c;p=ghc-hetmet.git

diff --git a/ghc/rts/GCCompact.c b/ghc/rts/GCCompact.c
index 9ddd414..ea2e474 100644
--- a/ghc/rts/GCCompact.c
+++ b/ghc/rts/GCCompact.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GCCompact.c,v 1.5 2001/07/30 12:57:01 simonmar Exp $
+ * $Id: GCCompact.c,v 1.12 2002/03/12 11:51:06 simonmar Exp $
  *
  * (c) The GHC Team 2001
  *
@@ -7,6 +7,7 @@
  *
  * ---------------------------------------------------------------------------*/
 
+#include "PosixSource.h"
 #include "Rts.h"
 #include "RtsUtils.h"
 #include "RtsFlags.h"
@@ -173,7 +174,7 @@ thread_stack(StgPtr p, StgPtr stack_end)
 {
     StgPtr q;
     const StgInfoTable* info;
-    StgWord32 bitmap;
+    StgWord bitmap;
     
     // highly similar to scavenge_stack, but we do pointer threading here.
     
@@ -213,7 +214,7 @@ thread_stack(StgPtr p, StgPtr stack_end)
 	    p++;
 	    continue;
 	    
-	    // small bitmap (< 32 entries, or 64 on a 64-bit machine) 
+	    // small bitmap (<= 32 entries, or 64 on a 64-bit machine) 
 	case UPDATE_FRAME:
 	case STOP_FRAME:
 	case CATCH_FRAME:
@@ -234,7 +235,7 @@ thread_stack(StgPtr p, StgPtr stack_end)
 	    }
 	    continue;
 
-	    // large bitmap (> 32 entries) 
+	    // large bitmap (> 32 entries, or 64 on a 64-bit machine) 
 	case RET_BIG:
 	case RET_VEC_BIG:
 	{
@@ -247,7 +248,7 @@ thread_stack(StgPtr p, StgPtr stack_end)
 
 	    for (i=0; i<large_bitmap->size; i++) {
 		bitmap = large_bitmap->bitmap[i];
-		q = p + sizeof(W_) * 8;
+		q = p + BITS_IN(W_);
 		while (bitmap != 0) {
 		    if ((bitmap & 1) == 0) {
 			thread(p);
@@ -306,6 +307,8 @@ update_fwd_large( bdescr *bd )
     {
 	StgTSO *tso = (StgTSO *)p;
 	thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
+	thread((StgPtr)&tso->link);
+	thread((StgPtr)&tso->global_link);
 	continue;
     }
 
@@ -444,18 +447,11 @@ update_fwd( bdescr *blocks )
 		break;
 	    }
 
-	    // specialise this case, because we want to update the
-	    // mut_link field too.
 	    case IND_OLDGEN:
 	    case IND_OLDGEN_PERM:
-	    {
-		StgIndOldGen *ind = (StgIndOldGen *)p;
-		thread((StgPtr)&ind->indirectee);
-		if (ind->mut_link != NULL) {
-		    thread((StgPtr)&ind->mut_link);
-		}
+		thread((StgPtr)&((StgIndOldGen *)p)->indirectee);
+		p += sizeofW(StgIndOldGen);
 		break;
-	    }
 
 	    case THUNK_SELECTOR:
 	    { 
@@ -514,7 +510,9 @@ static void
 update_fwd_compact( bdescr *blocks )
 {
     StgPtr p, q, free;
+#if 0
     StgWord m;
+#endif
     bdescr *bd, *free_bd;
     StgInfoTable *info;
     nat size;
@@ -659,17 +657,9 @@ update_fwd_compact( bdescr *blocks )
 
 	    case IND_OLDGEN:
 	    case IND_OLDGEN_PERM:
-		// specialise this case, because we want to update the
-		// mut_link field too.
-	    {
-		StgIndOldGen *ind = (StgIndOldGen *)p;
-		thread((StgPtr)&ind->indirectee);
-		if (ind->mut_link != NULL) {
-		    thread((StgPtr)&ind->mut_link);
-		}
+		thread((StgPtr)&((StgIndOldGen *)p)->indirectee);
 		p += sizeofW(StgIndOldGen);
 		break;
-	    }
 
 	    case THUNK_SELECTOR:
 	    { 
@@ -747,7 +737,9 @@ static nat
 update_bkwd_compact( step *stp )
 {
     StgPtr p, free;
+#if 0
     StgWord m;
+#endif
     bdescr *bd, *free_bd;
     StgInfoTable *info;
     nat size, free_blocks;
@@ -811,8 +803,6 @@ update_bkwd_compact( step *stp )
 	    }
 
 	    // Rebuild the mutable list for the old generation.
-	    // (the mut_once list is updated using threading, with
-	    // special cases for IND_OLDGEN and MUT_CONS above).
 	    if (ip_MUTABLE(info)) {
 		recordMutable((StgMutClosure *)free);
 	    }
@@ -839,14 +829,26 @@ update_bkwd_compact( step *stp )
     stp->n_blocks = free_blocks;
 
     return free_blocks;
-} 
+}
+
+static void
+thread_mut_once_list( generation *g )
+{
+    StgMutClosure *p, *next;
+
+    for (p = g->mut_once_list; p != END_MUT_LIST; p = next) {
+	next = p->mut_link;
+	thread((StgPtr)&p->mut_link);
+    }
+    
+    thread((StgPtr)&g->mut_once_list);
+}
 
 void
 compact( void (*get_roots)(evac_fn) )
 {
     nat g, s, blocks;
     step *stp;
-    extern StgWeak *old_weak_ptr_list; // tmp
 
     // 1. thread the roots
     get_roots((evac_fn)thread);
@@ -862,18 +864,32 @@ compact( void (*get_roots)(evac_fn) )
     // mutable lists
     for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
 	thread((StgPtr)&generations[g].mut_list);
-	thread((StgPtr)&generations[g].mut_once_list);
+	thread_mut_once_list(&generations[g]);
     }
 
     // the global thread list
     thread((StgPtr)&all_threads);
 
+    // any threads resurrected during this GC
+    thread((StgPtr)&resurrected_threads);
+
+    // the main threads list
+    {
+	StgMainThread *m;
+	for (m = main_threads; m != NULL; m = m->link) {
+	    thread((StgPtr)&m->tso);
+	}
+    }
+
     // the static objects
     thread_static(scavenged_static_objects);
 
     // the stable pointer table
     threadStablePtrTable((evac_fn)thread);
 
+    // the CAF list (used by GHCi)
+    markCAFs((evac_fn)thread);
+
     // 2. update forward ptrs
     for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
 	for (s = 0; s < generations[g].n_steps; s++) {