Add support for running executable with a script

This commit adds support for a `useRunScript` option in the config
file. The run script can be specified with its own args and then
will be called with its own args plus the executable and any run
flags it specifies.

Having an option for a run script is useful for running the
benchmarks with tools like dynamorio or pin that need to take
control of the executable.

lib/Fibon/ConfigMonad.hs

@@ -15,6 +15,7 @@ module Fibon.ConfigMonad (
   , useGhcDir
   , useGhcInPlaceDir
   , getEnv
+  , useRunScript
 )
 where
 
@@ -40,6 +41,7 @@ data ConfigState a = ConfigState {
   , limit          :: Timeout
   , extraStatsFile :: Maybe FilePath
   , environment    :: [(String, String)]
+  , wrapperScript  :: Maybe (FilePath, [String]) -- (wrapper, wrapper args)
   }
 type ConfigMap   = Map.Map FlagParameter [String]
 type ConfigMonad = GenConfigMonad ()
@@ -69,6 +71,10 @@ noExtraStats :: ConfigMonad
 noExtraStats = CM $
   modify $ (\c -> c {extraStatsFile = Nothing})
 
+useRunScript :: FilePath -> String -> ConfigMonad
+useRunScript wrapper args = CM $
+  modify $ (\c -> c {wrapperScript = Just (wrapper, (words args))})
+
 useGhcDir :: FilePath -> ConfigMonad
 useGhcDir dir = do
   append ConfigureFlags $ "--with-ghc="++(dir </> "ghc")
@@ -92,6 +98,7 @@ runWithInitialFlags fc progEnv cm = toConfig finalState
     , limit          = Infinity
     , extraStatsFile = Nothing
     , environment    = progEnv
+    , wrapperScript  = Nothing
     }
   finalState = execState (configState cm) startState
 

tools/fibon-run/Fibon/Run/BenchmarkBundle.hs

@@ -45,6 +45,7 @@ data BenchmarkBundle = BenchmarkBundle {
     , benchDetails  :: BenchmarkInstance
     , timeout       :: Maybe Int
     , extraStats    :: Maybe FilePath
+    , runScript     :: Maybe (FilePath, [String])
   } deriving (Show)
 
 mkBundle :: RunConfig
@@ -69,6 +70,7 @@ mkBundle rc bm wd bmsDir uniq size tune progEnv =
     , benchDetails  = benchInstance bm size
     , timeout       = timeoutToMicroSeconds (limit configuration)
     , extraStats    = (extraStatsFile configuration)
+    , runScript     = (wrapperScript configuration)
   }
   where
     configuration = mkConfig rc bm size tune progEnv
@@ -132,10 +134,13 @@ pathToStdinFile :: BenchmarkBundle -> FilePath -> FilePath
 pathToStdinFile bb inFile = (pathToExeRunDir bb) </> inFile
 
 benchExeAndArgs :: BenchmarkBundle -> (String, [String])
-benchExeAndArgs bb = (exe, fullArgs)
+benchExeAndArgs bb =
+  case runScript bb of
+    Nothing -> (realExe, realFlags)
+    Just (wrapper, args) -> (wrapper, args ++ realExe : realFlags)
   where
-  exe      = pathToExe bb
-  fullArgs = (runFlags . fullFlags) bb
+  realExe   = pathToExe bb
+  realFlags = (runFlags . fullFlags) bb
 
 prettyRunCommand :: BenchmarkBundle -> String
 prettyRunCommand bb = cmd

tools/fibon-run/Fibon/Run/Config.hs

@@ -7,6 +7,7 @@ module Fibon.Run.Config (
   , Fibon.ConfigMonad.useGhcDir
   , Fibon.ConfigMonad.useGhcInPlaceDir
   , Fibon.ConfigMonad.getEnv
+  , Fibon.ConfigMonad.useRunScript
   , Fibon.Timeout.Timeout(..)
   , Fibon.ConfigMonad.FlagParameter(..)
   , Fibon.ConfigMonad.Configuration

tools/fibon-run/Fibon/Run/Main.hs

@@ -152,12 +152,15 @@ dumpBundleConfig bb = do
   Log.config configString
   where
   configString = bundleName bb
-                  ++ dumpConfig "ConfigFlags" configureFlags
-                  ++ dumpConfig "BuildFlags"  buildFlags
-                  ++ dumpConfig "RunFlags"    runFlags
-  dumpConfig :: String -> (FlagConfig -> [String]) -> String
-  dumpConfig configName accessor = "\n" ++ paramSpaces ++ configName ++
-    (concatMap (\f -> "\n" ++ flagSpaces ++ f) (accessor . fullFlags $ bb))
-  paramSpaces = "  "
-  flagSpaces  = "  "++ paramSpaces
-
+                  ++ dumpConfig "ConfigFlags" (configureFlags . fullFlags)
+                  ++ dumpConfig "BuildFlags"  (buildFlags . fullFlags)
+                  ++ dumpConfig "RunFlags"    (runFlags . fullFlags)
+                  ++ dumpConfig "RunScript"   script
+                  ++ dumpConfig "RunScriptArgs" scriptArgs
+  dumpConfig :: String -> (BenchmarkBundle -> [String]) -> String
+  dumpConfig configName accessor = "\n" ++ paramSpace ++ configName ++
+    (concatMap (\f -> "\n" ++ flagSpaces ++ f) (accessor bb))
+  paramSpace = "  "
+  flagSpaces = "  "++ paramSpace
+  script     =       map fst . maybeToList . runScript
+  scriptArgs = concatMap snd . maybeToList . runScript