Commit 67b9ddc8 authored by simonmar's avatar simonmar
Browse files

[project @ 2001-01-19 15:26:37 by simonmar]

Merge the DriverState and the DynFlags structures - it was silly
having both.
parent 74880a82
-----------------------------------------------------------------------------
-- $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))
......
......@@ -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 = []
}
{-
......
{-# 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<blah>) 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 ( [], [] )
-----------------------------------------------------------------------------
-- $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)))
......
-----------------------------------------------------------------------------
-- $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
--
......@@ -28,73 +28,6 @@ import List
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
......@@ -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 ( [], [] )
......@@ -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
......
{-# 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
......
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