summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/compiler/GF/CompileInParallel.hs15
-rw-r--r--src/compiler/GF/System/Concurrency.hs33
2 files changed, 45 insertions, 3 deletions
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