X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FSysTools.lhs;h=d1fd9f7c400b22c146aaf76d10b73b3615d1eab2;hb=1246293616fc45787ecaed13aa31a2555510f7e3;hp=6d377743c87982935bcc1dfb94c5e5b0bd29d53c;hpb=68db78589f7faa747d26b8f10ba3b037f236c7aa;p=ghc-hetmet.git diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index 6d37774..d1fd9f7 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -48,7 +48,7 @@ import Util import DynFlags import FiniteMap -import Control.Exception +import Exception import Data.IORef import Control.Monad import System.Exit @@ -209,7 +209,7 @@ initSysTools mbMinusB dflags0 -- Check that the package config exists ; config_exists <- doesFileExist pkgconfig_path ; when (not config_exists) $ - throwDyn (InstallationError + ghcError (InstallationError ("Can't find package.conf as " ++ pkgconfig_path)) -- On Windows, gcc and friends are distributed with GHC, @@ -225,6 +225,7 @@ initSysTools mbMinusB dflags0 -- gcc can cope -- (see comments with declarations of global variables) gcc_b_arg = Option ("-B" ++ installed "gcc-lib/") + gcc_mingw_include_arg = Option ("-I" ++ installed "include/mingw/") (gcc_prog,gcc_args) | isWindowsHost && am_installed -- We tell gcc where its specs file + exes are (-B) @@ -236,7 +237,7 @@ initSysTools mbMinusB dflags0 -- the path, possibly including those from a cygwin -- install on the target, which is exactly what we're -- trying to avoid. - = (installed_bin "gcc", [gcc_b_arg]) + = (installed_bin "gcc", [gcc_b_arg, gcc_mingw_include_arg]) | otherwise = (cGCC, []) perl_path | isWindowsHost && am_installed = installed_bin cGHC_PERL @@ -268,7 +269,7 @@ initSysTools mbMinusB dflags0 [ Option "--dlltool-name", Option (installed "gcc-lib/" "dlltool"), Option "--driver-name", - Option gcc_prog, gcc_b_arg ]) + Option gcc_prog, gcc_b_arg, gcc_mingw_include_arg ]) | otherwise = (cMKDLL, []) -- cpp is derived from gcc on all platforms @@ -330,7 +331,7 @@ findTopDir mbMinusB -> do maybe_exec_dir <- getBaseDir -- Get directory of executable case maybe_exec_dir of -- (only works on Windows; -- returns Nothing on Unix) - Nothing -> throwDyn (InstallationError "missing -B option") + Nothing -> ghcError (InstallationError "missing -B option") Just dir -> return dir \end{code} @@ -677,9 +678,9 @@ runSomethingFiltered dflags filter_fn phase_name pgm args mb_env = do then return (ExitFailure 1, True) else IO.ioError err) case (doesn'tExist, exit_code) of - (True, _) -> throwDyn (InstallationError ("could not execute: " ++ pgm)) + (True, _) -> ghcError (InstallationError ("could not execute: " ++ pgm)) (_, ExitSuccess) -> return () - _ -> throwDyn (PhaseFailed phase_name exit_code) + _ -> ghcError (PhaseFailed phase_name exit_code) builderMainLoop :: DynFlags -> (String -> String) -> FilePath -> [String] -> Maybe [(String, String)] @@ -817,7 +818,7 @@ traceCmd dflags phase_name cmd_line action where handle_exn _verb exn = do { debugTraceMsg dflags 2 (char '\n') ; debugTraceMsg dflags 2 (ptext (sLit "Failed:") <+> text cmd_line <+> text (show exn)) - ; throwDyn (PhaseFailed phase_name (ExitFailure 1)) } + ; ghcError (PhaseFailed phase_name (ExitFailure 1)) } \end{code} %************************************************************************ @@ -843,16 +844,17 @@ getBaseDir = do let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32. return (Just (rootDir s)) where rootDir s = case splitFileName $ normalise s of - (d, "ghc.exe") -> + (d, ghc_exe) | lower ghc_exe == "ghc.exe" -> case splitFileName $ takeDirectory d of -- installed ghc.exe is in $topdir/bin/ghc.exe - (d', "bin") -> takeDirectory d' + (d', bin) | lower bin == "bin" -> takeDirectory d' -- inplace ghc.exe is in $topdir/ghc/stage1-inplace/ghc.exe - (d', x) | "-inplace" `isSuffixOf` x -> + (d', x) | "-inplace" `isSuffixOf` lower x -> takeDirectory d' ".." _ -> fail _ -> fail where fail = panic ("can't decompose ghc.exe path: " ++ show s) + lower = map toLower foreign import stdcall unsafe "GetModuleFileNameA" getModuleFileName :: Ptr () -> CString -> Int -> IO Int32