STM invariants

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

diff --git a/rts/GCCompact.c b/rts/GCCompact.c
index 682a09a..da3c7a7 100644 (file)
--- a/rts/GCCompact.c
+++ b/rts/GCCompact.c
@@ -17,6 +17,7 @@
 #include "GCCompact.h"
 #include "Schedule.h"
 #include "Apply.h"
+#include "Trace.h"
 
 // Turn off inlining when debugging - it obfuscates things
 #ifdef DEBUG
@@ -402,9 +403,7 @@ thread_TSO (StgTSO *tso)
        ) {
        thread_(&tso->block_info.closure);
     }
-    if ( tso->blocked_exceptions != NULL ) {
-       thread_(&tso->blocked_exceptions);
-    }
+    thread_(&tso->blocked_exceptions);
     
     thread_(&tso->trec);
 
@@ -629,20 +628,20 @@ thread_obj (StgInfoTable *info, StgPtr p)
     case TSO:
        return thread_TSO((StgTSO *)p);
     
-    case TVAR_WAIT_QUEUE:
+    case TVAR_WATCH_QUEUE:
     {
-        StgTVarWaitQueue *wq = (StgTVarWaitQueue *)p;
-       thread_(&wq->waiting_tso);
+        StgTVarWatchQueue *wq = (StgTVarWatchQueue *)p;
+       thread_(&wq->closure);
        thread_(&wq->next_queue_entry);
        thread_(&wq->prev_queue_entry);
-       return p + sizeofW(StgTVarWaitQueue);
+       return p + sizeofW(StgTVarWatchQueue);
     }
     
     case TVAR:
     {
         StgTVar *tvar = (StgTVar *)p;
        thread((void *)&tvar->current_value);
-       thread((void *)&tvar->first_wait_queue_entry);
+       thread((void *)&tvar->first_watch_queue_entry);
        return p + sizeofW(StgTVar);
     }
     
@@ -651,6 +650,7 @@ thread_obj (StgInfoTable *info, StgPtr p)
         StgTRecHeader *trec = (StgTRecHeader *)p;
        thread_(&trec->enclosing_trec);
        thread_(&trec->current_chunk);
+       thread_(&trec->invariants_to_check);
        return p + sizeofW(StgTRecHeader);
     }
 
@@ -668,6 +668,23 @@ thread_obj (StgInfoTable *info, StgPtr p)
        return p + sizeofW(StgTRecChunk);
     }
 
+    case ATOMIC_INVARIANT:
+    {
+        StgAtomicInvariant *invariant = (StgAtomicInvariant *)p;
+       thread_(&invariant->code);
+       thread_(&invariant->last_execution);
+       return p + sizeofW(StgAtomicInvariant);
+    }
+
+    case INVARIANT_CHECK_QUEUE:
+    {
+        StgInvariantCheckQueue *queue = (StgInvariantCheckQueue *)p;
+       thread_(&queue->invariant);
+       thread_(&queue->my_execution);
+       thread_(&queue->next_queue_entry);
+       return p + sizeofW(StgInvariantCheckQueue);
+    }
+
     default:
        barf("update_fwd: unknown/strange object  %d", (int)(info->type));
        return NULL;
@@ -931,12 +948,14 @@ compact( void (*get_roots)(evac_fn) )
        for (s = 0; s < generations[g].n_steps; s++) {
            if (g==0 && s ==0) continue;
            stp = &generations[g].steps[s];
-           IF_DEBUG(gc, debugBelch("update_fwd:  %d.%d\n", stp->gen->no, stp->no););
+           debugTrace(DEBUG_gc, "update_fwd:  %d.%d", 
+                      stp->gen->no, stp->no);
 
            update_fwd(stp->blocks);
            update_fwd_large(stp->scavenged_large_objects);
            if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) {
-               IF_DEBUG(gc, debugBelch("update_fwd:  %d.%d (compact)\n", stp->gen->no, stp->no););
+               debugTrace(DEBUG_gc, "update_fwd:  %d.%d (compact)",
+                          stp->gen->no, stp->no);
                update_fwd_compact(stp->old_blocks);
            }
        }
@@ -946,9 +965,10 @@ compact( void (*get_roots)(evac_fn) )
     stp = &oldest_gen->steps[0];
     if (stp->old_blocks != NULL) {
        blocks = update_bkwd_compact(stp);
-       IF_DEBUG(gc, debugBelch("update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n", 
-                            stp->gen->no, stp->no,
-                            stp->n_old_blocks, blocks););
+       debugTrace(DEBUG_gc, 
+                  "update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)",
+                  stp->gen->no, stp->no,
+                  stp->n_old_blocks, blocks);
        stp->n_old_blocks = blocks;
     }
 }