| DelaySTM {-# UNPACK #-} !USecs {-# UNPACK #-} !(TVar Bool)
#ifndef mingw32_HOST_OS
+{-# NOINLINE pendingEvents #-}
pendingEvents :: IORef [IOReq]
+pendingEvents = unsafePerformIO $ do
+ m <- newIORef []
+ sharedCAF m getOrSetGHCConcPendingEventsStore
+
+foreign import ccall unsafe "getOrSetGHCConcPendingEventsStore"
+ getOrSetGHCConcPendingEventsStore :: Ptr a -> IO (Ptr a)
#endif
-pendingDelays :: IORef [DelayReq]
-{-# NOINLINE pendingEvents #-}
+
{-# NOINLINE pendingDelays #-}
-(pendingEvents,pendingDelays) = unsafePerformIO $ do
- reqs <- newIORef []
- dels <- newIORef []
- return (reqs, dels)
+pendingDelays :: IORef [DelayReq]
+pendingDelays = unsafePerformIO $ do
+ m <- newIORef []
+ sharedCAF m getOrSetGHCConcPendingDelaysStore
+
+foreign import ccall unsafe "getOrSetGHCConcPendingDelaysStore"
+ getOrSetGHCConcPendingDelaysStore :: Ptr a -> IO (Ptr a)
{-# NOINLINE ioManagerThread #-}
ioManagerThread :: MVar (Maybe ThreadId)
-ioManagerThread = unsafePerformIO $ newMVar Nothing
+ioManagerThread = unsafePerformIO $ do
+ m <- newMVar Nothing
+ sharedCAF m getOrSetGHCConcIOManagerThreadStore
+
+foreign import ccall unsafe "getOrSetGHCConcIOManagerThreadStore"
+ getOrSetGHCConcIOManagerThreadStore :: Ptr a -> IO (Ptr a)
ensureIOManagerIsRunning :: IO ()
ensureIOManagerIsRunning
foreign import ccall unsafe "getUSecOfDay"
getUSecOfDay :: IO USecs
-prodding :: IORef Bool
{-# NOINLINE prodding #-}
-prodding = unsafePerformIO (newIORef False)
+prodding :: IORef Bool
+prodding = unsafePerformIO $ do
+ r <- newIORef False
+ sharedCAF r getOrSetGHCConcProddingStore
+
+foreign import ccall unsafe "getOrSetGHCConcProddingStore"
+ getOrSetGHCConcProddingStore :: Ptr a -> IO (Ptr a)
prodServiceThread :: IO ()
prodServiceThread = do
- was_set <- atomicModifyIORef prodding (\a -> (True,a))
+ was_set <- readIORef prodding
+ writeIORef prodding True
+ -- no need for atomicModifyIORef, extra prods are harmless.
if (not (was_set)) then wakeupIOManager else return ()
+-- Machinery needed to ensure that we only have one copy of certain
+-- CAFs in this module even when the base package is present twice, as
+-- it is when base is dynamically loaded into GHCi. The RTS keeps
+-- track of the single true value of the CAF, so even when the CAFs in
+-- the dynamically-loaded base package are reverted, nothing bad
+-- happens.
+--
+sharedCAF :: a -> (Ptr a -> IO (Ptr a)) -> IO a
+sharedCAF a get_or_set =
+ block $ do
+ stable_ref <- newStablePtr a
+ let ref = castPtr (castStablePtrToPtr stable_ref)
+ ref2 <- get_or_set ref
+ if ref==ref2
+ then return a
+ else do freeStablePtr stable_ref
+ deRefStablePtr (castPtrToStablePtr (castPtr ref2))
+
#ifdef mingw32_HOST_OS
-- ----------------------------------------------------------------------------
-- Windows IO manager thread
-- don't want them to block.
setCloseOnExec rd_end
setCloseOnExec wr_end
- writeIORef stick (fromIntegral wr_end)
c_setIOManagerPipe wr_end
allocaBytes sizeofFdSet $ \readfds -> do
allocaBytes sizeofFdSet $ \writefds -> do
io_MANAGER_DIE = 0xfe
io_MANAGER_SYNC = 0xfd
--- | the stick is for poking the IO manager with
-stick :: IORef Fd
-{-# NOINLINE stick #-}
-stick = unsafePerformIO $ newIORef (-1)
-
{-# NOINLINE sync #-}
sync :: IORef [MVar ()]
sync = unsafePerformIO (newIORef [])
syncIOManager = do
m <- newEmptyMVar
atomicModifyIORef sync (\old -> (m:old,()))
- fd <- readIORef stick
- when (fd /= (-1)) $
- with io_MANAGER_SYNC $ \pbuf -> do
- warnErrnoIfMinus1_ "syncIOManager" $ c_write (fromIntegral fd) pbuf 1
+ c_ioManagerSync
takeMVar m
-wakeupIOManager :: IO ()
-wakeupIOManager = do
- fd <- readIORef stick
- when (fd /= (-1)) $
- with io_MANAGER_WAKEUP $ \pbuf -> do
- warnErrnoIfMinus1_ "wakeupIOManager" $ c_write (fromIntegral fd) pbuf 1
+foreign import ccall unsafe "ioManagerSync" c_ioManagerSync :: IO ()
+foreign import ccall unsafe "ioManagerWakeup" wakeupIOManager :: IO ()
-- For the non-threaded RTS
runHandlers :: Ptr Word8 -> Int -> IO ()
signal_handlers = unsafePerformIO $ do
arr <- newIOArray (0,maxSig) Nothing
m <- newMVar arr
- block $ do
- stable_ref <- newStablePtr m
- let ref = castStablePtrToPtr stable_ref
- ref2 <- getOrSetSignalHandlerStore ref
- if ref==ref2
- then return m
- else do freeStablePtr stable_ref
- deRefStablePtr (castPtrToStablePtr ref2)
+ sharedCAF m getOrSetGHCConcSignalHandlerStore
-foreign import ccall unsafe "getOrSetSignalHandlerStore"
- getOrSetSignalHandlerStore :: Ptr a -> IO (Ptr a)
+foreign import ccall unsafe "getOrSetGHCConcSignalHandlerStore"
+ getOrSetGHCConcSignalHandlerStore :: Ptr a -> IO (Ptr a)
setHandler :: Signal -> Maybe (HandlerFun,Dynamic) -> IO (Maybe (HandlerFun,Dynamic))
setHandler sig handler = do