X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FCapability.c;h=ddb47b4ac813be223b852ecdc9e8c69939c8e93c;hb=2b16fa4791b08b02df8461f3b79d0e44d72d0960;hp=948922a3b2859ca1832c8372f64f66df5d88fd02;hpb=99df892cc9620fcc92747b79bba75dad8a1d295c;p=ghc-hetmet.git

diff --git a/rts/Capability.c b/rts/Capability.c
index 948922a..ddb47b4 100644
--- a/rts/Capability.c
+++ b/rts/Capability.c
@@ -54,7 +54,7 @@ globalWorkToDo (void)
 #endif
 
 #if defined(THREADED_RTS)
-rtsBool
+StgClosure *
 stealWork (Capability *cap)
 {
   /* use the normal Sparks.h interface (internally modified to enable
@@ -63,7 +63,6 @@ stealWork (Capability *cap)
   */
   Capability *robbed;
   StgClosurePtr spark;
-  rtsBool success = rtsFalse;
   rtsBool retry;
   nat i = 0;
 
@@ -71,7 +70,7 @@ stealWork (Capability *cap)
 	     "cap %d: Trying to steal work from other capabilities", 
 	     cap->no);
 
-  if (n_capabilities == 1) { return rtsFalse; } // makes no sense...
+  if (n_capabilities == 1) { return NULL; } // makes no sense...
 
   do {
       retry = rtsFalse;
@@ -86,7 +85,7 @@ stealWork (Capability *cap)
           if (emptySparkPoolCap(robbed)) // nothing to steal here
               continue;
 
-          spark = tryStealSpark(robbed->sparks);
+          spark = tryStealSpark(robbed);
           if (spark == NULL && !emptySparkPoolCap(robbed)) {
               // we conflicted with another thread while trying to steal;
               // try again later.
@@ -97,16 +96,31 @@ stealWork (Capability *cap)
               debugTrace(DEBUG_sched,
 		 "cap %d: Stole a spark from capability %d",
                          cap->no, robbed->no);
-
-              createSparkThread(cap,spark);
-              return rtsTrue;
+              return spark;
           }
           // otherwise: no success, try next one
       }
   } while (retry);
 
   debugTrace(DEBUG_sched, "No sparks stolen");
-  return rtsFalse;
+  return NULL;
+}
+
+// Returns True if any spark pool is non-empty at this moment in time
+// The result is only valid for an instant, of course, so in a sense
+// is immediately invalid, and should not be relied upon for
+// correctness.
+rtsBool
+anySparks (void)
+{
+    nat i;
+
+    for (i=0; i < n_capabilities; i++) {
+        if (!emptySparkPoolCap(&capabilities[i])) {
+            return rtsTrue;
+        }
+    }
+    return rtsFalse;
 }
 #endif
 
@@ -768,7 +782,6 @@ shutdownCapability (Capability *cap, Task *task, rtsBool safe)
         }
             
 	debugTrace(DEBUG_sched, "capability %d is stopped.", cap->no);
-        freeCapability(cap);
 	RELEASE_LOCK(&cap->lock);
 	break;
     }
@@ -806,14 +819,28 @@ tryGrabCapability (Capability *cap, Task *task)
 
 #endif /* THREADED_RTS */
 
-void
-freeCapability (Capability *cap) {
+static void
+freeCapability (Capability *cap)
+{
     stgFree(cap->mut_lists);
 #if defined(THREADED_RTS) || defined(PARALLEL_HASKELL)
     freeSparkPool(cap->sparks);
 #endif
 }
 
+void
+freeCapabilities (void)
+{
+#if defined(THREADED_RTS)
+    nat i;
+    for (i=0; i < n_capabilities; i++) {
+        freeCapability(&capabilities[i]);
+    }
+#else
+    freeCapability(&MainCapability);
+#endif
+}
+
 /* ---------------------------------------------------------------------------
    Mark everything directly reachable from the Capabilities.  When
    using multiple GC threads, each GC thread marks all Capabilities
@@ -821,7 +848,8 @@ freeCapability (Capability *cap) {
    ------------------------------------------------------------------------ */
 
 void
-markSomeCapabilities (evac_fn evac, void *user, nat i0, nat delta)
+markSomeCapabilities (evac_fn evac, void *user, nat i0, nat delta, 
+                      rtsBool prune_sparks USED_IF_THREADS)
 {
     nat i;
     Capability *cap;
@@ -848,7 +876,11 @@ markSomeCapabilities (evac_fn evac, void *user, nat i0, nat delta)
 	}
 
 #if defined(THREADED_RTS)
-        traverseSparkQueue (evac, user, cap);
+        if (prune_sparks) {
+            pruneSparkQueue (evac, user, cap);
+        } else {
+            traverseSparkQueue (evac, user, cap);
+        }
 #endif
     }
 
@@ -859,22 +891,8 @@ markSomeCapabilities (evac_fn evac, void *user, nat i0, nat delta)
 #endif 
 }
 
-// This function is used by the compacting GC to thread all the
-// pointers from spark queues.
-void
-traverseSparkQueues (evac_fn evac USED_IF_THREADS, void *user USED_IF_THREADS)
-{
-#if defined(THREADED_RTS)
-    nat i;
-    for (i = 0; i < n_capabilities; i++) {
-        traverseSparkQueue (evac, user, &capabilities[i]);
-    }
-#endif // THREADED_RTS
-
-}
-
 void
 markCapabilities (evac_fn evac, void *user)
 {
-    markSomeCapabilities(evac, user, 0, 1);
+    markSomeCapabilities(evac, user, 0, 1, rtsFalse);
 }