Permalink
Browse files

Add ability to reuse build results from old runs

We can now reuse the results of builds from old runs. Using
the old build results allow us to build the program under a
given configuration one time and then run it and collect
results many times. This feature is useful if you want to
collect performance numbers for configuration paramaters
that are passed at runtime instead of build time (for
example running with a different number of threads).

To reuse the build results pass the directory name as it
appers under the run/ directory in the fibon root. For
example,

  $ fibon-run -c head -r 401.head

will result the build results from run/401.head
  • Loading branch information...
1 parent 55a10e6 commit 050ed0ce9d4d3df913d6d18d0a6ec651b0d56e8b @dmpots committed Dec 13, 2011
Showing with 128 additions and 40 deletions.
  1. +4 −0 lib/Fibon/Result.hs
  2. +8 −0 tools/fibon-run/Fibon/Run/CommandLine.hs
  3. +116 −40 tools/fibon-run/Fibon/Run/Main.hs
View
@@ -6,6 +6,7 @@ module Fibon.Result (
, RunSummary(..)
, RunDetail(..)
, ExtraStats
+ , noBuildData
)
where
import Data.ByteString(ByteString)
@@ -24,6 +25,9 @@ data BuildData = BuildData {
}
deriving(Read, Show, Data, Typeable)
+noBuildData :: BuildData
+noBuildData = BuildData 0 ""
+
data RunData = RunData {
summary :: RunSummary
, details :: [RunDetail]
@@ -2,6 +2,7 @@ module Fibon.Run.CommandLine (
Opt(..)
, UsageError
, parseCommandLine
+ , ReuseDir
)
where
@@ -13,6 +14,7 @@ import Fibon.Run.Manifest
import System.Console.GetOpt
type UsageError = String
+type ReuseDir = Maybe FilePath -- path to directory of already built benchmarks
data Opt = Opt {
optConfig :: ConfigId
, optHelpMsg :: Maybe String
@@ -21,6 +23,7 @@ data Opt = Opt {
, optSizeSetting :: Maybe InputSize
, optIterations :: Maybe Int
, optAction :: Action
+ , optReuseDir :: ReuseDir
}
defaultOpts :: Opt
@@ -32,6 +35,7 @@ defaultOpts = Opt {
, optSizeSetting = Nothing
, optIterations = Nothing
, optAction = Run
+ , optReuseDir = Nothing
}
@@ -120,6 +124,10 @@ options = [
(errs, opt {optAction = fromMaybe (optAction opt) act})) "Action"
)
"override default action"
+ ,
+ Option ['r'] ["reuse"]
+ (ReqArg (\dir (e, opt) -> (e, opt {optReuseDir = Just dir})) "DIR")
+ "reuse build results from directory"
]
usage :: String
@@ -9,6 +9,8 @@ import Data.Char
import Data.List
import Data.Maybe
import Data.Serialize
+import Data.Time.LocalTime(getZonedTime)
+import Data.Time.Format(formatTime)
import Fibon.Benchmarks
import Fibon.FlagConfig
import Fibon.Result
@@ -21,6 +23,7 @@ import qualified Fibon.Run.Log as Log
import System.Directory
import System.Exit
import System.Environment
+import System.Locale(defaultTimeLocale)
import System.FilePath
import Text.Printf
@@ -35,38 +38,65 @@ main = do
benchRoot = currentDir </> "benchmarks/Fibon/Benchmarks"
logPath = currentDir </> "log"
action = optAction opts
- uniq <- chooseUniqueName workingDir (configId runConfig)
- logState <- Log.startLogger logPath logPath uniq
+ configName = configId runConfig
+ reuseDir = optReuseDir opts
+
+ -- Choose names used for log files and run directories.
+ (logUniq, reuseId) <- chooseUniqueNames workingDir configName reuseDir
+
+ -- Start the logger
+ logState <- Log.startLogger logPath logPath logUniq
+
+ -- Build the benchmark bundles that contain all the info about where the
+ -- benchmarks are located and how they should be run. If we were given a reuse
+ -- directory then we will have the bundle reuse the results from a previous
+ -- build.
progEnv <- getEnvironment
- let bundles = makeBundles runConfig workingDir benchRoot uniq progEnv
+ let bundles = makeBundles runConfig workingDir benchRoot reuseId progEnv
mapM_ dumpBundleConfig bundles
- results <- runUptoStep action bundles
+
+ -- Run the benchmarks to get the results. If we are reusing a previous build
+ -- then only run the "Run" action.
+ results <-
+ case reuseDir of
+ Nothing -> runUptoStep action bundles
+ Just _ -> runOnlyStep Run bundles
+
+ -- Write out the benchmark rsults and shutdown the logger
B.writeFile (Log.binaryPath logState) (encode results)
Log.stopLogger logState
-parseArgsOrDie :: IO Opt
-parseArgsOrDie = do
- args <- getArgs
- case parseCommandLine args of
- Left msg -> putStrLn msg >> exitFailure
- Right opts -> do
- case optHelpMsg opts of
- Just msg -> putStrLn msg >> exitSuccess
- Nothing -> return opts
-
+{------------------------------------------------------------------------------
+ -- Run a single action or an action and its prerequisites
+ ------------------------------------------------------------------------------}
runUptoStep :: Action -> [BenchmarkBundle] -> IO [FibonResult]
-runUptoStep stopAction bundles = do
- sane <- mapM runSanityStep bundles
- if (stopAction == Sanity) then
- return []
- else do
- built <- mapM runBuildStep (catMaybes sane)
- if (stopAction == Build) then
- return []
- else do
- results <- mapM runRunStep (catMaybes built)
- return (catMaybes results)
+runUptoStep Sanity bundles = runSanitySteps bundles >> return []
+runUptoStep Build bundles = runSanitySteps bundles >>= runBuildSteps >> return []
+runUptoStep Run bundles = runSanitySteps bundles >>= runBuildSteps >>= runRunSteps
+
+runOnlyStep :: Action -> [BenchmarkBundle] -> IO [FibonResult]
+runOnlyStep Sanity bundles = runSanitySteps bundles >> return []
+runOnlyStep Build bundles = runBuildSteps bundles >> return []
+runOnlyStep Run bundles = runRunSteps (zip (repeat noBuildData) bundles)
+
+{------------------------------------------------------------------------------
+ -- Run a specific step over a list of bundles and filter out failing results
+ ------------------------------------------------------------------------------}
+runSanitySteps :: [BenchmarkBundle] -> IO [BenchmarkBundle]
+runSanitySteps = runSteps runSanityStep
+
+runBuildSteps :: [BenchmarkBundle] -> IO [(BuildData, BenchmarkBundle)]
+runBuildSteps = runSteps runBuildStep
+
+runRunSteps :: [(BuildData, BenchmarkBundle)] -> IO [FibonResult]
+runRunSteps = runSteps runRunStep
+
+runSteps :: (a -> IO (Maybe b)) -> [a] -> IO [b]
+runSteps act bs = catMaybes `liftM` mapM act bs
+{------------------------------------------------------------------------------
+ -- Run a specific step over a single bundle
+ ------------------------------------------------------------------------------}
runSanityStep :: BenchmarkBundle -> IO (Maybe BenchmarkBundle)
runSanityStep bb = do
logAction Sanity bb
@@ -101,6 +131,9 @@ logAction :: Action -> BenchmarkBundle -> IO ()
logAction action bundle =
Log.notice $ "Benchmark["++(show action)++"] " ++ (bundleName bundle)
+{------------------------------------------------------------------------------
+ -- Generic run function
+ ------------------------------------------------------------------------------}
runAndLogErrors :: BenchmarkBundle -> ActionRunner a -> IO (Maybe a)
runAndLogErrors bundle act = do
result <- try (act bundle)
@@ -116,16 +149,9 @@ runAndLogErrors bundle act = do
logError s = do Log.warn $ "Error running: " ++ name
Log.warn $ " =====> " ++ s
-selectConfig :: ConfigId -> IO RunConfig
-selectConfig configName =
- case find ((== configName) . configId) configManifest of
- Just c -> do return c
- Nothing -> do
- Log.error $ "Unknown config: " ++ configName
- Log.error $ "Available configs:\n " ++ configNames
- exitFailure
- where configNames = concat (intersperse "\n " $ map configId configManifest)
-
+{------------------------------------------------------------------------------
+ -- BenchmarkBundle managament
+ ------------------------------------------------------------------------------}
makeBundles :: RunConfig
-> FilePath -- ^ Working directory
-> FilePath -- ^ Benchmark base path
@@ -148,19 +174,56 @@ expandBenchList = concatMap expand
expand (RunSingle b) = [b]
expand (RunGroup g) = filter (\b -> benchGroup b == g) allBenchmarks
-chooseUniqueName :: FilePath -> String -> IO String
-chooseUniqueName workingDir configName = do
+{------------------------------------------------------------------------------
+ -- Choose paths for build and data results
+ ------------------------------------------------------------------------------}
+-- Choose a unique name that will be used for the log and results file. Also, if
+-- we were given a reuse directory then check that it exists and return it to
+-- use as a key for building the benchmark bundles.
+chooseUniqueNames :: FilePath -> ConfigId -> ReuseDir -> IO (String, String)
+chooseUniqueNames workingDir configName mbReuseId = do
+ checkReuseDir workingDir mbReuseId
wdExists <- doesDirectoryExist workingDir
unless wdExists (createDirectory workingDir)
dirs <- getDirectoryContents workingDir
+ time <- getZonedTime
let numbered = filter (\x -> length x > 0) $ map (takeWhile isDigit) dirs
- case numbered of
- [] -> return $ format (0 :: Int)
- _ -> return $ (format . (+1) . read . last . sort) numbered
+ timestamp = formatTime defaultTimeLocale "%m%d%Y%H%M%S" time
+ nextAvailableUniq =
+ case numbered of
+ [] -> format (0 :: Int)
+ _ -> (format . (+1) . read . last . sort) numbered
+ logUniq = maybe nextAvailableUniq (++"."++timestamp) mbReuseId
+ runUniq = maybe nextAvailableUniq (id) mbReuseId
+ return (logUniq, runUniq)
where
format :: Int -> String
format d = printf "%03d.%s" d configName
+-- Make sure that the directory where we are trying to reuse the build results
+-- actually exists
+checkReuseDir :: FilePath -> Maybe String -> IO ()
+checkReuseDir _wd Nothing = return ()
+checkReuseDir wd (Just dir) = do
+ putStrLn $ "Checking : " ++ path
+ rdExists <- doesDirectoryExist path
+ when (not rdExists)
+ (putStrLn ("Error: Reuse directory " ++ path ++ " does not exist") >> exitFailure)
+ where path = wd </> dir
+
+{------------------------------------------------------------------------------
+ -- Configuration Management
+ ------------------------------------------------------------------------------}
+selectConfig :: ConfigId -> IO RunConfig
+selectConfig configName =
+ case find ((== configName) . configId) configManifest of
+ Just c -> do return c
+ Nothing -> do
+ Log.error $ "Unknown config: " ++ configName
+ Log.error $ "Available configs:\n " ++ configNames
+ exitFailure
+ where configNames = concat (intersperse "\n " $ map configId configManifest)
+
mergeConfigOpts :: RunConfig -> Opt -> RunConfig
mergeConfigOpts rc opt = rc {
tuneList = maybe (tuneList rc) (:[]) (optTuneSetting opt)
@@ -187,3 +250,16 @@ dumpBundleConfig bb = do
flagSpaces = " "++ paramSpace
script = map fst . maybeToList . runScript
scriptArgs = concatMap snd . maybeToList . runScript
+
+{------------------------------------------------------------------------------
+ -- Command line parsing
+ ------------------------------------------------------------------------------}
+parseArgsOrDie :: IO Opt
+parseArgsOrDie = do
+ args <- getArgs
+ case parseCommandLine args of
+ Left msg -> putStrLn msg >> exitFailure
+ Right opts -> do
+ case optHelpMsg opts of
+ Just msg -> putStrLn msg >> exitSuccess
+ Nothing -> return opts

0 comments on commit 050ed0c

Please sign in to comment.