try to fix the way we find $topdir

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

diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index c433374..11e31b8 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,
@@ -158,13 +161,13 @@ initSysTools mbMinusB dflags0
                 -- 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"
@@ -319,11 +322,16 @@ 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")
+       ; 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
+
+       ; let real_top = if exists2 then top_dir </> ".." else top_dir
 
-       ; return (am_installed, top_dir)
+       ; return (not amInplace, real_top)
        }
   where
     -- get_proto returns a Unix-format path (relying on getBaseDir to do so too)
@@ -428,9 +436,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
@@ -444,7 +449,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
@@ -681,11 +685,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
@@ -696,10 +695,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
@@ -810,7 +805,6 @@ data BuildMessage
   = BuildMsg   !SDoc
   | BuildError !SrcLoc !SDoc
   | EOF
-#endif
 
 showOpt :: Option -> String
 showOpt (FileOption pre f) = pre ++ f
@@ -862,9 +856,14 @@ getBaseDir = do let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.
     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