1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
|
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
module GHC.RTS.EventParserUtils (
EventParser(..),
EventParsers(..),
GetEvents,
GetHeader,
getE,
getH,
getString,
mkEventTypeParsers,
simpleEvent,
skip,
) where
import Control.Monad
import Control.Monad.Error
import Control.Monad.Reader
import Data.Array
import Data.Binary
import Data.Binary.Get hiding (skip)
import qualified Data.Binary.Get as G
import Data.Binary.Put
import Data.Char
import Data.Function
import Data.IntMap (IntMap)
import qualified Data.IntMap as M
import Data.List
#define EVENTLOG_CONSTANTS_ONLY
#include "EventLogFormat.h"
import GHC.RTS.EventTypes
-- reader/Get monad that passes around the event types
type GetEvents a = ReaderT EventParsers (ErrorT String Get) a
newtype EventParsers = EventParsers (Array Int (GetEvents EventInfo))
type GetHeader a = ErrorT String Get a
getH :: Binary a => GetHeader a
getH = lift get
getE :: Binary a => GetEvents a
getE = lift $ lift get
nBytes :: Integral a => a -> GetEvents [Word8]
nBytes n = replicateM (fromIntegral n) getE
getString :: Integral a => a -> GetEvents String
getString len = do
bytes <- nBytes len
return $ map (chr . fromIntegral) bytes
skip :: Integral a => a -> GetEvents ()
skip n = lift $ lift $ G.skip (fromIntegral n)
--
-- Code to build the event parser table.
--
--
-- Event parser data. Parsers are either fixed or vairable size.
--
data EventParser a
= FixedSizeParser {
fsp_type :: Int,
fsp_size :: EventTypeSize,
fsp_parser :: GetEvents a
}
| VariableSizeParser {
vsp_type :: Int,
vsp_parser :: GetEvents a
}
get_parser (FixedSizeParser _ _ p) = p
get_parser (VariableSizeParser _ p) = p
get_type (FixedSizeParser t _ _) = t
get_type (VariableSizeParser t _) = t
isFixedSize (FixedSizeParser {}) = True
isFixedSize (VariableSizeParser {}) = False
simpleEvent :: Int -> a -> EventParser a
simpleEvent t p = FixedSizeParser t 0 (return p)
-- Our event log format allows new fields to be added to events over
-- time. This means that our parser must be able to handle:
--
-- * old versions of an event, with fewer fields than expected,
-- * new versions of an event, with more fields than expected
--
-- The event log file declares the size for each event type, so we can
-- select the correct parser for the event type based on its size. We
-- do this once after parsing the header: given the EventTypes, we build
-- an array of event parsers indexed by event type.
--
-- For each event type, we may have multiple parsers for different
-- versions of the event, indexed by size. These are listed in the
-- eventTypeParsers list below. For the given log file we select the
-- parser for the most recent version (largest size less than the size
-- declared in the header). If this is a newer version of the event
-- than we understand, there may be extra bytes that we have to read
-- and discard in the parser for this event type.
--
-- Summary:
-- if size is smaller that we expect:
-- parse the earier version, or ignore the event
-- if size is just right:
-- parse it
-- if size is too big:
-- parse the bits we understand and discard the rest
mkEventTypeParsers :: IntMap EventType
-> [EventParser EventInfo]
-> Array Int (GetEvents EventInfo)
mkEventTypeParsers etypes event_parsers
= accumArray (flip const) undefined (0, max_event_num)
[ (num, parser num) | num <- [0..max_event_num] ]
--([ (num, undeclared_etype num) | num <- [0..max_event_num] ] ++
-- [ (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)
parser_map = makeParserMap event_parsers
parser num =
-- Get the event's size from the header,
-- the first Maybe describes whether the event was declared in the header.
-- the second Maybe selects between variable and fixed size events.
let mb_mb_et_size = do et <- M.lookup num etypes
return $ size et
-- Find a parser for the event with the given size.
maybe_parser mb_et_size = do possible <- M.lookup num parser_map
best_parser <- case mb_et_size of
Nothing -> getVariableParser possible
Just et_size -> getFixedParser et_size possible
return $ get_parser best_parser
in case mb_mb_et_size of
-- This event is declared in the log file's header
Just mb_et_size -> case maybe_parser mb_et_size of
-- And we have a valid parser for it.
Just p -> p
-- But we don't have a valid parser for it.
Nothing -> noEventTypeParser num mb_et_size
-- This event is not declared in the log file's header
Nothing -> undeclared_etype num
-- Find the first variable length parser.
getVariableParser :: [EventParser a] -> Maybe (EventParser a)
getVariableParser [] = Nothing
getVariableParser (x:xs) = case x of
FixedSizeParser _ _ _ -> getVariableParser xs
VariableSizeParser _ _ -> Just x
-- Find the best fixed size parser, that is to say, the parser for the largest
-- event that does not exceed the size of the event as declared in the log
-- file's header.
getFixedParser :: EventTypeSize -> [EventParser a] -> Maybe (EventParser a)
getFixedParser size parsers =
do parser <- ((filter isFixedSize) `pipe`
(filter (\x -> (fsp_size x) <= size)) `pipe`
(sortBy descending_size) `pipe`
maybe_head) parsers
return $ padParser size parser
where pipe f g = g . f
descending_size (FixedSizeParser _ s1 _) (FixedSizeParser _ s2 _) =
compare s2 s1
descending_size _ _ = undefined
maybe_head [] = Nothing
maybe_head (x:xs) = Just x
padParser :: EventTypeSize -> (EventParser a) -> (EventParser a)
padParser size (VariableSizeParser t p) = VariableSizeParser t p
padParser size (FixedSizeParser t orig_size orig_p) = FixedSizeParser t size p
where p = if (size == orig_size)
then orig_p
else do d <- orig_p
skip (size - orig_size)
return d
makeParserMap :: [EventParser a] -> IntMap [EventParser a]
makeParserMap = foldl buildParserMap M.empty
where buildParserMap map parser = M.alter (addParser parser) (get_type parser) map
addParser p Nothing = Just [p]
addParser p (Just ps) = Just (p:ps)
noEventTypeParser :: Int -> Maybe EventTypeSize
-> GetEvents EventInfo
noEventTypeParser num mb_size = do
bytes <- case mb_size of
Just n -> return n
Nothing -> getE :: GetEvents Word16
skip bytes
return UnknownEvent{ ref = fromIntegral num }
|
