Opened 9 years ago

Closed 9 years ago

#4262 closed bug (fixed)

GHC's runtime never terminates unused worker threads

Reported by: Remi Owned by: simonmar
Priority: high Milestone: 7.4.1
Component: Runtime System Version: 6.12.3
Keywords: worker thread foreign function interface Cc: ezyang@…
Operating System: Unknown/Multiple Architecture: Unknown/Multiple
Type of failure: Runtime performance bug Test Case:
Blocked By: Blocking:
Related Tickets: Differential Rev(s):
Wiki Page:

Description

When concurrently calling safe FFI functions, worker OS threads are created. These threads then never quit.

The following toy program creates 30k OS threads (which is fine because that's exactly what it asks for) which are then never "garbage collected": 30k threads and over 230g of VM are hanging around until the program exits.

{-# LANGUAGE ForeignFunctionInterface #-}
module Main where

import Control.Concurrent
import Control.Monad
import Foreign.C.Types
import System.Mem

foreign import ccall safe sleep :: CUInt -> IO ()

main = do
    replicateM_ 30000 $ forkIO $ sleep 2
    getLine
    -- do other stuff

P.S. Of course I should simply use threadDelay in this case. The real program performs up to a few hundred concurrent fdatasync calls.

Change History (6)

comment:1 Changed 9 years ago by igloo

Milestone: 7.0.1

comment:2 Changed 9 years ago by ezyang

Cc: ezyang@… added

comment:3 Changed 9 years ago by ezyang

Here is a somewhat refined test-case, though POSIX only.

{-# LANGUAGE ForeignFunctionInterface #-}
module Main where

import Control.Concurrent
import Control.Monad
import Foreign.C.Types
import System.Mem
import System.Posix.Process
import System.Directory
import Control.Concurrent.QSem

foreign import ccall safe sleep :: CUInt -> IO ()

main = do
    let amount = 200
    qsem <- newQSem 0
    replicateM_ amount . forkIO $ (sleep 2 >> signalQSem qsem)
    replicateM_ amount $ waitQSem qsem
    -- POSIX only: check thread usage manually
    pid <- getProcessID
    let dir = "/proc/" ++ show pid ++ "/task"
    contents <- getDirectoryContents dir
    let status = length contents - 2 -- . and ..
    print status

comment:5 Changed 9 years ago by simonmar

Milestone: 7.0.17.2.1
Owner: set to simonmar
Priority: normalhigh

Thanks for the patch, I'll review.

comment:6 Changed 9 years ago by simonmar

Resolution: fixed
Status: newclosed

Thanks. I reworked the patch a bit, and pushed my version today:

Thu Nov 25 05:57:29 PST 2010  Simon Marlow <marlowsd@gmail.com>
  * Keep a maximum of 6 spare worker threads per Capability (#4262)
Note: See TracTickets for help on using tickets.