diff --git a/GHC/RTS/EventLogFormat.h b/GHC/RTS/EventLogFormat.h --- a/GHC/RTS/EventLogFormat.h +++ b/GHC/RTS/EventLogFormat.h @@ -162,7 +162,6 @@ #define EVENT_TASK_MIGRATE 56 /* (taskID, cap, new_cap) */ #define EVENT_TASK_DELETE 57 /* (taskID) */ #define EVENT_USER_MARKER 58 /* (marker_name) */ -#define EVENT_HACK_BUG_T9003 59 /* Hack: see trac #9003 */ /* Range 59 - 59 is available for new GHC and common events. */ @@ -261,23 +260,22 @@ * #define ThreadFinished 5 * #define ForeignCall 6 * #define BlockedOnMVar 7 - * #define BlockedOnMVarRead 20 - * NOTE: in GHC-7.8.2, this was 8, and following states shifted one up - * #define BlockedOnBlackHole 8 - * #define BlockedOnRead 9 - * #define BlockedOnWrite 10 - * #define BlockedOnDelay 11 - * #define BlockedOnSTM 12 - * #define BlockedOnDoProc 13 - * NOTE: unused GUM states 8, 9 (here: 14,15) in rts/Constants.h + * #define BlockedOnMVarRead 8 + * NOTE: added in GHC-7.7, earlier versions shift numbers one up + * #define BlockedOnBlackHole 9 + * #define BlockedOnRead 10 + * #define BlockedOnWrite 11 + * #define BlockedOnDelay 12 + * #define BlockedOnSTM 13 + * #define BlockedOnDoProc 14 + * NOTE: unused GUM states 9, 10 (here: 15,16) in rts/Constants.h * #define BlockedOnCCall -- not used (see ForeignCall) * #define BlockedOnCCall_NoUnblockExc -- not used (see ForeignCall) - * #define BlockedOnMsgThrowTo 16 - * NOTE: 16 because unused GUM states ignored in ghc-events lib - * Otherwise it would be 18, following would be 19, 20 - * TODO: verify the above is what GHC does (16/17 could be 18/19) - * #define ThreadMigrating 17 - * #define BlockedOnMsgGlobalise 18 + * #define BlockedOnMsgThrowTo 17 + * NOTE: 17 because unused GUM states are ignored in ghc-events lib + * Otherwise it would be 19, following would be 20, 21 + * #define ThreadMigrating 18 + * #define BlockedOnMsgGlobalise 19 * NOTE: not present in GHC. Mercury-Event? */ #define THREAD_SUSPENDED_FOREIGN_CALL 6 diff --git a/GHC/RTS/EventTypes.hs b/GHC/RTS/EventTypes.hs --- a/GHC/RTS/EventTypes.hs +++ b/GHC/RTS/EventTypes.hs @@ -369,23 +369,18 @@ deriving Show -{- [Note: Stop status in GHC-7.8.2] +{- [Note: Stop status since GHC-7.7] In GHC-7.7, a new thread block reason "BlockedOnMVarRead" was introduced, and placed adjacent to BlockedOnMVar (7). Therefore, event -logs produced by GHC pre-7.8.2 encode BlockedOnBlackHole and following -as 8..18, whereas GHC-7.8.2 event logs encode them as 9..19. -Later, the prior event numbering was restored for GHC-7.8.3. -See GHC bug #9003 for a discussion. +logs produced by GHC pre-7.7 encode BlockedOnBlackHole and following +as 8..18, whereas post-7.7 event logs encode them as 9..19. The parsers in Events.hs have to be adapted accordingly, providing -special ghc-7.8.2 parsers for the thread-stop event if GHC-7.8.2 -produced the eventlog. -The EVENT_USER_MARKER was not present in GHC-7.6.3, and a new event -EVENT_HACK_BUG_T9003 was added in GHC-7.8.3, so we take presence of -USER_MARKER and absence of HACK_BUG_T9003 as an indication that -ghc-7.8.2 parsers should be used. --} +either post77 or pre77 parsers for the thread-stop event. +The EVENT_USER_MARKER was not present in GHC-7.6.3, so we take its +absense as an indication that pre77 parsers should be used. + -} --sync with ghc/includes/Constants.h data ThreadStopStatus @@ -412,9 +407,9 @@ | BlockedOnBlackHoleOwnedBy {-# UNPACK #-}!ThreadId deriving (Show) --- normal GHC encoding, see [Stop status in GHC-7.8.2] -mkStopStatus :: RawThreadStopStatus -> ThreadStopStatus -mkStopStatus n = case n of +-- GHC pre-7.7 encoding, see [Stop status since GHC-7.7] +mkStopStatus_pre77 :: RawThreadStopStatus -> ThreadStopStatus +mkStopStatus_pre77 n = case n of 0 -> NoStatus 1 -> HeapOverflow 2 -> StackOverflow @@ -434,13 +429,11 @@ 16 -> BlockedOnMsgThrowTo 17 -> ThreadMigrating 18 -> BlockedOnMsgGlobalise - 19 -> NoStatus -- yeuch... this one does not actually exist in GHC eventlogs - 20 -> BlockedOnMVarRead -- since GHC-7.8.3 _ -> error "mkStat" --- GHC 7.8.2 encoding, see [Stop status in GHC-7.8.2] -mkStopStatus782 :: RawThreadStopStatus -> ThreadStopStatus -mkStopStatus782 n = case n of +-- GHC post-7.7 encoding, see [Stop status since GHC-7.7] +mkStopStatus :: RawThreadStopStatus -> ThreadStopStatus +mkStopStatus n = case n of 0 -> NoStatus 1 -> HeapOverflow 2 -> StackOverflow @@ -449,7 +442,7 @@ 5 -> ThreadFinished 6 -> ForeignCall 7 -> BlockedOnMVar - 8 -> BlockedOnMVarRead -- in GHC-7.8.2 + 8 -> BlockedOnMVarRead -- since GHC-7.8 9 -> BlockedOnBlackHole 10 -> BlockedOnRead 11 -> BlockedOnWrite @@ -463,11 +456,9 @@ 19 -> BlockedOnMsgGlobalise _ -> error "mkStat" -maxThreadStopStatusPre77, maxThreadStopStatus782, maxThreadStopStatus - :: RawThreadStopStatus -maxThreadStopStatusPre77 = 18 -- see [Stop status in GHC-7.8.2] -maxThreadStopStatus782 = 19 -- need to distinguish three cases -maxThreadStopStatus = 20 +maxThreadStopStatus_pre77, maxThreadStopStatus :: RawThreadStopStatus +maxThreadStopStatus_pre77 = 18 -- see [Stop status since GHC-7.7] +maxThreadStopStatus = 19 data CapsetType = CapsetCustom @@ -498,10 +489,11 @@ | FailPE | RFork | Connect | DataMes | Head | Constr | Part | Terminate | Packet + deriving (Enum, Show) -- with GUM and its variants, add: -- ...| Fetch | Resume | Ack -- ...| Fish | Schedule | Free | Reval | Shark - deriving (Enum, Show) + offset :: RawMsgTag offset = 0x50 diff --git a/GHC/RTS/Events.hs b/GHC/RTS/Events.hs --- a/GHC/RTS/Events.hs +++ b/GHC/RTS/Events.hs @@ -1,6 +1,9 @@ {-# LANGUAGE CPP,BangPatterns,PatternGuards #-} {-# OPTIONS_GHC -funbox-strict-fields -fwarn-incomplete-patterns #-} {- + - Authors: Donnie Jones, Simon Marlow, Paul Bone, Mischa Dieterle, + - Thomas Horstmeyer, Duncan Coutts, Jost Berthold, Mikolaj Konarski + - Events.hs - Parser functions for GHC RTS EventLog framework, parallel version. -} @@ -421,38 +424,17 @@ )) ] --- special thread stop event parsers for GHC version 7.8.2 --- see [Stop status in GHC-7.8.2] in EventTypes.hs -ghc782StopParser :: EventParser EventInfo -ghc782StopParser = - (FixedSizeParser EVENT_STOP_THREAD (sz_tid + sz_th_stop_status + sz_tid) (do - -- (thread, status, info) - t <- getE - s <- getE :: GetEvents RawThreadStopStatus - i <- getE :: GetEvents ThreadId - return StopThread{thread = t, - status = case () of - _ | s > maxThreadStopStatus782 - -> NoStatus - | s == 9 {- XXX yeuch -} - -- GHC-7.8.2: 9 == BlockedOnBlackHole - -> BlockedOnBlackHoleOwnedBy i - | otherwise - -> mkStopStatus782 s} - )) - --- parsers for GHC < 7.8.2. Older versions do not use block info --- (different length). See [Stop status in GHC-7.8.2] in --- EventTypes.hs +-- special thread stop event parsers for GHC-7 before version 7.7. +-- see [Stop status since GHC-7.7] in EventTypes.hs pre77StopParsers :: [EventParser EventInfo] pre77StopParsers = [ (FixedSizeParser EVENT_STOP_THREAD (sz_tid + sz_th_stop_status) (do -- (thread, status) t <- getE s <- getE :: GetEvents RawThreadStopStatus - return StopThread{thread=t, status = if s > maxThreadStopStatusPre77 + return StopThread{thread=t, status = if s > maxThreadStopStatus_pre77 then NoStatus - else mkStopStatus s} + else mkStopStatus_pre77 s} -- older version of the event, no block info )), @@ -464,22 +446,20 @@ i <- getE :: GetEvents ThreadId return StopThread{thread = t, status = case () of - _ | s > maxThreadStopStatusPre77 + _ | s > maxThreadStopStatus_pre77 -> NoStatus | s == 8 {- XXX yeuch -} -- pre-7.7: 8==BlockedOnBlackhole -> BlockedOnBlackHoleOwnedBy i | otherwise - -> mkStopStatus s} + -> mkStopStatus_pre77 s} )) ] --- parsers for GHC >= 7.8.3, always using block info field parser. --- See [Stop status in GHC-7.8.2] in EventTypes.hs -post782StopParser :: EventParser EventInfo -post782StopParser = - (FixedSizeParser EVENT_STOP_THREAD (sz_tid + sz_th_stop_status + sz_tid) - (do +-- see [Stop status since GHC-7.7] in EventTypes.hs +post77StopParser :: EventParser EventInfo +post77StopParser = + (FixedSizeParser EVENT_STOP_THREAD (sz_tid + sz_th_stop_status + sz_tid) (do -- (thread, status, info) t <- getE s <- getE :: GetEvents RawThreadStopStatus @@ -488,12 +468,12 @@ status = case () of _ | s > maxThreadStopStatus -> NoStatus - | s == 8 {- XXX yeuch -} - -- post-7.8.2: 8==BlockedOnBlackhole + | s == 9 {- XXX yeuch -} + -- GHC post-7.7: 9 == BlockedOnBlackHole -> BlockedOnBlackHoleOwnedBy i | otherwise -> mkStopStatus s} - )) + )) ----------------------- -- GHC 6.12 compat: GHC 6.12 reported the wrong sizes for some events, @@ -521,12 +501,12 @@ (FixedSizeParser EVENT_STOP_THREAD (sz_old_tid + 2) (do -- (thread, status) t <- getE s <- getE :: GetEvents RawThreadStopStatus - return StopThread{thread=t, status = if s > maxThreadStopStatusPre77 + return StopThread{thread=t, status = if s > maxThreadStopStatus_pre77 then NoStatus - else mkStopStatus s} - -- older version of the event uses pre-77 encoding - -- (actually, it only uses encodings 0 to 5) - -- see [Stop status in GHC-7.8.2] in EventTypes.hs + else mkStopStatus_pre77 s} + -- older version of the event, use pre-77 encoding + -- (actually, it uses only encodings 0 to 5) + -- see [Stop status since GHC-7.7] in EventTypes.hs )), (FixedSizeParser EVENT_THREAD_RUNNABLE sz_old_tid (do -- (thread) @@ -789,23 +769,17 @@ -- make use of threadscope. -} - -- GHC-7.8.2 uses a different thread block status encoding, - -- and therefore requires a different parser for the stop - -- event. Later, in GHC-7.8.3, the old encoding was restored. - -- GHC-7.8.2 can be recognised by presence and absence of - -- events in the header: - -- * User markers were added in GHC-7.8 - -- * an empty event HACK_BUG_T9003 was added in GHC-7.8.3 + -- GHC-7.7 changed the thread block status encoding, and + -- therefore requires a different parser for the stop event. + -- (This fix assumes things will remain as they are in GHC). + -- User markers were added in GHC-7.8 so we simply use + -- different parsers if the user marker event is present. -- This fix breaks software which uses ghc-events and combines -- user markers with the older stop status encoding. We don't -- know of any such software, though. - is_pre77 = M.notMember EVENT_USER_MARKER imap - is_ghc782 = M.member EVENT_USER_MARKER imap && - M.notMember EVENT_HACK_BUG_T9003 imap - + is_pre77 = Nothing == M.lookup EVENT_USER_MARKER imap stopParsers = if is_pre77 then pre77StopParsers - else if is_ghc782 then [ghc782StopParser] - else [post782StopParser] + else [post77StopParser] event_parsers = if is_ghc_6 then standardParsers ++ ghc6Parsers ++ @@ -1294,8 +1268,11 @@ -- here we assume that ThreadStopStatus fromEnum matches the definitions in -- EventLogFormat.h --- The standard encoding is used here, which is wrong for eventlogs --- produced by GHC-7.8.2 ([Stop status in GHC-7.8.2] in EventTypes.hs + +-- The function uses the new (post GHC-7.7) encoding. This is wrong +-- when writing a log produced by a GHC pre-7.7, as its version event +-- is included, yet this is probably tolerable. +-- For the whole story see [Stop status since GHC-7.7] in EventTypes.hs putEventSpec (StopThread t s) = do putE t putE $ case s of @@ -1307,19 +1284,19 @@ ThreadFinished -> 5 ForeignCall -> 6 BlockedOnMVar -> 7 - BlockedOnMVarRead -> 20 -- since GHC-7.8.3 - BlockedOnBlackHole -> 8 - BlockedOnBlackHoleOwnedBy _ -> 8 - BlockedOnRead -> 9 - BlockedOnWrite -> 10 - BlockedOnDelay -> 11 - BlockedOnSTM -> 12 - BlockedOnDoProc -> 13 - BlockedOnCCall -> 14 - BlockedOnCCall_NoUnblockExc -> 15 - BlockedOnMsgThrowTo -> 16 - ThreadMigrating -> 17 - BlockedOnMsgGlobalise -> 18 + BlockedOnMVarRead -> 8 -- since GHC-7.7 + BlockedOnBlackHole -> 9 + BlockedOnBlackHoleOwnedBy _ -> 9 + BlockedOnRead -> 10 + BlockedOnWrite -> 11 + BlockedOnDelay -> 12 + BlockedOnSTM -> 13 + BlockedOnDoProc -> 14 + BlockedOnCCall -> 15 + BlockedOnCCall_NoUnblockExc -> 16 + BlockedOnMsgThrowTo -> 17 + ThreadMigrating -> 18 + BlockedOnMsgGlobalise -> 19 putE $ case s of BlockedOnBlackHoleOwnedBy i -> i _ -> 0 diff --git a/ghc-events-parallel.cabal b/ghc-events-parallel.cabal --- a/ghc-events-parallel.cabal +++ b/ghc-events-parallel.cabal @@ -1,5 +1,5 @@ name: ghc-events-parallel -version: 0.4.3.1 +version: 0.5.0.0 synopsis: Library and tool for parsing .eventlog files from parallel GHC description: Parses .eventlog files emitted by parallel GHC versions (6.12.3 and later). This package can replace the original @@ -22,15 +22,14 @@ maintainer: Eden group bug-reports: eden@mathematik.uni-marburg.de build-type: Simple -tested-with: GHC == 6.12.3, GHC == 7.4.1, GHC == 7.6.1, GHC == 7.6.3, GHC == 7.8.2, GHC == 7.8.3 +tested-with: GHC == 6.12.3, GHC == 7.4.1, GHC == 7.6.1, GHC == 7.6.3, GHC == 7.8.2 cabal-version: >= 1.8 extra-source-files: GHC/RTS/EventLogFormat.h, test/*.eventlog - test/stop.hs -source-repository head - type: git - location: http://github.com:jberthold/ghc-events-parallel.git +-- source-repository head +-- type: darcs +-- location: james.mathematik.uni-marburg.de:repos/jb/ghc-events-parallel/ library build-depends: base == 4.*, diff --git a/test/782stop.eventlog b/test/782stop.eventlog deleted file mode 100644 Binary files a/test/782stop.eventlog and /dev/null differ diff --git a/test/783stop.eventlog b/test/783stop.eventlog deleted file mode 100644 Binary files a/test/783stop.eventlog and /dev/null differ diff --git a/test/TestVersions.hs b/test/TestVersions.hs --- a/test/TestVersions.hs +++ b/test/TestVersions.hs @@ -23,7 +23,7 @@ , "queens-ghc-7.0.2.eventlog" , "mandelbrot-mmc-2011-06-14.eventlog" , "mdlLogMPI1.eventlog" - , "pre77stop.eventlog", "782stop.eventlog", "783stop.eventlog" ] + , "warshall0-trace-7.8.2#8.eventlog" ] -- returns True on success testFile :: FilePath -> IO Bool diff --git a/test/pre77stop.eventlog b/test/pre77stop.eventlog deleted file mode 100644 Binary files a/test/pre77stop.eventlog and /dev/null differ diff --git a/test/stop.hs b/test/stop.hs deleted file mode 100644 --- a/test/stop.hs +++ /dev/null @@ -1,42 +0,0 @@ --- This test program triggers different thread stop encodings in --- eventlogs, depending on GHC version (black hole, mvar read, mvar) - -module Main where - -import Control.Concurrent -import Debug.Trace -import GHC.Conc - -main = do - putStrLn "suggest to run with +RTS -lsu-g-p -K80m -k10m -H200m -C1s" - - -- define some time-consuming computation - let stuff = ack 3 10 - -- create MVars to block on - v1 <- newMVar "full" - v2 <- newEmptyMVar - -- create a thread which blackholes something, and re-fills the MVar - traceEventIO "forking child thread" - forkIO (do traceEventIO "child" - putStrLn ("child thread sez " ++ show stuff) - traceEventIO "filling full MVar" - putMVar v1 "filled full var" - yield - traceEventIO "filling empty MVar" - putMVar v2 "filled empty var" - yield - traceEventIO "child finished" - ) - yield - putStrLn ("and the main thread sez " ++ show stuff) - traceEventIO "emptying full MVar" - s1 <- takeMVar v1 - putStrLn ("from MVar: " ++ s1) - traceEventIO "reading empty MVar" - s2 <- readMVar v2 - putStrLn ("from MVar: " ++ s2) - -ack :: Integer -> Integer -> Integer -ack 0 m = m+1 -ack n 0 = ack (n-1) 1 -ack n m = ack (n-1) (ack n (m-1))