diff --git a/gf.cabal b/gf.cabal index 9b427afa6..bbdf7d090 100644 --- a/gf.cabal +++ b/gf.cabal @@ -254,11 +254,11 @@ Library GF.Speech.SRGS_XML GF.Speech.VoiceXML GF.System.Catch + GF.System.Concurrency GF.System.Console GF.System.Directory GF.System.Process GF.System.Signal --- GF.System.UseSignal GF.Text.Clitics GF.Text.Coding GF.Text.Lexing diff --git a/src/compiler/GF/CompileInParallel.hs b/src/compiler/GF/CompileInParallel.hs index 07c29febd..7986656ec 100644 --- a/src/compiler/GF/CompileInParallel.hs +++ b/src/compiler/GF/CompileInParallel.hs @@ -4,6 +4,7 @@ import Prelude hiding (catch) import Control.Monad(join,ap,when,unless) import Control.Applicative import GF.Infra.Concurrency +import GF.System.Concurrency import System.FilePath import qualified GF.System.Directory as D import GF.System.Catch(catch,try) @@ -27,11 +28,12 @@ import qualified Data.ByteString.Lazy as BS -- the broken PGF files that can result from mixing different modes in the -- same concrete syntax. -- --- The first argument is supposed to be the number of jobs to run in --- parallel, but this has not been implemented yet. Instead you have to +-- The first argument controls the number of jobs to run in +-- parallel. This works if GF was compiled with GHC>=7.6, otherwise you have to -- use the GHC run-time flag @+RTS -N -RTS@ to enable parallelism. parallelBatchCompile jobs opts rootfiles0 = - do rootfiles <- mapM canonical rootfiles0 + do setJobs jobs + rootfiles <- mapM canonical rootfiles0 lib_dir <- canonical =<< getLibraryDirectory opts filepaths <- mapM (getPathFromFile lib_dir opts) rootfiles let groups = groupFiles lib_dir filepaths @@ -66,6 +68,13 @@ parallelBatchCompile jobs opts rootfiles0 = dropSlash ('\\':p) = p dropSlash p = p +setJobs opt_n = + do ok <- setNumCapabilities opt_n + when (not ok) $ + ePutStrLn $ "To set the number of concurrent threads" + ++" you need to use +RTS -N"++maybe "" show opt_n + ++"\n or recompile GF with ghc>=7.6" + batchCompile1 lib_dir (opts,filepaths) = do cwd <- D.getCurrentDirectory let rel = relativeTo lib_dir cwd diff --git a/src/compiler/GF/System/Concurrency.hs b/src/compiler/GF/System/Concurrency.hs new file mode 100644 index 000000000..38e6559fc --- /dev/null +++ b/src/compiler/GF/System/Concurrency.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE CPP,ForeignFunctionInterface #-} +-- | A variant of 'Control.Concurrent.setNumCapabilities' that automatically +-- detects the number of processors in the system, and is available +-- even when compiling with GHC<7.6. +module GF.System.Concurrency( + -- * Controlling parallelism + setNumCapabilities,getNumberOfProcessors) where +import qualified Control.Concurrent as C +import Foreign.C.Types(CInt(..)) + + + + +-- | Set parallelism to a given number, or use the number of processors. +-- Returns 'False' if compiled with GHC<7.6 and the desired number of threads +-- hasn't already been set with @+RTS -N/n/ -RTS@. +setNumCapabilities opt_n = + do n <- maybe getNumberOfProcessors return opt_n +#if MIN_VERSION_base(4,6,0) + C.setNumCapabilities n + return True +#else + n_now <- C.getNumCapabilities + print (n,n_now) + return (n==n_now) +#endif + +-- | Returns the number of processors in the system. +getNumberOfProcessors = fmap fromEnum c_getNumberOfProcessors + +-- | According to comments in cabal-install cbits/getnumprocessors.c +-- this function is part of the RTS of GHC>=6.12. +foreign import ccall "getNumberOfProcessors" c_getNumberOfProcessors :: IO CInt