From: Simon Marlow Date: Fri, 22 Feb 2008 14:20:08 +0000 (+0000) Subject: add GC(0) and GC(1) time X-Git-Tag: Before_cabalised-GHC~241 X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=9b0be04d7d23a4ccce0275f3a7c519d9b614f3a2 add GC(0) and GC(1) time --- diff --git a/utils/nofib-analyse/CmdLine.hs b/utils/nofib-analyse/CmdLine.hs index 3861a30..0a303e1 100644 --- a/utils/nofib-analyse/CmdLine.hs +++ b/utils/nofib-analyse/CmdLine.hs @@ -54,6 +54,8 @@ data CLIFlags | OptTitle String | OptColumns String | OptRows String + | OptCSV String + | OptNoNormalise | OptHelp deriving Eq @@ -81,6 +83,10 @@ argInfo = "Specify columns for summary table (comma separates)" , Option [] ["rows"] (ReqArg OptRows "ROWS") "Specify rows for summary table (comma separates)" + , Option [] ["csv"] (ReqArg OptCSV "TABLE") + "Output a single table in CSV format" + , Option [] ["no-normalise"] (NoArg OptNoNormalise) + "Do not normalise to the baseline" , Option ['n'] ["nodeviations"] (NoArg OptNoDeviations) "Hide deviations" , Option ['t'] ["title"] (ReqArg OptTitle "title") diff --git a/utils/nofib-analyse/Main.hs b/utils/nofib-analyse/Main.hs index f47d3a2..0896a8467 100644 --- a/utils/nofib-analyse/Main.hs +++ b/utils/nofib-analyse/Main.hs @@ -40,7 +40,9 @@ main = do let { html = OptHTMLOutput `elem` flags; latex = OptLaTeXOutput `elem` flags; - ascii = OptASCIIOutput `elem` flags + ascii = OptASCIIOutput `elem` flags; + csv = [ table | OptCSV table <- flags ]; + no_norm = OptNoNormalise `elem` flags; } when (ascii && html) $ die "Can't produce both ASCII and HTML" @@ -63,6 +65,8 @@ main = do (prog,res) <- Map.toList result_table ] case () of + _ | not (null csv) -> + putStr (csvTable results (head csv) (not no_norm)) _ | html -> putStr (renderHtml (htmlPage results column_headings)) _ | latex -> @@ -104,7 +108,8 @@ data PerModuleTableSpec = -- The various per-program aspects of execution that we can generate results for. size_spec, alloc_spec, runtime_spec, muttime_spec, mutetime_spec, gctime_spec, gcelap_spec, - gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec + gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec, + gc0time_spec, gc0elap_spec, gc1time_spec, gc1elap_spec, balance_spec :: PerProgTableSpec size_spec = SpecP "Binary Sizes" "Size" "binary-sizes" binary_size compile_status always_ok alloc_spec = SpecP "Allocations" "Allocs" "allocations" allocs run_status always_ok @@ -113,6 +118,11 @@ muttime_spec = SpecP "Mutator Time" "MutTime" "mutator-time" (mean mut_time) run mutetime_spec = SpecP "Mutator Elapsed Time" "MutETime" "mutator-elapsed-time" (mean mut_elapsed_time) run_status time_ok gctime_spec = SpecP "GC Time" "GCTime" "gc-time" (mean gc_time) run_status time_ok gcelap_spec = SpecP "GC Elapsed Time" "GCETime" "gc-elapsed-time" (mean gc_elapsed_time) run_status time_ok +gc0time_spec = SpecP "GC(0) Time" "GC0Time" "gc0-time" (mean gc0_time) run_status time_ok +gc0elap_spec = SpecP "GC(0) Elapsed Time" "GC0ETime" "gc0-elapsed-time" (mean gc0_elapsed_time) run_status time_ok +gc1time_spec = SpecP "GC(1) Time" "GC1Time" "gc1-time" (mean gc1_time) run_status time_ok +gc1elap_spec = SpecP "GC(1) Elapsed Time" "GC1ETime" "gc1-elapsed-time" (mean gc1_elapsed_time) run_status time_ok +balance_spec = SpecP "GC work balance" "Balance" "balance" (mean balance) run_status time_ok gcwork_spec = SpecP "GC Work" "GCWork" "gc-work" gc_work run_status always_ok instrs_spec = SpecP "Instructions" "Instrs" "instrs" instrs run_status always_ok mreads_spec = SpecP "Memory Reads" "Reads" "mem-reads" mem_reads run_status always_ok @@ -128,6 +138,11 @@ all_specs = [ mutetime_spec, gctime_spec, gcelap_spec, + gc0time_spec, + gc0elap_spec, + gc1time_spec, + gc1elap_spec, + balance_spec, gcwork_spec, instrs_spec, mreads_spec, @@ -170,9 +185,9 @@ checkTimes prog results = do -- These are the per-prog tables we want to generate per_prog_result_tab :: [PerProgTableSpec] per_prog_result_tab = - [ size_spec, alloc_spec, runtime_spec, muttime_spec, mutetime_spec, - gctime_spec, gcelap_spec, - gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec ] + [ size_spec, alloc_spec, runtime_spec, muttime_spec, mutetime_spec, gctime_spec, + gcelap_spec, gc0time_spec, gc0elap_spec, gc1time_spec, gc1elap_spec, + gcwork_spec, balance_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec] -- A single summary table, giving comparison figures for a number of -- aspects, each in its own column. Only works when comparing two runs. @@ -269,7 +284,7 @@ htmlShowResults (r:rs) ss f stat result_ok ++ [tableRow (-1) ("Average", gms)]) where -- results_per_prog :: [ (String,[BoxValue a]) ] - results_per_prog = map (calc_result rs f stat result_ok) (Map.toList r) + results_per_prog = map (calc_result rs f stat result_ok convert_to_percentage) (Map.toList r) results_per_run = transpose (map snd results_per_prog) (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run) @@ -311,7 +326,7 @@ htmlShowMultiResults (r:rs) ss f result_ok = Just res -> f res get_results_for_mod id_attr - = calc_result fms Just (const Success) result_ok id_attr + = calc_result fms Just (const Success) result_ok convert_to_percentage id_attr show_results_for_prog (prog,mrs) = td b) boxes (_, column_mean, _) = calc_gmsd column (column_min, column_max) = calc_minmax column @@ -562,7 +577,7 @@ ascii_show_multi_results (r:rs) ss f result_ok Just res -> f res get_results_for_mod id_attr - = calc_result fms Just (const Success) result_ok id_attr + = calc_result fms Just (const Success) result_ok convert_to_percentage id_attr show_results_for_prog (prog,mrs) = str ("\n"++prog++"\n") @@ -585,6 +600,46 @@ show_per_prog_results_width w (prog,results) . str (space 5) . foldr (.) id (map (str . rjustify w . showBox) results) +-- ----------------------------------------------------------------------------- +-- CSV output + +csvTable :: [ResultTable] -> String -> Bool -> String +csvTable results table_name norm + = let + table_spec = [ spec | spec@(SpecP _ n _ _ _ _) <- per_prog_result_tab, + n == table_name ] + in + case table_spec of + [] -> error ("can't find table named: " ++ table_name) + (spec:_) -> csvProgTable results spec norm "\n" + +csvProgTable :: [ResultTable] -> PerProgTableSpec -> Bool -> ShowS +csvProgTable results (SpecP long_name _ _ get_result get_status result_ok) norm + = csv_show_results results get_result get_status result_ok norm + +csv_show_results + :: Result a + => [ResultTable] + -> (Results -> Maybe a) + -> (Results -> Status) + -> (a -> Bool) + -> Bool + -> ShowS + +csv_show_results [] _ _ _ _ + = error "csv_show_results: Can't happen?" +csv_show_results (r:rs) f stat result_ok norm + = interleave "\n" results_per_prog + where + -- results_per_prog :: [ (String,[BoxValue a]) ] + results_per_prog = map (result_line . calc) (Map.toList r) + calc = calc_result rs f stat (const True) do_norm + + do_norm | norm = normalise_to_base + | otherwise = \base res -> toBox res + + result_line (prog,boxes) = interleave "," (str prog : map (str.showBox) boxes) + -- --------------------------------------------------------------------------- -- Generic stuff for results generation @@ -594,11 +649,12 @@ calc_result => [Map String b] -- accumulated results -> (b -> Maybe a) -- get a result from the b -> (b -> Status) -- get a status from the b - -> (a -> Bool) -- is this result ok? + -> (a -> Bool) -- normalise against the baseline? + -> (a -> a -> BoxValue) -- how to normalise -> (String,b) -- the baseline result -> (String,[BoxValue]) -calc_result rts get_maybe_a get_stat result_ok (prog,base_r) = +calc_result rts get_maybe_a get_stat base_ok normalise (prog,base_r) = (prog, (just_result m_baseline base_stat : let @@ -609,10 +665,10 @@ calc_result rts get_maybe_a get_stat result_ok (prog,base_r) = in ( case m_baseline of - Just baseline - | result_ok baseline - -> map (\(r,s) -> percentage r s baseline) rts' - _ -> map (\(r,s) -> just_result r s) rts' + Just baseline | base_ok baseline + -> map (\(r,s) -> do_norm r s baseline) rts' + _other + -> map (\(r,s) -> just_result r s) rts' ))) where m_baseline = get_maybe_a base_r @@ -621,9 +677,9 @@ calc_result rts get_maybe_a get_stat result_ok (prog,base_r) = just_result Nothing s = RunFailed s just_result (Just a) _ = toBox a - percentage Nothing s _ = RunFailed s - percentage (Just a) _ baseline - = Percentage (convert_to_percentage baseline a) + do_norm Nothing s _ = RunFailed s + do_norm (Just a) _ baseline = normalise baseline a + ----------------------------------------------------------------------------- -- Calculating geometric means and standard deviations @@ -688,29 +744,26 @@ calc_minmax xs ----------------------------------------------------------------------------- -- Show the Results -class Num a => Result a where +convert_to_percentage :: Result a => a -> a -> BoxValue +convert_to_percentage 0 val = Percentage 100 +convert_to_percentage baseline val = Percentage ((realToFrac val / realToFrac baseline) * 100) + +normalise_to_base :: Result a => a -> a -> BoxValue +normalise_to_base 0 val = BoxFloat 1 +normalise_to_base baseline val = BoxFloat (realToFrac baseline / realToFrac val) + +class Real a => Result a where toBox :: a -> BoxValue - convert_to_percentage :: a -> a -> Float -- We assume an Int is a size, and print it in kilobytes. instance Result Int where - convert_to_percentage 0 _ = 100 - convert_to_percentage baseline val - = (fromIntegral val / fromIntegral baseline) * 100 - toBox = BoxInt instance Result Integer where - convert_to_percentage 0 _ = 100 - convert_to_percentage baseline val - = (fromInteger val / fromInteger baseline) * 100 toBox = BoxInteger instance Result Float where - convert_to_percentage 0.0 _ = 100.0 - convert_to_percentage baseline val = val / baseline * 100 - toBox = BoxFloat -- ----------------------------------------------------------------------------- diff --git a/utils/nofib-analyse/Makefile b/utils/nofib-analyse/Makefile index 55672d8..ba190ac 100644 --- a/utils/nofib-analyse/Makefile +++ b/utils/nofib-analyse/Makefile @@ -12,4 +12,8 @@ ifeq "$(ghc_ge_605)" "YES" SRC_HC_OPTS += -package regex-compat -package html endif +ifeq "$(ghc_ge_607)" "YES" +SRC_HC_OPTS += -package containers +endif + include $(TOP)/mk/target.mk diff --git a/utils/nofib-analyse/Slurp.hs b/utils/nofib-analyse/Slurp.hs index 30e8063..55d238e 100644 --- a/utils/nofib-analyse/Slurp.hs +++ b/utils/nofib-analyse/Slurp.hs @@ -42,6 +42,11 @@ data Results = Results { gc_work :: Maybe Integer, gc_time :: [Float], gc_elapsed_time :: [Float], + gc0_time :: [Float], + gc0_elapsed_time :: [Float], + gc1_time :: [Float], + gc1_elapsed_time :: [Float], + balance :: [Float], allocs :: Maybe Integer, run_status :: Status, compile_status :: Status @@ -62,6 +67,11 @@ emptyResults = Results { cache_misses = Nothing, gc_time = [], gc_elapsed_time = [], + gc0_time = [], + gc0_elapsed_time = [], + gc1_time = [], + gc1_elapsed_time = [], + balance = [], gc_work = Nothing, allocs = Nothing, compile_status = NotDone, @@ -126,6 +136,7 @@ size_re s = case matchRegex re s of ghc1_re = pre GHC 4.02 ghc2_re = GHC 4.02 (includes "xxM in use") ghc3_re = GHC 4.03 (includes "xxxx bytes GC work") +ghc5_re = GHC 6.9 (includes GC(0) and GC(1) times) -} ghc1_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float) @@ -160,6 +171,14 @@ ghc4_re s = case matchRegex re s of Nothing -> Nothing where re = mkRegex "^<>" +ghc5_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float,Float,Float,Float,Float,Float) +ghc5_re s = case matchRegex re s of + Just [allocations, gcs, avg_residency, max_residency, samples, gc_work', in_use, initialisation, initialisation_elapsed, mut, mut_elapsed, gc, gc_elapsed, gc0, gc0_elapsed, gc1, gc1_elapsed, bal] -> + Just (read allocations, read gcs, read avg_residency, read max_residency, read samples, read gc_work', read in_use, read initialisation, read initialisation_elapsed, read mut, read mut_elapsed, read gc, read gc_elapsed, read gc0, read gc0_elapsed, read gc1, read gc1_elapsed, read bal) + Just _ -> error "ghc3_re: Can't happen" + Nothing -> Nothing + where re = mkRegex "^<>" + wrong_exit_status, wrong_output, out_of_heap, out_of_stack :: Regex wrong_exit_status = mkRegex "^\\**[ \t]*expected exit status ([0-9]+) not seen ; got ([0-9]+)" wrong_output = mkRegex "^expected (stdout|stderr) not matched by reality$" @@ -189,6 +208,9 @@ combine2Results instrs = is1, mem_reads = mr1, mem_writes = mw1, cache_misses = cm1, gc_time = gt1, gc_elapsed_time = ge1, gc_work = gw1, + gc0_time = g0t1, gc0_elapsed_time = g0e1, + gc1_time = g1t1, gc1_elapsed_time = g1e1, + balance = b1, binary_size = bs1, allocs = al1, run_status = rs1, compile_status = cs1 } Results{ compile_time = ct2, link_time = lt2, @@ -198,6 +220,9 @@ combine2Results instrs = is2, mem_reads = mr2, mem_writes = mw2, cache_misses = cm2, gc_time = gt2, gc_elapsed_time = ge2, gc_work = gw2, + gc0_time = g0t2, gc0_elapsed_time = g0e2, + gc1_time = g1t2, gc1_elapsed_time = g1e2, + balance = b2, binary_size = bs2, allocs = al2, run_status = rs2, compile_status = cs2 } = Results{ compile_time = Map.unionWith (flip const) ct1 ct2, @@ -212,6 +237,11 @@ combine2Results cache_misses = cm1 `mplus` cm2, gc_time = gt1 ++ gt2, gc_elapsed_time= ge1 ++ ge2, + gc0_time = g0t1 ++ g0t2, + gc0_elapsed_time= g0e1 ++ g0e2, + gc1_time = g1t1 ++ g1t2, + gc1_elapsed_time= g1e1 ++ g1e2, + balance = b1 ++ b2, gc_work = gw1 `mplus` gw2, binary_size = bs1 `mplus` bs2, allocs = al1 `mplus` al2, @@ -319,32 +349,40 @@ parse_run_time prog [] res ex = [(prog, res{run_status=ex})] parse_run_time prog (l:ls) res ex = case ghc1_re l of { Just (allocations, _, _, _, _, _, initialisation, _, mut, mut_elapsed, gc, gc_elapsed) -> - got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed + got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed [] [] [] [] [] Nothing Nothing Nothing Nothing Nothing; Nothing -> case ghc2_re l of { Just (allocations, _, _, _, _, _, initialisation, _, mut, mut_elapsed, gc, gc_elapsed) -> - got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed + got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed [] [] [] [] [] Nothing Nothing Nothing Nothing Nothing; Nothing -> case ghc3_re l of { Just (allocations, _, _, _, _, gc_work', _, initialisation, _, mut, mut_elapsed, gc, gc_elapsed) -> - got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed + got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed [] [] [] [] [] (Just gc_work') Nothing Nothing Nothing Nothing; Nothing -> case ghc4_re l of { Just (allocations, _, _, _, _, gc_work', _, initialisation, _, mut, mut_elapsed, gc, gc_elapsed, is, mem_rs, mem_ws, cache_misses') -> - got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed + got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed [] [] [] [] [] (Just gc_work') (Just is) (Just mem_rs) (Just mem_ws) (Just cache_misses'); Nothing -> + case ghc5_re l of { + Just (allocations, _, _, _, _, gc_work', _, initialisation, _, mut, mut_elapsed, gc, gc_elapsed, gc0, gc0_elapsed, gc1, gc1_elapsed, bal) -> + got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed + [gc0] [gc0_elapsed] [gc1] [gc1_elapsed] [bal] + (Just gc_work') Nothing Nothing Nothing Nothing; + + Nothing -> + case matchRegex wrong_output l of { Just ["stdout"] -> parse_run_time prog ls res (combineRunResult WrongStdout ex); @@ -370,9 +408,9 @@ parse_run_time prog (l:ls) res ex = Nothing -> parse_run_time prog ls res ex; - }}}}}}}} + }}}}}}}}} where - got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed gc_work' instrs' mem_rs mem_ws cache_misses' + got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed gc0 gc0_elapsed gc1 gc1_elapsed bal gc_work' instrs' mem_rs mem_ws cache_misses' = -- trace ("got_run_result: " ++ initialisation ++ ", " ++ mut ++ ", " ++ gc) $ let time = initialisation + mut + gc @@ -382,6 +420,11 @@ parse_run_time prog (l:ls) res ex = mut_elapsed_time = [mut_elapsed], gc_time = [gc], gc_elapsed_time = [gc_elapsed], + gc0_time = gc0, + gc0_elapsed_time = gc0_elapsed, + gc1_time = gc1, + gc1_elapsed_time = gc1_elapsed, + balance = bal, gc_work = gc_work', allocs = Just allocations, instrs = instrs', @@ -409,8 +452,8 @@ parse_size progName modName (l:ls) = Nothing -> parse_size progName modName ls Just (text, datas, _bss) | progName == modName -> - [(progName,emptyResults{binary_size = - Just (text + datas), + [(progName,emptyResults{binary_size = + Just (text + datas), compile_status = Success})] | otherwise -> let ms = Map.singleton modName (text + datas)