X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=764fb91079fe01a0e0dca4add86b49820fa91ad4;hb=88605454e4bf30d7fca2b0eea4643c5637afd5cc;hp=dcd81056c4040bec657d421f2545f0ed7c2c2eed;hpb=9b7ba5edbd83ea1624cbb8da8d7c52f7e59bb467;p=ghc-hetmet.git diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index dcd8105..764fb91 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -35,6 +35,7 @@ module DynFlags ( updOptLevel, setTmpDir, setPackageName, + doingTickyProfiling, -- ** Parsing DynFlags parseDynamicFlags, @@ -63,12 +64,15 @@ module DynFlags ( #include "HsVersions.h" +#ifndef OMIT_NATIVE_CODEGEN +import Platform +#endif import Module import PackageConfig import PrelNames ( mAIN, main_RDR_Unqual ) import RdrName ( RdrName, mkRdrUnqual ) import OccName ( mkVarOccFS ) -#ifdef i386_TARGET_ARCH +#if defined(i386_TARGET_ARCH) || (!defined(mingw32_TARGET_OS) && !defined(darwin_TARGET_OS)) import StaticFlags ( opt_Static ) #endif import StaticFlags ( opt_PIC, WayName(..), v_Ways, v_Build_tag, @@ -84,10 +88,11 @@ import Util import Maybes ( orElse ) import SrcLoc import FastString +import FiniteMap import Outputable import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage ) -import Data.IORef ( readIORef ) +import Data.IORef import Control.Monad ( when ) import Data.Char @@ -218,6 +223,7 @@ data DynFlag | Opt_RelaxedPolyRec | Opt_StandaloneDeriving | Opt_DeriveDataTypeable + | Opt_DeriveFunctor | Opt_TypeSynonymInstances | Opt_FlexibleContexts | Opt_FlexibleInstances @@ -268,6 +274,11 @@ data DynFlag | Opt_RegsGraph -- do graph coloring register allocation | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation + -- profiling opts + | Opt_AutoSccsOnAllToplevs + | Opt_AutoSccsOnExportedToplevs + | Opt_AutoSccsOnIndividualCafs + -- misc opts | Opt_Cpp | Opt_Pp @@ -331,6 +342,9 @@ data DynFlags = DynFlags { specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase +#ifndef OMIT_NATIVE_CODEGEN + targetPlatform :: Platform, -- ^ The platform we're compiling for. Used by the NCG. +#endif stolen_x86_regs :: Int, cmdlineHcIncludes :: [String], -- ^ @\-\#includes@ importPaths :: [FilePath], @@ -347,6 +361,9 @@ data DynFlags = DynFlags { buildTag :: String, -- ^ The global \"way\" (e.g. \"p\" for prof) rtsBuildTag :: String, -- ^ The RTS \"way\" + -- For object splitting + splitInfo :: Maybe (String,Int), + -- paths etc. objectDir :: Maybe String, hiDir :: Maybe String, @@ -425,6 +442,12 @@ data DynFlags = DynFlags { pkgDatabase :: Maybe (UniqFM PackageConfig), pkgState :: PackageState, + -- Temporary files + -- These have to be IORefs, because the defaultCleanupHandler needs to + -- know what to clean when an exception happens + filesToClean :: IORef [FilePath], + dirsToClean :: IORef (FiniteMap FilePath FilePath), + -- hsc dynamic flags flags :: [DynFlag], @@ -436,23 +459,30 @@ data DynFlags = DynFlags { -- | The target code type of the compilation (if any). -- +-- Whenever you change the target, also make sure to set 'ghcLink' to +-- something sensible. +-- -- 'HscNothing' can be used to avoid generating any output, however, note -- that: -- -- * This will not run the desugaring step, thus no warnings generated in --- this step will be output. In particular, this includes warnings --- related to pattern matching. +-- this step will be output. In particular, this includes warnings related +-- to pattern matching. You can run the desugarer manually using +-- 'GHC.desugarModule'. -- --- * At the moment switching from 'HscNothing' to 'HscInterpreted' without --- unloading first is not safe. To unload use --- @GHC.setTargets [] >> GHC.load LoadAllTargets@. +-- * If a program uses Template Haskell the typechecker may try to run code +-- from an imported module. This will fail if no code has been generated +-- for this module. You can use 'GHC.needsTemplateHaskell' to detect +-- whether this might be the case and choose to either switch to a +-- different target or avoid typechecking such modules. (The latter may +-- preferable for security reasons.) -- data HscTarget - = HscC - | HscAsm - | HscJava - | HscInterpreted - | HscNothing + = HscC -- ^ Generate C code. + | HscAsm -- ^ Generate assembly using the native code generator. + | HscJava -- ^ Generate Java bytecode. + | HscInterpreted -- ^ Generate bytecode. (Requires 'LinkInMemory') + | HscNothing -- ^ Don't generate any code. See notes above. deriving (Eq, Show) -- | Will this target result in an object file on the disk? @@ -486,7 +516,8 @@ isOneShot _other = False data GhcLink = NoLink -- ^ Don't link at all | LinkBinary -- ^ Link object code into a binary - | LinkInMemory -- ^ Use the in-memory dynamic linker + | LinkInMemory -- ^ Use the in-memory dynamic linker (works for both + -- bytecode and object code). | LinkDynLib -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) deriving (Eq, Show) @@ -494,6 +525,11 @@ isNoLink :: GhcLink -> Bool isNoLink NoLink = True isNoLink _ = False +-- Is it worth evaluating this Bool and caching it in the DynFlags value +-- during initDynFlags? +doingTickyProfiling :: DynFlags -> Bool +doingTickyProfiling dflags = WayTicky `elem` wayNames dflags + data PackageFlag = ExposePackage String | HidePackage String @@ -523,10 +559,14 @@ initDynFlags dflags = do ways <- readIORef v_Ways build_tag <- readIORef v_Build_tag rts_build_tag <- readIORef v_RTS_Build_tag + refFilesToClean <- newIORef [] + refDirsToClean <- newIORef emptyFM return dflags{ wayNames = ways, buildTag = build_tag, - rtsBuildTag = rts_build_tag + rtsBuildTag = rts_build_tag, + filesToClean = refFilesToClean, + dirsToClean = refDirsToClean } -- | The normal 'DynFlags'. Note that they is not suitable for use in this form @@ -550,6 +590,9 @@ defaultDynFlags = specConstrThreshold = Just 200, specConstrCount = Just 3, liberateCaseThreshold = Just 200, +#ifndef OMIT_NATIVE_CODEGEN + targetPlatform = defaultTargetPlatform, +#endif stolen_x86_regs = 4, cmdlineHcIncludes = [], importPaths = ["."], @@ -571,7 +614,7 @@ defaultDynFlags = outputFile = Nothing, outputHi = Nothing, - dynLibLoader = Deployable, + dynLibLoader = SystemDependent, dumpPrefix = Nothing, dumpPrefixForce = Nothing, includePaths = [], @@ -600,6 +643,7 @@ defaultDynFlags = wayNames = panic "defaultDynFlags: No wayNames", buildTag = panic "defaultDynFlags: No buildTag", rtsBuildTag = panic "defaultDynFlags: No rtsBuildTag", + splitInfo = Nothing, -- initSysTools fills all these in ghcUsagePath = panic "defaultDynFlags: No ghciUsagePath", ghciUsagePath = panic "defaultDynFlags: No ghciUsagePath", @@ -624,6 +668,8 @@ defaultDynFlags = depExcludeMods = [], depSuffixes = [], -- end of ghc -M values + filesToClean = panic "defaultDynFlags: No filesToClean", + dirsToClean = panic "defaultDynFlags: No dirsToClean", haddockOptions = Nothing, flags = [ Opt_AutoLinkPackages, @@ -954,8 +1000,8 @@ pprFloatOutSwitches sw = pp_not (floatOutLambdas sw) <+> text "lambdas" <> comma pp_not False = text "not" -- | Switches that specify the minimum amount of floating out -gentleFloatOutSwitches :: FloatOutSwitches -gentleFloatOutSwitches = FloatOutSwitches False False +-- gentleFloatOutSwitches :: FloatOutSwitches +-- gentleFloatOutSwitches = FloatOutSwitches False False -- | Switches that do not specify floating out of lambdas, just of constants constantsOnlyFloatOutSwitches :: FloatOutSwitches @@ -1057,7 +1103,14 @@ getCoreToDo dflags -- so that overloaded functions have all their dictionary lambdas manifest CoreDoSpecialising, - runWhen full_laziness (CoreDoFloatOutwards gentleFloatOutSwitches), + runWhen full_laziness (CoreDoFloatOutwards constantsOnlyFloatOutSwitches), + -- Was: gentleFloatOutSwitches + -- I have no idea why, but not floating constants to top level is + -- very bad in some cases. + -- Notably: p_ident in spectral/rewrite + -- Changing from "gentle" to "constantsOnly" improved + -- rewrite's allocation by 19%, and made 0.0% difference + -- to any other nofib benchmark CoreDoFloatInwards, @@ -1472,6 +1525,38 @@ dynamic_flags = [ (IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n }) Supported + ------ Profiling ---------------------------------------------------- + + -- XXX Should the -f* flags be deprecated? + -- They don't seem to be documented + , Flag "fauto-sccs-on-all-toplevs" + (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs)) + Supported + , Flag "auto-all" + (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs)) + Supported + , Flag "no-auto-all" + (NoArg (unSetDynFlag Opt_AutoSccsOnAllToplevs)) + Supported + , Flag "fauto-sccs-on-exported-toplevs" + (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs)) + Supported + , Flag "auto" + (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs)) + Supported + , Flag "no-auto" + (NoArg (unSetDynFlag Opt_AutoSccsOnExportedToplevs)) + Supported + , Flag "fauto-sccs-on-individual-cafs" + (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs)) + Supported + , Flag "caf-all" + (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs)) + Supported + , Flag "no-caf-all" + (NoArg (unSetDynFlag Opt_AutoSccsOnIndividualCafs)) + Supported + ------ DPH flags ---------------------------------------------------- , Flag "fdph-seq" @@ -1703,6 +1788,7 @@ xFlags = [ ( "UnboxedTuples", Opt_UnboxedTuples, const Supported ), ( "StandaloneDeriving", Opt_StandaloneDeriving, const Supported ), ( "DeriveDataTypeable", Opt_DeriveDataTypeable, const Supported ), + ( "DeriveFunctor", Opt_DeriveFunctor, const Supported ), ( "TypeSynonymInstances", Opt_TypeSynonymInstances, const Supported ), ( "FlexibleContexts", Opt_FlexibleContexts, const Supported ), ( "FlexibleInstances", Opt_FlexibleInstances, const Supported ), @@ -1722,8 +1808,13 @@ impliedFlags = [ (Opt_GADTs, Opt_RelaxedPolyRec) -- We want type-sig variables to -- be completely rigid for GADTs + , (Opt_TypeFamilies, Opt_RelaxedPolyRec) -- Trac #2944 gives a nice example + , (Opt_TypeFamilies, Opt_KindSignatures) -- Type families use kind signatures + -- all over the place + , (Opt_ScopedTypeVariables, Opt_RelaxedPolyRec) -- Ditto for scoped type variables; see -- Note [Scoped tyvars] in TcBinds + , (Opt_ImpredicativeTypes, Opt_RankNTypes) ] glasgowExtsFlags :: [DynFlag] @@ -1738,6 +1829,7 @@ glasgowExtsFlags = [ , Opt_TypeSynonymInstances , Opt_StandaloneDeriving , Opt_DeriveDataTypeable + , Opt_DeriveFunctor , Opt_FlexibleContexts , Opt_FlexibleInstances , Opt_ConstrainedClassMethods @@ -1751,7 +1843,6 @@ glasgowExtsFlags = [ , Opt_PatternGuards , Opt_LiberalTypeSynonyms , Opt_RankNTypes - , Opt_ImpredicativeTypes , Opt_TypeOperators , Opt_RecursiveDo , Opt_ParallelListComp @@ -1950,12 +2041,15 @@ setOptLevel n dflags -- sometimes -- -fdicts-cheap always inline dictionaries -- -fmax-simplifier-iterations20 this is necessary sometimes +-- -fsimplifier-phases=3 we use an additional simplifier phase +-- for fusion -- -fno-spec-constr-threshold run SpecConstr even for big loops -- -fno-spec-constr-count SpecConstr as much as possible -- -finline-enough-args hack to prevent excessive inlining -- setDPHOpt :: DynFlags -> DynFlags setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20 + , simplPhases = 3 , specConstrThreshold = Nothing , specConstrCount = Nothing }) @@ -2164,7 +2258,13 @@ machdepCCOpts _dflags = ( [], ["-fomit-frame-pointer", "-G0"] ) #elif x86_64_TARGET_ARCH - = ( [], ["-fomit-frame-pointer", + = ( +#if darwin_TARGET_OS + ["-m64"], +#else + [], +#endif + ["-fomit-frame-pointer", "-fno-asynchronous-unwind-tables", -- the unwind tables are unnecessary for HC code, -- and get in the way of -split-objs. Another option @@ -2188,6 +2288,8 @@ machdepCCOpts _dflags -- for "normal" programs, but it doesn't support register variable -- declarations. = ( [], ["-no-cpp-precomp"] ) +#elif x86_64_apple_darwin_TARGET + = ( ["-m64"], [] ) #else = ( [], [] ) #endif @@ -2214,7 +2316,7 @@ picCCOpts _dflags | otherwise = [] #else - | opt_PIC + | opt_PIC || not opt_Static = ["-fPIC", "-U __PIC__", "-D__PIC__"] | otherwise = []