winio: Add new io-manager cmdline options

5 files changed, 119 insertions, 2 deletions

diff --git a/configure.ac b/configure.ac
index 6e710c7f8d..d3ef6eee62 100644
--- a/configure.ac
+++ b/configure.ac
@@ -117,6 +117,18 @@ if test "$EnableDistroToolchain" = "YES"; then
   TarballsAutodownload=NO
 fi
 
+AC_ARG_ENABLE(native-io-manager,
+[AC_HELP_STRING([--enable-native-io-manager],
+                [Enable the native I/O manager by default.])],
+        EnableNativeIOManager=YES,
+        EnableNativeIOManager=NO
+)
+
+if test "$EnableNativeIOManager" = "YES"; then
+  AC_DEFINE_UNQUOTED([DEFAULT_NATIVE_IO_MANAGER], [1], [Enable Native I/O manager as default.])
+
+fi
+
 dnl CC_STAGE0, LD_STAGE0, AR_STAGE0 are like the "previous" variable
 dnl CC, LD, AR (inherited by CC_STAGE[123], etc.)
 dnl but instead used by stage0 for bootstrapping stage1
diff --git a/includes/rts/Flags.h b/includes/rts/Flags.h
index d0c41a1576..bf84c5dc96 100644
--- a/includes/rts/Flags.h
+++ b/includes/rts/Flags.h
@@ -206,6 +206,9 @@ typedef struct _CONCURRENT_FLAGS {
 #define DEFAULT_LINKER_ALWAYS_PIC false
 #endif
 
+/* Which I/O Manager to use in the target program.  */
+typedef enum _IO_MANAGER { IO_MNGR_NATIVE, IO_MNGR_POSIX } IO_MANAGER;
+
 /* See Note [Synchronization of flags and base APIs] */
 typedef struct _MISC_FLAGS {
     Time    tickInterval;        /* units: TIME_RESOLUTION */
@@ -224,6 +227,8 @@ typedef struct _MISC_FLAGS {
     bool linkerAlwaysPic;        /* Assume the object code is always PIC */
     StgWord linkerMemBase;       /* address to ask the OS for memory
                                   * for the linker, NULL ==> off */
+    IO_MANAGER ioManager;        /* The I/O manager to use.  */
+    uint32_t numIoWorkerThreads; /* Number of I/O worker threads to use.  */
 } MISC_FLAGS;
 
 /* See Note [Synchronization of flags and base APIs] */
diff --git a/libraries/base/GHC/RTS/Flags.hsc b/libraries/base/GHC/RTS/Flags.hsc
index fc863fb3fc..45e2cbe27e 100644
--- a/libraries/base/GHC/RTS/Flags.hsc
+++ b/libraries/base/GHC/RTS/Flags.hsc
@@ -25,6 +25,7 @@ module GHC.RTS.Flags
   , TraceFlags (..)
   , TickyFlags (..)
   , ParFlags (..)
+  , IoSubSystem (..)
   , getRTSFlags
   , getGCFlags
   , getConcFlags
@@ -40,8 +41,7 @@ module GHC.RTS.Flags
 #include "Rts.h"
 #include "rts/Flags.h"
 
-import Control.Applicative
-import Control.Monad
+import Data.Functor ((<$>))
 
 import Foreign
 import Foreign.C
@@ -87,6 +87,32 @@ instance Enum GiveGCStats where
     toEnum #{const VERBOSE_GC_STATS} = VerboseGCStats
     toEnum e = errorWithoutStackTrace ("invalid enum for GiveGCStats: " ++ show e)
 
+-- | The I/O SubSystem to use in the program.
+--
+-- @since 4.9.0.0
+data IoSubSystem
+  = IoPOSIX   -- ^ Use a POSIX I/O Sub-System
+  | IoNative  -- ^ Use platform native Sub-System. For unix OSes this is the
+              --   same as IoPOSIX, but on Windows this means use the Windows
+              --   native APIs for I/O, including IOCP and RIO.
+  deriving (Eq, Show)
+
+-- | @since 4.9.0.0
+instance Enum IoSubSystem where
+    fromEnum IoPOSIX  = #{const IO_MNGR_POSIX}
+    fromEnum IoNative = #{const IO_MNGR_NATIVE}
+
+    toEnum #{const IO_MNGR_POSIX}  = IoPOSIX
+    toEnum #{const IO_MNGR_NATIVE} = IoNative
+    toEnum e = errorWithoutStackTrace ("invalid enum for IoSubSystem: " ++ show e)
+
+-- | @since 4.9.0.0
+instance Storable IoSubSystem where
+    sizeOf = sizeOf . fromEnum
+    alignment = sizeOf . fromEnum
+    peek ptr = fmap toEnum $ peek (castPtr ptr)
+    poke ptr v = poke (castPtr ptr) (fromEnum v)
+
 -- | Parameters of the garbage collector.
 --
 -- @since 4.8.0.0
@@ -148,6 +174,8 @@ data MiscFlags = MiscFlags
     , linkerAlwaysPic       :: Bool
     , linkerMemBase         :: Word
       -- ^ address to ask the OS for memory for the linker, 0 ==> off
+    , ioManager             :: IoSubSystem
+    , numIoWorkerThreads    :: Word32
     } deriving ( Show -- ^ @since 4.8.0.0
                , Generic -- ^ @since 4.15.0.0
                )
@@ -470,6 +498,10 @@ getMiscFlags = do
             <*> (toBool <$>
                   (#{peek MISC_FLAGS, linkerAlwaysPic} ptr :: IO CBool))
             <*> #{peek MISC_FLAGS, linkerMemBase} ptr
+            <*> (toEnum . fromIntegral
+                 <$> (#{peek MISC_FLAGS, ioManager} ptr :: IO Word32))
+            <*> (fromIntegral
+                 <$> (#{peek MISC_FLAGS, numIoWorkerThreads} ptr :: IO Word32))
 
 getDebugFlags :: IO DebugFlags
 getDebugFlags = do
diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index 6180f42e39..3963e6d0d5 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -35,6 +35,7 @@
 #endif
 
 #include <fs_rts.h>
+#include <stdbool.h>
 
 // Flag Structure
 RTS_FLAGS RtsFlags;
@@ -254,6 +255,16 @@ void initRtsFlagsDefaults(void)
     RtsFlags.MiscFlags.internalCounters        = false;
     RtsFlags.MiscFlags.linkerAlwaysPic         = DEFAULT_LINKER_ALWAYS_PIC;
     RtsFlags.MiscFlags.linkerMemBase           = 0;
+#if defined(DEFAULT_NATIVE_IO_MANAGER)
+    RtsFlags.MiscFlags.ioManager               = IO_MNGR_NATIVE;
+#else
+    RtsFlags.MiscFlags.ioManager               = IO_MNGR_POSIX;
+#endif
+#if defined(THREADED_RTS) && defined(mingw32_HOST_OS)
+    RtsFlags.MiscFlags.numIoWorkerThreads      = getNumberOfProcessors();
+#else
+    RtsFlags.MiscFlags.numIoWorkerThreads      = 1;
+#endif
 
 #if defined(THREADED_RTS)
     RtsFlags.ParFlags.nCapabilities     = 1;
@@ -474,7 +485,14 @@ usage_text[] = {
 "            fatal error. When symbols are available an attempt will be",
 "            made to resolve addresses to names. (default: yes)",
 #endif
+"  --io-manager=<native|posix>",
+"            The I/O manager subsystem to use. (default: posix)",
 #if defined(THREADED_RTS)
+#if defined(mingw32_HOST_OS)
+"  --io-manager-threads=<num>",
+"            The number of worker threads to use in the native I/O manager to",
+"            handle completion events. (defualt: num cores)",
+#endif
 "  -e<n>     Maximum number of outstanding local sparks (default: 4096)",
 #endif
 #if defined(x86_64_HOST_ARCH)
@@ -933,6 +951,16 @@ error = true;
                       OPTION_SAFE;
                       RtsFlags.MiscFlags.internalCounters = true;
                   }
+                  else if (strequal("io-manager=native",
+                               &rts_argv[arg][2])) {
+                      OPTION_UNSAFE;
+                      RtsFlags.MiscFlags.ioManager = IO_MNGR_NATIVE;
+                  }
+                  else if (strequal("io-manager=posix",
+                               &rts_argv[arg][2])) {
+                      OPTION_UNSAFE;
+                      RtsFlags.MiscFlags.ioManager = IO_MNGR_POSIX;
+                  }
                   else if (strequal("info",
                                &rts_argv[arg][2])) {
                       OPTION_SAFE;
@@ -945,6 +973,31 @@ error = true;
                       RtsFlags.GcFlags.useNonmoving = true;
                   }
 #if defined(THREADED_RTS)
+#if defined(mingw32_HOST_OS)
+                  else if (!strncmp("io-manager-threads",
+                                &rts_argv[arg][2], 18)) {
+                      OPTION_SAFE;
+                      uint32_t num;
+                      if (rts_argv[arg][20] == '=') {
+                          num = (StgWord)strtol(rts_argv[arg]+21,
+                                                 (char **) NULL, 10);
+                      } else {
+                          errorBelch("%s: Expected number of threads to use.",
+                                     rts_argv[arg]);
+                          error = true;
+                          break;
+                      }
+
+                      if (num < 1) {
+                          errorBelch("%s: Expected number of threads to be at least 1.",
+                                     rts_argv[arg]);
+                          error = true;
+                          break;
+                      }
+
+                      RtsFlags.MiscFlags.numIoWorkerThreads = num;
+                  }
+#endif
                   else if (!strncmp("numa", &rts_argv[arg][2], 4)) {
                       if (!osBuiltWithNumaSupport()) {
                           errorBelch("%s: This GHC build was compiled without NUMA support.",
@@ -2460,3 +2513,16 @@ built in the -debug, -eventlog, -prof ways. And even if they do, the
 damage should be limited to DOS, information disclosure and writing
 files like <progname>.eventlog, not arbitrary files.
 */
+
+/* ----------------------------------------------------------------------------
+   Helper utilities to query state.
+   ------------------------------------------------------------------------- */
+
+bool is_io_mng_native_p (void)
+{
+#if defined(mingw32_HOST_OS)
+  return RtsFlags.MiscFlags.ioManager == IO_MNGR_NATIVE;
+#else
+  return false;
+#endif
+}
diff --git a/rts/RtsFlags.h b/rts/RtsFlags.h
index c36c64a63b..bfcc43af42 100644
--- a/rts/RtsFlags.h
+++ b/rts/RtsFlags.h
@@ -10,6 +10,7 @@
 #pragma once
 
 #include "BeginPrivate.h"
+#include <stdbool.h>
 
 /* Routines that operate-on/to-do-with RTS flags: */
 
@@ -21,6 +22,7 @@ char** getUTF8Args(int* argc);
 void initRtsFlagsDefaults (void);
 void setupRtsFlags        (int *argc, char *argv[], RtsConfig rtsConfig);
 void freeRtsArgs          (void);
+bool is_io_mng_native_p   (void);
 
 extern RtsConfig rtsConfig;