+ let base_o = dropExtension output_fn
+ osuf = objectSuf dflags
+ split_odir = base_o ++ "_" ++ osuf ++ "_split"
+
+ io $ createDirectoryHierarchy split_odir
+
+ -- remove M_split/ *.o, because we're going to archive M_split/ *.o
+ -- later and we don't want to pick up any old objects.
+ fs <- io $ getDirectoryContents split_odir
+ io $ mapM_ removeFile $
+ map (split_odir </>) $ filter (osuf `isSuffixOf`) fs
+
+ let as_opts = getOpts dflags opt_a
+
+ 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 :: Int -> FilePath
+ split_obj n = split_odir </>
+ takeFileName base_o ++ "__" ++ show n <.> osuf
+
+ let assemble_file n
+ = SysTools.runAs dflags
+ (map SysTools.Option as_opts ++
+
+ -- 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.
+ (if platformArch (targetPlatform dflags) == ArchSPARC
+ then [SysTools.Option "-mcpu=v9"]
+ else []) ++
+
+ [ SysTools.Option "-c"
+ , SysTools.Option "-o"
+ , SysTools.FileOption "" (split_obj n)
+ , SysTools.FileOption "" (split_s n)
+ ])
+
+ io $ mapM_ assemble_file [1..n]
+
+ -- Note [pipeline-split-init]
+ -- If we have a stub file, it may contain constructor
+ -- functions for initialisation of this module. We can't
+ -- simply leave the stub as a separate object file, because it
+ -- will never be linked in: nothing refers to it. We need to
+ -- ensure that if we ever refer to the data in this module
+ -- that needs initialisation, then we also pull in the
+ -- initialisation routine.
+ --
+ -- To that end, we make a DANGEROUS ASSUMPTION here: the data
+ -- that needs to be initialised is all in the FIRST split
+ -- object. See Note [codegen-split-init].
+
+ PipeState{maybe_stub_o} <- getPipeState
+ case maybe_stub_o of
+ Nothing -> return ()
+ Just stub_o -> io $ do
+ tmp_split_1 <- newTempName dflags osuf
+ let split_1 = split_obj 1
+ copyFile split_1 tmp_split_1
+ removeFile split_1
+ joinObjectFiles dflags [tmp_split_1, stub_o] split_1
+
+ -- join them into a single .o file
+ io $ joinObjectFiles dflags (map split_obj [1..n]) output_fn
+
+ return (next_phase, output_fn)
+
+-----------------------------------------------------------------------------
+-- LlvmOpt phase
+
+runPhase LlvmOpt input_fn dflags
+ = do
+ let lo_opts = getOpts dflags opt_lo
+ let opt_lvl = max 0 (min 2 $ optLevel dflags)
+ -- don't specify anything if user has specified commands. We do this for
+ -- opt but not llc since opt is very specifically for optimisation passes
+ -- only, so if the user is passing us extra options we assume they know
+ -- what they are doing and don't get in the way.
+ let optFlag = if null lo_opts
+ then [SysTools.Option (llvmOpts !! opt_lvl)]
+ else []
+
+ output_fn <- phaseOutputFilename LlvmLlc
+
+ io $ SysTools.runLlvmOpt dflags
+ ([ SysTools.FileOption "" input_fn,
+ SysTools.Option "-o",
+ SysTools.FileOption "" output_fn]
+ ++ optFlag
+ ++ map SysTools.Option lo_opts)
+
+ return (LlvmLlc, output_fn)
+ where
+ -- we always (unless -optlo specified) run Opt since we rely on it to
+ -- fix up some pretty big deficiencies in the code we generate
+ llvmOpts = ["-mem2reg", "-O1", "-O2"]
+
+-----------------------------------------------------------------------------
+-- LlvmLlc phase
+
+runPhase LlvmLlc input_fn dflags
+ = do
+ let lc_opts = getOpts dflags opt_lc
+ opt_lvl = max 0 (min 2 $ optLevel dflags)
+ rmodel | opt_PIC = "pic"
+ | not opt_Static = "dynamic-no-pic"
+ | otherwise = "static"
+
+ output_fn <- phaseOutputFilename LlvmMangle
+
+ io $ SysTools.runLlvmLlc dflags
+ ([ SysTools.Option (llvmOpts !! opt_lvl),
+ SysTools.Option $ "-relocation-model=" ++ rmodel,
+ SysTools.FileOption "" input_fn,
+ SysTools.Option "-o", SysTools.FileOption "" output_fn]
+ ++ map SysTools.Option lc_opts)
+
+ return (LlvmMangle, output_fn)
+ where
+ -- Bug in LLVM at O3 on OSX.
+ llvmOpts = if cTargetOS == OSX
+ then ["-O1", "-O2", "-O2"]
+ else ["-O1", "-O2", "-O3"]
+
+-----------------------------------------------------------------------------
+-- LlvmMangle phase
+
+runPhase LlvmMangle input_fn _dflags
+ = do
+ output_fn <- phaseOutputFilename As
+ io $ llvmFixupAsm input_fn output_fn
+ return (As, output_fn)
+
+-----------------------------------------------------------------------------
+-- merge in stub objects
+
+runPhase MergeStub input_fn dflags
+ = do
+ PipeState{maybe_stub_o} <- getPipeState
+ output_fn <- phaseOutputFilename StopLn
+ case maybe_stub_o of
+ Nothing ->
+ panic "runPhase(MergeStub): no stub"
+ Just stub_o -> do
+ io $ joinObjectFiles dflags [input_fn, stub_o] output_fn
+ return (StopLn, output_fn)
+
+-- warning suppression
+runPhase other _input_fn _dflags =
+ panic ("runPhase: don't know how to run phase " ++ show other)
+
+maybeMergeStub :: CompPipeline Phase
+maybeMergeStub
+ = do
+ PipeState{maybe_stub_o} <- getPipeState
+ if isJust maybe_stub_o then return MergeStub else return StopLn