[project @ 2002-02-16 19:39:51 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 f8818ba..cb4a6e7 100644 (file)
--- a/ghc/compiler/main/SysTools.lhs
+++ b/ghc/compiler/main/SysTools.lhs
@@ -79,23 +79,17 @@ import qualified Posix
 #else
 import List            ( isPrefixOf )
 import MarshalArray
+import Foreign
 #endif
 
--- This is a kludge for bootstrapping with 4.08.X.  Given that
--- all distributed compilers >= 5.0 will be compiled with themselves.
--- I don't think this kludge is a problem.  And we have to start
--- building with >= 5.0 on Win32 anyway.
 #if __GLASGOW_HASKELL__ > 408
--- 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
+# if __GLASGOW_HASKELL__ >= 503
 import GHC.IOBase
-#else
-import PrelIOBase -- this can be removed when SystemExts is used
-#endif
-import CError     ( throwErrnoIfMinus1 ) -- as can this
--- import SystemExts       ( rawSystem )
+# else
+# endif
+# ifdef mingw32_TARGET_OS
+import SystemExts       ( rawSystem )
+# endif
 #else
 import System          ( system )
 #endif
@@ -286,11 +280,11 @@ initSysTools minusB_args
                tdir <-
                  if ret == 0 then do
                      -- failed, consult TEMP.
-                    destructArray len buf
+                    free buf
                     getEnv "TMP"
                   else do
                     s <- peekCString buf
-                    destructArray len buf
+                    free buf
                     return s
                let
                  -- strip the trailing backslash (awful, but 
@@ -410,7 +404,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}
 
@@ -842,37 +836,32 @@ getExecDir :: IO (Maybe String)
 getExecDir = do let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.
                buf <- mallocArray len
                ret <- getModuleFileName nullAddr buf len
-               if ret == 0 then destructArray len buf >> return Nothing
+               if ret == 0 then free buf >> return Nothing
                            else do s <- peekCString buf
-                                   destructArray len buf
+                                   free buf
                                    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
-    status <- throwErrnoIfMinus1 "rawSystem" (primRawSystem s)
-    case status of
-        0  -> return ExitSuccess
-        n  -> return (ExitFailure n)
-
-foreign import ccall "rawSystemCmd" unsafe primRawSystem :: CString -> IO Int
-#else
-rawSystem = System.system
+rawSystem cmd = system cmd
+ -- mingw only: if you try to build a stage2 compiler with a stage1
+ -- that has been bootstrapped with 4.08 (or earlier), this will run
+ -- into problems with limits on command-line lengths with the std.
+ -- Win32 command interpreters. So don't this - use 5.00 or later
+ -- to compile up the GHC sources.
 #endif