ghc-events-parallel 0.5.0.0 → 0.5.0.1
raw patch · 10 files changed
+204/−104 lines, 10 filesdep +transformersdep −mtlbinary-added
Dependencies added: transformers
Dependencies removed: mtl
Files
- GHC/RTS/EventLogFormat.h +16/−14
- GHC/RTS/EventParserUtils.hs +17/−5
- GHC/RTS/EventTypes.hs +27/−19
- GHC/RTS/Events.hs +92/−57
- ghc-events-parallel.cabal +9/−8
- test/782stop.eventlog binary
- test/783stop.eventlog binary
- test/TestVersions.hs +1/−1
- test/pre77stop.eventlog binary
- test/stop.hs +42/−0
GHC/RTS/EventLogFormat.h view
@@ -162,6 +162,7 @@ #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. */ @@ -260,22 +261,23 @@ * #define ThreadFinished 5 * #define ForeignCall 6 * #define BlockedOnMVar 7- * #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 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 BlockedOnCCall -- not used (see ForeignCall) * #define BlockedOnCCall_NoUnblockExc -- not used (see ForeignCall)- * #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+ * #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 * NOTE: not present in GHC. Mercury-Event? */ #define THREAD_SUSPENDED_FOREIGN_CALL 6
GHC/RTS/EventParserUtils.hs view
@@ -16,8 +16,13 @@ ) where import Control.Monad-import Control.Monad.Error-import Control.Monad.Reader+import Control.Monad.Trans.Class+#if MIN_VERSION_transformers(0, 4, 1)+import Control.Monad.Trans.Except+#else+import Control.Monad.Trans.Error+#endif+import Control.Monad.Trans.Reader import Data.Array import Data.Binary import Data.Binary.Get hiding (skip)@@ -34,12 +39,19 @@ import GHC.RTS.EventTypes +#if !(MIN_VERSION_transformers(0, 4, 1))+-- use Error instead of Except for tranformers-0.3.0.0+throwE = throwError+type ExceptT = ErrorT+#endif++ -- reader/Get monad that passes around the event types-type GetEvents a = ReaderT EventParsers (ErrorT String Get) a+type GetEvents a = ReaderT EventParsers (ExceptT String Get) a newtype EventParsers = EventParsers (Array Int (GetEvents EventInfo)) -type GetHeader a = ErrorT String Get a+type GetHeader a = ExceptT String Get a getH :: Binary a => GetHeader a getH = lift get@@ -125,7 +137,7 @@ -- [ (num, parser num etype) | (num, etype) <- M.toList etypes ]) where max_event_num = maximum (M.keys etypes)- undeclared_etype num = throwError ("undeclared event type: " ++ show num)+ undeclared_etype num = lift (throwE ("undeclared event type: " ++ show num)) parser_map = makeParserMap event_parsers parser num = -- Get the event's size from the header,
GHC/RTS/EventTypes.hs view
@@ -369,18 +369,23 @@ deriving Show -{- [Note: Stop status since GHC-7.7]+{- [Note: Stop status in GHC-7.8.2] 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.7 encode BlockedOnBlackHole and following-as 8..18, whereas post-7.7 event logs encode them as 9..19.+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. The parsers in Events.hs have to be adapted accordingly, providing-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.- -}+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.+-} --sync with ghc/includes/Constants.h data ThreadStopStatus@@ -407,9 +412,9 @@ | BlockedOnBlackHoleOwnedBy {-# UNPACK #-}!ThreadId deriving (Show) --- GHC pre-7.7 encoding, see [Stop status since GHC-7.7]-mkStopStatus_pre77 :: RawThreadStopStatus -> ThreadStopStatus-mkStopStatus_pre77 n = case n of+-- normal GHC encoding, see [Stop status in GHC-7.8.2]+mkStopStatus :: RawThreadStopStatus -> ThreadStopStatus+mkStopStatus n = case n of 0 -> NoStatus 1 -> HeapOverflow 2 -> StackOverflow@@ -429,11 +434,13 @@ 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 post-7.7 encoding, see [Stop status since GHC-7.7]-mkStopStatus :: RawThreadStopStatus -> ThreadStopStatus-mkStopStatus n = case n of+-- GHC 7.8.2 encoding, see [Stop status in GHC-7.8.2]+mkStopStatus782 :: RawThreadStopStatus -> ThreadStopStatus+mkStopStatus782 n = case n of 0 -> NoStatus 1 -> HeapOverflow 2 -> StackOverflow@@ -442,7 +449,7 @@ 5 -> ThreadFinished 6 -> ForeignCall 7 -> BlockedOnMVar- 8 -> BlockedOnMVarRead -- since GHC-7.8+ 8 -> BlockedOnMVarRead -- in GHC-7.8.2 9 -> BlockedOnBlackHole 10 -> BlockedOnRead 11 -> BlockedOnWrite@@ -456,9 +463,11 @@ 19 -> BlockedOnMsgGlobalise _ -> error "mkStat" -maxThreadStopStatus_pre77, maxThreadStopStatus :: RawThreadStopStatus-maxThreadStopStatus_pre77 = 18 -- see [Stop status since GHC-7.7]-maxThreadStopStatus = 19+maxThreadStopStatusPre77, maxThreadStopStatus782, maxThreadStopStatus + :: RawThreadStopStatus+maxThreadStopStatusPre77 = 18 -- see [Stop status in GHC-7.8.2]+maxThreadStopStatus782 = 19 -- need to distinguish three cases+maxThreadStopStatus = 20 data CapsetType = CapsetCustom@@ -489,11 +498,10 @@ | 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
GHC/RTS/Events.hs view
@@ -1,9 +1,6 @@ {-# 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. -} @@ -53,8 +50,13 @@ import Control.Monad import Data.IntMap (IntMap) import qualified Data.IntMap as M-import Control.Monad.Reader-import Control.Monad.Error+import Control.Monad.Trans.Class+import Control.Monad.Trans.Reader+#if MIN_VERSION_transformers(0, 4, 1)+import Control.Monad.Trans.Except+#else+import Control.Monad.Trans.Error+#endif import qualified Data.ByteString.Lazy as L import Data.Function import Data.List@@ -69,6 +71,13 @@ #define EVENTLOG_CONSTANTS_ONLY #include "EventLogFormat.h" +#if !(MIN_VERSION_transformers(0, 4, 1))+-- use Error instead of Except for tranformers-0.3.0.0+type ExceptT = ErrorT+throwE = throwError+runExceptT = runErrorT+#endif+ ------------------------------------------------------------------------------ -- Binary instances @@ -84,7 +93,7 @@ lift $ G.skip (fromIntegral etExtraLen) ete <- getH :: GetHeader Marker when (ete /= EVENT_ET_END) $- throwError ("Event Type end marker not found.")+ throwE ("Event Type end marker not found.") return (EventType etNum etDesc etSize) where getEtDesc :: Int -> GetHeader [Char]@@ -94,14 +103,14 @@ getHeader = do hdrb <- getH :: GetHeader Marker when (hdrb /= EVENT_HEADER_BEGIN) $- throwError "Header begin marker not found"+ throwE "Header begin marker not found" hetm <- getH :: GetHeader Marker when (hetm /= EVENT_HET_BEGIN) $- throwError "Header Event Type begin marker not found"+ throwE "Header Event Type begin marker not found" ets <- getEventTypes emark <- getH :: GetHeader Marker when (emark /= EVENT_HEADER_END) $- throwError "Header end marker not found"+ throwE "Header end marker not found" return (Header ets) where getEventTypes :: GetHeader [EventType]@@ -115,7 +124,7 @@ | m == EVENT_HET_END -> return [] | otherwise ->- throwError "Malformed list of Event Types in header"+ throwE "Malformed list of Event Types in header" getEvent :: EventParsers -> GetEvents (Maybe Event) getEvent (EventParsers parsers) = do@@ -144,7 +153,7 @@ lbs <- lift . lift $ getLazyByteString ((fromIntegral block_size) - (fromIntegral sz_block_event)) eparsers <- ask- let e_events = runGet (runErrorT $ runReaderT (getEventBlock eparsers) eparsers) lbs+ let e_events = runGet (runExceptT $ runReaderT (getEventBlock eparsers) eparsers) lbs return EventBlock{ end_time=end_time, cap= fromIntegral c, block_events=case e_events of@@ -424,17 +433,38 @@ )) ] --- special thread stop event parsers for GHC-7 before version 7.7.--- see [Stop status since GHC-7.7] in EventTypes.hs+-- 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 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 > maxThreadStopStatus_pre77+ return StopThread{thread=t, status = if s > maxThreadStopStatusPre77 then NoStatus- else mkStopStatus_pre77 s}+ else mkStopStatus s} -- older version of the event, no block info )), @@ -446,20 +476,22 @@ i <- getE :: GetEvents ThreadId return StopThread{thread = t, status = case () of- _ | s > maxThreadStopStatus_pre77+ _ | s > maxThreadStopStatusPre77 -> NoStatus | s == 8 {- XXX yeuch -} -- pre-7.7: 8==BlockedOnBlackhole -> BlockedOnBlackHoleOwnedBy i | otherwise- -> mkStopStatus_pre77 s}+ -> mkStopStatus s} )) ] --- 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+-- 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 -- (thread, status, info) t <- getE s <- getE :: GetEvents RawThreadStopStatus@@ -468,12 +500,12 @@ status = case () of _ | s > maxThreadStopStatus -> NoStatus- | s == 9 {- XXX yeuch -}- -- GHC post-7.7: 9 == BlockedOnBlackHole+ | s == 8 {- XXX yeuch -}+ -- post-7.8.2: 8==BlockedOnBlackhole -> BlockedOnBlackHoleOwnedBy i | otherwise -> mkStopStatus s}- ))+ )) ----------------------- -- GHC 6.12 compat: GHC 6.12 reported the wrong sizes for some events,@@ -501,12 +533,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 > maxThreadStopStatus_pre77+ return StopThread{thread=t, status = if s > maxThreadStopStatusPre77 then NoStatus- 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+ 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 )), (FixedSizeParser EVENT_THREAD_RUNNABLE sz_old_tid (do -- (thread)@@ -731,7 +763,7 @@ getData :: GetEvents Data getData = do db <- getE :: GetEvents Marker- when (db /= EVENT_DATA_BEGIN) $ throwError "Data begin marker not found"+ when (db /= EVENT_DATA_BEGIN) $ lift $ throwE "Data begin marker not found" eparsers <- ask let getEvents :: [Event] -> GetEvents Data@@ -754,7 +786,7 @@ es <- getEventBlock parsers return (e:es) -getEventLog :: ErrorT String Get EventLog+getEventLog :: ExceptT String Get EventLog getEventLog = do header <- getHeader let imap = M.fromList [ (fromIntegral (num t),t) | t <- eventTypes header]@@ -769,17 +801,23 @@ -- make use of threadscope. -} - -- 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.+ -- 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 -- 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 = Nothing == M.lookup EVENT_USER_MARKER imap+ is_pre77 = M.notMember EVENT_USER_MARKER imap+ is_ghc782 = M.member EVENT_USER_MARKER imap &&+ M.notMember EVENT_HACK_BUG_T9003 imap+ stopParsers = if is_pre77 then pre77StopParsers- else [post77StopParser]+ else if is_ghc782 then [ghc782StopParser]+ else [post782StopParser] event_parsers = if is_ghc_6 then standardParsers ++ ghc6Parsers ++@@ -795,7 +833,7 @@ readEventLogFromFile :: FilePath -> IO (Either String EventLog) readEventLogFromFile f = do s <- L.readFile f- return $ runGet (do v <- runErrorT $ getEventLog+ return $ runGet (do v <- runExceptT $ getEventLog m <- isEmpty m `seq` return v) s @@ -1268,11 +1306,8 @@ -- here we assume that ThreadStopStatus fromEnum matches the definitions in -- EventLogFormat.h---- 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+-- 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 putEventSpec (StopThread t s) = do putE t putE $ case s of@@ -1284,19 +1319,19 @@ ThreadFinished -> 5 ForeignCall -> 6 BlockedOnMVar -> 7- 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+ 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 putE $ case s of BlockedOnBlackHoleOwnedBy i -> i _ -> 0
ghc-events-parallel.cabal view
@@ -1,5 +1,5 @@ name: ghc-events-parallel-version: 0.5.0.0+version: 0.5.0.1 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,18 +22,19 @@ maintainer: Eden group <eden@mathematik.uni-marburg.de> 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+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 cabal-version: >= 1.8 extra-source-files: GHC/RTS/EventLogFormat.h, test/*.eventlog+ test/stop.hs --- source-repository head--- type: darcs--- location: james.mathematik.uni-marburg.de:repos/jb/ghc-events-parallel/+source-repository head+ type: git+ location: http://github.com:jberthold/ghc-events-parallel.git library build-depends: base == 4.*,- mtl >= 1.1 && < 3.0,+ transformers >= 0.3 && < 0.6, containers >= 0.2 && < 0.6, binary >= 0.5 && < 0.8, bytestring >= 0.9.0,@@ -51,11 +52,11 @@ executable ghc-events main-is: GhcEvents.hs- build-depends: base, mtl, containers, binary, bytestring, array+ build-depends: base, transformers, containers, binary, bytestring, array extensions: RecordWildCards, NamedFieldPuns, BangPatterns, PatternGuards test-suite test-versions type: exitcode-stdio-1.0 main-is: test/TestVersions.hs- build-depends: base, mtl, containers, binary, bytestring, array+ build-depends: base, transformers, containers, binary, bytestring, array extensions: RecordWildCards, NamedFieldPuns, BangPatterns, PatternGuards
+ test/782stop.eventlog view
binary file changed (absent → 6724 bytes)
+ test/783stop.eventlog view
binary file changed (absent → 6762 bytes)
test/TestVersions.hs view
@@ -23,7 +23,7 @@ , "queens-ghc-7.0.2.eventlog" , "mandelbrot-mmc-2011-06-14.eventlog" , "mdlLogMPI1.eventlog"- , "warshall0-trace-7.8.2#8.eventlog" ]+ , "pre77stop.eventlog", "782stop.eventlog", "783stop.eventlog" ] -- returns True on success testFile :: FilePath -> IO Bool
+ test/pre77stop.eventlog view
binary file changed (absent → 6512 bytes)
+ test/stop.hs view
@@ -0,0 +1,42 @@+-- 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))