Add support for the IO manager thread on Windows

[ghc-hetmet.git] / rts / win32 / ThrIOManager.c

diff --git a/rts/win32/ThrIOManager.c b/rts/win32/ThrIOManager.c
new file mode 100644 (file)
index 0000000..b0da0de
--- /dev/null
+++ b/rts/win32/ThrIOManager.c
@@ -0,0 +1,144 @@
+/* -----------------------------------------------------------------------------\r
+ *\r
+ * (c) The GHC Team, 1998-2006\r
+ *\r
+ * The IO manager thread in THREADED_RTS.  \r
+ * See also libraries/base/GHC/Conc.lhs.\r
+ *\r
+ * ---------------------------------------------------------------------------*/\r
+\r
+#include "Rts.h"\r
+#include "ThrIOManager.h"\r
+#include "Prelude.h"\r
+#include <windows.h>\r
+\r
+// Here's the Event that we use to wake up the IO manager thread\r
+static HANDLE io_manager_event = INVALID_HANDLE_VALUE;\r
+\r
+// must agree with values in GHC.Conc:\r
+#define IO_MANAGER_WAKEUP 0xffffffff\r
+#define IO_MANAGER_DIE    0xfffffffe\r
+// spurios wakeups are returned as zero.\r
+// console events are ((event<<1) | 1)\r
+\r
+HANDLE\r
+getIOManagerEvent (void)\r
+{\r
+    // This function has to exist even in the non-THREADED_RTS,\r
+    // because code in GHC.Conc refers to it.  It won't ever be called\r
+    // unless we're in the threaded RTS, however.\r
+#ifdef THREADED_RTS\r
+    HANDLE hRes;\r
+\r
+    if (io_manager_event == INVALID_HANDLE_VALUE) {\r
+        hRes = CreateEvent ( NULL, // no security attrs\r
+                             TRUE, // manual reset\r
+                             FALSE, // initial state,\r
+                             "IO Manager Event" );\r
+        if (hRes == NULL) {\r
+            sysErrorBelch("getIOManagerEvent");\r
+            stg_exit(EXIT_FAILURE);\r
+        }\r
+        io_manager_event = hRes;\r
+        return hRes;\r
+    } else {\r
+        return io_manager_event;\r
+    }\r
+#else\r
+    return NULL;\r
+#endif\r
+}\r
+\r
+\r
+#if defined(THREADED_RTS)\r
+\r
+#define EVENT_BUFSIZ 256\r
+Mutex event_buf_mutex;\r
+StgWord32 event_buf[EVENT_BUFSIZ];\r
+nat next_event;\r
+\r
+#endif\r
+\r
+StgWord32\r
+readIOManagerEvent (void)\r
+{\r
+    // This function must exist even in non-THREADED_RTS, \r
+    // see getIOManagerEvent() above.\r
+#if defined(THREADED_RTS)\r
+    StgWord32 res;\r
+\r
+    ACQUIRE_LOCK(&event_buf_mutex);\r
+    if (io_manager_event != INVALID_HANDLE_VALUE) {\r
+        if (next_event == 0) {\r
+            res = 0; // no event to return\r
+        } else {\r
+            res = event_buf[--next_event];\r
+            if (next_event == 0) {\r
+                if (!ResetEvent(io_manager_event)) {\r
+                    sysErrorBelch("readIOManagerEvent");\r
+                    stg_exit(EXIT_FAILURE);\r
+                }\r
+            }\r
+        }\r
+    } else {\r
+        res = 0;\r
+    }\r
+    RELEASE_LOCK(&event_buf_mutex);\r
+    // debugBelch("readIOManagerEvent: %d\n", res);\r
+    return res;\r
+#else\r
+    return 0;\r
+#endif\r
+}\r
+\r
+void\r
+sendIOManagerEvent (StgWord32 event)\r
+{\r
+#if defined(THREADED_RTS)\r
+    // debugBelch("sendIOManagerEvent: %d\n", event);\r
+    ACQUIRE_LOCK(&event_buf_mutex);\r
+    if (io_manager_event != INVALID_HANDLE_VALUE) {\r
+        if (next_event == EVENT_BUFSIZ) {\r
+            errorBelch("event buffer overflowed; event dropped");\r
+        } else {\r
+            if (!SetEvent(io_manager_event)) {\r
+                sysErrorBelch("sendIOManagerEvent");\r
+                stg_exit(EXIT_FAILURE);\r
+            }        \r
+            event_buf[next_event++] = event;\r
+        }\r
+    }\r
+    RELEASE_LOCK(&event_buf_mutex);\r
+#endif\r
+}    \r
+\r
+#if defined(THREADED_RTS)\r
+void\r
+ioManagerWakeup (void)\r
+{\r
+    sendIOManagerEvent(IO_MANAGER_WAKEUP);\r
+}\r
+\r
+void\r
+ioManagerDie (void)\r
+{\r
+    sendIOManagerEvent(IO_MANAGER_DIE);\r
+    // ToDo: wait for the IO manager to pick up the event, and\r
+    // then release the Event and Mutex objects we've allocated.\r
+}\r
+\r
+void\r
+ioManagerStart (void)\r
+{\r
+    initMutex(&event_buf_mutex);\r
+    next_event = 0;\r
+\r
+    // Make sure the IO manager thread is running\r
+    Capability *cap;\r
+    if (io_manager_event == INVALID_HANDLE_VALUE) {\r
+       cap = rts_lock();\r
+       rts_evalIO(cap,&base_GHCziConc_ensureIOManagerIsRunning_closure,NULL);\r
+       rts_unlock(cap);\r
+    }\r
+}\r
+#endif\r