5 , ForeignFunctionInterface
7 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
8 {-# OPTIONS_HADDOCK not-home #-}
10 -----------------------------------------------------------------------------
12 -- Module : GHC.Conc.IO
13 -- Copyright : (c) The University of Glasgow, 1994-2002
14 -- License : see libraries/base/LICENSE
16 -- Maintainer : cvs-ghc@haskell.org
17 -- Stability : internal
18 -- Portability : non-portable (GHC extensions)
20 -- Basic concurrency stuff.
22 -----------------------------------------------------------------------------
24 -- No: #hide, because bits of this module are exposed by the stm package.
25 -- However, we don't want this module to be the home location for the
26 -- bits it exports, we'd rather have Control.Concurrent and the other
27 -- higher level modules be the home. Hence:
33 ( ensureIOManagerIsRunning
36 , threadDelay -- :: Int -> IO ()
37 , registerDelay -- :: Int -> IO (TVar Bool)
38 , threadWaitRead -- :: Int -> IO ()
39 , threadWaitWrite -- :: Int -> IO ()
40 , closeFdWith -- :: (Fd -> IO ()) -> Fd -> IO ()
42 #ifdef mingw32_HOST_OS
43 , asyncRead -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
44 , asyncWrite -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
45 , asyncDoProc -- :: FunPtr (Ptr a -> IO Int) -> Ptr a -> IO Int
47 , asyncReadBA -- :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int, Int)
48 , asyncWriteBA -- :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int, Int)
58 import GHC.Conc.Sync as Sync
59 import GHC.Real ( fromIntegral )
60 import System.Posix.Types
62 #ifdef mingw32_HOST_OS
63 import qualified GHC.Conc.Windows as Windows
64 import GHC.Conc.Windows (asyncRead, asyncWrite, asyncDoProc, asyncReadBA,
65 asyncWriteBA, ConsoleEvent(..), win32ConsoleHandler,
68 import qualified GHC.Event.Thread as Event
71 ensureIOManagerIsRunning :: IO ()
72 #ifndef mingw32_HOST_OS
73 ensureIOManagerIsRunning = Event.ensureIOManagerIsRunning
75 ensureIOManagerIsRunning = Windows.ensureIOManagerIsRunning
78 -- | Block the current thread until data is available to read on the
79 -- given file descriptor (GHC only).
81 -- This will throw an 'IOError' if the file descriptor was closed
82 -- while this thread was blocked. To safely close a file descriptor
83 -- that has been used with 'threadWaitRead', use 'closeFdWith'.
84 threadWaitRead :: Fd -> IO ()
86 #ifndef mingw32_HOST_OS
87 | threaded = Event.threadWaitRead fd
89 | otherwise = IO $ \s ->
90 case fromIntegral fd of { I# fd# ->
91 case waitRead# fd# s of { s' -> (# s', () #)
94 -- | Block the current thread until data can be written to the
95 -- given file descriptor (GHC only).
97 -- This will throw an 'IOError' if the file descriptor was closed
98 -- while this thread was blocked. To safely close a file descriptor
99 -- that has been used with 'threadWaitWrite', use 'closeFdWith'.
100 threadWaitWrite :: Fd -> IO ()
102 #ifndef mingw32_HOST_OS
103 | threaded = Event.threadWaitWrite fd
105 | otherwise = IO $ \s ->
106 case fromIntegral fd of { I# fd# ->
107 case waitWrite# fd# s of { s' -> (# s', () #)
110 -- | Close a file descriptor in a concurrency-safe way (GHC only). If
111 -- you are using 'threadWaitRead' or 'threadWaitWrite' to perform
112 -- blocking I\/O, you /must/ use this function to close file
113 -- descriptors, or blocked threads may not be woken.
115 -- Any threads that are blocked on the file descriptor via
116 -- 'threadWaitRead' or 'threadWaitWrite' will be unblocked by having
117 -- IO exceptions thrown.
118 closeFdWith :: (Fd -> IO ()) -- ^ Low-level action that performs the real close.
119 -> Fd -- ^ File descriptor to close.
122 #ifndef mingw32_HOST_OS
123 | threaded = Event.closeFdWith close fd
125 | otherwise = close fd
127 -- | Suspends the current thread for a given number of microseconds
130 -- There is no guarantee that the thread will be rescheduled promptly
131 -- when the delay has expired, but the thread will never continue to
132 -- run /earlier/ than specified.
134 threadDelay :: Int -> IO ()
136 #ifdef mingw32_HOST_OS
137 | threaded = Windows.threadDelay time
139 | threaded = Event.threadDelay time
141 | otherwise = IO $ \s ->
142 case time of { I# time# ->
143 case delay# time# s of { s' -> (# s', () #)
146 -- | Set the value of returned TVar to True after a given number of
147 -- microseconds. The caveats associated with threadDelay also apply.
149 registerDelay :: Int -> IO (TVar Bool)
151 #ifdef mingw32_HOST_OS
152 | threaded = Windows.registerDelay usecs
154 | threaded = Event.registerDelay usecs
156 | otherwise = error "registerDelay: requires -threaded"
158 foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool