Ticket #7216: stm-fd-wait.patch

File stm-fd-wait.patch, 2.2 KB (added by AndreasVoellmy, 3 years ago)

Patch against 2921e94a3546d3c431051271f505307d2f13b208

  • GHC/Event/Thread.hs

    From dedd802749c8002ff24504727d81d2c0f7f5ab52 Mon Sep 17 00:00:00 2001
    From: Andreas Voellmy <[email protected]>
    Date: Tue, 28 Aug 2012 23:44:30 -0400
    Subject: [PATCH] Added threadWait functions to wait on FD readiness with STM
     actions.
    
    ---
     GHC/Event/Thread.hs |   28 +++++++++++++++++++++++++++-
     1 file changed, 27 insertions(+), 1 deletion(-)
    
    diff --git a/GHC/Event/Thread.hs b/GHC/Event/Thread.hs
    index 2643950..794f01e 100644
    a b module GHC.Event.Thread 
    66    , ensureIOManagerIsRunning
    77    , threadWaitRead
    88    , threadWaitWrite
     9    , threadWaitReadSTM
     10    , threadWaitWriteSTM
    911    , closeFdWith
    1012    , threadDelay
    1113    , registerDelay
    import Foreign.Ptr (Ptr) 
    1820import GHC.Base
    1921import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO,
    2022                      labelThread, modifyMVar_, newTVar, sharedCAF,
    21                       threadStatus, writeTVar)
     23                      threadStatus, writeTVar, newTVarIO, readTVar, retry,throwSTM,STM)
    2224import GHC.IO (mask_, onException)
    2325import GHC.IO.Exception (ioError)
    2426import GHC.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar)
    threadWait evt fd = mask_ $ do 
    9496    then ioError $ errnoToIOError "threadWait" eBADF Nothing Nothing
    9597    else return ()
    9698
     99
     100threadWaitSTM :: Event -> Fd -> IO (STM ())
     101threadWaitSTM evt fd = mask_ $ do
     102  m <- newTVarIO Nothing
     103  Just mgr <- getSystemEventManager
     104  registerFd mgr (\reg e -> unregisterFd_ mgr reg >> atomically (writeTVar m (Just e))) fd evt
     105  return (do mevt <- readTVar m
     106             case mevt of
     107               Nothing -> retry
     108               Just evt ->
     109                 if evt `eventIs` evtClose
     110                 then throwSTM $ errnoToIOError "threadWait" eBADF Nothing Nothing
     111                 else return ()
     112         )
     113
     114threadWaitReadSTM :: Fd -> IO (STM ())
     115threadWaitReadSTM = threadWaitSTM evtRead
     116{-# INLINE threadWaitReadSTM #-}
     117
     118threadWaitWriteSTM :: Fd -> IO (STM ())
     119threadWaitWriteSTM = threadWaitSTM evtWrite
     120{-# INLINE threadWaitWriteSTM #-}
     121
     122
    97123-- | Retrieve the system event manager.
    98124--
    99125-- This function always returns 'Just' the system event manager when using the