X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FThreads.c;h=d578cc29c77ad5729d1c4b20821bdb54a6487e15;hb=30ced40470d0bb2a14a8eb25dd77ca99edd88a5a;hp=b7f62c8f07fad55734c6446fe3ebf42d63e4e8b6;hpb=200c73fdfea734765c48309cc8dcbcf44b69c8c5;p=ghc-hetmet.git

diff --git a/rts/Threads.c b/rts/Threads.c
index b7f62c8..d578cc2 100644
--- a/rts/Threads.c
+++ b/rts/Threads.c
@@ -84,7 +84,7 @@ createThread(Capability *cap, nat size)
 	size = MIN_STACK_WORDS + TSO_STRUCT_SIZEW;
     }
 
-    stack_size = size - TSO_STRUCT_SIZEW;
+    stack_size = round_to_mblocks(size) - TSO_STRUCT_SIZEW;
     
     tso = (StgTSO *)allocateLocal(cap, size);
     TICK_ALLOC_TSO(stack_size, 0);
@@ -210,6 +210,8 @@ createThread(Capability *cap, nat size)
     }
 #endif 
     
+    postEvent (cap, EVENT_CREATE_THREAD, tso->id, 0);
+
 #if defined(GRAN)
     debugTrace(GRAN_DEBUG_pri,
 	       "==__ schedule: Created TSO %d (%p);",
@@ -503,22 +505,30 @@ unblockOne_ (Capability *cap, StgTSO *tso,
 	  ASSERT(tso->bound->cap == tso->cap);
 	  tso->bound->cap = cap;
       }
+
       tso->cap = cap;
       appendToRunQueue(cap,tso);
-      // we're holding a newly woken thread, make sure we context switch
-      // quickly so we can migrate it if necessary.
-      context_switch = 1;
+
+      // context-switch soonish so we can migrate the new thread if
+      // necessary.  NB. not contextSwitchCapability(cap), which would
+      // force a context switch immediately.
+      cap->context_switch = 1;
   } else {
       // we'll try to wake it up on the Capability it was last on.
-      wakeupThreadOnCapability_lock(tso->cap, tso);
+      wakeupThreadOnCapability(cap, tso->cap, tso);
   }
 #else
   appendToRunQueue(cap,tso);
-  context_switch = 1;
+
+  // context-switch soonish so we can migrate the new thread if
+  // necessary.  NB. not contextSwitchCapability(cap), which would
+  // force a context switch immediately.
+  cap->context_switch = 1;
 #endif
 
-  debugTrace(DEBUG_sched,
-	     "waking up thread %ld on cap %d",
+  postEvent (cap, EVENT_THREAD_WAKEUP, tso->id, tso->cap->no);
+
+  debugTrace(DEBUG_sched, "waking up thread %ld on cap %d",
 	     (long)tso->id, tso->cap->no);
 
   return next;
@@ -698,7 +708,7 @@ printThreadBlockage(StgTSO *tso)
     break;
 #if defined(mingw32_HOST_OS)
     case BlockedOnDoProc:
-    debugBelch("is blocked on proc (request: %ld)", tso->block_info.async_result->reqID);
+    debugBelch("is blocked on proc (request: %u)", tso->block_info.async_result->reqID);
     break;
 #endif
   case BlockedOnDelay:
@@ -763,6 +773,11 @@ printThreadStatus(StgTSO *t)
 	default:
 	    printThreadBlockage(t);
 	}
+        if (t->flags & TSO_DIRTY) {
+            debugBelch(" (TSO_DIRTY)");
+        } else if (t->flags & TSO_LINK_DIRTY) {
+            debugBelch(" (TSO_LINK_DIRTY)");
+        }
 	debugBelch("\n");
     }
 }