X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDriverPipeline.hs;h=f92a4110b9bdd59b3e6439c98326448e7da9c3d2;hb=5ccf658872ea2304f34eda6b1fb840fc1bfc0ba0;hp=bc16ede088bf1bd8cb138faaa926ea50a9cf0c88;hpb=814edf44433801e37318ce79082ac6991dbc87dd;p=ghc-hetmet.git diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index bc16ede..f92a411 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -779,9 +779,9 @@ runPhase (Cpp sf) input_fn dflags0 src_opts <- io $ getOptionsFromFile dflags0 output_fn (dflags2, unhandled_flags, warns) <- io $ parseDynamicNoPackageFlags dflags0 src_opts + io $ checkProcessArgsResult unhandled_flags unless (dopt Opt_Pp dflags2) $ io $ handleFlagWarnings dflags2 warns -- the HsPp pass below will emit warnings - io $ checkProcessArgsResult unhandled_flags setDynFlags dflags2 @@ -814,8 +814,8 @@ runPhase (HsPp sf) input_fn dflags (dflags1, unhandled_flags, warns) <- io $ parseDynamicNoPackageFlags dflags src_opts setDynFlags dflags1 - io $ handleFlagWarnings dflags1 warns io $ checkProcessArgsResult unhandled_flags + io $ handleFlagWarnings dflags1 warns return (Hsc sf, output_fn) @@ -1028,10 +1028,10 @@ runPhase cc_phase input_fn dflags (cmdline_include_paths ++ pkg_include_dirs) let md_c_flags = machdepCCOpts dflags - gcc_extra_viac_flags <- io $ getExtraViaCOpts dflags + let gcc_extra_viac_flags = extraGccViaCFlags dflags let pic_c_flags = picCCOpts dflags - let verb = getVerbFlag dflags + let verbFlags = getVerbFlags dflags -- cc-options are not passed when compiling .hc files. Our -- hc code doesn't not #include any header files anyway, so these @@ -1118,7 +1118,8 @@ runPhase cc_phase input_fn dflags ++ (if hcc then gcc_extra_viac_flags ++ more_hcc_opts else []) - ++ [ verb, "-S", "-Wimplicit", cc_opt ] + ++ verbFlags + ++ [ "-S", "-Wimplicit", cc_opt ] ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ] #ifdef darwin_TARGET_OS ++ framework_paths @@ -1227,6 +1228,8 @@ runPhase SplitAs _input_fn dflags Just x -> x let split_s n = split_s_prefix ++ "__" ++ show n <.> "s" + + split_obj :: Int -> FilePath split_obj n = split_odir takeFileName base_o ++ "__" ++ show n <.> osuf @@ -1253,15 +1256,31 @@ runPhase SplitAs _input_fn dflags io $ mapM_ assemble_file [1..n] - -- If there's a stub_o file, then we make it the n+1th split object. + -- Note [pipeline-split-init] + -- If we have a stub file, it may contain constructor + -- functions for initialisation of this module. We can't + -- simply leave the stub as a separate object file, because it + -- will never be linked in: nothing refers to it. We need to + -- ensure that if we ever refer to the data in this module + -- that needs initialisation, then we also pull in the + -- initialisation routine. + -- + -- To that end, we make a DANGEROUS ASSUMPTION here: the data + -- that needs to be initialised is all in the FIRST split + -- object. See Note [codegen-split-init]. + PipeState{maybe_stub_o} <- getPipeState - n' <- case maybe_stub_o of - Nothing -> return n - Just stub_o -> do io $ copyFile stub_o (split_obj (n+1)) - return (n+1) + case maybe_stub_o of + Nothing -> return () + Just stub_o -> io $ do + tmp_split_1 <- newTempName dflags osuf + let split_1 = split_obj 1 + copyFile split_1 tmp_split_1 + removeFile split_1 + joinObjectFiles dflags [tmp_split_1, stub_o] split_1 -- join them into a single .o file - io $ joinObjectFiles dflags (map split_obj [1..n']) output_fn + io $ joinObjectFiles dflags (map split_obj [1..n]) output_fn return (next_phase, output_fn) @@ -1415,18 +1434,21 @@ mkExtraObjToLinkIntoBinary dflags dep_packages = do link_info <- getLinkInfo dflags dep_packages mkExtraCObj dflags (showSDoc (vcat [rts_opts_enabled, extra_rts_opts, - link_opts link_info])) + link_opts link_info] + <> char '\n')) -- final newline, to + -- keep gcc happy + where mk_rts_opts_enabled val = vcat [text "#include \"Rts.h\"", text "#include \"RtsOpts.h\"", - text "const rtsOptsEnabledEnum rtsOptsEnabled = " <> + text "const RtsOptsEnabledEnum rtsOptsEnabled = " <> text val <> semi ] rts_opts_enabled = case rtsOptsEnabled dflags of - RtsOptsNone -> mk_rts_opts_enabled "rtsOptsNone" + RtsOptsNone -> mk_rts_opts_enabled "RtsOptsNone" RtsOptsSafeOnly -> empty -- The default - RtsOptsAll -> mk_rts_opts_enabled "rtsOptsAll" + RtsOptsAll -> mk_rts_opts_enabled "RtsOptsAll" extra_rts_opts = case rtsOpts dflags of Nothing -> empty @@ -1556,7 +1578,7 @@ getHCFilePackages filename = linkBinary :: DynFlags -> [FilePath] -> [PackageId] -> IO () linkBinary dflags o_files dep_packages = do - let verb = getVerbFlag dflags + let verbFlags = getVerbFlags dflags output_fn = exeFileName dflags -- get the full list of packages to link with, by combining the @@ -1634,10 +1656,10 @@ linkBinary dflags o_files dep_packages = do let md_c_flags = machdepCCOpts dflags SysTools.runLink dflags ( - [ SysTools.Option verb - , SysTools.Option "-o" - , SysTools.FileOption "" output_fn - ] + map SysTools.Option verbFlags + ++ [ SysTools.Option "-o" + , SysTools.FileOption "" output_fn + ] ++ map SysTools.Option ( md_c_flags @@ -1750,7 +1772,7 @@ maybeCreateManifest dflags exe_filename = do linkDynLib :: DynFlags -> [String] -> [PackageId] -> IO () linkDynLib dflags o_files dep_packages = do - let verb = getVerbFlag dflags + let verbFlags = getVerbFlags dflags let o_file = outputFile dflags pkgs <- getPreloadPackagesAnd dflags dep_packages @@ -1795,15 +1817,15 @@ linkDynLib dflags o_files dep_packages = do ----------------------------------------------------------------------------- let output_fn = case o_file of { Just s -> s; Nothing -> "HSdll.dll"; } - SysTools.runLink dflags - ([ SysTools.Option verb - , SysTools.Option "-o" - , SysTools.FileOption "" output_fn - , SysTools.Option "-shared" - ] ++ - [ SysTools.FileOption "-Wl,--out-implib=" (output_fn ++ ".a") - | dopt Opt_SharedImplib dflags - ] + SysTools.runLink dflags ( + map SysTools.Option verbFlags + ++ [ SysTools.Option "-o" + , SysTools.FileOption "" output_fn + , SysTools.Option "-shared" + ] ++ + [ SysTools.FileOption "-Wl,--out-implib=" (output_fn ++ ".a") + | dopt Opt_SharedImplib dflags + ] ++ map (SysTools.FileOption "") o_files ++ map SysTools.Option ( md_c_flags @@ -1855,12 +1877,12 @@ linkDynLib dflags o_files dep_packages = do Nothing -> do pwd <- getCurrentDirectory return $ pwd `combine` output_fn - SysTools.runLink dflags - ([ SysTools.Option verb - , SysTools.Option "-dynamiclib" - , SysTools.Option "-o" - , SysTools.FileOption "" output_fn - ] + SysTools.runLink dflags ( + map SysTools.Option verbFlags + ++ [ SysTools.Option "-dynamiclib" + , SysTools.Option "-o" + , SysTools.FileOption "" output_fn + ] ++ map SysTools.Option ( md_c_flags ++ o_files @@ -1891,11 +1913,11 @@ linkDynLib dflags o_files dep_packages = do -- non-PIC intra-package-relocations ["-Wl,-Bsymbolic"] - SysTools.runLink dflags - ([ SysTools.Option verb - , SysTools.Option "-o" - , SysTools.FileOption "" output_fn - ] + SysTools.runLink dflags ( + map SysTools.Option verbFlags + ++ [ SysTools.Option "-o" + , SysTools.FileOption "" output_fn + ] ++ map SysTools.Option ( md_c_flags ++ o_files @@ -1924,7 +1946,7 @@ doCpp dflags raw include_cc_opts input_fn output_fn = do let include_paths = foldr (\ x xs -> "-I" : x : xs) [] (cmdline_include_paths ++ pkg_include_dirs) - let verb = getVerbFlag dflags + let verbFlags = getVerbFlags dflags let cc_opts | not include_cc_opts = [] @@ -1944,7 +1966,7 @@ doCpp dflags raw include_cc_opts input_fn output_fn = do -- remember, in code we *compile*, the HOST is the same our TARGET, -- and BUILD is the same as our HOST. - cpp_prog ([SysTools.Option verb] + cpp_prog ( map SysTools.Option verbFlags ++ map SysTools.Option include_paths ++ map SysTools.Option hsSourceCppOpts ++ map SysTools.Option target_defs @@ -1979,14 +2001,22 @@ joinObjectFiles dflags o_files output_fn = do SysTools.Option "-nostdlib", SysTools.Option "-nodefaultlibs", SysTools.Option "-Wl,-r", + SysTools.Option ld_build_id, SysTools.Option ld_x_flag, SysTools.Option "-o", SysTools.FileOption "" output_fn ] ++ map SysTools.Option md_c_flags ++ args) + ld_x_flag | null cLD_X = "" | otherwise = "-Wl,-x" + -- suppress the generation of the .note.gnu.build-id section, + -- which we don't need and sometimes causes ld to emit a + -- warning: + ld_build_id | cLdHasBuildId == "YES" = "-Wl,--build-id=none" + | otherwise = "" + md_c_flags = machdepCCOpts dflags if cLdIsGNULd == "YES"