base 4.16.3.0 → 4.16.4.0
raw patch · 4 files changed
+116/−42 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- GHC/Event/Thread.hs +75/−19
- GHC/IO/Windows/Handle.hsc +32/−22
- base.cabal +1/−1
- changelog.md +8/−0
GHC/Event/Thread.hs view
@@ -18,7 +18,7 @@ -- TODO: Use new Windows I/O manager import Control.Exception (finally, SomeException, toException) import Data.Foldable (forM_, mapM_, sequence_)-import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicWriteIORef) import Data.Maybe (fromMaybe) import Data.Tuple (snd) import Foreign.C.Error (eBADF, errnoToIOError)@@ -29,7 +29,8 @@ import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO, labelThread, modifyMVar_, withMVar, newTVar, sharedCAF, getNumCapabilities, threadCapability, myThreadId, forkOn,- threadStatus, writeTVar, newTVarIO, readTVar, retry,throwSTM,STM)+ threadStatus, writeTVar, newTVarIO, readTVar, retry,+ throwSTM, STM, yield) import GHC.IO (mask_, uninterruptibleMask_, onException) import GHC.IO.Exception (ioError) import GHC.IOArray (IOArray, newIOArray, readIOArray, writeIOArray,@@ -41,6 +42,7 @@ new, registerFd, unregisterFd_) import qualified GHC.Event.Manager as M import qualified GHC.Event.TimerManager as TM+import GHC.Ix (inRange) import GHC.Num ((-), (+)) import GHC.Real (fromIntegral) import GHC.Show (showSignedInt)@@ -98,23 +100,45 @@ closeFdWith :: (Fd -> IO ()) -- ^ Action that performs the close. -> Fd -- ^ File descriptor to close. -> IO ()-closeFdWith close fd = do- eventManagerArray <- readIORef eventManager- let (low, high) = boundsIOArray eventManagerArray- mgrs <- flip mapM [low..high] $ \i -> do- Just (_,!mgr) <- readIOArray eventManagerArray i- return mgr- -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time.- -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have- -- to use uninterruptible mask.- uninterruptibleMask_ $ do- tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd- cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables- close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps)+closeFdWith close fd = close_loop where finish mgr table cbApp = putMVar (M.callbackTableVar mgr fd) table >> cbApp zipWithM f xs ys = sequence (zipWith f xs ys)+ -- The array inside 'eventManager' can be swapped out at any time, see+ -- 'ioManagerCapabilitiesChanged'. See #21651. We detect this case by+ -- checking the array bounds before and after. When such a swap has+ -- happened we cleanup and try again+ close_loop = do+ eventManagerArray <- readIORef eventManager+ let ema_bounds@(low, high) = boundsIOArray eventManagerArray+ mgrs <- flip mapM [low..high] $ \i -> do+ Just (_,!mgr) <- readIOArray eventManagerArray i+ return mgr + -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time.+ -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have+ -- to use uninterruptible mask.+ join $ uninterruptibleMask_ $ do+ tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd+ new_ema_bounds <- boundsIOArray `fmap` readIORef eventManager+ -- Here we exploit Note [The eventManager Array]+ if new_ema_bounds /= ema_bounds+ then do+ -- the array has been modified.+ -- mgrs still holds the right EventManagers, by the Note.+ -- new_ema_bounds must be larger than ema_bounds, by the note.+ -- return the MVars we took and try again+ sequence_ $ zipWith (\mgr table -> finish mgr table (pure ())) mgrs tables+ pure close_loop+ else do+ -- We surely have taken all the appropriate MVars. Even if the array+ -- has been swapped, our mgrs is still correct.+ -- Remove the Fd from all callback tables, close the Fd, and run all+ -- callbacks.+ cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables+ close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps)+ pure (pure ())+ threadWait :: Event -> Fd -> IO () threadWait evt fd = mask_ $ do m <- newEmptyMVar@@ -177,10 +201,24 @@ getSystemEventManager :: IO (Maybe EventManager) getSystemEventManager = do t <- myThreadId- (cap, _) <- threadCapability t eventManagerArray <- readIORef eventManager- mmgr <- readIOArray eventManagerArray cap- return $ fmap snd mmgr+ let r = boundsIOArray eventManagerArray+ (cap, _) <- threadCapability t+ -- It is possible that we've just increased the number of capabilities and the+ -- new EventManager has not yet been constructed by+ -- 'ioManagerCapabilitiesChanged'. We expect this to happen very rarely.+ -- T21561 exercises this.+ -- Two options to proceed:+ -- 1) return the EventManager for capability 0. This is guaranteed to exist,+ -- and "shouldn't" cause any correctness issues.+ -- 2) Busy wait, with or without a call to 'yield'. This can't deadlock,+ -- because we must be on a brand capability and there must be a call to+ -- 'ioManagerCapabilitiesChanged' pending.+ --+ -- We take the second option, with the yield, judging it the most robust.+ if not (inRange r cap)+ then yield >> getSystemEventManager+ else fmap snd `fmap` readIOArray eventManagerArray cap getSystemEventManager_ :: IO EventManager getSystemEventManager_ = do@@ -191,6 +229,22 @@ foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore" getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a) +-- Note [The eventManager Array]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- A mutable array holding the current EventManager for each capability+-- An entry is Nothing only while the eventmanagers are initialised, see+-- 'startIOManagerThread' and 'ioManagerCapabilitiesChanged'.+-- The 'ThreadId' at array position 'cap' will have been 'forkOn'ed capabality+-- 'cap'.+-- The array will be swapped with newer arrays when the number of capabilities+-- changes(via 'setNumCapabilities'). However:+-- * the size of the arrays will never decrease; and+-- * The 'EventManager's in the array are not replaced with other+-- 'EventManager' constructors.+--+-- This is a similar strategy as the rts uses for it's+-- capabilities array (n_capabilities is the size of the array,+-- enabled_capabilities' is the number of active capabilities). eventManager :: IORef (IOArray Int (Maybe (ThreadId, EventManager))) eventManager = unsafePerformIO $ do numCaps <- getNumCapabilities@@ -351,7 +405,9 @@ startIOManagerThread new_eventManagerArray -- update the event manager array reference:- writeIORef eventManager new_eventManagerArray+ atomicWriteIORef eventManager new_eventManagerArray+ -- We need an atomic write here because 'eventManager' is accessed+ -- unsynchronized in 'getSystemEventManager' and 'closeFdWith' else when (new_n_caps > numEnabled) $ forM_ [numEnabled..new_n_caps-1] $ \i -> do Just (_,mgr) <- readIOArray eventManagerArray i
GHC/IO/Windows/Handle.hsc view
@@ -575,24 +575,23 @@ consoleRead :: Bool -> Io ConsoleHandle -> Ptr Word8 -> Word64 -> Int -> IO Int consoleRead blocking hwnd ptr _offset bytes- = withUTF16ToGhcInternal ptr bytes $ \reqBytes w_ptr ->- alloca $ \res -> do- cooked <- isCooked hwnd- -- Cooked input must be handled differently when the STD handles are- -- attached to a real console handle. For File based handles we can't do- -- proper cooked inputs, but since the actions are async you would get- -- results as soon as available.- --- -- For console handles We have to use a lower level API then ReadConsole,- -- namely we must use ReadConsoleInput which requires us to process- -- all console message manually.- --- -- Do note that MSYS2 shells such as bash don't attach to a real handle,- -- and instead have by default a pipe/file based std handles. Which- -- means the cooked behaviour is best when used in a native Windows- -- terminal such as cmd, powershell or ConEmu.- case cooked || not blocking of- False -> do+ = alloca $ \res -> do+ cooked <- isCooked hwnd+ -- Cooked input must be handled differently when the STD handles are+ -- attached to a real console handle. For File based handles we can't do+ -- proper cooked inputs, but since the actions are async you would get+ -- results as soon as available.+ --+ -- For console handles We have to use a lower level API then ReadConsole,+ -- namely we must use ReadConsoleInput which requires us to process+ -- all console message manually.+ --+ -- Do note that MSYS2 shells such as bash don't attach to a real handle,+ -- and instead have by default a pipe/file based std handles. Which+ -- means the cooked behaviour is best when used in a native Windows+ -- terminal such as cmd, powershell or ConEmu.+ case cooked || not blocking of+ False -> withUTF16ToGhcInternal ptr bytes $ \reqBytes w_ptr -> do debugIO "consoleRead :: un-cooked I/O read." -- eotControl allows us to handle control characters like EOL -- without needing a newline, which would sort of defeat the point@@ -627,9 +626,9 @@ -- characters as they are. Technically this function can handle any -- console event. Including mouse, window and virtual key events -- but for now I'm only interested in key presses.- let entries = fromIntegral $ reqBytes `div` (#size INPUT_RECORD)+ let entries = fromIntegral $ bytes `div` (#size INPUT_RECORD) allocaBytes entries $ \p_inputs ->- maybeReadEvent p_inputs entries res w_ptr+ maybeReadEvent p_inputs entries res ptr -- Check to see if we have been explicitly asked to do a non-blocking -- I/O, and if we were, make sure that if we didn't have any console@@ -656,6 +655,7 @@ b_read <- fromIntegral <$> peek res read <- cobble b_read w_ptr p_inputs+ debugIO $ "readEvent: =" ++ show read if read > 0 then return $ fromIntegral read else maybeReadEvent p_inputs entries res w_ptr@@ -664,7 +664,7 @@ -- minimum required to know which key/sequences were pressed. To do -- this and prevent having to fully port the PINPUT_RECORD structure -- in Haskell we use some GCC builtins to find the correct offsets.- cobble :: Int -> Ptr Word16 -> PINPUT_RECORD -> IO Int+ cobble :: Int -> Ptr Word8 -> PINPUT_RECORD -> IO Int cobble 0 _ _ = do debugIO "cobble: done." return 0 cobble n w_ptr p_inputs =@@ -689,8 +689,18 @@ debugIO $ "cobble: offset - " ++ show char_offset debugIO $ "cobble: show > " ++ show char debugIO $ "cobble: repeat: " ++ show repeated+ -- The documentation here is rather subtle, but+ -- according to MSDN the uWChar being provided here+ -- has been "translated". What this actually means+ -- is that the surrogate pairs have already been+ -- translated into byte sequences. That is, despite+ -- the Word16 storage type, it's actually a byte+ -- stream. This means we shouldn't try to decode+ -- to UTF-8 again since we'd end up incorrectly+ -- interpreting two bytes as an extended unicode+ -- character. pokeArray w_ptr $ replicate repeated char- (+1) <$> cobble n' w_ptr' p_inputs'+ (+repeated) <$> cobble n' w_ptr' p_inputs' else do debugIO $ "cobble: skip event." cobble n' w_ptr p_inputs'
base.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: base-version: 4.16.3.0+version: 4.16.4.0 -- NOTE: Don't forget to update ./changelog.md license: BSD-3-Clause
changelog.md view
@@ -1,5 +1,13 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) +## 4.16.4.0 *Nov 2022*++ * Shipped with GHC 9.2.5++ * Fix races in IOManager (setNumCapabilities,closeFdWith) (#21651)++ * winio: do not re-translate input when handle is uncooked+ ## 4.16.3.0 *May 2022* * Shipped with GHC 9.2.4