rts/winio: Fix #18382

Here we refactor WinIO's IO completion scheme, squashing a memory leak
and fixing #18382.
To fix #18382 we drop the special thread status introduced for IoPort
blocking, BlockedOnIoCompletion, as well as drop the non-threaded RTS's
special dead-lock detection logic (which is redundant to the GC's
deadlock detection logic), as proposed in #20947.

Previously WinIO relied on foreign import ccall "wrapper" to create an
adjustor thunk which can be attached to the OVERLAPPED structure passed
to the operating system. It would then use foreign import ccall
"dynamic" to back out the original continuation from the adjustor. This
roundtrip is significantly more expensive than the alternative, using a
StablePtr. Furthermore, the implementation let the adjustor leak,
meaning that every IO request would leak a page of memory.

Fixes T18382.

20 files changed, 31 insertions, 92 deletions

diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs
index d5fb4868df..99df92daed 100644
--- a/libraries/base/GHC/Conc/Sync.hs
+++ b/libraries/base/GHC/Conc/Sync.hs
@@ -544,8 +544,6 @@ data BlockReason
         -- ^blocked in 'retry' in an STM transaction
   | BlockedOnForeignCall
         -- ^currently in a foreign call
-  | BlockedOnIOCompletion
-        -- ^currently blocked on an I/O Completion port
   | BlockedOnOther
         -- ^blocked on some other resource.  Without @-threaded@,
         -- I\/O and 'Control.Concurrent.threadDelay' show up as
@@ -584,7 +582,6 @@ threadStatus (ThreadId t) = IO $ \s ->
      mk_stat 11 = ThreadBlocked BlockedOnForeignCall
      mk_stat 12 = ThreadBlocked BlockedOnException
      mk_stat 14 = ThreadBlocked BlockedOnMVar -- possibly: BlockedOnMVarRead
-     mk_stat 15 = ThreadBlocked BlockedOnIOCompletion
      -- NB. these are hardcoded in rts/PrimOps.cmm
      mk_stat 16 = ThreadFinished
      mk_stat 17 = ThreadDied
diff --git a/libraries/base/GHC/Conc/Sync.hs-boot b/libraries/base/GHC/Conc/Sync.hs-boot
index 07b4ef05ab..4a8e4192c2 100644
--- a/libraries/base/GHC/Conc/Sync.hs-boot
+++ b/libraries/base/GHC/Conc/Sync.hs-boot
@@ -49,8 +49,6 @@ data BlockReason
               -- ^blocked in 'retry' in an STM transaction
         | BlockedOnForeignCall
               -- ^currently in a foreign call
-        | BlockedOnIOCompletion
-              -- ^currently blocked on an I/O Completion port
         | BlockedOnOther
               -- ^blocked on some other resource.  Without @-threaded@,
               -- I\/O and 'threadDelay' show up as 'BlockedOnOther', with @-threaded@
diff --git a/libraries/base/GHC/Event/Windows.hsc b/libraries/base/GHC/Event/Windows.hsc
index cc6bbaa927..973f25722b 100644
--- a/libraries/base/GHC/Event/Windows.hsc
+++ b/libraries/base/GHC/Event/Windows.hsc
@@ -542,18 +542,19 @@ withOverlappedEx mgr fname h async offset startCB completionCB = do
         signalThrow ex = failIfFalse_ (dbgMsg "signalThrow") $
                             writeIOPort signal (IOFailed ex)
     mask_ $ do
-      let completionCB' e b = completionCB e b >>= \result ->
-                                case result of
-                                  IOSuccess val -> signalReturn val
-                                  IOFailed  err -> signalThrow err
-      let callbackData = CompletionData h completionCB'
+      let completionCB' e b = do
+            result <- completionCB e b
+            case result of
+              IOSuccess val -> signalReturn val
+              IOFailed  err -> signalThrow err
+
       -- Note [Memory Management]
       -- These callback data and especially the overlapped structs have to keep
       -- alive throughout the entire lifetime of the requests.   Since this
       -- function will block until done so it can call completionCB at the end
       -- we can safely use dynamic memory management here and so reduce the
       -- possibility of memory errors.
-      withRequest async offset callbackData $ \hs_lpol cdData -> do
+      withRequest async offset h completionCB' $ \hs_lpol cdData -> do
         let ptr_lpol = hs_lpol `plusPtr` cdOffset
         let lpol = castPtr hs_lpol
         -- We need to add the payload before calling startCBResult, the reason being
@@ -1066,7 +1067,7 @@ processCompletion Manager{..} n delay = do
           when (oldDataPtr /= nullPtr && oldDataPtr /= castPtr nullReq) $
             do debugIO $ "exchanged: " ++ show oldDataPtr
                payload <- peek oldDataPtr :: IO CompletionData
-               let !cb = cdCallback payload
+               cb <- deRefStablePtr (cdCallback payload)
                reqs <- removeRequest
                debugIO $ "-1.. " ++ show reqs ++ " requests queued."
                status <- FFI.overlappedIOStatus (lpOverlapped oe)
diff --git a/libraries/base/GHC/Event/Windows/FFI.hsc b/libraries/base/GHC/Event/Windows/FFI.hsc
index c9c96d9d1e..c087f94eb1 100644
--- a/libraries/base/GHC/Event/Windows/FFI.hsc
+++ b/libraries/base/GHC/Event/Windows/FFI.hsc
@@ -231,14 +231,6 @@ type CompletionCallback a = ErrCode   -- ^ 0 indicates success
 -- | Callback type that will be called when an I/O operation completes.
 type IOCallback = CompletionCallback ()
 
--- | Wrap the IOCallback type into a FunPtr.
-foreign import ccall "wrapper"
-  wrapIOCallback :: IOCallback -> IO (FunPtr IOCallback)
-
--- | Unwrap a FunPtr IOCallback to a normal Haskell function.
-foreign import ccall "dynamic"
-  mkIOCallback :: FunPtr IOCallback -> IOCallback
-
 -- | Structure that the I/O manager uses to associate callbacks with
 -- additional payload such as their OVERLAPPED structure and Win32 handle
 -- etc.  *Must* be kept in sync with that in `winio_structs.h` or horrible things
@@ -247,7 +239,7 @@ foreign import ccall "dynamic"
 -- We keep the handle around for the benefit of ghc-external libraries making
 -- use of the manager.
 data CompletionData = CompletionData { cdHandle   :: !HANDLE
-                                     , cdCallback :: !IOCallback
+                                     , cdCallback :: !(StablePtr IOCallback)
                                      }
 
 instance Storable CompletionData where
@@ -255,14 +247,13 @@ instance Storable CompletionData where
     alignment _ = #{alignment CompletionData}
 
     peek ptr = do
-      cdCallback <- mkIOCallback `fmap` #{peek CompletionData, cdCallback} ptr
+      cdCallback <- #{peek CompletionData, cdCallback} ptr
       cdHandle   <- #{peek CompletionData, cdHandle} ptr
       let !cd = CompletionData{..}
       return cd
 
     poke ptr CompletionData{..} = do
-      cb <- wrapIOCallback cdCallback
-      #{poke CompletionData, cdCallback} ptr cb
+      #{poke CompletionData, cdCallback} ptr cdCallback
       #{poke CompletionData, cdHandle} ptr cdHandle
 
 ------------------------------------------------------------------------
@@ -402,10 +393,10 @@ pokeEventOverlapped lpol event = do
 --    the native OS Handle not the Haskell one. i.e. remote-iserv.
 
 -- See [Note AsyncHandles]
-withRequest :: Bool -> Word64 -> CompletionData
+withRequest :: Bool -> Word64 -> HANDLE -> IOCallback
             -> (Ptr HASKELL_OVERLAPPED -> Ptr CompletionData -> IO a)
             -> IO a
-withRequest async offset cbData f =
+withRequest async offset hdl cb f = do
     -- Create the completion record and store it.
     -- We only need the record when we enqueue a request, however if we
     -- delay creating it then we will run into a race condition where the
@@ -417,7 +408,10 @@ withRequest async offset cbData f =
     --
     -- Todo: Use a memory pool for this so we don't have to hit malloc every
     --       time.  This would allow us to scale better.
-    allocaBytes #{size HASKELL_OVERLAPPED} $ \hs_lpol ->
+    cb_sptr <- newStablePtr cb
+    let cbData :: CompletionData
+        cbData = CompletionData hdl cb_sptr
+    r <- allocaBytes #{size HASKELL_OVERLAPPED} $ \hs_lpol ->
       with cbData $ \cdData -> do
         zeroOverlapped hs_lpol
         let lpol = castPtr hs_lpol
@@ -436,6 +430,9 @@ withRequest async offset cbData f =
             failIfFalse_ "withRequest (free)" $ c_CloseHandle event
             return res
 
+    freeStablePtr cb_sptr
+    return r
+
 
 -- | Create an event object for use when the HANDLE isn't asynchronous
 foreign import WINDOWS_CCONV unsafe "windows.h CreateEventW"
diff --git a/libraries/base/tests/T18382/all.T b/libraries/base/tests/T18382/all.T
index f58231688d..4e65d556ce 100644
--- a/libraries/base/tests/T18382/all.T
+++ b/libraries/base/tests/T18382/all.T
@@ -1,7 +1,6 @@
 test('T18382',
      [unless(opsys('mingw32'), skip),
       extra_run_opts('+RTS --io-manager=native -RTS'),
-      expect_broken(18382),
      ],
      compile_and_run,
      [''])
diff --git a/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs b/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
index e15ae7008b..075e2a5b17 100644
--- a/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
+++ b/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
@@ -387,7 +387,6 @@ data WhyBlocked
   | BlockedOnCCall_Interruptible
   | BlockedOnMsgThrowTo
   | ThreadMigrating
-  | BlockedOnIOCompletion
   | WhyBlockedUnknownValue Word16 -- ^ Please report this as a bug
   deriving (Eq, Show, Generic, Ord)
 
diff --git a/libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc b/libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc
index 69c88db57d..48f99d2fcb 100644
--- a/libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc
+++ b/libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc
@@ -77,7 +77,7 @@ parseWhyBlocked w = case w of
                         (#const BlockedOnCCall_Interruptible) -> BlockedOnCCall_Interruptible
                         (#const BlockedOnMsgThrowTo) -> BlockedOnMsgThrowTo
                         (#const ThreadMigrating) -> ThreadMigrating
-#if __GLASGOW_HASKELL__ >= 811
+#if __GLASGOW_HASKELL__ >= 811 && __GLASGOW_HASKELL__ < 903
                         (#const BlockedOnIOCompletion) -> BlockedOnIOCompletion
 #endif
                         _ -> WhyBlockedUnknownValue w
diff --git a/libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc b/libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc
index 17bf3c8334..e9d106d46a 100644
--- a/libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc
+++ b/libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc
@@ -77,7 +77,7 @@ parseWhyBlocked w = case w of
                         (#const BlockedOnCCall_Interruptible) -> BlockedOnCCall_Interruptible
                         (#const BlockedOnMsgThrowTo) -> BlockedOnMsgThrowTo
                         (#const ThreadMigrating) -> ThreadMigrating
-#if __GLASGOW_HASKELL__ >= 811
+#if __GLASGOW_HASKELL__ >= 811 && __GLASGOW_HASKELL__ < 903
                         (#const BlockedOnIOCompletion) -> BlockedOnIOCompletion
 #endif
                         _ -> WhyBlockedUnknownValue w
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index edbd435702..15f9e949b0 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -2222,7 +2222,7 @@ stg_readIOPortzh ( P_ ioport /* :: IOPort a */ )
         StgMVar_head(ioport) = q;
         StgTSO__link(CurrentTSO)       = q;
         StgTSO_block_info(CurrentTSO)  = ioport;
-        StgTSO_why_blocked(CurrentTSO) = BlockedOnIOCompletion::I16;
+        StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
 
         //Unlocks the closure as well
         jump stg_block_readmvar(ioport);
@@ -2328,8 +2328,8 @@ loop:
     // at this point.
 
     //Either there was no reader queued, or he must have been
-    //blocked on BlockedOnIOCompletion
-    ASSERT(why_blocked == BlockedOnIOCompletion);
+    //blocked on BlockedOnMVar
+    ASSERT(why_blocked == BlockedOnMVar);
 
     unlockClosure(ioport, info);
     return (1);
diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index a0719024b4..39f39a22b4 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -175,7 +175,7 @@ throwToSelf (Capability *cap, StgTSO *tso, StgClosure *exception)
      - or it is masking exceptions (TSO_BLOCKEX)
 
    Currently, if the target is BlockedOnMVar, BlockedOnSTM,
-   BlockedOnIOCompletion or BlockedOnBlackHole then we acquire ownership of the
+   or BlockedOnBlackHole then we acquire ownership of the
    TSO by locking its parent container (e.g. the MVar) and then raise the
    exception.  We might change these cases to be more message-passing-like in
    the future.
@@ -344,7 +344,6 @@ check_target:
 
     case BlockedOnMVar:
     case BlockedOnMVarRead:
-    case BlockedOnIOCompletion:
     {
         /*
           To establish ownership of this TSO, we need to acquire a
@@ -370,8 +369,7 @@ check_target:
         // we have the MVar, let's check whether the thread
         // is still blocked on the same MVar.
         if ((target->why_blocked != BlockedOnMVar
-             && target->why_blocked != BlockedOnMVarRead
-             && target->why_blocked != BlockedOnIOCompletion)
+             && target->why_blocked != BlockedOnMVarRead)
             || (StgMVar *)target->block_info.closure != mvar) {
             unlockClosure((StgClosure *)mvar, info);
             goto retry;
@@ -684,7 +682,6 @@ removeFromQueues(Capability *cap, StgTSO *tso)
 
   case BlockedOnMVar:
   case BlockedOnMVarRead:
-  case BlockedOnIOCompletion:
       removeFromMVarBlockedQueue(tso);
       goto done;
 
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 4fe18fa769..b9b15811c9 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -942,7 +942,6 @@ scheduleDetectDeadlock (Capability **pcap, Task *task)
          */
         if (SEQ_CST_LOAD(&recent_activity) != ACTIVITY_INACTIVE) return;
 #endif
-        if (task->incall->tso && task->incall->tso->why_blocked == BlockedOnIOCompletion) return;
 
         debugTrace(DEBUG_sched, "deadlocked, forcing major GC...");
 
@@ -980,31 +979,6 @@ scheduleDetectDeadlock (Capability **pcap, Task *task)
             return;
         }
 #endif
-
-#if !defined(THREADED_RTS)
-        /* Probably a real deadlock.  Send the current main thread the
-         * Deadlock exception.
-         */
-        if (task->incall->tso) {
-            switch (task->incall->tso->why_blocked) {
-            case BlockedOnSTM:
-            case BlockedOnBlackHole:
-            case BlockedOnMsgThrowTo:
-            case BlockedOnMVar:
-            case BlockedOnMVarRead:
-                throwToSingleThreaded(cap, task->incall->tso,
-                                      (StgClosure *)nonTermination_closure);
-                return;
-            case BlockedOnIOCompletion:
-                /* We're blocked waiting for an external I/O call, let's just
-                   chill for a bit.  */
-                return;
-            default:
-                barf("deadlock: main thread blocked in a strange way");
-            }
-        }
-        return;
-#endif
     }
 }
 
@@ -3218,11 +3192,6 @@ resurrectThreads (StgTSO *threads)
             throwToSingleThreaded(cap, tso,
                                   (StgClosure *)blockedIndefinitelyOnSTM_closure);
             break;
-        case BlockedOnIOCompletion:
-            /* I/O Ports may not be reachable by the GC as they may be getting
-             * notified by the RTS.  As such this call should be treated as if
-             * it is masking the exception.  */
-            continue;
         case NotBlocked:
             /* This might happen if the thread was blocked on a black hole
              * belonging to a thread that we've just woken up (raiseAsync
diff --git a/rts/Threads.c b/rts/Threads.c
index b9f753234f..ab7af2e52c 100644
--- a/rts/Threads.c
+++ b/rts/Threads.c
@@ -286,7 +286,6 @@ tryWakeupThread (Capability *cap, StgTSO *tso)
 
     switch (tso->why_blocked)
     {
-    case BlockedOnIOCompletion:
     case BlockedOnMVar:
     case BlockedOnMVarRead:
     {
@@ -888,8 +887,6 @@ printThreadBlockage(StgTSO *tso)
   case BlockedOnMVarRead:
     debugBelch("is blocked on atomic MVar read @ %p", tso->block_info.closure);
     break;
-  case BlockedOnIOCompletion:
-    debugBelch("is blocked on I/O Completion port @ %p", tso->block_info.closure);
     break;
   case BlockedOnBlackHole:
       debugBelch("is blocked on a black hole %p",
diff --git a/rts/Trace.c b/rts/Trace.c
index 9edac3565e..f68a72cf2a 100644
--- a/rts/Trace.c
+++ b/rts/Trace.c
@@ -183,7 +183,6 @@ static char *thread_stop_reasons[] = {
     [6 + BlockedOnSTM]          = "blocked on STM",
     [6 + BlockedOnDoProc]       = "blocked on asyncDoProc",
     [6 + BlockedOnCCall]        = "blocked on a foreign call",
-    [6 + BlockedOnIOCompletion] = "blocked on I/O Completion port",
     [6 + BlockedOnCCall_Interruptible] = "blocked on a foreign call (interruptible)",
     [6 + BlockedOnMsgThrowTo]   =  "blocked on throwTo",
     [6 + ThreadMigrating]       =  "migrating"
diff --git a/rts/TraverseHeap.c b/rts/TraverseHeap.c
index 2285a93b6f..3b92bb9f98 100644
--- a/rts/TraverseHeap.c
+++ b/rts/TraverseHeap.c
@@ -1239,7 +1239,6 @@ inner_loop:
         traversePushClosure(ts, (StgClosure *) tso->trec, c, sep, child_data);
         if (   tso->why_blocked == BlockedOnMVar
                || tso->why_blocked == BlockedOnMVarRead
-               || tso->why_blocked == BlockedOnIOCompletion
                || tso->why_blocked == BlockedOnBlackHole
                || tso->why_blocked == BlockedOnMsgThrowTo
             ) {
diff --git a/rts/include/rts/Constants.h b/rts/include/rts/Constants.h
index 9cbe47752e..b601999f88 100644
--- a/rts/include/rts/Constants.h
+++ b/rts/include/rts/Constants.h
@@ -256,13 +256,7 @@
    by tryWakeupThread() */
 #define ThreadMigrating     13
 
-/* Lightweight non-deadlock checked version of MVar.  Used for the why_blocked
-   field of a TSO. Threads blocked for this reason are not forcibly release by
-   the GC, as we expect them to be unblocked in the future based on outstanding
-   IO events.  */
-#define BlockedOnIOCompletion  15
-
-/* Next number is 16.  */
+/* Next number is 15.  */
 
 /*
  * These constants are returned to the scheduler by a thread that has
diff --git a/rts/include/rts/storage/TSO.h b/rts/include/rts/storage/TSO.h
index fcbf7f7ab1..a6bd9e9087 100644
--- a/rts/include/rts/storage/TSO.h
+++ b/rts/include/rts/storage/TSO.h
@@ -304,7 +304,6 @@ void dirty_STACK (Capability *cap, StgStack *stack);
         BlockedOnBlackHole     MessageBlackHole *   TSO->bq
 
         BlockedOnMVar          the MVAR             the MVAR's queue
-        BlockedOnIOCompletion  the PortEVent        the IOCP's queue
 
         BlockedOnSTM           END_TSO_QUEUE        STM wait queue(s)
         BlockedOnSTM           STM_AWOKEN           run queue
diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c
index 43867343fc..3e71c30d35 100644
--- a/rts/sm/Compact.c
+++ b/rts/sm/Compact.c
@@ -461,7 +461,6 @@ thread_TSO (StgTSO *tso)
         || tso->why_blocked == BlockedOnMVarRead
         || tso->why_blocked == BlockedOnBlackHole
         || tso->why_blocked == BlockedOnMsgThrowTo
-        || tso->why_blocked == BlockedOnIOCompletion
         || tso->why_blocked == NotBlocked
         ) {
         thread_(&tso->block_info.closure);
diff --git a/rts/sm/Sanity.c b/rts/sm/Sanity.c
index 63ef9732dd..cf4e2dfea6 100644
--- a/rts/sm/Sanity.c
+++ b/rts/sm/Sanity.c
@@ -729,7 +729,6 @@ checkTSO(StgTSO *tso)
         || tso->why_blocked == BlockedOnMVarRead
         || tso->why_blocked == BlockedOnBlackHole
         || tso->why_blocked == BlockedOnMsgThrowTo
-        || tso->why_blocked == BlockedOnIOCompletion
         || tso->why_blocked == NotBlocked
         ) {
         ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure));
diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index 9316f395a8..a36ebbb331 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -131,7 +131,6 @@ scavengeTSO (StgTSO *tso)
         || tso->why_blocked == BlockedOnMVarRead
         || tso->why_blocked == BlockedOnBlackHole
         || tso->why_blocked == BlockedOnMsgThrowTo
-        || tso->why_blocked == BlockedOnIOCompletion
         || tso->why_blocked == NotBlocked
         ) {
         evacuate(&tso->block_info.closure);
diff --git a/rts/win32/AsyncWinIO.c b/rts/win32/AsyncWinIO.c
index 5f61f815f3..fa397c343d 100644
--- a/rts/win32/AsyncWinIO.c
+++ b/rts/win32/AsyncWinIO.c
@@ -24,6 +24,7 @@
 #include <stdio.h>
 
 /* Note [Non-Threaded WINIO design]
+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Compared to Async MIO, Async WINIO does all of the heavy processing at the
    Haskell side of things.  The same code as the threaded WINIO is re-used for
    the Non-threaded version.  Of course since we are in a non-threaded rts we
@@ -122,10 +123,8 @@
    See also Note [WINIO Manager design].
 
 
+  Note [Notifying the RTS/Haskell of completed events]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-    Note [Notifying the RTS/Haskell of completed events]
-  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
   The C side runner can't directly create a haskell thread.
   With the current API of the haskell runtime this would be terrible
   unsound. In particular the GC assumes no heap objects are generated,
@@ -137,10 +136,8 @@
   ensures there is only one OS thread at a time making use of the haskell
   heap.
 
+  Note [Non-Threaded IO Manager startup sequence]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-    Note [Non-Threaded IO Manager startup sequence]
-  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
   Under the new IO Manager we run a bit of initialization under
   hs_init(). The first call into actual IO manager code is a
   invocation of startupAsyncWinIO();