arm64: 64bit iOS and SMP support (#7942)
[ghc.git] / compiler / main / DriverPipeline.hs
1 {-# LANGUAGE CPP, NamedFieldPuns, NondecreasingIndentation #-}
2 {-# OPTIONS_GHC -fno-cse #-}
3 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
4
5 -----------------------------------------------------------------------------
6 --
7 -- GHC Driver
8 --
9 -- (c) The University of Glasgow 2005
10 --
11 -----------------------------------------------------------------------------
12
13 module DriverPipeline (
14 -- Run a series of compilation steps in a pipeline, for a
15 -- collection of source files.
16 oneShot, compileFile,
17
18 -- Interfaces for the batch-mode driver
19 linkBinary,
20
21 -- Interfaces for the compilation manager (interpreted/batch-mode)
22 preprocess,
23 compileOne, compileOne',
24 link,
25
26 -- Exports for hooks to override runPhase and link
27 PhasePlus(..), CompPipeline(..), PipeEnv(..), PipeState(..),
28 phaseOutputFilename, getPipeState, getPipeEnv,
29 hscPostBackendPhase, getLocation, setModLocation, setDynFlags,
30 runPhase, exeFileName,
31 mkExtraObjToLinkIntoBinary, mkNoteObjsToLinkIntoBinary,
32 maybeCreateManifest, runPhase_MoveBinary,
33 linkingNeeded, checkLinkInfo
34 ) where
35
36 #include "HsVersions.h"
37
38 import PipelineMonad
39 import Packages
40 import HeaderInfo
41 import DriverPhases
42 import SysTools
43 import HscMain
44 import Finder
45 import HscTypes hiding ( Hsc )
46 import Outputable
47 import Module
48 import UniqFM ( eltsUFM )
49 import ErrUtils
50 import DynFlags
51 import Config
52 import Panic
53 import Util
54 import StringBuffer ( hGetStringBuffer )
55 import BasicTypes ( SuccessFlag(..) )
56 import Maybes ( expectJust )
57 import SrcLoc
58 import FastString
59 import LlvmCodeGen ( llvmFixupAsm )
60 import MonadUtils
61 import Platform
62 import TcRnTypes
63 import Hooks
64
65 import Exception
66 import Data.IORef ( readIORef )
67 import System.Directory
68 import System.FilePath
69 import System.IO
70 import Control.Monad
71 import Data.List ( isSuffixOf )
72 import Data.Maybe
73 import System.Environment
74 import Data.Char
75
76 -- ---------------------------------------------------------------------------
77 -- Pre-process
78
79 -- | Just preprocess a file, put the result in a temp. file (used by the
80 -- compilation manager during the summary phase).
81 --
82 -- We return the augmented DynFlags, because they contain the result
83 -- of slurping in the OPTIONS pragmas
84
85 preprocess :: HscEnv
86 -> (FilePath, Maybe Phase) -- ^ filename and starting phase
87 -> IO (DynFlags, FilePath)
88 preprocess hsc_env (filename, mb_phase) =
89 ASSERT2(isJust mb_phase || isHaskellSrcFilename filename, text filename)
90 runPipeline anyHsc hsc_env (filename, fmap RealPhase mb_phase)
91 Nothing Temporary Nothing{-no ModLocation-} Nothing{-no stub-}
92
93 -- ---------------------------------------------------------------------------
94
95 -- | Compile
96 --
97 -- Compile a single module, under the control of the compilation manager.
98 --
99 -- This is the interface between the compilation manager and the
100 -- compiler proper (hsc), where we deal with tedious details like
101 -- reading the OPTIONS pragma from the source file, converting the
102 -- C or assembly that GHC produces into an object file, and compiling
103 -- FFI stub files.
104 --
105 -- NB. No old interface can also mean that the source has changed.
106
107 compileOne :: HscEnv
108 -> ModSummary -- ^ summary for module being compiled
109 -> Int -- ^ module N ...
110 -> Int -- ^ ... of M
111 -> Maybe ModIface -- ^ old interface, if we have one
112 -> Maybe Linkable -- ^ old linkable, if we have one
113 -> SourceModified
114 -> IO HomeModInfo -- ^ the complete HomeModInfo, if successful
115
116 compileOne = compileOne' Nothing (Just batchMsg)
117
118 compileOne' :: Maybe TcGblEnv
119 -> Maybe Messager
120 -> HscEnv
121 -> ModSummary -- ^ summary for module being compiled
122 -> Int -- ^ module N ...
123 -> Int -- ^ ... of M
124 -> Maybe ModIface -- ^ old interface, if we have one
125 -> Maybe Linkable -- ^ old linkable, if we have one
126 -> SourceModified
127 -> IO HomeModInfo -- ^ the complete HomeModInfo, if successful
128
129 compileOne' m_tc_result mHscMessage
130 hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable
131 source_modified0
132 = do
133 let dflags0 = ms_hspp_opts summary
134 this_mod = ms_mod summary
135 src_flavour = ms_hsc_src summary
136 location = ms_location summary
137 input_fn = expectJust "compile:hs" (ml_hs_file location)
138 input_fnpp = ms_hspp_file summary
139 mod_graph = hsc_mod_graph hsc_env0
140 needsTH = any (xopt Opt_TemplateHaskell . ms_hspp_opts) mod_graph
141 needsQQ = any (xopt Opt_QuasiQuotes . ms_hspp_opts) mod_graph
142 needsLinker = needsTH || needsQQ
143 isDynWay = any (== WayDyn) (ways dflags0)
144 isProfWay = any (== WayProf) (ways dflags0)
145 -- #8180 - when using TemplateHaskell, switch on -dynamic-too so
146 -- the linker can correctly load the object files.
147 let dflags1 = if needsLinker && dynamicGhc && not isDynWay && not isProfWay
148 then gopt_set dflags0 Opt_BuildDynamicToo
149 else dflags0
150
151 debugTraceMsg dflags1 2 (text "compile: input file" <+> text input_fnpp)
152
153 let basename = dropExtension input_fn
154
155 -- We add the directory in which the .hs files resides) to the import path.
156 -- This is needed when we try to compile the .hc file later, if it
157 -- imports a _stub.h file that we created here.
158 let current_dir = takeDirectory basename
159 old_paths = includePaths dflags1
160 dflags = dflags1 { includePaths = current_dir : old_paths }
161 hsc_env = hsc_env0 {hsc_dflags = dflags}
162
163 -- Figure out what lang we're generating
164 let hsc_lang = hscTarget dflags
165 -- ... and what the next phase should be
166 let next_phase = hscPostBackendPhase dflags src_flavour hsc_lang
167 -- ... and what file to generate the output into
168 output_fn <- getOutputFilename next_phase
169 Temporary basename dflags next_phase (Just location)
170
171 -- -fforce-recomp should also work with --make
172 let force_recomp = gopt Opt_ForceRecomp dflags
173 source_modified
174 | force_recomp || isNothing maybe_old_linkable = SourceModified
175 | otherwise = source_modified0
176 object_filename = ml_obj_file location
177
178 let always_do_basic_recompilation_check = case hsc_lang of
179 HscInterpreted -> True
180 _ -> False
181
182 e <- genericHscCompileGetFrontendResult
183 always_do_basic_recompilation_check
184 m_tc_result mHscMessage
185 hsc_env summary source_modified mb_old_iface (mod_index, nmods)
186
187 case e of
188 Left iface ->
189 do details <- genModDetails hsc_env iface
190 MASSERT(isJust maybe_old_linkable)
191 return (HomeModInfo{ hm_details = details,
192 hm_iface = iface,
193 hm_linkable = maybe_old_linkable })
194
195 Right (tc_result, mb_old_hash) ->
196 -- run the compiler
197 case hsc_lang of
198 HscInterpreted ->
199 case ms_hsc_src summary of
200 t | isHsBootOrSig t ->
201 do (iface, _changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash
202 return (HomeModInfo{ hm_details = details,
203 hm_iface = iface,
204 hm_linkable = maybe_old_linkable })
205 _ -> do guts0 <- hscDesugar hsc_env summary tc_result
206 guts <- hscSimplify hsc_env guts0
207 (iface, _changed, details, cgguts) <- hscNormalIface hsc_env guts mb_old_hash
208 (hasStub, comp_bc, modBreaks) <- hscInteractive hsc_env cgguts summary
209
210 stub_o <- case hasStub of
211 Nothing -> return []
212 Just stub_c -> do
213 stub_o <- compileStub hsc_env stub_c
214 return [DotO stub_o]
215
216 let hs_unlinked = [BCOs comp_bc modBreaks]
217 unlinked_time = ms_hs_date summary
218 -- Why do we use the timestamp of the source file here,
219 -- rather than the current time? This works better in
220 -- the case where the local clock is out of sync
221 -- with the filesystem's clock. It's just as accurate:
222 -- if the source is modified, then the linkable will
223 -- be out of date.
224 let linkable = LM unlinked_time this_mod
225 (hs_unlinked ++ stub_o)
226
227 return (HomeModInfo{ hm_details = details,
228 hm_iface = iface,
229 hm_linkable = Just linkable })
230 HscNothing ->
231 do (iface, changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash
232 when (gopt Opt_WriteInterface dflags) $
233 hscWriteIface dflags iface changed summary
234 let linkable = if isHsBootOrSig src_flavour
235 then maybe_old_linkable
236 else Just (LM (ms_hs_date summary) this_mod [])
237 return (HomeModInfo{ hm_details = details,
238 hm_iface = iface,
239 hm_linkable = linkable })
240
241 _ ->
242 case ms_hsc_src summary of
243 t | isHsBootOrSig t ->
244 do (iface, changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash
245 hscWriteIface dflags iface changed summary
246 touchObjectFile dflags object_filename
247 return (HomeModInfo{ hm_details = details,
248 hm_iface = iface,
249 hm_linkable = maybe_old_linkable })
250
251 _ -> do guts0 <- hscDesugar hsc_env summary tc_result
252 guts <- hscSimplify hsc_env guts0
253 (iface, changed, details, cgguts) <- hscNormalIface hsc_env guts mb_old_hash
254 hscWriteIface dflags iface changed summary
255
256 -- We're in --make mode: finish the compilation pipeline.
257 let mod_name = ms_mod_name summary
258 _ <- runPipeline StopLn hsc_env
259 (output_fn,
260 Just (HscOut src_flavour mod_name (HscRecomp cgguts summary)))
261 (Just basename)
262 Persistent
263 (Just location)
264 Nothing
265 -- The object filename comes from the ModLocation
266 o_time <- getModificationUTCTime object_filename
267 let linkable = LM o_time this_mod [DotO object_filename]
268
269 return (HomeModInfo{ hm_details = details,
270 hm_iface = iface,
271 hm_linkable = Just linkable })
272
273 -----------------------------------------------------------------------------
274 -- stub .h and .c files (for foreign export support)
275
276 -- The _stub.c file is derived from the haskell source file, possibly taking
277 -- into account the -stubdir option.
278 --
279 -- The object file created by compiling the _stub.c file is put into a
280 -- temporary file, which will be later combined with the main .o file
281 -- (see the MergeStubs phase).
282
283 compileStub :: HscEnv -> FilePath -> IO FilePath
284 compileStub hsc_env stub_c = do
285 (_, stub_o) <- runPipeline StopLn hsc_env (stub_c,Nothing) Nothing
286 Temporary Nothing{-no ModLocation-} Nothing
287
288 return stub_o
289
290 -- ---------------------------------------------------------------------------
291 -- Link
292
293 link :: GhcLink -- interactive or batch
294 -> DynFlags -- dynamic flags
295 -> Bool -- attempt linking in batch mode?
296 -> HomePackageTable -- what to link
297 -> IO SuccessFlag
298
299 -- For the moment, in the batch linker, we don't bother to tell doLink
300 -- which packages to link -- it just tries all that are available.
301 -- batch_attempt_linking should only be *looked at* in batch mode. It
302 -- should only be True if the upsweep was successful and someone
303 -- exports main, i.e., we have good reason to believe that linking
304 -- will succeed.
305
306 link ghcLink dflags
307 = lookupHook linkHook l dflags ghcLink dflags
308 where
309 l LinkInMemory _ _ _
310 = if cGhcWithInterpreter == "YES"
311 then -- Not Linking...(demand linker will do the job)
312 return Succeeded
313 else panicBadLink LinkInMemory
314
315 l NoLink _ _ _
316 = return Succeeded
317
318 l LinkBinary dflags batch_attempt_linking hpt
319 = link' dflags batch_attempt_linking hpt
320
321 l LinkStaticLib dflags batch_attempt_linking hpt
322 = link' dflags batch_attempt_linking hpt
323
324 l LinkDynLib dflags batch_attempt_linking hpt
325 = link' dflags batch_attempt_linking hpt
326
327 panicBadLink :: GhcLink -> a
328 panicBadLink other = panic ("link: GHC not built to link this way: " ++
329 show other)
330
331 link' :: DynFlags -- dynamic flags
332 -> Bool -- attempt linking in batch mode?
333 -> HomePackageTable -- what to link
334 -> IO SuccessFlag
335
336 link' dflags batch_attempt_linking hpt
337 | batch_attempt_linking
338 = do
339 let
340 staticLink = case ghcLink dflags of
341 LinkStaticLib -> True
342 _ -> platformBinariesAreStaticLibs (targetPlatform dflags)
343
344 -- Don't attempt to link hsigs; they don't actually produce objects.
345 -- This is in contrast to hs-boot files, which will /eventually/
346 -- get objects.
347 home_mod_infos =
348 filter ((==Nothing).mi_sig_of.hm_iface) (eltsUFM hpt)
349
350 -- the packages we depend on
351 pkg_deps = concatMap (map fst . dep_pkgs . mi_deps . hm_iface) home_mod_infos
352
353 -- the linkables to link
354 linkables = map (expectJust "link".hm_linkable) home_mod_infos
355
356 debugTraceMsg dflags 3 (text "link: linkables are ..." $$ vcat (map ppr linkables))
357
358 -- check for the -no-link flag
359 if isNoLink (ghcLink dflags)
360 then do debugTraceMsg dflags 3 (text "link(batch): linking omitted (-c flag given).")
361 return Succeeded
362 else do
363
364 let getOfiles (LM _ _ us) = map nameOfObject (filter isObject us)
365 obj_files = concatMap getOfiles linkables
366
367 exe_file = exeFileName staticLink dflags
368
369 linking_needed <- linkingNeeded dflags staticLink linkables pkg_deps
370
371 if not (gopt Opt_ForceRecomp dflags) && not linking_needed
372 then do debugTraceMsg dflags 2 (text exe_file <+> ptext (sLit "is up to date, linking not required."))
373 return Succeeded
374 else do
375
376 compilationProgressMsg dflags ("Linking " ++ exe_file ++ " ...")
377
378 -- Don't showPass in Batch mode; doLink will do that for us.
379 let link = case ghcLink dflags of
380 LinkBinary -> linkBinary
381 LinkStaticLib -> linkStaticLibCheck
382 LinkDynLib -> linkDynLibCheck
383 other -> panicBadLink other
384 link dflags obj_files pkg_deps
385
386 debugTraceMsg dflags 3 (text "link: done")
387
388 -- linkBinary only returns if it succeeds
389 return Succeeded
390
391 | otherwise
392 = do debugTraceMsg dflags 3 (text "link(batch): upsweep (partially) failed OR" $$
393 text " Main.main not exported; not linking.")
394 return Succeeded
395
396
397 linkingNeeded :: DynFlags -> Bool -> [Linkable] -> [PackageKey] -> IO Bool
398 linkingNeeded dflags staticLink linkables pkg_deps = do
399 -- if the modification time on the executable is later than the
400 -- modification times on all of the objects and libraries, then omit
401 -- linking (unless the -fforce-recomp flag was given).
402 let exe_file = exeFileName staticLink dflags
403 e_exe_time <- tryIO $ getModificationUTCTime exe_file
404 case e_exe_time of
405 Left _ -> return True
406 Right t -> do
407 -- first check object files and extra_ld_inputs
408 let extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]
409 e_extra_times <- mapM (tryIO . getModificationUTCTime) extra_ld_inputs
410 let (errs,extra_times) = splitEithers e_extra_times
411 let obj_times = map linkableTime linkables ++ extra_times
412 if not (null errs) || any (t <) obj_times
413 then return True
414 else do
415
416 -- next, check libraries. XXX this only checks Haskell libraries,
417 -- not extra_libraries or -l things from the command line.
418 let pkg_hslibs = [ (libraryDirs c, lib)
419 | Just c <- map (lookupPackage dflags) pkg_deps,
420 lib <- packageHsLibs dflags c ]
421
422 pkg_libfiles <- mapM (uncurry (findHSLib dflags)) pkg_hslibs
423 if any isNothing pkg_libfiles then return True else do
424 e_lib_times <- mapM (tryIO . getModificationUTCTime)
425 (catMaybes pkg_libfiles)
426 let (lib_errs,lib_times) = splitEithers e_lib_times
427 if not (null lib_errs) || any (t <) lib_times
428 then return True
429 else checkLinkInfo dflags pkg_deps exe_file
430
431 -- Returns 'False' if it was, and we can avoid linking, because the
432 -- previous binary was linked with "the same options".
433 checkLinkInfo :: DynFlags -> [PackageKey] -> FilePath -> IO Bool
434 checkLinkInfo dflags pkg_deps exe_file
435 | not (platformSupportsSavingLinkOpts (platformOS (targetPlatform dflags)))
436 -- ToDo: Windows and OS X do not use the ELF binary format, so
437 -- readelf does not work there. We need to find another way to do
438 -- this.
439 = return False -- conservatively we should return True, but not
440 -- linking in this case was the behaviour for a long
441 -- time so we leave it as-is.
442 | otherwise
443 = do
444 link_info <- getLinkInfo dflags pkg_deps
445 debugTraceMsg dflags 3 $ text ("Link info: " ++ link_info)
446 m_exe_link_info <- readElfSection dflags ghcLinkInfoSectionName exe_file
447 debugTraceMsg dflags 3 $ text ("Exe link info: " ++ show m_exe_link_info)
448 return (Just link_info /= m_exe_link_info)
449
450 platformSupportsSavingLinkOpts :: OS -> Bool
451 platformSupportsSavingLinkOpts os
452 | os == OSSolaris2 = False -- see #5382
453 | otherwise = osElfTarget os
454
455 ghcLinkInfoSectionName :: String
456 ghcLinkInfoSectionName = ".debug-ghc-link-info"
457 -- if we use the ".debug" prefix, then strip will strip it by default
458
459 findHSLib :: DynFlags -> [String] -> String -> IO (Maybe FilePath)
460 findHSLib dflags dirs lib = do
461 let batch_lib_file = if gopt Opt_Static dflags
462 then "lib" ++ lib <.> "a"
463 else mkSOName (targetPlatform dflags) lib
464 found <- filterM doesFileExist (map (</> batch_lib_file) dirs)
465 case found of
466 [] -> return Nothing
467 (x:_) -> return (Just x)
468
469 -- -----------------------------------------------------------------------------
470 -- Compile files in one-shot mode.
471
472 oneShot :: HscEnv -> Phase -> [(String, Maybe Phase)] -> IO ()
473 oneShot hsc_env stop_phase srcs = do
474 o_files <- mapM (compileFile hsc_env stop_phase) srcs
475 doLink (hsc_dflags hsc_env) stop_phase o_files
476
477 compileFile :: HscEnv -> Phase -> (FilePath, Maybe Phase) -> IO FilePath
478 compileFile hsc_env stop_phase (src, mb_phase) = do
479 exists <- doesFileExist src
480 when (not exists) $
481 throwGhcExceptionIO (CmdLineError ("does not exist: " ++ src))
482
483 let
484 dflags = hsc_dflags hsc_env
485 split = gopt Opt_SplitObjs dflags
486 mb_o_file = outputFile dflags
487 ghc_link = ghcLink dflags -- Set by -c or -no-link
488
489 -- When linking, the -o argument refers to the linker's output.
490 -- otherwise, we use it as the name for the pipeline's output.
491 output
492 -- If we are dong -fno-code, then act as if the output is
493 -- 'Temporary'. This stops GHC trying to copy files to their
494 -- final location.
495 | HscNothing <- hscTarget dflags = Temporary
496 | StopLn <- stop_phase, not (isNoLink ghc_link) = Persistent
497 -- -o foo applies to linker
498 | isJust mb_o_file = SpecificFile
499 -- -o foo applies to the file we are compiling now
500 | otherwise = Persistent
501
502 stop_phase' = case stop_phase of
503 As _ | split -> SplitAs
504 _ -> stop_phase
505
506 ( _, out_file) <- runPipeline stop_phase' hsc_env
507 (src, fmap RealPhase mb_phase) Nothing output
508 Nothing{-no ModLocation-} Nothing
509 return out_file
510
511
512 doLink :: DynFlags -> Phase -> [FilePath] -> IO ()
513 doLink dflags stop_phase o_files
514 | not (isStopLn stop_phase)
515 = return () -- We stopped before the linking phase
516
517 | otherwise
518 = case ghcLink dflags of
519 NoLink -> return ()
520 LinkBinary -> linkBinary dflags o_files []
521 LinkStaticLib -> linkStaticLibCheck dflags o_files []
522 LinkDynLib -> linkDynLibCheck dflags o_files []
523 other -> panicBadLink other
524
525
526 -- ---------------------------------------------------------------------------
527
528 -- | Run a compilation pipeline, consisting of multiple phases.
529 --
530 -- This is the interface to the compilation pipeline, which runs
531 -- a series of compilation steps on a single source file, specifying
532 -- at which stage to stop.
533 --
534 -- The DynFlags can be modified by phases in the pipeline (eg. by
535 -- OPTIONS_GHC pragmas), and the changes affect later phases in the
536 -- pipeline.
537 runPipeline
538 :: Phase -- ^ When to stop
539 -> HscEnv -- ^ Compilation environment
540 -> (FilePath,Maybe PhasePlus) -- ^ Input filename (and maybe -x suffix)
541 -> Maybe FilePath -- ^ original basename (if different from ^^^)
542 -> PipelineOutput -- ^ Output filename
543 -> Maybe ModLocation -- ^ A ModLocation, if this is a Haskell module
544 -> Maybe FilePath -- ^ stub object, if we have one
545 -> IO (DynFlags, FilePath) -- ^ (final flags, output filename)
546 runPipeline stop_phase hsc_env0 (input_fn, mb_phase)
547 mb_basename output maybe_loc maybe_stub_o
548
549 = do let
550 dflags0 = hsc_dflags hsc_env0
551
552 -- Decide where dump files should go based on the pipeline output
553 dflags = dflags0 { dumpPrefix = Just (basename ++ ".") }
554 hsc_env = hsc_env0 {hsc_dflags = dflags}
555
556 (input_basename, suffix) = splitExtension input_fn
557 suffix' = drop 1 suffix -- strip off the .
558 basename | Just b <- mb_basename = b
559 | otherwise = input_basename
560
561 -- If we were given a -x flag, then use that phase to start from
562 start_phase = fromMaybe (RealPhase (startPhase suffix')) mb_phase
563
564 isHaskell (RealPhase (Unlit _)) = True
565 isHaskell (RealPhase (Cpp _)) = True
566 isHaskell (RealPhase (HsPp _)) = True
567 isHaskell (RealPhase (Hsc _)) = True
568 isHaskell (HscOut {}) = True
569 isHaskell _ = False
570
571 isHaskellishFile = isHaskell start_phase
572
573 env = PipeEnv{ pe_isHaskellishFile = isHaskellishFile,
574 stop_phase,
575 src_filename = input_fn,
576 src_basename = basename,
577 src_suffix = suffix',
578 output_spec = output }
579
580 -- We want to catch cases of "you can't get there from here" before
581 -- we start the pipeline, because otherwise it will just run off the
582 -- end.
583 --
584 -- There is a partial ordering on phases, where A < B iff A occurs
585 -- before B in a normal compilation pipeline.
586
587 let happensBefore' = happensBefore dflags
588 case start_phase of
589 RealPhase start_phase' ->
590 when (not (start_phase' `happensBefore'` stop_phase)) $
591 throwGhcExceptionIO (UsageError
592 ("cannot compile this file to desired target: "
593 ++ input_fn))
594 HscOut {} -> return ()
595
596 debugTraceMsg dflags 4 (text "Running the pipeline")
597 r <- runPipeline' start_phase hsc_env env input_fn
598 maybe_loc maybe_stub_o
599
600 -- If we are compiling a Haskell module, and doing
601 -- -dynamic-too, but couldn't do the -dynamic-too fast
602 -- path, then rerun the pipeline for the dyn way
603 let dflags = extractDynFlags hsc_env
604 -- NB: Currently disabled on Windows (ref #7134, #8228, and #5987)
605 when (not $ platformOS (targetPlatform dflags) == OSMinGW32) $ do
606 when isHaskellishFile $ whenCannotGenerateDynamicToo dflags $ do
607 debugTraceMsg dflags 4
608 (text "Running the pipeline again for -dynamic-too")
609 let dflags' = dynamicTooMkDynamicDynFlags dflags
610 hsc_env' <- newHscEnv dflags'
611 _ <- runPipeline' start_phase hsc_env' env input_fn
612 maybe_loc maybe_stub_o
613 return ()
614 return r
615
616 runPipeline'
617 :: PhasePlus -- ^ When to start
618 -> HscEnv -- ^ Compilation environment
619 -> PipeEnv
620 -> FilePath -- ^ Input filename
621 -> Maybe ModLocation -- ^ A ModLocation, if this is a Haskell module
622 -> Maybe FilePath -- ^ stub object, if we have one
623 -> IO (DynFlags, FilePath) -- ^ (final flags, output filename)
624 runPipeline' start_phase hsc_env env input_fn
625 maybe_loc maybe_stub_o
626 = do
627 -- Execute the pipeline...
628 let state = PipeState{ hsc_env, maybe_loc, maybe_stub_o = maybe_stub_o }
629
630 evalP (pipeLoop start_phase input_fn) env state
631
632 -- ---------------------------------------------------------------------------
633 -- outer pipeline loop
634
635 -- | pipeLoop runs phases until we reach the stop phase
636 pipeLoop :: PhasePlus -> FilePath -> CompPipeline (DynFlags, FilePath)
637 pipeLoop phase input_fn = do
638 env <- getPipeEnv
639 dflags <- getDynFlags
640 let happensBefore' = happensBefore dflags
641 stopPhase = stop_phase env
642 case phase of
643 RealPhase realPhase | realPhase `eqPhase` stopPhase -- All done
644 -> -- Sometimes, a compilation phase doesn't actually generate any output
645 -- (eg. the CPP phase when -fcpp is not turned on). If we end on this
646 -- stage, but we wanted to keep the output, then we have to explicitly
647 -- copy the file, remembering to prepend a {-# LINE #-} pragma so that
648 -- further compilation stages can tell what the original filename was.
649 case output_spec env of
650 Temporary ->
651 return (dflags, input_fn)
652 output ->
653 do pst <- getPipeState
654 final_fn <- liftIO $ getOutputFilename
655 stopPhase output (src_basename env)
656 dflags stopPhase (maybe_loc pst)
657 when (final_fn /= input_fn) $ do
658 let msg = ("Copying `" ++ input_fn ++"' to `" ++ final_fn ++ "'")
659 line_prag = Just ("{-# LINE 1 \"" ++ src_filename env ++ "\" #-}\n")
660 liftIO $ copyWithHeader dflags msg line_prag input_fn final_fn
661 return (dflags, final_fn)
662
663
664 | not (realPhase `happensBefore'` stopPhase)
665 -- Something has gone wrong. We'll try to cover all the cases when
666 -- this could happen, so if we reach here it is a panic.
667 -- eg. it might happen if the -C flag is used on a source file that
668 -- has {-# OPTIONS -fasm #-}.
669 -> panic ("pipeLoop: at phase " ++ show realPhase ++
670 " but I wanted to stop at phase " ++ show stopPhase)
671
672 _
673 -> do liftIO $ debugTraceMsg dflags 4
674 (ptext (sLit "Running phase") <+> ppr phase)
675 (next_phase, output_fn) <- runHookedPhase phase input_fn dflags
676 r <- pipeLoop next_phase output_fn
677 case phase of
678 HscOut {} ->
679 whenGeneratingDynamicToo dflags $ do
680 setDynFlags $ dynamicTooMkDynamicDynFlags dflags
681 -- TODO shouldn't ignore result:
682 _ <- pipeLoop phase input_fn
683 return ()
684 _ ->
685 return ()
686 return r
687
688 runHookedPhase :: PhasePlus -> FilePath -> DynFlags
689 -> CompPipeline (PhasePlus, FilePath)
690 runHookedPhase pp input dflags =
691 lookupHook runPhaseHook runPhase dflags pp input dflags
692
693 -- -----------------------------------------------------------------------------
694 -- In each phase, we need to know into what filename to generate the
695 -- output. All the logic about which filenames we generate output
696 -- into is embodied in the following function.
697
698 phaseOutputFilename :: Phase{-next phase-} -> CompPipeline FilePath
699 phaseOutputFilename next_phase = do
700 PipeEnv{stop_phase, src_basename, output_spec} <- getPipeEnv
701 PipeState{maybe_loc, hsc_env} <- getPipeState
702 let dflags = hsc_dflags hsc_env
703 liftIO $ getOutputFilename stop_phase output_spec
704 src_basename dflags next_phase maybe_loc
705
706 getOutputFilename
707 :: Phase -> PipelineOutput -> String
708 -> DynFlags -> Phase{-next phase-} -> Maybe ModLocation -> IO FilePath
709 getOutputFilename stop_phase output basename dflags next_phase maybe_location
710 | is_last_phase, Persistent <- output = persistent_fn
711 | is_last_phase, SpecificFile <- output = case outputFile dflags of
712 Just f -> return f
713 Nothing ->
714 panic "SpecificFile: No filename"
715 | keep_this_output = persistent_fn
716 | otherwise = newTempName dflags suffix
717 where
718 hcsuf = hcSuf dflags
719 odir = objectDir dflags
720 osuf = objectSuf dflags
721 keep_hc = gopt Opt_KeepHcFiles dflags
722 keep_s = gopt Opt_KeepSFiles dflags
723 keep_bc = gopt Opt_KeepLlvmFiles dflags
724
725 myPhaseInputExt HCc = hcsuf
726 myPhaseInputExt MergeStub = osuf
727 myPhaseInputExt StopLn = osuf
728 myPhaseInputExt other = phaseInputExt other
729
730 is_last_phase = next_phase `eqPhase` stop_phase
731
732 -- sometimes, we keep output from intermediate stages
733 keep_this_output =
734 case next_phase of
735 As _ | keep_s -> True
736 LlvmOpt | keep_bc -> True
737 HCc | keep_hc -> True
738 _other -> False
739
740 suffix = myPhaseInputExt next_phase
741
742 -- persistent object files get put in odir
743 persistent_fn
744 | StopLn <- next_phase = return odir_persistent
745 | otherwise = return persistent
746
747 persistent = basename <.> suffix
748
749 odir_persistent
750 | Just loc <- maybe_location = ml_obj_file loc
751 | Just d <- odir = d </> persistent
752 | otherwise = persistent
753
754 -- -----------------------------------------------------------------------------
755 -- | Each phase in the pipeline returns the next phase to execute, and the
756 -- name of the file in which the output was placed.
757 --
758 -- We must do things dynamically this way, because we often don't know
759 -- what the rest of the phases will be until part-way through the
760 -- compilation: for example, an {-# OPTIONS -fasm #-} at the beginning
761 -- of a source file can change the latter stages of the pipeline from
762 -- taking the LLVM route to using the native code generator.
763 --
764 runPhase :: PhasePlus -- ^ Run this phase
765 -> FilePath -- ^ name of the input file
766 -> DynFlags -- ^ for convenience, we pass the current dflags in
767 -> CompPipeline (PhasePlus, -- next phase to run
768 FilePath) -- output filename
769
770 -- Invariant: the output filename always contains the output
771 -- Interesting case: Hsc when there is no recompilation to do
772 -- Then the output filename is still a .o file
773
774
775 -------------------------------------------------------------------------------
776 -- Unlit phase
777
778 runPhase (RealPhase (Unlit sf)) input_fn dflags
779 = do
780 output_fn <- phaseOutputFilename (Cpp sf)
781
782 let flags = [ -- The -h option passes the file name for unlit to
783 -- put in a #line directive
784 SysTools.Option "-h"
785 , SysTools.Option $ escape $ normalise input_fn
786 , SysTools.FileOption "" input_fn
787 , SysTools.FileOption "" output_fn
788 ]
789
790 liftIO $ SysTools.runUnlit dflags flags
791
792 return (RealPhase (Cpp sf), output_fn)
793 where
794 -- escape the characters \, ", and ', but don't try to escape
795 -- Unicode or anything else (so we don't use Util.charToC
796 -- here). If we get this wrong, then in
797 -- Coverage.addTicksToBinds where we check that the filename in
798 -- a SrcLoc is the same as the source filenaame, the two will
799 -- look bogusly different. See test:
800 -- libraries/hpc/tests/function/subdir/tough2.lhs
801 escape ('\\':cs) = '\\':'\\': escape cs
802 escape ('\"':cs) = '\\':'\"': escape cs
803 escape ('\'':cs) = '\\':'\'': escape cs
804 escape (c:cs) = c : escape cs
805 escape [] = []
806
807 -------------------------------------------------------------------------------
808 -- Cpp phase : (a) gets OPTIONS out of file
809 -- (b) runs cpp if necessary
810
811 runPhase (RealPhase (Cpp sf)) input_fn dflags0
812 = do
813 src_opts <- liftIO $ getOptionsFromFile dflags0 input_fn
814 (dflags1, unhandled_flags, warns)
815 <- liftIO $ parseDynamicFilePragma dflags0 src_opts
816 setDynFlags dflags1
817 liftIO $ checkProcessArgsResult dflags1 unhandled_flags
818
819 if not (xopt Opt_Cpp dflags1) then do
820 -- we have to be careful to emit warnings only once.
821 unless (gopt Opt_Pp dflags1) $
822 liftIO $ handleFlagWarnings dflags1 warns
823
824 -- no need to preprocess CPP, just pass input file along
825 -- to the next phase of the pipeline.
826 return (RealPhase (HsPp sf), input_fn)
827 else do
828 output_fn <- phaseOutputFilename (HsPp sf)
829 liftIO $ doCpp dflags1 True{-raw-}
830 input_fn output_fn
831 -- re-read the pragmas now that we've preprocessed the file
832 -- See #2464,#3457
833 src_opts <- liftIO $ getOptionsFromFile dflags0 output_fn
834 (dflags2, unhandled_flags, warns)
835 <- liftIO $ parseDynamicFilePragma dflags0 src_opts
836 liftIO $ checkProcessArgsResult dflags2 unhandled_flags
837 unless (gopt Opt_Pp dflags2) $
838 liftIO $ handleFlagWarnings dflags2 warns
839 -- the HsPp pass below will emit warnings
840
841 setDynFlags dflags2
842
843 return (RealPhase (HsPp sf), output_fn)
844
845 -------------------------------------------------------------------------------
846 -- HsPp phase
847
848 runPhase (RealPhase (HsPp sf)) input_fn dflags
849 = do
850 if not (gopt Opt_Pp dflags) then
851 -- no need to preprocess, just pass input file along
852 -- to the next phase of the pipeline.
853 return (RealPhase (Hsc sf), input_fn)
854 else do
855 PipeEnv{src_basename, src_suffix} <- getPipeEnv
856 let orig_fn = src_basename <.> src_suffix
857 output_fn <- phaseOutputFilename (Hsc sf)
858 liftIO $ SysTools.runPp dflags
859 ( [ SysTools.Option orig_fn
860 , SysTools.Option input_fn
861 , SysTools.FileOption "" output_fn
862 ]
863 )
864
865 -- re-read pragmas now that we've parsed the file (see #3674)
866 src_opts <- liftIO $ getOptionsFromFile dflags output_fn
867 (dflags1, unhandled_flags, warns)
868 <- liftIO $ parseDynamicFilePragma dflags src_opts
869 setDynFlags dflags1
870 liftIO $ checkProcessArgsResult dflags1 unhandled_flags
871 liftIO $ handleFlagWarnings dflags1 warns
872
873 return (RealPhase (Hsc sf), output_fn)
874
875 -----------------------------------------------------------------------------
876 -- Hsc phase
877
878 -- Compilation of a single module, in "legacy" mode (_not_ under
879 -- the direction of the compilation manager).
880 runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
881 = do -- normal Hsc mode, not mkdependHS
882
883 PipeEnv{ stop_phase=stop,
884 src_basename=basename,
885 src_suffix=suff } <- getPipeEnv
886
887 -- we add the current directory (i.e. the directory in which
888 -- the .hs files resides) to the include path, since this is
889 -- what gcc does, and it's probably what you want.
890 let current_dir = takeDirectory basename
891 paths = includePaths dflags0
892 dflags = dflags0 { includePaths = current_dir : paths }
893
894 setDynFlags dflags
895
896 -- gather the imports and module name
897 (hspp_buf,mod_name,imps,src_imps) <- liftIO $ do
898 do
899 buf <- hGetStringBuffer input_fn
900 (src_imps,imps,L _ mod_name) <- getImports dflags buf input_fn (basename <.> suff)
901 return (Just buf, mod_name, imps, src_imps)
902
903 -- Take -o into account if present
904 -- Very like -ohi, but we must *only* do this if we aren't linking
905 -- (If we're linking then the -o applies to the linked thing, not to
906 -- the object file for one module.)
907 -- Note the nasty duplication with the same computation in compileFile above
908 location <- getLocation src_flavour mod_name
909
910 let o_file = ml_obj_file location -- The real object file
911
912 -- Figure out if the source has changed, for recompilation avoidance.
913 --
914 -- Setting source_unchanged to True means that M.o seems
915 -- to be up to date wrt M.hs; so no need to recompile unless imports have
916 -- changed (which the compiler itself figures out).
917 -- Setting source_unchanged to False tells the compiler that M.o is out of
918 -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
919 src_timestamp <- liftIO $ getModificationUTCTime (basename <.> suff)
920
921 source_unchanged <- liftIO $
922 if not (isStopLn stop)
923 -- SourceModified unconditionally if
924 -- (a) recompilation checker is off, or
925 -- (b) we aren't going all the way to .o file (e.g. ghc -S)
926 then return SourceModified
927 -- Otherwise look at file modification dates
928 else do o_file_exists <- doesFileExist o_file
929 if not o_file_exists
930 then return SourceModified -- Need to recompile
931 else do t2 <- getModificationUTCTime o_file
932 if t2 > src_timestamp
933 then return SourceUnmodified
934 else return SourceModified
935
936 PipeState{hsc_env=hsc_env'} <- getPipeState
937
938 -- Tell the finder cache about this module
939 mod <- liftIO $ addHomeModuleToFinder hsc_env' mod_name location
940
941 -- Make the ModSummary to hand to hscMain
942 let
943 mod_summary = ModSummary { ms_mod = mod,
944 ms_hsc_src = src_flavour,
945 ms_hspp_file = input_fn,
946 ms_hspp_opts = dflags,
947 ms_hspp_buf = hspp_buf,
948 ms_location = location,
949 ms_hs_date = src_timestamp,
950 ms_obj_date = Nothing,
951 ms_textual_imps = imps,
952 ms_srcimps = src_imps }
953
954 -- run the compiler!
955 result <- liftIO $ hscCompileOneShot hsc_env'
956 mod_summary source_unchanged
957
958 return (HscOut src_flavour mod_name result,
959 panic "HscOut doesn't have an input filename")
960
961 runPhase (HscOut src_flavour mod_name result) _ dflags = do
962 location <- getLocation src_flavour mod_name
963 setModLocation location
964
965 let o_file = ml_obj_file location -- The real object file
966 hsc_lang = hscTarget dflags
967 next_phase = hscPostBackendPhase dflags src_flavour hsc_lang
968
969 case result of
970 HscNotGeneratingCode ->
971 return (RealPhase next_phase,
972 panic "No output filename from Hsc when no-code")
973 HscUpToDate ->
974 do liftIO $ touchObjectFile dflags o_file
975 -- The .o file must have a later modification date
976 -- than the source file (else we wouldn't get Nothing)
977 -- but we touch it anyway, to keep 'make' happy (we think).
978 return (RealPhase StopLn, o_file)
979 HscUpdateBoot ->
980 do -- In the case of hs-boot files, generate a dummy .o-boot
981 -- stamp file for the benefit of Make
982 liftIO $ touchObjectFile dflags o_file
983 return (RealPhase next_phase, o_file)
984 HscRecomp cgguts mod_summary
985 -> do output_fn <- phaseOutputFilename next_phase
986
987 PipeState{hsc_env=hsc_env'} <- getPipeState
988
989 (outputFilename, mStub) <- liftIO $ hscGenHardCode hsc_env' cgguts mod_summary output_fn
990 case mStub of
991 Nothing -> return ()
992 Just stub_c ->
993 do stub_o <- liftIO $ compileStub hsc_env' stub_c
994 setStubO stub_o
995
996 return (RealPhase next_phase, outputFilename)
997
998 -----------------------------------------------------------------------------
999 -- Cmm phase
1000
1001 runPhase (RealPhase CmmCpp) input_fn dflags
1002 = do
1003 output_fn <- phaseOutputFilename Cmm
1004 liftIO $ doCpp dflags False{-not raw-}
1005 input_fn output_fn
1006 return (RealPhase Cmm, output_fn)
1007
1008 runPhase (RealPhase Cmm) input_fn dflags
1009 = do
1010 let hsc_lang = hscTarget dflags
1011
1012 let next_phase = hscPostBackendPhase dflags HsSrcFile hsc_lang
1013
1014 output_fn <- phaseOutputFilename next_phase
1015
1016 PipeState{hsc_env} <- getPipeState
1017
1018 liftIO $ hscCompileCmmFile hsc_env input_fn output_fn
1019
1020 return (RealPhase next_phase, output_fn)
1021
1022 -----------------------------------------------------------------------------
1023 -- Cc phase
1024
1025 -- we don't support preprocessing .c files (with -E) now. Doing so introduces
1026 -- way too many hacks, and I can't say I've ever used it anyway.
1027
1028 runPhase (RealPhase cc_phase) input_fn dflags
1029 | any (cc_phase `eqPhase`) [Cc, Ccpp, HCc, Cobjc, Cobjcpp]
1030 = do
1031 let platform = targetPlatform dflags
1032 hcc = cc_phase `eqPhase` HCc
1033
1034 let cmdline_include_paths = includePaths dflags
1035
1036 -- HC files have the dependent packages stamped into them
1037 pkgs <- if hcc then liftIO $ getHCFilePackages input_fn else return []
1038
1039 -- add package include paths even if we're just compiling .c
1040 -- files; this is the Value Add(TM) that using ghc instead of
1041 -- gcc gives you :)
1042 pkg_include_dirs <- liftIO $ getPackageIncludePath dflags pkgs
1043 let include_paths = foldr (\ x xs -> ("-I" ++ x) : xs) []
1044 (cmdline_include_paths ++ pkg_include_dirs)
1045
1046 let gcc_extra_viac_flags = extraGccViaCFlags dflags
1047 let pic_c_flags = picCCOpts dflags
1048
1049 let verbFlags = getVerbFlags dflags
1050
1051 -- cc-options are not passed when compiling .hc files. Our
1052 -- hc code doesn't not #include any header files anyway, so these
1053 -- options aren't necessary.
1054 pkg_extra_cc_opts <- liftIO $
1055 if cc_phase `eqPhase` HCc
1056 then return []
1057 else getPackageExtraCcOpts dflags pkgs
1058
1059 framework_paths <-
1060 if platformUsesFrameworks platform
1061 then do pkgFrameworkPaths <- liftIO $ getPackageFrameworkPath dflags pkgs
1062 let cmdlineFrameworkPaths = frameworkPaths dflags
1063 return $ map ("-F"++)
1064 (cmdlineFrameworkPaths ++ pkgFrameworkPaths)
1065 else return []
1066
1067 let split_objs = gopt Opt_SplitObjs dflags
1068 split_opt | hcc && split_objs = [ "-DUSE_SPLIT_MARKERS" ]
1069 | otherwise = [ ]
1070
1071 let cc_opt | optLevel dflags >= 2 = [ "-O2" ]
1072 | optLevel dflags >= 1 = [ "-O" ]
1073 | otherwise = []
1074
1075 -- Decide next phase
1076 let next_phase = As False
1077 output_fn <- phaseOutputFilename next_phase
1078
1079 let
1080 more_hcc_opts =
1081 -- on x86 the floating point regs have greater precision
1082 -- than a double, which leads to unpredictable results.
1083 -- By default, we turn this off with -ffloat-store unless
1084 -- the user specified -fexcess-precision.
1085 (if platformArch platform == ArchX86 &&
1086 not (gopt Opt_ExcessPrecision dflags)
1087 then [ "-ffloat-store" ]
1088 else []) ++
1089
1090 -- gcc's -fstrict-aliasing allows two accesses to memory
1091 -- to be considered non-aliasing if they have different types.
1092 -- This interacts badly with the C code we generate, which is
1093 -- very weakly typed, being derived from C--.
1094 ["-fno-strict-aliasing"]
1095
1096 ghcVersionH <- liftIO $ getGhcVersionPathName dflags
1097
1098 let gcc_lang_opt | cc_phase `eqPhase` Ccpp = "c++"
1099 | cc_phase `eqPhase` Cobjc = "objective-c"
1100 | cc_phase `eqPhase` Cobjcpp = "objective-c++"
1101 | otherwise = "c"
1102 liftIO $ SysTools.runCc dflags (
1103 -- force the C compiler to interpret this file as C when
1104 -- compiling .hc files, by adding the -x c option.
1105 -- Also useful for plain .c files, just in case GHC saw a
1106 -- -x c option.
1107 [ SysTools.Option "-x", SysTools.Option gcc_lang_opt
1108 , SysTools.FileOption "" input_fn
1109 , SysTools.Option "-o"
1110 , SysTools.FileOption "" output_fn
1111 ]
1112 ++ map SysTools.Option (
1113 pic_c_flags
1114
1115 -- Stub files generated for foreign exports references the runIO_closure
1116 -- and runNonIO_closure symbols, which are defined in the base package.
1117 -- These symbols are imported into the stub.c file via RtsAPI.h, and the
1118 -- way we do the import depends on whether we're currently compiling
1119 -- the base package or not.
1120 ++ (if platformOS platform == OSMinGW32 &&
1121 thisPackage dflags == basePackageKey
1122 then [ "-DCOMPILING_BASE_PACKAGE" ]
1123 else [])
1124
1125 -- We only support SparcV9 and better because V8 lacks an atomic CAS
1126 -- instruction. Note that the user can still override this
1127 -- (e.g., -mcpu=ultrasparc) as GCC picks the "best" -mcpu flag
1128 -- regardless of the ordering.
1129 --
1130 -- This is a temporary hack. See #2872, commit
1131 -- 5bd3072ac30216a505151601884ac88bf404c9f2
1132 ++ (if platformArch platform == ArchSPARC
1133 then ["-mcpu=v9"]
1134 else [])
1135
1136 -- GCC 4.6+ doesn't like -Wimplicit when compiling C++.
1137 ++ (if (cc_phase /= Ccpp && cc_phase /= Cobjcpp)
1138 then ["-Wimplicit"]
1139 else [])
1140
1141 ++ (if hcc
1142 then gcc_extra_viac_flags ++ more_hcc_opts
1143 else [])
1144 ++ verbFlags
1145 ++ [ "-S" ]
1146 ++ cc_opt
1147 ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt
1148 , "-include", ghcVersionH
1149 ]
1150 ++ framework_paths
1151 ++ split_opt
1152 ++ include_paths
1153 ++ pkg_extra_cc_opts
1154 ))
1155
1156 return (RealPhase next_phase, output_fn)
1157
1158 -----------------------------------------------------------------------------
1159 -- Splitting phase
1160
1161 runPhase (RealPhase Splitter) input_fn dflags
1162 = do -- tmp_pfx is the prefix used for the split .s files
1163
1164 split_s_prefix <- liftIO $ SysTools.newTempName dflags "split"
1165 let n_files_fn = split_s_prefix
1166
1167 liftIO $ SysTools.runSplit dflags
1168 [ SysTools.FileOption "" input_fn
1169 , SysTools.FileOption "" split_s_prefix
1170 , SysTools.FileOption "" n_files_fn
1171 ]
1172
1173 -- Save the number of split files for future references
1174 s <- liftIO $ readFile n_files_fn
1175 let n_files = read s :: Int
1176 dflags' = dflags { splitInfo = Just (split_s_prefix, n_files) }
1177
1178 setDynFlags dflags'
1179
1180 -- Remember to delete all these files
1181 liftIO $ addFilesToClean dflags'
1182 [ split_s_prefix ++ "__" ++ show n ++ ".s"
1183 | n <- [1..n_files]]
1184
1185 return (RealPhase SplitAs,
1186 "**splitter**") -- we don't use the filename in SplitAs
1187
1188 -----------------------------------------------------------------------------
1189 -- As, SpitAs phase : Assembler
1190
1191 -- This is for calling the assembler on a regular assembly file (not split).
1192 runPhase (RealPhase (As with_cpp)) input_fn dflags
1193 = do
1194 -- LLVM from version 3.0 onwards doesn't support the OS X system
1195 -- assembler, so we use clang as the assembler instead. (#5636)
1196 let whichAsProg | hscTarget dflags == HscLlvm &&
1197 platformOS (targetPlatform dflags) == OSDarwin
1198 = do
1199 -- be careful what options we call clang with
1200 -- see #5903 and #7617 for bugs caused by this.
1201 llvmVer <- liftIO $ figureLlvmVersion dflags
1202 return $ case llvmVer of
1203 Just n | n >= 30 -> SysTools.runClang
1204 _ -> SysTools.runAs
1205
1206 | otherwise = return SysTools.runAs
1207
1208 as_prog <- whichAsProg
1209 let cmdline_include_paths = includePaths dflags
1210 let pic_c_flags = picCCOpts dflags
1211
1212 next_phase <- maybeMergeStub
1213 output_fn <- phaseOutputFilename next_phase
1214
1215 -- we create directories for the object file, because it
1216 -- might be a hierarchical module.
1217 liftIO $ createDirectoryIfMissing True (takeDirectory output_fn)
1218
1219 ccInfo <- liftIO $ getCompilerInfo dflags
1220 let runAssembler inputFilename outputFilename
1221 = liftIO $ as_prog dflags
1222 ([ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
1223
1224 -- See Note [-fPIC for assembler]
1225 ++ map SysTools.Option pic_c_flags
1226
1227 -- We only support SparcV9 and better because V8 lacks an atomic CAS
1228 -- instruction so we have to make sure that the assembler accepts the
1229 -- instruction set. Note that the user can still override this
1230 -- (e.g., -mcpu=ultrasparc). GCC picks the "best" -mcpu flag
1231 -- regardless of the ordering.
1232 --
1233 -- This is a temporary hack.
1234 ++ (if platformArch (targetPlatform dflags) == ArchSPARC
1235 then [SysTools.Option "-mcpu=v9"]
1236 else [])
1237 ++ (if any (ccInfo ==) [Clang, AppleClang, AppleClang51]
1238 then [SysTools.Option "-Qunused-arguments"]
1239 else [])
1240 ++ [ SysTools.Option "-x"
1241 , if with_cpp
1242 then SysTools.Option "assembler-with-cpp"
1243 else SysTools.Option "assembler"
1244 , SysTools.Option "-c"
1245 , SysTools.FileOption "" inputFilename
1246 , SysTools.Option "-o"
1247 , SysTools.FileOption "" outputFilename
1248 ])
1249
1250 liftIO $ debugTraceMsg dflags 4 (text "Running the assembler")
1251 runAssembler input_fn output_fn
1252 return (RealPhase next_phase, output_fn)
1253
1254
1255 -- This is for calling the assembler on a split assembly file (so a collection
1256 -- of assembly files)
1257 runPhase (RealPhase SplitAs) _input_fn dflags
1258 = do
1259 -- we'll handle the stub_o file in this phase, so don't MergeStub,
1260 -- just jump straight to StopLn afterwards.
1261 let next_phase = StopLn
1262 output_fn <- phaseOutputFilename next_phase
1263
1264 let base_o = dropExtension output_fn
1265 osuf = objectSuf dflags
1266 split_odir = base_o ++ "_" ++ osuf ++ "_split"
1267
1268 let pic_c_flags = picCCOpts dflags
1269
1270 -- this also creates the hierarchy
1271 liftIO $ createDirectoryIfMissing True split_odir
1272
1273 -- remove M_split/ *.o, because we're going to archive M_split/ *.o
1274 -- later and we don't want to pick up any old objects.
1275 fs <- liftIO $ getDirectoryContents split_odir
1276 liftIO $ mapM_ removeFile $
1277 map (split_odir </>) $ filter (osuf `isSuffixOf`) fs
1278
1279 let (split_s_prefix, n) = case splitInfo dflags of
1280 Nothing -> panic "No split info"
1281 Just x -> x
1282
1283 let split_s n = split_s_prefix ++ "__" ++ show n <.> "s"
1284
1285 split_obj :: Int -> FilePath
1286 split_obj n = split_odir </>
1287 takeFileName base_o ++ "__" ++ show n <.> osuf
1288
1289 let assemble_file n
1290 = SysTools.runAs dflags (
1291
1292 -- We only support SparcV9 and better because V8 lacks an atomic CAS
1293 -- instruction so we have to make sure that the assembler accepts the
1294 -- instruction set. Note that the user can still override this
1295 -- (e.g., -mcpu=ultrasparc). GCC picks the "best" -mcpu flag
1296 -- regardless of the ordering.
1297 --
1298 -- This is a temporary hack.
1299 (if platformArch (targetPlatform dflags) == ArchSPARC
1300 then [SysTools.Option "-mcpu=v9"]
1301 else []) ++
1302
1303 -- See Note [-fPIC for assembler]
1304 map SysTools.Option pic_c_flags ++
1305
1306 [ SysTools.Option "-c"
1307 , SysTools.Option "-o"
1308 , SysTools.FileOption "" (split_obj n)
1309 , SysTools.FileOption "" (split_s n)
1310 ])
1311
1312 liftIO $ mapM_ assemble_file [1..n]
1313
1314 -- Note [pipeline-split-init]
1315 -- If we have a stub file, it may contain constructor
1316 -- functions for initialisation of this module. We can't
1317 -- simply leave the stub as a separate object file, because it
1318 -- will never be linked in: nothing refers to it. We need to
1319 -- ensure that if we ever refer to the data in this module
1320 -- that needs initialisation, then we also pull in the
1321 -- initialisation routine.
1322 --
1323 -- To that end, we make a DANGEROUS ASSUMPTION here: the data
1324 -- that needs to be initialised is all in the FIRST split
1325 -- object. See Note [codegen-split-init].
1326
1327 PipeState{maybe_stub_o} <- getPipeState
1328 case maybe_stub_o of
1329 Nothing -> return ()
1330 Just stub_o -> liftIO $ do
1331 tmp_split_1 <- newTempName dflags osuf
1332 let split_1 = split_obj 1
1333 copyFile split_1 tmp_split_1
1334 removeFile split_1
1335 joinObjectFiles dflags [tmp_split_1, stub_o] split_1
1336
1337 -- join them into a single .o file
1338 liftIO $ joinObjectFiles dflags (map split_obj [1..n]) output_fn
1339
1340 return (RealPhase next_phase, output_fn)
1341
1342 -----------------------------------------------------------------------------
1343 -- LlvmOpt phase
1344
1345 runPhase (RealPhase LlvmOpt) input_fn dflags
1346 = do
1347 ver <- liftIO $ readIORef (llvmVersion dflags)
1348
1349 let opt_lvl = max 0 (min 2 $ optLevel dflags)
1350 -- don't specify anything if user has specified commands. We do this
1351 -- for opt but not llc since opt is very specifically for optimisation
1352 -- passes only, so if the user is passing us extra options we assume
1353 -- they know what they are doing and don't get in the way.
1354 optFlag = if null (getOpts dflags opt_lo)
1355 then map SysTools.Option $ words (llvmOpts ver !! opt_lvl)
1356 else []
1357 tbaa | ver < 29 = "" -- no tbaa in 2.8 and earlier
1358 | gopt Opt_LlvmTBAA dflags = "--enable-tbaa=true"
1359 | otherwise = "--enable-tbaa=false"
1360
1361
1362 output_fn <- phaseOutputFilename LlvmLlc
1363
1364 liftIO $ SysTools.runLlvmOpt dflags
1365 ([ SysTools.FileOption "" input_fn,
1366 SysTools.Option "-o",
1367 SysTools.FileOption "" output_fn]
1368 ++ optFlag
1369 ++ [SysTools.Option tbaa])
1370
1371 return (RealPhase LlvmLlc, output_fn)
1372 where
1373 -- we always (unless -optlo specified) run Opt since we rely on it to
1374 -- fix up some pretty big deficiencies in the code we generate
1375 llvmOpts ver = [ "-mem2reg -globalopt"
1376 , if ver >= 34 then "-O1 -globalopt" else "-O1"
1377 -- LLVM 3.4 -O1 doesn't eliminate aliases reliably (bug #8855)
1378 , "-O2"
1379 ]
1380
1381 -----------------------------------------------------------------------------
1382 -- LlvmLlc phase
1383
1384 runPhase (RealPhase LlvmLlc) input_fn dflags
1385 = do
1386 ver <- liftIO $ readIORef (llvmVersion dflags)
1387
1388 let opt_lvl = max 0 (min 2 $ optLevel dflags)
1389 -- iOS requires external references to be loaded indirectly from the
1390 -- DATA segment or dyld traps at runtime writing into TEXT: see #7722
1391 rmodel | platformOS (targetPlatform dflags) == OSiOS = "dynamic-no-pic"
1392 | gopt Opt_PIC dflags = "pic"
1393 | not (gopt Opt_Static dflags) = "dynamic-no-pic"
1394 | otherwise = "static"
1395 tbaa | ver < 29 = "" -- no tbaa in 2.8 and earlier
1396 | gopt Opt_LlvmTBAA dflags = "--enable-tbaa=true"
1397 | otherwise = "--enable-tbaa=false"
1398
1399 -- hidden debugging flag '-dno-llvm-mangler' to skip mangling
1400 let next_phase = case gopt Opt_NoLlvmMangler dflags of
1401 False -> LlvmMangle
1402 True | gopt Opt_SplitObjs dflags -> Splitter
1403 True -> As False
1404
1405 output_fn <- phaseOutputFilename next_phase
1406
1407 -- AVX can cause LLVM 3.2 to generate a C-like frame pointer
1408 -- prelude, see #9391
1409 when (ver == 32 && isAvxEnabled dflags) $ liftIO $ errorMsg dflags $ text
1410 "Note: LLVM 3.2 has known problems with AVX instructions (see trac #9391)"
1411
1412 liftIO $ SysTools.runLlvmLlc dflags
1413 ([ SysTools.Option (llvmOpts !! opt_lvl),
1414 SysTools.Option $ "-relocation-model=" ++ rmodel,
1415 SysTools.FileOption "" input_fn,
1416 SysTools.Option "-o", SysTools.FileOption "" output_fn]
1417 ++ [SysTools.Option tbaa]
1418 ++ map SysTools.Option fpOpts
1419 ++ map SysTools.Option abiOpts
1420 ++ map SysTools.Option sseOpts
1421 ++ map SysTools.Option (avxOpts ver)
1422 ++ map SysTools.Option avx512Opts
1423 ++ map SysTools.Option stackAlignOpts)
1424
1425 return (RealPhase next_phase, output_fn)
1426 where
1427 -- Bug in LLVM at O3 on OSX.
1428 llvmOpts = if platformOS (targetPlatform dflags) == OSDarwin
1429 then ["-O1", "-O2", "-O2"]
1430 else ["-O1", "-O2", "-O3"]
1431 -- On ARMv7 using LLVM, LLVM fails to allocate floating point registers
1432 -- while compiling GHC source code. It's probably due to fact that it
1433 -- does not enable VFP by default. Let's do this manually here
1434 fpOpts = case platformArch (targetPlatform dflags) of
1435 ArchARM ARMv7 ext _ -> if (elem VFPv3 ext)
1436 then ["-mattr=+v7,+vfp3"]
1437 else if (elem VFPv3D16 ext)
1438 then ["-mattr=+v7,+vfp3,+d16"]
1439 else []
1440 ArchARM ARMv6 ext _ -> if (elem VFPv2 ext)
1441 then ["-mattr=+v6,+vfp2"]
1442 else ["-mattr=+v6"]
1443 _ -> []
1444 -- On Ubuntu/Debian with ARM hard float ABI, LLVM's llc still
1445 -- compiles into soft-float ABI. We need to explicitly set abi
1446 -- to hard
1447 abiOpts = case platformArch (targetPlatform dflags) of
1448 ArchARM _ _ HARD -> ["-float-abi=hard"]
1449 ArchARM _ _ _ -> []
1450 _ -> []
1451
1452 sseOpts | isSse4_2Enabled dflags = ["-mattr=+sse42"]
1453 | isSse2Enabled dflags = ["-mattr=+sse2"]
1454 | isSseEnabled dflags = ["-mattr=+sse"]
1455 | otherwise = []
1456
1457 avxOpts ver | isAvx512fEnabled dflags = ["-mattr=+avx512f"]
1458 | isAvx2Enabled dflags = ["-mattr=+avx2"]
1459 | isAvxEnabled dflags = ["-mattr=+avx"]
1460 | ver == 32 = ["-mattr=-avx"] -- see #9391
1461 | otherwise = []
1462
1463 avx512Opts =
1464 [ "-mattr=+avx512cd" | isAvx512cdEnabled dflags ] ++
1465 [ "-mattr=+avx512er" | isAvx512erEnabled dflags ] ++
1466 [ "-mattr=+avx512pf" | isAvx512pfEnabled dflags ]
1467
1468 stackAlignOpts =
1469 case platformArch (targetPlatform dflags) of
1470 ArchX86_64 | isAvxEnabled dflags -> ["-stack-alignment=32"]
1471 _ -> []
1472
1473 -----------------------------------------------------------------------------
1474 -- LlvmMangle phase
1475
1476 runPhase (RealPhase LlvmMangle) input_fn dflags
1477 = do
1478 let next_phase = if gopt Opt_SplitObjs dflags then Splitter else As False
1479 output_fn <- phaseOutputFilename next_phase
1480 liftIO $ llvmFixupAsm dflags input_fn output_fn
1481 return (RealPhase next_phase, output_fn)
1482
1483 -----------------------------------------------------------------------------
1484 -- merge in stub objects
1485
1486 runPhase (RealPhase MergeStub) input_fn dflags
1487 = do
1488 PipeState{maybe_stub_o} <- getPipeState
1489 output_fn <- phaseOutputFilename StopLn
1490 liftIO $ createDirectoryIfMissing True (takeDirectory output_fn)
1491 case maybe_stub_o of
1492 Nothing ->
1493 panic "runPhase(MergeStub): no stub"
1494 Just stub_o -> do
1495 liftIO $ joinObjectFiles dflags [input_fn, stub_o] output_fn
1496 return (RealPhase StopLn, output_fn)
1497
1498 -- warning suppression
1499 runPhase (RealPhase other) _input_fn _dflags =
1500 panic ("runPhase: don't know how to run phase " ++ show other)
1501
1502 maybeMergeStub :: CompPipeline Phase
1503 maybeMergeStub
1504 = do
1505 PipeState{maybe_stub_o} <- getPipeState
1506 if isJust maybe_stub_o then return MergeStub else return StopLn
1507
1508 getLocation :: HscSource -> ModuleName -> CompPipeline ModLocation
1509 getLocation src_flavour mod_name = do
1510 dflags <- getDynFlags
1511
1512 PipeEnv{ src_basename=basename,
1513 src_suffix=suff } <- getPipeEnv
1514
1515 -- Build a ModLocation to pass to hscMain.
1516 -- The source filename is rather irrelevant by now, but it's used
1517 -- by hscMain for messages. hscMain also needs
1518 -- the .hi and .o filenames, and this is as good a way
1519 -- as any to generate them, and better than most. (e.g. takes
1520 -- into account the -osuf flags)
1521 location1 <- liftIO $ mkHomeModLocation2 dflags mod_name basename suff
1522
1523 -- Boot-ify it if necessary
1524 let location2 | HsBootFile <- src_flavour = addBootSuffixLocn location1
1525 | otherwise = location1
1526
1527
1528 -- Take -ohi into account if present
1529 -- This can't be done in mkHomeModuleLocation because
1530 -- it only applies to the module being compiles
1531 let ohi = outputHi dflags
1532 location3 | Just fn <- ohi = location2{ ml_hi_file = fn }
1533 | otherwise = location2
1534
1535 -- Take -o into account if present
1536 -- Very like -ohi, but we must *only* do this if we aren't linking
1537 -- (If we're linking then the -o applies to the linked thing, not to
1538 -- the object file for one module.)
1539 -- Note the nasty duplication with the same computation in compileFile above
1540 let expl_o_file = outputFile dflags
1541 location4 | Just ofile <- expl_o_file
1542 , isNoLink (ghcLink dflags)
1543 = location3 { ml_obj_file = ofile }
1544 | otherwise = location3
1545
1546 return location4
1547
1548 -----------------------------------------------------------------------------
1549 -- MoveBinary sort-of-phase
1550 -- After having produced a binary, move it somewhere else and generate a
1551 -- wrapper script calling the binary. Currently, we need this only in
1552 -- a parallel way (i.e. in GUM), because PVM expects the binary in a
1553 -- central directory.
1554 -- This is called from linkBinary below, after linking. I haven't made it
1555 -- a separate phase to minimise interfering with other modules, and
1556 -- we don't need the generality of a phase (MoveBinary is always
1557 -- done after linking and makes only sense in a parallel setup) -- HWL
1558
1559 runPhase_MoveBinary :: DynFlags -> FilePath -> IO Bool
1560 runPhase_MoveBinary dflags input_fn
1561 | WayPar `elem` ways dflags && not (gopt Opt_Static dflags) =
1562 panic ("Don't know how to combine PVM wrapper and dynamic wrapper")
1563 | WayPar `elem` ways dflags = do
1564 let sysMan = pgm_sysman dflags
1565 pvm_root <- getEnv "PVM_ROOT"
1566 pvm_arch <- getEnv "PVM_ARCH"
1567 let
1568 pvm_executable_base = "=" ++ input_fn
1569 pvm_executable = pvm_root ++ "/bin/" ++ pvm_arch ++ "/" ++ pvm_executable_base
1570 -- nuke old binary; maybe use configur'ed names for cp and rm?
1571 _ <- tryIO (removeFile pvm_executable)
1572 -- move the newly created binary into PVM land
1573 copy dflags "copying PVM executable" input_fn pvm_executable
1574 -- generate a wrapper script for running a parallel prg under PVM
1575 writeFile input_fn (mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan)
1576 return True
1577 | otherwise = return True
1578
1579 mkExtraObj :: DynFlags -> Suffix -> String -> IO FilePath
1580 mkExtraObj dflags extn xs
1581 = do cFile <- newTempName dflags extn
1582 oFile <- newTempName dflags "o"
1583 writeFile cFile xs
1584 let rtsDetails = getPackageDetails dflags rtsPackageKey
1585 SysTools.runCc dflags
1586 ([Option "-c",
1587 FileOption "" cFile,
1588 Option "-o",
1589 FileOption "" oFile]
1590 ++ map (FileOption "-I") (includeDirs rtsDetails))
1591 return oFile
1592
1593 -- When linking a binary, we need to create a C main() function that
1594 -- starts everything off. This used to be compiled statically as part
1595 -- of the RTS, but that made it hard to change the -rtsopts setting,
1596 -- so now we generate and compile a main() stub as part of every
1597 -- binary and pass the -rtsopts setting directly to the RTS (#5373)
1598 --
1599 mkExtraObjToLinkIntoBinary :: DynFlags -> IO FilePath
1600 mkExtraObjToLinkIntoBinary dflags = do
1601 when (gopt Opt_NoHsMain dflags && haveRtsOptsFlags dflags) $ do
1602 log_action dflags dflags SevInfo noSrcSpan defaultUserStyle
1603 (text "Warning: -rtsopts and -with-rtsopts have no effect with -no-hs-main." $$
1604 text " Call hs_init_ghc() from your main() function to set these options.")
1605
1606 mkExtraObj dflags "c" (showSDoc dflags main)
1607
1608 where
1609 main
1610 | gopt Opt_NoHsMain dflags = Outputable.empty
1611 | otherwise = vcat [
1612 text "#include \"Rts.h\"",
1613 text "extern StgClosure ZCMain_main_closure;",
1614 text "int main(int argc, char *argv[])",
1615 char '{',
1616 text " RtsConfig __conf = defaultRtsConfig;",
1617 text " __conf.rts_opts_enabled = "
1618 <> text (show (rtsOptsEnabled dflags)) <> semi,
1619 case rtsOpts dflags of
1620 Nothing -> Outputable.empty
1621 Just opts -> ptext (sLit " __conf.rts_opts= ") <>
1622 text (show opts) <> semi,
1623 text " __conf.rts_hs_main = rtsTrue;",
1624 text " return hs_main(argc,argv,&ZCMain_main_closure,__conf);",
1625 char '}',
1626 char '\n' -- final newline, to keep gcc happy
1627 ]
1628
1629 -- Write out the link info section into a new assembly file. Previously
1630 -- this was included as inline assembly in the main.c file but this
1631 -- is pretty fragile. gas gets upset trying to calculate relative offsets
1632 -- that span the .note section (notably .text) when debug info is present
1633 mkNoteObjsToLinkIntoBinary :: DynFlags -> [PackageKey] -> IO [FilePath]
1634 mkNoteObjsToLinkIntoBinary dflags dep_packages = do
1635 link_info <- getLinkInfo dflags dep_packages
1636
1637 if (platformSupportsSavingLinkOpts (platformOS (targetPlatform dflags)))
1638 then fmap (:[]) $ mkExtraObj dflags "s" (showSDoc dflags (link_opts link_info))
1639 else return []
1640
1641 where
1642 link_opts info = hcat [
1643 text "\t.section ", text ghcLinkInfoSectionName,
1644 text ",\"\",",
1645 text elfSectionNote,
1646 text "\n",
1647
1648 text "\t.ascii \"", info', text "\"\n",
1649
1650 -- ALL generated assembly must have this section to disable
1651 -- executable stacks. See also
1652 -- compiler/nativeGen/AsmCodeGen.lhs for another instance
1653 -- where we need to do this.
1654 (if platformHasGnuNonexecStack (targetPlatform dflags)
1655 then text ".section .note.GNU-stack,\"\",@progbits\n"
1656 else Outputable.empty)
1657
1658 ]
1659 where
1660 info' = text $ escape info
1661
1662 escape :: String -> String
1663 escape = concatMap (charToC.fromIntegral.ord)
1664
1665 elfSectionNote :: String
1666 elfSectionNote = case platformArch (targetPlatform dflags) of
1667 ArchARM _ _ _ -> "%note"
1668 _ -> "@note"
1669
1670 -- The "link info" is a string representing the parameters of the
1671 -- link. We save this information in the binary, and the next time we
1672 -- link, if nothing else has changed, we use the link info stored in
1673 -- the existing binary to decide whether to re-link or not.
1674 getLinkInfo :: DynFlags -> [PackageKey] -> IO String
1675 getLinkInfo dflags dep_packages = do
1676 package_link_opts <- getPackageLinkOpts dflags dep_packages
1677 pkg_frameworks <- if platformUsesFrameworks (targetPlatform dflags)
1678 then getPackageFrameworks dflags dep_packages
1679 else return []
1680 let extra_ld_inputs = ldInputs dflags
1681 let
1682 link_info = (package_link_opts,
1683 pkg_frameworks,
1684 rtsOpts dflags,
1685 rtsOptsEnabled dflags,
1686 gopt Opt_NoHsMain dflags,
1687 map showOpt extra_ld_inputs,
1688 getOpts dflags opt_l)
1689 --
1690 return (show link_info)
1691
1692 -- generates a Perl skript starting a parallel prg under PVM
1693 mk_pvm_wrapper_script :: String -> String -> String -> String
1694 mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $
1695 [
1696 "eval 'exec perl -S $0 ${1+\"$@\"}'",
1697 " if $running_under_some_shell;",
1698 "# =!=!=!=!=!=!=!=!=!=!=!",
1699 "# This script is automatically generated: DO NOT EDIT!!!",
1700 "# Generated by Glasgow Haskell Compiler",
1701 "# ngoqvam choHbogh vaj' vIHoHnISbej !!!!",
1702 "#",
1703 "$pvm_executable = '" ++ pvm_executable ++ "';",
1704 "$pvm_executable_base = '" ++ pvm_executable_base ++ "';",
1705 "$SysMan = '" ++ sysMan ++ "';",
1706 "",
1707 {- ToDo: add the magical shortcuts again iff we actually use them -- HWL
1708 "# first, some magical shortcuts to run "commands" on the binary",
1709 "# (which is hidden)",
1710 "if ($#ARGV == 1 && $ARGV[0] eq '+RTS' && $ARGV[1] =~ /^--((size|file|strip|rm|nm).*)/ ) {",
1711 " local($cmd) = $1;",
1712 " system("$cmd $pvm_executable");",
1713 " exit(0); # all done",
1714 "}", -}
1715 "",
1716 "# Now, run the real binary; process the args first",
1717 "$ENV{'PE'} = $pvm_executable_base;", -- ++ pvm_executable_base,
1718 "$debug = '';",
1719 "$nprocessors = 0; # the default: as many PEs as machines in PVM config",
1720 "@nonPVM_args = ();",
1721 "$in_RTS_args = 0;",
1722 "",
1723 "args: while ($a = shift(@ARGV)) {",
1724 " if ( $a eq '+RTS' ) {",
1725 " $in_RTS_args = 1;",
1726 " } elsif ( $a eq '-RTS' ) {",
1727 " $in_RTS_args = 0;",
1728 " }",
1729 " if ( $a eq '-d' && $in_RTS_args ) {",
1730 " $debug = '-';",
1731 " } elsif ( $a =~ /^-qN(\\d+)/ && $in_RTS_args ) {",
1732 " $nprocessors = $1;",
1733 " } elsif ( $a =~ /^-qp(\\d+)/ && $in_RTS_args ) {",
1734 " $nprocessors = $1;",
1735 " } else {",
1736 " push(@nonPVM_args, $a);",
1737 " }",
1738 "}",
1739 "",
1740 "local($return_val) = 0;",
1741 "# Start the parallel execution by calling SysMan",
1742 "system(\"$SysMan $debug $pvm_executable $nprocessors @nonPVM_args\");",
1743 "$return_val = $?;",
1744 "# ToDo: fix race condition moving files and flushing them!!",
1745 "system(\"cp $ENV{'HOME'}/$pvm_executable_base.???.gr .\") if -f \"$ENV{'HOME'}/$pvm_executable_base.002.gr\";",
1746 "exit($return_val);"
1747 ]
1748
1749 -----------------------------------------------------------------------------
1750 -- Look for the /* GHC_PACKAGES ... */ comment at the top of a .hc file
1751
1752 getHCFilePackages :: FilePath -> IO [PackageKey]
1753 getHCFilePackages filename =
1754 Exception.bracket (openFile filename ReadMode) hClose $ \h -> do
1755 l <- hGetLine h
1756 case l of
1757 '/':'*':' ':'G':'H':'C':'_':'P':'A':'C':'K':'A':'G':'E':'S':rest ->
1758 return (map stringToPackageKey (words rest))
1759 _other ->
1760 return []
1761
1762 -----------------------------------------------------------------------------
1763 -- Static linking, of .o files
1764
1765 -- The list of packages passed to link is the list of packages on
1766 -- which this program depends, as discovered by the compilation
1767 -- manager. It is combined with the list of packages that the user
1768 -- specifies on the command line with -package flags.
1769 --
1770 -- In one-shot linking mode, we can't discover the package
1771 -- dependencies (because we haven't actually done any compilation or
1772 -- read any interface files), so the user must explicitly specify all
1773 -- the packages.
1774
1775 linkBinary :: DynFlags -> [FilePath] -> [PackageKey] -> IO ()
1776 linkBinary = linkBinary' False
1777
1778 linkBinary' :: Bool -> DynFlags -> [FilePath] -> [PackageKey] -> IO ()
1779 linkBinary' staticLink dflags o_files dep_packages = do
1780 let platform = targetPlatform dflags
1781 mySettings = settings dflags
1782 verbFlags = getVerbFlags dflags
1783 output_fn = exeFileName staticLink dflags
1784
1785 -- get the full list of packages to link with, by combining the
1786 -- explicit packages with the auto packages and all of their
1787 -- dependencies, and eliminating duplicates.
1788
1789 full_output_fn <- if isAbsolute output_fn
1790 then return output_fn
1791 else do d <- getCurrentDirectory
1792 return $ normalise (d </> output_fn)
1793 pkg_lib_paths <- getPackageLibraryPath dflags dep_packages
1794 let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
1795 get_pkg_lib_path_opts l
1796 | osElfTarget (platformOS platform) &&
1797 dynLibLoader dflags == SystemDependent &&
1798 not (gopt Opt_Static dflags)
1799 = let libpath = if gopt Opt_RelativeDynlibPaths dflags
1800 then "$ORIGIN" </>
1801 (l `makeRelativeTo` full_output_fn)
1802 else l
1803 rpath = if gopt Opt_RPath dflags
1804 then ["-Wl,-rpath", "-Wl," ++ libpath]
1805 else []
1806 -- Solaris 11's linker does not support -rpath-link option. It silently
1807 -- ignores it and then complains about next option which is -l<some
1808 -- dir> as being a directory and not expected object file, E.g
1809 -- ld: elf error: file
1810 -- /tmp/ghc-src/libraries/base/dist-install/build:
1811 -- elf_begin: I/O error: region read: Is a directory
1812 rpathlink = if (platformOS platform) == OSSolaris2
1813 then []
1814 else ["-Wl,-rpath-link", "-Wl," ++ l]
1815 in ["-L" ++ l] ++ rpathlink ++ rpath
1816 | osMachOTarget (platformOS platform) &&
1817 dynLibLoader dflags == SystemDependent &&
1818 not (gopt Opt_Static dflags) &&
1819 gopt Opt_RPath dflags
1820 = let libpath = if gopt Opt_RelativeDynlibPaths dflags
1821 then "@loader_path" </>
1822 (l `makeRelativeTo` full_output_fn)
1823 else l
1824 in ["-L" ++ l] ++ ["-Wl,-rpath", "-Wl," ++ libpath]
1825 | otherwise = ["-L" ++ l]
1826
1827 let lib_paths = libraryPaths dflags
1828 let lib_path_opts = map ("-L"++) lib_paths
1829
1830 extraLinkObj <- mkExtraObjToLinkIntoBinary dflags
1831 noteLinkObjs <- mkNoteObjsToLinkIntoBinary dflags dep_packages
1832
1833 pkg_link_opts <- do
1834 (package_hs_libs, extra_libs, other_flags) <- getPackageLinkOpts dflags dep_packages
1835 return $ if staticLink
1836 then package_hs_libs -- If building an executable really means making a static
1837 -- library (e.g. iOS), then we only keep the -l options for
1838 -- HS packages, because libtool doesn't accept other options.
1839 -- In the case of iOS these need to be added by hand to the
1840 -- final link in Xcode.
1841 else other_flags ++ package_hs_libs ++ extra_libs -- -Wl,-u,<sym> contained in other_flags
1842 -- needs to be put before -l<package>,
1843 -- otherwise Solaris linker fails linking
1844 -- a binary with unresolved symbols in RTS
1845 -- which are defined in base package
1846 -- the reason for this is a note in ld(1) about
1847 -- '-u' option: "The placement of this option
1848 -- on the command line is significant.
1849 -- This option must be placed before the library
1850 -- that defines the symbol."
1851
1852 pkg_framework_path_opts <-
1853 if platformUsesFrameworks platform
1854 then do pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages
1855 return $ map ("-F" ++) pkg_framework_paths
1856 else return []
1857
1858 framework_path_opts <-
1859 if platformUsesFrameworks platform
1860 then do let framework_paths = frameworkPaths dflags
1861 return $ map ("-F" ++) framework_paths
1862 else return []
1863
1864 pkg_framework_opts <-
1865 if platformUsesFrameworks platform
1866 then do pkg_frameworks <- getPackageFrameworks dflags dep_packages
1867 return $ concat [ ["-framework", fw] | fw <- pkg_frameworks ]
1868 else return []
1869
1870 framework_opts <-
1871 if platformUsesFrameworks platform
1872 then do let frameworks = cmdlineFrameworks dflags
1873 -- reverse because they're added in reverse order from
1874 -- the cmd line:
1875 return $ concat [ ["-framework", fw]
1876 | fw <- reverse frameworks ]
1877 else return []
1878
1879 -- probably _stub.o files
1880 let extra_ld_inputs = ldInputs dflags
1881
1882 -- Here are some libs that need to be linked at the *end* of
1883 -- the command line, because they contain symbols that are referred to
1884 -- by the RTS. We can't therefore use the ordinary way opts for these.
1885 let
1886 debug_opts | WayDebug `elem` ways dflags = [
1887 #if defined(HAVE_LIBBFD)
1888 "-lbfd", "-liberty"
1889 #endif
1890 ]
1891 | otherwise = []
1892
1893 let thread_opts
1894 | WayThreaded `elem` ways dflags =
1895 let os = platformOS (targetPlatform dflags)
1896 in if os == OSOsf3 then ["-lpthread", "-lexc"]
1897 else if os `elem` [OSMinGW32, OSFreeBSD, OSOpenBSD,
1898 OSNetBSD, OSHaiku, OSQNXNTO, OSiOS, OSDarwin]
1899 then []
1900 else ["-lpthread"]
1901 | otherwise = []
1902
1903 rc_objs <- maybeCreateManifest dflags output_fn
1904
1905 let link = if staticLink
1906 then SysTools.runLibtool
1907 else SysTools.runLink
1908 link dflags (
1909 map SysTools.Option verbFlags
1910 ++ [ SysTools.Option "-o"
1911 , SysTools.FileOption "" output_fn
1912 ]
1913 ++ map SysTools.Option (
1914 []
1915
1916 -- Permit the linker to auto link _symbol to _imp_symbol.
1917 -- This lets us link against DLLs without needing an "import library".
1918 ++ (if platformOS platform == OSMinGW32
1919 then ["-Wl,--enable-auto-import"]
1920 else [])
1921
1922 -- '-no_compact_unwind'
1923 -- C++/Objective-C exceptions cannot use optimised
1924 -- stack unwinding code. The optimised form is the
1925 -- default in Xcode 4 on at least x86_64, and
1926 -- without this flag we're also seeing warnings
1927 -- like
1928 -- ld: warning: could not create compact unwind for .LFB3: non-standard register 5 being saved in prolog
1929 -- on x86.
1930 ++ (if sLdSupportsCompactUnwind mySettings &&
1931 not staticLink &&
1932 (platformOS platform == OSDarwin || platformOS platform == OSiOS) &&
1933 case platformArch platform of
1934 ArchX86 -> True
1935 ArchX86_64 -> True
1936 ArchARM {} -> True
1937 ArchARM64 -> True
1938 _ -> False
1939 then ["-Wl,-no_compact_unwind"]
1940 else [])
1941
1942 -- '-no_pie'
1943 -- iOS uses 'dynamic-no-pic', so we must pass this to ld to suppress a warning; see #7722
1944 ++ (if platformOS platform == OSiOS &&
1945 not staticLink
1946 then ["-Wl,-no_pie"]
1947 else [])
1948
1949 -- '-Wl,-read_only_relocs,suppress'
1950 -- ld gives loads of warnings like:
1951 -- ld: warning: text reloc in _base_GHCziArr_unsafeArray_info to _base_GHCziArr_unsafeArray_closure
1952 -- when linking any program. We're not sure
1953 -- whether this is something we ought to fix, but
1954 -- for now this flags silences them.
1955 ++ (if platformOS platform == OSDarwin &&
1956 platformArch platform == ArchX86 &&
1957 not staticLink
1958 then ["-Wl,-read_only_relocs,suppress"]
1959 else [])
1960
1961 ++ o_files
1962 ++ lib_path_opts)
1963 ++ extra_ld_inputs
1964 ++ map SysTools.Option (
1965 rc_objs
1966 ++ framework_path_opts
1967 ++ framework_opts
1968 ++ pkg_lib_path_opts
1969 ++ extraLinkObj:noteLinkObjs
1970 ++ pkg_link_opts
1971 ++ pkg_framework_path_opts
1972 ++ pkg_framework_opts
1973 ++ debug_opts
1974 ++ thread_opts
1975 ))
1976
1977 -- parallel only: move binary to another dir -- HWL
1978 success <- runPhase_MoveBinary dflags output_fn
1979 unless success $
1980 throwGhcExceptionIO (InstallationError ("cannot move binary"))
1981
1982
1983 exeFileName :: Bool -> DynFlags -> FilePath
1984 exeFileName staticLink dflags
1985 | Just s <- outputFile dflags =
1986 case platformOS (targetPlatform dflags) of
1987 OSMinGW32 -> s <?.> "exe"
1988 _ -> if staticLink
1989 then s <?.> "a"
1990 else s
1991 | otherwise =
1992 if platformOS (targetPlatform dflags) == OSMinGW32
1993 then "main.exe"
1994 else if staticLink
1995 then "liba.a"
1996 else "a.out"
1997 where s <?.> ext | null (takeExtension s) = s <.> ext
1998 | otherwise = s
1999
2000 maybeCreateManifest
2001 :: DynFlags
2002 -> FilePath -- filename of executable
2003 -> IO [FilePath] -- extra objects to embed, maybe
2004 maybeCreateManifest dflags exe_filename
2005 | platformOS (targetPlatform dflags) == OSMinGW32 &&
2006 gopt Opt_GenManifest dflags
2007 = do let manifest_filename = exe_filename <.> "manifest"
2008
2009 writeFile manifest_filename $
2010 "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\n"++
2011 " <assembly xmlns=\"urn:schemas-microsoft-com:asm.v1\" manifestVersion=\"1.0\">\n"++
2012 " <assemblyIdentity version=\"1.0.0.0\"\n"++
2013 " processorArchitecture=\"X86\"\n"++
2014 " name=\"" ++ dropExtension exe_filename ++ "\"\n"++
2015 " type=\"win32\"/>\n\n"++
2016 " <trustInfo xmlns=\"urn:schemas-microsoft-com:asm.v3\">\n"++
2017 " <security>\n"++
2018 " <requestedPrivileges>\n"++
2019 " <requestedExecutionLevel level=\"asInvoker\" uiAccess=\"false\"/>\n"++
2020 " </requestedPrivileges>\n"++
2021 " </security>\n"++
2022 " </trustInfo>\n"++
2023 "</assembly>\n"
2024
2025 -- Windows will find the manifest file if it is named
2026 -- foo.exe.manifest. However, for extra robustness, and so that
2027 -- we can move the binary around, we can embed the manifest in
2028 -- the binary itself using windres:
2029 if not (gopt Opt_EmbedManifest dflags) then return [] else do
2030
2031 rc_filename <- newTempName dflags "rc"
2032 rc_obj_filename <- newTempName dflags (objectSuf dflags)
2033
2034 writeFile rc_filename $
2035 "1 24 MOVEABLE PURE " ++ show manifest_filename ++ "\n"
2036 -- magic numbers :-)
2037 -- show is a bit hackish above, but we need to escape the
2038 -- backslashes in the path.
2039
2040 runWindres dflags $ map SysTools.Option $
2041 ["--input="++rc_filename,
2042 "--output="++rc_obj_filename,
2043 "--output-format=coff"]
2044 -- no FileOptions here: windres doesn't like seeing
2045 -- backslashes, apparently
2046
2047 removeFile manifest_filename
2048
2049 return [rc_obj_filename]
2050 | otherwise = return []
2051
2052
2053 linkDynLibCheck :: DynFlags -> [String] -> [PackageKey] -> IO ()
2054 linkDynLibCheck dflags o_files dep_packages
2055 = do
2056 when (haveRtsOptsFlags dflags) $ do
2057 log_action dflags dflags SevInfo noSrcSpan defaultUserStyle
2058 (text "Warning: -rtsopts and -with-rtsopts have no effect with -shared." $$
2059 text " Call hs_init_ghc() from your main() function to set these options.")
2060
2061 linkDynLib dflags o_files dep_packages
2062
2063 linkStaticLibCheck :: DynFlags -> [String] -> [PackageKey] -> IO ()
2064 linkStaticLibCheck dflags o_files dep_packages
2065 = do
2066 when (platformOS (targetPlatform dflags) `notElem` [OSiOS, OSDarwin]) $
2067 throwGhcExceptionIO (ProgramError "Static archive creation only supported on Darwin/OS X/iOS")
2068 linkBinary' True dflags o_files dep_packages
2069
2070 -- -----------------------------------------------------------------------------
2071 -- Running CPP
2072
2073 doCpp :: DynFlags -> Bool -> FilePath -> FilePath -> IO ()
2074 doCpp dflags raw input_fn output_fn = do
2075 let hscpp_opts = picPOpts dflags
2076 let cmdline_include_paths = includePaths dflags
2077
2078 pkg_include_dirs <- getPackageIncludePath dflags []
2079 let include_paths = foldr (\ x xs -> "-I" : x : xs) []
2080 (cmdline_include_paths ++ pkg_include_dirs)
2081
2082 let verbFlags = getVerbFlags dflags
2083
2084 let cpp_prog args | raw = SysTools.runCpp dflags args
2085 | otherwise = SysTools.runCc dflags (SysTools.Option "-E" : args)
2086
2087 let target_defs =
2088 [ "-D" ++ HOST_OS ++ "_BUILD_OS=1",
2089 "-D" ++ HOST_ARCH ++ "_BUILD_ARCH=1",
2090 "-D" ++ TARGET_OS ++ "_HOST_OS=1",
2091 "-D" ++ TARGET_ARCH ++ "_HOST_ARCH=1" ]
2092 -- remember, in code we *compile*, the HOST is the same our TARGET,
2093 -- and BUILD is the same as our HOST.
2094
2095 let sse_defs =
2096 [ "-D__SSE__=1" | isSseEnabled dflags ] ++
2097 [ "-D__SSE2__=1" | isSse2Enabled dflags ] ++
2098 [ "-D__SSE4_2__=1" | isSse4_2Enabled dflags ]
2099
2100 let avx_defs =
2101 [ "-D__AVX__=1" | isAvxEnabled dflags ] ++
2102 [ "-D__AVX2__=1" | isAvx2Enabled dflags ] ++
2103 [ "-D__AVX512CD__=1" | isAvx512cdEnabled dflags ] ++
2104 [ "-D__AVX512ER__=1" | isAvx512erEnabled dflags ] ++
2105 [ "-D__AVX512F__=1" | isAvx512fEnabled dflags ] ++
2106 [ "-D__AVX512PF__=1" | isAvx512pfEnabled dflags ]
2107
2108 backend_defs <- getBackendDefs dflags
2109
2110 #ifdef GHCI
2111 let th_defs = [ "-D__GLASGOW_HASKELL_TH__=YES" ]
2112 #else
2113 let th_defs = [ "-D__GLASGOW_HASKELL_TH__=NO" ]
2114 #endif
2115 -- Default CPP defines in Haskell source
2116 ghcVersionH <- getGhcVersionPathName dflags
2117 let hsSourceCppOpts =
2118 [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt
2119 , "-include", ghcVersionH
2120 ]
2121
2122 cpp_prog ( map SysTools.Option verbFlags
2123 ++ map SysTools.Option include_paths
2124 ++ map SysTools.Option hsSourceCppOpts
2125 ++ map SysTools.Option target_defs
2126 ++ map SysTools.Option backend_defs
2127 ++ map SysTools.Option th_defs
2128 ++ map SysTools.Option hscpp_opts
2129 ++ map SysTools.Option sse_defs
2130 ++ map SysTools.Option avx_defs
2131 -- Set the language mode to assembler-with-cpp when preprocessing. This
2132 -- alleviates some of the C99 macro rules relating to whitespace and the hash
2133 -- operator, which we tend to abuse. Clang in particular is not very happy
2134 -- about this.
2135 ++ [ SysTools.Option "-x"
2136 , SysTools.Option "assembler-with-cpp"
2137 , SysTools.Option input_fn
2138 -- We hackily use Option instead of FileOption here, so that the file
2139 -- name is not back-slashed on Windows. cpp is capable of
2140 -- dealing with / in filenames, so it works fine. Furthermore
2141 -- if we put in backslashes, cpp outputs #line directives
2142 -- with *double* backslashes. And that in turn means that
2143 -- our error messages get double backslashes in them.
2144 -- In due course we should arrange that the lexer deals
2145 -- with these \\ escapes properly.
2146 , SysTools.Option "-o"
2147 , SysTools.FileOption "" output_fn
2148 ])
2149
2150 getBackendDefs :: DynFlags -> IO [String]
2151 getBackendDefs dflags | hscTarget dflags == HscLlvm = do
2152 llvmVer <- figureLlvmVersion dflags
2153 return $ case llvmVer of
2154 Just n -> [ "-D__GLASGOW_HASKELL_LLVM__="++show n ]
2155 _ -> []
2156
2157 getBackendDefs _ =
2158 return []
2159
2160 -- ---------------------------------------------------------------------------
2161 -- join object files into a single relocatable object file, using ld -r
2162
2163 joinObjectFiles :: DynFlags -> [FilePath] -> FilePath -> IO ()
2164 joinObjectFiles dflags o_files output_fn = do
2165 let mySettings = settings dflags
2166 ldIsGnuLd = sLdIsGnuLd mySettings
2167 osInfo = platformOS (targetPlatform dflags)
2168 ld_r args cc = SysTools.runLink dflags ([
2169 SysTools.Option "-nostdlib",
2170 SysTools.Option "-Wl,-r"
2171 ]
2172 ++ (if any (cc ==) [Clang, AppleClang, AppleClang51]
2173 then []
2174 else [SysTools.Option "-nodefaultlibs"])
2175 ++ (if osInfo == OSFreeBSD
2176 then [SysTools.Option "-L/usr/lib"]
2177 else [])
2178 -- gcc on sparc sets -Wl,--relax implicitly, but
2179 -- -r and --relax are incompatible for ld, so
2180 -- disable --relax explicitly.
2181 ++ (if platformArch (targetPlatform dflags) == ArchSPARC
2182 && ldIsGnuLd
2183 then [SysTools.Option "-Wl,-no-relax"]
2184 else [])
2185 ++ map SysTools.Option ld_build_id
2186 ++ [ SysTools.Option "-o",
2187 SysTools.FileOption "" output_fn ]
2188 ++ args)
2189
2190 -- suppress the generation of the .note.gnu.build-id section,
2191 -- which we don't need and sometimes causes ld to emit a
2192 -- warning:
2193 ld_build_id | sLdSupportsBuildId mySettings = ["-Wl,--build-id=none"]
2194 | otherwise = []
2195
2196 ccInfo <- getCompilerInfo dflags
2197 if ldIsGnuLd
2198 then do
2199 script <- newTempName dflags "ldscript"
2200 cwd <- getCurrentDirectory
2201 let o_files_abs = map (cwd </>) o_files
2202 writeFile script $ "INPUT(" ++ unwords o_files_abs ++ ")"
2203 ld_r [SysTools.FileOption "" script] ccInfo
2204 else if sLdSupportsFilelist mySettings
2205 then do
2206 filelist <- newTempName dflags "filelist"
2207 writeFile filelist $ unlines o_files
2208 ld_r [SysTools.Option "-Wl,-filelist",
2209 SysTools.FileOption "-Wl," filelist] ccInfo
2210 else do
2211 ld_r (map (SysTools.FileOption "") o_files) ccInfo
2212
2213 -- -----------------------------------------------------------------------------
2214 -- Misc.
2215
2216 -- | What phase to run after one of the backend code generators has run
2217 hscPostBackendPhase :: DynFlags -> HscSource -> HscTarget -> Phase
2218 hscPostBackendPhase _ HsBootFile _ = StopLn
2219 hscPostBackendPhase _ HsigFile _ = StopLn
2220 hscPostBackendPhase dflags _ hsc_lang =
2221 case hsc_lang of
2222 HscC -> HCc
2223 HscAsm | gopt Opt_SplitObjs dflags -> Splitter
2224 | otherwise -> As False
2225 HscLlvm -> LlvmOpt
2226 HscNothing -> StopLn
2227 HscInterpreted -> StopLn
2228
2229 touchObjectFile :: DynFlags -> FilePath -> IO ()
2230 touchObjectFile dflags path = do
2231 createDirectoryIfMissing True $ takeDirectory path
2232 SysTools.touch dflags "Touching object file" path
2233
2234 haveRtsOptsFlags :: DynFlags -> Bool
2235 haveRtsOptsFlags dflags =
2236 isJust (rtsOpts dflags) || case rtsOptsEnabled dflags of
2237 RtsOptsSafeOnly -> False
2238 _ -> True
2239
2240 -- | Find out path to @ghcversion.h@ file
2241 getGhcVersionPathName :: DynFlags -> IO FilePath
2242 getGhcVersionPathName dflags = do
2243 dirs <- getPackageIncludePath dflags [rtsPackageKey]
2244
2245 found <- filterM doesFileExist (map (</> "ghcversion.h") dirs)
2246 case found of
2247 [] -> throwGhcExceptionIO (InstallationError ("ghcversion.h missing"))
2248 (x:_) -> return x
2249
2250 -- Note [-fPIC for assembler]
2251 -- When compiling .c source file GHC's driver pipeline basically
2252 -- does the following two things:
2253 -- 1. ${CC} -S 'PIC_CFLAGS' source.c
2254 -- 2. ${CC} -x assembler -c 'PIC_CFLAGS' source.S
2255 --
2256 -- Why do we need to pass 'PIC_CFLAGS' both to C compiler and assembler?
2257 -- Because on some architectures (at least sparc32) assembler also chooses
2258 -- the relocation type!
2259 -- Consider the following C module:
2260 --
2261 -- /* pic-sample.c */
2262 -- int v;
2263 -- void set_v (int n) { v = n; }
2264 -- int get_v (void) { return v; }
2265 --
2266 -- $ gcc -S -fPIC pic-sample.c
2267 -- $ gcc -c pic-sample.s -o pic-sample.no-pic.o # incorrect binary
2268 -- $ gcc -c -fPIC pic-sample.s -o pic-sample.pic.o # correct binary
2269 --
2270 -- $ objdump -r -d pic-sample.pic.o > pic-sample.pic.o.od
2271 -- $ objdump -r -d pic-sample.no-pic.o > pic-sample.no-pic.o.od
2272 -- $ diff -u pic-sample.pic.o.od pic-sample.no-pic.o.od
2273 --
2274 -- Most of architectures won't show any difference in this test, but on sparc32
2275 -- the following assembly snippet:
2276 --
2277 -- sethi %hi(_GLOBAL_OFFSET_TABLE_-8), %l7
2278 --
2279 -- generates two kinds or relocations, only 'R_SPARC_PC22' is correct:
2280 --
2281 -- 3c: 2f 00 00 00 sethi %hi(0), %l7
2282 -- - 3c: R_SPARC_PC22 _GLOBAL_OFFSET_TABLE_-0x8
2283 -- + 3c: R_SPARC_HI22 _GLOBAL_OFFSET_TABLE_-0x8