From 4624e88753fadfa74301adecbaeef5864a9d7a83 Mon Sep 17 00:00:00 2001 From: Mikhail Glushenkov Date: Fri, 10 Aug 2012 20:48:01 +0200 Subject: [PATCH] Initialise the 'jobs' config file setting with the current number of CPU cores. Fixes #982. Additionally, running 'install -j' without the numerical argument will have the same effect at runtime. Side effect: 'install -jNUM' doesn't work when there's a space between -j and NUM. --- cabal-install/Distribution/Client/Config.hs | 5 ++- cabal-install/Distribution/Client/Install.hs | 13 +++--- cabal-install/Distribution/Client/Setup.hs | 12 ++--- cabal-install/Distribution/Client/Utils.hs | 16 ++++++- cabal-install/cabal-install.cabal | 3 +- cabal-install/cbits/getnumcores.c | 46 ++++++++++++++++++++ 6 files changed, 82 insertions(+), 13 deletions(-) create mode 100644 cabal-install/cbits/getnumcores.c diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs index de15e71443e..93e5a527923 100644 --- a/cabal-install/Distribution/Client/Config.hs +++ b/cabal-install/Distribution/Client/Config.hs @@ -36,6 +36,8 @@ import Distribution.Client.Setup , UploadFlags(..), uploadCommand , ReportFlags(..), reportCommand , showRepo, parseRepo ) +import Distribution.Client.Utils + ( numberOfProcessors ) import Distribution.Simple.Compiler ( OptimisationLevel(..) ) @@ -200,7 +202,8 @@ initialSavedConfig = do }, savedInstallFlags = mempty { installSummaryFile = [toPathTemplate (logsDir "build.log")], - installBuildReports= toFlag AnonymousReports + installBuildReports= toFlag AnonymousReports, + installNumJobs = toFlag (Just numberOfProcessors) } } diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index abd479bcad1..86455faec6c 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -93,7 +93,7 @@ import Distribution.Simple.Setup , toFlag, fromFlag, fromFlagOrDefault, flagToMaybe ) import qualified Distribution.Simple.Setup as Cabal ( installCommand, InstallFlags(..), emptyInstallFlags - , emptyTestFlags, testCommand ) + , emptyTestFlags, testCommand, Flag(..) ) import Distribution.Simple.Utils ( rawSystemExit, comparing ) import Distribution.Simple.InstallDirs as InstallDirs @@ -114,7 +114,7 @@ import Distribution.Version import Distribution.Simple.Utils as Utils ( notice, info, warn, die, intercalate, withTempDirectory ) import Distribution.Client.Utils - ( inDir, mergeBy, MergeResult(..) ) + ( numberOfProcessors, inDir, mergeBy, MergeResult(..) ) import Distribution.System ( Platform, buildPlatform, OS(Windows), buildOS ) import Distribution.Text @@ -767,7 +767,10 @@ performInstallations verbosity platform = InstallPlan.planPlatform installPlan compid = InstallPlan.planCompiler installPlan - numJobs = fromFlag (installNumJobs installFlags) + numJobs = case installNumJobs installFlags of + Cabal.NoFlag -> 1 + Cabal.Flag Nothing -> numberOfProcessors + Cabal.Flag (Just n) -> n numFetchJobs = 2 parallelBuild = numJobs >= 2 @@ -825,14 +828,14 @@ performInstallations verbosity useDefaultTemplate | reportingLevel == DetailedReports = True | isJust installLogFile' = False - | numJobs > 1 = True + | parallelBuild = True | otherwise = False overrideVerbosity :: Bool overrideVerbosity | reportingLevel == DetailedReports = True | isJust installLogFile' = True - | numJobs > 1 = False + | parallelBuild = False | otherwise = False substLogFileName :: PathTemplate -> PackageIdentifier -> FilePath diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index 527951c1e75..a41da03d348 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -616,7 +616,7 @@ data InstallFlags = InstallFlags { installBuildReports :: Flag ReportLevel, installSymlinkBinDir :: Flag FilePath, installOneShot :: Flag Bool, - installNumJobs :: Flag Int + installNumJobs :: Flag (Maybe Int) } defaultInstallFlags :: InstallFlags @@ -640,7 +640,7 @@ defaultInstallFlags = InstallFlags { installBuildReports = Flag NoReports, installSymlinkBinDir = mempty, installOneShot = Flag False, - installNumJobs = Flag 1 + installNumJobs = mempty } where docIndexFile = toPathTemplate ("$datadir" "doc" "index.html") @@ -792,9 +792,11 @@ installOptions showOrParseArgs = , option "j" ["jobs"] "Run NUM jobs simultaneously." installNumJobs (\v flags -> flags { installNumJobs = v }) - (reqArg "NUM" (readP_to_E (\_ -> "jobs should be a number") - (fmap toFlag (Parse.readS_to_P reads))) - (map show . flagToList)) + (optArg "NUM" (readP_to_E (\_ -> "jobs should be a number") + (fmap (toFlag . Just) + (Parse.readS_to_P reads))) + (Flag Nothing) + (map (fmap show) . flagToList)) ] ++ case showOrParseArgs of -- TODO: remove when "cabal install" avoids ParseArgs -> option [] ["only"] diff --git a/cabal-install/Distribution/Client/Utils.hs b/cabal-install/Distribution/Client/Utils.hs index 39035b96bc3..c685f80f069 100644 --- a/cabal-install/Distribution/Client/Utils.hs +++ b/cabal-install/Distribution/Client/Utils.hs @@ -1,10 +1,17 @@ -module Distribution.Client.Utils where +{-# LANGUAGE ForeignFunctionInterface #-} + +module Distribution.Client.Utils ( MergeResult(..) + , mergeBy, duplicates, duplicatesBy + , moreRecentFile, inDir, numberOfProcessors ) + where import Data.List ( sortBy, groupBy ) +import Foreign.C.Types ( CInt(..) ) import System.Directory ( doesFileExist, getModificationTime , getCurrentDirectory, setCurrentDirectory ) +import System.IO.Unsafe ( unsafePerformIO ) import qualified Control.Exception as Exception ( finally ) @@ -58,3 +65,10 @@ inDir (Just d) m = do old <- getCurrentDirectory setCurrentDirectory d m `Exception.finally` setCurrentDirectory old + +foreign import ccall "getNumberOfProcessors" c_getNumberOfProcessors :: IO CInt + +-- The number of processors is not going to change during the duration of the +-- program, so unsafePerformIO is safe here. +numberOfProcessors :: Int +numberOfProcessors = fromEnum $ unsafePerformIO c_getNumberOfProcessors diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 43cdb7c0c1b..e5169e0ff2a 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -136,4 +136,5 @@ Executable cabal cpp-options: -DWIN32 else build-depends: unix >= 1.0 && < 2.6 - extensions: CPP + extensions: CPP, ForeignFunctionInterface + c-sources: cbits/getnumcores.c diff --git a/cabal-install/cbits/getnumcores.c b/cabal-install/cbits/getnumcores.c new file mode 100644 index 00000000000..9d5d76e1441 --- /dev/null +++ b/cabal-install/cbits/getnumcores.c @@ -0,0 +1,46 @@ +#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 612) +/* Since version 6.12, GHC's threaded RTS includes a getNumberOfProcessors + function, so we try to use that if available. cabal-install is always built + with -threaded nowadays. */ +#define HAS_GET_NUMBER_OF_PROCESSORS +#endif + + +#ifndef HAS_GET_NUMBER_OF_PROCESSORS + +#ifdef _WIN32 +#include +#elif MACOS +#include +#include +#elif __linux__ +#include +#endif + +int getNumberOfProcessors() { +#ifdef WIN32 + SYSTEM_INFO sysinfo; + GetSystemInfo(&sysinfo); + return sysinfo.dwNumberOfProcessors; +#elif MACOS + int nm[2]; + size_t len = 4; + uint32_t count; + + nm[0] = CTL_HW; nm[1] = HW_AVAILCPU; + sysctl(nm, 2, &count, &len, NULL, 0); + + if(count < 1) { + nm[1] = HW_NCPU; + sysctl(nm, 2, &count, &len, NULL, 0); + if(count < 1) { count = 1; } + } + return count; +#elif __linux__ + return sysconf(_SC_NPROCESSORS_ONLN); +#else + return 1; +#endif +} + +#endif /* HAS_GET_NUMBER_OF_PROCESSORS */