X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSchedule.c;h=be3b7cbf24b8fb6a859a7b7a12fbcf8bf8b94a04;hb=f6013eedb4dea47afac8167dfa08561ae90454db;hp=302ec1e7a546e82fd3b319cca90760c18ace843c;hpb=0856ac59cfb455d32a3042317fdba0f5e85cab9c;p=ghc-hetmet.git

diff --git a/rts/Schedule.c b/rts/Schedule.c
index 302ec1e..be3b7cb 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -17,7 +17,7 @@
 #include "Interpreter.h"
 #include "Printer.h"
 #include "RtsSignals.h"
-#include "Sanity.h"
+#include "sm/Sanity.h"
 #include "Stats.h"
 #include "STM.h"
 #include "Prelude.h"
@@ -162,7 +162,7 @@ static Capability *scheduleDoGC(Capability *cap, Task *task,
 static rtsBool checkBlackHoles(Capability *cap);
 
 static StgTSO *threadStackOverflow(Capability *cap, StgTSO *tso);
-static StgTSO *threadStackUnderflow(Task *task, StgTSO *tso);
+static StgTSO *threadStackUnderflow(Capability *cap, Task *task, StgTSO *tso);
 
 static void deleteThread (Capability *cap, StgTSO *tso);
 static void deleteAllThreads (Capability *cap);
@@ -547,7 +547,7 @@ run_thread:
     schedulePostRunThread(cap,t);
 
     if (ret != StackOverflow) {
-        t = threadStackUnderflow(task,t);
+        t = threadStackUnderflow(cap,task,t);
     }
 
     ready_to_gc = rtsFalse;
@@ -1118,8 +1118,8 @@ scheduleHandleHeapOverflow( Capability *cap, StgTSO *t )
 	    { 
 		bdescr *x;
 		for (x = bd; x < bd + blocks; x++) {
-		    x->step = cap->r.rNursery;
-		    x->gen_no = 0;
+                    initBdescr(x,cap->r.rNursery);
+                    x->free = x->start;
 		    x->flags = 0;
 		}
 	    }
@@ -1206,9 +1206,6 @@ scheduleHandleYield( Capability *cap, StgTSO *t, nat prev_what_next )
     }
 #endif
     
-    IF_DEBUG(sanity,
-	     //debugBelch("&& Doing sanity check on yielding TSO %ld.", t->id);
-	     checkTSO(t));
     ASSERT(t->_link == END_TSO_QUEUE);
     
     // Shortcut if we're just switching evaluators: don't bother
@@ -1218,6 +1215,10 @@ scheduleHandleYield( Capability *cap, StgTSO *t, nat prev_what_next )
 	return rtsTrue;
     }
 
+    IF_DEBUG(sanity,
+	     //debugBelch("&& Doing sanity check on yielding TSO %ld.", t->id);
+	     checkTSO(t));
+
     addToRunQueue(cap,t);
 
     return rtsFalse;
@@ -1418,6 +1419,18 @@ scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS, rtsBool force_major)
     if (gc_type == PENDING_GC_SEQ)
     {
         traceSchedEvent(cap, EVENT_REQUEST_SEQ_GC, 0, 0);
+    }
+    else
+    {
+        traceSchedEvent(cap, EVENT_REQUEST_PAR_GC, 0, 0);
+        debugTrace(DEBUG_sched, "ready_to_gc, grabbing GC threads");
+    }
+
+    // do this while the other Capabilities stop:
+    if (cap) scheduleCheckBlackHoles(cap);
+
+    if (gc_type == PENDING_GC_SEQ)
+    {
         // single-threaded GC: grab all the capabilities
         for (i=0; i < n_capabilities; i++) {
             debugTrace(DEBUG_sched, "ready_to_gc, grabbing all the capabilies (%d/%d)", i, n_capabilities);
@@ -1440,16 +1453,16 @@ scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS, rtsBool force_major)
     {
         // multi-threaded GC: make sure all the Capabilities donate one
         // GC thread each.
-        traceSchedEvent(cap, EVENT_REQUEST_PAR_GC, 0, 0);
-        debugTrace(DEBUG_sched, "ready_to_gc, grabbing GC threads");
-
         waitForGcThreads(cap);
     }
-#endif
 
-    // so this happens periodically:
+#else /* !THREADED_RTS */
+
+    // do this while the other Capabilities stop:
     if (cap) scheduleCheckBlackHoles(cap);
-    
+
+#endif
+
     IF_DEBUG(scheduler, printAllThreads());
 
 delete_threads_and_gc:
@@ -1671,6 +1684,10 @@ forkProcess(HsStablePtr *entry
         initTimer();
         startTimer();
 
+#if defined(THREADED_RTS)
+        cap = ioManagerStartCap(cap);
+#endif
+
 	cap = rts_evalStableIO(cap, entry, NULL);  // run the action
 	rts_checkSchedStatus("forkProcess",cap);
 	
@@ -2084,9 +2101,10 @@ exitScheduler(
 	for (i = 0; i < n_capabilities; i++) {
 	    shutdownCapability(&capabilities[i], task, wait_foreign);
 	}
-	boundTaskExiting(task);
     }
 #endif
+
+    boundTaskExiting(task);
 }
 
 void
@@ -2173,12 +2191,27 @@ threadStackOverflow(Capability *cap, StgTSO *tso)
   // while we are moving the TSO:
   lockClosure((StgClosure *)tso);
 
-  if (tso->stack_size >= tso->max_stack_size && !(tso->flags & TSO_BLOCKEX)) {
+  if (tso->stack_size >= tso->max_stack_size
+      && !(tso->flags & TSO_BLOCKEX)) {
       // NB. never raise a StackOverflow exception if the thread is
       // inside Control.Exceptino.block.  It is impractical to protect
       // against stack overflow exceptions, since virtually anything
       // can raise one (even 'catch'), so this is the only sensible
       // thing to do here.  See bug #767.
+      //
+
+      if (tso->flags & TSO_SQUEEZED) {
+          return tso;
+      }
+      // #3677: In a stack overflow situation, stack squeezing may
+      // reduce the stack size, but we don't know whether it has been
+      // reduced enough for the stack check to succeed if we try
+      // again.  Fortunately stack squeezing is idempotent, so all we
+      // need to do is record whether *any* squeezing happened.  If we
+      // are at the stack's absolute -K limit, and stack squeezing
+      // happened, then we try running the thread again.  The
+      // TSO_SQUEEZED flag is set by threadPaused() to tell us whether
+      // squeezing happened or not.
 
       debugTrace(DEBUG_gc,
 		 "threadStackOverflow of TSO %ld (%p): stack too large (now %ld; max is %ld)",
@@ -2194,6 +2227,21 @@ threadStackOverflow(Capability *cap, StgTSO *tso)
       return tso;
   }
 
+
+  // We also want to avoid enlarging the stack if squeezing has
+  // already released some of it.  However, we don't want to get into
+  // a pathalogical situation where a thread has a nearly full stack
+  // (near its current limit, but not near the absolute -K limit),
+  // keeps allocating a little bit, squeezing removes a little bit,
+  // and then it runs again.  So to avoid this, if we squeezed *and*
+  // there is still less than BLOCK_SIZE_W words free, then we enlarge
+  // the stack anyway.
+  if ((tso->flags & TSO_SQUEEZED) && 
+      ((W_)(tso->sp - tso->stack) >= BLOCK_SIZE_W)) {
+      unlockTSO(tso);
+      return tso;
+  }
+
   /* Try to double the current stack size.  If that takes us over the
    * maximum stack size for this thread, then use the maximum instead
    * (that is, unless we're already at or over the max size and we
@@ -2215,7 +2263,7 @@ threadStackOverflow(Capability *cap, StgTSO *tso)
 	     "increasing stack size from %ld words to %d.",
 	     (long)tso->stack_size, new_stack_size);
 
-  dest = (StgTSO *)allocateLocal(cap,new_tso_size);
+  dest = (StgTSO *)allocate(cap,new_tso_size);
   TICK_ALLOC_TSO(new_stack_size,0);
 
   /* copy the TSO block and the old stack into the new area */
@@ -2252,7 +2300,7 @@ threadStackOverflow(Capability *cap, StgTSO *tso)
 }
 
 static StgTSO *
-threadStackUnderflow (Task *task STG_UNUSED, StgTSO *tso)
+threadStackUnderflow (Capability *cap, Task *task, StgTSO *tso)
 {
     bdescr *bd, *new_bd;
     lnat free_w, tso_size_w;
@@ -2290,6 +2338,13 @@ threadStackUnderflow (Task *task STG_UNUSED, StgTSO *tso)
     memcpy(new_tso,tso,TSO_STRUCT_SIZE);
     new_tso->stack_size = new_bd->free - new_tso->stack;
 
+    // The original TSO was dirty and probably on the mutable
+    // list. The new TSO is not yet on the mutable list, so we better
+    // put it there.
+    new_tso->dirty = 0;
+    new_tso->flags &= !TSO_LINK_DIRTY;
+    dirty_TSO(cap, new_tso);
+
     debugTrace(DEBUG_sched, "thread %ld: reducing TSO size from %lu words to %lu",
                (long)tso->id, tso_size_w, tso_sizeW(new_tso));
 
@@ -2486,7 +2541,7 @@ raiseExceptionHelper (StgRegTable *reg, StgTSO *tso, StgClosure *exception)
 	    // Only create raise_closure if we need to.
 	    if (raise_closure == NULL) {
 		raise_closure = 
-		    (StgThunk *)allocateLocal(cap,sizeofW(StgThunk)+1);
+		    (StgThunk *)allocate(cap,sizeofW(StgThunk)+1);
 		SET_HDR(raise_closure, &stg_raise_info, CCCS);
 		raise_closure->payload[0] = exception;
 	    }