import HscTypes
import Outputable
import Module
-import LazyUniqFM ( eltsUFM )
+import UniqFM ( eltsUFM )
import ErrUtils
import DynFlags
import StaticFlags ( v_Ld_inputs, opt_Static, WayName(..) )
import ParserCoreUtils ( getCoreModuleName )
import SrcLoc
import FastString
-import MonadUtils
+-- import MonadUtils
-import Data.Either
+-- import Data.Either
import Exception
import Data.IORef ( readIORef )
-import GHC.Exts ( Int(..) )
+-- import GHC.Exts ( Int(..) )
import System.Directory
import System.FilePath
import System.IO
-> return ([], ms_hs_date summary)
-- We're in --make mode: finish the compilation pipeline.
_other
- -> do runPipeline StopLn hsc_env' (output_fn,Nothing)
+ -> do _ <- runPipeline StopLn hsc_env' (output_fn,Nothing)
(Just basename)
Persistent
(Just location)
let (stub_c,_,stub_o) = mkStubPaths (hsc_dflags hsc_env)
(moduleName mod) location
- runPipeline StopLn hsc_env (stub_c,Nothing) Nothing
+ _ <- runPipeline StopLn hsc_env (stub_c,Nothing) Nothing
(SpecificFile stub_o) Nothing{-no ModLocation-}
return stub_o
-- at which stage to stop.
--
-- The DynFlags can be modified by phases in the pipeline (eg. by
--- GHC_OPTIONS pragmas), and the changes affect later phases in the
+-- OPTIONS_GHC pragmas), and the changes affect later phases in the
-- pipeline.
runPipeline
:: GhcMonad m =>
runPhase (Cpp sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
= do let dflags0 = hsc_dflags hsc_env
src_opts <- liftIO $ getOptionsFromFile dflags0 input_fn
- (dflags, unhandled_flags, warns)
+ (dflags1, unhandled_flags, warns)
<- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts
- handleFlagWarnings dflags warns
checkProcessArgsResult unhandled_flags
- if not (dopt Opt_Cpp dflags) then
+ if not (dopt Opt_Cpp dflags1) then do
+ -- we have to be careful to emit warnings only once.
+ unless (dopt Opt_Pp dflags1) $ handleFlagWarnings dflags1 warns
+
-- no need to preprocess CPP, just pass input file along
-- to the next phase of the pipeline.
- return (HsPp sf, dflags, maybe_loc, input_fn)
+ return (HsPp sf, dflags1, maybe_loc, input_fn)
else do
- output_fn <- liftIO $ get_output_fn dflags (HsPp sf) maybe_loc
- liftIO $ doCpp dflags True{-raw-} False{-no CC opts-} input_fn output_fn
- return (HsPp sf, dflags, maybe_loc, output_fn)
+ output_fn <- liftIO $ get_output_fn dflags1 (HsPp sf) maybe_loc
+ liftIO $ doCpp dflags1 True{-raw-} False{-no CC opts-} input_fn output_fn
+ -- re-read the pragmas now that we've preprocessed the file
+ -- See #2464,#3457
+ src_opts <- liftIO $ getOptionsFromFile dflags0 output_fn
+ (dflags2, unhandled_flags, warns)
+ <- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts
+ unless (dopt Opt_Pp dflags2) $ handleFlagWarnings dflags2 warns
+ -- the HsPp pass below will emit warnings
+ checkProcessArgsResult unhandled_flags
+
+ return (HsPp sf, dflags2, maybe_loc, output_fn)
-------------------------------------------------------------------------------
-- HsPp phase
] ++
map SysTools.Option hspp_opts
)
- return (Hsc sf, dflags, maybe_loc, output_fn)
+
+ -- re-read pragmas now that we've parsed the file (see #3674)
+ src_opts <- liftIO $ getOptionsFromFile dflags output_fn
+ (dflags1, unhandled_flags, warns)
+ <- liftIO $ parseDynamicNoPackageFlags dflags src_opts
+ handleFlagWarnings dflags1 warns
+ checkProcessArgsResult unhandled_flags
+
+ return (Hsc sf, dflags1, maybe_loc, output_fn)
-----------------------------------------------------------------------------
-- Hsc phase
then []
else [ "-ffloat-store" ]) ++
#endif
+
-- gcc's -fstrict-aliasing allows two accesses to memory
-- to be considered non-aliasing if they have different types.
-- This interacts badly with the C code we generate, which is
-- very weakly typed, being derived from C--.
["-fno-strict-aliasing"]
-
-
liftIO $ SysTools.runCc dflags (
-- force the C compiler to interpret this file as C when
-- compiling .hc files, by adding the -x c option.
-- Also useful for plain .c files, just in case GHC saw a
-- -x c option.
[ SysTools.Option "-x", if cc_phase `eqPhase` Ccpp
- then SysTools.Option "c++" else SysTools.Option "c"] ++
+ then SysTools.Option "c++"
+ else SysTools.Option "c"] ++
[ SysTools.FileOption "" input_fn
, SysTools.Option "-o"
, SysTools.FileOption "" output_fn
++ map SysTools.Option (
md_c_flags
++ pic_c_flags
+
+#if defined(mingw32_TARGET_OS)
+ -- Stub files generated for foreign exports references the runIO_closure
+ -- and runNonIO_closure symbols, which are defined in the base package.
+ -- These symbols are imported into the stub.c file via RtsAPI.h, and the
+ -- way we do the import depends on whether we're currently compiling
+ -- the base package or not.
+ ++ (if thisPackage dflags == basePackageId
+ then [ "-DCOMPILING_BASE_PACKAGE" ]
+ else [])
+#endif
+
#ifdef sparc_TARGET_ARCH
-- We only support SparcV9 and better because V8 lacks an atomic CAS
-- instruction. Note that the user can still override this
-- This is a temporary hack.
++ ["-mcpu=v9"]
#endif
-#if defined(darwin_TARGET_OS) && defined(i386_TARGET_ARCH)
- -- By default, gcc on OS X will generate SSE
- -- instructions, which need things 16-byte aligned,
- -- but we don't 16-byte align things. Thus drop
- -- back to generic i686 compatibility. Trac #2983.
- ++ ["-march=i686"]
-#endif
++ (if hcc && mangle
then md_regd_c_flags
else [])
output_fn <- get_output_fn dflags StopLn maybe_loc
let base_o = dropExtension output_fn
- split_odir = base_o ++ "_split"
osuf = objectSuf dflags
+ split_odir = base_o ++ "_" ++ osuf ++ "_split"
createDirectoryHierarchy split_odir
pvm_executable_base = "=" ++ input_fn
pvm_executable = pvm_root ++ "/bin/" ++ pvm_arch ++ "/" ++ pvm_executable_base
-- nuke old binary; maybe use configur'ed names for cp and rm?
- tryIO (removeFile pvm_executable)
+ _ <- tryIO (removeFile pvm_executable)
-- move the newly created binary into PVM land
copy dflags "copying PVM executable" input_fn pvm_executable
-- generate a wrapper script for running a parallel prg under PVM
putStrLn (unwords (map (packageIdString . packageConfigId) allpkg))
return $ 'F':s ++ ';':(seperateBySemiColon (map (packageIdString . packageConfigId) allpkg))
+mkExtraCObj :: DynFlags -> [String] -> IO FilePath
+mkExtraCObj dflags xs
+ = do cFile <- newTempName dflags "c"
+ oFile <- newTempName dflags "o"
+ writeFile cFile $ unlines xs
+ let rtsDetails = getPackageDetails (pkgState dflags) rtsPackageId
+ SysTools.runCc dflags
+ ([Option "-c",
+ FileOption "" cFile,
+ Option "-o",
+ FileOption "" oFile] ++
+ map (FileOption "-I") (includeDirs rtsDetails))
+ return oFile
+
-- generates a Perl skript starting a parallel prg under PVM
mk_pvm_wrapper_script :: String -> String -> String -> String
mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $
pkg_lib_paths <- getPackageLibraryPath dflags dep_packages
let pkg_lib_path_opts = concat (map get_pkg_lib_path_opts pkg_lib_paths)
-#ifdef linux_TARGET_OS
+#ifdef elf_OBJ_FORMAT
get_pkg_lib_path_opts l | (dynLibLoader dflags)==SystemDependent && not opt_Static = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l]
| otherwise = ["-L" ++ l]
#else
let lib_paths = libraryPaths dflags
let lib_path_opts = map ("-L"++) lib_paths
+ -- The C "main" function is not in the rts but in a separate static
+ -- library libHSrtsmain.a that sits next to the rts lib files. Assuming
+ -- we're using a Haskell main function then we need to link it in.
+ let no_hs_main = dopt Opt_NoHsMain dflags
+ let main_lib | no_hs_main = []
+ | otherwise = [ "-lHSrtsmain" ]
+ rtsEnabledObj <- if dopt Opt_RtsOptsEnabled dflags
+ then do fn <- mkExtraCObj dflags
+ ["#include \"Rts.h\"",
+ "const rtsBool rtsOptsEnabled = rtsTrue;"]
+ return [fn]
+ else return []
+ rtsOptsObj <- case rtsOpts dflags of
+ Just opts ->
+ do fn <- mkExtraCObj dflags
+ -- We assume that the Haskell "show" does
+ -- the right thing here
+ ["char *ghc_rts_opts = " ++ show opts ++ ";"]
+ return [fn]
+ Nothing -> return []
+
pkg_link_opts <- getPackageLinkOpts dflags dep_packages
#ifdef darwin_TARGET_OS
framework_opts = concat [ ["-framework", fw] | fw <- reverse frameworks ]
-- reverse because they're added in reverse order from the cmd line
#endif
-#ifdef mingw32_TARGET_OS
- let dynMain = if not opt_Static then
- (head (libraryDirs (getPackageDetails (pkgState dflags) rtsPackageId))) ++ "/Main.dyn_o"
- else
- ""
-#endif
-- probably _stub.o files
extra_ld_inputs <- readIORef v_Ld_inputs
let
thread_opts | WayThreaded `elem` ways = [
-#if !defined(mingw32_TARGET_OS) && !defined(freebsd_TARGET_OS)
+#if !defined(mingw32_TARGET_OS) && !defined(freebsd_TARGET_OS) && !defined(haiku_TARGET_OS)
"-lpthread"
#endif
#if defined(osf3_TARGET_OS)
]
++ map SysTools.Option (
md_c_flags
- ++ o_files
+
#ifdef mingw32_TARGET_OS
- ++ [dynMain]
+ -- Permit the linker to auto link _symbol to _imp_symbol.
+ -- This lets us link against DLLs without needing an "import library".
+ ++ ["-Wl,--enable-auto-import"]
#endif
+ ++ o_files
++ extra_ld_inputs
++ lib_path_opts
++ extra_ld_opts
++ framework_opts
#endif
++ pkg_lib_path_opts
+ ++ main_lib
+ ++ rtsEnabledObj
+ ++ rtsOptsObj
++ pkg_link_opts
#ifdef darwin_TARGET_OS
++ pkg_framework_path_opts
let pkgs_no_rts = pkgs
#endif
let pkg_lib_paths = collectLibraryPaths pkgs_no_rts
- let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
+ let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
+#ifdef elf_OBJ_FORMAT
+ get_pkg_lib_path_opts l | (dynLibLoader dflags)==SystemDependent && not opt_Static = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l]
+ | otherwise = ["-L" ++ l]
+#else
+ get_pkg_lib_path_opts l = ["-L" ++ l]
+#endif
let lib_paths = libraryPaths dflags
let lib_path_opts = map ("-L"++) lib_paths
, SysTools.Option "-o"
, SysTools.FileOption "" output_fn
, SysTools.Option "-shared"
- , SysTools.FileOption "-Wl,--out-implib=" (output_fn ++ ".a")
+ ] ++
+ [ SysTools.FileOption "-Wl,--out-implib=" (output_fn ++ ".a")
+ | dopt Opt_SharedImplib dflags
]
++ map (SysTools.FileOption "") o_files
++ map SysTools.Option (
md_c_flags
+
+ -- Permit the linker to auto link _symbol to _imp_symbol
+ -- This lets us link against DLLs without needing an "import library"
+ ++ ["-Wl,--enable-auto-import"]
+
++ extra_ld_inputs
++ lib_path_opts
++ extra_ld_opts
-- later, so that it will not complain about the use of the option
-- -undefined dynamic_lookup above.
-- -install_name
- -- Causes the dynamic linker to ignore the DYLD_LIBRARY_PATH when loading
- -- this lib and instead look for it at its absolute path.
- -- When installing the .dylibs (see target.mk), we'll change that path to
- -- point to the place they are installed. Therefore, we won't have to set
- -- up DYLD_LIBRARY_PATH specifically for ghc.
+ -- Mac OS/X stores the path where a dynamic library is (to be) installed
+ -- in the library itself. It's called the "install name" of the library.
+ -- Then any library or executable that links against it before it's
+ -- installed will search for it in its ultimate install location. By
+ -- default we set the install name to the absolute path at build time, but
+ -- it can be overridden by the -dylib-install-name option passed to ghc.
+ -- Cabal does this.
-----------------------------------------------------------------------------
let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
- pwd <- getCurrentDirectory
+ instName <- case dylibInstallName dflags of
+ Just n -> return n
+ Nothing -> do
+ pwd <- getCurrentDirectory
+ return $ pwd `combine` output_fn
SysTools.runLink dflags
([ SysTools.Option verb
, SysTools.Option "-dynamiclib"
++ map SysTools.Option (
md_c_flags
++ o_files
- ++ [ "-undefined", "dynamic_lookup", "-single_module", "-Wl,-macosx_version_min","-Wl,10.3", "-install_name " ++ (pwd </> output_fn) ]
+ ++ [ "-undefined", "dynamic_lookup", "-single_module", "-Wl,-macosx_version_min","-Wl,10.5",
+ "-Wl,-read_only_relocs,suppress", "-install_name", instName ]
++ extra_ld_inputs
++ lib_path_opts
++ extra_ld_opts
-----------------------------------------------------------------------------
let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
+ let buildingRts = thisPackage dflags == rtsPackageId
+ let bsymbolicFlag = if buildingRts
+ then -- -Bsymbolic breaks the way we implement
+ -- hooks in the RTS
+ []
+ else -- we need symbolic linking to resolve
+ -- non-PIC intra-package-relocations
+ ["-Wl,-Bsymbolic"]
SysTools.runLink dflags
([ SysTools.Option verb
++ map SysTools.Option (
md_c_flags
++ o_files
- ++ [ "-shared", "-Wl,-Bsymbolic" ] -- we need symbolic linking to resolve non-PIC intra-package-relocations
+ ++ [ "-shared" ]
+ ++ bsymbolicFlag
+ ++ [ "-Wl,-soname," ++ takeFileName output_fn ] -- set the library soname
++ extra_ld_inputs
++ lib_path_opts
++ extra_ld_opts
projects / ghc-hetmet.git / blobdiff