Second attempt to fix #1185 (forkProcess and -threaded)

Patch 1/2: second part of the patch is to libraries/base

This time without dynamic linker hacks, instead I've expanded the
existing rts/Globals.c to cache more CAFs, specifically those in
GHC.Conc.  We were already using this trick for signal handlers, I
should have realised before.

It's still quite unsavoury, but we can do away with rts/Globals.c in
the future when we switch to a dynamically-linked GHCi.

5 files changed, 91 insertions, 38 deletions

diff --git a/includes/rts/Globals.h b/includes/rts/Globals.h
index 85d0acd4bd..75c7f69fe4 100644
--- a/includes/rts/Globals.h
+++ b/includes/rts/Globals.h
@@ -18,6 +18,10 @@
 #define RTS_GLOBALS_H
 
 StgStablePtr getOrSetTypeableStore(StgStablePtr value);
-StgStablePtr getOrSetSignalHandlerStore(StgStablePtr value);
+StgStablePtr getOrSetGHCConcSignalHandlerStore(StgStablePtr value);
+StgStablePtr getOrSetGHCConcPendingEventsStore(StgStablePtr ptr);
+StgStablePtr getOrSetGHCConcPendingDelaysStore(StgStablePtr ptr);
+StgStablePtr getOrSetGHCConcIOManagerThreadStore(StgStablePtr ptr);
+StgStablePtr getOrSetGHCConcProddingStore(StgStablePtr ptr);
 
 #endif /* RTS_GLOBALS_H */
diff --git a/includes/rts/IOManager.h b/includes/rts/IOManager.h
index ef89f27a30..3aedda8b55 100644
--- a/includes/rts/IOManager.h
+++ b/includes/rts/IOManager.h
@@ -27,6 +27,7 @@ void     sendIOManagerEvent (HsWord32 event);
 #else
 
 void     setIOManagerPipe   (int fd);
+void     ioManagerSync (void);
 
 #endif
 
@@ -35,8 +36,8 @@ void     setIOManagerPipe   (int fd);
 // Posix implementation in posix/Signals.c
 // Win32 implementation in win32/ThrIOManager.c
 //
-#if defined(THREADED_RTS)
 void ioManagerWakeup (void);
+#if defined(THREADED_RTS)
 void ioManagerDie (void);
 void ioManagerStart (void);
 #endif
diff --git a/rts/Globals.c b/rts/Globals.c
index 15b10130a8..00d911ac56 100644
--- a/rts/Globals.c
+++ b/rts/Globals.c
@@ -7,6 +7,9 @@
  * even when multiple versions of the library are loaded.  e.g. see
  * Data.Typeable and GHC.Conc.
  *
+ * If/when we switch to a dynamically-linked GHCi, this can all go
+ * away, because there would be just one copy of each library.
+ *
  * ---------------------------------------------------------------------------*/
 
 #include "PosixSource.h"
@@ -15,18 +18,29 @@
 #include "Globals.h"
 #include "Stable.h"
 
-static StgStablePtr typeableStore      = 0;
-static StgStablePtr signalHandlerStore = 0;
+typedef enum {
+    TypeableStore,
+    GHCConcSignalHandlerStore,
+    GHCConcPendingEventsStore,
+    GHCConcPendingDelaysStore,
+    GHCConcIOManagerThreadStore,
+    GHCConcProddingStore,
+    MaxStoreKey
+} StoreKey;
 
 #ifdef THREADED_RTS
 Mutex globalStoreLock;
 #endif
 
+StgStablePtr store[MaxStoreKey];
+
 void
 initGlobalStore(void)
 {
-    typeableStore      = 0;
-    signalHandlerStore = 0;
+    nat i;
+    for (i=0; i < MaxStoreKey; i++) {
+        store[i] = 0;
+    }
 #ifdef THREADED_RTS
     initMutex(&globalStoreLock);
 #endif
@@ -35,53 +49,69 @@ initGlobalStore(void)
 void
 exitGlobalStore(void)
 {
+    nat i;
 #ifdef THREADED_RTS
     closeMutex(&globalStoreLock);
 #endif
-    if(typeableStore!=0) {
-        freeStablePtr((StgStablePtr)typeableStore);
-        typeableStore=0;
-    }
-    if(signalHandlerStore!=0) {
-        freeStablePtr((StgStablePtr)signalHandlerStore);
-        signalHandlerStore=0;
+    for (i=0; i < MaxStoreKey; i++) {
+        if (store[i] != 0) {
+            freeStablePtr(store[i]);
+            store[i] = 0;
+        }
     }
 }
 
-StgStablePtr
-getOrSetTypeableStore(StgStablePtr ptr)
+static StgStablePtr getOrSetKey(StoreKey key, StgStablePtr ptr)
 {
-    StgStablePtr ret = typeableStore;
+    StgStablePtr ret = store[key];
     if(ret==0) {
 #ifdef THREADED_RTS
         ACQUIRE_LOCK(&globalStoreLock);
-        ret=typeableStore;
+        ret = store[key];
         if(ret==0) {
 #endif
-            typeableStore = ret = ptr;
+            store[key] = ret = ptr;
 #ifdef THREADED_RTS
         }
         RELEASE_LOCK(&globalStoreLock);
 #endif
     }
     return ret;
+}    
+
+
+StgStablePtr
+getOrSetTypeableStore(StgStablePtr ptr)
+{
+    return getOrSetKey(TypeableStore,ptr);
 }
 
 StgStablePtr
-getOrSetSignalHandlerStore(StgStablePtr ptr)
+getOrSetGHCConcSignalHandlerStore(StgStablePtr ptr)
 {
-    StgStablePtr ret = signalHandlerStore;
-    if(ret==0) {
-#ifdef THREADED_RTS
-        ACQUIRE_LOCK(&globalStoreLock);
-        ret=signalHandlerStore;
-        if(ret==0) {
-#endif
-            signalHandlerStore = ret = ptr;
-#ifdef THREADED_RTS
-        }
-        RELEASE_LOCK(&globalStoreLock);
-#endif
-    }
-    return ret;
+    return getOrSetKey(GHCConcSignalHandlerStore,ptr);
+}
+
+StgStablePtr
+getOrSetGHCConcPendingEventsStore(StgStablePtr ptr)
+{
+    return getOrSetKey(GHCConcPendingEventsStore,ptr);
+}
+
+StgStablePtr
+getOrSetGHCConcPendingDelaysStore(StgStablePtr ptr)
+{
+    return getOrSetKey(GHCConcPendingDelaysStore,ptr);
+}
+
+StgStablePtr
+getOrSetGHCConcIOManagerThreadStore(StgStablePtr ptr)
+{
+    return getOrSetKey(GHCConcIOManagerThreadStore,ptr);
+}
+
+StgStablePtr
+getOrSetGHCConcProddingStore(StgStablePtr ptr)
+{
+    return getOrSetKey(GHCConcProddingStore,ptr);
 }
diff --git a/rts/Linker.c b/rts/Linker.c
index e3278b5ef4..4ce525f80e 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -505,10 +505,13 @@ typedef struct _RtsSymbolVal {
 #if !defined(mingw32_HOST_OS)
 #define RTS_USER_SIGNALS_SYMBOLS \
    SymI_HasProto(setIOManagerPipe) \
+   SymI_HasProto(ioManagerWakeup) \
+   SymI_HasProto(ioManagerSync) \
    SymI_HasProto(blockUserSignals) \
    SymI_HasProto(unblockUserSignals)
 #else
 #define RTS_USER_SIGNALS_SYMBOLS     \
+   SymI_HasProto(ioManagerWakeup) \
    SymI_HasProto(sendIOManagerEvent) \
    SymI_HasProto(readIOManagerEvent) \
    SymI_HasProto(getIOManagerEvent)  \
@@ -736,7 +739,11 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(forkOS_createThread)		\
       SymI_HasProto(freeHaskellFunctionPtr)		\
       SymI_HasProto(getOrSetTypeableStore)		\
-      SymI_HasProto(getOrSetSignalHandlerStore)		\
+      SymI_HasProto(getOrSetGHCConcSignalHandlerStore)		\
+      SymI_HasProto(getOrSetGHCConcPendingEventsStore)		\
+      SymI_HasProto(getOrSetGHCConcPendingDelaysStore)		\
+      SymI_HasProto(getOrSetGHCConcIOManagerThreadStore)	\
+      SymI_HasProto(getOrSetGHCConcProddingStore)		\
       SymI_HasProto(genSymZh)				\
       SymI_HasProto(genericRaise)			\
       SymI_HasProto(getProgArgv)			\
diff --git a/rts/posix/Signals.c b/rts/posix/Signals.c
index 660065734b..3b93fccbb7 100644
--- a/rts/posix/Signals.c
+++ b/rts/posix/Signals.c
@@ -86,18 +86,16 @@ static int io_manager_pipe = -1;
 
 #define IO_MANAGER_WAKEUP 0xff
 #define IO_MANAGER_DIE    0xfe
+#define IO_MANAGER_SYNC   0xfd
 
 void
 setIOManagerPipe (int fd)
 {
     // only called when THREADED_RTS, but unconditionally
     // compiled here because GHC.Conc depends on it.
-    if (io_manager_pipe < 0) {
-        io_manager_pipe = fd;
-    }
+    io_manager_pipe = fd;
 }
 
-#if defined(THREADED_RTS)
 void
 ioManagerWakeup (void)
 {
@@ -111,6 +109,19 @@ ioManagerWakeup (void)
 }
 
 void
+ioManagerSync (void)
+{
+    int r;
+    // Wake up the IO Manager thread by sending a byte down its pipe
+    if (io_manager_pipe >= 0) {
+	StgWord8 byte = (StgWord8)IO_MANAGER_SYNC;
+	r = write(io_manager_pipe, &byte, 1);
+        if (r == -1) { sysErrorBelch("ioManagerSync: write"); }
+    }
+}
+
+#if defined(THREADED_RTS)
+void
 ioManagerDie (void)
 {
     int r;