Add and export rts_unsafeGetMyCapability from rts

[ghc-hetmet.git] / rts / Capability.c

diff --git a/rts/Capability.c b/rts/Capability.c
index 05e9126..02308d4 100644 (file)
--- a/rts/Capability.c
+++ b/rts/Capability.c
@@ -44,6 +44,21 @@ Capability *last_free_capability;
 /* 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)
@@ -79,6 +94,10 @@ findSpark (Capability *cap)
   spark = tryStealSpark(cap);
   if (spark != NULL) {
       cap->sparks_converted++;
+
+      // Post event for running a spark from capability's own pool.
+      postEvent(cap, EVENT_RUN_SPARK, cap->r.rCurrentTSO->id, 0);
+
       return spark;
   }
 
@@ -113,6 +132,11 @@ findSpark (Capability *cap)
                 "cap %d: Stole a spark from capability %d",
                          cap->no, robbed->no);
               cap->sparks_converted++;
+
+              postEvent(cap, EVENT_STEAL_SPARK, 
+                        cap->r.rCurrentTSO->id, robbed->no);
+                        
+              
               return spark;
           }
           // otherwise: no success, try next one
@@ -810,7 +834,7 @@ static void
 freeCapability (Capability *cap)
 {
     stgFree(cap->mut_lists);
-#if defined(THREADED_RTS) || defined(PARALLEL_HASKELL)
+#if defined(THREADED_RTS)
     freeSparkPool(cap->sparks);
 #endif
 }