From: simonmar Date: Fri, 19 Jan 2001 15:26:37 +0000 (+0000) Subject: [project @ 2001-01-19 15:26:37 by simonmar] X-Git-Tag: Approximately_9120_patches~2843 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=67b9ddc822964b29ea177bde3c735702afcda667;p=ghc-hetmet.git [project @ 2001-01-19 15:26:37 by simonmar] Merge the DriverState and the DynFlags structures - it was silly having both. --- diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs index 3b5c701..b2ec5c1 100644 --- a/ghc/compiler/ghci/InteractiveUI.hs +++ b/ghc/compiler/ghci/InteractiveUI.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: InteractiveUI.hs,v 1.29 2001/01/18 16:30:00 simonmar Exp $ +-- $Id: InteractiveUI.hs,v 1.30 2001/01/19 15:26:37 simonmar Exp $ -- -- GHC Interactive User Interface -- @@ -351,12 +351,16 @@ setOptions str mapM setOpt plus_opts -- now, the GHC flags - io (do leftovers <- processArgs static_flags minus_opts [] + io (do -- first, static flags + leftovers <- processArgs static_flags minus_opts [] + + -- then, dynamic flags dyn_flags <- readIORef v_InitDynFlags writeIORef v_DynFlags dyn_flags leftovers <- processArgs dynamic_flags leftovers [] dyn_flags <- readIORef v_DynFlags writeIORef v_InitDynFlags dyn_flags + if (not (null leftovers)) then throwDyn (OtherError ("unrecognised flags: " ++ unwords leftovers)) diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index 5d2338c..8464aff 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -281,18 +281,40 @@ data DynFlag deriving (Eq) data DynFlags = DynFlags { - coreToDo :: [CoreToDo], - stgToDo :: [StgToDo], - hscLang :: HscLang, - hscOutName :: String, -- name of the file in which to place output - verbosity :: Int, -- verbosity level - flags :: [DynFlag] + coreToDo :: [CoreToDo], + stgToDo :: [StgToDo], + hscLang :: HscLang, + hscOutName :: String, -- name of the output file + verbosity :: Int, -- verbosity level + cppFlag :: Bool, -- preprocess with cpp? + stolen_x86_regs :: Int, + cmdlineHcIncludes :: [String], -- -#includes + + -- options for particular phases + opt_L :: [String], + opt_P :: [String], + opt_c :: [String], + opt_a :: [String], + opt_m :: [String], + + -- hsc dynamic flags + flags :: [DynFlag] } defaultDynFlags = DynFlags { coreToDo = [], stgToDo = [], - hscLang = HscC, hscOutName = "", - verbosity = 0, flags = [] + hscLang = HscC, + hscOutName = "", + verbosity = 0, + cppFlag = False, + stolen_x86_regs = 4, + cmdlineHcIncludes = [], + opt_L = [], + opt_P = [], + opt_c = [], + opt_a = [], + opt_m = [], + flags = [] } {- diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index 128a3a8..fa1fa47 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -1,7 +1,7 @@ {-# OPTIONS -#include "hschooks.h" #-} ----------------------------------------------------------------------------- --- $Id: DriverFlags.hs,v 1.39 2001/01/12 11:04:45 simonmar Exp $ +-- $Id: DriverFlags.hs,v 1.40 2001/01/19 15:26:37 simonmar Exp $ -- -- Driver flags -- @@ -310,7 +310,8 @@ static_flags = -- v_InitDynFlags -- is the "baseline" dynamic flags, initialised from --- the defaults and command line options. +-- the defaults and command line options, and updated by the +-- ':s' command in GHCi. -- -- v_DynFlags -- is the dynamic flags for the current compilation. It is reset @@ -333,6 +334,19 @@ dynFlag f = do dflags <- readIORef v_DynFlags; return (f dflags) setDynFlag f = updDynFlags (\dfs -> dfs{ flags = f : flags dfs }) unSetDynFlag f = updDynFlags (\dfs -> dfs{ flags = filter (/= f) (flags dfs) }) +addOpt_L a = updDynFlags (\s -> s{opt_L = a : opt_L s}) +addOpt_P a = updDynFlags (\s -> s{opt_P = a : opt_P s}) +addOpt_c a = updDynFlags (\s -> s{opt_c = a : opt_c s}) +addOpt_a a = updDynFlags (\s -> s{opt_a = a : opt_a s}) +addOpt_m a = updDynFlags (\s -> s{opt_m = a : opt_m s}) + +addCmdlineHCInclude a = + updDynFlags (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes s}) + + -- we add to the options from the front, so we need to reverse the list +getOpts :: (DynFlags -> [a]) -> IO [a] +getOpts opts = dynFlag opts >>= return . reverse + -- we can only change HscC to HscAsm and vice-versa with dynamic flags -- (-fvia-C and -fasm). setLang l = do @@ -358,7 +372,7 @@ getVerbFlag = do dynamic_flags = [ - ( "cpp", NoArg (updateState (\s -> s{ cpp_flag = True })) ) + ( "cpp", NoArg (updDynFlags (\s -> s{ cppFlag = True })) ) , ( "#include", HasArg (addCmdlineHCInclude) ) , ( "v", OptPrefix (setVerbosity) ) @@ -418,9 +432,9 @@ dynamic_flags = [ ------ Machine dependant (-m) stuff --------------------------- - , ( "monly-2-regs", NoArg (updateState (\s -> s{stolen_x86_regs = 2}) )) - , ( "monly-3-regs", NoArg (updateState (\s -> s{stolen_x86_regs = 3}) )) - , ( "monly-4-regs", NoArg (updateState (\s -> s{stolen_x86_regs = 4}) )) + , ( "monly-2-regs", NoArg (updDynFlags (\s -> s{stolen_x86_regs = 2}) )) + , ( "monly-3-regs", NoArg (updDynFlags (\s -> s{stolen_x86_regs = 3}) )) + , ( "monly-4-regs", NoArg (updDynFlags (\s -> s{stolen_x86_regs = 4}) )) ------ Compiler flags ----------------------------------------------- @@ -538,3 +552,53 @@ runSomething phase_name cmd then throwDyn (PhaseFailed phase_name exit_code) else do when (verb >= 3) (hPutStr stderr "\n") return () + +----------------------------------------------------------------------------- +-- Via-C compilation stuff + +-- flags returned are: ( all C compilations +-- , registerised HC compilations +-- ) + +machdepCCOpts + | prefixMatch "alpha" cTARGETPLATFORM + = return ( ["-static"], [] ) + + | prefixMatch "hppa" cTARGETPLATFORM + -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi! + -- (very nice, but too bad the HP /usr/include files don't agree.) + = return ( ["-static", "-D_HPUX_SOURCE"], [] ) + + | prefixMatch "m68k" cTARGETPLATFORM + -- -fno-defer-pop : for the .hc files, we want all the pushing/ + -- popping of args to routines to be explicit; if we let things + -- be deferred 'til after an STGJUMP, imminent death is certain! + -- + -- -fomit-frame-pointer : *don't* + -- It's better to have a6 completely tied up being a frame pointer + -- rather than let GCC pick random things to do with it. + -- (If we want to steal a6, then we would try to do things + -- as on iX86, where we *do* steal the frame pointer [%ebp].) + = return ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] ) + + | prefixMatch "i386" cTARGETPLATFORM + -- -fno-defer-pop : basically the same game as for m68k + -- + -- -fomit-frame-pointer : *must* in .hc files; because we're stealing + -- the fp (%ebp) for our register maps. + = 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" else "" ], + [ "-fno-defer-pop", "-fomit-frame-pointer", + "-DSTOLEN_X86_REGS="++show n_regs ] + ) + + | prefixMatch "mips" cTARGETPLATFORM + = return ( ["static"], [] ) + + | prefixMatch "powerpc" cTARGETPLATFORM || prefixMatch "rs6000" cTARGETPLATFORM + = return ( ["static"], ["-finhibit-size-directive"] ) + + | otherwise + = return ( [], [] ) diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index b0f2915..d0bb19a 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverPipeline.hs,v 1.48 2001/01/16 21:05:51 qrczak Exp $ +-- $Id: DriverPipeline.hs,v 1.49 2001/01/19 15:26:37 simonmar Exp $ -- -- GHC Driver -- @@ -322,7 +322,7 @@ run_phase Cpp basename suff input_fn output_fn ++ ": static flags are not allowed in {-# OPTIONS #-} pragmas:\n\t" ++ unwords unhandled_flags)) (ExitFailure 1)) - do_cpp <- readState cpp_flag + do_cpp <- dynFlag cppFlag if do_cpp then do cpp <- readIORef v_Pgm_P @@ -525,7 +525,7 @@ run_phase cc_phase _basename _suff input_fn output_fn ++ pkg_include_dirs) c_includes <- getPackageCIncludes - cmdline_includes <- readState cmdline_hc_includes -- -#include options + cmdline_includes <- dynFlag cmdlineHcIncludes -- -#include options let cc_injects | hcc = unlines (map mk_include (c_includes ++ reverse cmdline_includes)) @@ -588,7 +588,7 @@ run_phase Mangle _basename _suff input_fn output_fn mangler_opts <- getOpts opt_m machdep_opts <- if (prefixMatch "i386" cTARGETPLATFORM) - then do n_regs <- readState stolen_x86_regs + then do n_regs <- dynFlag stolen_x86_regs return [ show n_regs ] else return [] runSomething "Assembly Mangler" @@ -811,14 +811,12 @@ doMkDLL o_files = do preprocess :: FilePath -> IO FilePath preprocess filename = ASSERT(haskellish_file filename) - do init_driver_state <- readIORef v_InitDriverState - writeIORef v_Driver_state init_driver_state - + do init_dyn_flags <- readIORef v_InitDynFlags + writeIORef v_DynFlags init_dyn_flags pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False defaultHscLang filename runPipeline pipeline filename False{-no linking-} False{-no -o flag-} - ----------------------------------------------------------------------------- -- Compile a single module, under the control of the compilation manager. -- @@ -858,8 +856,6 @@ data CompResult compile ghci_mode summary source_unchanged old_iface hst hit pcs = do init_dyn_flags <- readIORef v_InitDynFlags writeIORef v_DynFlags init_dyn_flags - init_driver_state <- readIORef v_InitDriverState - writeIORef v_Driver_state init_driver_state showPass init_dyn_flags (showSDoc (text "Compiling" <+> ppr (name_of_summary summary))) diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs index b462da8..bbaadd5 100644 --- a/ghc/compiler/main/DriverState.hs +++ b/ghc/compiler/main/DriverState.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverState.hs,v 1.24 2001/01/16 12:41:03 simonmar Exp $ +-- $Id: DriverState.hs,v 1.25 2001/01/19 15:26:37 simonmar Exp $ -- -- Settings for the driver -- @@ -29,73 +29,6 @@ import Char import Monad ----------------------------------------------------------------------------- --- Driver state - --- certain flags can be specified on a per-file basis, in an OPTIONS --- pragma at the beginning of the source file. This means that when --- compiling mulitple files, we have to restore the global option --- settings before compiling a new file. --- --- The DriverState record contains the per-file-mutable state. - -data DriverState = DriverState { - - -- are we runing cpp on this file? - cpp_flag :: Bool, - - -- misc - stolen_x86_regs :: Int, - cmdline_hc_includes :: [String], - - -- options for a particular phase - opt_L :: [String], - opt_P :: [String], - opt_c :: [String], - opt_a :: [String], - opt_m :: [String] - } - -initDriverState = DriverState { - cpp_flag = False, - stolen_x86_regs = 4, - cmdline_hc_includes = [], - opt_L = [], - opt_P = [], - opt_c = [], - opt_a = [], - opt_m = [], - } - --- The driver state is first initialized from the command line options, --- and then reset to this initial state before each compilation. --- v_InitDriverState contains the saved initial state, and v_DriverState --- contains the current state (modified by any OPTIONS pragmas, for example). --- --- v_InitDriverState may also be modified from the GHCi prompt, using :set. --- -GLOBAL_VAR(v_InitDriverState, initDriverState, DriverState) -GLOBAL_VAR(v_Driver_state, initDriverState, DriverState) - -readState :: (DriverState -> a) -> IO a -readState f = readIORef v_Driver_state >>= return . f - -updateState :: (DriverState -> DriverState) -> IO () -updateState f = readIORef v_Driver_state >>= writeIORef v_Driver_state . f - -addOpt_L a = updateState (\s -> s{opt_L = a : opt_L s}) -addOpt_P a = updateState (\s -> s{opt_P = a : opt_P s}) -addOpt_c a = updateState (\s -> s{opt_c = a : opt_c s}) -addOpt_a a = updateState (\s -> s{opt_a = a : opt_a s}) -addOpt_m a = updateState (\s -> s{opt_m = a : opt_m s}) - -addCmdlineHCInclude a = - updateState (\s -> s{cmdline_hc_includes = a : cmdline_hc_includes s}) - - -- we add to the options from the front, so we need to reverse the list -getOpts :: (DriverState -> [a]) -> IO [a] -getOpts opts = readState opts >>= return . reverse - ------------------------------------------------------------------------------ -- non-configured things cHaskell1Version = "5" -- i.e., Haskell 98 @@ -671,53 +604,3 @@ GLOBAL_VAR(v_Opt_dll, [], [String]) getStaticOpts :: IORef [String] -> IO [String] getStaticOpts ref = readIORef ref >>= return . reverse - ------------------------------------------------------------------------------ --- Via-C compilation stuff - --- flags returned are: ( all C compilations --- , registerised HC compilations --- ) - -machdepCCOpts - | prefixMatch "alpha" cTARGETPLATFORM - = return ( ["-static"], [] ) - - | prefixMatch "hppa" cTARGETPLATFORM - -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi! - -- (very nice, but too bad the HP /usr/include files don't agree.) - = return ( ["-static", "-D_HPUX_SOURCE"], [] ) - - | prefixMatch "m68k" cTARGETPLATFORM - -- -fno-defer-pop : for the .hc files, we want all the pushing/ - -- popping of args to routines to be explicit; if we let things - -- be deferred 'til after an STGJUMP, imminent death is certain! - -- - -- -fomit-frame-pointer : *don't* - -- It's better to have a6 completely tied up being a frame pointer - -- rather than let GCC pick random things to do with it. - -- (If we want to steal a6, then we would try to do things - -- as on iX86, where we *do* steal the frame pointer [%ebp].) - = return ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] ) - - | prefixMatch "i386" cTARGETPLATFORM - -- -fno-defer-pop : basically the same game as for m68k - -- - -- -fomit-frame-pointer : *must* in .hc files; because we're stealing - -- 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 "", - if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else "" ], - [ "-fno-defer-pop", "-fomit-frame-pointer", - "-DSTOLEN_X86_REGS="++show n_regs ] - ) - - | prefixMatch "mips" cTARGETPLATFORM - = return ( ["static"], [] ) - - | prefixMatch "powerpc" cTARGETPLATFORM || prefixMatch "rs6000" cTARGETPLATFORM - = return ( ["static"], ["-finhibit-size-directive"] ) - - | otherwise - = return ( [], [] ) diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index be302b9..21da9dc 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -342,8 +342,7 @@ restOfCodeGeneration dflags toInterp this_mod imported_module_names -------------------------- Code output ------------------------------- (maybe_stub_h_name, maybe_stub_c_name) - <- _scc_ "CodeOutput" - codeOutput dflags this_mod local_tycons + <- codeOutput dflags this_mod local_tycons tidy_binds stg_binds c_code h_code abstractC diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs index e2a863b..e55f105 100644 --- a/ghc/compiler/main/Main.hs +++ b/ghc/compiler/main/Main.hs @@ -1,6 +1,6 @@ {-# OPTIONS -fno-warn-incomplete-patterns #-} ----------------------------------------------------------------------------- --- $Id: Main.hs,v 1.47 2001/01/16 12:41:03 simonmar Exp $ +-- $Id: Main.hs,v 1.48 2001/01/19 15:26:37 simonmar Exp $ -- -- GHC Driver program -- @@ -17,7 +17,6 @@ module Main (main) where #ifdef GHCI -import Interpreter import InteractiveUI #endif @@ -34,7 +33,7 @@ import DriverMkDepend import DriverUtil import Panic import DriverPhases ( Phase(..), haskellish_file ) -import CmdLineOpts ( HscLang(..), DynFlags(..), v_Static_hsc_opts ) +import CmdLineOpts import TmpFiles import Finder ( initFinder ) import CmStaticInfo @@ -42,7 +41,6 @@ import Config import Util - import Concurrent import Directory import IOExts @@ -206,18 +204,17 @@ main = | otherwise -> defaultHscLang writeIORef v_DynFlags - DynFlags{ coreToDo = core_todo, - stgToDo = stg_todo, - hscLang = lang, - -- leave out hscOutName for now - hscOutName = panic "Main.main:hscOutName not set", - - verbosity = case mode of - DoInteractive -> 1 - DoMake -> 1 - _other -> 0, - - flags = [] } + defaultDynFlags{ coreToDo = core_todo, + stgToDo = stg_todo, + hscLang = lang, + -- leave out hscOutName for now + hscOutName = panic "Main.main:hscOutName not set", + + verbosity = case mode of + DoInteractive -> 1 + DoMake -> 1 + _other -> 0, + } -- the rest of the arguments are "dynamic" srcs <- processArgs dynamic_flags (way_non_static ++ @@ -229,12 +226,6 @@ main = -- complain about any unknown flags mapM unknownFlagErr [ f | f@('-':_) <- srcs ] - -- save the flag state, because this could be modified by OPTIONS - -- pragmas during the compilation, and we'll need to restore it - -- before starting the next compilation. - saved_driver_state <- readIORef v_Driver_state - writeIORef v_InitDriverState saved_driver_state - verb <- dynFlag verbosity when (verb >= 2) @@ -270,7 +261,6 @@ main = if null srcs then throwDyn (UsageError "no input files") else do let compileFile src = do - writeIORef v_Driver_state saved_driver_state writeIORef v_DynFlags init_dyn_flags -- We compile in two stages, because the file may have an