From 32a27624f18d545701dc256d2501add6b6b70866 Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Sat, 11 May 2002 00:16:12 +0000
Subject: [PATCH] [project @ 2002-05-11 00:16:11 by sof] As a result of
 calling exitScheduler(), enter into a 'shutting-down'
 state, so that the subsequent (sequential) execution of
 finalisers won't get stuck inside the Scheduler waiting for
 more work.

Cleanest way I could think of solving this problem on a
Friday afternoon.
---
 ghc/rts/RtsStartup.c |   10 +++++-----
 ghc/rts/Schedule.c   |   18 +++++++++++-------
 2 files changed, 16 insertions(+), 12 deletions(-)

diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c
index 36821d0..27ee47c 100644
--- a/ghc/rts/RtsStartup.c
+++ b/ghc/rts/RtsStartup.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsStartup.c,v 1.62 2002/04/26 22:35:55 sof Exp $
+ * $Id: RtsStartup.c,v 1.63 2002/05/11 00:16:12 sof Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -273,10 +273,13 @@ shutdownHaskell(void)
   if (!rts_has_started_up)
      return;
   rts_has_started_up=0;
-
+  
   /* start timing the shutdown */
   stat_startExit();
 
+  /* stop all running tasks */
+  exitScheduler();
+
 #if !defined(GRAN)
   /* Finalize any remaining weak pointers */
   finalizeWeakPointersNow();
@@ -288,9 +291,6 @@ shutdownHaskell(void)
     end_gr_simulation();
 #endif
 
-  /* stop all running tasks */
-  exitScheduler();
-
   /* stop the ticker */
   stopVirtTimer();
   
diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 64c983e..11a52ec 100644
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -1,5 +1,5 @@
 /* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.141 2002/04/26 22:35:54 sof Exp $
+ * $Id: Schedule.c,v 1.142 2002/05/11 00:16:11 sof Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -224,6 +224,7 @@ StgTSO *CurrentTSO;
 StgTSO dummy_tso;
 
 rtsBool ready_to_gc;
+rtsBool shutting_down_scheduler = rtsFalse;
 
 void            addToBlockedQueue ( StgTSO *tso );
 
@@ -714,15 +715,17 @@ schedule( void )
     if ( EMPTY_RUN_QUEUE() ) {
       /* Give up our capability */
       releaseCapability(cap);
+
+      /* If we're in the process of shutting down (& running the
+       * a batch of finalisers), don't wait around.
+       */
+      if ( shutting_down_scheduler ) {
+	RELEASE_LOCK(&sched_mutex);
+	return;
+      }
       IF_DEBUG(scheduler, sched_belch("thread %d: waiting for work", osThreadId()));
       waitForWorkCapability(&sched_mutex, &cap, rtsTrue);
       IF_DEBUG(scheduler, sched_belch("thread %d: work now available", osThreadId()));
-#if 0
-      while ( EMPTY_RUN_QUEUE() ) {
-	waitForWorkCapability(&sched_mutex, &cap);
-	IF_DEBUG(scheduler, sched_belch("thread %d: work now available", osThreadId()));
-      }
-#endif
     }
 #endif
 
@@ -2084,6 +2087,7 @@ exitScheduler( void )
 #if defined(RTS_SUPPORTS_THREADS)
   stopTaskManager();
 #endif
+  shutting_down_scheduler = rtsTrue;
 }
 
 /* -----------------------------------------------------------------------------
-- 
1.7.10.4