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
= return Succeeded
link LinkBinary dflags batch_attempt_linking hpt
+ = link' dflags batch_attempt_linking hpt
+
+link LinkDynLib dflags batch_attempt_linking hpt
+ = link' dflags batch_attempt_linking hpt
+
+#ifndef GHCI
+-- warning suppression
+link other _ _ _ = panicBadLink other
+#endif
+
+panicBadLink :: GhcLink -> a
+panicBadLink other = panic ("link: GHC not built to link this way: " ++
+ show other)
+
+link' :: DynFlags -- dynamic flags
+ -> Bool -- attempt linking in batch mode?
+ -> HomePackageTable -- what to link
+ -> IO SuccessFlag
+
+link' dflags batch_attempt_linking hpt
| batch_attempt_linking
= do
let
text " Main.main not exported; not linking.")
return Succeeded
--- warning suppression
-link other _ _ _ = panicBadLink other
-
-panicBadLink :: GhcLink -> a
-panicBadLink other = panic ("link: GHC not built to link this way: " ++
- show other)
-
linkingNeeded :: DynFlags -> [Linkable] -> [PackageId] -> IO Bool
linkingNeeded dflags linkables pkg_deps = do
-- 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 =>
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 [])
-- might be a hierarchical module.
createDirectoryHierarchy (takeDirectory output_fn)
+ let (md_c_flags, _) = machdepCCOpts dflags
SysTools.runAs dflags
(map SysTools.Option as_opts
++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
, SysTools.FileOption "" input_fn
, SysTools.Option "-o"
, SysTools.FileOption "" output_fn
- ])
+ ]
+ ++ map SysTools.Option md_c_flags)
return (StopLn, dflags, maybe_loc, output_fn)
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
split_obj n = split_odir </>
takeFileName base_o ++ "__" ++ show n <.> osuf
+ let (md_c_flags, _) = machdepCCOpts dflags
let assemble_file n
= SysTools.runAs dflags
(map SysTools.Option as_opts ++
, SysTools.Option "-o"
, SysTools.FileOption "" (split_obj n)
, SysTools.FileOption "" (split_s n)
- ])
+ ]
+ ++ map SysTools.Option md_c_flags)
mapM_ assemble_file [1..n]
SysTools.Option "-Wl,-r",
SysTools.Option ld_x_flag,
SysTools.Option "-o",
- SysTools.FileOption "" output_fn ] ++ args)
+ SysTools.FileOption "" output_fn ]
+ ++ map SysTools.Option md_c_flags
+ ++ args)
ld_x_flag | null cLD_X = ""
| otherwise = "-Wl,-x"
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
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" ]
+
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
++ 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
md_c_flags
++ o_files
++ [ "-shared", "-Wl,-Bsymbolic" ] -- we need symbolic linking to resolve non-PIC intra-package-relocations
+ ++ [ "-Wl,-soname," ++ takeFileName output_fn ] -- set the library soname
++ extra_ld_inputs
++ lib_path_opts
++ extra_ld_opts
projects / ghc-hetmet.git / blobdiff