[project @ 2005-05-19 13:21:55 by simonmar]

- Move the call to threadPaused() from the scheduler into STG land,
  and put it in a new code fragment (stg_returnToSched) that we pass
  through every time we return from STG to the scheduler.  Also, the
  SAVE_THREAD_STATE() is now in stg_returnToSched which might save a
  little code space (at the expense of an extra jump for every return
  to the scheduler).

- SMP: when blocking on an MVar, we now wait until the thread has been
  made fully safe and placed on the blocked queue of the MVar before
  we unlock the MVar.  This closes a race whereby another OS thread could
  begin waking us up before the current TSO had been properly tidied up.

Fixes one cause of crashes when using MVars with SMP.  I still have a
deadlock problem to track down.

diff --git a/ghc/includes/StgMiscClosures.h b/ghc/includes/StgMiscClosures.h
index 420fd8c..b81ec90 100644 (file)
--- a/ghc/includes/StgMiscClosures.h
+++ b/ghc/includes/StgMiscClosures.h
@@ -473,7 +473,8 @@ RTS_RET_INFO(stg_stop_thread_info);
 RTS_ENTRY(stg_stop_thread_ret);
 
 RTS_FUN(stg_returnToStackTop);
-RTS_FUN(stg_enterStackTop);
+RTS_FUN(stg_returnToSched);
+RTS_FUN(stg_returnToSchedButFirst);
 
 RTS_FUN(stg_init_finish);
 RTS_FUN(stg_init);

diff --git a/ghc/rts/HeapStackCheck.cmm b/ghc/rts/HeapStackCheck.cmm
index db4af25..27e8f44 100644 (file)
--- a/ghc/rts/HeapStackCheck.cmm
+++ b/ghc/rts/HeapStackCheck.cmm
@@ -69,20 +69,25 @@
         R1 = StackOverflow;                                    \
     }                                                          \
   sched:                                                       \
-    SAVE_THREAD_STATE();                                       \
     StgTSO_what_next(CurrentTSO) = ThreadRunGHC::I16;          \
-    jump StgReturn;
+    jump stg_returnToSched;
 
 #define RETURN_TO_SCHED(why,what_next)                 \
-  SAVE_THREAD_STATE();                                 \
   StgTSO_what_next(CurrentTSO) = what_next::I16;       \
   R1 = why;                                            \
-  jump StgReturn;
+  jump stg_returnToSched;
+
+#define RETURN_TO_SCHED_BUT_FIRST(why,what_next,cont)  \
+  StgTSO_what_next(CurrentTSO) = what_next::I16;       \
+  R1 = why;                                            \
+  R2 = cont;                                           \
+  jump stg_returnToSchedButFirst;
 
 #define HP_GENERIC           RETURN_TO_SCHED(HeapOverflow,   ThreadRunGHC)
 #define YIELD_GENERIC        RETURN_TO_SCHED(ThreadYielding, ThreadRunGHC)
 #define YIELD_TO_INTERPRETER RETURN_TO_SCHED(ThreadYielding, ThreadInterpret)
 #define BLOCK_GENERIC        RETURN_TO_SCHED(ThreadBlocked,  ThreadRunGHC)
+#define BLOCK_BUT_FIRST(c)   RETURN_TO_SCHED_BUT_FIRST(ThreadBlocked, ThreadRunGHC, c)
 
 /* -----------------------------------------------------------------------------
    Heap checks in thunks/functions.
@@ -823,12 +828,22 @@ INFO_TABLE_RET( stg_block_takemvar, 1/*framesize*/, 0/*bitmap*/, RET_SMALL )
     jump takeMVarzh_fast;
 }
 
+// code fragment executed just before we return to the scheduler
+stg_block_takemvar_finally
+{
+#ifdef SMP
+    foreign "C" unlockClosure(R3 "ptr", stg_EMPTY_MVAR_info);
+#endif
+    jump StgReturn;
+}
+
 stg_block_takemvar
 {
     Sp_adj(-2);
     Sp(1) = R1;
     Sp(0) = stg_block_takemvar_info;
-    BLOCK_GENERIC;
+    R3 = R1;
+    BLOCK_BUT_FIRST(stg_block_takemvar_finally);
 }
 
 INFO_TABLE_RET( stg_block_putmvar, 2/*framesize*/, 0/*bitmap*/, RET_SMALL )
@@ -839,13 +854,23 @@ INFO_TABLE_RET( stg_block_putmvar, 2/*framesize*/, 0/*bitmap*/, RET_SMALL )
     jump putMVarzh_fast;
 }
 
+// code fragment executed just before we return to the scheduler
+stg_block_putmvar_finally
+{
+#ifdef SMP
+    foreign "C" unlockClosure(R3 "ptr", stg_FULL_MVAR_info);
+#endif
+    jump StgReturn;
+}
+
 stg_block_putmvar
 {
     Sp_adj(-3);
     Sp(2) = R2;
     Sp(1) = R1;
     Sp(0) = stg_block_putmvar_info;
-    BLOCK_GENERIC;
+    R3 = R1;
+    BLOCK_BUT_FIRST(stg_block_putmvar_finally);
 }
 
 #ifdef mingw32_HOST_OS

diff --git a/ghc/rts/PrimOps.cmm b/ghc/rts/PrimOps.cmm
index cdca634..f704570 100644 (file)
--- a/ghc/rts/PrimOps.cmm
+++ b/ghc/rts/PrimOps.cmm
@@ -1424,6 +1424,17 @@ newMVarzh_fast
     StgTSO_sp(tso) = StgTSO_sp(tso) + WDS(3);  \
     lval = W_[StgTSO_sp(tso) - WDS(1)];
 
+/*
+ * Only in threaded mode: we have to be careful when manipulating another thread's TSO,
+ * because the scheduler might also be manipulating it.
+ */
+#if defined(RTS_SUPPORTS_THREADS)
+#define ACQUIRE_SCHED_LOCK   foreign "C" ACQUIRE_LOCK(sched_mutex "ptr");
+#define RELEASE_SCHED_LOCK   foreign "C" RELEASE_LOCK(sched_mutex "ptr");
+#else
+#define ACQUIRE_SCHED_LOCK
+#define RELEASE_SCHED_LOCK
+#endif
 
 takeMVarzh_fast
 {
@@ -1452,10 +1463,6 @@ takeMVarzh_fast
        StgTSO_block_info(CurrentTSO)  = mvar;
        StgMVar_tail(mvar) = CurrentTSO;
        
-#if defined(SMP)
-        SET_INFO(mvar,stg_EMPTY_MVAR_info);
-#endif
-
        jump stg_block_takemvar;
   }
 
@@ -1464,6 +1471,8 @@ takeMVarzh_fast
 
   if (StgMVar_head(mvar) != stg_END_TSO_QUEUE_closure)
   {
+      ACQUIRE_SCHED_LOCK;
+
       /* There are putMVar(s) waiting... 
        * wake up the first thread on the queue
        */
@@ -1475,20 +1484,22 @@ takeMVarzh_fast
 
 #if defined(GRAN) || defined(PAR)
       /* ToDo: check 2nd arg (mvar) is right */
-      "ptr" tso = foreign "C" unblockOne(StgMVar_head(mvar),mvar);
+      "ptr" tso = foreign "C" unblockOneLocked(StgMVar_head(mvar),mvar);
       StgMVar_head(mvar) = tso;
 #else
-      "ptr" tso = foreign "C" unblockOne(StgMVar_head(mvar) "ptr");
+      "ptr" tso = foreign "C" unblockOneLocked(StgMVar_head(mvar) "ptr");
       StgMVar_head(mvar) = tso;
 #endif
+
+      RELEASE_SCHED_LOCK;
+
       if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
          StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
       }
 
 #if defined(SMP)
-      SET_INFO(mvar,stg_FULL_MVAR_info);
+      foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info);
 #endif
-
       RET_P(val);
   } 
   else
@@ -1496,8 +1507,11 @@ takeMVarzh_fast
       /* No further putMVars, MVar is now empty */
       StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
  
-      /* unlocks the closure in the SMP case */
+#if defined(SMP)
+      foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info);
+#else
       SET_INFO(mvar,stg_EMPTY_MVAR_info);
+#endif
 
       RET_P(val);
   }
@@ -1520,7 +1534,7 @@ tryTakeMVarzh_fast
 
     if (info == stg_EMPTY_MVAR_info) {
 #if defined(SMP)
-        SET_INFO(mvar,stg_EMPTY_MVAR_info);
+        foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info);
 #endif
        /* HACK: we need a pointer to pass back, 
         * so we abuse NO_FINALIZER_closure
@@ -1532,6 +1546,9 @@ tryTakeMVarzh_fast
     val = StgMVar_value(mvar);
 
     if (StgMVar_head(mvar) != stg_END_TSO_QUEUE_closure) {
+
+        ACQUIRE_SCHED_LOCK;
+
        /* There are putMVar(s) waiting... 
         * wake up the first thread on the queue
         */
@@ -1543,25 +1560,31 @@ tryTakeMVarzh_fast
 
 #if defined(GRAN) || defined(PAR)
        /* ToDo: check 2nd arg (mvar) is right */
-       "ptr" tso = foreign "C" unblockOne(StgMVar_head(mvar) "ptr", mvar "ptr");
+       "ptr" tso = foreign "C" unblockOneLocked(StgMVar_head(mvar) "ptr", mvar "ptr");
        StgMVar_head(mvar) = tso;
 #else
-       "ptr" tso = foreign "C" unblockOne(StgMVar_head(mvar) "ptr");
+       "ptr" tso = foreign "C" unblockOneLocked(StgMVar_head(mvar) "ptr");
        StgMVar_head(mvar) = tso;
 #endif
 
+        RELEASE_SCHED_LOCK;
+
        if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
            StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
        }
 #if defined(SMP)
-        SET_INFO(mvar,stg_FULL_MVAR_info);
+        foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info);
 #endif
     }
     else 
     {
        /* No further putMVars, MVar is now empty */
        StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
+#if defined(SMP)
+       foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info);
+#else
        SET_INFO(mvar,stg_EMPTY_MVAR_info);
+#endif
     }
     
     RET_NP(1, val);
@@ -1592,13 +1615,13 @@ putMVarzh_fast
        StgTSO_block_info(CurrentTSO)  = mvar;
        StgMVar_tail(mvar) = CurrentTSO;
        
-#if defined(SMP)
-        SET_INFO(mvar,stg_FULL_MVAR_info);
-#endif
        jump stg_block_putmvar;
     }
   
     if (StgMVar_head(mvar) != stg_END_TSO_QUEUE_closure) {
+
+        ACQUIRE_SCHED_LOCK;
+
        /* There are takeMVar(s) waiting: wake up the first one
         */
        ASSERT(StgTSO_why_blocked(StgMVar_head(mvar)) == BlockedOnMVar::I16);
@@ -1609,19 +1632,21 @@ putMVarzh_fast
       
 #if defined(GRAN) || defined(PAR)
        /* ToDo: check 2nd arg (mvar) is right */
-       "ptr" tso = foreign "C" unblockOne(StgMVar_head(mvar) "ptr",mvar "ptr");
+       "ptr" tso = foreign "C" unblockOneLocked(StgMVar_head(mvar) "ptr",mvar "ptr");
        StgMVar_head(mvar) = tso;
 #else
-       "ptr" tso = foreign "C" unblockOne(StgMVar_head(mvar) "ptr");
+       "ptr" tso = foreign "C" unblockOneLocked(StgMVar_head(mvar) "ptr");
        StgMVar_head(mvar) = tso;
 #endif
 
+        RELEASE_SCHED_LOCK;
+
        if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
            StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
        }
 
 #if defined(SMP)
-        SET_INFO(mvar,stg_EMPTY_MVAR_info);
+       foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info);
 #endif
        jump %ENTRY_CODE(Sp(0));
     }
@@ -1629,9 +1654,12 @@ putMVarzh_fast
     {
        /* No further takes, the MVar is now full. */
        StgMVar_value(mvar) = R2;
-       /* unlocks the MVar in the SMP case */
-       SET_INFO(mvar,stg_FULL_MVAR_info);
 
+#if defined(SMP)
+       foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info);
+#else
+       SET_INFO(mvar,stg_FULL_MVAR_info);
+#endif
        jump %ENTRY_CODE(Sp(0));
     }
     
@@ -1654,12 +1682,15 @@ tryPutMVarzh_fast
 
     if (info == stg_FULL_MVAR_info) {
 #if defined(SMP)
-        SET_INFO(mvar,stg_FULL_MVAR_info);
+       foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info);
 #endif
        RET_N(0);
     }
   
     if (StgMVar_head(mvar) != stg_END_TSO_QUEUE_closure) {
+
+        ACQUIRE_SCHED_LOCK;
+
        /* There are takeMVar(s) waiting: wake up the first one
         */
        ASSERT(StgTSO_why_blocked(StgMVar_head(mvar)) == BlockedOnMVar::I16);
@@ -1670,19 +1701,21 @@ tryPutMVarzh_fast
       
 #if defined(GRAN) || defined(PAR)
        /* ToDo: check 2nd arg (mvar) is right */
-       "ptr" tso = foreign "C" unblockOne(StgMVar_head(mvar) "ptr",mvar "ptr");
+       "ptr" tso = foreign "C" unblockOneLocked(StgMVar_head(mvar) "ptr",mvar "ptr");
        StgMVar_head(mvar) = tso;
 #else
-       "ptr" tso = foreign "C" unblockOne(StgMVar_head(mvar) "ptr");
+       "ptr" tso = foreign "C" unblockOneLocked(StgMVar_head(mvar) "ptr");
        StgMVar_head(mvar) = tso;
 #endif
 
+        RELEASE_SCHED_LOCK;
+
        if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
            StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
        }
 
 #if defined(SMP)
-        SET_INFO(mvar,stg_EMPTY_MVAR_info);
+       foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info);
 #endif
        jump %ENTRY_CODE(Sp(0));
     }
@@ -1690,9 +1723,12 @@ tryPutMVarzh_fast
     {
        /* No further takes, the MVar is now full. */
        StgMVar_value(mvar) = R2;
-       /* unlocks the MVar in the SMP case */
-       SET_INFO(mvar,stg_FULL_MVAR_info);
 
+#if defined(SMP)
+       foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info);
+#else
+       SET_INFO(mvar,stg_FULL_MVAR_info);
+#endif
        jump %ENTRY_CODE(Sp(0));
     }
     

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 977a2aa..7ba2fc0 100644 (file)
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -458,8 +458,6 @@ schedule( StgMainThread *mainThread USED_WHEN_RTS_SUPPORTS_THREADS,
       CurrentTSO = event->tso;
 #endif
 
-      IF_DEBUG(scheduler, printAllThreads());
-
 #if defined(RTS_SUPPORTS_THREADS)
       // Yield the capability to higher-priority tasks if necessary.
       //
@@ -762,7 +760,6 @@ run_thread:
 
     case ThreadBlocked:
        scheduleHandleThreadBlocked(t);
-       threadPaused(t);
        break;
 
     case ThreadFinished:
@@ -902,6 +899,7 @@ scheduleDetectDeadlock(void)
        // they are unreachable and will therefore be sent an
        // exception.  Any threads thus released will be immediately
        // runnable.
+
        GarbageCollect(GetRoots,rtsTrue);
        recent_activity = ACTIVITY_DONE_GC;
        if ( !EMPTY_RUN_QUEUE() ) return;
@@ -1539,7 +1537,6 @@ scheduleHandleHeapOverflow( Capability *cap, StgTSO *t )
     IF_DEBUG(scheduler,
             debugBelch("--<< thread %ld (%s) stopped: HeapOverflow\n", 
                        (long)t->id, whatNext_strs[t->what_next]));
-    threadPaused(t);
 #if defined(GRAN)
     ASSERT(!is_on_queue(t,CurrentProc));
 #elif defined(PARALLEL_HASKELL)
@@ -1571,7 +1568,6 @@ scheduleHandleStackOverflow( StgTSO *t)
     /* just adjust the stack for this thread, then pop it back
      * on the run queue.
      */
-    threadPaused(t);
     { 
        /* enlarge the stack */
        StgTSO *new_t = threadStackOverflow(t);
@@ -1630,8 +1626,6 @@ scheduleHandleYield( StgTSO *t, nat prev_what_next )
        return rtsTrue;
     }
     
-    threadPaused(t);
-    
 #if defined(GRAN)
     ASSERT(!is_on_queue(t,CurrentProc));
       
@@ -1704,12 +1698,19 @@ scheduleHandleThreadBlocked( StgTSO *t
     emitSchedule = rtsTrue;
     
 #else /* !GRAN */
-      /* don't need to do anything.  Either the thread is blocked on
-       * I/O, in which case we'll have called addToBlockedQueue
-       * previously, or it's blocked on an MVar or Blackhole, in which
-       * case it'll be on the relevant queue already.
-       */
+
+      // We don't need to do anything.  The thread is blocked, and it
+      // has tidied up its stack and placed itself on whatever queue
+      // it needs to be on.
+
+#if !defined(SMP)
     ASSERT(t->why_blocked != NotBlocked);
+            // This might not be true under SMP: we don't have
+            // exclusive access to this TSO, so someone might have
+            // woken it up by now.  This actually happens: try
+            // conc023 +RTS -N2.
+#endif
+
     IF_DEBUG(scheduler,
             debugBelch("--<< thread %d (%s) stopped: ", 
                        t->id, whatNext_strs[t->what_next]);
@@ -1943,6 +1944,8 @@ scheduleDoGC( Capability *cap STG_UNUSED )
     // so this happens periodically:
     scheduleCheckBlackHoles();
     
+    IF_DEBUG(scheduler, printAllThreads());
+
     /* everybody back, start the GC.
      * Could do it in this thread, or signal a condition var
      * to do it in another thread.  Either way, we need to

diff --git a/ghc/rts/Schedule.h b/ghc/rts/Schedule.h
index 18313de..c4560ed 100644 (file)
--- a/ghc/rts/Schedule.h
+++ b/ghc/rts/Schedule.h
@@ -46,8 +46,10 @@ void awakenBlockedQueueNoLock (StgTSO *tso);
  */
 #if defined(GRAN) || defined(PAR)
 StgBlockingQueueElement *unblockOne(StgBlockingQueueElement *bqe, StgClosure *node);
+StgBlockingQueueElement *unblockOneLocked(StgBlockingQueueElement *bqe, StgClosure *node);
 #else
 StgTSO *unblockOne(StgTSO *tso);
+StgTSO *unblockOneLocked(StgTSO *tso);
 #endif
 
 /* raiseAsync()

diff --git a/ghc/rts/StgStartup.cmm b/ghc/rts/StgStartup.cmm
index 2d5d4d8..d727cb5 100644 (file)
--- a/ghc/rts/StgStartup.cmm
+++ b/ghc/rts/StgStartup.cmm
@@ -102,6 +102,9 @@ INFO_TABLE_RET( stg_stop_thread, STOP_THREAD_WORDS, STOP_THREAD_BITMAP,
    Start a thread from the scheduler by returning to the address on
    the top of the stack.  This is used for all entries to STG code
    from C land.
+
+   On the way back, we (usually) pass through stg_returnToSched which saves
+   the thread's state away nicely.
    -------------------------------------------------------------------------- */
 
 stg_returnToStackTop
@@ -111,6 +114,24 @@ stg_returnToStackTop
   jump %ENTRY_CODE(Sp(0));
 }
 
+stg_returnToSched
+{
+  SAVE_THREAD_STATE();
+  foreign "C" threadPaused(CurrentTSO);
+  jump StgReturn;
+}
+
+// A variant of stg_returnToSched, but instead of returning directly to the
+// scheduler, we jump to the code fragment pointed to by R2.  This lets us
+// perform some final actions after making the thread safe, such as unlocking
+// the MVar on which we are about to block in SMP mode.
+stg_returnToSchedButFirst
+{
+  SAVE_THREAD_STATE();
+  foreign "C" threadPaused(CurrentTSO);
+  jump R2;
+}
+
 /* -----------------------------------------------------------------------------
     Strict IO application - performing an IO action and entering its result.