Add ASSERTs to all calls of nameModule
[ghc-hetmet.git] / rts / sm / GCUtils.c
index f7b1819..4432ad6 100644 (file)
@@ -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)
 {
@@ -152,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) {
@@ -180,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 && 
@@ -192,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;