Commit 50159f6c authored by simonmar's avatar simonmar
Browse files

[project @ 2005-03-21 10:50:22 by simonmar]

Complete the transition of -split-objs into a dynamic flag (looks like I
half-finished it in the last commit).

Also: complete the transition of -tmpdir into a dynamic flag, which
involves some rearrangement of code from SysTools into DynFlags.

Someday, initSysTools should move wholesale into initDynFlags, because
most of the state that it initialises is now part of the DynFlags
structure, and the rest could be moved in easily.
parent cbe4c3a7
...@@ -30,6 +30,7 @@ import MachOp ...@@ -30,6 +30,7 @@ import MachOp
import ForeignCall import ForeignCall
-- Utils -- Utils
import DynFlags ( DynFlags, DynFlag(..), dopt )
import Unique ( getUnique ) import Unique ( getUnique )
import UniqSet import UniqSet
import FiniteMap import FiniteMap
...@@ -37,7 +38,6 @@ import UniqFM ( eltsUFM ) ...@@ -37,7 +38,6 @@ import UniqFM ( eltsUFM )
import FastString import FastString
import Outputable import Outputable
import Constants import Constants
import StaticFlags ( opt_SplitObjs )
-- The rest -- The rest
import Data.List ( intersperse, groupBy ) import Data.List ( intersperse, groupBy )
...@@ -59,16 +59,18 @@ import MONAD_ST ...@@ -59,16 +59,18 @@ import MONAD_ST
-- -------------------------------------------------------------------------- -- --------------------------------------------------------------------------
-- Top level -- Top level
pprCs :: [Cmm] -> SDoc pprCs :: DynFlags -> [Cmm] -> SDoc
pprCs cmms = pprCode CStyle (vcat $ map (\c -> split_marker $$ pprC c) cmms) pprCs dflags cmms
= pprCode CStyle (vcat $ map (\c -> split_marker $$ pprC c) cmms)
writeCs :: Handle -> [Cmm] -> IO () where
writeCs handle cmms = printForUser handle alwaysQualify (pprCs cmms) split_marker
-- ToDo: should be printForC | dopt Opt_SplitObjs dflags = ptext SLIT("__STG_SPLIT_MARKER")
| otherwise = empty
split_marker
| opt_SplitObjs = ptext SLIT("__STG_SPLIT_MARKER") writeCs :: DynFlags -> Handle -> [Cmm] -> IO ()
| otherwise = empty writeCs dflags handle cmms
= printForUser handle alwaysQualify (pprCs dflags cmms)
-- ToDo: should be printForC
-- -------------------------------------------------------------------------- -- --------------------------------------------------------------------------
-- Now do some real work -- Now do some real work
......
...@@ -39,8 +39,8 @@ import MachOp ( wordRep, MachHint(..) ) ...@@ -39,8 +39,8 @@ import MachOp ( wordRep, MachHint(..) )
import StgSyn import StgSyn
import PrelNames ( gHC_PRIM, rOOT_MAIN, mAIN, pREL_TOP_HANDLER ) import PrelNames ( gHC_PRIM, rOOT_MAIN, mAIN, pREL_TOP_HANDLER )
import DynFlags ( DynFlags(..), DynFlag(..) ) import DynFlags ( DynFlags(..), DynFlag(..), dopt )
import StaticFlags ( opt_SplitObjs, opt_SccProfilingOn ) import StaticFlags ( opt_SccProfilingOn )
import HscTypes ( ForeignStubs(..), TypeEnv, typeEnvTyCons ) import HscTypes ( ForeignStubs(..), TypeEnv, typeEnvTyCons )
import CostCentre ( CollectedCCs ) import CostCentre ( CollectedCCs )
...@@ -281,7 +281,7 @@ variable. ...@@ -281,7 +281,7 @@ variable.
\begin{code} \begin{code}
cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> Code cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> Code
cgTopBinding dflags (StgNonRec id rhs, srts) cgTopBinding dflags (StgNonRec id rhs, srts)
= do { id' <- maybeExternaliseId id = do { id' <- maybeExternaliseId dflags id
; mapM_ (mkSRT dflags [id']) srts ; mapM_ (mkSRT dflags [id']) srts
; (id,info) <- cgTopRhs id' rhs ; (id,info) <- cgTopRhs id' rhs
; addBindC id info -- Add the *un-externalised* Id to the envt, ; addBindC id info -- Add the *un-externalised* Id to the envt,
...@@ -290,7 +290,7 @@ cgTopBinding dflags (StgNonRec id rhs, srts) ...@@ -290,7 +290,7 @@ cgTopBinding dflags (StgNonRec id rhs, srts)
cgTopBinding dflags (StgRec pairs, srts) cgTopBinding dflags (StgRec pairs, srts)
= do { let (bndrs, rhss) = unzip pairs = do { let (bndrs, rhss) = unzip pairs
; bndrs' <- mapFCs maybeExternaliseId bndrs ; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs
; let pairs' = zip bndrs' rhss ; let pairs' = zip bndrs' rhss
; mapM_ (mkSRT dflags bndrs') srts ; mapM_ (mkSRT dflags bndrs') srts
; _new_binds <- fixC (\ new_binds -> do ; _new_binds <- fixC (\ new_binds -> do
...@@ -342,9 +342,9 @@ If we're splitting the object, we need to externalise all the top-level names ...@@ -342,9 +342,9 @@ If we're splitting the object, we need to externalise all the top-level names
which refers to this name). which refers to this name).
\begin{code} \begin{code}
maybeExternaliseId :: Id -> FCode Id maybeExternaliseId :: DynFlags -> Id -> FCode Id
maybeExternaliseId id maybeExternaliseId dflags id
| opt_SplitObjs, -- Externalise the name for -split-objs | dopt Opt_SplitObjs dflags, -- Externalise the name for -split-objs
isInternalName name = do { mod <- moduleName isInternalName name = do { mod <- moduleName
; returnFC (setIdName id (externalise mod)) } ; returnFC (setIdName id (externalise mod)) }
| otherwise = returnFC id | otherwise = returnFC id
......
...@@ -152,7 +152,7 @@ outputC dflags filenm flat_absC ...@@ -152,7 +152,7 @@ outputC dflags filenm flat_absC
hPutStr h cc_injects hPutStr h cc_injects
when stub_h_exists $ when stub_h_exists $
hPutStrLn h ("#include \"" ++ (filenameOf (hscStubHOutName dflags)) ++ "\"") hPutStrLn h ("#include \"" ++ (filenameOf (hscStubHOutName dflags)) ++ "\"")
writeCs h flat_absC writeCs dflags h flat_absC
\end{code} \end{code}
......
...@@ -96,7 +96,7 @@ beginMkDependHS dflags = do ...@@ -96,7 +96,7 @@ beginMkDependHS dflags = do
-- open a new temp file in which to stuff the dependency info -- open a new temp file in which to stuff the dependency info
-- as we go along. -- as we go along.
tmp_file <- newTempName "dep" tmp_file <- newTempName dflags "dep"
tmp_hdl <- openFile tmp_file WriteMode tmp_hdl <- openFile tmp_file WriteMode
-- open the makefile -- open the makefile
......
...@@ -410,7 +410,7 @@ genOutputFilenameFunc dflags stop_phase keep_final_output ...@@ -410,7 +410,7 @@ genOutputFilenameFunc dflags stop_phase keep_final_output
| is_last_phase, Just f <- maybe_output_filename = return f | is_last_phase, Just f <- maybe_output_filename = return f
| is_last_phase && keep_final_output = persistent_fn | is_last_phase && keep_final_output = persistent_fn
| keep_this_output = persistent_fn | keep_this_output = persistent_fn
| otherwise = newTempName suffix | otherwise = newTempName dflags suffix
where where
is_last_phase = next_phase `eqPhase` stop_phase is_last_phase = next_phase `eqPhase` stop_phase
...@@ -802,7 +802,7 @@ runPhase Mangle stop dflags _basename _suff input_fn get_output_fn maybe_loc ...@@ -802,7 +802,7 @@ runPhase Mangle stop dflags _basename _suff input_fn get_output_fn maybe_loc
runPhase SplitMangle stop dflags _basename _suff input_fn get_output_fn maybe_loc runPhase SplitMangle stop dflags _basename _suff input_fn get_output_fn maybe_loc
= do -- tmp_pfx is the prefix used for the split .s files = do -- tmp_pfx is the prefix used for the split .s files
-- We also use it as the file to contain the no. of split .s files (sigh) -- We also use it as the file to contain the no. of split .s files (sigh)
split_s_prefix <- SysTools.newTempName "split" split_s_prefix <- SysTools.newTempName dflags "split"
let n_files_fn = split_s_prefix let n_files_fn = split_s_prefix
SysTools.runSplit dflags SysTools.runSplit dflags
......
...@@ -37,6 +37,7 @@ module DynFlags ( ...@@ -37,6 +37,7 @@ module DynFlags (
getOpts, -- (DynFlags -> [a]) -> IO [a] getOpts, -- (DynFlags -> [a]) -> IO [a]
getVerbFlag, getVerbFlag,
updOptLevel, updOptLevel,
setTmpDir,
-- parsing DynFlags -- parsing DynFlags
parseDynamicFlags, parseDynamicFlags,
...@@ -54,7 +55,7 @@ import DriverPhases ( Phase(..), phaseInputExt ) ...@@ -54,7 +55,7 @@ import DriverPhases ( Phase(..), phaseInputExt )
import Config import Config
import CmdLineParser import CmdLineParser
import Panic ( panic, GhcException(..) ) import Panic ( panic, GhcException(..) )
import Util ( notNull, splitLongestPrefix, split ) import Util ( notNull, splitLongestPrefix, split, normalisePath )
import DATA_IOREF ( readIORef ) import DATA_IOREF ( readIORef )
import EXCEPTION ( throwDyn ) import EXCEPTION ( throwDyn )
...@@ -213,7 +214,7 @@ data DynFlags = DynFlags { ...@@ -213,7 +214,7 @@ data DynFlags = DynFlags {
libraryPaths :: [String], libraryPaths :: [String],
frameworkPaths :: [String], -- used on darwin only frameworkPaths :: [String], -- used on darwin only
cmdlineFrameworks :: [String], -- ditto cmdlineFrameworks :: [String], -- ditto
tmpDir :: String, tmpDir :: String, -- no trailing '/'
-- options for particular phases -- options for particular phases
opt_L :: [String], opt_L :: [String],
...@@ -342,7 +343,7 @@ defaultDynFlags = ...@@ -342,7 +343,7 @@ defaultDynFlags =
libraryPaths = [], libraryPaths = [],
frameworkPaths = [], frameworkPaths = [],
cmdlineFrameworks = [], cmdlineFrameworks = [],
tmpDir = [], tmpDir = cDEFAULT_TMPDIR,
opt_L = [], opt_L = [],
opt_P = [], opt_P = [],
...@@ -431,7 +432,6 @@ setObjectSuf f d = d{ objectSuf = f} ...@@ -431,7 +432,6 @@ setObjectSuf f d = d{ objectSuf = f}
setHcSuf f d = d{ hcSuf = f} setHcSuf f d = d{ hcSuf = f}
setHiSuf f d = d{ hiSuf = f} setHiSuf f d = d{ hiSuf = f}
setHiDir f d = d{ hiDir = f} setHiDir f d = d{ hiDir = f}
setTmpDir f d = d{ tmpDir = f}
-- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"] -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"]
-- Config.hs should really use Option. -- Config.hs should really use Option.
...@@ -769,6 +769,10 @@ dynamic_flags = [ ...@@ -769,6 +769,10 @@ dynamic_flags = [
, ( "optdll" , HasArg (upd . addOptdll) ) , ( "optdll" , HasArg (upd . addOptdll) )
, ( "optdep" , HasArg (upd . addOptdep) ) , ( "optdep" , HasArg (upd . addOptdep) )
, ( "split-objs" , NoArg (if can_split
then setDynFlag Opt_SplitObjs
else return ()) )
-------- Linking ---------------------------------------------------- -------- Linking ----------------------------------------------------
, ( "c" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) , ( "c" , NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
, ( "no-link" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) -- Dep. , ( "no-link" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) -- Dep.
...@@ -1118,6 +1122,40 @@ splitPathList s = filter notNull (splitUp s) ...@@ -1118,6 +1122,40 @@ splitPathList s = filter notNull (splitUp s)
dir_markers = ['/', '\\'] dir_markers = ['/', '\\']
#endif #endif
-- -----------------------------------------------------------------------------
-- tmpDir, where we store temporary files.
setTmpDir :: FilePath -> DynFlags -> DynFlags
setTmpDir dir dflags = dflags{ tmpDir = canonicalise dir }
where
#if !defined(mingw32_HOST_OS)
canonicalise p = normalisePath p
#else
-- Canonicalisation of temp path under win32 is a bit more
-- involved: (a) strip trailing slash,
-- (b) normalise slashes
-- (c) just in case, if there is a prefix /cygdrive/x/, change to x:
--
canonicalise path = normalisePath (xltCygdrive (removeTrailingSlash path))
-- if we're operating under cygwin, and TMP/TEMP is of
-- the form "/cygdrive/drive/path", translate this to
-- "drive:/path" (as GHC isn't a cygwin app and doesn't
-- understand /cygdrive paths.)
xltCygdrive path
| "/cygdrive/" `isPrefixOf` path =
case drop (length "/cygdrive/") path of
drive:xs@('/':_) -> drive:':':xs
_ -> path
| otherwise = path
-- strip the trailing backslash (awful, but we only do this once).
removeTrailingSlash path =
case last path of
'/' -> init path
'\\' -> init path
_ -> path
#endif
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- Via-C compilation stuff -- Via-C compilation stuff
...@@ -1228,3 +1266,22 @@ picCCOpts dflags ...@@ -1228,3 +1266,22 @@ picCCOpts dflags
| otherwise | otherwise
= [] = []
#endif #endif
-- -----------------------------------------------------------------------------
-- Splitting
can_split :: Bool
can_split =
#if defined(i386_TARGET_ARCH) \
|| defined(alpha_TARGET_ARCH) \
|| defined(hppa_TARGET_ARCH) \
|| defined(m68k_TARGET_ARCH) \
|| defined(mips_TARGET_ARCH) \
|| defined(powerpc_TARGET_ARCH) \
|| defined(rs6000_TARGET_ARCH) \
|| defined(sparc_TARGET_ARCH)
True
#else
False
#endif
...@@ -58,7 +58,6 @@ module StaticFlags ( ...@@ -58,7 +58,6 @@ module StaticFlags (
opt_IgnoreDotGhci, opt_IgnoreDotGhci,
opt_ErrorSpans, opt_ErrorSpans,
opt_EmitCExternDecls, opt_EmitCExternDecls,
opt_SplitObjs,
opt_GranMacros, opt_GranMacros,
opt_HiVersion, opt_HiVersion,
opt_HistorySize, opt_HistorySize,
...@@ -153,12 +152,6 @@ static_flags = [ ...@@ -153,12 +152,6 @@ static_flags = [
------- Miscellaneous ----------------------------------------------- ------- Miscellaneous -----------------------------------------------
, ( "no-link-chk" , NoArg (return ()) ) -- ignored for backwards compat , ( "no-link-chk" , NoArg (return ()) ) -- ignored for backwards compat
, ( "split-objs" , NoArg (if can_split
then addOpt "-split-objs"
else hPutStrLn stderr
"warning: don't know how to split object files on this architecture"
) )
----- Linker -------------------------------------------------------- ----- Linker --------------------------------------------------------
, ( "static" , PassFlag addOpt ) , ( "static" , PassFlag addOpt )
, ( "dynamic" , NoArg (removeOpt "-static") ) , ( "dynamic" , NoArg (removeOpt "-static") )
...@@ -278,7 +271,6 @@ opt_LiberateCaseThreshold = lookup_def_int "-fliberate-case-threshold" (10::Int) ...@@ -278,7 +271,6 @@ opt_LiberateCaseThreshold = lookup_def_int "-fliberate-case-threshold" (10::Int)
opt_MaxWorkerArgs = lookup_def_int "-fmax-worker-args" (10::Int) opt_MaxWorkerArgs = lookup_def_int "-fmax-worker-args" (10::Int)
opt_EmitCExternDecls = lookUp FSLIT("-femit-extern-decls") opt_EmitCExternDecls = lookUp FSLIT("-femit-extern-decls")
opt_SplitObjs = lookUp FSLIT("-split-objs")
opt_GranMacros = lookUp FSLIT("-fgransim") opt_GranMacros = lookUp FSLIT("-fgransim")
opt_HiVersion = read (cProjectVersionInt ++ cProjectPatchLevel) :: Int opt_HiVersion = read (cProjectVersionInt ++ cProjectPatchLevel) :: Int
opt_HistorySize = lookup_def_int "-fhistory-size" 20 opt_HistorySize = lookup_def_int "-fhistory-size" 20
...@@ -399,24 +391,6 @@ foreign import "setHeapSize" unsafe setHeapSize :: Int -> IO () ...@@ -399,24 +391,6 @@ foreign import "setHeapSize" unsafe setHeapSize :: Int -> IO ()
foreign import "enableTimingStats" unsafe enableTimingStats :: IO () foreign import "enableTimingStats" unsafe enableTimingStats :: IO ()
#endif #endif
-- -----------------------------------------------------------------------------
-- Splitting
can_split :: Bool
can_split =
#if defined(i386_TARGET_ARCH) \
|| defined(alpha_TARGET_ARCH) \
|| defined(hppa_TARGET_ARCH) \
|| defined(m68k_TARGET_ARCH) \
|| defined(mips_TARGET_ARCH) \
|| defined(powerpc_TARGET_ARCH) \
|| defined(rs6000_TARGET_ARCH) \
|| defined(sparc_TARGET_ARCH)
True
#else
False
#endif
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- Ways -- Ways
......
...@@ -48,8 +48,10 @@ import DriverPhases ( isHaskellUserSrcFilename ) ...@@ -48,8 +48,10 @@ import DriverPhases ( isHaskellUserSrcFilename )
import Config import Config
import Outputable import Outputable
import Panic ( GhcException(..) ) import Panic ( GhcException(..) )
import Util ( Suffix, global, notNull, consIORef ) import Util ( Suffix, global, notNull, consIORef,
import DynFlags ( DynFlags(..), DynFlag(..), dopt, Option(..) ) normalisePath, pgmPath, platformPath )
import DynFlags ( DynFlags(..), DynFlag(..), dopt, Option(..),
setTmpDir, defaultDynFlags )
import EXCEPTION ( throwDyn ) import EXCEPTION ( throwDyn )
import DATA_IOREF ( IORef, readIORef, writeIORef ) import DATA_IOREF ( IORef, readIORef, writeIORef )
...@@ -237,32 +239,32 @@ initSysTools minusB_args dflags ...@@ -237,32 +239,32 @@ initSysTools minusB_args dflags
| am_installed = installed_bin cGHC_MANGLER_PGM | am_installed = installed_bin cGHC_MANGLER_PGM
| otherwise = inplace cGHC_MANGLER_DIR_REL cGHC_MANGLER_PGM | otherwise = inplace cGHC_MANGLER_DIR_REL cGHC_MANGLER_PGM
; let dflags0 = defaultDynFlags
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
-- check whether TMPDIR is set in the environment -- check whether TMPDIR is set in the environment
; IO.try (do dir <- getEnv "TMPDIR" -- fails if not set ; e_tmpdir <- IO.try (getEnv "TMPDIR") -- fails if not set
setTmpDir dir
return ()
)
#else #else
-- On Win32, consult GetTempPath() for a temp dir. -- On Win32, consult GetTempPath() for a temp dir.
-- => it first tries TMP, TEMP, then finally the -- => it first tries TMP, TEMP, then finally the
-- Windows directory(!). The directory is in short-path -- Windows directory(!). The directory is in short-path
-- form. -- form.
; IO.try (do ; e_tmpdir <-
IO.try (do
let len = (2048::Int) let len = (2048::Int)
buf <- mallocArray len buf <- mallocArray len
ret <- getTempPath len buf ret <- getTempPath len buf
tdir <- if ret == 0 then do
if ret == 0 then do
-- failed, consult TMPDIR. -- failed, consult TMPDIR.
free buf free buf
getEnv "TMPDIR" getEnv "TMPDIR"
else do else do
s <- peekCString buf s <- peekCString buf
free buf free buf
return s return s)
setTmpDir tdir)
#endif #endif
; let dflags1 = case e_tmpdir of
Left _ -> dflags0
Right d -> setTmpDir d dflags0
-- Check that the package config exists -- Check that the package config exists
; config_exists <- doesFileExist pkgconfig_path ; config_exists <- doesFileExist pkgconfig_path
...@@ -364,7 +366,7 @@ initSysTools minusB_args dflags ...@@ -364,7 +366,7 @@ initSysTools minusB_args dflags
; writeIORef v_Pgm_T touch_path ; writeIORef v_Pgm_T touch_path
; writeIORef v_Pgm_CP cp_path ; writeIORef v_Pgm_CP cp_path
; return dflags{ ; return dflags1{
pgm_L = unlit_path, pgm_L = unlit_path,
pgm_P = cpp_path, pgm_P = cpp_path,
pgm_F = "", pgm_F = "",
...@@ -518,42 +520,9 @@ getUsageMsgPaths = readIORef v_Path_usages ...@@ -518,42 +520,9 @@ getUsageMsgPaths = readIORef v_Path_usages
\begin{code} \begin{code}
GLOBAL_VAR(v_FilesToClean, [], [String] ) GLOBAL_VAR(v_FilesToClean, [], [String] )
GLOBAL_VAR(v_TmpDir, cDEFAULT_TMPDIR, String )
-- v_TmpDir has no closing '/'
\end{code} \end{code}
\begin{code} \begin{code}
setTmpDir dir = writeIORef v_TmpDir (canonicalise dir)
where
#if !defined(mingw32_HOST_OS)
canonicalise p = normalisePath p
#else
-- Canonicalisation of temp path under win32 is a bit more
-- involved: (a) strip trailing slash,
-- (b) normalise slashes
-- (c) just in case, if there is a prefix /cygdrive/x/, change to x:
--
canonicalise path = normalisePath (xltCygdrive (removeTrailingSlash path))
-- if we're operating under cygwin, and TMP/TEMP is of
-- the form "/cygdrive/drive/path", translate this to
-- "drive:/path" (as GHC isn't a cygwin app and doesn't
-- understand /cygdrive paths.)
xltCygdrive path
| "/cygdrive/" `isPrefixOf` path =
case drop (length "/cygdrive/") path of
drive:xs@('/':_) -> drive:':':xs
_ -> path
| otherwise = path
-- strip the trailing backslash (awful, but we only do this once).
removeTrailingSlash path =
case last path of
'/' -> init path
'\\' -> init path
_ -> path
#endif
cleanTempFiles :: DynFlags -> IO () cleanTempFiles :: DynFlags -> IO ()
cleanTempFiles dflags cleanTempFiles dflags
= do fs <- readIORef v_FilesToClean = do fs <- readIORef v_FilesToClean
...@@ -569,10 +538,9 @@ cleanTempFilesExcept dflags dont_delete ...@@ -569,10 +538,9 @@ cleanTempFilesExcept dflags dont_delete
-- find a temporary name that doesn't already exist. -- find a temporary name that doesn't already exist.
newTempName :: Suffix -> IO FilePath newTempName :: DynFlags -> Suffix -> IO FilePath
newTempName extn newTempName DynFlags{tmpDir=tmp_dir} extn
= do x <- getProcessID = do x <- getProcessID
tmp_dir <- readIORef v_TmpDir
findTempName tmp_dir x findTempName tmp_dir x
where where
findTempName tmp_dir x findTempName tmp_dir x
...@@ -669,54 +637,6 @@ traceCmd dflags phase_name cmd_line action ...@@ -669,54 +637,6 @@ traceCmd dflags phase_name cmd_line action
; throwDyn (PhaseFailed phase_name (ExitFailure 1)) } ; throwDyn (PhaseFailed phase_name (ExitFailure 1)) }
\end{code} \end{code}
%************************************************************************
%* *
\subsection{Path names}
%* *
%************************************************************************
We maintain path names in Unix form ('/'-separated) right until
the last moment. On Windows we dos-ify them just before passing them
to the Windows command.
The alternative, of using '/' consistently on Unix and '\' on Windows,
proved quite awkward. There were a lot more calls to platformPath,
and even on Windows we might invoke a unix-like utility (eg 'sh'), which
interpreted a command line 'foo\baz' as 'foobaz'.
\begin{code}
-----------------------------------------------------------------------------
-- Convert filepath into platform / MSDOS form.
normalisePath :: String -> String
-- Just changes '\' to '/'
pgmPath :: String -- Directory string in Unix format
-> String -- Program name with no directory separators
-- (e.g. copy /y)
-> String -- Program invocation string in native format
#if defined(mingw32_HOST_OS)
--------------------- Windows version ------------------
normalisePath xs = subst '\\' '/' xs
platformPath p = subst '/' '\\' p
pgmPath dir pgm = platformPath dir ++ '\\' : pgm
subst a b ls = map (\ x -> if x == a then b else x) ls
#else
--------------------- Non-Windows version --------------
normalisePath xs = xs
pgmPath dir pgm = dir ++ '/' : pgm
platformPath stuff = stuff
--------------------------------------------------------
#endif
\end{code}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
Path name construction Path name construction
......
...@@ -37,7 +37,7 @@ import List ( groupBy, sortBy ) ...@@ -37,7 +37,7 @@ import List ( groupBy, sortBy )
import CLabel ( pprCLabel ) import CLabel ( pprCLabel )
import ErrUtils ( dumpIfSet_dyn ) import ErrUtils ( dumpIfSet_dyn )
import DynFlags ( DynFlags, DynFlag(..), dopt ) import DynFlags ( DynFlags, DynFlag(..), dopt )
import StaticFlags ( opt_Static, opt_SplitObjs, opt_PIC ) import StaticFlags ( opt_Static, opt_PIC )
import Digraph import Digraph
import qualified Pretty import qualified Pretty
...@@ -133,8 +133,8 @@ nativeCodeGen dflags cmms us ...@@ -133,8 +133,8 @@ nativeCodeGen dflags cmms us
where where