From: Simon Marlow <simonmar@microsoft.com>
Date: Fri, 14 Sep 2007 14:55:19 +0000 (+0000)
Subject: attempt to fix #1391, hold locks across fork() and initialize them in the child
X-Git-Tag: 2007-09-25~4
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=442099ad2dbcc007b137745b9246116f06c8723d

attempt to fix #1391, hold locks across fork() and initialize them in the child
---

diff --git a/rts/Schedule.c b/rts/Schedule.c
index 5ebb685..22e6120 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -2137,16 +2137,31 @@ forkProcess(HsStablePtr *entry
     // ToDo: for SMP, we should probably acquire *all* the capabilities
     cap = rts_lock();
     
+    // no funny business: hold locks while we fork, otherwise if some
+    // other thread is holding a lock when the fork happens, the data
+    // structure protected by the lock will forever be in an
+    // inconsistent state in the child.  See also #1391.
+    ACQUIRE_LOCK(&sched_mutex);
+    ACQUIRE_LOCK(&cap->lock);
+
     pid = fork();
     
     if (pid) { // parent
 	
+        RELEASE_LOCK(&sched_mutex);
+        RELEASE_LOCK(&cap->lock);
+
 	// just return the pid
 	rts_unlock(cap);
 	return pid;
 	
     } else { // child
 	
+#if defined(THREADED_RTS)
+        initMutex(&sched_mutex);
+        initMutex(&cap->lock);
+#endif
+
 	// Now, all OS threads except the thread that forked are
 	// stopped.  We need to stop all Haskell threads, including
 	// those involved in foreign calls.  Also we need to delete