import HscTypes
import Outputable
import Module
-import UniqFM ( eltsUFM )
+import LazyUniqFM ( eltsUFM )
import ErrUtils
import DynFlags
-import StaticFlags ( v_Ld_inputs, opt_Static, opt_HardwireLibPaths, WayName(..) )
+import StaticFlags ( v_Ld_inputs, opt_Static, WayName(..) )
import Config
import Panic
import Util
import Data.Maybe
import System.Exit
import System.Environment
-import System.FilePath
-- ---------------------------------------------------------------------------
-- Pre-process
-- Unlit phase
runPhase (Unlit sf) _stop dflags _basename _suff input_fn get_output_fn maybe_loc
- = do let unlit_flags = getOpts dflags opt_L
- -- The -h option passes the file name for unlit to put in a #line directive
+ = do
output_fn <- get_output_fn dflags (Cpp sf) maybe_loc
- SysTools.runUnlit dflags
- (map SysTools.Option unlit_flags ++
- [ SysTools.Option "-h"
- , SysTools.Option input_fn
- , SysTools.FileOption "" input_fn
- , SysTools.FileOption "" output_fn
- ])
+ let unlit_flags = getOpts dflags opt_L
+ flags = map SysTools.Option unlit_flags ++
+ [ -- The -h option passes the file name for unlit to
+ -- put in a #line directive
+ SysTools.Option "-h"
+ -- cpp interprets \b etc as escape sequences,
+ -- so we use / for filenames in pragmas
+ , SysTools.Option $ reslash Forwards $ normalise input_fn
+ , SysTools.FileOption "" input_fn
+ , SysTools.FileOption "" output_fn
+ ]
+
+ SysTools.runUnlit dflags flags
return (Cpp sf, dflags, maybe_loc, output_fn)
pkg_extra_cc_opts <- getPackageExtraCcOpts dflags pkgs
+#ifdef darwin_TARGET_OS
+ pkg_framework_paths <- getPackageFrameworkPath dflags pkgs
+ let cmdline_framework_paths = frameworkPaths dflags
+ let framework_paths = map ("-F"++)
+ (cmdline_framework_paths ++ pkg_framework_paths)
+#endif
+
let split_objs = dopt Opt_SplitObjs dflags
split_opt | hcc && split_objs = [ "-DUSE_SPLIT_MARKERS" ]
| otherwise = [ ]
else [])
++ [ verb, "-S", "-Wimplicit", cc_opt ]
++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
+#ifdef darwin_TARGET_OS
+ ++ framework_paths
+#endif
++ cc_opts
++ split_opt
++ include_paths
-- we don't need the generality of a phase (MoveBinary is always
-- done after linking and makes only sense in a parallel setup) -- HWL
-runPhase_MoveBinary :: DynFlags -> FilePath -> IO Bool
-runPhase_MoveBinary dflags input_fn
- = do
+runPhase_MoveBinary :: DynFlags -> FilePath -> [PackageId] -> IO Bool
+runPhase_MoveBinary dflags input_fn dep_packages
+ | WayPar `elem` (wayNames dflags) && not opt_Static =
+ panic ("Don't know how to combine PVM wrapper and dynamic wrapper")
+ | WayPar `elem` (wayNames dflags) = do
let sysMan = pgm_sysman dflags
pvm_root <- getEnv "PVM_ROOT"
pvm_arch <- getEnv "PVM_ARCH"
- let
+ let
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?
-- generate a wrapper script for running a parallel prg under PVM
writeFile input_fn (mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan)
return True
+ | not opt_Static =
+ case (dynLibLoader dflags) of
+ Wrapped wrapmode ->
+ do
+ let (o_base, o_ext) = splitExtension input_fn
+ let wrapped_executable | o_ext == "exe" = (o_base ++ "_real") <.> o_ext
+ | otherwise = input_fn ++ "_real"
+ behaviour <- wrapper_behaviour dflags wrapmode dep_packages
+
+ -- THINKME isn't this possible to do a bit nicer?
+ let behaviour' = concatMap (\x -> if x=='\\' then "\\\\" else [x]) behaviour
+ renameFile input_fn wrapped_executable
+ let rtsDetails = (getPackageDetails (pkgState dflags) rtsPackageId);
+ SysTools.runCc dflags
+ ([ SysTools.FileOption "" ((head (libraryDirs rtsDetails)) ++ "/dyn-wrapper.c")
+ , SysTools.Option ("-DBEHAVIOUR=\"" ++ behaviour' ++ "\"")
+ , SysTools.Option "-o"
+ , SysTools.FileOption "" input_fn
+ ] ++ map (SysTools.FileOption "-I") (includeDirs rtsDetails))
+ return True
+ _ -> return True
+ | otherwise = return True
+
+wrapper_behaviour :: DynFlags -> Maybe [Char] -> [PackageId] -> IO [Char]
+wrapper_behaviour dflags mode dep_packages =
+ let seperateBySemiColon strs = tail $ concatMap (';':) strs
+ in case mode of
+ Nothing -> do
+ pkg_lib_paths <- getPackageLibraryPath dflags dep_packages
+ return ('H' : (seperateBySemiColon pkg_lib_paths))
+ Just s -> do
+ allpkg <- getPreloadPackagesAnd dflags dep_packages
+ putStrLn (unwords (map (packageIdString . packageConfigId) allpkg))
+ return $ 'F':s ++ ';':(seperateBySemiColon (map (packageIdString . packageConfigId) allpkg))
-- generates a Perl skript starting a parallel prg under PVM
mk_pvm_wrapper_script :: String -> String -> String -> String
pkg_lib_paths <- getPackageLibraryPath dflags dep_packages
let pkg_lib_path_opts = concat (map get_pkg_lib_path_opts pkg_lib_paths)
- get_pkg_lib_path_opts l | opt_HardwireLibPaths && not opt_Static = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l]
- | otherwise = ["-L" ++ l]
+#ifdef linux_TARGET_OS
+ 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
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
++ map SysTools.Option (
md_c_flags
++ o_files
+#ifdef mingw32_TARGET_OS
+ ++ [dynMain]
+#endif
++ extra_ld_inputs
++ lib_path_opts
++ extra_ld_opts
))
-- parallel only: move binary to another dir -- HWL
- when (WayPar `elem` ways)
- (do success <- runPhase_MoveBinary dflags output_fn
- if success then return ()
- else throwDyn (InstallationError ("cannot move binary to PVM dir")))
+ success <- runPhase_MoveBinary dflags output_fn dep_packages
+ if success then return ()
+ else throwDyn (InstallationError ("cannot move binary"))
exeFileName :: DynFlags -> FilePath
projects / ghc-hetmet.git / blobdiff