-----------------------------------------------------------------------------
--- $Id: Slurp.hs,v 1.3 2002/02/28 18:50:42 keithw Exp $
-
--- (c) Simon Marlow 1997-1999
+--
+-- (c) Simon Marlow 1997-2005
+--
-----------------------------------------------------------------------------
module Slurp (Status(..), Results(..), ResultTable(..), parse_log) where
import CmdLine
-import FiniteMap
+import Data.FiniteMap
import RegexString
-import Maybe
+import Data.Maybe
+-- import Debug.Trace
-----------------------------------------------------------------------------
-- This is the structure into which we collect our results:
module_size :: FiniteMap String Int,
binary_size :: Maybe Int,
link_time :: Maybe Float,
- run_time :: Maybe Float,
- mut_time :: Maybe Float,
+ run_time :: [Float],
+ mut_time :: [Float],
instrs :: Maybe Integer,
mem_reads :: Maybe Integer,
mem_writes :: Maybe Integer,
+ cache_misses :: Maybe Integer,
gc_work :: Maybe Integer,
- gc_time :: Maybe Float,
+ gc_time :: [Float],
allocs :: Maybe Integer,
run_status :: Status,
compile_status :: Status
module_size = emptyFM,
binary_size = Nothing,
link_time = Nothing,
- run_time = Nothing,
- mut_time = Nothing,
+ run_time = [],
+ mut_time = [],
instrs = Nothing,
mem_reads = Nothing,
mem_writes = Nothing,
- gc_time = Nothing,
+ cache_misses = Nothing,
+ gc_time = [],
gc_work = Nothing,
allocs = Nothing,
compile_status = NotDone,
==nofib== boyer2: time to compile Checker follows...
-}
-banner_re = mkRegex "^==nofib==[ \t]+([A-Za-z0-9_]+):[ \t]+(size of|time to link|time to run|time to compile)[ \t]+([A-Za-z0-9_]+)(\\.o)?[ \t]+follows"
+banner_re = mkRegex "^==nofib==[ \t]+([A-Za-z0-9-_]+):[ \t]+(size of|time to link|time to run|time to compile)[ \t]+([A-Za-z0-9-_]+)(\\.o)?[ \t]+follows"
{-
This regexp for the output of "time" works on FreeBSD, other versions
ghc3_re = mkRegex "^<<ghc:[ \t]+([0-9]+)[ \t]+bytes,[ \t]*([0-9]+)[ \t]+GCs,[ \t]*([0-9]+)/([0-9]+)[ \t]+avg/max bytes residency \\(([0-9]+) samples\\), ([0-9]+) bytes GC work, ([0-9]+)M in use, ([0-9.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\) :ghc>>"
-ghc4_re = mkRegex "^<<ghc-instrs:[ \t]+([0-9]+)[ \t]+bytes,[ \t]*([0-9]+)[ \t]+GCs,[ \t]*([0-9]+)/([0-9]+)[ \t]+avg/max bytes residency \\(([0-9]+) samples\\), ([0-9]+) bytes GC work, ([0-9]+)M in use, ([0-9.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\), ([0-9]+) instructions, ([0-9]+) memory reads, ([0-9]+) memory writes :ghc-instrs>>"
+ghc4_re = mkRegex "^<<ghc-instrs:[ \t]+([0-9]+)[ \t]+bytes,[ \t]*([0-9]+)[ \t]+GCs,[ \t]*([0-9]+)/([0-9]+)[ \t]+avg/max bytes residency \\(([0-9]+) samples\\), ([0-9]+) bytes GC work, ([0-9]+)M in use, ([0-9.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\), ([0-9]+) instructions, ([0-9]+) memory reads, ([0-9]+) memory writes, ([0-9]+) L2 cache misses :ghc-instrs>>"
wrong_exit_status = mkRegex "^\\**[ \t]*expected exit status ([0-9]+) not seen ; got ([0-9]+)"
combine_results :: [(String,Results)] -> FiniteMap String Results
combine_results = foldr f emptyFM
where
- f (prog,results) fm = addToFM_C comb fm prog results
- comb Results{ compile_time = ct1, link_time = lt1,
+ f (prog,results) fm = addToFM_C combine2Results fm prog results
+
+
+combine2Results
+ Results{ compile_time = ct1, link_time = lt1,
module_size = ms1,
run_time = rt1, mut_time = mt1,
instrs = is1, mem_reads = mr1, mem_writes = mw1,
+ cache_misses = cm1,
gc_time = gt1, gc_work = gw1,
binary_size = bs1, allocs = al1,
run_status = rs1, compile_status = cs1 }
module_size = ms2,
run_time = rt2, mut_time = mt2,
instrs = is2, mem_reads = mr2, mem_writes = mw2,
+ cache_misses = cm2,
gc_time = gt2, gc_work = gw2,
binary_size = bs2, allocs = al2,
run_status = rs2, compile_status = cs2 }
= Results{ compile_time = plusFM_C const ct1 ct2,
module_size = plusFM_C const ms1 ms2,
link_time = combMaybes lt1 lt2,
- run_time = combMaybes rt1 rt2,
- mut_time = combMaybes mt1 mt2,
+ run_time = rt1 ++ rt2,
+ mut_time = mt1 ++ mt2,
instrs = combMaybes is1 is2,
mem_reads = combMaybes mr1 mr2,
mem_writes = combMaybes mw1 mw2,
- gc_time = combMaybes gt1 gt2,
+ cache_misses = combMaybes cm1 cm2,
+ gc_time = gt1 ++ gt2,
gc_work = combMaybes gw1 gw2,
binary_size = combMaybes bs1 bs2,
allocs = combMaybes al1 al2,
process_chunk (prog : what : mod : _, chk) =
case what of
"time to compile" -> parse_compile_time prog mod chk
- "time to run" -> parse_run_time prog (reverse chk) NotDone
+ "time to run" -> parse_run_time prog (reverse chk) emptyResults NotDone
"time to link" -> parse_link_time prog chk
"size of" -> parse_size prog mod chk
_ -> error ("process_chunk: "++what)
parse_link_time prog ls
}}
-parse_run_time prog [] NotDone = []
-parse_run_time prog [] ex =[(prog,emptyResults{run_status=ex})]
-parse_run_time prog (l:ls) ex =
+
+-- There might be multiple runs of the program, so we have to collect up
+-- all the results. Variable results like runtimes are aggregated into
+-- a list, whereas the non-variable aspects are just kept singly.
+parse_run_time prog [] res NotDone = []
+parse_run_time prog [] res ex = [(prog, res{run_status=ex})]
+parse_run_time prog (l:ls) res ex =
case matchRegex ghc1_re l of {
Just (allocs:_:_:_:_:init:_:mut:_:gc:_) ->
- let
- read_mut = read mut
- read_gc = read gc
- time = (read init + read_mut + read_gc) :: Float
- in
- [(prog,emptyResults{run_time = Just time,
- mut_time = Just read_mut,
- gc_time = Just read_gc,
- allocs = Just (read allocs),
- run_status = Success })];
+ got_run_result allocs init mut gc Nothing
+ Nothing Nothing Nothing Nothing;
Nothing ->
case matchRegex ghc2_re l of {
Just (allocs:_:_:_:_:_:init:_:mut:_:gc:_) ->
- let
- read_mut = read mut
- read_gc = read gc
- time = (read init + read_mut + read_gc) :: Float
- in
- [(prog,emptyResults{run_time = Just time,
- mut_time = Just read_mut,
- gc_time = Just read_gc,
- allocs = Just (read allocs),
- run_status = Success })];
+ got_run_result allocs init mut gc Nothing
+ Nothing Nothing Nothing Nothing;
+
Nothing ->
case matchRegex ghc3_re l of {
Just (allocs:_:_:_:_:gc_work:_:init:_:mut:_:gc:_) ->
- let
- read_mut = read mut
- read_gc = read gc
- read_gc_work = read gc_work
- time = (read init + read_mut + read_gc) :: Float
- in
- [(prog,emptyResults{run_time = Just time,
- mut_time = Just read_mut,
- gc_work = Just read_gc_work,
- gc_time = Just read_gc,
- allocs = Just (read allocs),
- run_status = Success })];
+ got_run_result allocs init mut gc (Just (read gc_work))
+ Nothing Nothing Nothing Nothing;
+
Nothing ->
case matchRegex ghc4_re l of {
- Just (allocs:_:_:_:_:gc_work:_:init:_:mut:_:gc:_:is:mem_rs:mem_ws:_) ->
- let
- read_mut = read mut
- read_gc = read gc
- read_gc_work = read gc_work
- time = (read init + read_mut + read_gc) :: Float
- in
- [(prog,emptyResults{run_time = Just time,
- mut_time = Just read_mut,
- gc_work = Just read_gc_work,
- gc_time = Just read_gc,
- instrs = Just (read is),
- mem_writes = Just (read mem_ws),
- mem_reads = Just (read mem_rs),
- allocs = Just (read allocs),
- run_status = Success })];
+ Just (allocs:_:_:_:_:gc_work:_:init:_:mut:_:gc:_:is:mem_rs:mem_ws:cache_misses:_) ->
+ got_run_result allocs init mut gc (Just (read gc_work))
+ (Just (read is)) (Just (read mem_rs))
+ (Just (read mem_ws)) (Just (read cache_misses));
+
Nothing ->
case matchRegex wrong_output l of {
Just ("stdout":_) ->
- parse_run_time prog ls (combineRunResult WrongStdout ex);
+ parse_run_time prog ls res (combineRunResult WrongStdout ex);
Just ("stderr":_) ->
- parse_run_time prog ls (combineRunResult WrongStderr ex);
+ parse_run_time prog ls res (combineRunResult WrongStderr ex);
Nothing ->
case matchRegex wrong_exit_status l of {
Just (wanted:got:_) ->
- parse_run_time prog ls (combineRunResult (Exit (read got)) ex);
+ parse_run_time prog ls res (combineRunResult (Exit (read got)) ex);
Nothing ->
case matchRegex out_of_heap l of {
Just _ ->
- parse_run_time prog ls (combineRunResult OutOfHeap ex);
+ parse_run_time prog ls res (combineRunResult OutOfHeap ex);
Nothing ->
case matchRegex out_of_stack l of {
Just _ ->
- parse_run_time prog ls (combineRunResult OutOfStack ex);
+ parse_run_time prog ls res (combineRunResult OutOfStack ex);
Nothing ->
- parse_run_time prog ls ex;
+ parse_run_time prog ls res ex;
}}}}}}}}
+ where
+ got_run_result allocs init mut gc gc_work instrs mem_rs mem_ws cache_misses
+ = -- trace ("got_run_result: " ++ init ++ ", " ++ mut ++ ", " ++ gc) $
+ let
+ read_mut = read mut
+ read_gc = read gc
+ time = (read init + read_mut + read_gc) :: Float
+ res' = combine2Results res
+ emptyResults{ run_time = [time],
+ mut_time = [read_mut],
+ gc_time = [read_gc],
+ gc_work = gc_work,
+ allocs = Just (read allocs),
+ instrs = instrs,
+ mem_reads = mem_rs,
+ mem_writes = mem_ws,
+ cache_misses = cache_misses,
+ run_status = Success
+ }
+ in
+ parse_run_time prog ls res' Success
+
combineRunResult OutOfHeap _ = OutOfHeap
combineRunResult _ OutOfHeap = OutOfHeap