[project @ 2005-04-25 15:36:28 by simonmar]

Partial support for deadlock detection in the threaded/SMP RTS.

The idea is to wait until a complete time slice has gone by without
running any Haskell code, and then try doing a GC to detect deadlocked
threads.

This kind of works: but we can only wake up a worker thread from the
signal handler if there's another worker running - we can't wake up the
current thread, it seems.

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index ee69d03..baf5e1d 100644 (file)
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -174,6 +174,9 @@ static StgTSO *suspended_ccalling_threads;
 /* flag set by signal handler to precipitate a context switch */
 int context_switch = 0;
 
+/* flag that tracks whether we have done any execution in this time slice. */
+nat recent_activity = ACTIVITY_YES;
+
 /* if this flag is set as well, give up execution */
 rtsBool interrupted = rtsFalse;
 
@@ -668,6 +671,8 @@ run_thread:
     errno = t->saved_errno;
     cap->r.rInHaskell = rtsTrue;
 
+    recent_activity = ACTIVITY_YES;
+
     switch (prev_what_next) {
 
     case ThreadKilled:
@@ -850,6 +855,12 @@ scheduleCheckBlackHoles( void )
 static void
 scheduleDetectDeadlock(void)
 {
+
+#if defined(PARALLEL_HASKELL)
+    // ToDo: add deadlock detection in GUM (similar to SMP) -- HWL
+    return;
+#endif
+
     /* 
      * Detect deadlock: when we have no threads to run, there are no
      * threads blocked, waiting for I/O, or sleeping, and all the
@@ -858,7 +869,16 @@ scheduleDetectDeadlock(void)
      */
     if ( EMPTY_THREAD_QUEUES() )
     {
-#if !defined(PARALLEL_HASKELL) && !defined(RTS_SUPPORTS_THREADS)
+#if defined(RTS_SUPPORTS_THREADS)
+       /* 
+        * In the threaded RTS, we only check for deadlock if there
+        * has been no activity in a complete timeslice.  This means
+        * we won't eagerly start a full GC just because we don't have
+        * any threads to run currently.
+        */
+       if (recent_activity != ACTIVITY_INACTIVE) return;
+#endif
+
        IF_DEBUG(scheduler, sched_belch("deadlocked, forcing major GC..."));
 
        // Garbage collection can release some new threads due to
@@ -867,9 +887,10 @@ scheduleDetectDeadlock(void)
        // exception.  Any threads thus released will be immediately
        // runnable.
        GarbageCollect(GetRoots,rtsTrue);
+       recent_activity = ACTIVITY_DONE_GC;
        if ( !EMPTY_RUN_QUEUE() ) return;
 
-#if defined(RTS_USER_SIGNALS)
+#if defined(RTS_USER_SIGNALS) && !defined(RTS_SUPPORTS_THREADS)
        /* If we have user-installed signal handlers, then wait
         * for signals to arrive rather then bombing out with a
         * deadlock.
@@ -891,6 +912,7 @@ scheduleDetectDeadlock(void)
        }
 #endif
 
+#if !defined(RTS_SUPPORTS_THREADS)
        /* Probably a real deadlock.  Send the current main thread the
         * Deadlock exception (or in the SMP build, send *all* main
         * threads the deadlock exception, since none of them can make
@@ -910,11 +932,6 @@ scheduleDetectDeadlock(void)
                barf("deadlock: main thread blocked in a strange way");
            }
        }
-
-#elif defined(RTS_SUPPORTS_THREADS)
-    // ToDo: add deadlock detection in threaded RTS
-#elif defined(PARALLEL_HASKELL)
-    // ToDo: add deadlock detection in GUM (similar to SMP) -- HWL
 #endif
     }
 }
@@ -3221,6 +3238,10 @@ interruptStgRts(void)
     interrupted    = 1;
     context_switch = 1;
     threadRunnable();
+    /* ToDo: if invoked from a signal handler, this threadRunnable
+     * only works if there's another thread (not this one) waiting to
+     * be woken up.
+     */
 }
 
 /* -----------------------------------------------------------------------------

diff --git a/ghc/rts/Schedule.h b/ghc/rts/Schedule.h
index d8c1643..18313de 100644 (file)
--- a/ghc/rts/Schedule.h
+++ b/ghc/rts/Schedule.h
@@ -133,6 +133,15 @@ void    initThread(StgTSO *tso, nat stack_size);
 extern int RTS_VAR(context_switch);
 extern rtsBool RTS_VAR(interrupted);
 
+/* 
+ * flag that tracks whether we have done any execution in this time slice.
+ */
+#define ACTIVITY_YES      0 /* there has been activity in the current slice */
+#define ACTIVITY_MAYBE_NO 1 /* no activity in the current slice */
+#define ACTIVITY_INACTIVE 2 /* a complete slice has passed with no activity */
+#define ACTIVITY_DONE_GC  3 /* like 2, but we've done a GC too */
+extern nat recent_activity;
+
 /* In Select.c */
 extern lnat RTS_VAR(timestamp);
 

diff --git a/ghc/rts/Timer.c b/ghc/rts/Timer.c
index 147b4d1..da4c852 100644 (file)
--- a/ghc/rts/Timer.c
+++ b/ghc/rts/Timer.c
@@ -19,6 +19,7 @@
 #include "Proftimer.h"
 #include "Schedule.h"
 #include "Timer.h"
+#include "Capability.h"
 
 #if !defined(mingw32_HOST_OS)
 #include "Itimer.h"
@@ -47,6 +48,30 @@ handle_tick(int unused STG_UNUSED)
       if (ticks_to_ctxt_switch <= 0) {
          ticks_to_ctxt_switch = RtsFlags.ConcFlags.ctxtSwitchTicks;
          context_switch = 1;   /* schedule a context switch */
+
+#if defined(RTS_SUPPORTS_THREADS)
+         /* 
+          * If we've been inactive for a whole time slice, tell the
+          * scheduler to wake up and do a GC, to check for threads
+          * that are deadlocked.
+          */
+         switch (recent_activity) {
+         case ACTIVITY_YES:
+             recent_activity = ACTIVITY_MAYBE_NO;
+             break;
+         case ACTIVITY_MAYBE_NO:
+             recent_activity = ACTIVITY_INACTIVE;
+             blackholes_need_checking = rtsTrue;
+             /* hack: re-use the blackholes_need_checking flag */
+             threadRunnable();
+             /* ToDo: this threadRunnable only works if there's
+              * another thread (not this one) waiting to be woken up
+              */
+             break;
+         default:
+             break;
+         }
+#endif
       }
   }
 }