Skip to content

Commit

Permalink
Merge pull request #22 from maoe/refactor
Browse files Browse the repository at this point in the history
Refactor the incremental parser
  • Loading branch information
Mitsutoshi Aoe authored Apr 9, 2017
2 parents 54ecc91 + 53f2872 commit 58aefed
Show file tree
Hide file tree
Showing 18 changed files with 5,596 additions and 5,672 deletions.
12 changes: 3 additions & 9 deletions GhcEvents.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
module Main where

import GHC.RTS.Events
import GHC.RTS.EventsIncremental
import GHC.RTS.Events.Incremental
import GHC.RTS.Events.Merge
import GHC.RTS.Events.Analysis
import GHC.RTS.Events.Analysis.SparkThread
Expand All @@ -22,15 +22,9 @@ main = getArgs >>= command
command :: [String] -> IO ()
command ["--help"] = putStr usage

command ["inc", file] = do
h <- openBinaryFile file ReadMode
eh <- ehOpen h 4096
printEventsIncremental eh False
command ["inc", file] = printEventsIncremental False file

command ["inc", "force", file] = do
h <- openBinaryFile file ReadMode
eh <- ehOpen h 1024
printEventsIncremental eh True
command ["inc", "force", file] = printEventsIncremental True file

command ["show", file] = do
evtLog <- readLogOrDie file
Expand Down
4 changes: 3 additions & 1 deletion ghc-events.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -52,18 +52,20 @@ library
bytestring >= 0.10.4,
array >= 0.2 && < 0.6
exposed-modules: GHC.RTS.Events,
GHC.RTS.EventsIncremental
GHC.RTS.Events.Incremental
GHC.RTS.Events.Merge
GHC.RTS.Events.Analysis
GHC.RTS.Events.Analysis.Capability
GHC.RTS.Events.Analysis.SparkThread
GHC.RTS.Events.Analysis.Thread
other-modules: GHC.RTS.EventParserUtils,
GHC.RTS.EventTypes
GHC.RTS.Events.Binary
hs-source-dirs: src
include-dirs: include
extensions: RecordWildCards, NamedFieldPuns, BangPatterns, PatternGuards
other-extensions: FlexibleContexts, CPP
ghc-options: -Wall

executable ghc-events
main-is: GhcEvents.hs
Expand Down
6 changes: 2 additions & 4 deletions src/GHC/RTS/EventParserUtils.hs
Original file line number Diff line number Diff line change
@@ -1,7 +1,5 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}

module GHC.RTS.EventParserUtils (
EventParser(..),
EventParsers(..),
Expand Down Expand Up @@ -46,7 +44,7 @@ skip n = G.skip (fromIntegral n)
--

--
-- Event parser data. Parsers are either fixed or vairable size.
-- | Event parser data. Parsers are either fixed or vairable size.
--
data EventParser a
= FixedSizeParser {
Expand Down Expand Up @@ -168,7 +166,7 @@ padParser size (FixedSizeParser t orig_size orig_p) = FixedSizeParser t size p

makeParserMap :: [EventParser a] -> IntMap [EventParser a]
makeParserMap = foldl buildParserMap M.empty
where buildParserMap map' parser =
where buildParserMap map' parser =
M.alter (addParser parser) (getType parser) map'
addParser p Nothing = Just [p]
addParser p (Just ps) = Just (p:ps)
Expand Down
18 changes: 12 additions & 6 deletions src/GHC/RTS/EventTypes.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,5 @@
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}

module GHC.RTS.EventTypes where
import Control.Monad

import Data.Binary

Expand Down Expand Up @@ -130,11 +129,11 @@ data Event =

{-# DEPRECATED time "The field is now called evTime" #-}
time :: Event -> Timestamp
time = evTime
time = evTime

{-# DEPRECATED spec "The field is now called evSpec" #-}
spec :: Event -> EventInfo
spec = evSpec
spec = evSpec

data EventInfo

Expand All @@ -158,7 +157,7 @@ data EventInfo
| RunThread { thread :: {-# UNPACK #-}!ThreadId
}
| StopThread { thread :: {-# UNPACK #-}!ThreadId,
status :: ThreadStopStatus
status :: !ThreadStopStatus
}
| ThreadRunnable { thread :: {-# UNPACK #-}!ThreadId
}
Expand Down Expand Up @@ -471,7 +470,7 @@ mkStopStatus782 n = case n of
19 -> BlockedOnMsgGlobalise
_ -> error "mkStat"

maxThreadStopStatusPre77, maxThreadStopStatus782, maxThreadStopStatus
maxThreadStopStatusPre77, maxThreadStopStatus782, maxThreadStopStatus
:: RawThreadStopStatus
maxThreadStopStatusPre77 = 18 -- see [Stop status in GHC-7.8.2]
maxThreadStopStatus782 = 19 -- need to distinguish three cases
Expand Down Expand Up @@ -520,3 +519,10 @@ toMsgTag = toEnum . fromIntegral . (\n -> n - offset)

fromMsgTag :: MessageTag -> RawMsgTag
fromMsgTag = (+ offset) . fromIntegral . fromEnum

-- Checks if the capability is not -1 (which indicates a global eventblock), so
-- has no associated capability
mkCap :: Int -> Maybe Int
mkCap cap = do
guard $ fromIntegral cap /= (-1 :: Word16)
return cap
Loading

0 comments on commit 58aefed

Please sign in to comment.