Misc minor changes to integrate GHC a little bit better on Win32 platforms.
Specifically, the commit does the following (assuming you've configured
fptools/ with the option --enable-minimal-unix-deps on a mingw platform):
* when GHC uses System.system, it expects an MSDOS command processor to
interpret the command. This implies that 'normal' UNIX shell utils will
no longer be used, but substituted with MSDOS equivalents.
* the GHC backend relies on gcc and perl to handle .s/.hc/.o/.a files. GHC
will now assume that these all live in one 'tool directory', making it
easier to bundle these backend tools with GHC.
The upshot of these changes is that it is now possible for the user not to
have to install cygwin prior to installing GHC (as the upcoming ghc-win32
binary release will prove).
# -----------------------------------------------------------------------------
-# $Id: Makefile,v 1.154 2001/04/13 13:37:24 panne Exp $
+# $Id: Makefile,v 1.155 2001/05/28 03:31:19 sof Exp $
TOP = ..
include $(TOP)/mk/boilerplate.mk
@echo "cGHC_SPLIT = \"$(GHC_SPLIT)\"" >> $(CONFIG_HS)
@echo "cGHC_SYSMAN = \"$(GHC_SYSMAN)\"" >> $(CONFIG_HS)
@echo "cEnableWin32DLLs = \"$(EnableWin32DLLs)\"" >> $(CONFIG_HS)
+ifeq "$(TARGETPLATFORM) and $(MinimalUnixDeps)" "i386-unknown-mingw32 and YES"
+ @echo "cCP = \"copy /y\"" >> $(CONFIG_HS)
+ @echo "cRM = \"del /F /Q\"" >> $(CONFIG_HS)
+ @echo "cTOUCH = \"$(GHC_TOUCHY)\"" >> $(CONFIG_HS)
+else
@echo "cCP = \"$(CP)\"" >> $(CONFIG_HS)
@echo "cRM = \"$(RM)\"" >> $(CONFIG_HS)
+ @echo "cTOUCH = \"touch\"" >> $(CONFIG_HS)
+endif
@echo "cCONTEXT_DIFF = \"$(CONTEXT_DIFF)\"" >> $(CONFIG_HS)
@echo "cHaveLibGmp = \"$(HaveLibGmp)\"" >> $(CONFIG_HS)
@echo "cUSER_WAY_NAMES = \"$(USER_WAY_NAMES)\"" >> $(CONFIG_HS)
@echo "cUSER_WAY_OPTS = \"$(USER_WAY_OPTS)\"" >> $(CONFIG_HS)
@echo "cDEFAULT_TMPDIR = \"$(DEFAULT_TMPDIR)\"" >> $(CONFIG_HS)
+ifeq "$(TARGETPLATFORM) and $(MinimalUnixDeps)" "i386-unknown-mingw32 and YES"
+ @echo "cRAWCPP = \"$(subst -mwin32,,$(RAWCPP))\"" >> $(CONFIG_HS)
+else
@echo "cRAWCPP = \"$(RAWCPP)\"" >> $(CONFIG_HS)
+endif
@echo done.
CLEAN_FILES += $(CONFIG_HS)
endif
endif
+# Enable code that assumes a MSDOSish subshell. See mk/config.mk.in
+# for explanatory comment as to what this does.
+ifeq "$(MinimalUnixDeps)" "YES"
+SRC_HC_OPTS += -DMINIMAL_UNIX_DEPS
+endif
+
HS_SRCS := $(foreach dir,$(DIRS),$(wildcard $(dir)/*.lhs) $(wildcard $(dir)/*.hs))
HS_SRCS := $(filter-out rename/ParseIface.hs parser/Parser.hs main/ParsePkgConf.hs $(CONFIG_HS), $(HS_SRCS))
HS_SRCS += $(CONFIG_HS)
echo '#!/bin/sh' >>$@
echo exec $(FPTOOLS_TOP_ABS_UNIX)/ghc/compiler/$(HS_PROG) -B$(FPTOOLS_TOP_ABS) '"$$@"' >>$@
chmod 755 $@
+ifeq "$(TARGETPLATFORM) and $(MinimalUnixDeps)" "i386-unknown-mingw32 and YES"
+ @$(RM) $@.bat
+ echo "@"$(subst /,\\,$(FPTOOLS_TOP_ABS)/ghc/compiler/$(HS_PROG)) "-B$(FPTOOLS_TOP_ABS) %*" >$@.bat
+ chmod 755 $@.bat
+endif
CLEAN_FILES += ghc-inplace
{-# OPTIONS -#include "hschooks.h" #-}
-----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.54 2001/05/24 15:10:19 dsyme Exp $
+-- $Id: DriverFlags.hs,v 1.55 2001/05/28 03:31:19 sof Exp $
--
-- Driver flags
--
= do n_regs <- dynFlag stolen_x86_regs
sta <- readIORef v_Static
return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "",
- if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin -mwin32" else "" ],
+ if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else "" ],
[ "-fno-defer-pop", "-fomit-frame-pointer",
"-DSTOLEN_X86_REGS="++show n_regs ]
)
-----------------------------------------------------------------------------
--- $Id: DriverMkDepend.hs,v 1.10 2001/04/26 14:33:44 simonmar Exp $
+-- $Id: DriverMkDepend.hs,v 1.11 2001/05/28 03:31:19 sof Exp $
--
-- GHC Driver
--
GLOBAL_VAR(v_Dep_makefile, "Makefile", String);
GLOBAL_VAR(v_Dep_include_prelude, False, Bool);
GLOBAL_VAR(v_Dep_ignore_dirs, [], [String]);
+GLOBAL_VAR(v_Dep_exclude_mods, [], [String]);
GLOBAL_VAR(v_Dep_suffixes, [], [String]);
GLOBAL_VAR(v_Dep_warnings, True, Bool);
( "-include-prelude", NoArg (writeIORef v_Dep_include_prelude True) ),
( "X", Prefix (addToDirList v_Dep_ignore_dirs) ),
( "-exclude-directory=", Prefix (addToDirList v_Dep_ignore_dirs) )
+-- ( "-exclude-module=", Prefix (add v_Dep_exclude_mods) )
+-- ( "x", Prefix (add v_Dep_exclude_mods) )
+
]
beginMkDependHS :: IO ()
-- create a backup of the original makefile
when (isJust makefile_hdl) $
runSomething ("Backing up " ++ makefile)
- (unwords [ "cp", makefile, makefile++".bak" ])
+ (unwords [ cCP, dosifyPath makefile, dosifyPath $ makefile++".bak" ])
-- copy the new makefile in place
runSomething "Installing new makefile"
- (unwords [ "cp", tmp_file, makefile ])
+ (unwords [ cCP, dosifyPath tmp_file, dosifyPath makefile ])
findDependency :: Bool -> FilePath -> ModuleName -> IO (Maybe (String, Bool))
findDependency is_source src imp = do
dir_contents <- readIORef v_Dep_dir_contents
ignore_dirs <- readIORef v_Dep_ignore_dirs
+ excl_mods <- readIORef v_Dep_exclude_mods
hisuf <- readIORef v_Hi_suf
let
dep = head present
-- in
- search dir_contents
+ if imp_mod `elem` excl_mods then
+ return Nothing
+ else
+ search dir_contents
-----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.70 2001/05/25 12:09:43 simonpj Exp $
+-- $Id: DriverPipeline.hs,v 1.71 2001/05/28 03:31:19 sof Exp $
--
-- GHC Driver
--
= do unlit <- readIORef v_Pgm_L
unlit_flags <- getOpts opt_L
runSomething "Literate pre-processor"
- ("echo '# 1 \"" ++input_fn++"\"' > "++output_fn++" && "
- ++ unlit ++ ' ':input_fn ++ " - >> " ++ output_fn)
+ (unlit ++ unwords unlit_flags ++
+ " -h " ++ input_fn ++
+ ' ':input_fn ++
+ ' ':output_fn)
return True
-------------------------------------------------------------------------------
do_cpp <- dynFlag cppFlag
if do_cpp
then do
- cpp <- readIORef v_Pgm_P
+ cpp <- readIORef v_Pgm_P >>= prependToolDir
hscpp_opts <- getOpts opt_P
hs_src_cpp_opts <- readIORef v_Hs_source_cpp_opts
runSomething "C pre-processor"
(unwords
- (["echo '{-# LINE 1 \"" ++ input_fn ++ "\" #-}'", ">", output_fn, "&&",
- cpp, verb]
+ ([cpp, verb]
++ include_paths
++ hs_src_cpp_opts
++ hscpp_opts
++ md_c_flags
- ++ [ "-x", "c", input_fn, ">>", output_fn ]
+ ++ [ "-x", "c", input_fn, "-o", output_fn ]
))
+ -- ToDo: switch away from using 'echo' alltogether (but need
+ -- a faster alternative than what's done below).
+#if defined(mingw32_TARGET_OS) && defined(MINIMAL_UNIX_DEPS)
+ else (do
+ h <- openFile output_fn WriteMode
+ hPutStrLn h ("{-# LINE 1 \"" ++ input_fn ++ "\" #-}")
+ ls <- readFile input_fn -- inefficient, but it'll do for now.
+ -- ToDo: speed up via slurping.
+ hPutStrLn h ls
+ hClose h) `catchAllIO`
+ (\_ -> throwDyn (PhaseFailed "Ineffective C pre-processor" (ExitFailure 1)))
+#else
else do
runSomething "Ineffective C pre-processor"
("echo '{-# LINE 1 \"" ++ input_fn ++ "\" #-}' > "
++ output_fn ++ " && cat " ++ input_fn
++ " >> " ++ output_fn)
+#endif
return True
-----------------------------------------------------------------------------
HscNoRecomp pcs details iface ->
do {
- runSomething "Touching object file" ("touch " ++ o_file);
+#if defined(mingw32_TARGET_OS) && defined(MINIMAL_UNIX_DEPS)
+ touch <- readIORef v_Pgm_T;
+ runSomething "Touching object file" (unwords [dosifyPath touch, dosifyPath o_file]);
+#else
+ runSomething "Touching object file" (cTOUCH ++ o_file);
+#endif
return False;
};
run_phase cc_phase basename suff input_fn output_fn
| cc_phase == Cc || cc_phase == HCc
- = do cc <- readIORef v_Pgm_c
+ = do cc <- readIORef v_Pgm_c >>= prependToolDir >>= appendInstallDir
cc_opts <- (getOpts opt_c)
cmdline_include_dirs <- readIORef v_Include_paths
| otherwise = [ ]
excessPrecision <- readIORef v_Excess_precision
-
runSomething "C Compiler"
(unwords ([ cc, "-x", "c", input_fn, "-o", output_fn ]
++ md_c_flags
then do n_regs <- dynFlag stolen_x86_regs
return [ show n_regs ]
else return []
+#if defined(mingw32_TARGET_OS) && defined(MINIMAL_UNIX_DEPS)
+ perl_path <- prependToolDir ("perl")
+ let real_mangler = unwords [perl_path, mangler]
+#else
+ let real_mangler = mangler
+#endif
runSomething "Assembly Mangler"
- (unwords (mangler :
- mangler_opts
+ (unwords (real_mangler : mangler_opts
++ [ input_fn, output_fn ]
++ machdep_opts
))
run_phase SplitMangle _basename _suff input_fn _output_fn
= do splitter <- readIORef v_Pgm_s
-
-- this is the prefix used for the split .s files
tmp_pfx <- readIORef v_TmpDir
x <- myGetProcessID
-- allocate a tmp file to put the no. of split .s files in (sigh)
n_files <- newTempName "n_files"
+#if defined(mingw32_TARGET_OS) && defined(MINIMAL_UNIX_DEPS)
+ perl_path <- prependToolDir ("perl")
+ let real_splitter = unwords [perl_path, splitter]
+#else
+ let real_splitter = splitter
+#endif
runSomething "Split Assembly File"
- (unwords [ splitter
+ (unwords [ real_splitter
, input_fn
, split_s_prefix
, n_files ]
-- As phase
run_phase As _basename _suff input_fn output_fn
- = do as <- readIORef v_Pgm_a
+ = do as <- readIORef v_Pgm_a >>= prependToolDir >>= appendInstallDir
as_opts <- getOpts opt_a
cmdline_include_paths <- readIORef v_Include_paths
doLink :: [String] -> IO ()
doLink o_files = do
- ln <- readIORef v_Pgm_l
+ ln <- readIORef v_Pgm_l >>= prependToolDir >>= appendInstallDir
verb <- getVerbFlag
static <- readIORef v_Static
let imp = if static then "" else "_imp"
-- in a vain attempt to aid future portability
doMkDLL :: [String] -> IO ()
doMkDLL o_files = do
- ln <- readIORef v_Pgm_dll
+ ln <- readIORef v_Pgm_dll >>= prependToolDir >>= appendInstallDir
verb <- getVerbFlag
static <- readIORef v_Static
let imp = if static then "" else "_imp"
-----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.39 2001/05/24 15:10:19 dsyme Exp $
+-- $Id: DriverState.hs,v 1.40 2001/05/28 03:31:19 sof Exp $
--
-- Settings for the driver
--
module DriverState where
+#include "../includes/config.h"
#include "HsVersions.h"
import CmStaticInfo
GLOBAL_VAR(v_Pgm_l, cGCC, String)
GLOBAL_VAR(v_Pgm_dll, cMkDLL, String)
+#if defined(mingw32_TARGET_OS) && defined(MINIMAL_UNIX_DEPS)
+GLOBAL_VAR(v_Pgm_T, cTOUCH, String)
+#endif
+
GLOBAL_VAR(v_Opt_dep, [], [String])
GLOBAL_VAR(v_Anti_opt_C, [], [String])
GLOBAL_VAR(v_Opt_C, [], [String])
-----------------------------------------------------------------------------
--- $Id: DriverUtil.hs,v 1.21 2001/05/08 10:58:48 simonmar Exp $
+-- $Id: DriverUtil.hs,v 1.22 2001/05/28 03:31:19 sof Exp $
--
-- Utils for the driver
--
import Char
import Monad
+#ifndef mingw32_TARGET_OS
+import Posix
+#endif
+
-----------------------------------------------------------------------------
-- Errors
remove_spaces :: String -> String
remove_spaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace
+
+ghcToolDir :: String
+prependToolDir :: String -> IO String
+#if defined(mingw32_TARGET_OS) && defined(MINIMAL_UNIX_DEPS)
+ghcToolDir = unsafePerformIO $ do
+ bs <- getEnv "GHC_TOOLDIR" `IO.catch` (\ _ -> return "")
+ case bs of
+ "" -> return bs
+ ls ->
+ let
+ term = last ls
+ bs'
+ | term `elem` ['/', '\\'] = bs
+ | otherwise = bs ++ ['/']
+ in
+ return bs'
+
+prependToolDir x = return (dosifyPath (ghcToolDir ++ x))
+#else
+ghcToolDir = ""
+prependToolDir x = return x
+#endif
+
+appendInstallDir :: String -> IO String
+appendInstallDir cmd =
+ case ghcToolDir of
+ "" -> return cmd
+ _ -> return (unwords [cmd, '-':'B':ghcToolDir])
+
+-- convert filepath into MSDOS form.
+dosifyPath :: String -> String
+#if defined(mingw32_TARGET_OS) && defined(MINIMAL_UNIX_DEPS)
+dosifyPath stuff = subst '/' '\\' real_stuff
+ where
+ -- fully convince myself that /cygdrive/ prefixes cannot
+ -- really appear here.
+ cygdrive_prefix = "/cygdrive/"
+
+ real_stuff
+ | "/cygdrive/" `isPrefixOf` stuff = drop (length cygdrive_prefix) stuff
+ | otherwise = stuff
+
+ subst a b ls = map (\ x -> if x == a then b else x) ls
+#else
+dosifyPath x = x
+#endif
+
+#ifdef mingw32_TARGET_OS
+foreign import "_getpid" myGetProcessID :: IO Int
+#else
+myGetProcessID :: IO Int
+myGetProcessID = Posix.getProcessID
+#endif
{-# OPTIONS -fno-warn-incomplete-patterns #-}
-----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.65 2001/05/23 09:59:18 simonmar Exp $
+-- $Id: Main.hs,v 1.66 2001/05/28 03:31:19 sof Exp $
--
-- GHC Driver program
--
main =
-- top-level exception handler: any unrecognised exception is a compiler bug.
- handle (\exception ->
- case exception of
-#if __GLASGOW_HASKELL__ >= 501
- ExitException _ -> throw exception
-#endif
- _other -> do hPutStr stderr (show (Panic (show exception)))
- exitWith (ExitFailure 1)
+ handle (\exception -> do hPutStr stderr (show (Panic (show exception)))
+ exitWith (ExitFailure 1)
) $ do
-- all error messages are propagated as exceptions
writeIORef v_Pgm_L (installed "unlit")
writeIORef v_Pgm_m (installed "ghc-asm")
writeIORef v_Pgm_s (installed "ghc-split")
+#if defined(mingw32_TARGET_OS) && defined(MINIMAL_UNIX_DEPS)
+ writeIORef v_Pgm_T (installed cTOUCH)
+#endif
else do writeIORef v_Path_usage (inplace (cGHC_DRIVER_DIR ++ "/ghc-usage.txt"))
writeIORef v_Pgm_L (inplace cGHC_UNLIT)
writeIORef v_Pgm_m (inplace cGHC_MANGLER)
writeIORef v_Pgm_s (inplace cGHC_SPLIT)
+#if defined(mingw32_TARGET_OS) && defined(MINIMAL_UNIX_DEPS)
+ writeIORef v_Pgm_T (inplace cTOUCH)
+#endif
-- read the package configuration
conf_file <- readIORef v_Path_package_config
-----------------------------------------------------------------------------
--- $Id: TmpFiles.hs,v 1.18 2001/04/21 10:19:53 panne Exp $
+-- $Id: TmpFiles.hs,v 1.19 2001/05/28 03:31:19 sof Exp $
--
-- Temporary file management
--
blowAway f =
(do when verbose (hPutStrLn stderr ("Removing: " ++ f))
if '*' `elem` f
- then kludgedSystem ("rm -f " ++ f) "Cleaning temp files" >> return ()
+#if defined(mingw32_TARGET_OS) && defined(MINIMAL_UNIX_DEPS)
+ then kludgedSystem (cRM ++ ' ':dosifyPath f) "Cleaning temp files" >> return ()
+#else
+ then kludgedSystem (cRM ++ f) "Cleaning temp files" >> return ()
+#endif
else removeFile f)
`catchAllIO`
(\_ -> when verbose (hPutStrLn stderr
-- because system() under Windows doesn't look at SHELL, and always uses CMD.EXE)
kludgedSystem cmd phase_name
= do
-#ifndef mingw32_TARGET_OS
+#if !defined(mingw32_TARGET_OS) || defined(MINIMAL_UNIX_DEPS)
+ -- in the case where we do want to use an MSDOS command shell, we assume
+ -- that files and paths have been converted to a form that's
+ -- understandable to the command we're invoking.
exit_code <- system cmd `catchAllIO`
(\_ -> throwDyn (PhaseFailed phase_name (ExitFailure 1)))
#else
unzipWith
, global
- , myGetProcessID
#if __GLASGOW_HASKELL__ <= 408
, catchJust
#if __GLASGOW_HASKELL__ <= 408
import Exception ( catchIO, justIoErrors, raiseInThread )
#endif
-#ifndef mingw32_TARGET_OS
-import Posix
-#endif
+
infixr 9 `thenCmp`
\end{code}
ioErrors = justIoErrors
throwTo = raiseInThread
#endif
-
-#ifdef mingw32_TARGET_OS
-foreign import "_getpid" myGetProcessID :: IO Int
-#else
-myGetProcessID :: IO Int
-myGetProcessID = Posix.getProcessID
-#endif
\end{code}
projects / ghc-hetmet.git / commitdiff