Duncan Coutts pushed to branch wip/dcoutts/io-manager-feature-bitset at Glasgow Haskell Compiler / GHC Commits: 357d3081 by Duncan Coutts at 2026-09-21T20:43:40+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. - - - - - b6dbdec2 by Duncan Coutts at 2026-09-21T20:43:40+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. - - - - - ca52d820 by Duncan Coutts at 2026-09-21T20:43:40+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 ===================================== @@ -71,10 +71,10 @@ import GHC.Internal.Prim (Int#, State#, RealWorld, delay#, waitRead#, waitWrite#, raiseIO#) import GHC.Internal.Real ( fromIntegral ) import GHC.Internal.System.Posix.Types +import GHC.Internal.IO.SubSystem #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 +102,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 +124,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 +140,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 +154,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 +173,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 +206,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 +223,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 +244,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 ===================================== @@ -120,7 +120,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 +134,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 +183,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 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/885549aa1e1d4efdfa7295b947142bf... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/885549aa1e1d4efdfa7295b947142bf... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help