X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FSysTools.lhs;h=d1fd9f7c400b22c146aaf76d10b73b3615d1eab2;hb=3ebcd3deb769a03f4ded0fca2cf38201048c0214;hp=11e31b823474aa67a1d10b0010942daa49435fa1;hpb=9bcd5a09b7b57de8b7d6780fa7a767ff72049a7a;p=ghc-hetmet.git
diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index 11e31b8..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
@@ -74,24 +74,33 @@ import FastString
import SrcLoc ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan )
\end{code}
+How GHC finds its files
+~~~~~~~~~~~~~~~~~~~~~~~
- The configuration story
- ~~~~~~~~~~~~~~~~~~~~~~~
+[Note topdir]
GHC needs various support files (library packages, RTS etc), plus
-various auxiliary programs (cp, gcc, etc). It finds these in one
-of two places:
+various auxiliary programs (cp, gcc, etc). It starts by finding topdir:
-* When running as an *installed program*, GHC finds most of this support
- stuff in the installed library tree. The path to this tree is passed
- to GHC via the -B flag, and given to initSysTools .
+ for "installed" topdir is the root of GHC's support files ($libdir)
+ for "in-place" topdir is the root of the build tree
-* When running *in-place* in a build tree, GHC finds most of this support
- stuff in the build tree. The path to the build tree is, again passed
- to GHC via -B.
+On Unix:
+ - ghc always has a shell wrapper that passes a -B
option
+ - in an installation, is $libdir
+ - in a build tree, is $TOP/inplace-datadir
+ - so we detect the build-tree case and add ".." to get us back to $TOP
-GHC tells which of the two is the case by seeing whether package.conf
-is in TopDir [installed] or in TopDir/ghc/driver [inplace] (what a hack).
+On Windows:
+ - ghc never has a shell wrapper.
+ - we can find the location of the ghc binary, which is
+ $topdir/bin/ghc.exe in an installation, or
+ $topdir/ghc/stage1-inplace/ghc.exe in a build tree.
+ - we detect which one of these we have, and calculate $topdir.
+
+
+from topdir we can find package.conf, which contains the locations of
+almost everything else, whether we're in a build tree or installed.
SysTools.initSysProgs figures out exactly where all the auxiliary programs
@@ -154,9 +163,7 @@ initSysTools :: Maybe String -- Maybe TopDir path (without the '-B' prefix)
initSysTools mbMinusB dflags0
= do { (am_installed, top_dir) <- findTopDir mbMinusB
- -- top_dir
- -- for "installed" this is the root of GHC's support files
- -- for "in-place" it is the root of the build tree
+ -- see [Note topdir]
-- NB: top_dir is assumed to be in standard Unix
-- format, '/' separated
@@ -202,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,
@@ -218,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)
@@ -229,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
@@ -261,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
@@ -298,24 +306,6 @@ initSysTools mbMinusB dflags0
\end{code}
\begin{code}
--- Find TopDir
--- for "installed" this is the root of GHC's support files
--- for "in-place" it is the root of the build tree
---
--- Plan of action:
--- 1. Set proto_top_dir
--- if there is no given TopDir path, get the directory
--- where GHC is running (only on Windows)
---
--- 2. If package.conf exists in proto_top_dir, we are running
--- installed; and TopDir = proto_top_dir
---
--- 3. Otherwise we are running in-place, so
--- proto_top_dir will be /...stuff.../ghc/compiler
--- Set TopDir to /...stuff..., which is the root of the build tree
---
--- This is very gruesome indeed
-
findTopDir :: Maybe String -- Maybe TopDir path (without the '-B' prefix).
-> IO (Bool, -- True <=> am installed, False <=> in-place
String) -- TopDir (in Unix format '/' separated)
@@ -341,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}
@@ -688,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)]
@@ -828,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}
%************************************************************************
@@ -854,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