Hello,
I'm looking for a bit of help (ok, a lot) the speed up my program
which I use to build a calltree out of an annotated program execution
trace. To give you an idea about the sluggishness at the moment, for
a trace containing 70MB, it has been running for about 10 hours
straight (AMD Athlon XP (Barton) 2600+).
The trace contains lines made up of a number of fields:
C 4 1000 100
C 4 1001 1000200
R 4 1001 1003045
R 4 1000 1003060
C indicates a function entrypoint (call), R indicates a function
exitpoint (return). The second field indicates which thread is
executing the function, the third field denotes the function id, the
last field contains a performance counter value. As you can see,
numbering each line with a pre-order and a post-order number yields a
list that can be transformed easily into a tree, which can then be
manipulated. The first goal is to build the tree. This is done in the
following code:
data ParserState = ParserState { methodStack :: !ThreadMap
, methodQueue :: !ThreadMap
, pre :: !Integer
, post:: !Integer
, methodMap :: !MethodMap
, currentThread :: !Integer
} deriving (Show)
initialParserState :: ParserState
initialParserState = ParserState e e 0 0 e 0
where e = M.empty :: Map Integer a
readInteger :: B.ByteString - Integer
readInteger = fromIntegral . fst . fromJust . B.readInt
parseTraceMonadic :: [B.ByteString] - ParserState
parseTraceMonadic ss = state { methodQueue = M.map reverse
(methodQueue state) }
where state = execState (mapM_ (\x - modify (updateState x)
get = (`seq` return ())) ss) initialParserState
updateState :: B.ByteString - ParserState - ParserState
updateState s state = case (B.unpack $ head fields) of
M - updateStateMethod fields state
E - updateStateException fields state
C - updateStateEntry fields state
R - updateStateExit fields state
where fields = B.splitWith (== ' ') s
updateStateMethod :: [B.ByteString] - ParserState - ParserState
updateStateMethod (_:methodId:methodName:_) state = state { methodMap
= M.insert (readInteger methodId) methodName (methodMap state) }
updateStateException :: [B.ByteString] - ParserState - ParserState
updateStateException _ state = state
updateStateEntry :: [B.ByteString] - ParserState - ParserState
updateStateEntry (_:ss) state = {-Debug.Trace.trace (before: ++
(show state) ++ \nafter: ++ (show newstate)) $-} newstate
where newstate = state { methodStack = updateMap thread
(methodStack state) (\x y - Just (x:y)) (pre state, 0, method)
, pre = ((+1) $! (pre state))
}
method = mkMethod (Prelude.map B.unpack ss)
thread = Method.thread method
updateStateExit :: [B.ByteString] - ParserState - ParserState
updateStateExit (_:ss) state = {-Debug.Trace.trace (before: ++
(show state)) $-} case updateMethod m (Prelude.map B.unpack ss) of
Just um - state { methodStack =
M.update (\x - Just (tail x)) thread (methodStack state)
, methodQueue =
updateMap thread (methodQueue state) (\x y - Just (x:y)) (pre_, post
state, um)
, post = ((+1)
$! (post state))
}
Nothing - error $ Top of the
stack is mismatching! Expected ++ (show m) ++ yet got ++ (show
ss) ++ \n ++ (show state)
where method = mkMethod (Prelude.map B.unpack ss)
thread = Method.thread method
(pre_, _, m) = case M.lookup thread (methodStack state) of
Just stack - head stack
Nothing- error $ Method stack has
not been found for thread ++ (show thread) ++ - fields: ++
(show ss)
updateMap key map f value = case M.member key map of
True - M.update (f value) key map
False - M.insert key [value] map
As you can see, the state is updated for each entry, a stack being
maintained with methods we've seen up to now, and a list with methods
that have received both pre and post order numbers, and of which both
the entry and exit point have been parsed. I am using a ByteString,
because using a plain String is causing the program to grab far too
much heap.
The mkMethod yields a Method like this:
data Method = Method { mid :: Integer
, thread :: Integer
, instruction_entry :: Integer
, instruction_exit :: Integer
} deriving (Eq, Show)
eM = Method 0 0 0 0
mkMethod :: [String] - Method
mkMethod s = let [_thread, _id, _entry] = take 3 $
