ghc-events 0.12.0 → 0.13.0

raw patch · 10 files changed

+213/−102 lines, 10 filesdep ~basebinary-addedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• ghc-events.cabal +6/−3
• src/GHC/RTS/EventParserUtils.hs +30/−9
• src/GHC/RTS/EventTypes.hs +9/−10
• src/GHC/RTS/Events.hs +8/−8
• src/GHC/RTS/Events/Binary.hs +48/−70
• test/TestVersions.hs +1/−2
• test/Utils.hs +2/−0
• test/unicode.eventlog binary
• test/unicode.eventlog.reference +103/−0

@@ -1,5 +1,11 @@ # Change Log +## 0.13.0 - 2020-04-04++* Fix broken UTF-8 decoding ([#55](https://github.com/haskell/ghc-events/pull/55))+  * This is a breaking change. Most of the String fields in EventInfo have been replaced with Texts.+* Support GHC 8.10.1+ ## 0.12.0 - 2019-12-02  * Add support for EVENT_USER_BINARY_MSG ([#54](https://github.com/haskell/ghc-events/pull/54))

@@ -1,5 +1,5 @@ name:             ghc-events-version:          0.12.0+version:          0.13.0 synopsis:         Library and tool for parsing .eventlog files from GHC description:      Parses .eventlog files emitted by GHC 6.12.1 and later.                   Includes the ghc-events tool permitting, in particular,@@ -26,7 +26,8 @@                   GHC == 8.2.2                   GHC == 8.4.4                   GHC == 8.6.5-                  GHC == 8.8.1+                  GHC == 8.8.3+                  GHC == 8.10.1 cabal-version:    >= 1.8 extra-source-files: include/EventLogFormat.h                     test/queens-ghc-6.12.1.eventlog@@ -65,6 +66,8 @@                     test/time-prof.eventlog.reference                     test/trace-binary-event.eventlog                     test/trace-binary-event.eventlog.reference+                    test/unicode.eventlog+                    test/unicode.eventlog.reference                     test/Utils.hs                     test/stop.hs                     README.md@@ -75,7 +78,7 @@   location: git@github.com:haskell/ghc-events.git  library-  build-depends:    base       >= 4.7 && < 4.14,+  build-depends:    base       >= 4.7 && < 4.15,                     containers >= 0.5 && < 0.7,                     binary     >= 0.7 && < 0.11,                     bytestring >= 0.10.4,

@@ -5,21 +5,26 @@         EventParsers(..),          getString,+        getText,+        getTextNul,         mkEventTypeParsers,         simpleEvent,         skip,     ) where -import Control.Monad import Data.Array import Data.Binary import Data.Binary.Get ()-import qualified Data.Binary.Get as G import Data.Binary.Put ()-import Data.Char import Data.IntMap (IntMap)-import qualified Data.IntMap as M import Data.List+import Data.Text (Text)+import qualified Data.Binary.Get as G+import qualified Data.ByteString.Char8 as B8+import qualified Data.IntMap as M+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TLE  #define EVENTLOG_CONSTANTS_ONLY #include "EventLogFormat.h"@@ -28,13 +33,29 @@  newtype EventParsers = EventParsers (Array Int (Get EventInfo)) -nBytes :: Integral a => a -> Get [Word8]-nBytes n = replicateM (fromIntegral n) get- getString :: Integral a => a -> Get String getString len = do-    bytes <- nBytes len-    return $ map (chr . fromIntegral) bytes+  bytes <- G.getByteString $ fromIntegral len+  return $! B8.unpack bytes++-- | Decode a given length of bytes as a 'Text'+getText+  :: Integral a+  => a -- ^ Number of bytes to decode+  -> Get Text+getText len = do+  bytes <- G.getByteString $ fromIntegral len+  case TE.decodeUtf8' bytes of+    Left err -> fail $ show err+    Right text -> return text++-- | Decode a null-terminated string as a 'Text'+getTextNul :: Get Text+getTextNul = do+  chunks <- G.getLazyByteStringNul+  case TLE.decodeUtf8' chunks of+    Left err -> fail $ show err+    Right text -> return $ TL.toStrict text  skip :: Integral a => a -> Get () skip n = G.skip (fromIntegral n)

@@ -11,10 +11,9 @@ -- EventType. type EventTypeNum = Word16 type EventTypeDescLen = Word32-type EventTypeDesc = String+type EventTypeDesc = Text type EventTypeSize = Word16 -- Event.-type EventDescription = String type Timestamp = Word64 type ThreadId = Word32 type CapNo = Word16@@ -173,7 +172,7 @@                          otherCap :: {-# UNPACK #-}!Int                        }   | ThreadLabel        { thread :: {-# UNPACK #-}!ThreadId,-                         threadlabel :: String+                         threadlabel :: !Text                        }    -- par sparks@@ -265,13 +264,13 @@    -- program/process info   | RtsIdentifier      { capset :: {-# UNPACK #-}!Capset-                       , rtsident :: String+                       , rtsident :: !Text                        }   | ProgramArgs        { capset :: {-# UNPACK #-}!Capset-                       , args   :: [String]+                       , args   :: [Text]                        }   | ProgramEnv         { capset :: {-# UNPACK #-}!Capset-                       , env    :: [String]+                       , env    :: [Text]                        }   | OsProcessPid       { capset :: {-# UNPACK #-}!Capset                        , pid    :: {-# UNPACK #-}!PID@@ -285,9 +284,9 @@                        }    -- messages-  | Message            { msg :: String }-  | UserMessage        { msg :: String }-  | UserMarker         { markername :: String }+  | Message            { msg :: !Text }+  | UserMessage        { msg :: !Text }+  | UserMarker         { markername :: !Text }    -- Events emitted by a parallel RTS    -- Program /process info (tools might prefer newer variants above)@@ -371,7 +370,7 @@    -- perf events   | PerfName           { perfNum :: {-# UNPACK #-}!PerfEventTypeNum-                       , name    :: String+                       , name    :: !Text                        }   | PerfCounter        { perfNum :: {-# UNPACK #-}!PerfEventTypeNum                        , tid     :: {-# UNPACK #-}!KernelThreadId

@@ -268,7 +268,7 @@           <> " on cap " <> TB.decimal otherCap         ThreadLabel thread label ->           "thread " <> TB.decimal thread-          <> " has label \"" <> TB.fromString label <> "\""+          <> " has label \"" <> TB.fromText label <> "\""         RequestSeqGC ->           "requesting sequential GC"         RequestParGC ->@@ -320,11 +320,11 @@         CapEnable{cap} ->           "enabled cap " <> TB.decimal cap         Message msg ->-          TB.fromString msg+          TB.fromText msg         UserMessage msg ->-          TB.fromString msg+          TB.fromText msg         UserMarker markername ->-          "marker: " <> TB.fromString markername+          "marker: " <> TB.fromText markername         CapsetCreate cs ct ->           "created capset " <> TB.decimal cs           <> " of type " <> TB.fromString (show ct)@@ -344,7 +344,7 @@           <> TB.decimal nsec <> "ns (unix epoch)"         RtsIdentifier cs i ->           "capset " <> TB.decimal cs-          <> ": RTS version \"" <> TB.fromString i <> "\""+          <> ": RTS version \"" <> TB.fromText i <> "\""         ProgramArgs cs args ->           "capset " <> TB.decimal cs           <> ": args: " <> TB.fromString (show args)@@ -434,7 +434,7 @@           "About to call the program entry point"         PerfName{perfNum, name} ->           "perf event " <> TB.decimal perfNum-          <> " named \"" <> TB.fromString name <> "\""+          <> " named \"" <> TB.fromText name <> "\""         PerfCounter{perfNum, tid, period} ->           "perf event counter " <> TB.decimal perfNum           <> " incremented by " <> TB.decimal (period + 1)@@ -571,7 +571,7 @@ buildEventType :: EventType -> TB.Builder buildEventType (EventType num dsc msz) =   TB.decimal num <> ": "-  <> TB.fromString dsc <> " (size "+  <> TB.fromText dsc <> " (size "   <> maybe "variable" TB.decimal msz <> ")"  -- | Pretty prints an 'Event', with clean handling for 'UnknownEvent'@@ -585,7 +585,7 @@   <> maybe "" (\c -> "cap " <> TB.decimal c <> ": ") evCap   <> case evSpec of     UnknownEvent{ ref=ref } ->-      maybe "" (TB.fromString . desc) $ IM.lookup (fromIntegral ref) imap+      maybe "" (TB.fromText . desc) $ IM.lookup (fromIntegral ref) imap     _ -> buildEventInfo evSpec  buildEvent' :: Event -> TB.Builder

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} module GHC.RTS.Events.Binary   ( -- * Readers     getHeader@@ -29,6 +30,7 @@   ) where import Control.Exception (assert) import Control.Monad+import Data.List (intersperse) import Data.Maybe import Prelude hiding (gcd, rem, id) @@ -39,8 +41,6 @@ import qualified Data.ByteString as B import qualified Data.Text as T import qualified Data.Text.Encoding as TE-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TLE import qualified Data.Vector.Unboxed as VU  import GHC.RTS.EventTypes@@ -56,16 +56,13 @@            let etSize = if size == 0xffff then Nothing else Just size            -- 0xffff indicates variable-sized event            etDescLen <- get :: Get EventTypeDescLen-           etDesc <- getEtDesc (fromIntegral etDescLen)+           etDesc <- getText etDescLen            etExtraLen <- get :: Get Word32            G.skip (fromIntegral etExtraLen)            ete <- get :: Get Marker            when (ete /= EVENT_ET_END) $               fail "Event Type end marker not found."            return (EventType etNum etDesc etSize)-           where-             getEtDesc :: Int -> Get [Char]-             getEtDesc s = replicateM s (get :: Get Char)  getHeader :: Get Header getHeader = do@@ -270,37 +267,39 @@   (VariableSizeParser EVENT_LOG_MSG (do -- (msg)       num <- get :: Get Word16-      string <- getString num+      string <- getText num       return Message{ msg = string }    )),  (VariableSizeParser EVENT_USER_MSG (do -- (msg)       num <- get :: Get Word16-      string <- getString num+      string <- getText num       return UserMessage{ msg = string }    )),     (VariableSizeParser EVENT_USER_MARKER (do -- (markername)       num <- get :: Get Word16-      string <- getString num+      string <- getText num       return UserMarker{ markername = string }    )),  (VariableSizeParser EVENT_PROGRAM_ARGS (do -- (capset, [arg])       num <- get :: Get Word16       cs <- get-      string <- getString (num - sz_capset)-      return ProgramArgs{ capset = cs-                        , args = splitNull string }+      string <- getText (num - sz_capset)+      return ProgramArgs+        { capset = cs+        , args = T.splitOn "\0" $ T.dropWhileEnd (== '\0') string }    )),  (VariableSizeParser EVENT_PROGRAM_ENV (do -- (capset, [arg])       num <- get :: Get Word16       cs <- get-      string <- getString (num - sz_capset)-      return ProgramEnv{ capset = cs-                       , env = splitNull string }+      string <- getText (num - sz_capset)+      return ProgramEnv+        { capset = cs+        , env = T.splitOn "\0" $ T.dropWhileEnd (== '\0') string }    )),  (VariableSizeParser EVENT_RTS_IDENTIFIER (do -- (capset, str)       num <- get :: Get Word16       cs <- get-      string <- getString (num - sz_capset)+      string <- getText (num - sz_capset)       return RtsIdentifier{ capset = cs                           , rtsident = string }    )),@@ -315,7 +314,7 @@  (VariableSizeParser EVENT_THREAD_LABEL (do -- (thread, str)       num <- get :: Get Word16       tid <- get-      str <- getString (num - sz_tid)+      str <- getText (num - sz_tid)       return ThreadLabel{ thread      = tid                         , threadlabel = str }     ))@@ -727,7 +726,7 @@  (VariableSizeParser EVENT_PERF_NAME (do -- (perf_num, name)       num     <- get :: Get Word16       perfNum <- get-      name    <- getString (num - sz_perf_num)+      name    <- getText (num - sz_perf_num)       return PerfName{perfNum, name}    )), @@ -752,13 +751,13 @@     heapProfId <- get     heapProfSamplingPeriod <- get     heapProfBreakdown <- get-    heapProfModuleFilter <- getText-    heapProfClosureDescrFilter <- getText-    heapProfTypeDescrFilter <- getText-    heapProfCostCentreFilter <- getText-    heapProfCostCentreStackFilter <- getText-    heapProfRetainerFilter <- getText-    heapProfBiographyFilter <- getText+    heapProfModuleFilter <- getTextNul+    heapProfClosureDescrFilter <- getTextNul+    heapProfTypeDescrFilter <- getTextNul+    heapProfCostCentreFilter <- getTextNul+    heapProfCostCentreStackFilter <- getTextNul+    heapProfRetainerFilter <- getTextNul+    heapProfBiographyFilter <- getTextNul     assert       (fromIntegral payloadLen == sum         [ 1 -- heapProfId@@ -777,9 +776,9 @@   , VariableSizeParser EVENT_HEAP_PROF_COST_CENTRE $ do     payloadLen <- get :: Get Word16     heapProfCostCentreId <- get-    heapProfLabel <- getText-    heapProfModule <- getText-    heapProfSrcLoc <- getText+    heapProfLabel <- getTextNul+    heapProfModule <- getTextNul+    heapProfSrcLoc <- getTextNul     heapProfFlags <- get     assert       (fromIntegral payloadLen == sum@@ -820,7 +819,7 @@     payloadLen <- get :: Get Word16     heapProfId <- get     heapProfResidency <- get-    heapProfLabel <- getText+    heapProfLabel <- getTextNul     assert       (fromIntegral payloadLen == sum         [ 1 -- heapProfId@@ -879,9 +878,6 @@ putMarker :: Word32 -> PutM () putMarker = putE -putEStr :: String -> PutM ()-putEStr = mapM_ putE- putEventLog :: EventLog -> PutM () putEventLog (EventLog hdr es) = do     putHeader hdr@@ -899,8 +895,8 @@         putMarker EVENT_ET_BEGIN         putType n         putE $ fromMaybe 0xffff msz-        putE (fromIntegral $ length d :: EventTypeDescLen)-        mapM_ put d+        putE (fromIntegral $ T.length d :: EventTypeDescLen)+        putE d         -- the event type header allows for extra data, which we don't use:         putE (0 :: Word32)         putMarker EVENT_ET_END@@ -1111,9 +1107,9 @@     putCap c  putEventSpec (ThreadLabel t l) = do-    putE (fromIntegral (length l) + sz_tid :: Word16)+    putE (fromIntegral (T.length l) + sz_tid :: Word16)     putE t-    putEStr l+    putE l  putEventSpec Shutdown =     return ()@@ -1220,21 +1216,21 @@     putCap cp  putEventSpec (RtsIdentifier cs rts) = do-    putE (fromIntegral (length rts) + sz_capset :: Word16)+    putE (fromIntegral (T.length rts) + sz_capset :: Word16)     putE cs-    putEStr rts+    putE rts  putEventSpec (ProgramArgs cs as) = do-    let as' = unsep as-    putE (fromIntegral (length as') + sz_capset :: Word16)+    let sz_args = sum $ map ((+ 1) {- for \0 -} . T.length) as+    putE (fromIntegral sz_args + sz_capset :: Word16)     putE cs-    mapM_ putE as'+    mapM_ putE (intersperse "\0" as)  putEventSpec (ProgramEnv cs es) = do-    let es' = unsep es-    putE (fromIntegral (length es') + sz_capset :: Word16)+    let sz_env = sum $ map ((+ 1) {- for \0 -} . T.length) es+    putE (fromIntegral sz_env + sz_capset :: Word16)     putE cs-    mapM_ putE es'+    mapM_ putE $ intersperse "\0" es  putEventSpec (OsProcessPid cs pid) = do     putE cs@@ -1250,16 +1246,16 @@     putE nsec  putEventSpec (Message s) = do-    putE (fromIntegral (length s) :: Word16)-    mapM_ putE s+    putE (fromIntegral (T.length s) :: Word16)+    putE s  putEventSpec (UserMessage s) = do-    putE (fromIntegral (length s) :: Word16)-    mapM_ putE s+    putE (fromIntegral (T.length s) :: Word16)+    putE s  putEventSpec (UserMarker s) = do-    putE (fromIntegral (length s) :: Word16)-    mapM_ putE s+    putE (fromIntegral (T.length s) :: Word16)+    putE s  putEventSpec (UnknownEvent {}) = error "putEventSpec UnknownEvent" @@ -1363,9 +1359,9 @@ putEventSpec MerCallingMain = return ()  putEventSpec PerfName{..} = do-    putE (fromIntegral (length name) + sz_perf_num :: Word16)+    putE (fromIntegral (T.length name) + sz_perf_num :: Word16)     putE perfNum-    mapM_ putE name+    putE name  putEventSpec PerfCounter{..} = do     putE perfNum@@ -1431,21 +1427,3 @@ putEventSpec UserBinaryMessage {..} = do     putE (fromIntegral (B.length payload) :: Word16)     putByteString payload---- [] == []--- [x] == x\0--- [x, y, z] == x\0y\0-unsep :: [String] -> String-unsep = concatMap (++"\0") -- not the most efficient, but should be ok--splitNull :: String -> [String]-splitNull [] = []-splitNull xs = case span (/= '\0') xs of-                (x, xs') -> x : splitNull (drop 1 xs')--getText :: Get T.Text-getText = do-  chunks <- G.getLazyByteStringNul-  case TLE.decodeUtf8' chunks of-    Left err -> fail $ show err-    Right text -> return $ TL.toStrict text

@@ -17,10 +17,8 @@ import System.Exit (exitFailure)  import GHC.RTS.Events-import GHC.RTS.Events.Incremental import Utils (files, diffLines) - testFile :: FilePath -> IO Bool testFile f = do     e <- readEventLogFromFile f@@ -35,6 +33,7 @@                     else do putStrLn $ diffLines oldlog newlog                             oops "pretty print output does not match" +main :: IO () main = do     successes <- mapM testFile files     if and successes

@@ -17,10 +17,12 @@     , "biographical-samples.eventlog"     , "time-prof.eventlog"     , "trace-binary-event.eventlog"+    , "unicode.eventlog"     ]   -- Code to help print the differences between a working test and a failing test.+diffLines :: String -> String -> String diffLines o n = diff 1 (lines o) (lines n)  diff :: Int -> [String] -> [String] -> String

binary file changed (absent → 2959 bytes)

@@ -0,0 +1,103 @@+Event Types:+0: Create thread (size 4)+1: Run thread (size 4)+2: Stop thread (size 10)+3: Thread runnable (size 4)+4: Migrate thread (size 6)+8: Wakeup thread (size 6)+9: Starting GC (size 0)+10: Finished GC (size 0)+11: Request sequential GC (size 0)+12: Request parallel GC (size 0)+15: Create spark thread (size 4)+16: Log message (size variable)+18: Block marker (size 14)+19: User message (size variable)+20: GC idle (size 0)+21: GC working (size 0)+22: GC done (size 0)+25: Create capability set (size 6)+26: Delete capability set (size 4)+27: Add capability to capability set (size 6)+28: Remove capability from capability set (size 6)+29: RTS name and version (size variable)+30: Program arguments (size variable)+31: Program environment variables (size variable)+32: Process ID (size 8)+33: Parent process ID (size 8)+34: Spark counters (size 56)+35: Spark create (size 0)+36: Spark dud (size 0)+37: Spark overflow (size 0)+38: Spark run (size 0)+39: Spark steal (size 2)+40: Spark fizzle (size 0)+41: Spark GC (size 0)+43: Wall clock time (size 16)+44: Thread label (size variable)+45: Create capability (size 2)+46: Delete capability (size 2)+47: Disable capability (size 2)+48: Enable capability (size 2)+49: Total heap mem ever allocated (size 12)+50: Current heap size (size 12)+51: Current heap live data (size 12)+52: Heap static parameters (size 38)+53: GC statistics (size 58)+54: Synchronise stop-the-world GC (size 0)+55: Task create (size 18)+56: Task migrate (size 12)+57: Task delete (size 8)+58: User marker (size variable)+59: Empty event for bug #9003 (size 0)+160: Start of heap profile (size variable)+161: Cost center definition (size variable)+162: Start of heap profile sample (size 8)+163: Heap profile cost-centre sample (size variable)+164: Heap profile string sample (size variable)+181: User binary message (size variable)++Events:+199023: created capset 0 of type CapsetOsProcess+199124: created capset 1 of type CapsetClockDomain+199641: created cap 0+199705: assigned cap 0 to capset 0+199757: assigned cap 0 to capset 1+205412: capset 1: wall clock time 1576909771s 759746000ns (unix epoch)+205582: capset 0: pid 85701+211303: capset 0: parent pid 89650+215676: capset 0: RTS version "GHC-8.8.1 rts_l"+218893: capset 0: args: ["./unicode","+RTS","-lu"]+3684143: heap stats for heap capset 0: generations 2, 0 bytes max heap size, 1048576 bytes alloc area size, 1048576 bytes mblock size, 4096 bytes block size+3790819: task 0x7fdd0ee00460 created on cap 0 with OS kernel thread 4628350+3791820: cap 0: creating thread 1+3801611: cap 0: running thread 1+3851573: cap 0: こんにちは+3852417: cap 0: stopping thread 1 (thread finished)+3853023: task 0x7fdd0ee00460 deleted+3854106: task 0x7fdd0ee00460 created on cap 0 with OS kernel thread 4628350+3854259: cap 0: creating thread 2+3854458: cap 0: running thread 2+3979871: cap 0: stopping thread 2 (thread finished)+3980191: task 0x7fdd0ee00460 deleted+3983762: cap 0: starting GC+3988279: cap 0: GC working+4151142: cap 0: GC idle+4151260: cap 0: GC done+4152813: cap 0: GC idle+4152861: cap 0: GC done+4153142: cap 0: GC idle+4153184: cap 0: GC done+4155396: cap 0: allocated on heap capset 0: 42872 total bytes till now+4156194: cap 0: finished GC+4156678: cap 0: all caps stopped for GC+4156798: cap 0: GC stats for heap capset 0: generation 1, 3216 bytes copied, 21256 bytes slop, 950272 bytes fragmentation, 1 par threads, 0 bytes max par copied, 3216 bytes total par copied, 0 bytes balanced par copied+4157147: cap 0: live data in heap capset 0: 36088 bytes+4157226: cap 0: size of heap capset 0: 2097152 bytes+14563387: cap 0: allocated on heap capset 0: 42872 total bytes till now+14566187: removed cap 0 from capset 0+14566352: removed cap 0 from capset 1+14566478: deleted cap 0+14566778: deleted capset 0+14566855: deleted capset 1+