Блокирует ли Data.ByteString.readFile все потоки?

У меня есть следующий фрагмент кода:

module Main where
import Data.IORef
import qualified Data.ByteString as S
import Control.Monad
import Control.Concurrent

main :: IO ()
main = do
    var <- newIORef False
    forkIO $ forever $ do
        status <- readIORef var
        if status
            then putStrLn "main: file was read"
            else putStrLn "main: file not yet read"
        threadDelay 10000
    threadDelay 200000
    putStrLn ">>! going to read file"
    --threadDelay 200000    --
    str <- S.readFile "large2"
    putStrLn ">>! finished reading file"
    writeIORef var True
    threadDelay 200000

Я компилирую код и запускаю его следующим образом:

$ ghc -threaded --make test.hs
$ dd if=/dev/urandom of=large bs=800000 count=1024
$ ./test +RTS -N3
<...>
main: file not yet read
main: file not yet read
main: file not yet read
main: file not yet read
>>! going to read file
>>! finished reading file
main: file was read
main: file was read
main: file was read
main: file was read
<...>

То есть программа приостанавливается при чтении файла. Я нахожу это сбивающим с толку, потому что, если я заменю readFile на threadDelay, он корректно выполнит управление.

Что здесь происходит? Разве GHC не сопоставляет код forkIO 'd с другим системным потоком?

(Я использую Mac OS X 10.8.5, но люди сообщают о том же поведении на Ubuntu и Debian)

Ответ 1

Джейк прав.

Я считаю, что большое выделение вызывает сбор мусора, но сама коллекция не может начинаться до тех пор, пока все потоки не будут готовы.

Если у вас есть проблемы, подобные этому, вы можете посмотреть, что происходит, используя ThreadScope.

Журнал событий из вашего кода выглядит следующим образом:

Проблема заключается в том, что мы хотим дать другому потоку возможность запускать. Поэтому вместо использования S.readFile мы используем chunked read и накапливаем результат (или ленивую байтовую строку). Например:

readChunky filename = withFile filename ReadMode $ \x -> do
  go x S.empty
  where
    go h acc = do
      more <- hIsEOF h
      case more of
        True  -> return acc
        False -> do
          v <- S.hGet h (4096 * 4096)
          go h $ S.append acc v

И он работает по назначению.

См. график: .

Ответ 2

Я разработал теорию. Я считаю, что большое выделение вызывает сбор мусора, но сама коллекция не может начинаться до тех пор, пока все потоки не будут готовы. Все потоки, кроме тех, которые читают блок файла до тех пор, пока чтение не завершится, но, к сожалению, все чтение происходит в один звонок, поэтому требуется некоторое время. Затем выполняется GC, и после этого все хорошо.

У меня также есть обходное решение, но я не думаю, что он гарантирует, что программа не будет блокироваться (хотя я еще не заблокировал ее, другие сообщили, что она все еще блокируется на своих машинах). Выполните следующее с помощью +RTS -N -qg (если вы разрешаете параллельный GC, он иногда блокирует, но не всегда):

module Main where

import Data.IORef
import qualified Data.ByteString as S
import Control.Monad
import Control.Concurrent

main :: IO ()
main = do
  done <- newEmptyMVar
  forkIO $ do
    var <- newIORef False
    forkIO $ forever $ do
      status <- readIORef var
      if status
        then putStrLn "main: file was read"
        else putStrLn "main: file not yet read"
      threadDelay 10000
    threadDelay 200000
    putStrLn ">>! going to read file"
    --threadDelay 200000    --
    _str <- S.readFile "large"
    putStrLn ">>! finished reading file"
    writeIORef var True
    threadDelay 200000
    putMVar done ()
  takeMVar done

У меня еще нет теорий о том, почему GC ждет syscall. Я не могу воспроизвести проблему с моими собственными безопасными и небезопасными привязками до sleep и добавлением performGC в цикл состояния.

Ответ 3

Я не думаю, что это readFile так же, как базовые операции ByteString. В Data.ByteString.Internal есть пара unsafe вызовов FFI:

foreign import ccall unsafe "string.h strlen" c_strlen
    :: CString -> IO CSize

foreign import ccall unsafe "static stdlib.h &free" c_free_finalizer
    :: FunPtr (Ptr Word8 -> IO ())

foreign import ccall unsafe "string.h memchr" c_memchr
    :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)

foreign import ccall unsafe "string.h memcmp" c_memcmp
    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt

foreign import ccall unsafe "string.h memcpy" c_memcpy
    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)

foreign import ccall unsafe "string.h memset" c_memset
    :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)

foreign import ccall unsafe "static fpstring.h fps_reverse" c_reverse
    :: Ptr Word8 -> Ptr Word8 -> CULong -> IO ()

foreign import ccall unsafe "static fpstring.h fps_intersperse" c_intersperse
    :: Ptr Word8 -> Ptr Word8 -> CULong -> Word8 -> IO ()

foreign import ccall unsafe "static fpstring.h fps_maximum" c_maximum
    :: Ptr Word8 -> CULong -> IO Word8

foreign import ccall unsafe "static fpstring.h fps_minimum" c_minimum
    :: Ptr Word8 -> CULong -> IO Word8

foreign import ccall unsafe "static fpstring.h fps_count" c_count
    :: Ptr Word8 -> CULong -> Word8 -> IO CULong

Эти небезопасные вызовы быстрее, чем безопасные вызовы (для каждого вызова мало накладных расходов), но они будут блокировать систему времени выполнения Haskell (включая потоки) до тех пор, пока они не завершатся.

Я не на 100% уверен, это причина, по которой вы видите задержку, но это было первое, что пришло мне в голову.