-----------------------------------------------------------------------------
--- Access to system tools: gcc, cp, rm etc
+-- $Id: SysTools.lhs,v 1.48 2001/08/13 15:49:38 simonmar Exp $
+--
+-- (c) The University of Glasgow 2001
--
--- (c) The University of Glasgow 2000
+-- Access to system tools: gcc, cp, rm etc
--
-----------------------------------------------------------------------------
-- Command-line override
setDryRun,
- packageConfigPath, -- IO String
- -- Where package.conf is
+ getTopDir, -- IO String -- The value of $libdir
+ getPackageConfigPath, -- IO String -- Where package.conf is
-- Interface to system tools
- runUnlit, runCpp, runCc, -- [String] -> IO ()
- runMangle, runSplit, -- [String] -> IO ()
- runAs, runLink, -- [String] -> IO ()
+ runUnlit, runCpp, runCc, -- [Option] -> IO ()
+ runMangle, runSplit, -- [Option] -> IO ()
+ runAs, runLink, -- [Option] -> IO ()
runMkDLL,
touch, -- String -> String -> IO ()
-- System interface
getProcessID, -- IO Int
- system, -- String -> IO Int
+ system, -- String -> IO ExitCode
-- Misc
showGhcUsage, -- IO () Shows usage message and exits
- getSysMan -- IO String Parallel system only
+ getSysMan, -- IO String Parallel system only
+
+ Option(..)
) where
import Directory ( doesFileExist, removeFile )
import IOExts ( IORef, readIORef, writeIORef )
import Monad ( when, unless )
-import System ( system, ExitCode(..), exitWith, getEnv )
+import System ( ExitCode(..), exitWith, getEnv, system )
import CString
import Int
import Addr
#include "../includes/config.h"
-#if !defined(mingw32_TARGET_OS)
+#ifndef mingw32_TARGET_OS
import qualified Posix
#else
import List ( isPrefixOf )
import MarshalArray
+import SystemExts ( rawSystem )
#endif
#include "HsVersions.h"
GLOBAL_VAR(v_Path_package_config, error "path_package_config", String)
GLOBAL_VAR(v_Path_usage, error "ghc_usage.txt", String)
+GLOBAL_VAR(v_TopDir, error "TopDir", String) -- -B<dir>
+
-- Parallel system only
GLOBAL_VAR(v_Pgm_sysman, error "pgm_sysman", String) -- system manager
+
+-- ways to get at some of these variables from outside this module
+getPackageConfigPath = readIORef v_Path_package_config
+getTopDir = readIORef v_TopDir
\end{code}
\begin{code}
initSysTools :: [String] -- Command-line arguments starting "-B"
- -> IO String -- Set all the mutable variables above, holding
+ -> IO () -- Set all the mutable variables above, holding
-- (a) the system programs
-- (b) the package-config file
-- (c) the GHC usage message
- -- Return TopDir
initSysTools minusB_args
- = do { (am_installed, top_dir) <- getTopDir minusB_args
+ = do { (am_installed, top_dir) <- findTopDir minusB_args
+ ; writeIORef v_TopDir top_dir
-- top_dir
-- for "installed" this is the root of GHC's support files
-- for "in-place" it is the root of the build tree
-- pick up whatever happens to be lying around in the path,
-- possibly including those from a cygwin install on the target,
-- which is exactly what we're trying to avoid.
- ; let gcc_path | am_installed = installed_bin ("gcc -B\"" ++ installed "gcc-lib\\\"")
+ ; let gcc_path | am_installed = installed_bin ("gcc -B\"" ++ installed "gcc-lib/\"")
| otherwise = cGCC
- -- The trailing "\\" is absolutely essential; gcc seems
+ -- The trailing "/" is absolutely essential; gcc seems
-- to construct file names simply by concatenating to this
- -- -B path with no extra slash.
- -- We use "\\" rather than "/" because gcc_path is in NATIVE format
+ -- -B path with no extra slash
+ -- We use "/" rather than "\\" because otherwise "\\\" is mangled
+ -- later on; although gcc_path is in NATIVE format, gcc can cope
-- (see comments with declarations of global variables)
--
-- The quotes round the -B argument are in case TopDir has spaces in it
-- 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
- ; let split_path = perl_path ++ " " ++ split_script
- mangle_path = perl_path ++ " " ++ mangle_script
+ ; let split_path = perl_path ++ " \"" ++ split_script ++ "\""
+ mangle_path = perl_path ++ " \"" ++ mangle_script ++ "\""
; let mkdll_path = cMKDLL
#else
; writeIORef v_Pgm_T touch_path
; writeIORef v_Pgm_CP cp_path
- ; return top_dir
+ ; return ()
}
\end{code}
--
-- This is very gruesome indeed
-getTopDir :: [String]
+findTopDir :: [String]
-> IO (Bool, -- True <=> am installed, False <=> in-place
String) -- TopDir (in Unix format '/' separated)
-getTopDir minusbs
+findTopDir minusbs
= 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.
%************************************************************************
%* *
+\subsection{Command-line options}
+n%* *
+%************************************************************************
+
+When invoking external tools as part of the compilation pipeline, we
+pass these a sequence of options on the command-line. Rather than
+just using a list of Strings, we use a type that allows us to distinguish
+between filepaths and 'other stuff'. [The reason being, of course, that
+this type gives us a handle on transforming filenames, and filenames only,
+to whatever format they're expected to be on a particular platform.]
+
+
+\begin{code}
+data Option
+ = FileOption String
+ | Option String
+
+showOptions :: [Option] -> String
+showOptions ls = unwords (map (quote.showOpt) ls)
+ where
+ showOpt (FileOption f) = dosifyPath f
+ showOpt (Option s) = s
+
+#if defined(mingw32_TARGET_OS)
+ quote "" = ""
+ quote s = "\"" ++ s ++ "\""
+#else
+ quote = id
+#endif
+
+\end{code}
+
+
+%************************************************************************
+%* *
\subsection{Running an external program}
n%* *
%************************************************************************
\begin{code}
-runUnlit :: [String] -> IO ()
+runUnlit :: [Option] -> IO ()
runUnlit args = do p <- readIORef v_Pgm_L
runSomething "Literate pre-processor" p args
-runCpp :: [String] -> IO ()
+runCpp :: [Option] -> IO ()
runCpp args = do p <- readIORef v_Pgm_P
runSomething "C pre-processor" p args
-runCc :: [String] -> IO ()
+runCc :: [Option] -> IO ()
runCc args = do p <- readIORef v_Pgm_c
runSomething "C Compiler" p args
-runMangle :: [String] -> IO ()
+runMangle :: [Option] -> IO ()
runMangle args = do p <- readIORef v_Pgm_m
runSomething "Mangler" p args
-runSplit :: [String] -> IO ()
+runSplit :: [Option] -> IO ()
runSplit args = do p <- readIORef v_Pgm_s
runSomething "Splitter" p args
-runAs :: [String] -> IO ()
+runAs :: [Option] -> IO ()
runAs args = do p <- readIORef v_Pgm_a
runSomething "Assembler" p args
-runLink :: [String] -> IO ()
+runLink :: [Option] -> IO ()
runLink args = do p <- readIORef v_Pgm_l
runSomething "Linker" p args
-runMkDLL :: [String] -> IO ()
+runMkDLL :: [Option] -> IO ()
runMkDLL args = do p <- readIORef v_Pgm_MkDLL
runSomething "Make DLL" p args
touch :: String -> String -> IO ()
touch purpose arg = do p <- readIORef v_Pgm_T
- runSomething purpose p [arg]
+ runSomething purpose p [FileOption arg]
copy :: String -> String -> String -> IO ()
copy purpose from to = do
dump "" = return ()
dump ('$':'$':s) = hPutStr stderr progName >> dump s
dump (c:s) = hPutChar stderr c >> dump s
-
-packageConfigPath = readIORef v_Path_package_config
\end{code}
runSomething :: String -- For -v message
-> String -- Command name (possibly a full path)
-- assumed already dos-ified
- -> [String] -- Arguments
+ -> [Option] -- Arguments
-- runSomething will dos-ify them
-> IO ()
runSomething phase_name pgm args
= traceCmd phase_name cmd_line $
- do { exit_code <- system cmd_line
+ do {
+#ifndef mingw32_TARGET_OS
+ exit_code <- system cmd_line
+#else
+ exit_code <- rawSystem cmd_line
+#endif
; if exit_code /= ExitSuccess
then throwDyn (PhaseFailed phase_name exit_code)
else return ()
}
where
- cmd_line = unwords (pgm : dosifyPaths (map quote args))
+ cmd_line = pgm ++ ' ':showOptions args -- unwords (pgm : dosifyPaths (map quote args))
-- The pgm is already in native format (appropriate dir separators)
#if defined(mingw32_TARGET_OS)
quote "" = ""
#else
--------------------- Unix version ---------------------
-dosifyPaths ps = ps
-unDosifyPath xs = xs
-pgmPath dir pgm = dir ++ '/' : pgm
+dosifyPaths ps = ps
+unDosifyPath xs = xs
+pgmPath dir pgm = dir ++ '/' : pgm
+dosifyPath stuff = stuff
--------------------------------------------------------
#endif