Commit 4cef3202 authored by sof's avatar sof
Browse files

[project @ 2001-05-28 03:31:19 by sof]

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).
parent 8bbf522b
# -----------------------------------------------------------------------------
# $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
......@@ -57,14 +57,25 @@ $(CONFIG_HS) : $(FPTOOLS_TOP)/mk/config.mk Makefile
@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)
......@@ -107,6 +118,12 @@ DIRS += ghci
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)
......@@ -312,6 +329,11 @@ ghc-inplace : $(HS_PROG)
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
--
......@@ -585,7 +585,7 @@ machdepCCOpts
= 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
--
......@@ -35,6 +35,7 @@ import Maybe
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);
......@@ -56,6 +57,9 @@ dep_opts = [
( "-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 ()
......@@ -157,17 +161,18 @@ endMkDependHS = do
-- 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
......@@ -198,4 +203,7 @@ findDependency is_source src imp = do
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
--
......@@ -311,8 +311,10 @@ run_phase Unlit _basename _suff input_fn output_fn
= 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
-------------------------------------------------------------------------------
......@@ -326,7 +328,7 @@ run_phase Cpp basename suff input_fn output_fn
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
......@@ -340,19 +342,31 @@ run_phase Cpp basename suff input_fn output_fn
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
-----------------------------------------------------------------------------
......@@ -508,7 +522,12 @@ run_phase Hsc basename suff input_fn output_fn
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;
};
......@@ -532,7 +551,7 @@ run_phase Hsc basename suff input_fn output_fn
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
......@@ -561,7 +580,6 @@ run_phase cc_phase basename suff input_fn output_fn
| otherwise = [ ]
excessPrecision <- readIORef v_Excess_precision
runSomething "C Compiler"
(unwords ([ cc, "-x", "c", input_fn, "-o", output_fn ]
++ md_c_flags
......@@ -591,9 +609,14 @@ run_phase Mangle _basename _suff input_fn output_fn
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
))
......@@ -604,7 +627,6 @@ run_phase Mangle _basename _suff input_fn output_fn
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
......@@ -615,8 +637,14 @@ run_phase SplitMangle _basename _suff input_fn _output_fn
-- 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 ]
......@@ -632,7 +660,7 @@ run_phase SplitMangle _basename _suff input_fn _output_fn
-- 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
......@@ -768,7 +796,7 @@ checkProcessArgsResult flags basename suff
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"
......@@ -843,7 +871,7 @@ doLink o_files = do
-- 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
--
......@@ -9,6 +9,7 @@
module DriverState where
#include "../includes/config.h"
#include "HsVersions.h"
import CmStaticInfo
......@@ -596,6 +597,10 @@ GLOBAL_VAR(v_Pgm_a, cGCC, String)
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
--
......@@ -27,6 +27,10 @@ import List
import Char
import Monad
#ifndef mingw32_TARGET_OS
import Posix
#endif
-----------------------------------------------------------------------------
-- Errors
......@@ -175,3 +179,56 @@ newdir dir s = dir ++ '/':drop_longest_prefix s '/'
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
--
......@@ -87,13 +87,8 @@ import Maybe
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
......@@ -154,11 +149,17 @@ main =
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
--
......@@ -87,7 +87,11 @@ removeTmpFiles verb fs = do
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
......@@ -99,7 +103,10 @@ removeTmpFiles verb fs = do
-- 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
......
......@@ -52,7 +52,6 @@ module Util (
unzipWith
, global
, myGetProcessID
#if __GLASGOW_HASKELL__ <= 408
, catchJust
......@@ -73,9 +72,7 @@ import FastTypes
#if __GLASGOW_HASKELL__ <= 408
import Exception ( catchIO, justIoErrors, raiseInThread )
#endif
#ifndef mingw32_TARGET_OS
import Posix
#endif
infixr 9 `thenCmp`
\end{code}
......@@ -726,11 +723,4 @@ catchJust = catchIO
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}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment