projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
STM invariants
[ghc-hetmet.git] / rts / GC.c
diff --git a/rts/GC.c b/rts/GC.c
index 727027d..4e8b3c2 100644 (file)
--- a/rts/GC.c
+++ b/rts/GC.c
@@ -44,6 +44,7 @@
 #endif
 #include "Trace.h"
 #include "RetainerProfile.h"
+#include "RaiseAsync.h"
 
 #include <string.h>
 
@@ -826,8 +827,8 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
        copied +=  mut_list_size;
 
        debugTrace(DEBUG_gc,
-                  "mut_list_size: %ld (%d vars, %d arrays, %d others)",
-                  mut_list_size * sizeof(W_), 
+                  "mut_list_size: %lu (%d vars, %d arrays, %d others)",
+                  (unsigned long)(mut_list_size * sizeof(W_)),
                   mutlist_MUTVARS, mutlist_MUTARRS, mutlist_OTHERS);
     }
 
@@ -1897,8 +1898,6 @@ loop:
          }
          return q;
          
-      case CONSTR_INTLIKE:
-      case CONSTR_CHARLIKE:
       case CONSTR_NOCAF_STATIC:
          /* no need to put these on the static linked list, they don't need
           * to be scavenged.
@@ -2234,8 +2233,8 @@ loop:
   case TREC_HEADER: 
     return copy(q,sizeofW(StgTRecHeader),stp);
 
-  case TVAR_WAIT_QUEUE:
-    return copy(q,sizeofW(StgTVarWaitQueue),stp);
+  case TVAR_WATCH_QUEUE:
+    return copy(q,sizeofW(StgTVarWatchQueue),stp);
 
   case TVAR:
     return copy(q,sizeofW(StgTVar),stp);
@@ -2243,6 +2242,12 @@ loop:
   case TREC_CHUNK:
     return copy(q,sizeofW(StgTRecChunk),stp);
 
+  case ATOMIC_INVARIANT:
+    return copy(q,sizeofW(StgAtomicInvariant),stp);
+
+  case INVARIANT_CHECK_QUEUE:
+    return copy(q,sizeofW(StgInvariantCheckQueue),stp);
+
   default:
     barf("evacuate: strange closure type %d", (int)(info->type));
   }
@@ -2631,10 +2636,8 @@ scavengeTSO (StgTSO *tso)
        ) {
        tso->block_info.closure = evacuate(tso->block_info.closure);
     }
-    if ( tso->blocked_exceptions != NULL ) {
-       tso->blocked_exceptions = 
-           (StgTSO *)evacuate((StgClosure *)tso->blocked_exceptions);
-    }
+    tso->blocked_exceptions = 
+       (StgTSO *)evacuate((StgClosure *)tso->blocked_exceptions);
     
     // We don't always chase the link field: TSOs on the blackhole
     // queue are not automatically alive, so the link field is a
@@ -3115,16 +3118,16 @@ scavenge(step *stp)
     }
 #endif
 
-    case TVAR_WAIT_QUEUE:
+    case TVAR_WATCH_QUEUE:
       {
-       StgTVarWaitQueue *wq = ((StgTVarWaitQueue *) p);
+       StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p);
        evac_gen = 0;
-       wq->waiting_tso = (StgTSO *)evacuate((StgClosure*)wq->waiting_tso);
-       wq->next_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->next_queue_entry);
-       wq->prev_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
+       wq->closure = (StgClosure*)evacuate((StgClosure*)wq->closure);
+       wq->next_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->next_queue_entry);
+       wq->prev_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
        evac_gen = saved_evac_gen;
        failed_to_evac = rtsTrue; // mutable
-       p += sizeofW(StgTVarWaitQueue);
+       p += sizeofW(StgTVarWatchQueue);
        break;
       }
 
@@ -3133,7 +3136,7 @@ scavenge(step *stp)
        StgTVar *tvar = ((StgTVar *) p);
        evac_gen = 0;
        tvar->current_value = evacuate((StgClosure*)tvar->current_value);
-       tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry);
+       tvar->first_watch_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)tvar->first_watch_queue_entry);
        evac_gen = saved_evac_gen;
        failed_to_evac = rtsTrue; // mutable
        p += sizeofW(StgTVar);
@@ -3146,6 +3149,7 @@ scavenge(step *stp)
         evac_gen = 0;
        trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec);
        trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk);
+       trec->invariants_to_check = (StgInvariantCheckQueue *)evacuate((StgClosure*)trec->invariants_to_check);
        evac_gen = saved_evac_gen;
        failed_to_evac = rtsTrue; // mutable
        p += sizeofW(StgTRecHeader);
@@ -3170,6 +3174,31 @@ scavenge(step *stp)
        break;
       }
 
+    case ATOMIC_INVARIANT:
+      {
+        StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p);
+        evac_gen = 0;
+       invariant->code = (StgClosure *)evacuate(invariant->code);
+       invariant->last_execution = (StgTRecHeader *)evacuate((StgClosure*)invariant->last_execution);
+       evac_gen = saved_evac_gen;
+       failed_to_evac = rtsTrue; // mutable
+       p += sizeofW(StgAtomicInvariant);
+        break;
+      }
+
+    case INVARIANT_CHECK_QUEUE:
+      {
+        StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p);
+        evac_gen = 0;
+       queue->invariant = (StgAtomicInvariant *)evacuate((StgClosure*)queue->invariant);
+       queue->my_execution = (StgTRecHeader *)evacuate((StgClosure*)queue->my_execution);
+       queue->next_queue_entry = (StgInvariantCheckQueue *)evacuate((StgClosure*)queue->next_queue_entry);
+       evac_gen = saved_evac_gen;
+       failed_to_evac = rtsTrue; // mutable
+       p += sizeofW(StgInvariantCheckQueue);
+        break;
+      }
+
     default:
        barf("scavenge: unimplemented/strange closure type %d @ %p", 
             info->type, p);
@@ -3499,13 +3528,13 @@ linear_scan:
        }
 #endif /* PAR */
 
-       case TVAR_WAIT_QUEUE:
+       case TVAR_WATCH_QUEUE:
          {
-           StgTVarWaitQueue *wq = ((StgTVarWaitQueue *) p);
+           StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p);
            evac_gen = 0;
-           wq->waiting_tso = (StgTSO *)evacuate((StgClosure*)wq->waiting_tso);
-           wq->next_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->next_queue_entry);
-           wq->prev_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
+            wq->closure = (StgClosure*)evacuate((StgClosure*)wq->closure);
+           wq->next_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->next_queue_entry);
+           wq->prev_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
            evac_gen = saved_evac_gen;
            failed_to_evac = rtsTrue; // mutable
            break;
@@ -3516,7 +3545,7 @@ linear_scan:
            StgTVar *tvar = ((StgTVar *) p);
            evac_gen = 0;
            tvar->current_value = evacuate((StgClosure*)tvar->current_value);
-           tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry);
+           tvar->first_watch_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)tvar->first_watch_queue_entry);
            evac_gen = saved_evac_gen;
            failed_to_evac = rtsTrue; // mutable
            break;
@@ -3545,11 +3574,35 @@ linear_scan:
            evac_gen = 0;
            trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec);
            trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk);
+           trec->invariants_to_check = (StgInvariantCheckQueue *)evacuate((StgClosure*)trec->invariants_to_check);
            evac_gen = saved_evac_gen;
            failed_to_evac = rtsTrue; // mutable
            break;
          }
 
+        case ATOMIC_INVARIANT:
+          {
+            StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p);
+            evac_gen = 0;
+           invariant->code = (StgClosure *)evacuate(invariant->code);
+           invariant->last_execution = (StgTRecHeader *)evacuate((StgClosure*)invariant->last_execution);
+           evac_gen = saved_evac_gen;
+           failed_to_evac = rtsTrue; // mutable
+            break;
+          }
+
+        case INVARIANT_CHECK_QUEUE:
+          {
+            StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p);
+            evac_gen = 0;
+           queue->invariant = (StgAtomicInvariant *)evacuate((StgClosure*)queue->invariant);
+           queue->my_execution = (StgTRecHeader *)evacuate((StgClosure*)queue->my_execution);
+            queue->next_queue_entry = (StgInvariantCheckQueue *)evacuate((StgClosure*)queue->next_queue_entry);
+           evac_gen = saved_evac_gen;
+           failed_to_evac = rtsTrue; // mutable
+            break;
+          }
+
        default:
            barf("scavenge_mark_stack: unimplemented/strange closure type %d @ %p", 
                 info->type, p);
@@ -3850,13 +3903,13 @@ scavenge_one(StgPtr p)
     }
 #endif
 
-    case TVAR_WAIT_QUEUE:
+    case TVAR_WATCH_QUEUE:
       {
-       StgTVarWaitQueue *wq = ((StgTVarWaitQueue *) p);
+       StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p);
        evac_gen = 0;
-       wq->waiting_tso = (StgTSO *)evacuate((StgClosure*)wq->waiting_tso);
-       wq->next_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->next_queue_entry);
-       wq->prev_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
+        wq->closure = (StgClosure*)evacuate((StgClosure*)wq->closure);
+        wq->next_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->next_queue_entry);
+        wq->prev_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
        evac_gen = saved_evac_gen;
        failed_to_evac = rtsTrue; // mutable
        break;
@@ -3867,7 +3920,7 @@ scavenge_one(StgPtr p)
        StgTVar *tvar = ((StgTVar *) p);
        evac_gen = 0;
        tvar->current_value = evacuate((StgClosure*)tvar->current_value);
-       tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry);
+        tvar->first_watch_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)tvar->first_watch_queue_entry);
        evac_gen = saved_evac_gen;
        failed_to_evac = rtsTrue; // mutable
        break;
@@ -3879,6 +3932,7 @@ scavenge_one(StgPtr p)
         evac_gen = 0;
        trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec);
        trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk);
+        trec->invariants_to_check = (StgInvariantCheckQueue *)evacuate((StgClosure*)trec->invariants_to_check);
        evac_gen = saved_evac_gen;
        failed_to_evac = rtsTrue; // mutable
         break;
@@ -3901,6 +3955,29 @@ scavenge_one(StgPtr p)
        break;
       }
 
+    case ATOMIC_INVARIANT:
+    {
+      StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p);
+      evac_gen = 0;
+      invariant->code = (StgClosure *)evacuate(invariant->code);
+      invariant->last_execution = (StgTRecHeader *)evacuate((StgClosure*)invariant->last_execution);
+      evac_gen = saved_evac_gen;
+      failed_to_evac = rtsTrue; // mutable
+      break;
+    }
+
+    case INVARIANT_CHECK_QUEUE:
+    {
+      StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p);
+      evac_gen = 0;
+      queue->invariant = (StgAtomicInvariant *)evacuate((StgClosure*)queue->invariant);
+      queue->my_execution = (StgTRecHeader *)evacuate((StgClosure*)queue->my_execution);
+      queue->next_queue_entry = (StgInvariantCheckQueue *)evacuate((StgClosure*)queue->next_queue_entry);
+      evac_gen = saved_evac_gen;
+      failed_to_evac = rtsTrue; // mutable
+      break;
+    }
+
     case IND_OLDGEN:
     case IND_OLDGEN_PERM:
     case IND_STATIC:
@@ -4620,6 +4697,14 @@ threadPaused(Capability *cap, StgTSO *tso)
     nat weight_pending   = 0;
     rtsBool prev_was_update_frame;
     
+    // Check to see whether we have threads waiting to raise
+    // exceptions, and we're not blocking exceptions, or are blocked
+    // interruptibly.  This is important; if a thread is running with
+    // TSO_BLOCKEX and becomes blocked interruptibly, this is the only
+    // place we ensure that the blocked_exceptions get a chance.
+    maybePerformBlockedException (cap, tso);
+    if (tso->what_next == ThreadKilled) { return; }
+
     stack_end = &tso->stack[tso->stack_size];
     
     frame = (StgClosure *)tso->sp;
@@ -4643,7 +4728,7 @@ threadPaused(Capability *cap, StgTSO *tso)
            if (closure_IND(bh) || bh->header.info == &stg_BLACKHOLE_info) {
                debugTrace(DEBUG_squeeze,
                           "suspending duplicate work: %ld words of stack",
-                          (StgPtr)frame - tso->sp);
+                          (long)((StgPtr)frame - tso->sp));
 
                // If this closure is already an indirection, then
                // suspend the computation up to this point:
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)