Commit f6866824 authored by Sergei Trofimovich's avatar Sergei Trofimovich Committed by Austin Seipp

ghc --make: add nicer names to RTS threads (threaded IO manager, make workers)

Summary:
The patch names most of RTS threads
and ghc (the tool) threads.

It makes nicer debug and eventlog output for ghc itself.
Signed-off-by: default avatarSergei Trofimovich <slyfox@gentoo.org>

Test Plan: ran debugged ghc under '+RTS -Ds'

Reviewers: simonmar, austin

Reviewed By: austin

Subscribers: phaskell, simonmar, relrod, ezyang, carter

Differential Revision: https://phabricator.haskell.org/D101
parent 65e5dbcd
......@@ -63,6 +63,7 @@ import qualified Data.Set as Set
import qualified FiniteMap as Map ( insertListWith )
import Control.Concurrent ( forkIOWithUnmask, killThread )
import qualified GHC.Conc as CC
import Control.Concurrent.MVar
import Control.Concurrent.QSem
import Control.Exception
......@@ -80,6 +81,11 @@ import System.IO.Error ( isDoesNotExistError )
import GHC.Conc ( getNumProcessors, getNumCapabilities, setNumCapabilities )
label_self :: String -> IO ()
label_self thread_name = do
self_tid <- CC.myThreadId
CC.labelThread self_tid thread_name
-- -----------------------------------------------------------------------------
-- Loading the program
......@@ -744,10 +750,18 @@ parUpsweep n_jobs old_hpt stable_mods cleanup sccs = do
| ((ms,mvar,_),idx) <- comp_graph_w_idx ]
liftIO $ label_self "main --make thread"
-- For each module in the module graph, spawn a worker thread that will
-- compile this module.
let { spawnWorkers = forM comp_graph_w_idx $ \((mod,!mvar,!log_queue),!mod_idx) ->
forkIOWithUnmask $ \unmask -> do
liftIO $ label_self $ unwords
[ "worker --make thread"
, "for module"
, show (moduleNameString (ms_mod_name mod))
, "number"
, show mod_idx
]
-- Replace the default log_action with one that writes each
-- message to the module's log_queue. The main thread will
-- deal with synchronously printing these messages.
......
......@@ -39,6 +39,7 @@ import GHC.Event.Manager (Event, EventManager, evtRead, evtWrite, loop,
import qualified GHC.Event.Manager as M
import qualified GHC.Event.TimerManager as TM
import GHC.Num ((-), (+))
import GHC.Show (showSignedInt)
import System.IO.Unsafe (unsafePerformIO)
import System.Posix.Types (Fd)
......@@ -244,11 +245,14 @@ startIOManagerThreads =
forM_ [0..high] (startIOManagerThread eventManagerArray)
writeIORef numEnabledEventManagers (high+1)
show_int :: Int -> String
show_int i = showSignedInt 0 i ""
restartPollLoop :: EventManager -> Int -> IO ThreadId
restartPollLoop mgr i = do
M.release mgr
!t <- forkOn i $ loop mgr
labelThread t "IOManager"
labelThread t ("IOManager on cap " ++ show_int i)
return t
startIOManagerThread :: IOArray Int (Maybe (ThreadId, EventManager))
......@@ -258,7 +262,7 @@ startIOManagerThread eventManagerArray i = do
let create = do
!mgr <- new True
!t <- forkOn i $ loop mgr
labelThread t "IOManager"
labelThread t ("IOManager on cap " ++ show_int i)
writeIOArray eventManagerArray i (Just (t,mgr))
old <- readIOArray eventManagerArray i
case old of
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment