cacheprint.hs

深入理解计算机系统（computer system：a programmer s perpective)是一本非常经典的教材

        mk_inline_function_summary_text fn_name fn_t fn_m
           = ["", opener] 
             ++ 
             map foo
             [ "",
               "Summary for " ++ fn_name ++ ":",
               "",
               "  rd-&-wr: " ++ pp14 fn_t ++ " (" ++ percent fn_t n_t 
                           ++ " of total)",
               "   misses: " ++ pp14 fn_m ++ " (" ++ percent fn_m n_mt
                           ++ " of total)",
               "miss rate:          " 
                              ++ percent fn_m fn_t ++ " (is " 
                              ++ percent n_mt n_t ++  " overall)",
               ""
             ]
             ++ 
             [closer]

        sum_width  = 70
        sum_indent = 24
        foo s = take sum_indent (repeat ' ') ++ " |   " 
                ++ take (sum_width-7) (s ++ repeat ' ') ++ " |"
        opener
           = take sum_indent (repeat ' ') ++ "/*" 
             ++ take (sum_width-2) (repeat '-')
        closer
           = take sum_indent (repeat ' ') ++ " " 
             ++ take (sum_width-2) (repeat '-') ++ "*/"

        -- truncated_per_fn_info
        --   :: [(String,Integer,Integer,Integer,Integer)]
        -- full_per_fn_info
        --   :: [(String,Integer,Integer)]
        (truncated_per_fn_info, full_per_fn_info)
           = mk_per_fn_info n_t n_mt fnnames ccs

        num_ignored
           = length fnnames - length truncated_per_fn_info

        per_fn_text
           = ""
             :
             ("   FUNCTION NAME                              "  ++
              " RD-&-WR      %  cum-%" ++
              "       MISSES      %  cum-%      RATE")
             :
             ("   " ++ take 102 (repeat '-'))
             :
             map fn_info_to_text truncated_per_fn_info
             ++ ["", 
                 "   The remaining " ++ show num_ignored ++ 
                    " functions contributed less than 0.01% " ++
                    "of the reads-&-writes,",
                 "   and less than 0.01% of the misses."]

        fn_info_to_text (fnname, sum_trans, cum_trans, sum_misses, cum_misses)
           = "   " ++ lj 36 fnname ++ " " ++
             pp14 sum_trans ++ "  "  
                ++ percent sum_trans n_t ++ "  "
                ++ percent cum_trans n_t ++ "  " ++
             pp11 sum_misses ++ "  "
                ++ percent sum_misses n_mt ++ "  "
                ++ percent cum_misses n_mt ++ "     " ++
             percent sum_misses sum_trans

        ---------------------------------------------------
        --- Names info ------------------------------------
        ---------------------------------------------------

        names_text
           = [ show (length filenames) ++ " source files named in profile:" ]
             ++ map ("   "++) filenames
             ++ [ show (length fnnames) ++ " functions named in profile:" ]
             ++ map ("   "++) fnnames               

        ---------------------------------------------------
        --- Summary info ----------------------------------
        ---------------------------------------------------

        summary_text
           = [ 
                "",
                "   " ++ showc (n_insns pf) ++ " instructions,  "
                      ++ showc n_t ++ " references,  " 
                      ++ showc n_mt ++ " misses.",
                "",
                "",
                "     SIZE          RD-&-WR      %          MISSES      %      RATE",
                "   ---------------------------------------------------------------",
                st_line "TOTAL:"  n_t      n_t  n_mt      n_mt,
                st_line "1 byte"  n_t1     n_t  n_mt1     n_mt,
                st_line "2 byte"  n_t2     n_t  n_mt2     n_mt,
                st_line "4 byte"  n_t4     n_t  n_mt4     n_mt,
                st_line "8 byte"  n_t8     n_t  n_mt8     n_mt,
                "",
                "",
                "     SIZE            READS      %          MISSES      %      RATE",
                "   ---------------------------------------------------------------",
                st_line "TOTAL:" n_r       n_r n_mr       n_mr,
                st_line "1 byte" (n_r1 pf) n_r (n_mr1 pf) n_mr,
                st_line "2 byte" (n_r2 pf) n_r (n_mr2 pf) n_mr,
                st_line "4 byte" (n_r4 pf) n_r (n_mr4 pf) n_mr,
                st_line "8 byte" (n_r8 pf) n_r (n_mr8 pf) n_mr,
                "",
                "",
                "     SIZE           WRITES      %          MISSES      %      RATE",
                "   ---------------------------------------------------------------",
                st_line "TOTAL:" n_w       n_w n_mw       n_mw, 
                st_line "1 byte" (n_w1 pf) n_w (n_mw1 pf) n_mw,
                st_line "2 byte" (n_w2 pf) n_w (n_mw2 pf) n_mw,
                st_line "4 byte" (n_w4 pf) n_w (n_mw4 pf) n_mw,
                st_line "8 byte" (n_w8 pf) n_w (n_mw8 pf) n_mw,
                "",
                "",
                "   " ++ showc (genericLength filenames) 
                     ++ " source files, " ++
                     showc (genericLength fnnames) ++ " function names, and " ++
                     showc (genericLength ccs) ++ " program points",
               "   are mentioned in `cacheprof.out'."
             ]

        st_line kind nt tott nm totm
           = "   " ++ kind ++ "   " ++
             pp14 nt ++ "  " ++ percent nt tott ++ "  " ++
             pp14 nm ++ "  " ++ percent nm totm ++ "     " ++
             percent nm nt 


mk_per_fn_info :: Integer -> Integer 
                  -> [String] -> [CC] 
                  -> ( [(String,Integer,Integer,Integer,Integer)],
                       [(String,Integer,Integer)] )
mk_per_fn_info n_t n_mt fnnames ccs
   = let initialSFM
            = createSFM [0 .. length fnnames-1] 
                        (0 :: Integer, 0 :: Integer) 
         updSFM sfm (CC info lno fno nt nm)
            = updateSFM sfm fno ( \ (nts,nms) -> (nts+nt, nms+nm) )

         -- a hack to avoid need for an enormous stack (sigh)
         finalSFM
            = loop initialSFM ccs
              where
                 loop fm [] 
                    = fm
                 loop fm (cc:ccs)
                    = let fm2 = updSFM fm cc in seq fm2 (loop fm2 ccs)

         triplesI :: [(Int, (Integer,Integer))]
                            -- with fsts as 0, 1, 2 ... #fns-1
         triplesI = flattenSFM finalSFM
         triplesS :: [(String, Integer, Integer)]
         triplesS
            = zipWith (\fnnm (fnno,(nt,nm)) -> (fnnm,nt,nm)) 
                      fnnames triplesI

         -- (name, # trans, # miss) sorted by # trans or # miss
         triplesSorted :: [(String, Integer, Integer)]
         triplesSorted
             = sortBy (\(_,t1,m1) (_,t2,m2) -> compare t2 t1) triplesS

         -- as triplesSorted, but with cumulative info too
         fiveBles :: [(String,Integer,Integer,Integer,Integer)]
         fiveBles
             = accum (0::Integer) (0::Integer) triplesSorted
               where
                  accum acc_trans acc_misses [] = []
                  accum acc_trans acc_misses ((name, nt, nm):rest)
                     = let acc_trans2 = acc_trans + nt
                           acc_misses2 = acc_misses + nm
                           restDone = accum acc_trans2 acc_misses2 rest
                       in
                           (name, nt, acc_trans2, nm, acc_misses2) 
                           : restDone

         -- truncate fiveBles at the point where *both* cumulative
         -- transactions and cumulative misses exceed 99.99%
         truncated
            = if   length fiveBles < 10
              then fiveBles
              else takeWhile p fiveBles
              where
                 p (name, nt, ct, nm, cm)
                    = n_t > 0 && n_mt > 0 &&   -- avoid division by zero
                      ((ii2d ct) / (ii2d n_t) <= 0.9999 ||
                       (ii2d cm) / (ii2d n_mt) <= 0.9999)
     in
         (truncated, triplesSorted)

readProfFile :: [[String]] -> Maybe ProfFile
readProfFile
   ([n_insns] :
    numsR@[n_r1,  n_r2,  n_r4,  n_r8,  n_mr1, n_mr2, n_mr4, n_mr8] :
    numsW@[n_w1,  n_w2,  n_w4,  n_w8,  n_mw1, n_mw2, n_mw4, n_mw8] :
    sss)
   | all (all isDigit) (numsR ++ numsW)
   = case readModules sss of
        Just (ms, [])
           -> Just (
                 ProfFile
                    ms
                    (readII n_insns)
                    (readII n_r1)  (readII n_r2)  (readII n_r4)  (readII n_r8)
                    (readII n_mr1) (readII n_mr2) (readII n_mr4) (readII n_mr8)
                    (readII n_w1)  (readII n_w2)  (readII n_w4)  (readII n_w8)
                    (readII n_mw1) (readII n_mw2) (readII n_mw4) (readII n_mw8)
              )
        other
           -> Nothing
   | otherwise
   = Nothing


readModules :: [[String]] -> Maybe ([Module], [[String]])
readModules []
   = Just ([],[])
readModules sss
   = case readModule sss of
        Just (m, ss1) 
           -> case readModules ss1 of
                 Just (ms, ss2) -> Just ((m:ms), ss2)
                 Nothing        -> Nothing
        Nothing
           -> Nothing

readModule :: [[String]] -> Maybe (Module, [[String]])
readModule sss
   = case sss of
        ([s1,s2,s3]:ss1) 
           |  all (all isDigit) [s1,s2,s3]
           -> let n1 = (readI s1) :: Int
                  n2 = (readI s2) :: Int
                  n3 = (readI s3) :: Int
              in
              case splitAt n1 ss1 of { (filenames, ss2) ->
              case splitAt n2 ss2 of { (fnnames, ss3) ->
              case splitAt n3 ss3 of { (cctxts, ss4) ->
              if   n1 /= length filenames
                   || n2 /= length fnnames
                   || not (all ((==1).length) filenames)
                   || not (all ((==1).length) fnnames)
              then Nothing
              else 
              let  maybeCCs = map tryReadCC cctxts
              in   if any isNothing maybeCCs
              then Nothing
              else 
              let  ccs = map unJust maybeCCs
              in   Just (Module (map head filenames)
                                (map head fnnames) ccs, 
                         ss4)
              }}}
        other
           -> Nothing

isNothing Nothing  = True
isNothing (Just _) = False

unJust (Just x) = x

tryReadCC :: [String] -> Maybe CC
tryReadCC ss
   = case ss of
        [filen,linen,fnn,ntrans,nmiss] 
           | all (all isDigit) ss
           -> let v_filen  = readI filen
                  v_linen  = readI linen
                  v_fnn    = readI fnn
                  v_ntrans = readII ntrans
                  v_nmiss  = readII nmiss
              in 
                  Just (CC v_filen v_linen v_fnn v_ntrans v_nmiss)
        other
           -> Nothing

lj :: Int -> String -> String
lj n x = take n (x ++ repeat ' ')

readII :: String -> Integer
readII s
   = f 0 s
     where
        f :: Integer -> String -> Integer
        f acc [] 
           = acc
        f acc (d:ds) 
           | d >= '0' && d <= '9'  
           = let di = fromIntegral (ord d - ord '0')
             in  f (di + acc * 10) ds
           | otherwise
           = internal ("readII `" ++ s ++ "'\n")

readI :: String -> Int
readI s
   = f 0 s
     where
        f :: Int -> String -> Int
        f acc [] 
           = acc
        f acc (d:ds) 
           | d >= '0' && d <= '9'  
           = let di = ord d - ord '0'
             in  f (di + acc * 10) ds
           | otherwise
           = internal ("readI `" ++ s ++ "'\n")



pp11 = ppN 11
pp14 = ppN 14

ppN :: Int -> Integer -> String
ppN w n
   = let s = showc n
     in  if   length s >= w 
         then s
         else reverse (take w (reverse s ++ repeat ' '))

showc :: Integer -> String
showc n
   | n < 0
   = '-':showc (-n)
   | otherwise
   = (reverse . comma3 . reverse . show) n
     where
        comma3 (d:e:f:rest@(_:_)) = d:e:f:',': comma3 rest
        comma3 other        = other

percent :: Integer -> Integer -> String
percent n d
   | d == 0
   = " NaN%"
   | otherwise
   = let f :: Double
         f = 100.0 * (ii2d n) / (ii2d d)
     in
         if f < 0.1 then " 0.0%" 
         else if f < 10.0 then " " ++ take 3 (show f) ++ "%" 
         else take 4 (show f) ++ "%"

i2d :: Int -> Double
i2d = fromIntegral

ii2d :: Integer -> Double
ii2d = fromIntegral

nukeAdjacent :: Eq a => [a] -> [a]
nukeAdjacent [] = []
nukeAdjacent [x] = [x]
nukeAdjacent (x:y:rest)
   = let restDone = nukeAdjacent (y:rest)
     in  if x == y then restDone else x : restDone

-- return the first of a list satisfying f, along with
-- the rest which don't
filterOne :: (a -> Bool) -> [a] -> (Maybe a, [a])
filterOne f xs
   = g [] xs
     where
        g unusedR [] = (Nothing, reverse unusedR)
        g unusedR (y:ys)
           | f y       = (Just y, reverse unusedR ++ ys)
           | otherwise = g (y:unusedR) ys

fst3 (a,b,c) = a


{------------------------------------------------------------------------}
{--- end                                                CachePrint.hs ---}
{------------------------------------------------------------------------}