glafp-utils/nofib-analyse/Slurp.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- (c) Simon Marlow 1997-2005
   4 --
   5 -----------------------------------------------------------------------------
   6
   7 module Slurp (Status(..), Results(..), ResultTable(..), parse_log) where
   8
   9 import CmdLine
  10 import Data.FiniteMap
  11 import RegexString
  12 import Data.Maybe
  13 -- import Debug.Trace
  14
  15 -----------------------------------------------------------------------------
  16 -- This is the structure into which we collect our results:
  17
  18 type ResultTable = FiniteMap String Results
  19
  20 data Status
  21         = NotDone
  22         | Success
  23         | OutOfHeap
  24         | OutOfStack
  25         | Exit Int
  26         | WrongStdout
  27         | WrongStderr
  28
  29 data Results = Results {
  30         compile_time    :: FiniteMap String Float,
  31         module_size     :: FiniteMap String Int,
  32         binary_size     :: Maybe Int,
  33         link_time       :: Maybe Float,
  34         run_time        :: [Float],
  35         mut_time        :: [Float],
  36         instrs          :: Maybe Integer,
  37         mem_reads       :: Maybe Integer,
  38         mem_writes      :: Maybe Integer,
  39         cache_misses    :: Maybe Integer,
  40         gc_work         :: Maybe Integer,
  41         gc_time         :: [Float],
  42         allocs          :: Maybe Integer,
  43         run_status      :: Status,
  44         compile_status  :: Status
  45         }
  46
  47 emptyResults = Results {
  48         compile_time    = emptyFM,
  49         module_size     = emptyFM,
  50         binary_size     = Nothing,
  51         link_time       = Nothing,
  52         run_time        = [],
  53         mut_time        = [],
  54         instrs          = Nothing,
  55         mem_reads       = Nothing,
  56         mem_writes      = Nothing,
  57         cache_misses    = Nothing,
  58         gc_time         = [],
  59         gc_work         = Nothing,
  60         allocs          = Nothing,
  61         compile_status  = NotDone,
  62         run_status      = NotDone
  63         }
  64
  65 -----------------------------------------------------------------------------
  66 -- Parse the log file
  67
  68 {-
  69 Various banner lines:
  70
  71 ==nofib== awards: size of QSort.o follows...
  72 ==nofib== banner: size of banner follows...
  73 ==nofib== awards: time to link awards follows...
  74 ==nofib== awards: time to run awards follows...
  75 ==nofib== boyer2: time to compile Checker follows...
  76 -}
  77
  78 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"
  79
  80 {-
  81 This regexp for the output of "time" works on FreeBSD, other versions
  82 of "time" will need different regexps.
  83 -}
  84
  85 time_re = mkRegex "^[ \t]*([0-9.]+)[ \t]+real[ \t]+([0-9.]+)[ \t]+user[ \t]+([0-9.]+)[ \t]+sys[ \t]*$"
  86
  87 time_gnu17_re = mkRegex "^[ \t]*([0-9.]+)user[ \t]+([0-9.]+)system[ \t]+([0-9.:]+)elapsed"
  88                 -- /usr/bin/time --version reports: GNU time 1.7
  89                 -- notice the order is different, and the elapsed time is [hh:]mm:ss.s
  90
  91 size_re = mkRegex "^[ \t]*([0-9]+)[ \t]+([0-9]+)[ \t]+([0-9]+)"
  92
  93 {-
  94 <<ghc: 5820820 bytes, 0 GCs, 0/0 avg/max bytes residency (0 samples), 41087234 bytes GC work, 0.00 INIT (0.05 elapsed), 0.08 MUT (0.18 elapsed), 0.00 GC (0.00 elapsed) :ghc>>
  95
  96         = (bytes, gcs, avg_resid, max_resid, samples, gc_work,
  97            init, init_elapsed, mut, mut_elapsed, gc, gc_elapsed)
  98
  99 ghc1_re = pre GHC 4.02
 100 ghc2_re = GHC 4.02 (includes "xxM in use")
 101 ghc3_re = GHC 4.03 (includes "xxxx bytes GC work")
 102 -}
 103
 104 ghc1_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.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\) :ghc>>"
 105
 106 ghc2_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]+)M in use, ([0-9.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\) :ghc>>"
 107
 108 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>>"
 109
 110 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>>"
 111
 112 wrong_exit_status = mkRegex "^\\**[ \t]*expected exit status ([0-9]+) not seen ; got ([0-9]+)"
 113
 114 wrong_output = mkRegex "^expected (stdout|stderr) not matched by reality$"
 115
 116 out_of_heap = mkRegex "^\\+ Heap exhausted;$"
 117
 118 out_of_stack = mkRegex "^\\+ Stack space overflow:"
 119
 120 parse_log :: String -> ResultTable
 121 parse_log
 122         = combine_results               -- collate information
 123         . concat
 124         . map process_chunk             -- get information from each chunk
 125         . tail                          -- first chunk is junk
 126         . chunk_log [] []               -- break at banner lines
 127         . lines
 128
 129 combine_results :: [(String,Results)] -> FiniteMap String Results
 130 combine_results = foldr f emptyFM
 131  where
 132         f (prog,results) fm = addToFM_C combine2Results fm prog results
 133
 134
 135 combine2Results
 136              Results{ compile_time = ct1, link_time = lt1,
 137                       module_size = ms1,
 138                       run_time = rt1, mut_time = mt1,
 139                       instrs = is1, mem_reads = mr1, mem_writes = mw1,
 140                       cache_misses = cm1,
 141                       gc_time = gt1, gc_work = gw1,
 142                       binary_size = bs1, allocs = al1,
 143                       run_status = rs1, compile_status = cs1 }
 144              Results{ compile_time = ct2, link_time = lt2,
 145                       module_size = ms2,
 146                       run_time = rt2, mut_time = mt2,
 147                       instrs = is2, mem_reads = mr2, mem_writes = mw2,
 148                       cache_misses = cm2,
 149                       gc_time = gt2, gc_work = gw2,
 150                       binary_size = bs2, allocs = al2,
 151                       run_status = rs2, compile_status = cs2 }
 152           =  Results{ compile_time   = plusFM_C const ct1 ct2,
 153                       module_size    = plusFM_C const ms1 ms2,
 154                       link_time      = combMaybes lt1 lt2,
 155                       run_time       = rt1 ++ rt2,
 156                       mut_time       = mt1 ++ mt2,
 157                       instrs         = combMaybes is1 is2,
 158                       mem_reads      = combMaybes mr1 mr2,
 159                       mem_writes     = combMaybes mw1 mw2,
 160                       cache_misses   = combMaybes cm1 cm2,
 161                       gc_time        = gt1 ++ gt2,
 162                       gc_work        = combMaybes gw1 gw2,
 163                       binary_size    = combMaybes bs1 bs2,
 164                       allocs         = combMaybes al1 al2,
 165                       run_status     = combStatus rs1 rs2,
 166                       compile_status = combStatus cs1 cs2 }
 167
 168 combMaybes m1 m2 = case maybeToList m1 ++ maybeToList m2 of
 169                         [] -> Nothing
 170                         (x:_) -> Just x
 171
 172 combStatus NotDone x = x
 173 combStatus x NotDone = x
 174 combStatus x y = x
 175
 176 chunk_log :: [String] -> [String] -> [String] -> [([String],[String])]
 177 chunk_log header chunk [] = [(header,chunk)]
 178 chunk_log header chunk (l:ls) =
 179         case matchRegex banner_re l of
 180                 Nothing -> chunk_log header (l:chunk) ls
 181                 Just stuff -> (header,chunk) : chunk_log stuff [] ls
 182
 183 process_chunk :: ([String],[String]) -> [(String,Results)]
 184 process_chunk (prog : what : mod : _, chk) =
 185  case what of
 186         "time to compile" -> parse_compile_time prog mod chk
 187         "time to run"     -> parse_run_time prog (reverse chk) emptyResults NotDone
 188         "time to link"    -> parse_link_time prog chk
 189         "size of"         -> parse_size prog mod chk
 190         _                 -> error ("process_chunk: "++what)
 191
 192 parse_compile_time prog mod [] = []
 193 parse_compile_time prog mod (l:ls) =
 194         case matchRegex time_re l of {
 195              Just (real:user:system:_) ->
 196                 let ct  = addToFM emptyFM mod (read user)
 197                 in
 198                 [(prog,emptyResults{compile_time = ct})];
 199              Nothing ->
 200
 201         case matchRegex time_gnu17_re l of {
 202              Just (user:system:elapsed:_) ->
 203                 let ct  = addToFM emptyFM mod (read user)
 204                 in
 205                 [(prog,emptyResults{compile_time = ct})];
 206              Nothing ->
 207
 208         case matchRegex ghc1_re l of {
 209             Just (allocs:_:_:_:_:init:_:mut:_:gc:_) ->
 210               let
 211                   read_mut = read mut
 212                   read_gc  = read gc
 213                   time = (read init + read_mut + read_gc) :: Float
 214                   ct  = addToFM emptyFM mod time
 215               in
 216                 [(prog,emptyResults{compile_time = ct})];
 217             Nothing ->
 218
 219         case matchRegex ghc2_re l of {
 220            Just (allocs:_:_:_:_:_:init:_:mut:_:gc:_) ->
 221               let
 222                   read_mut = read mut
 223                   read_gc  = read gc
 224                   time = (read init + read_mut + read_gc) :: Float
 225                   ct  = addToFM emptyFM mod time
 226               in
 227                 [(prog,emptyResults{compile_time = ct})];
 228             Nothing ->
 229
 230         case matchRegex ghc3_re l of {
 231            Just (allocs:_:_:_:_:_:_:init:_:mut:_:gc:_) ->
 232               let
 233                   read_mut = read mut
 234                   read_gc  = read gc
 235                   time = (read init + read_mut + read_gc) :: Float
 236                   ct  = addToFM emptyFM mod time
 237               in
 238                 [(prog,emptyResults{compile_time = ct})];
 239             Nothing ->
 240
 241         case matchRegex ghc4_re l of {
 242            Just (allocs:_:_:_:_:_:_:init:_:mut:_:gc:_:_:_:_) ->
 243               let
 244                   read_mut = read mut
 245                   read_gc  = read gc
 246                   time = (read init + read_mut + read_gc) :: Float
 247                   ct  = addToFM emptyFM mod time
 248               in
 249                 [(prog,emptyResults{compile_time = ct})];
 250             Nothing ->
 251
 252                 parse_compile_time prog mod ls
 253         }}}}}}
 254
 255 parse_link_time prog [] = []
 256 parse_link_time prog (l:ls) =
 257           case matchRegex time_re l of {
 258              Just (real:user:system:_) ->
 259                 [(prog,emptyResults{link_time = Just (read user)})];
 260              Nothing ->
 261
 262           case matchRegex time_gnu17_re l of {
 263              Just (user:system:elapsed:_) ->
 264                 [(prog,emptyResults{link_time = Just (read user)})];
 265              Nothing ->
 266
 267           parse_link_time prog ls
 268           }}
 269
 270
 271 -- There might be multiple runs of the program, so we have to collect up
 272 -- all the results.  Variable results like runtimes are aggregated into
 273 -- a list, whereas the non-variable aspects are just kept singly.
 274 parse_run_time prog [] res NotDone = []
 275 parse_run_time prog [] res ex = [(prog, res{run_status=ex})]
 276 parse_run_time prog (l:ls) res ex =
 277         case matchRegex ghc1_re l of {
 278            Just (allocs:_:_:_:_:init:_:mut:_:gc:_) ->
 279                 got_run_result allocs init mut gc Nothing
 280                         Nothing Nothing Nothing Nothing;
 281            Nothing ->
 282
 283         case matchRegex ghc2_re l of {
 284            Just (allocs:_:_:_:_:_:init:_:mut:_:gc:_) ->
 285                 got_run_result allocs init mut gc Nothing
 286                         Nothing Nothing Nothing Nothing;
 287
 288             Nothing ->
 289
 290         case matchRegex ghc3_re l of {
 291            Just (allocs:_:_:_:_:gc_work:_:init:_:mut:_:gc:_) ->
 292                 got_run_result allocs init mut gc (Just (read gc_work))
 293                         Nothing Nothing Nothing Nothing;
 294
 295             Nothing ->
 296
 297         case matchRegex ghc4_re l of {
 298            Just (allocs:_:_:_:_:gc_work:_:init:_:mut:_:gc:_:is:mem_rs:mem_ws:cache_misses:_) ->
 299                 got_run_result allocs init mut gc (Just (read gc_work))
 300                         (Just (read is)) (Just (read mem_rs))
 301                         (Just (read mem_ws)) (Just (read cache_misses));
 302
 303             Nothing ->
 304
 305         case matchRegex wrong_output l of {
 306             Just ("stdout":_) ->
 307                 parse_run_time prog ls res (combineRunResult WrongStdout ex);
 308             Just ("stderr":_) ->
 309                 parse_run_time prog ls res (combineRunResult WrongStderr ex);
 310             Nothing ->
 311
 312         case matchRegex wrong_exit_status l of {
 313             Just (wanted:got:_) ->
 314                 parse_run_time prog ls res (combineRunResult (Exit (read got)) ex);
 315             Nothing ->
 316
 317         case matchRegex out_of_heap l of {
 318             Just _ ->
 319                 parse_run_time prog ls res (combineRunResult OutOfHeap ex);
 320             Nothing ->
 321
 322         case matchRegex out_of_stack l of {
 323             Just _ ->
 324                 parse_run_time prog ls res (combineRunResult OutOfStack ex);
 325             Nothing ->
 326                 parse_run_time prog ls res ex;
 327
 328         }}}}}}}}
 329   where
 330   got_run_result allocs init mut gc gc_work instrs mem_rs mem_ws cache_misses
 331       = -- trace ("got_run_result: " ++ init ++ ", " ++ mut ++ ", " ++ gc) $
 332         let
 333           read_mut = read mut
 334           read_gc  = read gc
 335           time = (read init + read_mut + read_gc) :: Float
 336           res' = combine2Results res
 337                         emptyResults{   run_time   = [time],
 338                                         mut_time   = [read_mut],
 339                                         gc_time    = [read_gc],
 340                                         gc_work    = gc_work,
 341                                         allocs     = Just (read allocs),
 342                                         instrs     = instrs,
 343                                         mem_reads  = mem_rs,
 344                                         mem_writes = mem_ws,
 345                                         cache_misses = cache_misses,
 346                                         run_status = Success
 347                                 }
 348         in
 349         parse_run_time prog ls res' Success
 350
 351
 352 combineRunResult OutOfHeap  _           = OutOfHeap
 353 combineRunResult _          OutOfHeap   = OutOfHeap
 354 combineRunResult OutOfStack _           = OutOfStack
 355 combineRunResult _          OutOfStack  = OutOfStack
 356 combineRunResult (Exit e)   _           = Exit e
 357 combineRunResult _          (Exit e)    = Exit e
 358 combineRunResult exit       _            = exit
 359
 360 parse_size prog mod [] = []
 361 parse_size prog mod (l:ls) =
 362         case matchRegex size_re l of
 363             Nothing -> parse_size prog mod ls
 364             Just (text:datas:bss:_)
 365                  | prog == mod ->
 366                         [(prog,emptyResults{binary_size =
 367                                               Just (read text + read datas),
 368                                     compile_status = Success})]
 369                  | otherwise ->
 370                         let ms  = addToFM emptyFM mod (read text + read datas)
 371                         in
 372                         [(prog,emptyResults{module_size = ms})]
 373