X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FCapability.c;h=f4fdd70ed92e01fadc27bec73169cadca7817416;hb=f4b727487a65e6b611bbaafbd2207bd63a8df706;hp=a81d71073a20877d6cc1259cedcc4232706cfb10;hpb=6a405b1efd138a4af4ed93ce4ff173a4c5704512;p=ghc-hetmet.git

diff --git a/rts/Capability.c b/rts/Capability.c
index a81d710..f4fdd70 100644
--- a/rts/Capability.c
+++ b/rts/Capability.c
@@ -18,32 +18,46 @@
 
 #include "PosixSource.h"
 #include "Rts.h"
-#include "RtsUtils.h"
-#include "RtsFlags.h"
-#include "STM.h"
-#include "OSThreads.h"
+
 #include "Capability.h"
 #include "Schedule.h"
 #include "Sparks.h"
 #include "Trace.h"
-#include "GC.h"
+#include "sm/GC.h" // for gcWorkerThread()
+#include "STM.h"
+#include "RtsUtils.h"
 
 // one global capability, this is the Capability for non-threaded
 // builds, and for +RTS -N1
 Capability MainCapability;
 
-nat n_capabilities;
+nat n_capabilities = 0;
 Capability *capabilities = NULL;
 
 // Holds the Capability which last became free.  This is used so that
 // an in-call has a chance of quickly finding a free Capability.
 // Maintaining a global free list of Capabilities would require global
 // locking, so we don't do that.
-Capability *last_free_capability;
+Capability *last_free_capability = NULL;
 
 /* GC indicator, in scope for the scheduler, init'ed to false */
 volatile StgWord waiting_for_gc = 0;
 
+/* Let foreign code get the current Capability -- assuming there is one!
+ * This is useful for unsafe foreign calls because they are called with
+ * the current Capability held, but they are not passed it. For example,
+ * see see the integer-gmp package which calls allocateLocal() in its
+ * stgAllocForGMP() function (which gets called by gmp functions).
+ * */
+Capability * rts_unsafeGetMyCapability (void)
+{
+#if defined(THREADED_RTS)
+  return myTask()->cap;
+#else
+  return &MainCapability;
+#endif
+}
+
 #if defined(THREADED_RTS)
 STATIC_INLINE rtsBool
 globalWorkToDo (void)
@@ -63,33 +77,40 @@ findSpark (Capability *cap)
   rtsBool retry;
   nat i = 0;
 
-  if (!emptyRunQueue(cap)) {
+  if (!emptyRunQueue(cap) || cap->returning_tasks_hd != NULL) {
       // If there are other threads, don't try to run any new
       // sparks: sparks might be speculative, we don't want to take
       // resources away from the main computation.
       return 0;
   }
 
-  // first try to get a spark from our own pool.
-  // We should be using reclaimSpark(), because it works without
-  // needing any atomic instructions:
-  //   spark = reclaimSpark(cap->sparks);
-  // However, measurements show that this makes at least one benchmark
-  // slower (prsa) and doesn't affect the others.
-  spark = tryStealSpark(cap);
-  if (spark != NULL) {
-      cap->sparks_converted++;
-      return spark;
-  }
+  do {
+      retry = rtsFalse;
 
-  if (n_capabilities == 1) { return NULL; } // makes no sense...
+      // first try to get a spark from our own pool.
+      // We should be using reclaimSpark(), because it works without
+      // needing any atomic instructions:
+      //   spark = reclaimSpark(cap->sparks);
+      // However, measurements show that this makes at least one benchmark
+      // slower (prsa) and doesn't affect the others.
+      spark = tryStealSpark(cap);
+      if (spark != NULL) {
+          cap->sparks_converted++;
 
-  debugTrace(DEBUG_sched,
-	     "cap %d: Trying to steal work from other capabilities", 
-	     cap->no);
+          // Post event for running a spark from capability's own pool.
+          traceSchedEvent(cap, EVENT_RUN_SPARK, cap->r.rCurrentTSO, 0);
 
-  do {
-      retry = rtsFalse;
+          return spark;
+      }
+      if (!emptySparkPoolCap(cap)) {
+          retry = rtsTrue;
+      }
+
+      if (n_capabilities == 1) { return NULL; } // makes no sense...
+
+      debugTrace(DEBUG_sched,
+                 "cap %d: Trying to steal work from other capabilities", 
+                 cap->no);
 
       /* visit cap.s 0..n-1 in sequence until a theft succeeds. We could
       start at a random place instead of 0 as well.  */
@@ -109,10 +130,11 @@ findSpark (Capability *cap)
           }
 
           if (spark != NULL) {
-              debugTrace(DEBUG_sched,
-		 "cap %d: Stole a spark from capability %d",
-                         cap->no, robbed->no);
               cap->sparks_converted++;
+
+              traceSchedEvent(cap, EVENT_STEAL_SPARK, 
+                              cap->r.rCurrentTSO, robbed->no);
+              
               return spark;
           }
           // otherwise: no success, try next one
@@ -191,7 +213,6 @@ initCapability( Capability *cap, nat i )
 
     cap->no = i;
     cap->in_haskell        = rtsFalse;
-    cap->in_gc             = rtsFalse;
 
     cap->run_queue_hd      = END_TSO_QUEUE;
     cap->run_queue_tl      = END_TSO_QUEUE;
@@ -211,8 +232,8 @@ initCapability( Capability *cap, nat i )
 #endif
 
     cap->f.stgEagerBlackholeInfo = (W_)&__stg_EAGER_BLACKHOLE_info;
-    cap->f.stgGCEnter1     = (F_)__stg_gc_enter_1;
-    cap->f.stgGCFun        = (F_)__stg_gc_fun;
+    cap->f.stgGCEnter1     = (StgFunPtr)__stg_gc_enter_1;
+    cap->f.stgGCFun        = (StgFunPtr)__stg_gc_fun;
 
     cap->mut_lists  = stgMallocBytes(sizeof(bdescr *) *
 				     RtsFlags.GcFlags.generations,
@@ -231,6 +252,7 @@ initCapability( Capability *cap, nat i )
     cap->free_trec_headers = NO_TREC;
     cap->transaction_tokens = 0;
     cap->context_switch = 0;
+    cap->pinned_object_block = NULL;
 }
 
 /* ---------------------------------------------------------------------------
@@ -294,10 +316,10 @@ initCapabilities( void )
 
 void setContextSwitches(void)
 {
-  nat i;
-  for (i=0; i < n_capabilities; i++) {
-    capabilities[i].context_switch = 1;
-  }
+    nat i;
+    for (i=0; i < n_capabilities; i++) {
+        contextSwitchCapability(&capabilities[i]);
+    }
 }
 
 /* ----------------------------------------------------------------------------
@@ -320,10 +342,9 @@ giveCapabilityToTask (Capability *cap USED_IF_DEBUG, Task *task)
 {
     ASSERT_LOCK_HELD(&cap->lock);
     ASSERT(task->cap == cap);
-    trace(TRACE_sched | DEBUG_sched,
-	  "passing capability %d to %s %p",
-	  cap->no, task->tso ? "bound task" : "worker",
-	  (void *)task->id);
+    debugTrace(DEBUG_sched, "passing capability %d to %s %p",
+               cap->no, task->tso ? "bound task" : "worker",
+               (void *)task->id);
     ACQUIRE_LOCK(&task->lock);
     task->wakeup = rtsTrue;
     // the wakeup flag is needed because signalCondition() doesn't
@@ -365,8 +386,7 @@ releaseCapability_ (Capability* cap,
 
     if (waiting_for_gc == PENDING_GC_SEQ) {
       last_free_capability = cap; // needed?
-      trace(TRACE_sched | DEBUG_sched, 
-	    "GC pending, set capability %d free", cap->no);
+      debugTrace(DEBUG_sched, "GC pending, set capability %d free", cap->no);
       return;
     } 
 
@@ -407,7 +427,7 @@ releaseCapability_ (Capability* cap,
     }
 
     last_free_capability = cap;
-    trace(TRACE_sched | DEBUG_sched, "freeing capability %d", cap->no);
+    debugTrace(DEBUG_sched, "freeing capability %d", cap->no);
 }
 
 void
@@ -479,17 +499,20 @@ waitForReturnCapability (Capability **pCap, Task *task)
     if (cap == NULL) {
 	// Try last_free_capability first
 	cap = last_free_capability;
-	if (!cap->running_task) {
+	if (cap->running_task) {
 	    nat i;
 	    // otherwise, search for a free capability
+            cap = NULL;
 	    for (i = 0; i < n_capabilities; i++) {
-		cap = &capabilities[i];
-		if (!cap->running_task) {
+		if (!capabilities[i].running_task) {
+                    cap = &capabilities[i];
 		    break;
 		}
 	    }
-	    // Can't find a free one, use last_free_capability.
-	    cap = last_free_capability;
+            if (cap == NULL) {
+                // Can't find a free one, use last_free_capability.
+                cap = last_free_capability;
+            }
 	}
 
 	// record the Capability as the one this Task is now assocated with.
@@ -539,7 +562,7 @@ waitForReturnCapability (Capability **pCap, Task *task)
 
     ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
 
-    trace(TRACE_sched | DEBUG_sched, "resuming capability %d", cap->no);
+    debugTrace(DEBUG_sched, "resuming capability %d", cap->no);
 
     *pCap = cap;
 #endif
@@ -556,8 +579,9 @@ yieldCapability (Capability** pCap, Task *task)
     Capability *cap = *pCap;
 
     if (waiting_for_gc == PENDING_GC_PAR) {
-	debugTrace(DEBUG_sched, "capability %d: becoming a GC thread", cap->no);
+        traceSchedEvent(cap, EVENT_GC_START, 0, 0);
         gcWorkerThread(cap);
+        traceSchedEvent(cap, EVENT_GC_END, 0, 0);
         return;
     }
 
@@ -603,7 +627,7 @@ yieldCapability (Capability** pCap, Task *task)
 	    break;
 	}
 
-	trace(TRACE_sched | DEBUG_sched, "resuming capability %d", cap->no);
+	debugTrace(DEBUG_sched, "resuming capability %d", cap->no);
 	ASSERT(cap->running_task == task);
 
     *pCap = cap;
@@ -645,7 +669,6 @@ wakeupThreadOnCapability (Capability *my_cap,
 
 	appendToRunQueue(other_cap,tso);
 
-	trace(TRACE_sched, "resuming capability %d", other_cap->no);
 	releaseCapability_(other_cap,rtsFalse);
     } else {
 	appendToWakeupQueue(my_cap,other_cap,tso);
@@ -765,7 +788,7 @@ shutdownCapability (Capability *cap, Task *task, rtsBool safe)
             continue;
         }
             
-	debugTrace(DEBUG_sched, "capability %d is stopped.", cap->no);
+        traceSchedEvent(cap, EVENT_SHUTDOWN, 0, 0);
 	RELEASE_LOCK(&cap->lock);
 	break;
     }
@@ -807,7 +830,8 @@ static void
 freeCapability (Capability *cap)
 {
     stgFree(cap->mut_lists);
-#if defined(THREADED_RTS) || defined(PARALLEL_HASKELL)
+    stgFree(cap->saved_mut_lists);
+#if defined(THREADED_RTS)
     freeSparkPool(cap->sparks);
 #endif
 }
@@ -854,8 +878,6 @@ markSomeCapabilities (evac_fn evac, void *user, nat i0, nat delta,
 #endif
 	for (task = cap->suspended_ccalling_tasks; task != NULL; 
 	     task=task->next) {
-	    debugTrace(DEBUG_sched,
-		       "evac'ing suspended TSO %lu", (unsigned long)task->suspended_tso->id);
 	    evac(user, (StgClosure **)(void *)&task->suspended_tso);
 	}