ghc/compiler/main/DriverPipeline.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: DriverPipeline.hs,v 1.2 2000/10/11 16:26:04 simonmar Exp $
   3 --
   4 -- GHC Driver
   5 --
   6 -- (c) Simon Marlow 2000
   7 --
   8 -----------------------------------------------------------------------------
   9
  10 module DriverPipeline (
  11    GhcMode(..), getGhcMode, v_GhcMode,
  12    genPipeline, runPipeline,
  13    preprocess,
  14    doLink,
  15   ) where
  16
  17 #include "HsVersions.h"
  18
  19 import CmSummarise -- for mkdependHS stuff
  20 import DriverState
  21 import DriverUtil
  22 import DriverMkDepend
  23 import DriverFlags
  24 import TmpFiles
  25 import Config
  26 import Util
  27 import CmdLineOpts
  28 import Panic
  29
  30 import IOExts
  31 import Posix
  32 import Exception
  33
  34 import IO
  35 import Monad
  36 import Maybe
  37
  38 -----------------------------------------------------------------------------
  39 -- GHC modes of operation
  40
  41 data GhcMode
  42   = DoMkDependHS                        -- ghc -M
  43   | DoMkDLL                             -- ghc -mk-dll
  44   | StopBefore Phase                    -- ghc -E | -C | -S | -c
  45   | DoMake                              -- ghc --make
  46   | DoInteractive                       -- ghc --interactive
  47   | DoLink                              -- [ the default ]
  48   deriving (Eq)
  49
  50 GLOBAL_VAR(v_GhcMode, error "todo", GhcMode)
  51
  52 modeFlag :: String -> Maybe GhcMode
  53 modeFlag "-M"            = Just $ DoMkDependHS
  54 modeFlag "-E"            = Just $ StopBefore Hsc
  55 modeFlag "-C"            = Just $ StopBefore HCc
  56 modeFlag "-S"            = Just $ StopBefore As
  57 modeFlag "-c"            = Just $ StopBefore Ln
  58 modeFlag "--make"        = Just $ DoMake
  59 modeFlag "--interactive" = Just $ DoInteractive
  60 modeFlag _               = Nothing
  61
  62 getGhcMode :: [String]
  63          -> IO ( [String]   -- rest of command line
  64                , GhcMode
  65                , String     -- "GhcMode" flag
  66                )
  67 getGhcMode flags
  68   = case my_partition modeFlag flags of
  69         ([]   , rest) -> return (rest, DoLink,  "") -- default is to do linking
  70         ([(flag,one)], rest) -> return (rest, one, flag)
  71         (_    , _   ) ->
  72           throwDyn (OtherError
  73                 "only one of the flags -M, -E, -C, -S, -c, --make, --interactive is allowed")
  74
  75 -----------------------------------------------------------------------------
  76 -- Phases
  77
  78 {-
  79 Phase of the           | Suffix saying | Flag saying   | (suffix of)
  80 compilation system     | ``start here''| ``stop after''| output file
  81
  82 literate pre-processor | .lhs          | -             | -
  83 C pre-processor (opt.) | -             | -E            | -
  84 Haskell compiler       | .hs           | -C, -S        | .hc, .s
  85 C compiler (opt.)      | .hc or .c     | -S            | .s
  86 assembler              | .s  or .S     | -c            | .o
  87 linker                 | other         | -             | a.out
  88 -}
  89
  90 data Phase
  91         = MkDependHS    -- haskell dependency generation
  92         | Unlit
  93         | Cpp
  94         | Hsc
  95         | Cc
  96         | HCc           -- Haskellised C (as opposed to vanilla C) compilation
  97         | Mangle        -- assembly mangling, now done by a separate script.
  98         | SplitMangle   -- after mangler if splitting
  99         | SplitAs
 100         | As
 101         | Ln
 102   deriving (Eq)
 103
 104 -- the first compilation phase for a given file is determined
 105 -- by its suffix.
 106 startPhase "lhs"   = Unlit
 107 startPhase "hs"    = Cpp
 108 startPhase "hc"    = HCc
 109 startPhase "c"     = Cc
 110 startPhase "raw_s" = Mangle
 111 startPhase "s"     = As
 112 startPhase "S"     = As
 113 startPhase "o"     = Ln
 114 startPhase _       = Ln    -- all unknown file types
 115
 116 -- the output suffix for a given phase is uniquely determined by
 117 -- the input requirements of the next phase.
 118 phase_input_ext Unlit       = "lhs"
 119 phase_input_ext Cpp         = "lpp"     -- intermediate only
 120 phase_input_ext Hsc         = "cpp"     -- intermediate only
 121 phase_input_ext HCc         = "hc"
 122 phase_input_ext Cc          = "c"
 123 phase_input_ext Mangle      = "raw_s"
 124 phase_input_ext SplitMangle = "split_s" -- not really generated
 125 phase_input_ext As          = "s"
 126 phase_input_ext SplitAs     = "split_s" -- not really generated
 127 phase_input_ext Ln          = "o"
 128 phase_input_ext MkDependHS  = "dep"
 129
 130 haskellish_suffix = (`elem` [ "hs", "lhs", "hc" ])
 131 cish_suffix       = (`elem` [ "c", "s", "S" ])  -- maybe .cc et al.??
 132
 133 haskellish_file f = haskellish_suffix suf where (_,suf) = splitFilename f
 134 cish_file f       = cish_suffix suf       where (_,suf) = splitFilename f
 135
 136 -----------------------------------------------------------------------------
 137 -- genPipeline
 138 --
 139 -- Herein is all the magic about which phases to run in which order, whether
 140 -- the intermediate files should be in /tmp or in the current directory,
 141 -- what the suffix of the intermediate files should be, etc.
 142
 143 -- The following compilation pipeline algorithm is fairly hacky.  A
 144 -- better way to do this would be to express the whole comilation as a
 145 -- data flow DAG, where the nodes are the intermediate files and the
 146 -- edges are the compilation phases.  This framework would also work
 147 -- nicely if a haskell dependency generator was included in the
 148 -- driver.
 149
 150 -- It would also deal much more cleanly with compilation phases that
 151 -- generate multiple intermediates, (eg. hsc generates .hc, .hi, and
 152 -- possibly stub files), where some of the output files need to be
 153 -- processed further (eg. the stub files need to be compiled by the C
 154 -- compiler).
 155
 156 -- A cool thing to do would then be to execute the data flow graph
 157 -- concurrently, automatically taking advantage of extra processors on
 158 -- the host machine.  For example, when compiling two Haskell files
 159 -- where one depends on the other, the data flow graph would determine
 160 -- that the C compiler from the first comilation can be overlapped
 161 -- with the hsc comilation for the second file.
 162
 163 data IntermediateFileType
 164   = Temporary
 165   | Persistent
 166   deriving (Eq)
 167
 168 genPipeline
 169    :: GhcMode           -- when to stop
 170    -> String            -- "stop after" flag (for error messages)
 171    -> String            -- original filename
 172    -> IO [              -- list of phases to run for this file
 173              (Phase,
 174               IntermediateFileType,  -- keep the output from this phase?
 175               String)                -- output file suffix
 176          ]
 177
 178 genPipeline todo stop_flag filename
 179  = do
 180    split      <- readIORef split_object_files
 181    mangle     <- readIORef do_asm_mangling
 182    lang       <- readIORef hsc_lang
 183    keep_hc    <- readIORef keep_hc_files
 184    keep_raw_s <- readIORef keep_raw_s_files
 185    keep_s     <- readIORef keep_s_files
 186
 187    let
 188    ----------- -----  ----   ---   --   --  -  -  -
 189     (_basename, suffix) = splitFilename filename
 190
 191     start_phase = startPhase suffix
 192
 193     haskellish = haskellish_suffix suffix
 194     cish = cish_suffix suffix
 195
 196    -- for a .hc file, or if the -C flag is given, we need to force lang to HscC
 197     real_lang
 198         | suffix == "hc"  = HscC
 199         | todo == StopBefore HCc && lang /= HscC && haskellish = HscC
 200         | otherwise = lang
 201
 202    let
 203    ----------- -----  ----   ---   --   --  -  -  -
 204     pipeline
 205       | todo == DoMkDependHS = [ Unlit, Cpp, MkDependHS ]
 206
 207       | haskellish =
 208        case real_lang of
 209         HscC    | split && mangle -> [ Unlit, Cpp, Hsc, HCc, Mangle,
 210                                         SplitMangle, SplitAs ]
 211                 | mangle          -> [ Unlit, Cpp, Hsc, HCc, Mangle, As ]
 212                 | split           -> not_valid
 213                 | otherwise       -> [ Unlit, Cpp, Hsc, HCc, As ]
 214
 215         HscAsm  | split           -> [ Unlit, Cpp, Hsc, SplitMangle, SplitAs ]
 216                 | otherwise       -> [ Unlit, Cpp, Hsc, As ]
 217
 218         HscJava | split           -> not_valid
 219                 | otherwise       -> error "not implemented: compiling via Java"
 220
 221       | cish      = [ Cc, As ]
 222
 223       | otherwise = [ ]  -- just pass this file through to the linker
 224
 225         -- ToDo: this is somewhat cryptic
 226     not_valid = throwDyn (OtherError ("invalid option combination"))
 227    ----------- -----  ----   ---   --   --  -  -  -
 228
 229         -- this shouldn't happen.
 230    if start_phase /= Ln && start_phase `notElem` pipeline
 231         then throwDyn (OtherError ("can't find starting phase for "
 232                                     ++ filename))
 233         else do
 234
 235         -- if we can't find the phase we're supposed to stop before,
 236         -- something has gone wrong.
 237    case todo of
 238         StopBefore phase ->
 239            when (phase /= Ln
 240                  && phase `notElem` pipeline
 241                  && not (phase == As && SplitAs `elem` pipeline)) $
 242               throwDyn (OtherError
 243                 ("flag " ++ stop_flag
 244                  ++ " is incompatible with source file `" ++ filename ++ "'"))
 245         _ -> return ()
 246
 247    let
 248    ----------- -----  ----   ---   --   --  -  -  -
 249       annotatePipeline
 250          :: [Phase]             -- raw pipeline
 251          -> Phase               -- phase to stop before
 252          -> [(Phase, IntermediateFileType, String{-file extension-})]
 253       annotatePipeline []     _    = []
 254       annotatePipeline (Ln:_) _    = []
 255       annotatePipeline (phase:next_phase:ps) stop =
 256           (phase, keep_this_output, phase_input_ext next_phase)
 257              : annotatePipeline (next_phase:ps) stop
 258           where
 259                 keep_this_output
 260                      | next_phase == stop = Persistent
 261                      | otherwise =
 262                         case next_phase of
 263                              Ln -> Persistent
 264                              Mangle | keep_raw_s -> Persistent
 265                              As     | keep_s     -> Persistent
 266                              HCc    | keep_hc    -> Persistent
 267                              _other              -> Temporary
 268
 269         -- add information about output files to the pipeline
 270         -- the suffix on an output file is determined by the next phase
 271         -- in the pipeline, so we add linking to the end of the pipeline
 272         -- to force the output from the final phase to be a .o file.
 273       stop_phase = case todo of StopBefore phase -> phase
 274                                 DoMkDependHS     -> Ln
 275                                 DoLink           -> Ln
 276       annotated_pipeline = annotatePipeline (pipeline ++ [ Ln ]) stop_phase
 277
 278       phase_ne p (p1,_,_) = (p1 /= p)
 279    ----------- -----  ----   ---   --   --  -  -  -
 280
 281    return $
 282      dropWhile (phase_ne start_phase) .
 283         foldr (\p ps -> if phase_ne stop_phase p then p:ps else [])  []
 284                 $ annotated_pipeline
 285
 286
 287 runPipeline
 288   :: [ (Phase, IntermediateFileType, String) ] -- phases to run
 289   -> String                     -- input file
 290   -> Bool                       -- doing linking afterward?
 291   -> Bool                       -- take into account -o when generating output?
 292   -> IO String                  -- return final filename
 293
 294 runPipeline pipeline input_fn do_linking use_ofile
 295   = pipeLoop pipeline input_fn do_linking use_ofile basename suffix
 296   where (basename, suffix) = splitFilename input_fn
 297
 298 pipeLoop [] input_fn _ _ _ _ = return input_fn
 299 pipeLoop ((phase, keep, o_suffix):phases)
 300         input_fn do_linking use_ofile orig_basename orig_suffix
 301   = do
 302
 303      output_fn <- outputFileName (null phases) keep o_suffix
 304
 305      carry_on <- run_phase phase orig_basename orig_suffix input_fn output_fn
 306         -- sometimes we bail out early, eg. when the compiler's recompilation
 307         -- checker has determined that recompilation isn't necessary.
 308      if not carry_on
 309         then do let (_,keep,final_suffix) = last phases
 310                 ofile <- outputFileName True keep final_suffix
 311                 return ofile
 312         else do -- carry on ...
 313
 314         -- sadly, ghc -E is supposed to write the file to stdout.  We
 315         -- generate <file>.cpp, so we also have to cat the file here.
 316      when (null phases && phase == Cpp) $
 317         run_something "Dump pre-processed file to stdout"
 318                       ("cat " ++ output_fn)
 319
 320      pipeLoop phases output_fn do_linking use_ofile orig_basename orig_suffix
 321
 322   where
 323      outputFileName last_phase keep suffix
 324         = do o_file <- readIORef output_file
 325              if last_phase && not do_linking && use_ofile && isJust o_file
 326                then case o_file of
 327                        Just s  -> return s
 328                        Nothing -> error "outputFileName"
 329                else if keep == Persistent
 330                            then do f <- odir_ify (orig_basename ++ '.':suffix)
 331                                    osuf_ify f
 332                            else newTempName suffix
 333
 334 -------------------------------------------------------------------------------
 335 -- Unlit phase
 336
 337 run_phase Unlit _basename _suff input_fn output_fn
 338   = do unlit <- readIORef pgm_L
 339        unlit_flags <- getOpts opt_L
 340        run_something "Literate pre-processor"
 341           ("echo '# 1 \"" ++input_fn++"\"' > "++output_fn++" && "
 342            ++ unlit ++ ' ':input_fn ++ " - >> " ++ output_fn)
 343        return True
 344
 345 -------------------------------------------------------------------------------
 346 -- Cpp phase
 347
 348 run_phase Cpp _basename _suff input_fn output_fn
 349   = do src_opts <- getOptionsFromSource input_fn
 350         -- ToDo: this is *wrong* if we're processing more than one file:
 351         -- the OPTIONS will persist through the subsequent compilations.
 352        _ <- processArgs dynamic_flags src_opts []
 353
 354        do_cpp <- readState cpp_flag
 355        if do_cpp
 356           then do
 357             cpp <- readIORef pgm_P
 358             hscpp_opts <- getOpts opt_P
 359             hs_src_cpp_opts <- readIORef hs_source_cpp_opts
 360
 361             cmdline_include_paths <- readIORef include_paths
 362             pkg_include_dirs <- getPackageIncludePath
 363             let include_paths = map (\p -> "-I"++p) (cmdline_include_paths
 364                                                         ++ pkg_include_dirs)
 365
 366             verb <- is_verbose
 367             run_something "C pre-processor"
 368                 (unwords
 369                    (["echo '{-# LINE 1 \"" ++ input_fn ++ "\" -}'", ">", output_fn, "&&",
 370                      cpp, verb]
 371                     ++ include_paths
 372                     ++ hs_src_cpp_opts
 373                     ++ hscpp_opts
 374                     ++ [ "-x", "c", input_fn, ">>", output_fn ]
 375                    ))
 376           else do
 377             run_something "Ineffective C pre-processor"
 378                    ("echo '{-# LINE 1 \""  ++ input_fn ++ "\" -}' > "
 379                     ++ output_fn ++ " && cat " ++ input_fn
 380                     ++ " >> " ++ output_fn)
 381        return True
 382
 383 -----------------------------------------------------------------------------
 384 -- MkDependHS phase
 385
 386 run_phase MkDependHS basename suff input_fn _output_fn = do
 387    src <- readFile input_fn
 388    let imports = getImports src
 389
 390    deps <- mapM (findDependency basename) imports
 391
 392    osuf_opt <- readIORef output_suf
 393    let osuf = case osuf_opt of
 394                         Nothing -> "o"
 395                         Just s  -> s
 396
 397    extra_suffixes <- readIORef dep_suffixes
 398    let suffixes = osuf : map (++ ('_':osuf)) extra_suffixes
 399        ofiles = map (\suf -> basename ++ '.':suf) suffixes
 400
 401    objs <- mapM odir_ify ofiles
 402
 403    hdl <- readIORef dep_tmp_hdl
 404
 405         -- std dependeny of the object(s) on the source file
 406    hPutStrLn hdl (unwords objs ++ " : " ++ basename ++ '.':suff)
 407
 408    let genDep (dep, False {- not an hi file -}) =
 409           hPutStrLn hdl (unwords objs ++ " : " ++ dep)
 410        genDep (dep, True  {- is an hi file -}) = do
 411           hisuf <- readIORef hi_suf
 412           let dep_base = remove_suffix '.' dep
 413               deps = (dep_base ++ hisuf)
 414                      : map (\suf -> dep_base ++ suf ++ '_':hisuf) extra_suffixes
 415                   -- length objs should be == length deps
 416           sequence_ (zipWith (\o d -> hPutStrLn hdl (o ++ " : " ++ d)) objs deps)
 417
 418    mapM genDep [ d | Just d <- deps ]
 419
 420    return True
 421
 422 -- add the lines to dep_makefile:
 423            -- always:
 424                    -- this.o : this.hs
 425
 426            -- if the dependency is on something other than a .hi file:
 427                    -- this.o this.p_o ... : dep
 428            -- otherwise
 429                    -- if the import is {-# SOURCE #-}
 430                            -- this.o this.p_o ... : dep.hi-boot[-$vers]
 431
 432                    -- else
 433                            -- this.o ...   : dep.hi
 434                            -- this.p_o ... : dep.p_hi
 435                            -- ...
 436
 437            -- (where .o is $osuf, and the other suffixes come from
 438            -- the cmdline -s options).
 439
 440 -----------------------------------------------------------------------------
 441 -- Hsc phase
 442
 443 run_phase Hsc   basename suff input_fn output_fn
 444   = do
 445
 446   -- we add the current directory (i.e. the directory in which
 447   -- the .hs files resides) to the import path, since this is
 448   -- what gcc does, and it's probably what you want.
 449         let current_dir = getdir basename
 450
 451         paths <- readIORef include_paths
 452         writeIORef include_paths (current_dir : paths)
 453
 454   -- figure out where to put the .hi file
 455         ohi    <- readIORef output_hi
 456         hisuf  <- readIORef hi_suf
 457         let hifile = case ohi of
 458                            Nothing -> current_dir ++ {-ToDo: modname!!-}basename
 459                                         ++ hisuf
 460                            Just fn -> fn
 461
 462   -- figure out if the source has changed, for recompilation avoidance.
 463   -- only do this if we're eventually going to generate a .o file.
 464   -- (ToDo: do when generating .hc files too?)
 465   --
 466   -- Setting source_unchanged to "-fsource_unchanged" means that M.o seems
 467   -- to be up to date wrt M.hs; so no need to recompile unless imports have
 468   -- changed (which the compiler itself figures out).
 469   -- Setting source_unchanged to "" tells the compiler that M.o is out of
 470   -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
 471         do_recomp <- readIORef recomp
 472         todo <- readIORef v_GhcMode
 473         o_file <- odir_ify (basename ++ '.':phase_input_ext Ln)
 474         source_unchanged <-
 475           if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln ))
 476              then return ""
 477              else do t1 <- getModificationTime (basename ++ '.':suff)
 478                      o_file_exists <- doesFileExist o_file
 479                      if not o_file_exists
 480                         then return ""  -- Need to recompile
 481                         else do t2 <- getModificationTime o_file
 482                                 if t2 > t1
 483                                   then return "-fsource-unchanged"
 484                                   else return ""
 485
 486    -- build a bogus ModSummary to pass to hscMain.
 487         let summary = ModSummary {
 488                         ms_loc = SourceOnly (error "no mod") input_fn,
 489                         ms_ppsource = Just (loc, error "no fingerprint"),
 490                         ms_imports = error "no imports"
 491                      }
 492
 493   -- run the compiler!
 494         result <- hscMain dyn_flags mod_summary
 495                                 Nothing{-no iface-}
 496                                 output_fn emptyUFM emptyPCS
 497
 498         case result of {
 499
 500             HscErrs pcs errs warns -> do
 501                 mapM (printSDoc PprForUser) warns
 502                 mapM (printSDoc PprForUser) errs
 503                 throwDyn (PhaseFailed "hsc" (ExitFailure 1));
 504
 505             HscOk details maybe_iface maybe_stub_h maybe_stub_c pcs warns -> do
 506
 507         mapM (printSDoc PprForUser) warns
 508
 509    -- generate the interface file
 510         case iface of
 511            Nothing -> -- compilation not required
 512              do run_something "Touching object file" ("touch " ++ o_file)
 513                 return False
 514
 515            Just iface ->
 516
 517   -- Deal with stubs
 518         let stub_h = basename ++ "_stub.h"
 519         let stub_c = basename ++ "_stub.c"
 520
 521   -- copy the .stub_h file into the current dir if necessary
 522         case maybe_stub_h of
 523            Nothing -> return ()
 524            Just tmp_stub_h -> do
 525                 run_something "Copy stub .h file"
 526                                 ("cp " ++ tmp_stub_h ++ ' ':stub_h)
 527
 528                         -- #include <..._stub.h> in .hc file
 529                 addCmdlineHCInclude tmp_stub_h  -- hack
 530
 531   -- copy the .stub_c file into the current dir, and compile it, if necessary
 532         case maybe_stub_c of
 533            Nothing -> return ()
 534            Just tmp_stub_c -> do  -- copy the _stub.c file into the current dir
 535                 run_something "Copy stub .c file"
 536                     (unwords [
 537                         "rm -f", stub_c, "&&",
 538                         "echo \'#include \""++stub_h++"\"\' >"++stub_c, " &&",
 539                         "cat", tmp_stub_c, ">> ", stub_c
 540                         ])
 541
 542                         -- compile the _stub.c file w/ gcc
 543                 pipeline <- genPipeline (StopBefore Ln) "" stub_c
 544                 runPipeline pipeline stub_c False{-no linking-} False{-no -o option-}
 545
 546                 add ld_inputs (basename++"_stub.o")
 547
 548         return True
 549
 550 -----------------------------------------------------------------------------
 551 -- Cc phase
 552
 553 -- we don't support preprocessing .c files (with -E) now.  Doing so introduces
 554 -- way too many hacks, and I can't say I've ever used it anyway.
 555
 556 run_phase cc_phase _basename _suff input_fn output_fn
 557    | cc_phase == Cc || cc_phase == HCc
 558    = do cc <- readIORef pgm_c
 559         cc_opts <- (getOpts opt_c)
 560         cmdline_include_dirs <- readIORef include_paths
 561
 562         let hcc = cc_phase == HCc
 563
 564                 -- add package include paths even if we're just compiling
 565                 -- .c files; this is the Value Add(TM) that using
 566                 -- ghc instead of gcc gives you :)
 567         pkg_include_dirs <- getPackageIncludePath
 568         let include_paths = map (\p -> "-I"++p) (cmdline_include_dirs
 569                                                         ++ pkg_include_dirs)
 570
 571         c_includes <- getPackageCIncludes
 572         cmdline_includes <- readState cmdline_hc_includes -- -#include options
 573
 574         let cc_injects | hcc = unlines (map mk_include
 575                                         (c_includes ++ reverse cmdline_includes))
 576                        | otherwise = ""
 577             mk_include h_file =
 578                 case h_file of
 579                    '"':_{-"-} -> "#include "++h_file
 580                    '<':_      -> "#include "++h_file
 581                    _          -> "#include \""++h_file++"\""
 582
 583         cc_help <- newTempName "c"
 584         h <- openFile cc_help WriteMode
 585         hPutStr h cc_injects
 586         hPutStrLn h ("#include \"" ++ input_fn ++ "\"\n")
 587         hClose h
 588
 589         ccout <- newTempName "ccout"
 590
 591         mangle <- readIORef do_asm_mangling
 592         (md_c_flags, md_regd_c_flags) <- machdepCCOpts
 593
 594         verb <- is_verbose
 595
 596         o2 <- readIORef opt_minus_o2_for_C
 597         let opt_flag | o2        = "-O2"
 598                      | otherwise = "-O"
 599
 600         pkg_extra_cc_opts <- getPackageExtraCcOpts
 601
 602         excessPrecision <- readIORef excess_precision
 603
 604         run_something "C Compiler"
 605          (unwords ([ cc, "-x", "c", cc_help, "-o", output_fn ]
 606                    ++ md_c_flags
 607                    ++ (if cc_phase == HCc && mangle
 608                          then md_regd_c_flags
 609                          else [])
 610                    ++ [ verb, "-S", "-Wimplicit", opt_flag ]
 611                    ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
 612                    ++ cc_opts
 613 #ifdef mingw32_TARGET_OS
 614                    ++ [" -mno-cygwin"]
 615 #endif
 616                    ++ (if excessPrecision then [] else [ "-ffloat-store" ])
 617                    ++ include_paths
 618                    ++ pkg_extra_cc_opts
 619 --                 ++ [">", ccout]
 620                    ))
 621         return True
 622
 623         -- ToDo: postprocess the output from gcc
 624
 625 -----------------------------------------------------------------------------
 626 -- Mangle phase
 627
 628 run_phase Mangle _basename _suff input_fn output_fn
 629   = do mangler <- readIORef pgm_m
 630        mangler_opts <- getOpts opt_m
 631        machdep_opts <-
 632          if (prefixMatch "i386" cTARGETPLATFORM)
 633             then do n_regs <- readState stolen_x86_regs
 634                     return [ show n_regs ]
 635             else return []
 636        run_something "Assembly Mangler"
 637         (unwords (mangler :
 638                      mangler_opts
 639                   ++ [ input_fn, output_fn ]
 640                   ++ machdep_opts
 641                 ))
 642        return True
 643
 644 -----------------------------------------------------------------------------
 645 -- Splitting phase
 646
 647 run_phase SplitMangle _basename _suff input_fn _output_fn
 648   = do  splitter <- readIORef pgm_s
 649
 650         -- this is the prefix used for the split .s files
 651         tmp_pfx <- readIORef v_TmpDir
 652         x <- getProcessID
 653         let split_s_prefix = tmp_pfx ++ "/ghc" ++ show x
 654         writeIORef split_prefix split_s_prefix
 655         addFilesToClean [split_s_prefix ++ "__*"] -- d:-)
 656
 657         -- allocate a tmp file to put the no. of split .s files in (sigh)
 658         n_files <- newTempName "n_files"
 659
 660         run_something "Split Assembly File"
 661          (unwords [ splitter
 662                   , input_fn
 663                   , split_s_prefix
 664                   , n_files ]
 665          )
 666
 667         -- save the number of split files for future references
 668         s <- readFile n_files
 669         let n = read s :: Int
 670         writeIORef n_split_files n
 671         return True
 672
 673 -----------------------------------------------------------------------------
 674 -- As phase
 675
 676 run_phase As _basename _suff input_fn output_fn
 677   = do  as <- readIORef pgm_a
 678         as_opts <- getOpts opt_a
 679
 680         cmdline_include_paths <- readIORef include_paths
 681         let cmdline_include_flags = map (\p -> "-I"++p) cmdline_include_paths
 682         run_something "Assembler"
 683            (unwords (as : as_opts
 684                        ++ cmdline_include_flags
 685                        ++ [ "-c", input_fn, "-o",  output_fn ]
 686                     ))
 687         return True
 688
 689 run_phase SplitAs basename _suff _input_fn _output_fn
 690   = do  as <- readIORef pgm_a
 691         as_opts <- getOpts opt_a
 692
 693         split_s_prefix <- readIORef split_prefix
 694         n <- readIORef n_split_files
 695
 696         odir <- readIORef output_dir
 697         let real_odir = case odir of
 698                                 Nothing -> basename
 699                                 Just d  -> d
 700
 701         let assemble_file n = do
 702                     let input_s  = split_s_prefix ++ "__" ++ show n ++ ".s"
 703                     let output_o = newdir real_odir
 704                                         (basename ++ "__" ++ show n ++ ".o")
 705                     real_o <- osuf_ify output_o
 706                     run_something "Assembler"
 707                             (unwords (as : as_opts
 708                                       ++ [ "-c", "-o", real_o, input_s ]
 709                             ))
 710
 711         mapM_ assemble_file [1..n]
 712         return True
 713
 714 -----------------------------------------------------------------------------
 715 -- Linking
 716
 717 doLink :: [String] -> IO ()
 718 doLink o_files = do
 719     ln <- readIORef pgm_l
 720     verb <- is_verbose
 721     o_file <- readIORef output_file
 722     let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
 723
 724     pkg_lib_paths <- getPackageLibraryPath
 725     let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
 726
 727     lib_paths <- readIORef library_paths
 728     let lib_path_opts = map ("-L"++) lib_paths
 729
 730     pkg_libs <- getPackageLibraries
 731     let pkg_lib_opts = map (\lib -> "-l"++lib) pkg_libs
 732
 733     libs <- readIORef cmdline_libraries
 734     let lib_opts = map ("-l"++) (reverse libs)
 735          -- reverse because they're added in reverse order from the cmd line
 736
 737     pkg_extra_ld_opts <- getPackageExtraLdOpts
 738
 739         -- probably _stub.o files
 740     extra_ld_inputs <- readIORef ld_inputs
 741
 742         -- opts from -optl-<blah>
 743     extra_ld_opts <- getStaticOpts opt_l
 744
 745     run_something "Linker"
 746        (unwords
 747          ([ ln, verb, "-o", output_fn ]
 748          ++ o_files
 749          ++ extra_ld_inputs
 750          ++ lib_path_opts
 751          ++ lib_opts
 752          ++ pkg_lib_path_opts
 753          ++ pkg_lib_opts
 754          ++ pkg_extra_ld_opts
 755          ++ extra_ld_opts
 756         )
 757        )
 758
 759 -----------------------------------------------------------------------------
 760 -- Just preprocess a file, put the result in a temp. file (used by the
 761 -- compilation manager during the summary phase).
 762
 763 preprocess :: FilePath -> IO FilePath
 764 preprocess filename =
 765   ASSERT(haskellish_file filename)
 766   do pipeline <- genPipeline (StopBefore Hsc) ("preprocess") filename
 767      runPipeline pipeline filename False{-no linking-} False{-no -o flag-}