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 Foreign
  50 import GHC.Base
  51 import GHC.Conc.Sync as Sync
  52 import GHC.Real ( fromIntegral )
  53 import System.Posix.Types
  54
  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,
  59                          toWin32ConsoleEvent)
  60 #else
  61 import qualified System.Event.Thread as Event
  62 #endif
  63
  64 ensureIOManagerIsRunning :: IO ()
  65 #ifndef mingw32_HOST_OS
  66 ensureIOManagerIsRunning = Event.ensureIOManagerIsRunning
  67 #else
  68 ensureIOManagerIsRunning = Windows.ensureIOManagerIsRunning
  69 #endif
  70
  71 -- | Block the current thread until data is available to read on the
  72 -- given file descriptor (GHC only).
  73 threadWaitRead :: Fd -> IO ()
  74 threadWaitRead fd
  75 #ifndef mingw32_HOST_OS
  76   | threaded  = Event.threadWaitRead fd
  77 #endif
  78   | otherwise = IO $ \s ->
  79         case fromIntegral fd of { I# fd# ->
  80         case waitRead# fd# s of { s' -> (# s', () #)
  81         }}
  82
  83 -- | Block the current thread until data can be written to the
  84 -- given file descriptor (GHC only).
  85 threadWaitWrite :: Fd -> IO ()
  86 threadWaitWrite fd
  87 #ifndef mingw32_HOST_OS
  88   | threaded  = Event.threadWaitWrite fd
  89 #endif
  90   | otherwise = IO $ \s ->
  91         case fromIntegral fd of { I# fd# ->
  92         case waitWrite# fd# s of { s' -> (# s', () #)
  93         }}
  94
  95 -- | Suspends the current thread for a given number of microseconds
  96 -- (GHC only).
  97 --
  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.
 101 --
 102 threadDelay :: Int -> IO ()
 103 threadDelay time
 104 #ifdef mingw32_HOST_OS
 105   | threaded  = Windows.threadDelay time
 106 #else
 107   | threaded  = Event.threadDelay time
 108 #endif
 109   | otherwise = IO $ \s ->
 110         case time of { I# time# ->
 111         case delay# time# s of { s' -> (# s', () #)
 112         }}
 113
 114 -- | Set the value of returned TVar to True after a given number of
 115 -- microseconds. The caveats associated with threadDelay also apply.
 116 --
 117 registerDelay :: Int -> IO (TVar Bool)
 118 registerDelay usecs
 119 #ifdef mingw32_HOST_OS
 120   | threaded = Windows.registerDelay usecs
 121 #else
 122   | threaded = Event.registerDelay usecs
 123 #endif
 124   | otherwise = error "registerDelay: requires -threaded"
 125
 126 foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool