[project @ 2002-02-14 07:55:47 by sof]

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

diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs
index aa13060..066ae67 100644 (file)
--- a/ghc/compiler/main/SysTools.lhs
+++ b/ghc/compiler/main/SysTools.lhs
@@ -54,7 +54,7 @@ import DriverUtil
 import Config
 import Outputable
 import Panic           ( progName, GhcException(..) )
-import Util            ( global )
+import Util            ( global, dropList )
 import CmdLineOpts     ( dynFlag, verbosity )
 
 import Exception       ( throwDyn )
@@ -89,10 +89,16 @@ import MarshalArray
 -- use the line below when we can be sure of compiling with GHC >=
 -- 5.02, and remove the implementation of rawSystem at the end of this
 -- file
+# if __GLASGOW_HASKELL__ >= 503
+import GHC.IOBase
+# else
 import PrelIOBase -- this can be removed when SystemExts is used
-import CError     ( throwErrnoIfMinus1 ) -- as can this
--- import SystemExts       ( rawSystem )
+# endif
+# ifdef mingw32_TARGET_OS
+import SystemExts       ( rawSystem )
+# endif
 #else
+import CError           ( throwErrnoIfMinus1 ) -- as can this
 import System          ( system )
 #endif
 
@@ -141,9 +147,9 @@ Config.hs contains two sorts of things
   etc          They do *not* include paths
                                
 
-  cUNLIT_DIR   The *path* to the directory containing unlit, split etc
-  cSPLIT_DIR   *relative* to the root of the build tree,
-               for use when running *in-place* in a build tree (only)
+  cUNLIT_DIR_REL   The *path* to the directory containing unlit, split etc
+  cSPLIT_DIR_REL   *relative* to the root of the build tree,
+                  for use when running *in-place* in a build tree (only)
                
 
 
@@ -238,30 +244,31 @@ initSysTools minusB_args
        ; let installed, installed_bin :: FilePath -> FilePath
               installed_bin pgm   =  pgmPath top_dir pgm
              installed     file  =  pgmPath top_dir file
-             inplace dir   pgm   =  pgmPath (top_dir `slash` dir) pgm
+             inplace dir   pgm   =  pgmPath (top_dir `slash` 
+                                               cPROJECT_DIR `slash` dir) pgm
 
        ; let pkgconfig_path
                | am_installed = installed "package.conf"
-               | otherwise    = inplace cGHC_DRIVER_DIR "package.conf.inplace"
+               | otherwise    = inplace cGHC_DRIVER_DIR_REL "package.conf.inplace"
 
              ghc_usage_msg_path
                | am_installed = installed "ghc-usage.txt"
-               | otherwise    = inplace cGHC_DRIVER_DIR "ghc-usage.txt"
+               | otherwise    = inplace cGHC_DRIVER_DIR_REL "ghc-usage.txt"
 
                -- For all systems, unlit, split, mangle are GHC utilities
                -- architecture-specific stuff is done when building Config.hs
              unlit_path
-               | am_installed = installed_bin cGHC_UNLIT
-               | otherwise    = inplace cGHC_UNLIT_DIR cGHC_UNLIT
+               | am_installed = installed_bin cGHC_UNLIT_PGM
+               | otherwise    = inplace cGHC_UNLIT_DIR_REL cGHC_UNLIT_PGM
 
                -- split and mangle are Perl scripts
              split_script
-               | am_installed = installed_bin cGHC_SPLIT
-               | otherwise    = inplace cGHC_SPLIT_DIR cGHC_SPLIT
+               | am_installed = installed_bin cGHC_SPLIT_PGM
+               | otherwise    = inplace cGHC_SPLIT_DIR_REL cGHC_SPLIT_PGM
 
              mangle_script
-               | am_installed = installed_bin cGHC_MANGLER
-               | otherwise    = inplace cGHC_MANGLER_DIR cGHC_MANGLER
+               | am_installed = installed_bin cGHC_MANGLER_PGM
+               | otherwise    = inplace cGHC_MANGLER_DIR_REL cGHC_MANGLER_PGM
 
 #ifndef mingw32_TARGET_OS
        -- check whether TMPDIR is set in the environment
@@ -334,8 +341,8 @@ initSysTools minusB_args
                        | otherwise    = cGHC_PERL
 
        -- 'touch' is a GHC util for Windows, and similarly unlit, mangle
-       ; let touch_path  | am_installed = installed_bin cGHC_TOUCHY
-                         | otherwise    = inplace cGHC_TOUCHY_DIR cGHC_TOUCHY
+       ; let touch_path  | am_installed = installed_bin cGHC_TOUCHY_PGM
+                         | otherwise    = inplace cGHC_TOUCHY_DIR_REL cGHC_TOUCHY_PGM
 
        -- On Win32 we don't want to rely on #!/bin/perl, so we prepend 
        -- a call to Perl to get the invocation of split and mangle
@@ -349,7 +356,7 @@ initSysTools minusB_args
        -- in the same place whether we are running "in-place" or "installed"
        -- That place is wherever the build-time configure script found them.
        ; let   gcc_path   = cGCC
-               touch_path = cGHC_TOUCHY
+               touch_path = "touch"
                mkdll_path = panic "Can't build DLLs on a non-Win32 system"
 
        -- On Unix, scripts are invoked using the '#!' method.  Binary
@@ -405,7 +412,7 @@ initSysTools minusB_args
        }
 
 #if defined(mingw32_TARGET_OS)
-foreign import stdcall "GetTempPathA" getTempPath :: Int -> CString -> IO Int32
+foreign import stdcall "GetTempPathA" unsafe getTempPath :: Int -> CString -> IO Int32
 #endif
 \end{code}
 
@@ -843,20 +850,20 @@ getExecDir = do let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.
                                    return (Just (reverse (dropList "/bin/ghc.exe" (reverse (unDosifyPath s)))))
 
 
-foreign import stdcall "GetModuleFileNameA" getModuleFileName :: Addr -> CString -> Int -> IO Int32
+foreign import stdcall "GetModuleFileNameA" unsafe getModuleFileName :: Addr -> CString -> Int -> IO Int32
 #else
 getExecDir :: IO (Maybe String) = do return Nothing
 #endif
 
 #ifdef mingw32_TARGET_OS
-foreign import "_getpid" getProcessID :: IO Int -- relies on Int == Int32 on Windows
+foreign import "_getpid" unsafe getProcessID :: IO Int -- relies on Int == Int32 on Windows
 #else
 getProcessID :: IO Int
 getProcessID = Posix.getProcessID
 #endif
 
+#if defined(mingw32_TARGET_OS) && (__GLASGOW_HASKELL__ <= 408)
 rawSystem :: String -> IO ExitCode
-#if __GLASGOW_HASKELL__ > 408
 rawSystem "" = ioException (IOError Nothing InvalidArgument "rawSystem" "null command" Nothing)
 rawSystem cmd =
   withCString cmd $ \s -> do
@@ -866,8 +873,6 @@ rawSystem cmd =
         n  -> return (ExitFailure n)
 
 foreign import ccall "rawSystemCmd" unsafe primRawSystem :: CString -> IO Int
-#else
-rawSystem = System.system
 #endif