From 71efe750343606d6d13fc8b8e77213fe13825288 Mon Sep 17 00:00:00 2001 From: rrt Date: Mon, 4 Dec 2000 16:42:14 +0000 Subject: [PATCH] [project @ 2000-12-04 16:42:14 by rrt] Merge changes from old driver in before-ghci-branch. --- ghc/compiler/main/DriverFlags.hs | 6 ++++-- ghc/compiler/main/DriverPipeline.hs | 16 +++++++--------- ghc/compiler/main/DriverState.hs | 20 +++++++------------- ghc/compiler/main/TmpFiles.hs | 8 +++++--- 4 files changed, 23 insertions(+), 27 deletions(-) diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index 2c90276..08a2fbe 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverFlags.hs,v 1.24 2000/11/24 09:51:39 simonpj Exp $ +-- $Id: DriverFlags.hs,v 1.25 2000/12/04 16:42:14 rrt Exp $ -- -- Driver flags -- @@ -194,6 +194,7 @@ static_flags = ------- Miscellaneous ----------------------------------------------- , ( "no-link-chk" , NoArg (return ()) ) -- ignored for backwards compat + , ( "no-hs-main" , NoArg (writeIORef no_hs_main True) ) ------- Output Redirection ------------------------------------------ , ( "odir" , HasArg (writeIORef v_Output_dir . Just) ) @@ -258,6 +259,7 @@ static_flags = ----- Linker -------------------------------------------------------- , ( "static" , NoArg (writeIORef v_Static True) ) + , ( "rdynamic" , NoArg (return ()) ) -- ignored for compat w/ gcc ----- RTS opts ------------------------------------------------------ #ifdef not_yet @@ -527,7 +529,7 @@ runSomething phase_name cmd hPutStrLn h cmd hClose h exit_code <- system ("sh - " ++ tmp) `catchAllIO` - (\e -> throwDyn (PhaseFailed phase_name (ExitFailure 1))) + (\_ -> throwDyn (PhaseFailed phase_name (ExitFailure 1))) removeFile tmp #endif diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index 5438b63..5d3aeb0 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverPipeline.hs,v 1.35 2000/11/24 17:09:52 simonmar Exp $ +-- $Id: DriverPipeline.hs,v 1.36 2000/12/04 16:42:14 rrt Exp $ -- -- GHC Driver -- @@ -95,7 +95,7 @@ getGhcMode flags -- what the suffix of the intermediate files should be, etc. -- The following compilation pipeline algorithm is fairly hacky. A --- better way to do this would be to express the whole comilation as a +-- better way to do this would be to express the whole compilation as a -- data flow DAG, where the nodes are the intermediate files and the -- edges are the compilation phases. This framework would also work -- nicely if a haskell dependency generator was included in the @@ -111,8 +111,8 @@ getGhcMode flags -- concurrently, automatically taking advantage of extra processors on -- the host machine. For example, when compiling two Haskell files -- where one depends on the other, the data flow graph would determine --- that the C compiler from the first comilation can be overlapped --- with the hsc comilation for the second file. +-- that the C compiler from the first compilation can be overlapped +-- with the hsc compilation for the second file. data IntermediateFileType = Temporary @@ -430,7 +430,8 @@ run_phase Hsc basename suff input_fn output_fn -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless. do_recomp <- readIORef v_Recomp todo <- readIORef v_GhcMode - o_file <- odir_ify (basename ++ '.':phaseInputExt Ln) + o_file' <- odir_ify (basename ++ '.':phase_input_ext Ln) + o_file <- osuf_ify o_file' source_unchanged <- if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln )) then return False @@ -551,9 +552,6 @@ run_phase cc_phase _basename _suff input_fn output_fn ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ] ++ cc_opts ++ split_opt -#ifdef mingw32_TARGET_OS - ++ [" -mno-cygwin"] -#endif ++ (if excessPrecision then [] else [ "-ffloat-store" ]) ++ include_paths ++ pkg_extra_cc_opts @@ -871,7 +869,7 @@ dealWithStubs basename maybe_stub_h maybe_stub_c runSomething "Copy stub .c file" (unwords [ "rm -f", stub_c, "&&", - "echo \'#include \""++stub_h++"\"\' >"++stub_c, " &&", + "echo \'#include \"Stg.h\"\n#include \""++stub_h++"\"\' >"++stub_c, " &&", "cat", tmp_stub_c, ">> ", stub_c ]) diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs index 37e19e2..ae738ff 100644 --- a/ghc/compiler/main/DriverState.hs +++ b/ghc/compiler/main/DriverState.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverState.hs,v 1.16 2000/11/21 14:35:05 simonmar Exp $ +-- $Id: DriverState.hs,v 1.17 2000/12/04 16:42:14 rrt Exp $ -- -- Settings for the driver -- @@ -527,7 +527,6 @@ GLOBAL_VAR(v_Build_tag, "", String) data WayName = WayProf | WayUnreg - | WayDll | WayTicky | WayPar | WayGran @@ -554,12 +553,9 @@ data WayName GLOBAL_VAR(v_Ways, [] ,[WayName]) --- ToDo: allow WayDll with any other allowed combination - -allowed_combinations = - [ [WayProf,WayUnreg], - [WayProf,WaySMP] -- works??? - ] +allowed_combinations way = ways `elem` combs + where -- the sub-lists must be ordered according to WayName, because findBuildTag sorts them + combs = [ [WayProf,WayUnreg], [WayProf,WaySMP] ] findBuildTag :: IO [String] -- new options findBuildTag = do @@ -572,7 +568,7 @@ findBuildTag = do writeIORef v_Build_tag (wayTag details) return (wayOpts details) - ws -> if ws `notElem` allowed_combinations + ws -> if not allowed_combination ws then throwDyn (OtherError $ "combination not supported: " ++ foldr1 (\a b -> a ++ '/':b) @@ -616,9 +612,6 @@ way_details = , "-funregisterised" , "-fvia-C" ]), - (WayDll, Way "dll" "DLLized" - [ ]), - (WayPar, Way "mp" "Parallel" [ "-fparallel" , "-D__PARALLEL_HASKELL__" @@ -714,7 +707,8 @@ machdepCCOpts -- the fp (%ebp) for our register maps. = do n_regs <- readState stolen_x86_regs sta <- readIORef v_Static - return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "" ], + return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "", + if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else "" ], [ "-fno-defer-pop", "-fomit-frame-pointer", "-DSTOLEN_X86_REGS="++show n_regs ] ) diff --git a/ghc/compiler/main/TmpFiles.hs b/ghc/compiler/main/TmpFiles.hs index 90ebcc2..4f0805d 100644 --- a/ghc/compiler/main/TmpFiles.hs +++ b/ghc/compiler/main/TmpFiles.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: TmpFiles.hs,v 1.8 2000/10/30 09:52:15 simonpj Exp $ +-- $Id: TmpFiles.hs,v 1.9 2000/12/04 16:42:14 rrt Exp $ -- -- Temporary file management -- @@ -39,8 +39,10 @@ GLOBAL_VAR(v_TmpDir, cDEFAULT_TMPDIR, String ) initTempFileStorage = do -- check whether TMPDIR is set in the environment IO.try (do dir <- getEnv "TMPDIR" -- fails if not set - writeIORef v_TmpDir dir) - +#ifndef mingw32_TARGET_OS + writeIORef v_TmpDir dir +#endif + ) cleanTempFiles :: Bool -> IO () cleanTempFiles verbose = do -- 1.7.10.4