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 967f48d..4e8b3c2 100644 (file)
--- a/rts/GC.c
+++ b/rts/GC.c
@@ -1898,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.
@@ -2235,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);
@@ -2244,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));
   }
@@ -3114,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;
       }
 
@@ -3132,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);
@@ -3145,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);
@@ -3169,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);
@@ -3498,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;
@@ -3515,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;
@@ -3544,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);
@@ -3849,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;
@@ -3866,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;
@@ -3878,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;
@@ -3900,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:
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)