X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=glafp-utils%2Fnofib-analyse%2FSlurp.hs;h=ed21716315d55f8be86f58884b951ede20591674;hb=f216dd0134b3c581dde683f16a75885457e4c60b;hp=5fe15ddd1e9ab9265ccfe868a8c50b8a8f4b40e6;hpb=8d0295c843f763123f0bdae69f84972ff3850cef;p=ghc-hetmet.git diff --git a/glafp-utils/nofib-analyse/Slurp.hs b/glafp-utils/nofib-analyse/Slurp.hs index 5fe15dd..ed21716 100644 --- a/glafp-utils/nofib-analyse/Slurp.hs +++ b/glafp-utils/nofib-analyse/Slurp.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: Slurp.hs,v 1.4 2002/09/18 12:36:40 simonmar Exp $ +-- $Id: Slurp.hs,v 1.5 2004/04/02 14:28:57 simonmar Exp $ -- (c) Simon Marlow 1997-1999 ----------------------------------------------------------------------------- @@ -30,14 +30,14 @@ data Results = 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 @@ -48,13 +48,13 @@ emptyResults = Results { 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, cache_misses = Nothing, - gc_time = Nothing, + gc_time = [], gc_work = Nothing, allocs = Nothing, compile_status = NotDone, @@ -128,8 +128,11 @@ parse_log 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, @@ -148,13 +151,13 @@ combine_results = foldr f emptyFM = 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, cache_misses = combMaybes cm1 cm2, - gc_time = combMaybes gt1 gt2, + gc_time = gt1 ++ gt2, gc_work = combMaybes gw1 gw2, binary_size = combMaybes bs1 bs2, allocs = combMaybes al1 al2, @@ -180,7 +183,7 @@ process_chunk :: ([String],[String]) -> [(String,Results)] 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) @@ -263,97 +266,86 @@ parse_link_time prog (l:ls) = 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:cache_misses:_) -> - 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_reads = Just (read mem_rs), - mem_writes = Just (read mem_ws), - cache_misses = Just (read cache_misses), - allocs = Just (read allocs), - run_status = Success })]; + 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 + = 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