diff options
Diffstat (limited to 'compiler/main/GhcMake.hs')
| -rw-r--r-- | compiler/main/GhcMake.hs | 29 |
1 files changed, 8 insertions, 21 deletions
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 6599da07f4..b9397ff31e 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -69,6 +69,7 @@ import Util import qualified GHC.LanguageExtensions as LangExt import NameEnv import FileCleanup +import MakeSem import Data.Either ( rights, partitionEithers ) import qualified Data.Map as Map @@ -79,7 +80,6 @@ import qualified FiniteMap as Map ( insertListWith ) import Control.Concurrent ( forkIOWithUnmask, killThread ) import qualified GHC.Conc as CC import Control.Concurrent.MVar -import Control.Concurrent.QSem import Control.Exception import Control.Monad import Control.Monad.Trans.Except ( ExceptT(..), runExceptT, throwE ) @@ -95,7 +95,7 @@ import System.FilePath import System.IO ( fixIO ) import System.IO.Error ( isDoesNotExistError ) -import GHC.Conc ( getNumProcessors, getNumCapabilities, setNumCapabilities ) +import GHC.Conc ( getNumProcessors) label_self :: String -> IO () label_self thread_name = do @@ -875,7 +875,9 @@ checkStability hpt sccs all_home_mods = - IORef) to save space. - - Instead of immediately outputting messages to the standard handles, all - - compilation output is deferred to a per-module TQueue. A QSem is used to + - compilation output is deferred to a per-module TQueue. +TODO Doug update +A QSem is used to - limit the number of workers that are compiling simultaneously. - - Meanwhile, the main thread sequentially loops over all the modules in the @@ -956,23 +958,8 @@ parUpsweep n_jobs mHscMessage old_hpt stable_mods cleanup sccs = do -- module successfully gets compiled, its HMI is pruned from the old HPT. old_hpt_var <- liftIO $ newIORef old_hpt - -- What we use to limit parallelism with. - par_sem <- liftIO $ newQSem n_jobs - - let updNumCapabilities = liftIO $ do - n_capabilities <- getNumCapabilities - n_cpus <- getNumProcessors - -- Setting number of capabilities more than - -- CPU count usually leads to high userspace - -- lock contention. #9221 - let n_caps = min n_jobs n_cpus - unless (n_capabilities /= 1) $ setNumCapabilities n_caps - return n_capabilities - -- Reset the number of capabilities once the upsweep ends. - let resetNumCapabilities orig_n = liftIO $ setNumCapabilities orig_n - - gbracket updNumCapabilities resetNumCapabilities $ \_ -> do + withMakeSem n_jobs (parMakeSemaphore dflags) $ \par_sem -> do -- Sync the global session with the latest HscEnv once the upsweep ends. let finallySyncSession io = io `gfinally` do @@ -1147,7 +1134,7 @@ parUpsweep_one -- ^ The messager -> (HscEnv -> IO ()) -- ^ The callback for cleaning up intermediate files - -> QSem + -> MakeSem -- ^ The semaphore for limiting the number of simultaneous compiles -> MVar HscEnv -- ^ The MVar that synchronizes updates to the global HscEnv @@ -1256,7 +1243,7 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags mHscMessage cleanup let logger err = printBagOfErrors lcl_dflags (srcErrorMessages err) -- Limit the number of parallel compiles. - let withSem sem = bracket_ (waitQSem sem) (signalQSem sem) + let withSem sem = bracket_ (waitMakeSem sem) (signalMakeSem sem) mb_mod_info <- withSem par_sem $ handleSourceError (\err -> do logger err; return Nothing) $ do -- Have the ModSummary and HscEnv point to our local log_action |