fix allocated blocks calculation, and add more sanity checks

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

diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index 744bd57..b76fcf4 100644 (file)
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -101,6 +101,8 @@ initStep (step *stp, int g, int s)
     initSpinLock(&stp->sync_todo);
     initSpinLock(&stp->sync_large_objects);
 #endif
+    stp->threads = END_TSO_QUEUE;
+    stp->old_threads = END_TSO_QUEUE;
 }
 
 void
@@ -551,6 +553,22 @@ resizeNurseries (nat blocks)
     resizeNurseriesFixed(blocks / n_nurseries);
 }
 
+
+/* -----------------------------------------------------------------------------
+   move_TSO is called to update the TSO structure after it has been
+   moved from one place to another.
+   -------------------------------------------------------------------------- */
+
+void
+move_TSO (StgTSO *src, StgTSO *dest)
+{
+    ptrdiff_t diff;
+
+    // relocate the stack pointer... 
+    diff = (StgPtr)dest - (StgPtr)src; // In *words* 
+    dest->sp = (StgPtr)dest->sp + diff;
+}
+
 /* -----------------------------------------------------------------------------
    The allocate() interface
 
@@ -822,6 +840,35 @@ dirty_MUT_VAR(StgRegTable *reg, StgClosure *p)
     }
 }
 
+// Setting a TSO's link field with a write barrier.
+// It is *not* necessary to call this function when
+//    * setting the link field to END_TSO_QUEUE
+//    * putting a TSO on the blackhole_queue
+//    * setting the link field of the currently running TSO, as it
+//      will already be dirty.
+void
+setTSOLink (Capability *cap, StgTSO *tso, StgTSO *target)
+{
+    bdescr *bd;
+    if ((tso->flags & (TSO_DIRTY|TSO_LINK_DIRTY)) == 0) {
+        tso->flags |= TSO_LINK_DIRTY;
+       bd = Bdescr((StgPtr)tso);
+       if (bd->gen_no > 0) recordMutableCap((StgClosure*)tso,cap,bd->gen_no);
+    }
+    tso->_link = target;
+}
+
+void
+dirty_TSO (Capability *cap, StgTSO *tso)
+{
+    bdescr *bd;
+    if ((tso->flags & (TSO_DIRTY|TSO_LINK_DIRTY)) == 0) {
+       bd = Bdescr((StgPtr)tso);
+       if (bd->gen_no > 0) recordMutableCap((StgClosure*)tso,cap,bd->gen_no);
+    }
+    tso->flags |= TSO_DIRTY;
+}
+
 /*
    This is the write barrier for MVARs.  An MVAR_CLEAN objects is not
    on the mutable list; a MVAR_DIRTY is.  When written to, a
@@ -1261,6 +1308,9 @@ memInventory (rtsBool show)
 #define MB(n) (((n) * BLOCK_SIZE_W) / ((1024*1024)/sizeof(W_)))
 
   leak = live_blocks + free_blocks != mblocks_allocated * BLOCKS_PER_MBLOCK;
+
+  ASSERT(n_alloc_blocks == live_blocks);
+
   if (show || leak)
   {
       if (leak) {