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)
51 import GHC.Conc.Sync as Sync
52 import GHC.Real ( fromIntegral )
53 import System.Posix.Types
55 #ifdef mingw32_HOST_OS
56 import qualified GHC.Conc.Windows as Windows
57 import GHC.Conc.Windows (asyncRead, asyncWrite, asyncDoProc, asyncReadBA,
58 asyncWriteBA, ConsoleEvent(..), win32ConsoleHandler,
61 import qualified System.Event.Thread as Event
64 ensureIOManagerIsRunning :: IO ()
65 #ifndef mingw32_HOST_OS
66 ensureIOManagerIsRunning = Event.ensureIOManagerIsRunning
68 ensureIOManagerIsRunning = Windows.ensureIOManagerIsRunning
71 -- | Block the current thread until data is available to read on the
72 -- given file descriptor (GHC only).
73 threadWaitRead :: Fd -> IO ()
75 #ifndef mingw32_HOST_OS
76 | threaded = Event.threadWaitRead fd
78 | otherwise = IO $ \s ->
79 case fromIntegral fd of { I# fd# ->
80 case waitRead# fd# s of { s' -> (# s', () #)
83 -- | Block the current thread until data can be written to the
84 -- given file descriptor (GHC only).
85 threadWaitWrite :: Fd -> IO ()
87 #ifndef mingw32_HOST_OS
88 | threaded = Event.threadWaitWrite fd
90 | otherwise = IO $ \s ->
91 case fromIntegral fd of { I# fd# ->
92 case waitWrite# fd# s of { s' -> (# s', () #)
95 -- | Suspends the current thread for a given number of microseconds
98 -- There is no guarantee that the thread will be rescheduled promptly
99 -- when the delay has expired, but the thread will never continue to
100 -- run /earlier/ than specified.
102 threadDelay :: Int -> IO ()
104 #ifdef mingw32_HOST_OS
105 | threaded = Windows.threadDelay time
107 | threaded = Event.threadDelay time
109 | otherwise = IO $ \s ->
110 case fromIntegral time of { I# time# ->
111 case delay# time# s of { s' -> (# s', () #)
114 -- | Set the value of returned TVar to True after a given number of
115 -- microseconds. The caveats associated with threadDelay also apply.
117 registerDelay :: Int -> IO (TVar Bool)
119 #ifdef mingw32_HOST_OS
120 | threaded = Windows.registerDelay usecs
122 | threaded = Event.registerDelay usecs
124 | otherwise = error "registerDelay: requires -threaded"
126 foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool