summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/Driver/Config.hs15
-rw-r--r--compiler/GHC/Linker/Loader.hs23
-rw-r--r--compiler/GHC/Runtime/Interpreter.hs24
3 files changed, 13 insertions, 49 deletions
diff --git a/compiler/GHC/Driver/Config.hs b/compiler/GHC/Driver/Config.hs
index bd9790312b..c92da902c9 100644
--- a/compiler/GHC/Driver/Config.hs
+++ b/compiler/GHC/Driver/Config.hs
@@ -2,7 +2,6 @@
module GHC.Driver.Config
( initOptCoercionOpts
, initSimpleOpts
- , initBCOOpts
, initEvalOpts
)
where
@@ -12,12 +11,8 @@ import GHC.Prelude
import GHC.Driver.Session
import GHC.Core.SimpleOpt
import GHC.Core.Coercion.Opt
-import GHC.Runtime.Interpreter (BCOOpts(..))
import GHCi.Message (EvalOpts(..))
-import GHC.Conc (getNumProcessors)
-import Control.Monad.IO.Class
-
-- | Initialise coercion optimiser configuration from DynFlags
initOptCoercionOpts :: DynFlags -> OptCoercionOpts
initOptCoercionOpts dflags = OptCoercionOpts
@@ -32,16 +27,6 @@ initSimpleOpts dflags = SimpleOpts
, so_eta_red = gopt Opt_DoEtaReduction dflags
}
--- | Extract BCO options from DynFlags
-initBCOOpts :: DynFlags -> IO BCOOpts
-initBCOOpts dflags = do
- -- Serializing ResolvedBCO is expensive, so if we're in parallel mode
- -- (-j<n>) parallelise the serialization.
- n_jobs <- case parMakeCount dflags of
- Nothing -> liftIO getNumProcessors
- Just n -> return n
- return $ BCOOpts n_jobs
-
-- | Extract GHCi options from DynFlags and step
initEvalOpts :: DynFlags -> Bool -> EvalOpts
initEvalOpts dflags step =
diff --git a/compiler/GHC/Linker/Loader.hs b/compiler/GHC/Linker/Loader.hs
index 1b3a283d92..7080bb0776 100644
--- a/compiler/GHC/Linker/Loader.hs
+++ b/compiler/GHC/Linker/Loader.hs
@@ -43,7 +43,6 @@ import GHC.Driver.Phases
import GHC.Driver.Env
import GHC.Driver.Session
import GHC.Driver.Ppr
-import GHC.Driver.Config
import GHC.Driver.Config.Diagnostic
import GHC.Driver.Config.Finder
@@ -598,8 +597,7 @@ loadExpr interp hsc_env span root_ul_bco = do
nobreakarray = error "no break array"
bco_ix = mkNameEnv [(unlinkedBCOName root_ul_bco, 0)]
resolved <- linkBCO interp le bco_ix nobreakarray root_ul_bco
- bco_opts <- initBCOOpts (hsc_dflags hsc_env)
- [root_hvref] <- createBCOs interp bco_opts [resolved]
+ [root_hvref] <- createBCOs interp [resolved]
fhv <- mkFinalizedHValue interp root_hvref
return (pls, fhv)
where
@@ -946,8 +944,7 @@ loadDecls interp hsc_env span cbc@CompiledByteCode{..} = do
, addr_env = plusNameEnv (addr_env le) bc_strs }
-- Link the necessary packages and linkables
- bco_opts <- initBCOOpts (hsc_dflags hsc_env)
- new_bindings <- linkSomeBCOs bco_opts interp le2 [cbc]
+ new_bindings <- linkSomeBCOs interp le2 [cbc]
nms_fhvs <- makeForeignNamedHValueRefs interp new_bindings
let ce2 = extendClosureEnv (closure_env le2) nms_fhvs
!pls2 = pls { linker_env = le2 { closure_env = ce2 } }
@@ -995,7 +992,6 @@ loadModuleLinkables interp hsc_env pls linkables
let (objs, bcos) = partition isObjectLinkable
(concatMap partitionLinkable linkables)
- bco_opts <- initBCOOpts (hsc_dflags hsc_env)
-- Load objects first; they can't depend on BCOs
(pls1, ok_flag) <- loadObjects interp hsc_env pls objs
@@ -1003,7 +999,7 @@ loadModuleLinkables interp hsc_env pls linkables
if failed ok_flag then
return (pls1, Failed)
else do
- pls2 <- dynLinkBCOs bco_opts interp pls1 bcos
+ pls2 <- dynLinkBCOs interp pls1 bcos
return (pls2, Succeeded)
@@ -1156,8 +1152,8 @@ rmDupLinkables already ls
********************************************************************* -}
-dynLinkBCOs :: BCOOpts -> Interp -> LoaderState -> [Linkable] -> IO LoaderState
-dynLinkBCOs bco_opts interp pls bcos = do
+dynLinkBCOs :: Interp -> LoaderState -> [Linkable] -> IO LoaderState
+dynLinkBCOs interp pls bcos = do
let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos
pls1 = pls { bcos_loaded = bcos_loaded' }
@@ -1173,7 +1169,7 @@ dynLinkBCOs bco_opts interp pls bcos = do
ae2 = foldr plusNameEnv (addr_env le1) (map bc_strs cbcs)
le2 = le1 { itbl_env = ie2, addr_env = ae2 }
- names_and_refs <- linkSomeBCOs bco_opts interp le2 cbcs
+ names_and_refs <- linkSomeBCOs interp le2 cbcs
-- We only want to add the external ones to the ClosureEnv
let (to_add, to_drop) = partition (isExternalName.fst) names_and_refs
@@ -1187,8 +1183,7 @@ dynLinkBCOs bco_opts interp pls bcos = do
return $! pls1 { linker_env = le2 { closure_env = ce2 } }
-- Link a bunch of BCOs and return references to their values
-linkSomeBCOs :: BCOOpts
- -> Interp
+linkSomeBCOs :: Interp
-> LinkerEnv
-> [CompiledByteCode]
-> IO [(Name,HValueRef)]
@@ -1196,7 +1191,7 @@ linkSomeBCOs :: BCOOpts
-- the incoming unlinked BCOs. Each gives the
-- value of the corresponding unlinked BCO
-linkSomeBCOs bco_opts interp le mods = foldr fun do_link mods []
+linkSomeBCOs interp le mods = foldr fun do_link mods []
where
fun CompiledByteCode{..} inner accum =
case bc_breaks of
@@ -1211,7 +1206,7 @@ linkSomeBCOs bco_opts interp le mods = foldr fun do_link mods []
bco_ix = mkNameEnv (zip names [0..])
resolved <- sequence [ linkBCO interp le bco_ix breakarray bco
| (breakarray, bco) <- flat ]
- hvrefs <- createBCOs interp bco_opts resolved
+ hvrefs <- createBCOs interp resolved
return (zip names hvrefs)
-- | Useful to apply to the result of 'linkSomeBCOs'
diff --git a/compiler/GHC/Runtime/Interpreter.hs b/compiler/GHC/Runtime/Interpreter.hs
index 4f34cbf03b..64790ba8a4 100644
--- a/compiler/GHC/Runtime/Interpreter.hs
+++ b/compiler/GHC/Runtime/Interpreter.hs
@@ -11,7 +11,6 @@ module GHC.Runtime.Interpreter
( module GHC.Runtime.Interpreter.Types
-- * High-level interface to the interpreter
- , BCOOpts (..)
, evalStmt, EvalStatus_(..), EvalStatus, EvalResult(..), EvalExpr(..)
, resumeStmt
, abandonStmt
@@ -329,26 +328,11 @@ mkCostCentres :: Interp -> String -> [(String,String)] -> IO [RemotePtr CostCent
mkCostCentres interp mod ccs =
interpCmd interp (MkCostCentres mod ccs)
-newtype BCOOpts = BCOOpts
- { bco_n_jobs :: Int -- ^ Number of parallel jobs doing BCO serialization
- }
-
-- | Create a set of BCOs that may be mutually recursive.
-createBCOs :: Interp -> BCOOpts -> [ResolvedBCO] -> IO [HValueRef]
-createBCOs interp opts rbcos = do
- let n_jobs = bco_n_jobs opts
- -- Serializing ResolvedBCO is expensive, so if we support doing it in parallel
- if (n_jobs == 1)
- then
- interpCmd interp (CreateBCOs [runPut (put rbcos)])
- else do
- old_caps <- getNumCapabilities
- if old_caps == n_jobs
- then void $ evaluate puts
- else bracket_ (setNumCapabilities n_jobs)
- (setNumCapabilities old_caps)
- (void $ evaluate puts)
- interpCmd interp (CreateBCOs puts)
+createBCOs :: Interp -> [ResolvedBCO] -> IO [HValueRef]
+createBCOs interp rbcos = do
+ -- Serializing ResolvedBCO is expensive, so we do it in parallel
+ interpCmd interp (CreateBCOs puts)
where
puts = parMap doChunk (chunkList 100 rbcos)
View Lorry Controller Status