[project @ 2002-03-12 13:57:11 by simonmar]

If we are in a deadlock situation but there are signal handlers
installed, pause() instead of reporting deadlock.  One of the signal
handlers may allow the process to continue after being triggered.

Fixes bug #525772.

I've made a half-hearted attempt to clean up the deadlock code in the
scheduler, it now looks slightly better.

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 5cef10c..f40e457 100644 (file)
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -1,5 +1,5 @@
 /* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.133 2002/03/12 11:51:06 simonmar Exp $
+ * $Id: Schedule.c,v 1.134 2002/03/12 13:57:11 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -554,9 +554,7 @@ schedule( void )
      * inform all the main threads.
      */
 #ifndef PAR
-    if (   EMPTY_RUN_QUEUE()
-       && EMPTY_QUEUE(blocked_queue_hd)
-       && EMPTY_QUEUE(sleeping_queue)
+    if (   EMPTY_THREAD_QUEUES()
 #if defined(RTS_SUPPORTS_THREADS)
        && EMPTY_QUEUE(suspended_ccalling_threads)
 #endif
@@ -570,37 +568,51 @@ schedule( void )
        /* and SMP mode ..? */
        releaseCapability(cap);
 #endif
+       // Garbage collection can release some new threads due to
+       // either (a) finalizers or (b) threads resurrected because
+       // they are about to be send BlockedOnDeadMVar.  Any threads
+       // thus released will be immediately runnable.
        GarbageCollect(GetRoots,rtsTrue);
-       if (   EMPTY_QUEUE(blocked_queue_hd)
-           && EMPTY_RUN_QUEUE()
-           && EMPTY_QUEUE(sleeping_queue) ) {
-
-           IF_DEBUG(scheduler, sched_belch("still deadlocked, checking for black holes..."));
-           detectBlackHoles();
-
-           /* No black holes, so 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 progress).
-            */
-           if ( EMPTY_RUN_QUEUE() ) {
-               StgMainThread *m;
+
+       if ( !EMPTY_RUN_QUEUE() ) { goto not_deadlocked; }
+
+       IF_DEBUG(scheduler, 
+                sched_belch("still deadlocked, checking for black holes..."));
+       detectBlackHoles();
+
+       if ( !EMPTY_RUN_QUEUE() ) { goto not_deadlocked; }
+
+#ifndef mingw32_TARGET_OS
+       /* If we have user-installed signal handlers, then wait
+        * for signals to arrive rather then bombing out with a
+        * deadlock.
+        */
+       if ( anyUserHandlers() ) {
+           IF_DEBUG(scheduler, 
+                    sched_belch("still deadlocked, waiting for signals..."));
+
+           awaitUserSignals();
+
+           // we might be interrupted...
+           if (interrupted) { continue; }
+
+           if (signals_pending()) {
+               startSignalHandlers();
+           }
+           ASSERT(!EMPTY_RUN_QUEUE());
+           goto not_deadlocked;
+       }
+#endif
+
+       /* 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
+        * progress).
+        */
+       {
+           StgMainThread *m;
 #if defined(RTS_SUPPORTS_THREADS)
-               for (m = main_threads; m != NULL; m = m->link) {
-                   switch (m->tso->why_blocked) {
-                   case BlockedOnBlackHole:
-                       raiseAsync(m->tso, (StgClosure *)NonTermination_closure);
-                       break;
-                   case BlockedOnException:
-                   case BlockedOnMVar:
-                       raiseAsync(m->tso, (StgClosure *)Deadlock_closure);
-                       break;
-                   default:
-                       barf("deadlock: main thread blocked in a strange way");
-                   }
-               }
-#else
-               m = main_threads;
+           for (m = main_threads; m != NULL; m = m->link) {
                switch (m->tso->why_blocked) {
                case BlockedOnBlackHole:
                    raiseAsync(m->tso, (StgClosure *)NonTermination_closure);
@@ -612,19 +624,32 @@ schedule( void )
                default:
                    barf("deadlock: main thread blocked in a strange way");
                }
-#endif
            }
-#if defined(RTS_SUPPORTS_THREADS)
-           /* ToDo: revisit conditions (and mechanism) for shutting
-              down a multi-threaded world  */
-           if ( EMPTY_RUN_QUEUE() ) {
-             IF_DEBUG(scheduler, sched_belch("all done, i think...shutting down."));
-             shutdownHaskellAndExit(0);
+#else
+           m = main_threads;
+           switch (m->tso->why_blocked) {
+           case BlockedOnBlackHole:
+               raiseAsync(m->tso, (StgClosure *)NonTermination_closure);
+               break;
+           case BlockedOnException:
+           case BlockedOnMVar:
+               raiseAsync(m->tso, (StgClosure *)Deadlock_closure);
+               break;
+           default:
+               barf("deadlock: main thread blocked in a strange way");
            }
 #endif
-           ASSERT( !EMPTY_RUN_QUEUE() );
        }
+
+#if defined(RTS_SUPPORTS_THREADS)
+       /* ToDo: revisit conditions (and mechanism) for shutting
+          down a multi-threaded world  */
+       IF_DEBUG(scheduler, sched_belch("all done, i think...shutting down."));
+       shutdownHaskellAndExit(0);
+#endif
     }
+  not_deadlocked:
+
 #elif defined(PAR)
     /* ToDo: add deadlock detection in GUM (similar to SMP) -- HWL */
 #endif
@@ -1362,18 +1387,10 @@ void deleteAllThreads ( void )
 {
   StgTSO* t, *next;
   IF_DEBUG(scheduler,sched_belch("deleting all threads"));
-  for (t = run_queue_hd; t != END_TSO_QUEUE; t = next) {
-      next = t->link;
-      deleteThread(t);
-  }
-  for (t = blocked_queue_hd; t != END_TSO_QUEUE; t = next) {
-      next = t->link;
+  for (t = all_threads; t != END_TSO_QUEUE; t = next) {
+      next = t->global_link;
       deleteThread(t);
-  }
-  for (t = sleeping_queue; t != END_TSO_QUEUE; t = next) {
-      next = t->link;
-      deleteThread(t);
-  }
+  }      
   run_queue_hd = run_queue_tl = END_TSO_QUEUE;
   blocked_queue_hd = blocked_queue_tl = END_TSO_QUEUE;
   sleeping_queue = END_TSO_QUEUE;

diff --git a/ghc/rts/Schedule.h b/ghc/rts/Schedule.h
index 10f950c..5b0e16b 100644 (file)
--- a/ghc/rts/Schedule.h
+++ b/ghc/rts/Schedule.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Schedule.h,v 1.30 2002/03/12 11:51:07 simonmar Exp $
+ * $Id: Schedule.h,v 1.31 2002/03/12 13:57:12 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -267,9 +267,16 @@ void print_bqe (StgBlockingQueueElement *bqe);
 #define THREAD_RUNNABLE()  /* nothing */
 #endif
 
-/* Check whether the run queue is empty i.e. the PE is idle
+/* Check whether various thread queues are empty
  */
-#define EMPTY_RUN_QUEUE()     (run_queue_hd == END_TSO_QUEUE)
-#define EMPTY_QUEUE(q)        (q == END_TSO_QUEUE)
+#define EMPTY_QUEUE(q)         (q == END_TSO_QUEUE)
+
+#define EMPTY_RUN_QUEUE()      (EMPTY_QUEUE(run_queue_hd))
+#define EMPTY_BLOCKED_QUEUE()  (EMPTY_QUEUE(blocked_queue_hd))
+#define EMPTY_SLEEPING_QUEUE() (EMPTY_QUEUE(sleeping_queue))
+
+#define EMPTY_THREAD_QUEUES()  (EMPTY_RUN_QUEUE() && \
+                               EMPTY_BLOCKED_QUEUE() && \
+                               EMPTY_SLEEPING_QUEUE())
 
 #endif /* __SCHEDULE_H__ */

diff --git a/ghc/rts/Signals.c b/ghc/rts/Signals.c
index 747356d..2e26d0b 100644 (file)
--- a/ghc/rts/Signals.c
+++ b/ghc/rts/Signals.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Signals.c,v 1.22 2001/10/31 10:34:29 simonmar Exp $
+ * $Id: Signals.c,v 1.23 2002/03/12 13:57:14 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -30,6 +30,8 @@
 static StgInt *handlers = NULL; /* Dynamically grown array of signal handlers */
 static StgInt nHandlers = 0;    /* Size of handlers array */
 
+static nat n_haskell_handlers = 0;
+
 #define N_PENDING_HANDLERS 16
 
 StgPtr pending_handler_buf[N_PENDING_HANDLERS];
@@ -166,6 +168,19 @@ unblockUserSignals(void)
     sigprocmask(SIG_SETMASK, &savedSignals, NULL);
 }
 
+rtsBool
+anyUserHandlers(void)
+{
+    return n_haskell_handlers != 0;
+}
+
+void
+awaitUserSignals(void)
+{
+    while (!signals_pending() && !interrupted) {
+       pause();
+    }
+}
 
 /* -----------------------------------------------------------------------------
  * Install a Haskell signal handler.
@@ -206,6 +221,7 @@ stg_sig_install(StgInt sig, StgInt spi, StgStablePtr handler, sigset_t *mask)
        handlers[sig] = (StgInt)handler;
        sigaddset(&userSignals, sig);
        action.sa_handler = generic_handler;
+       n_haskell_handlers++;
        break;
 
     default:
@@ -226,6 +242,7 @@ stg_sig_install(StgInt sig, StgInt spi, StgStablePtr handler, sigset_t *mask)
        // by freeing the previous handler if there was one.
        if (previous_spi >= 0) {
            freeStablePtr(stgCast(StgStablePtr,handlers[sig]));
+           n_haskell_handlers--;
        }
        return STG_SIG_ERR;
     }

diff --git a/ghc/rts/Signals.h b/ghc/rts/Signals.h
index 0425c7b..4ea7523 100644 (file)
--- a/ghc/rts/Signals.h
+++ b/ghc/rts/Signals.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Signals.h,v 1.6 2001/10/31 10:34:29 simonmar Exp $
+ * $Id: Signals.h,v 1.7 2002/03/12 13:57:14 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -14,9 +14,12 @@ extern StgPtr *next_pending_handler;
 
 #define signals_pending() (next_pending_handler != pending_handler_buf)
 
-extern void initUserSignals(void);
-extern void blockUserSignals(void);
-extern void unblockUserSignals(void);
+extern void    initUserSignals(void);
+extern void    blockUserSignals(void);
+extern void    unblockUserSignals(void);
+
+extern rtsBool anyUserHandlers(void);
+extern void    awaitUserSignals(void);
 
 /* sig_install declared in PrimOps.h */