Add ASSERTs to all calls of nameModule

[ghc-hetmet.git] / rts / sm / GCUtils.c

diff --git a/rts/sm/GCUtils.c b/rts/sm/GCUtils.c
index 0e20c46..4432ad6 100644 (file)
--- a/rts/sm/GCUtils.c
+++ b/rts/sm/GCUtils.c
@@ -1,6 +1,6 @@
 /* -----------------------------------------------------------------------------
  *
- * (c) The GHC Team 1998-2006
+ * (c) The GHC Team 1998-2008
  *
  * Generational garbage collector: utilities
  *
@@ -15,6 +15,7 @@
 #include "RtsFlags.h"
 #include "Storage.h"
 #include "GC.h"
+#include "GCThread.h"
 #include "GCUtils.h"
 #include "Printer.h"
 #include "Trace.h"
@@ -33,6 +34,31 @@ allocBlock_sync(void)
     return bd;
 }
 
+
+#if 0
+static void
+allocBlocks_sync(nat n, bdescr **hd, bdescr **tl, 
+                 nat gen_no, step *stp,
+                 StgWord32 flags)
+{
+    bdescr *bd;
+    nat i;
+    ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync);
+    bd = allocGroup(n);
+    for (i = 0; i < n; i++) {
+        bd[i].blocks = 1;
+        bd[i].gen_no = gen_no;
+        bd[i].step = stp;
+        bd[i].flags = flags;
+        bd[i].link = &bd[i+1];
+        bd[i].u.scan = bd[i].free = bd[i].start;
+    }
+    *hd = bd;
+    *tl = &bd[n-1];
+    RELEASE_SPIN_LOCK(&gc_alloc_block_sync);
+}
+#endif
+
 void
 freeChain_sync(bdescr *bd)
 {
@@ -115,15 +141,13 @@ todo_block_full (nat size, step_workspace *ws)
     ASSERT(bd->link == NULL);
     ASSERT(bd->step == ws->step);
 
-    bd->free = ws->todo_free;
-
     // If the global list is not empty, or there's not much work in
     // this block to push, and there's enough room in
     // this block to evacuate the current object, then just increase
     // the limit.
     if (ws->step->todos != NULL || 
-        (bd->free - bd->u.scan < WORK_UNIT_WORDS / 2)) {
-        if (bd->free + size < bd->start + BLOCK_SIZE_W) {
+        (ws->todo_free - bd->u.scan < WORK_UNIT_WORDS / 2)) {
+        if (ws->todo_free + size < bd->start + BLOCK_SIZE_W) {
             ws->todo_lim = stg_min(bd->start + BLOCK_SIZE_W,
                                    ws->todo_lim + stg_max(WORK_UNIT_WORDS,size));
             debugTrace(DEBUG_gc, "increasing limit for %p to %p", bd->start, ws->todo_lim);
@@ -131,11 +155,14 @@ todo_block_full (nat size, step_workspace *ws)
         }
     }
     
+    gct->copied += ws->todo_free - bd->free;
+    bd->free = ws->todo_free;
+
     ASSERT(bd->u.scan >= bd->start && bd->u.scan <= bd->free);
 
     // If this block is not the scan block, we want to push it out and
     // make room for a new todo block.
-    if (bd != ws->scan_bd)
+    if (bd != gct->scan_bd)
     {
         // If this block does not have enough space to allocate the
         // current object, but it also doesn't have any work to push, then 
@@ -151,8 +178,9 @@ todo_block_full (nat size, step_workspace *ws)
         {
             step *stp;
             stp = ws->step;
-            trace(TRACE_gc|DEBUG_gc, "push todo block %p (%d words), step %d, n_todos: %d", 
-                  bd->start, bd->free - bd->u.scan, stp->abs_no, stp->n_todos);
+            trace(TRACE_gc|DEBUG_gc, "push todo block %p (%ld words), step %d, n_todos: %d", 
+                  bd->start, (unsigned long)(bd->free - bd->u.scan),
+                  stp->abs_no, stp->n_todos);
             // ToDo: use buffer_todo
             ACQUIRE_SPIN_LOCK(&stp->sync_todo);
             if (stp->todos_last == NULL) {
@@ -179,7 +207,7 @@ todo_block_full (nat size, step_workspace *ws)
 StgPtr
 alloc_todo_block (step_workspace *ws, nat size)
 {
-    bdescr *bd;
+    bdescr *bd/*, *hd, *tl*/;
 
     // Grab a part block if we have one, and it has enough room
     if (ws->part_list != NULL && 
@@ -191,18 +219,22 @@ alloc_todo_block (step_workspace *ws, nat size)
     }
     else
     {
+        // blocks in to-space get the BF_EVACUATED flag.
+
+//        allocBlocks_sync(4, &hd, &tl, 
+//                         ws->step->gen_no, ws->step, BF_EVACUATED);
+//
+//        tl->link = ws->part_list;
+//        ws->part_list = hd->link;
+//        ws->n_part_blocks += 3;
+//
+//        bd = hd;
+
         bd = allocBlock_sync();
-        bd->gen_no = ws->step->gen_no;
         bd->step = ws->step;
-        bd->u.scan = bd->start;
-
-        // blocks in to-space in generations up to and including N
-        // get the BF_EVACUATED flag.
-        if (ws->step->gen_no <= N) {
-            bd->flags = BF_EVACUATED;
-        } else {
-            bd->flags = 0;
-        }
+        bd->gen_no = ws->step->gen_no;
+        bd->flags = BF_EVACUATED;
+        bd->u.scan = bd->free = bd->start;
     }
 
     bd->link = NULL;