setNumCapabilities call breaks eventlog events
The problem was found when i tried to eventlog ghc --make itself. I've missinterpreted is as a threadscope bug: https://github.com/haskell/ThreadScope/issues/37
Here is small program to reliably reproduce the bug:
module Main where
import qualified Data.List as L
import qualified System.Environment as E
import Control.Monad
import qualified Control.Concurrent as CC
import qualified Control.Concurrent.MVar as CC
slow_and_silly :: Int -> IO Int
slow_and_silly i = return $ length $ L.foldl' (\a v -> a ++ [v]) [] [1..i]
-- build as:
-- $ ghc --make a -O2 -threaded -eventlog
-- valid eventlog:
-- $ ./a 2 7000 +RTS -ls -N2
-- $ ghc-events validate threads a.eventlog
-- Valid eventlog:
-- ...
-- invalid eventlog
-- $ ./a 2 7000 +RTS -ls
-- $ ghc-events validate threads a.eventlog
-- Invalid eventlog:
-- ...
main = do
[caps, count] <- E.getArgs
let n_caps :: Int
n_caps = read caps
max_n :: Int
max_n = read count
CC.setNumCapabilities n_caps
waits <- replicateM n_caps $ CC.newEmptyMVar
forM_ waits $ \w -> CC.forkIO $ do
slow_and_silly max_n >>= print
CC.putMVar w ()
forM_ waits $ \w -> CC.takeMVar w
How to reproduce (comments have ghc-events version):
$ ghc --make a -O2 -threaded -eventlog
$ ./a 2 7000 +RTS -ls -N2
$ threadscope a.eventlog # works
$ ./a 2 7000 +RTS -ls
$ threadscope a.eventlog # crashes
Trac metadata
Trac field | Value |
---|---|
Version | 7.8.3 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Profiling |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |