-----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.22 2001/01/09 17:16:35 rrt Exp $
+-- $Id: DriverState.hs,v 1.26 2001/02/01 11:47:53 simonmar Exp $
--
-- Settings for the driver
--
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
-----------------------------------------------------------------------------
-- Hi Files
-GLOBAL_VAR(v_ProduceHi, True, Bool)
GLOBAL_VAR(v_Hi_on_stdout, False, Bool)
GLOBAL_VAR(v_Hi_suf, "hi", String)
GLOBAL_VAR(v_CPR, True, Bool)
GLOBAL_VAR(v_CSE, True, Bool)
-hsc_minusO2_flags = hsc_minusO_flags -- for now
-
+-- these are the static flags you get without -O.
hsc_minusNoO_flags =
[
"-fignore-interface-pragmas",
- "-fomit-interface-pragmas"
+ "-fomit-interface-pragmas",
+ "-flet-no-escape"
]
+-- these are the static flags you get when -O is on.
hsc_minusO_flags =
[
"-ffoldr-build-on",
"-fdo-lambda-eta-expansion",
"-fcase-of-case",
"-fcase-merge",
- "-flet-to-case"
+ "-flet-to-case",
+ "-flet-no-escape"
]
+hsc_minusO2_flags = hsc_minusO_flags -- for now
+
getStaticOptimisationFlags 0 = hsc_minusNoO_flags
getStaticOptimisationFlags 1 = hsc_minusO_flags
getStaticOptimisationFlags n = hsc_minusO2_flags
, "-fvia-C" ]),
(WayUnreg, Way "u" "Unregisterised"
- [ "-optc-DNO_REGS"
- , "-optc-DUSE_MINIINTERPRETER"
- , "-fno-asm-mangling"
- , "-funregisterised"
- , "-fvia-C" ]),
+ unregFlags ),
(WayPar, Way "mp" "Parallel"
[ "-fparallel"
(WayUser_B, Way "B" "User way 'B'" ["$WAY_B_REAL_OPTS"])
]
+unregFlags =
+ [ "-optc-DNO_REGS"
+ , "-optc-DUSE_MINIINTERPRETER"
+ , "-fno-asm-mangling"
+ , "-funregisterised"
+ , "-fvia-C" ]
+
-----------------------------------------------------------------------------
-- Programs for particular phases
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 ( [], [] )
projects / ghc-hetmet.git / blobdiff