add comments and an ASSERT_LOCK_HELD()

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

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index bb244d8..10d91a7 100644 (file)
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -17,6 +17,7 @@
 #include "Updates.h"
 #include "STM.h"
 #include "Sanity.h"
 #include "Updates.h"
 #include "STM.h"
 #include "Sanity.h"

+#include "Profiling.h"

 #if defined(mingw32_HOST_OS)
 #include "win32/IOManager.h"
 #endif
 #if defined(mingw32_HOST_OS)
 #include "win32/IOManager.h"
 #endif

@@ -29,7 +30,7 @@ static void raiseAsync (Capability *cap,
 
 static void removeFromQueues(Capability *cap, StgTSO *tso);
 
 
 static void removeFromQueues(Capability *cap, StgTSO *tso);
 

-static void blockedThrowTo (StgTSO *source, StgTSO *target);
+static void blockedThrowTo (Capability *cap, StgTSO *source, StgTSO *target);

 
 static void performBlockedException (Capability *cap, 
                                     StgTSO *source, StgTSO *target);
 
 static void performBlockedException (Capability *cap, 
                                     StgTSO *source, StgTSO *target);

@@ -151,7 +152,7 @@ throwTo (Capability *cap,   // the Capability we hold
 
     // follow ThreadRelocated links in the target first
     while (target->what_next == ThreadRelocated) {
 
     // follow ThreadRelocated links in the target first
     while (target->what_next == ThreadRelocated) {

-       target = target->link;
+       target = target->_link;

        // No, it might be a WHITEHOLE:
        // ASSERT(get_itbl(target)->type == TSO);
     }
        // No, it might be a WHITEHOLE:
        // ASSERT(get_itbl(target)->type == TSO);
     }

@@ -260,10 +261,10 @@ check_target:
            // just moved this TSO.
            if (target->what_next == ThreadRelocated) {
                unlockTSO(target);
            // just moved this TSO.
            if (target->what_next == ThreadRelocated) {
                unlockTSO(target);

-               target = target->link;
+               target = target->_link;

                goto retry;
            }
                goto retry;
            }

-           blockedThrowTo(source,target);
+           blockedThrowTo(cap,source,target);

            *out = target;
            return THROWTO_BLOCKED;
        }
            *out = target;
            return THROWTO_BLOCKED;
        }

@@ -293,7 +294,7 @@ check_target:
        info = lockClosure((StgClosure *)mvar);
 
        if (target->what_next == ThreadRelocated) {
        info = lockClosure((StgClosure *)mvar);
 
        if (target->what_next == ThreadRelocated) {

-           target = target->link;
+           target = target->_link;

            unlockClosure((StgClosure *)mvar,info);
            goto retry;
        }
            unlockClosure((StgClosure *)mvar,info);
            goto retry;
        }

@@ -308,12 +309,12 @@ check_target:
        if ((target->flags & TSO_BLOCKEX) &&
            ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
            lockClosure((StgClosure *)target);
        if ((target->flags & TSO_BLOCKEX) &&
            ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
            lockClosure((StgClosure *)target);

-           blockedThrowTo(source,target);
+           blockedThrowTo(cap,source,target);

            unlockClosure((StgClosure *)mvar, info);
            *out = target;
            return THROWTO_BLOCKED; // caller releases TSO
        } else {
            unlockClosure((StgClosure *)mvar, info);
            *out = target;
            return THROWTO_BLOCKED; // caller releases TSO
        } else {

-           removeThreadFromMVarQueue(mvar, target);
+           removeThreadFromMVarQueue(cap, mvar, target);

            raiseAsync(cap, target, exception, rtsFalse, NULL);
            unblockOne(cap, target);
            unlockClosure((StgClosure *)mvar, info);
            raiseAsync(cap, target, exception, rtsFalse, NULL);
            unblockOne(cap, target);
            unlockClosure((StgClosure *)mvar, info);

@@ -332,12 +333,12 @@ check_target:
 
        if (target->flags & TSO_BLOCKEX) {
            lockTSO(target);
 
        if (target->flags & TSO_BLOCKEX) {
            lockTSO(target);

-           blockedThrowTo(source,target);
+           blockedThrowTo(cap,source,target);

            RELEASE_LOCK(&sched_mutex);
            *out = target;
            return THROWTO_BLOCKED; // caller releases TSO
        } else {
            RELEASE_LOCK(&sched_mutex);
            *out = target;
            return THROWTO_BLOCKED; // caller releases TSO
        } else {

-           removeThreadFromQueue(&blackhole_queue, target);
+           removeThreadFromQueue(cap, &blackhole_queue, target);

            raiseAsync(cap, target, exception, rtsFalse, NULL);
            unblockOne(cap, target);
            RELEASE_LOCK(&sched_mutex);
            raiseAsync(cap, target, exception, rtsFalse, NULL);
            unblockOne(cap, target);
            RELEASE_LOCK(&sched_mutex);

@@ -372,12 +373,12 @@ check_target:
            goto retry;
        }
        if (target->what_next == ThreadRelocated) {
            goto retry;
        }
        if (target->what_next == ThreadRelocated) {

-           target = target->link;
+           target = target->_link;

            unlockTSO(target2);
            goto retry;
        }
        if (target2->what_next == ThreadRelocated) {
            unlockTSO(target2);
            goto retry;
        }
        if (target2->what_next == ThreadRelocated) {

-           target->block_info.tso = target2->link;
+           target->block_info.tso = target2->_link;

            unlockTSO(target2);
            goto retry;
        }
            unlockTSO(target2);
            goto retry;
        }

@@ -396,12 +397,12 @@ check_target:
        if ((target->flags & TSO_BLOCKEX) &&
            ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
            lockTSO(target);
        if ((target->flags & TSO_BLOCKEX) &&
            ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
            lockTSO(target);

-           blockedThrowTo(source,target);
+           blockedThrowTo(cap,source,target);

            unlockTSO(target2);
            *out = target;
            return THROWTO_BLOCKED;
        } else {
            unlockTSO(target2);
            *out = target;
            return THROWTO_BLOCKED;
        } else {

-           removeThreadFromQueue(&target2->blocked_exceptions, target);
+           removeThreadFromQueue(cap, &target2->blocked_exceptions, target);

            raiseAsync(cap, target, exception, rtsFalse, NULL);
            unblockOne(cap, target);
            unlockTSO(target2);
            raiseAsync(cap, target, exception, rtsFalse, NULL);
            unblockOne(cap, target);
            unlockTSO(target2);

@@ -418,7 +419,7 @@ check_target:
        }
        if ((target->flags & TSO_BLOCKEX) &&
            ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
        }
        if ((target->flags & TSO_BLOCKEX) &&
            ((target->flags & TSO_INTERRUPTIBLE) == 0)) {

-           blockedThrowTo(source,target);
+           blockedThrowTo(cap,source,target);

            *out = target;
            return THROWTO_BLOCKED;
        } else {
            *out = target;
            return THROWTO_BLOCKED;
        } else {

@@ -435,7 +436,7 @@ check_target:
        // thread is blocking exceptions, and block on its
        // blocked_exception queue.
        lockTSO(target);
        // thread is blocking exceptions, and block on its
        // blocked_exception queue.
        lockTSO(target);

-       blockedThrowTo(source,target);
+       blockedThrowTo(cap,source,target);

        *out = target;
        return THROWTO_BLOCKED;
 
        *out = target;
        return THROWTO_BLOCKED;
 

@@ -448,7 +449,7 @@ check_target:
 #endif
        if ((target->flags & TSO_BLOCKEX) &&
            ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
 #endif
        if ((target->flags & TSO_BLOCKEX) &&
            ((target->flags & TSO_INTERRUPTIBLE) == 0)) {

-           blockedThrowTo(source,target);
+           blockedThrowTo(cap,source,target);

            return THROWTO_BLOCKED;
        } else {
            removeFromQueues(cap,target);
            return THROWTO_BLOCKED;
        } else {
            removeFromQueues(cap,target);

@@ -468,12 +469,12 @@ check_target:
 // complex to achieve as there's no single lock on a TSO; see
 // throwTo()).
 static void
 // complex to achieve as there's no single lock on a TSO; see
 // throwTo()).
 static void

-blockedThrowTo (StgTSO *source, StgTSO *target)
+blockedThrowTo (Capability *cap, StgTSO *source, StgTSO *target)

 {
     debugTrace(DEBUG_sched, "throwTo: blocking on thread %lu", (unsigned long)target->id);
 {
     debugTrace(DEBUG_sched, "throwTo: blocking on thread %lu", (unsigned long)target->id);

-    source->link = target->blocked_exceptions;
+    setTSOLink(cap, source, target->blocked_exceptions);

     target->blocked_exceptions = source;
     target->blocked_exceptions = source;

-    dirtyTSO(target); // we modified the blocked_exceptions queue
+    dirty_TSO(cap,target); // we modified the blocked_exceptions queue

     
     source->block_info.tso = target;
     write_barrier(); // throwTo_exception *must* be visible if BlockedOnException is.
     
     source->block_info.tso = target;
     write_barrier(); // throwTo_exception *must* be visible if BlockedOnException is.

@@ -511,6 +512,11 @@ maybePerformBlockedException (Capability *cap, StgTSO *tso)
 {
     StgTSO *source;
     
 {
     StgTSO *source;
     

+    if (tso->blocked_exceptions != END_TSO_QUEUE && 
+        (tso->flags & TSO_BLOCKEX) != 0) {
+        debugTrace(DEBUG_sched, "throwTo: thread %lu has blocked exceptions but is inside block", (unsigned long)tso->id);
+    }
+

     if (tso->blocked_exceptions != END_TSO_QUEUE
        && ((tso->flags & TSO_BLOCKEX) == 0
            || ((tso->flags & TSO_INTERRUPTIBLE) && interruptible(tso)))) {
     if (tso->blocked_exceptions != END_TSO_QUEUE
        && ((tso->flags & TSO_BLOCKEX) == 0
            || ((tso->flags & TSO_INTERRUPTIBLE) && interruptible(tso)))) {

@@ -569,6 +575,12 @@ performBlockedException (Capability *cap, StgTSO *source, StgTSO *target)
 
    This is for use when we raise an exception in another thread, which
    may be blocked.
 
    This is for use when we raise an exception in another thread, which
    may be blocked.

+
+   Precondition: we have exclusive access to the TSO, which entails
+   holding a lock on the object that owns the queue, if the TSO is
+   blocked.  e.g. if the thread is blocked on an MVar, we must hold a
+   lock on the MVar before calling removeFromQueues().
+

    This has nothing to do with the UnblockThread event in GranSim. -- HWL
    -------------------------------------------------------------------------- */
 
    This has nothing to do with the UnblockThread event in GranSim. -- HWL
    -------------------------------------------------------------------------- */
 

@@ -714,7 +726,7 @@ removeFromQueues(Capability *cap, StgTSO *tso)
     }
 
   default:
     }
 
   default:

-    barf("removeFromQueues");
+    barf("removeFromQueues: %d", tso->why_blocked);

   }
 
  done:
   }
 
  done:

@@ -742,11 +754,14 @@ removeFromQueues(Capability *cap, StgTSO *tso)
     goto done;
 
   case BlockedOnMVar:
     goto done;
 
   case BlockedOnMVar:

-      removeThreadFromMVarQueue((StgMVar *)tso->block_info.closure, tso);
+      removeThreadFromMVarQueue(cap, (StgMVar *)tso->block_info.closure, tso);

       goto done;
 
   case BlockedOnBlackHole:
       goto done;
 
   case BlockedOnBlackHole:

-      removeThreadFromQueue(&blackhole_queue, tso);
+      // we have exclusive access to this TSO, which implies that we
+      // must hold sched_mutex:
+      ASSERT_LOCK_HELD(&sched_mutex);
+      removeThreadFromQueue(cap, &blackhole_queue, tso);

       goto done;
 
   case BlockedOnException:
       goto done;
 
   case BlockedOnException:

@@ -759,10 +774,10 @@ removeFromQueues(Capability *cap, StgTSO *tso)
       // ASSERT(get_itbl(target)->type == TSO);
 
       while (target->what_next == ThreadRelocated) {
       // ASSERT(get_itbl(target)->type == TSO);
 
       while (target->what_next == ThreadRelocated) {

-         target = target->link;
+         target = target->_link;

       }
       
       }
       

-      removeThreadFromQueue(&target->blocked_exceptions, tso);
+      removeThreadFromQueue(cap, &target->blocked_exceptions, tso);

       goto done;
     }
 
       goto done;
     }
 

@@ -772,7 +787,7 @@ removeFromQueues(Capability *cap, StgTSO *tso)
 #if defined(mingw32_HOST_OS)
   case BlockedOnDoProc:
 #endif
 #if defined(mingw32_HOST_OS)
   case BlockedOnDoProc:
 #endif

-      removeThreadFromDeQueue(&blocked_queue_hd, &blocked_queue_tl, tso);
+      removeThreadFromDeQueue(cap, &blocked_queue_hd, &blocked_queue_tl, tso);

 #if defined(mingw32_HOST_OS)
       /* (Cooperatively) signal that the worker thread should abort
        * the request.
 #if defined(mingw32_HOST_OS)
       /* (Cooperatively) signal that the worker thread should abort
        * the request.

@@ -782,16 +797,16 @@ removeFromQueues(Capability *cap, StgTSO *tso)
       goto done;
 
   case BlockedOnDelay:
       goto done;
 
   case BlockedOnDelay:

-       removeThreadFromQueue(&sleeping_queue, tso);
+        removeThreadFromQueue(cap, &sleeping_queue, tso);

        goto done;
 #endif
 
   default:
        goto done;
 #endif
 
   default:

-      barf("removeFromQueues");
+      barf("removeFromQueues: %d", tso->why_blocked);

   }
 
  done:
   }
 
  done:

-  tso->link = END_TSO_QUEUE;
+  tso->_link = END_TSO_QUEUE; // no write barrier reqd

   tso->why_blocked = NotBlocked;
   tso->block_info.closure = NULL;
   appendToRunQueue(cap,tso);
   tso->why_blocked = NotBlocked;
   tso->block_info.closure = NULL;
   appendToRunQueue(cap,tso);

@@ -852,8 +867,20 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
     debugTrace(DEBUG_sched,
               "raising exception in thread %ld.", (long)tso->id);
     
     debugTrace(DEBUG_sched,
               "raising exception in thread %ld.", (long)tso->id);
     

+#if defined(PROFILING)
+    /* 
+     * Debugging tool: on raising an  exception, show where we are.
+     * See also Exception.cmm:raisezh_fast.
+     * This wasn't done for asynchronous exceptions originally; see #1450 
+     */
+    if (RtsFlags.ProfFlags.showCCSOnException)
+    {
+        fprintCCS_stderr(tso->prof.CCCS);
+    }
+#endif
+

     // mark it dirty; we're about to change its stack.
     // mark it dirty; we're about to change its stack.

-    dirtyTSO(tso);
+    dirty_TSO(cap, tso);

 
     sp = tso->sp;
     
 
     sp = tso->sp;
     

@@ -926,21 +953,12 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
            //       printObj((StgClosure *)ap);
            //  );
 
            //       printObj((StgClosure *)ap);
            //  );
 

-           // Replace the updatee with an indirection
-           //
-           // Warning: if we're in a loop, more than one update frame on
-           // the stack may point to the same object.  Be careful not to
-           // overwrite an IND_OLDGEN in this case, because we'll screw
-           // up the mutable lists.  To be on the safe side, don't
-           // overwrite any kind of indirection at all.  See also
-           // threadSqueezeStack in GC.c, where we have to make a similar
-           // check.
-           //
-           if (!closure_IND(((StgUpdateFrame *)frame)->updatee)) {
-               // revert the black hole
-               UPD_IND_NOLOCK(((StgUpdateFrame *)frame)->updatee,
-                              (StgClosure *)ap);
-           }
+            // Perform the update
+            // TODO: this may waste some work, if the thunk has
+            // already been updated by another thread.
+            UPD_IND_NOLOCK(((StgUpdateFrame *)frame)->updatee,
+                           (StgClosure *)ap);
+

            sp += sizeofW(StgUpdateFrame) - 1;
            sp[0] = (W_)ap; // push onto stack
            frame = sp + 1;
            sp += sizeofW(StgUpdateFrame) - 1;
            sp[0] = (W_)ap; // push onto stack
            frame = sp + 1;

@@ -1001,23 +1019,14 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
            if (stop_at_atomically) {
                ASSERT(stmGetEnclosingTRec(tso->trec) == NO_TREC);
                stmCondemnTransaction(cap, tso -> trec);
            if (stop_at_atomically) {
                ASSERT(stmGetEnclosingTRec(tso->trec) == NO_TREC);
                stmCondemnTransaction(cap, tso -> trec);

-#ifdef REG_R1

                tso->sp = frame;
                tso->sp = frame;

-#else
-               // R1 is not a register: the return convention for IO in
-               // this case puts the return value on the stack, so we
-               // need to set up the stack to return to the atomically
-               // frame properly...
-               tso->sp = frame - 2;
-               tso->sp[1] = (StgWord) &stg_NO_FINALIZER_closure; // why not?
-               tso->sp[0] = (StgWord) &stg_ut_1_0_unreg_info;
-#endif

                tso->what_next = ThreadRunGHC;
                return;
            }
            // Not stop_at_atomically... fall through and abort the
            // transaction.
            
                tso->what_next = ThreadRunGHC;
                return;
            }
            // Not stop_at_atomically... fall through and abort the
            // transaction.
            

+       case CATCH_STM_FRAME:

        case CATCH_RETRY_FRAME:
            // IF we find an ATOMICALLY_FRAME then we abort the
            // current transaction and propagate the exception.  In
        case CATCH_RETRY_FRAME:
            // IF we find an ATOMICALLY_FRAME then we abort the
            // current transaction and propagate the exception.  In