Add and export rts_unsafeGetMyCapability from rts

We need this, or something equivalent, to be able to implement
stgAllocForGMP outside of the rts. That's because we want to use
allocateLocal which allocates from the given capability without
having to take any locks. In the gmp primops we're basically in
an unsafe foreign call, that is a context where we hold a current
capability. So it's safe for us to use allocateLocal. We just
need a way to get the current capability. The method to get the
current capability varies depends on whether we're using the
threaded rts or not. When stgAllocForGMP is built inside the rts
that's ok because we can do it conditionally on THREADED_RTS.
Outside the rts we need a single api we can call without knowing
if we're talking to a threaded rts or not, hence this addition.

diff --git a/includes/RtsAPI.h b/includes/RtsAPI.h
index 41f0fc0..5160046 100644 (file)
--- a/includes/RtsAPI.h
+++ b/includes/RtsAPI.h
@@ -66,6 +66,15 @@ Capability *rts_lock (void);
 // releases the token acquired with rts_lock().
 void rts_unlock (Capability *token);
 
+// If you are in a context where you know you have a current capability but
+// do not know what it is, then use this to get it. Basically this only
+// applies to "unsafe" foreign calls (as unsafe foreign calls are made with
+// the capability held).
+//
+// WARNING: There is *no* guarantee this returns anything sensible (eg NULL)
+// when there is no current capability.
+Capability *rts_unsafeGetMyCapability (void);
+
 /* ----------------------------------------------------------------------------
    Building Haskell objects from C datatypes.
    ------------------------------------------------------------------------- */

diff --git a/rts/Capability.c b/rts/Capability.c
index c27733f..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)

diff --git a/rts/Linker.c b/rts/Linker.c
index 283103f..68bd586 100644 (file)
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -752,6 +752,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(rts_mkWord32)                      \
       SymI_HasProto(rts_mkWord64)                      \
       SymI_HasProto(rts_unlock)                                \
+      SymI_HasProto(rts_unsafeGetMyCapability)          \
       SymI_HasProto(rtsSupportsBoundThreads)           \
       SymI_HasProto(__hscore_get_saved_termios)                \
       SymI_HasProto(__hscore_set_saved_termios)                \