From 636f9337e202be85065ec837d66d163b4b549205 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Thu, 19 Jun 2008 14:19:11 +0000 Subject: [PATCH] Fix #2363: getChar cannot be interrupted with -threaded Now in -threaded mode, instead of just making a blocking call to read(), we call select() first to make sure the read() won't block, and if it would block, then we use threadWaitRead. The idea is that the current thread must be interruptible while it blocks. This is a little slower than before, but the overhead only applies to blocking Handles (stdin/stdout/stderr, and those created by System.Process). --- GHC/Handle.hs | 69 ++++++++++++++++++++++++++++++++++----------------------- 1 file changed, 41 insertions(+), 28 deletions(-) diff --git a/GHC/Handle.hs b/GHC/Handle.hs index ddec90f..bbab74d 100644 --- a/GHC/Handle.hs +++ b/GHC/Handle.hs @@ -546,42 +546,52 @@ cases are wrong here. The cases that are wrong: but that leaves a small race window where the data can be read from the file descriptor before we issue our blocking read(). * readRawBufferNoBlock for a blocking FD + +NOTE [2363]: + +In the threaded RTS we could just make safe calls to read()/write() +for file descriptors in blocking mode without worrying about blocking +other threads, but the problem with this is that the thread will be +uninterruptible while it is blocked in the foreign call. See #2363. +So now we always call fdReady() before reading, and if fdReady +indicates that there's no data, we call threadWaitRead. + -} readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt readRawBuffer loc fd is_nonblock buf off len - | is_nonblock = unsafe_read - | threaded = safe_read + | is_nonblock = unsafe_read -- unsafe is ok, it can't block | otherwise = do r <- throwErrnoIfMinus1 loc - (fdReady (fromIntegral fd) 0 0 False) + (unsafe_fdReady (fromIntegral fd) 0 0 False) if r /= 0 - then unsafe_read - else do threadWaitRead (fromIntegral fd); unsafe_read + then read + else do threadWaitRead (fromIntegral fd); read where do_read call = throwErrnoIfMinus1RetryMayBlock loc call (threadWaitRead (fromIntegral fd)) + read = if threaded then safe_read else unsafe_read unsafe_read = do_read (read_rawBuffer fd buf off len) safe_read = do_read (safe_read_rawBuffer fd buf off len) readRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt readRawBufferPtr loc fd is_nonblock buf off len - | is_nonblock = unsafe_read - | threaded = safe_read + | is_nonblock = unsafe_read -- unsafe is ok, it can't block | otherwise = do r <- throwErrnoIfMinus1 loc - (fdReady (fromIntegral fd) 0 0 False) + (unsafe_fdReady (fromIntegral fd) 0 0 False) if r /= 0 - then unsafe_read - else do threadWaitRead (fromIntegral fd); unsafe_read + then read + else do threadWaitRead (fromIntegral fd); read where - do_read call = throwErrnoIfMinus1RetryMayBlock loc call - (threadWaitRead (fromIntegral fd)) - unsafe_read = do_read (read_off fd buf off len) - safe_read = do_read (safe_read_off fd buf off len) + do_read call = throwErrnoIfMinus1RetryMayBlock loc call + (threadWaitRead (fromIntegral fd)) + read = if threaded then safe_read else unsafe_read + unsafe_read = do_read (read_off fd buf off len) + safe_read = do_read (safe_read_off fd buf off len) readRawBufferNoBlock :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt readRawBufferNoBlock loc fd is_nonblock buf off len - | is_nonblock = unsafe_read - | otherwise = do r <- fdReady (fromIntegral fd) 0 0 False + | is_nonblock = unsafe_read -- unsafe is ok, it can't block + | otherwise = do r <- unsafe_fdReady (fromIntegral fd) 0 0 False if r /= 0 then safe_read else return 0 -- XXX see note [nonblock] @@ -592,8 +602,8 @@ readRawBufferNoBlock loc fd is_nonblock buf off len readRawBufferPtrNoBlock :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt readRawBufferPtrNoBlock loc fd is_nonblock buf off len - | is_nonblock = unsafe_read - | otherwise = do r <- fdReady (fromIntegral fd) 0 0 False + | is_nonblock = unsafe_read -- unsafe is ok, it can't block + | otherwise = do r <- unsafe_fdReady (fromIntegral fd) 0 0 False if r /= 0 then safe_read else return 0 -- XXX see note [nonblock] @@ -604,29 +614,29 @@ readRawBufferPtrNoBlock loc fd is_nonblock buf off len writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt writeRawBuffer loc fd is_nonblock buf off len - | is_nonblock = unsafe_write - | threaded = safe_write - | otherwise = do r <- fdReady (fromIntegral fd) 1 0 False + | is_nonblock = unsafe_write -- unsafe is ok, it can't block + | otherwise = do r <- unsafe_fdReady (fromIntegral fd) 1 0 False if r /= 0 - then safe_write - else do threadWaitWrite (fromIntegral fd); unsafe_write + then write + else do threadWaitWrite (fromIntegral fd); write where do_write call = throwErrnoIfMinus1RetryMayBlock loc call (threadWaitWrite (fromIntegral fd)) + write = if threaded then safe_write else unsafe_write unsafe_write = do_write (write_rawBuffer fd buf off len) safe_write = do_write (safe_write_rawBuffer (fromIntegral fd) buf off len) writeRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt writeRawBufferPtr loc fd is_nonblock buf off len - | is_nonblock = unsafe_write - | threaded = safe_write - | otherwise = do r <- fdReady (fromIntegral fd) 1 0 False + | is_nonblock = unsafe_write -- unsafe is ok, it can't block + | otherwise = do r <- unsafe_fdReady (fromIntegral fd) 1 0 False if r /= 0 - then safe_write - else do threadWaitWrite (fromIntegral fd); unsafe_write + then write + else do threadWaitWrite (fromIntegral fd); write where do_write call = throwErrnoIfMinus1RetryMayBlock loc call (threadWaitWrite (fromIntegral fd)) + write = if threaded then safe_write else unsafe_write unsafe_write = do_write (write_off fd buf off len) safe_write = do_write (safe_write_off (fromIntegral fd) buf off len) @@ -645,6 +655,9 @@ foreign import ccall unsafe "__hscore_PrelHandle_write" foreign import ccall safe "fdReady" fdReady :: CInt -> CInt -> CInt -> Bool -> IO CInt +foreign import ccall unsafe "fdReady" + unsafe_fdReady :: CInt -> CInt -> CInt -> Bool -> IO CInt + #else /* mingw32_HOST_OS.... */ readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt -- 1.7.10.4