GHC/Conc/IO.hs

   1 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
   2 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
   3 {-# OPTIONS_HADDOCK not-home #-}
   4 -----------------------------------------------------------------------------
   5 -- |
   6 -- Module      :  GHC.Conc.IO
   7 -- Copyright   :  (c) The University of Glasgow, 1994-2002
   8 -- License     :  see libraries/base/LICENSE
   9 --
  10 -- Maintainer  :  cvs-ghc@haskell.org
  11 -- Stability   :  internal
  12 -- Portability :  non-portable (GHC extensions)
  13 --
  14 -- Basic concurrency stuff.
  15 --
  16 -----------------------------------------------------------------------------
  17
  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:
  22
  23 #include "Typeable.h"
  24
  25 -- #not-home
  26 module GHC.Conc.IO
  27         ( ensureIOManagerIsRunning
  28
  29         -- * Waiting
  30         , threadDelay           -- :: Int -> IO ()
  31         , registerDelay         -- :: Int -> IO (TVar Bool)
  32         , threadWaitRead        -- :: Int -> IO ()
  33         , threadWaitWrite       -- :: Int -> IO ()
  34
  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
  39
  40         , asyncReadBA   -- :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int, Int)
  41         , asyncWriteBA  -- :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int, Int)
  42
  43         , ConsoleEvent(..)
  44         , win32ConsoleHandler
  45         , toWin32ConsoleEvent
  46 #endif
  47         ) where
  48
  49 import Control.Monad
  50 import Foreign
  51 import GHC.Base
  52 import GHC.Conc.Sync as Sync
  53 import GHC.Real ( fromIntegral )
  54 import System.Posix.Types
  55
  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,
  60                          toWin32ConsoleEvent)
  61 #else
  62 import qualified System.Event.Thread as Event
  63 #endif
  64
  65 ensureIOManagerIsRunning :: IO ()
  66 #ifndef mingw32_HOST_OS
  67 ensureIOManagerIsRunning = Event.ensureIOManagerIsRunning
  68 #else
  69 ensureIOManagerIsRunning = Windows.ensureIOManagerIsRunning
  70 #endif
  71
  72 -- | Block the current thread until data is available to read on the
  73 -- given file descriptor (GHC only).
  74 threadWaitRead :: Fd -> IO ()
  75 threadWaitRead fd
  76 #ifndef mingw32_HOST_OS
  77   | threaded  = Event.threadWaitRead fd
  78 #endif
  79   | otherwise = IO $ \s ->
  80         case fromIntegral fd of { I# fd# ->
  81         case waitRead# fd# s of { s' -> (# s', () #)
  82         }}
  83
  84 -- | Block the current thread until data can be written to the
  85 -- given file descriptor (GHC only).
  86 threadWaitWrite :: Fd -> IO ()
  87 threadWaitWrite fd
  88 #ifndef mingw32_HOST_OS
  89   | threaded  = Event.threadWaitWrite fd
  90 #endif
  91   | otherwise = IO $ \s ->
  92         case fromIntegral fd of { I# fd# ->
  93         case waitWrite# fd# s of { s' -> (# s', () #)
  94         }}
  95
  96 -- | Suspends the current thread for a given number of microseconds
  97 -- (GHC only).
  98 --
  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.
 102 --
 103 threadDelay :: Int -> IO ()
 104 threadDelay time
 105 #ifdef mingw32_HOST_OS
 106   | threaded  = Windows.threadDelay time
 107 #else
 108   | threaded  = Event.threadDelay time
 109 #endif
 110   | otherwise = IO $ \s ->
 111         case fromIntegral time of { I# time# ->
 112         case delay# time# s of { s' -> (# s', () #)
 113         }}
 114
 115 -- | Set the value of returned TVar to True after a given number of
 116 -- microseconds. The caveats associated with threadDelay also apply.
 117 --
 118 registerDelay :: Int -> IO (TVar Bool)
 119 registerDelay usecs
 120 #ifdef mingw32_HOST_OS
 121   | threaded = Windows.registerDelay usecs
 122 #else
 123   | threaded = Event.registerDelay usecs
 124 #endif
 125   | otherwise = error "registerDelay: requires -threaded"
 126
 127 foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool