X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSchedule.c;h=5169895631acba8052a5948eedbe986aa65ff790;hb=c50bc4658e3801442b4581bd1d9a19f67567cdda;hp=8e3981487373e3d3be4cf412fa635e6edfd667cc;hpb=150ac5e907ec5096660f90caaa5f076da181d81b;p=ghc-hetmet.git

diff --git a/rts/Schedule.c b/rts/Schedule.c
index 8e39814..5169895 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -56,6 +56,9 @@
 #include <errno.h>
 #endif
 
+#ifdef TRACING
+#include "eventlog/EventLog.h"
+#endif
 /* -----------------------------------------------------------------------------
  * Global variables
  * -------------------------------------------------------------------------- */
@@ -1031,10 +1034,8 @@ scheduleHandleHeapOverflow( Capability *cap, StgTSO *t )
 	    cap->r.rNursery->n_blocks == 1) {  // paranoia to prevent infinite loop
 	                                       // if the nursery has only one block.
 	    
-	    ACQUIRE_SM_LOCK
-	    bd = allocGroup( blocks );
-	    RELEASE_SM_LOCK
-	    cap->r.rNursery->n_blocks += blocks;
+            bd = allocGroup_lock(blocks);
+            cap->r.rNursery->n_blocks += blocks;
 	    
 	    // link the new group into the list
 	    bd->link = cap->r.rCurrentNursery;
@@ -1535,6 +1536,10 @@ forkProcess(HsStablePtr *entry
 
     stopTimer(); // See #4074
 
+#if defined(TRACING)
+    flushEventLog(); // so that child won't inherit dirty file buffers
+#endif
+
     pid = fork();
     
     if (pid) { // parent
@@ -1557,6 +1562,10 @@ forkProcess(HsStablePtr *entry
         initMutex(&cap->running_task->lock);
 #endif
 
+#if defined(TRACING)
+        abortEventLogging(); // abort eventlog inherited from parent
+        initEventLogging(); // child starts its own eventlog
+#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