1 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
2 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
3 {-# OPTIONS_HADDOCK not-home #-}
4 -----------------------------------------------------------------------------
6 -- Module : GHC.Conc.IO
7 -- Copyright : (c) The University of Glasgow, 1994-2002
8 -- License : see libraries/base/LICENSE
10 -- Maintainer : cvs-ghc@haskell.org
11 -- Stability : internal
12 -- Portability : non-portable (GHC extensions)
14 -- Basic concurrency stuff.
16 -----------------------------------------------------------------------------
18 -- No: #hide, because bits of this module are exposed by the stm package.
19 -- However, we don't want this module to be the home location for the
20 -- bits it exports, we'd rather have Control.Concurrent and the other
21 -- higher level modules be the home. Hence:
27 ( ensureIOManagerIsRunning
30 , threadDelay -- :: Int -> IO ()
31 , registerDelay -- :: Int -> IO (TVar Bool)
32 , threadWaitRead -- :: Int -> IO ()
33 , threadWaitWrite -- :: Int -> IO ()
35 #ifdef mingw32_HOST_OS
36 , asyncRead -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
37 , asyncWrite -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
38 , asyncDoProc -- :: FunPtr (Ptr a -> IO Int) -> Ptr a -> IO Int
40 , asyncReadBA -- :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int, Int)
41 , asyncWriteBA -- :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int, Int)
52 import GHC.Conc.Sync as Sync
53 import GHC.Real ( fromIntegral )
54 import System.Posix.Types
56 #ifdef mingw32_HOST_OS
57 import qualified GHC.Conc.Windows as Windows
58 import GHC.Conc.Windows (asyncRead, asyncWrite, asyncDoProc, asyncReadBA,
59 asyncWriteBA, ConsoleEvent(..), win32ConsoleHandler,
62 import qualified System.Event.Thread as Event
65 ensureIOManagerIsRunning :: IO ()
66 #ifndef mingw32_HOST_OS
67 ensureIOManagerIsRunning = Event.ensureIOManagerIsRunning
69 ensureIOManagerIsRunning = Windows.ensureIOManagerIsRunning
72 -- | Block the current thread until data is available to read on the
73 -- given file descriptor (GHC only).
74 threadWaitRead :: Fd -> IO ()
76 #ifndef mingw32_HOST_OS
77 | threaded = Event.threadWaitRead fd
79 | otherwise = IO $ \s ->
80 case fromIntegral fd of { I# fd# ->
81 case waitRead# fd# s of { s' -> (# s', () #)
84 -- | Block the current thread until data can be written to the
85 -- given file descriptor (GHC only).
86 threadWaitWrite :: Fd -> IO ()
88 #ifndef mingw32_HOST_OS
89 | threaded = Event.threadWaitWrite fd
91 | otherwise = IO $ \s ->
92 case fromIntegral fd of { I# fd# ->
93 case waitWrite# fd# s of { s' -> (# s', () #)
96 -- | Suspends the current thread for a given number of microseconds
99 -- There is no guarantee that the thread will be rescheduled promptly
100 -- when the delay has expired, but the thread will never continue to
101 -- run /earlier/ than specified.
103 threadDelay :: Int -> IO ()
105 #ifdef mingw32_HOST_OS
106 | threaded = Windows.threadDelay time
108 | threaded = Event.threadDelay time
110 | otherwise = IO $ \s ->
111 case fromIntegral time of { I# time# ->
112 case delay# time# s of { s' -> (# s', () #)
115 -- | Set the value of returned TVar to True after a given number of
116 -- microseconds. The caveats associated with threadDelay also apply.
118 registerDelay :: Int -> IO (TVar Bool)
120 #ifdef mingw32_HOST_OS
121 | threaded = Windows.registerDelay usecs
123 | threaded = Event.registerDelay usecs
125 | otherwise = error "registerDelay: requires -threaded"
127 foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool