X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FSysTools.lhs;h=e098dd9eabce8cf301e895694ebe4014d38f95b5;hb=2ebe8addfaae2bc65e6b87ad369928b02053014f;hp=a76cb53b5d23b2b30b5ea3c3d7da541cba52668b;hpb=9bbcd77cf9b66940058dbea1827db594e8ff6d7f;p=ghc-hetmet.git diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index a76cb53..e098dd9 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -22,6 +22,7 @@ module SysTools ( copy, copyWithHeader, normalisePath, -- FilePath -> FilePath + getExtraViaCOpts, -- Temporary-file management setTmpDir, @@ -57,11 +58,7 @@ import Data.Maybe import Data.List #ifndef mingw32_HOST_OS -#if __GLASGOW_HASKELL__ > 504 import qualified System.Posix.Internals -#else -import qualified Posix -#endif #else /* Must be Win32 */ import Foreign import CString ( CString, peekCString ) @@ -540,6 +537,10 @@ copyWithHeader dflags purpose maybe_header from to = do hPutStr h ls hClose h +getExtraViaCOpts :: DynFlags -> IO [String] +getExtraViaCOpts dflags = do + f <- readFile (topDir dflags `joinFileName` "extra-gcc-opts") + return (words f) \end{code} %************************************************************************ @@ -583,7 +584,8 @@ newTempName dflags extn = do d <- getTempDir dflags x <- getProcessID findTempName (d ++ "/ghc" ++ show x ++ "_") 0 - where + where + findTempName :: FilePath -> Integer -> IO FilePath findTempName prefix x = do let filename = (prefix ++ show x) `joinFileExt` extn b <- doesFileExist filename @@ -600,6 +602,8 @@ getTempDir dflags@(DynFlags{tmpDir=tmp_dir}) Nothing -> do x <- getProcessID let prefix = tmp_dir ++ "/ghc" ++ show x ++ "_" + let + mkTempDir :: Integer -> IO FilePath mkTempDir x = let dirname = prefix ++ show x in do createDirectory dirname @@ -723,7 +727,11 @@ builderMainLoop dflags filter_fn pgm real_args mb_env = do hSetBuffering hStdErr LineBuffering forkIO (readerProc chan hStdOut filter_fn) forkIO (readerProc chan hStdErr filter_fn) - rc <- loop chan hProcess 2 1 ExitSuccess + -- we don't want to finish until 2 streams have been completed + -- (stdout and stderr) + -- nor until 1 exit code has been retrieved. + rc <- loop chan hProcess (2::Integer) (1::Integer) ExitSuccess + -- after that, we're done here. hClose hStdIn hClose hStdOut hClose hStdErr @@ -877,12 +885,9 @@ getBaseDir = return Nothing #ifdef mingw32_HOST_OS foreign import ccall unsafe "_getpid" getProcessID :: IO Int -- relies on Int == Int32 on Windows -#elif __GLASGOW_HASKELL__ > 504 -getProcessID :: IO Int -getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral #else getProcessID :: IO Int -getProcessID = Posix.getProcessID +getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral #endif -- Divvy up text stream into lines, taking platform dependent