GitLab

Duncan Coutts pushed to branch wip/dcoutts/io-manager-feature-bitset at Glasgow Haskell Compiler / GHC

Commits:

2abd3dd2

by Duncan Coutts at 2026-09-22T09:36:27+01:00

Change G.I.Conc.IO operations to condition on iomgrInLib rather than threaded

The GHC.Internal.Conc.IO defines a bunch of operations like threadDelay,
threadWaitRead etc and provides conditional definitions for them in
terms of the appropriate I/O manager for the platform. Some of these are
static conditions (using CPP) such as Windows or JS platforms.

Others are dynamic conditions, depending on whether the RTS is threaded
or not. Though the threaded/non-threaded condition was really a proxy
for whether the I/O manager is implemented in the library (accessed by
direct calls) or within the RTS (accessed via primops).

We can now change this threaded/non-threaded condition to use the new
I/O manager feature bitmap. We add a 'iomgrInLib' as the inverse of
'iomgrInRTS' to make the logic clearer.

Currently this will have no effect. If/when new in-RTS I/O managers are
available in the threaded RTS, then the operations using this condition
will Do The Right Thing™.

Note that on Windows we use this to simplify the logic: it previously
had to test for isWindowsNativeIO or threaded, because the WinIO I/O
manager is available in the non-threaded RTS too. The WinIO I/O manager
counts as an in-lib one, irrespective of threaded/non-threaded.

4b8339e3

by Duncan Coutts at 2026-09-22T09:36:27+01:00

In G.I.Conc.IO: ensure in-lib ops are no-ops for in-RTS I/O managers

The interruptIOManager and ioManagerCapabilitiesChanged operations are
only defined for some of the in-library I/O managers. Make sure they are
defined to be no-ops for the in-RTS I/O managers.

01b5c5e8

by Duncan Coutts at 2026-09-22T09:36:27+01:00

Replace other uses of threaded with iomgrInRTS/iomgrInLib

For cases where threaded/non-threaded was being used as a proxy for
whether the I/O manager is in libs or the RTS, replace it with a check
on the I/O manager feature bit: iomgrInRTS/iomgrInLib.

Again, more future proofing for if/when we have in-RTS I/O managers for
the threaded RTS.

5 changed files:

libraries/base/src/System/Timeout.hs
libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
libraries/ghc-internal/src/GHC/Internal/Conc/POSIX.hs
libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
libraries/ghc-internal/src/GHC/Internal/IO/SubSystem.hs

Changes:

libraries/base/src/System/Timeout.hs

@@ -23,6 +23,7 @@ import Prelude
  import GHC.Internal.Control.Monad
  import GHC.Internal.Event           (getSystemTimerManager,
                              registerTimeout, unregisterTimeout)
 +import GHC.Internal.IO.SubSystem    (iomgrInLib)
  #endif
  import Control.Concurrent
@@ -105,8 +106,8 @@ timeout n f
      | n <  0    = fmap Just f
      | n == 0    = return Nothing
  #if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
 -    | rtsSupportsBoundThreads = do
 -        -- In the threaded RTS, we use the Timer Manager to delay the
 +    | iomgrInLib = do
 +        -- If the Timer Manager is available then use it to delay the
          -- (fairly expensive) 'forkIO' call until the timeout has expired.
          --
          -- An additional thread is required for the actual delivery of

libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs

@@ -72,9 +72,12 @@ import GHC.Internal.Prim (Int#, State#, RealWorld,
  import GHC.Internal.Real ( fromIntegral )
  import GHC.Internal.System.Posix.Types
 +#if !defined(javascript_HOST_ARCH)
 +import GHC.Internal.IO.SubSystem
 +#endif
++
  #if defined(mingw32_HOST_OS)
  import qualified GHC.Internal.Conc.Windows as Windows
 -import GHC.Internal.IO.SubSystem
  import GHC.Internal.Conc.Windows (asyncRead, asyncWrite, asyncDoProc, asyncReadBA,
                           asyncWriteBA, ConsoleEvent(..), win32ConsoleHandler,
                           toWin32ConsoleEvent)
@@ -102,18 +105,18 @@ ensureIOManagerIsRunning = Windows.ensureIOManagerIsRunning
  --
  -- @since base-4.15
  interruptIOManager :: IO ()
 -#if !defined(mingw32_HOST_OS)
 -interruptIOManager = return ()
 -#else
 -interruptIOManager = Windows.interruptIOManager
 +interruptIOManager
 +#if defined(mingw32_HOST_OS)
 +  | iomgrInLib = Windows.interruptIOManager
  #endif
 +  | otherwise  = return ()
  ioManagerCapabilitiesChanged :: IO ()
 +ioManagerCapabilitiesChanged
  #if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
 -ioManagerCapabilitiesChanged = Event.ioManagerCapabilitiesChanged
 -#else
 -ioManagerCapabilitiesChanged = return ()
 +  | iomgrInLib = Event.ioManagerCapabilitiesChanged
  #endif
 +  | otherwise  = return ()
  -- | Block the current thread until data is available to read on the
  -- given file descriptor (GHC only).
@@ -124,9 +127,9 @@ ioManagerCapabilitiesChanged = return ()
  threadWaitRead :: Fd -> IO ()
  threadWaitRead fd
  #if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
 -  | threaded  = Event.threadWaitRead fd
 +  | iomgrInLib = Event.threadWaitRead fd
  #endif
 -  | otherwise = IO $ \s ->
 +  | otherwise  = IO $ \s ->
          case fromIntegral fd of { I# fd# ->
          case waitRead# fd# s of { s' -> (# s', () #)
          }}
@@ -140,9 +143,9 @@ threadWaitRead fd
  threadWaitWrite :: Fd -> IO ()
  threadWaitWrite fd
  #if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
 -  | threaded  = Event.threadWaitWrite fd
 +  | iomgrInLib = Event.threadWaitWrite fd
  #endif
 -  | otherwise = IO $ \s ->
 +  | otherwise  = IO $ \s ->
          case fromIntegral fd of { I# fd# ->
          case waitWrite# fd# s of { s' -> (# s', () #)
          }}
@@ -154,9 +157,9 @@ threadWaitWrite fd
  threadWaitReadSTM :: Fd -> IO (STM.STM (), IO ())
  threadWaitReadSTM fd
  #if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
 -  | threaded  = Event.threadWaitReadSTM fd
 +  | iomgrInLib = Event.threadWaitReadSTM fd
  #endif
 -  | otherwise = do
 +  | otherwise  = do
        m <- STM.newTVarIO False
        t <- Sync.forkIO $ do
          threadWaitRead fd
@@ -173,9 +176,9 @@ threadWaitReadSTM fd
  threadWaitWriteSTM :: Fd -> IO (STM.STM (), IO ())
  threadWaitWriteSTM fd
  #if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
 -  | threaded  = Event.threadWaitWriteSTM fd
 +  | iomgrInLib = Event.threadWaitWriteSTM fd
  #endif
 -  | otherwise = do
 +  | otherwise  = do
        m <- STM.newTVarIO False
        t <- Sync.forkIO $ do
          threadWaitWrite fd
@@ -206,9 +209,9 @@ closeFdWith :: (Fd -> IO ()) -- ^ Low-level action that performs the real close.
              -> IO ()
  closeFdWith close fd
  #if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
 -  | threaded  = Event.closeFdWith close fd
 +  | iomgrInLib = Event.closeFdWith close fd
  #endif
 -  | otherwise = close fd
 +  | otherwise  = close fd
  -- | Suspends the current thread for a given number of microseconds
  -- (GHC only).
@@ -223,12 +226,11 @@ closeFdWith close fd
  threadDelay :: Int -> IO ()
  threadDelay time
  #if defined(mingw32_HOST_OS)
 -  | isWindowsNativeIO = Windows.threadDelay time
 -  | threaded          = Windows.threadDelay time
 +  | iomgrInLib        = Windows.threadDelay time
  #elif defined(wasm32_HOST_ARCH)
    | Wasm.isJSFFIUsed  = Wasm.threadDelay time
  #elif !defined(javascript_HOST_ARCH)
 -  | threaded  = Event.threadDelay time
 +  | iomgrInLib        = Event.threadDelay time
  #endif
    | otherwise         = IO $ \s ->
          case time of { I# time# ->
@@ -245,17 +247,12 @@ threadDelay time
  registerDelay :: Int -> IO (TVar Bool)
  registerDelay _usecs
  #if defined(mingw32_HOST_OS)
 -  | isWindowsNativeIO = Windows.registerDelay _usecs
 -  | threaded          = Windows.registerDelay _usecs
 +  | iomgrInLib        = Windows.registerDelay _usecs
  #elif !defined(javascript_HOST_ARCH)
 -  | threaded          = Event.registerDelay _usecs
 +  | iomgrInLib        = Event.registerDelay _usecs
  #endif
    | otherwise         = errorWithoutStackTrace "registerDelay: requires -threaded"
 -#if !defined(javascript_HOST_ARCH)
 -foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
 -#endif
+-
  -- ---------------------------------------------------------------------------
  -- PrimIOException

libraries/ghc-internal/src/GHC/Internal/Conc/POSIX.hs

@@ -55,6 +55,7 @@ import GHC.Internal.Data.Maybe (Maybe(..))
  import GHC.Internal.Err (errorWithoutStackTrace)
  import GHC.Internal.Event.Windows.ConsoleEvent
  import GHC.Internal.IO (unsafePerformIO)
 +import GHC.Internal.IO.SubSystem (iomgrInLib)
  import GHC.Internal.IORef
  import GHC.Internal.MVar
  import GHC.Internal.Num (Num(..))
@@ -120,7 +121,7 @@ asyncWriteBA fd isSock len off bufB =
  --
  threadDelay :: Int -> IO ()
  threadDelay time
 -  | threaded  = waitForDelayEvent time
 +  | iomgrInLib = waitForDelayEvent time
    | otherwise = IO $ \s ->
          case time of { I# time# ->
          case delay# time# s of { s' -> (# s', () #)
@@ -134,11 +135,9 @@ threadDelay time
  --
  registerDelay :: Int -> IO (TVar Bool)
  registerDelay usecs
 -  | threaded = waitForDelayEventSTM usecs
 +  | iomgrInLib = waitForDelayEventSTM usecs
    | otherwise = errorWithoutStackTrace "registerDelay: requires -threaded"
 -foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
+-
  waitForDelayEvent :: Int -> IO ()
  waitForDelayEvent usecs = do
    m <- newEmptyMVar
@@ -185,7 +184,7 @@ foreign import ccall unsafe "getOrSetGHCConcWindowsIOManagerThreadStore"
  ensureIOManagerIsRunning :: IO ()
  ensureIOManagerIsRunning
 -  | threaded  = startIOManagerThread
 +  | iomgrInLib = startIOManagerThread
    | otherwise = return ()
  interruptIOManager :: IO ()

libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs

@@ -49,6 +49,7 @@ import GHC.Internal.IO (mask_, uninterruptibleMask_, onException)
  import GHC.Internal.IO.Exception (ioError)
  import GHC.Internal.IOArray (IOArray, newIOArray, readIOArray, writeIOArray,
                      boundsIOArray)
 +import GHC.Internal.IO.SubSystem (iomgrInRTS)
  import GHC.Internal.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar)
  import GHC.Internal.Event.Control (controlWriteFd)
  import GHC.Internal.Event.Internal (eventIs, evtClose)
@@ -325,7 +326,7 @@ timerManagerThreadVar = unsafePerformIO $ do
  ensureIOManagerIsRunning :: IO ()
  ensureIOManagerIsRunning
 -  | not threaded = return ()
 +  | iomgrInRTS = return ()
    | otherwise = do
        startIOManagerThreads
        startTimerManagerThread
@@ -409,8 +410,6 @@ startTimerManagerThread = modifyMVar_ timerManagerThreadVar $ \old -> do
            create
          _other         -> return st
 -foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
+-
  ioManagerCapabilitiesChanged :: IO ()
  ioManagerCapabilitiesChanged =
    withMVar ioManagerLock $ \_ -> do

libraries/ghc-internal/src/GHC/Internal/IO/SubSystem.hs

@@ -51,6 +51,7 @@ module GHC.Internal.IO.SubSystem (
    -- other. This can instead now be done conditionally on the I\/O manager
    -- feature 'iomgrInRTS'.
    iomgrInRTS,
 +  iomgrInLib,
    iomgrUsesHANDLEs,
   ) where
@@ -150,6 +151,11 @@ ioManagerFeatureBitmask IOMgrUsesHANDLEs = 1## `uncheckedShiftL#` 1#
  iomgrInRTS :: Bool
  iomgrInRTS = ioManagerFeature IOMgrInRTS
 +-- | The inverse of 'iomgrInRTS'. In some cases the logic may read more clearly
 +-- this way round.
 +iomgrInLib :: Bool
 +iomgrInLib = not iomgrInRTS
++
  -- | This means that the I\/O manager uses the Win32 API's HANDLE type to
  -- refer to open files. The inverse is that it uses Posix style fds.
  -- This is always false on Poisx platforms, while on Windows it is true