[project @ 2000-02-25 15:20:33 by simonmar]

[ghc-hetmet.git] / ghc / rts / GC.c

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index 3665034..acb122f 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.69 2000/01/13 14:34:02 hwloidl Exp $
+ * $Id: GC.c,v 1.72 2000/01/22 18:00:03 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -933,19 +933,9 @@ isAlive(StgClosure *p)
 StgClosure *
 MarkRoot(StgClosure *root)
 {
-  //if (root != END_TSO_QUEUE)
   return evacuate(root);
 }
 
-//@cindex MarkRootHWL
-StgClosure *
-MarkRootHWL(StgClosure *root)
-{
-  StgClosure *new = evacuate(root);
-  upd_evacuee(root, new);
-  return new;
-}
-
 //@cindex addBlock
 static void addBlock(step *step)
 {
@@ -1189,9 +1179,6 @@ evacuate(StgClosure *q)
   step *step;
   const StgInfoTable *info;
 
-  nat size, ptrs, nonptrs, vhs;
-  char str[80];
-
 loop:
   if (HEAP_ALLOCED(q)) {
     bd = Bdescr((P_)q);
@@ -1502,10 +1489,17 @@ loop:
 
   case TSO:
     {
-      StgTSO *tso = stgCast(StgTSO *,q);
+      StgTSO *tso = (StgTSO *)q;
       nat size = tso_sizeW(tso);
       int diff;
 
+      /* Deal with redirected TSOs (a TSO that's had its stack enlarged).
+       */
+      if (tso->whatNext == ThreadRelocated) {
+       q = (StgClosure *)tso->link;
+       goto loop;
+      }
+
       /* Large TSOs don't get moved, so no relocation is required.
        */
       if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
@@ -2724,17 +2718,15 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
     case CATCH_FRAME:
     case SEQ_FRAME:
       {
-       StgPtr old_p = p; // debugging only -- HWL
+       // StgPtr old_p = p; // debugging only -- HWL
       /* stack frames like these are ordinary closures and therefore may 
         contain setup-specific fixed-header words (as in GranSim!);
         therefore, these cases should not use p++ but &(p->payload) -- HWL */
-      IF_DEBUG(gran, IF_DEBUG(sanity, printObj(p)));
+      // IF_DEBUG(gran, IF_DEBUG(sanity, printObj(p)));
       bitmap = info->layout.bitmap;
 
       p = (StgPtr)&(((StgClosure *)p)->payload);
-      IF_DEBUG(sanity, 
-                belch("HWL: scavenge_stack: (STOP|CATCH|SEQ)_FRAME adjusting p from %p to %p (instead of %p)",
-                      old_p, p, old_p+1));
+      // IF_DEBUG(sanity, belch("HWL: scavenge_stack: (STOP|CATCH|SEQ)_FRAME adjusting p from %p to %p (instead of %p)",                      old_p, p, old_p+1));
       goto small_bitmap;
       }
     case RET_BCO:
@@ -3148,7 +3140,7 @@ threadSqueezeStack(StgTSO *tso)
     frame = prev_frame;
 #if DEBUG
     IF_DEBUG(sanity,
-            if (!(frame>=top_frame && frame<=bottom)) {
+            if (!(frame>=top_frame && frame<=(StgUpdateFrame *)bottom)) {
               printObj((StgClosure *)prev_frame);
               barf("threadSqueezeStack: current frame is rubbish %p; previous was %p\n", 
                    frame, prev_frame);
@@ -3351,21 +3343,20 @@ threadPaused(StgTSO *tso)
     threadLazyBlackHole(tso);
 }
 
+/* -----------------------------------------------------------------------------
+ * Debugging
+ * -------------------------------------------------------------------------- */
+
 #if DEBUG
 //@cindex printMutOnceList
 void
 printMutOnceList(generation *gen)
 {
-  const StgInfoTable *info;
-  StgMutClosure *p, *next, *new_list;
+  StgMutClosure *p, *next;
 
   p = gen->mut_once_list;
-  new_list = END_MUT_LIST;
   next = p->mut_link;
 
-  evac_gen = gen->no;
-  failed_to_evac = rtsFalse;
-
   fprintf(stderr, "@@ Mut once list %p: ", gen->mut_once_list);
   for (; p != END_MUT_LIST; p = next, next = p->mut_link) {
     fprintf(stderr, "%p (%s), ", 
@@ -3378,18 +3369,14 @@ printMutOnceList(generation *gen)
 void
 printMutableList(generation *gen)
 {
-  const StgInfoTable *info;
   StgMutClosure *p, *next;
 
   p = gen->saved_mut_list;
   next = p->mut_link;
 
-  evac_gen = 0;
-  failed_to_evac = rtsFalse;
-
   fprintf(stderr, "@@ Mutable list %p: ", gen->saved_mut_list);
   for (; p != END_MUT_LIST; p = next, next = p->mut_link) {
-    fprintf(stderr, "%p (%s), ", 
+    fprintf(stderr, "%p (%s), ",
            p, info_type((StgClosure *)p));
   }
   fputc('\n', stderr);