-----------------------------------------------------------------------------
\begin{code}
+{-# OPTIONS -fno-cse #-}
+-- -fno-cse is needed for GLOBAL_VAR's to behave properly
+
module SysTools (
-- Initialisation
initSysTools,
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:
+
+ 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 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 .
+On Unix:
+ - ghc always has a shell wrapper that passes a -B<dir> option
+ - in an installation, <dir> is $libdir
+ - in a build tree, <dir> is $TOP/inplace-datadir
+ - so we detect the build-tree case and add ".." to get us back to $TOP
-* 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 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.
-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).
+
+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
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
; let installed, installed_bin :: FilePath -> FilePath
- installed_bin pgm = top_dir </> pgm
- installed file = top_dir </> file
- inplace dir pgm = top_dir </> dir </> pgm
+ installed_bin pgm = top_dir </> pgm
+ installed file = top_dir </> file
+ inplace dir pgm = top_dir </> dir </> pgm
; let pkgconfig_path
| am_installed = installed "package.conf"
- | otherwise = inplace cGHC_DRIVER_DIR_REL "package.conf.inplace"
+ | otherwise = inplace "inplace-datadir" "package.conf"
ghc_usage_msg_path
| am_installed = installed "ghc-usage.txt"
\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)
findTopDir mbMinusB
= do { top_dir <- get_proto
- -- Discover whether we're running in a build tree or in an installation,
- -- by looking for the package configuration file.
- ; am_installed <- doesFileExist (top_dir </> "package.conf")
+ ; exists1 <- doesFileExist (top_dir </> "package.conf")
+ ; exists2 <- doesFileExist (top_dir </> "inplace")
+ ; let amInplace = not exists1 -- On Windows, package.conf doesn't exist
+ -- when we are inplace
+ || exists2 -- On Linux, the presence of inplace signals
+ -- that we are inplace
- ; return (am_installed, top_dir)
+ ; let real_top = if exists2 then top_dir </> ".." else top_dir
+
+ ; return (not amInplace, real_top)
}
where
-- get_proto returns a Unix-format path (relying on getBaseDir to do so too)
-- binaries (see bug #1110).
getGccEnv :: [Option] -> IO (Maybe [(String,String)])
getGccEnv opts =
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 603
- return Nothing
-#else
if null b_dirs
then return Nothing
else do env <- getEnvironment
mangle_path (path,paths) | map toUpper path == "PATH"
= (path, '\"' : head b_dirs ++ "\";" ++ paths)
mangle_path other = other
-#endif
runMangle :: DynFlags -> [Option] -> IO ()
runMangle dflags args = do
-- to test for this in general.)
(\ err ->
if IO.isDoesNotExistError err
-#if defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ < 604
- -- the 'compat' version of rawSystem under mingw32 always
- -- maps 'errno' to EINVAL to failure.
- || case (ioeGetErrorType err ) of { InvalidArgument{} -> True ; _ -> False}
-#endif
then return (ExitFailure 1, True)
else IO.ioError err)
case (doesn'tExist, exit_code) of
builderMainLoop :: DynFlags -> (String -> String) -> FilePath
-> [String] -> Maybe [(String, String)]
-> IO ExitCode
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 603
-builderMainLoop dflags filter_fn pgm real_args mb_env = do
- rawSystem pgm real_args
-#else
builderMainLoop dflags filter_fn pgm real_args mb_env = do
chan <- newChan
(hStdIn, hStdOut, hStdErr, hProcess) <- runInteractiveProcess pgm real_args Nothing mb_env
= BuildMsg !SDoc
| BuildError !SrcLoc !SDoc
| EOF
-#endif
showOpt :: Option -> String
showOpt (FileOption pre f) = pre ++ f
rootDir s = case splitFileName $ normalise s of
(d, "ghc.exe") ->
case splitFileName $ takeDirectory d of
+ -- installed ghc.exe is in $topdir/bin/ghc.exe
(d', "bin") -> takeDirectory d'
- _ -> panic ("Expected \"bin\" in " ++ show s)
- _ -> panic ("Expected \"ghc.exe\" in " ++ show s)
+ -- inplace ghc.exe is in $topdir/ghc/stage1-inplace/ghc.exe
+ (d', x) | "-inplace" `isSuffixOf` x ->
+ takeDirectory d' </> ".."
+ _ -> fail
+ _ -> fail
+ where fail = panic ("can't decompose ghc.exe path: " ++ show s)
foreign import stdcall unsafe "GetModuleFileNameA"
getModuleFileName :: Ptr () -> CString -> Int -> IO Int32
projects / ghc-hetmet.git / blobdiff