X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDriverPipeline.hs;h=50b45017c41b686697df53197874969fe0ba2cc7;hb=4a4554a5c38a30532ad77235ed8f7a0b0d23eb0f;hp=88b6b9045fecf84a3483736097651f56975c7763;hpb=c9b6b5e89b9f75bc40a9964fdd154242dd4ed45b;p=ghc-hetmet.git

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 88b6b90..50b4501 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -32,10 +32,10 @@ import Finder
 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
@@ -835,6 +835,13 @@ runPhase cc_phase _stop dflags _basename _suff input_fn get_output_fn maybe_loc
 
 	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         = [ ]
@@ -907,6 +914,9 @@ runPhase cc_phase _stop dflags _basename _suff input_fn get_output_fn maybe_loc
 			     else [])
 		       ++ [ verb, "-S", "-Wimplicit", cc_opt ]
 		       ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
+#ifdef darwin_TARGET_OS
+                       ++ framework_paths
+#endif
 		       ++ cc_opts
 		       ++ split_opt
 		       ++ include_paths
@@ -1075,13 +1085,15 @@ runPhase other _stop _dflags _basename _suff _input_fn _get_output_fn _maybe_loc
 -- 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?
@@ -1091,6 +1103,40 @@ runPhase_MoveBinary dflags input_fn
         -- 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
@@ -1197,8 +1243,12 @@ linkBinary dflags o_files dep_packages = do
 
     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
@@ -1288,10 +1338,9 @@ linkBinary dflags o_files dep_packages = do
 		    ))
 
     -- 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
@@ -1576,6 +1625,5 @@ hscMaybeAdjustTarget dflags stop _ current_hsc_lang
 		-- otherwise, stick to the plan
 		 | otherwise = current_hsc_lang
 
-v_Split_info :: IORef (String, Int)
 GLOBAL_VAR(v_Split_info, ("",0), (String,Int))
 	-- The split prefix and number of files