also call initMutex on every task->lock, see #1391

[ghc-hetmet.git] / rts / Schedule.c

diff --git a/rts/Schedule.c b/rts/Schedule.c
index b68e1ac..375520d 100644 (file)
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -2137,16 +2137,34 @@ 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);
+    ACQUIRE_LOCK(&cap->running_task->lock);
+
     pid = fork();
     
     if (pid) { // parent
        
+        RELEASE_LOCK(&sched_mutex);
+        RELEASE_LOCK(&cap->lock);
+        RELEASE_LOCK(&cap->running_task->lock);
+
        // just return the pid
        rts_unlock(cap);
        return pid;
        
     } else { // child
        
+#if defined(THREADED_RTS)
+        initMutex(&sched_mutex);
+        initMutex(&cap->lock);
+        initMutex(&cap->running_task->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
@@ -2184,6 +2202,9 @@ forkProcess(HsStablePtr *entry
        ACQUIRE_LOCK(&sched_mutex);
        for (task = all_tasks; task != NULL; task=task->all_link) {
            if (task != cap->running_task) {
+#if defined(THREADED_RTS)
+                initMutex(&task->lock); // see #1391
+#endif
                discardTask(task);
            }
        }
@@ -3109,10 +3130,10 @@ findRetryFrameHelper (StgTSO *tso)
        return CATCH_RETRY_FRAME;
       
     case CATCH_STM_FRAME: {
-        debugTrace(DEBUG_stm,
-                  "found CATCH_STM_FRAME at %p during retry", p);
         StgTRecHeader *trec = tso -> trec;
        StgTRecHeader *outer = stmGetEnclosingTRec(trec);
+        debugTrace(DEBUG_stm,
+                  "found CATCH_STM_FRAME at %p during retry", p);
         debugTrace(DEBUG_stm, "trec=%p outer=%p", trec, outer);
        stmAbortTransaction(tso -> cap, trec);
        stmFreeAbortedTRec(tso -> cap, trec);