More build system changes; ghc-pkg is now built with Cabal

[ghc-hetmet.git] / compiler / main / SysTools.lhs

diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index 96833c8..c418789 100644 (file)
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -7,6 +7,9 @@
 -----------------------------------------------------------------------------
 
 \begin{code}
+{-# OPTIONS -fno-cse #-}
+-- -fno-cse is needed for GLOBAL_VAR's to behave properly
+
 module SysTools (
         -- Initialisation
         initSysTools,
@@ -52,7 +55,7 @@ import System.Exit
 import System.Environment
 import System.FilePath
 import System.IO
-import SYSTEM_IO_ERROR as IO
+import System.IO.Error as IO
 import System.Directory
 import Data.Char
 import Data.Maybe
@@ -149,7 +152,7 @@ initSysTools :: Maybe String    -- Maybe TopDir path (without the '-B' prefix)
                                 --      (c) the GHC usage message
 
 
-initSysTools mbMinusB _
+initSysTools mbMinusB dflags0
   = do  { (am_installed, top_dir) <- findTopDir mbMinusB
                 -- top_dir
                 --      for "installed" this is the root of GHC's support files
@@ -158,13 +161,16 @@ initSysTools mbMinusB _
                 -- 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
+              real_top_dir
+               | isWindowsHost = top_dir </> ".." </> ".."
+               | otherwise     = top_dir </> ".."
+              inplace dir   pgm  = real_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"
@@ -193,8 +199,6 @@ initSysTools mbMinusB _
                 | am_installed = installed_bin "bin/windres"
                 | otherwise    = "windres"
 
-        ; let dflags0 = defaultDynFlags
-
         ; tmpdir <- getTemporaryDirectory
         ; let dflags1 = setTmpDir tmpdir dflags0
 
@@ -322,10 +326,10 @@ findTopDir :: Maybe String   -- Maybe TopDir path (without the '-B' prefix).
 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")
+        -- by looking for a file we use for that purpose
+       ; am_inplace <- doesFileExist (top_dir </> "inplace")
 
-       ; return (am_installed, top_dir)
+       ; return (not am_inplace, top_dir)
        }
   where
     -- get_proto returns a Unix-format path (relying on getBaseDir to do so too)
@@ -430,9 +434,6 @@ xs `isContainedIn` ys = any (xs `isPrefixOf`) (tails ys)
 -- 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
@@ -446,7 +447,6 @@ getGccEnv opts =
   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
@@ -683,11 +683,6 @@ runSomethingFiltered dflags filter_fn phase_name pgm args mb_env = 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
@@ -698,10 +693,6 @@ runSomethingFiltered dflags filter_fn phase_name pgm args mb_env = do
 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
@@ -812,7 +803,6 @@ data BuildMessage
   = BuildMsg   !SDoc
   | BuildError !SrcLoc !SDoc
   | EOF
-#endif
 
 showOpt :: Option -> String
 showOpt (FileOption pre f) = pre ++ f