-- Interfaces for the compilation manager (interpreted/batch-mode)
preprocess,
- compile,
+ compile, compile',
link,
) where
import Data.Either
import Exception
-import Data.IORef ( readIORef, writeIORef, IORef )
+import Data.IORef ( readIORef )
import GHC.Exts ( Int(..) )
import System.Directory
import System.FilePath
-> Maybe Linkable -- ^ old linkable, if we have one
-> m HomeModInfo -- ^ the complete HomeModInfo, if successful
-compile hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable
+compile = compile' (hscCompileNothing, hscCompileInteractive, hscCompileBatch)
+
+type Compiler m a = HscEnv -> ModSummary -> Bool
+ -> Maybe ModIface -> Maybe (Int, Int)
+ -> m a
+
+compile' :: GhcMonad m =>
+ (Compiler m (HscStatus, ModIface, ModDetails),
+ Compiler m (InteractiveStatus, ModIface, ModDetails),
+ Compiler m (HscStatus, ModIface, ModDetails))
+ -> HscEnv
+ -> ModSummary -- ^ summary for module being compiled
+ -> Int -- ^ module N ...
+ -> Int -- ^ ... of M
+ -> Maybe ModIface -- ^ old interface, if we have one
+ -> Maybe Linkable -- ^ old linkable, if we have one
+ -> m HomeModInfo -- ^ the complete HomeModInfo, if successful
+
+compile' (nothingCompiler, interactiveCompiler, batchCompiler)
+ hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable
= do
let dflags0 = ms_hspp_opts summary
this_mod = ms_mod summary
= ASSERT (isJust maybe_old_linkable)
return maybe_old_linkable
- handleBatch (HscRecomp hasStub)
+ handleBatch (HscRecomp hasStub _)
| isHsBoot src_flavour
= do when (isObjectTarget hsc_lang) $ -- interpreted reaches here too
liftIO $ SysTools.touch dflags' "Touching object file"
(hs_unlinked ++ stub_unlinked)
return (Just linkable)
- handleInterpreted InteractiveNoRecomp
+ handleInterpreted HscNoRecomp
= ASSERT (isJust maybe_old_linkable)
return maybe_old_linkable
- handleInterpreted (InteractiveRecomp hasStub comp_bc modBreaks)
+ handleInterpreted (HscRecomp _hasStub Nothing)
+ = ASSERT (isHsBoot src_flavour)
+ return maybe_old_linkable
+ handleInterpreted (HscRecomp hasStub (Just (comp_bc, modBreaks)))
= do stub_unlinked <- getStubLinkable hasStub
let hs_unlinked = [BCOs comp_bc modBreaks]
unlinked_time = ms_hs_date summary
hm_linkable = linkable })
-- run the compiler
case hsc_lang of
- HscInterpreted
- | isHsBoot src_flavour ->
- runCompiler hscCompileNothing handleBatch
- | otherwise ->
- runCompiler hscCompileInteractive handleInterpreted
+ HscInterpreted ->
+ runCompiler interactiveCompiler handleInterpreted
HscNothing ->
- runCompiler hscCompileNothing handleBatch
+ runCompiler nothingCompiler handleBatch
_other ->
- runCompiler hscCompileBatch handleBatch
+ runCompiler batchCompiler handleBatch
+
-----------------------------------------------------------------------------
-- stub .h and .c files (for foreign export support)
-- than the source file (else we wouldn't be in HscNoRecomp)
-- but we touch it anyway, to keep 'make' happy (we think).
return (StopLn, dflags', Just location4, o_file)
- (HscRecomp hasStub)
+ (HscRecomp hasStub _)
-> do when hasStub $
do stub_o <- compileStub hsc_env' mod location4
liftIO $ consIORef v_Ld_inputs stub_o
-- Save the number of split files for future references
s <- readFile n_files_fn
let n_files = read s :: Int
- writeIORef v_Split_info (split_s_prefix, n_files)
+ dflags' = dflags { splitInfo = Just (split_s_prefix, n_files) }
-- Remember to delete all these files
- addFilesToClean [ split_s_prefix ++ "__" ++ show n ++ ".s"
- | n <- [1..n_files]]
+ addFilesToClean dflags' [ split_s_prefix ++ "__" ++ show n ++ ".s"
+ | n <- [1..n_files]]
- return (SplitAs, dflags, maybe_loc, "**splitmangle**")
+ return (SplitAs, dflags', maybe_loc, "**splitmangle**")
-- we don't use the filename
-----------------------------------------------------------------------------
let as_opts = getOpts dflags opt_a
- (split_s_prefix, n) <- readIORef v_Split_info
+ let (split_s_prefix, n) = case splitInfo dflags of
+ Nothing -> panic "No split info"
+ Just x -> x
let split_s n = split_s_prefix ++ "__" ++ show n <.> "s"
split_obj n = split_odir </>
let assemble_file n
= SysTools.runAs dflags
(map SysTools.Option as_opts ++
+#ifdef sparc_TARGET_ARCH
+ -- We only support SparcV9 and better because V8 lacks an atomic CAS
+ -- instruction so we have to make sure that the assembler accepts the
+ -- instruction set. Note that the user can still override this
+ -- (e.g., -mcpu=ultrasparc). GCC picks the "best" -mcpu flag
+ -- regardless of the ordering.
+ --
+ -- This is a temporary hack.
+ [ SysTools.Option "-mcpu=v9" ] ++
+#endif
[ SysTools.Option "-c"
, SysTools.Option "-o"
, SysTools.FileOption "" (split_obj n)
-- otherwise, stick to the plan
| otherwise = current_hsc_lang
-GLOBAL_VAR(v_Split_info, ("",0), (String,Int))
- -- The split prefix and number of files