diff options
author | David Terei <davidterei@gmail.com> | 2012-01-12 15:43:12 -0800 |
---|---|---|
committer | David Terei <davidterei@gmail.com> | 2012-01-12 16:42:07 -0800 |
commit | 4ef5ce6f463ae1ffc6afc1f50a99ecf226bcbf1b (patch) | |
tree | c7396dd00c768ada5dbe14beaca3a4786ce0453d | |
parent | 167d2d42f02e4e2a7bbbe02f584b289d6a39ee37 (diff) | |
download | haskell-4ef5ce6f463ae1ffc6afc1f50a99ecf226bcbf1b.tar.gz |
Add '-freg-liveness' flag to control if STG liveness information
is used for optimisation. (enabled by default)
-rw-r--r-- | compiler/llvmGen/LlvmCodeGen.hs | 2 | ||||
-rw-r--r-- | compiler/llvmGen/LlvmCodeGen/Base.hs | 16 | ||||
-rw-r--r-- | compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 27 | ||||
-rw-r--r-- | compiler/main/DynFlags.hs | 3 | ||||
-rw-r--r-- | docs/users_guide/flags.xml | 17 |
5 files changed, 48 insertions, 17 deletions
diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs index f239ee50cf..00f4292f63 100644 --- a/compiler/llvmGen/LlvmCodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen.hs @@ -37,7 +37,7 @@ llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmmGroup] -> IO () llvmCodeGen dflags h us cmms = let cmm = concat cmms (cdata,env) = {-# SCC "llvm_split" #-} - foldr split ([],initLlvmEnv (targetPlatform dflags)) cmm + foldr split ([], initLlvmEnv dflags) cmm split (CmmData s d' ) (d,e) = ((s,d'):d,e) split (CmmProc i l _) (d,e) = let lbl = strCLabel_llvm env $ case i of diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs index a896cdd482..9bdb115505 100644 --- a/compiler/llvmGen/LlvmCodeGen/Base.hs +++ b/compiler/llvmGen/LlvmCodeGen/Base.hs @@ -13,7 +13,7 @@ module LlvmCodeGen.Base ( LlvmEnv, initLlvmEnv, clearVars, varLookup, varInsert, funLookup, funInsert, getLlvmVer, setLlvmVer, getLlvmPlatform, - ghcInternalFunctions, + getDflags, ghcInternalFunctions, cmmToLlvmType, widthToLlvmFloat, widthToLlvmInt, llvmFunTy, llvmFunSig, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign, @@ -32,6 +32,7 @@ import CLabel import CgUtils ( activeStgRegs ) import Config import Constants +import DynFlags import FastString import OldCmm import qualified Outputable as Outp @@ -150,12 +151,13 @@ defaultLlvmVersion = 28 -- -- two maps, one for functions and one for local vars. -newtype LlvmEnv = LlvmEnv (LlvmEnvMap, LlvmEnvMap, LlvmVersion, Platform) +newtype LlvmEnv = LlvmEnv (LlvmEnvMap, LlvmEnvMap, LlvmVersion, DynFlags) + type LlvmEnvMap = UniqFM LlvmType -- | Get initial Llvm environment. -initLlvmEnv :: Platform -> LlvmEnv -initLlvmEnv platform = LlvmEnv (initFuncs, emptyUFM, defaultLlvmVersion, platform) +initLlvmEnv :: DynFlags -> LlvmEnv +initLlvmEnv dflags = LlvmEnv (initFuncs, emptyUFM, defaultLlvmVersion, dflags) where initFuncs = listToUFM $ [ (n, LMFunction ty) | (n, ty) <- ghcInternalFunctions ] -- | Here we pre-initialise some functions that are used internally by GHC @@ -211,7 +213,11 @@ setLlvmVer n (LlvmEnv (e1, e2, _, p)) = LlvmEnv (e1, e2, n, p) -- | Get the platform we are generating code for getLlvmPlatform :: LlvmEnv -> Platform -getLlvmPlatform (LlvmEnv (_, _, _, p)) = p +getLlvmPlatform (LlvmEnv (_, _, _, d)) = targetPlatform d + +-- | Get the DynFlags for this compilation pass +getDflags :: LlvmEnv -> DynFlags +getDflags (LlvmEnv (_, _, _, d)) = d -- ---------------------------------------------------------------------------- -- * Label handling diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index ee4a29b64a..d5037828c7 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -16,13 +16,14 @@ import CgUtils ( activeStgRegs, callerSaves ) import CLabel import OldCmm import qualified OldPprCmm as PprCmm -import OrdList +import DynFlags import FastString import ForeignCall import Outputable hiding ( panic, pprPanic ) import qualified Outputable import Platform +import OrdList import UniqSupply import Unique import Util @@ -475,7 +476,7 @@ genJump :: LlvmEnv -> CmmExpr -> Maybe [GlobalReg] -> UniqSM StmtData -- Call to known function genJump env (CmmLit (CmmLabel lbl)) live = do (env', vf, stmts, top) <- getHsFunc env lbl - (stgRegs, stgStmts) <- funEpilogue live + (stgRegs, stgStmts) <- funEpilogue env live let s1 = Expr $ Call TailCall vf stgRegs llvmStdFunAttrs let s2 = Return Nothing return (env', stmts `appOL` stgStmts `snocOL` s1 `snocOL` s2, top) @@ -494,7 +495,7 @@ genJump env expr live = do ++ show (ty) ++ ")" (v1, s1) <- doExpr (pLift fty) $ Cast cast vf (pLift fty) - (stgRegs, stgStmts) <- funEpilogue live + (stgRegs, stgStmts) <- funEpilogue env live let s2 = Expr $ Call TailCall v1 stgRegs llvmStdFunAttrs let s3 = Return Nothing return (env', stmts `snocOL` s1 `appOL` stgStmts `snocOL` s2 `snocOL` s3, @@ -1200,29 +1201,33 @@ funPrologue = concat $ map getReg activeStgRegs -- | Function epilogue. Load STG variables to use as argument for call. -funEpilogue :: Maybe [GlobalReg] -> UniqSM ([LlvmVar], LlvmStatements) -funEpilogue Nothing = do +-- STG Liveness optimisation done here. +funEpilogue :: LlvmEnv -> Maybe [GlobalReg] -> UniqSM ([LlvmVar], LlvmStatements) + +-- Have information and liveness optimisation is enabled +funEpilogue env (Just live) | dopt Opt_RegLiveness (getDflags env) = do loads <- mapM loadExpr activeStgRegs let (vars, stmts) = unzip loads return (vars, concatOL stmts) where - loadExpr r = do + loadExpr r | r `elem` alwaysLive || r `elem` live = do let reg = lmGlobalRegVar r (v,s) <- doExpr (pLower $ getVarType reg) $ Load reg return (v, unitOL s) + loadExpr r = do + let ty = (pLower . getVarType $ lmGlobalRegVar r) + return (LMLitVar $ LMUndefLit ty, unitOL Nop) -funEpilogue (Just live) = do +-- don't do liveness optimisation +funEpilogue _ _ = do loads <- mapM loadExpr activeStgRegs let (vars, stmts) = unzip loads return (vars, concatOL stmts) where - loadExpr r | r `elem` alwaysLive || r `elem` live = do + loadExpr r = do let reg = lmGlobalRegVar r (v,s) <- doExpr (pLower $ getVarType reg) $ Load reg return (v, unitOL s) - loadExpr r = do - let ty = (pLower . getVarType $ lmGlobalRegVar r) - return (LMLitVar $ LMUndefLit ty, unitOL Nop) -- | A serries of statements to trash all the STG registers. diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 47134bb7de..fb2e4e58e7 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -251,6 +251,7 @@ data DynFlag | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation | Opt_PedanticBottoms -- Be picky about how we treat bottom | Opt_LlvmTBAA -- Use LLVM TBAA infastructure for improving AA + | Opt_RegLiveness -- Use the STG Reg liveness information -- Interface files | Opt_IgnoreInterfacePragmas @@ -1825,6 +1826,7 @@ fFlags = [ ( "regs-graph", Opt_RegsGraph, nop ), ( "regs-iterative", Opt_RegsIterative, nop ), ( "llvm-tbaa", Opt_LlvmTBAA, nop), + ( "reg-liveness", Opt_RegLiveness, nop), ( "gen-manifest", Opt_GenManifest, nop ), ( "embed-manifest", Opt_EmbedManifest, nop ), ( "ext-core", Opt_EmitExternalCore, nop ), @@ -2074,6 +2076,7 @@ optLevelFlags , ([2], Opt_SpecConstr) , ([2], Opt_RegsGraph) , ([0,1,2], Opt_LlvmTBAA) + , ([0,1,2], Opt_RegLiveness) -- , ([2], Opt_StaticArgumentTransformation) -- Max writes: I think it's probably best not to enable SAT with -O2 for the diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index 10679576ef..8e599c26ae 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -1608,6 +1608,23 @@ </row> <row> + <entry><option>-freg-liveness</option></entry> + <entry>Track STG register liveness to avoid saving and restoring + dead registers, as well as freeing the dead ones for use in + intermediate code. (LLVM backend only). + + Traditionally GHC has reserved a set of machine registers for the + exclusive use of storing a stack pointer, heap pointer and + general purpose function argument registers (these are the so + called STG registers). This optimisation tracks the liveness of + the machine registers the STG registers are mapped to so that the + machine register can be used for other purposes when the STG + register are dead.</entry> + <entry>dynamic</entry> + <entry><option>-fno-reg-liveness</option></entry> + </row> + + <row> <entry><option>-fsimplifier-phases</option></entry> <entry>Set the number of phases for the simplifier (default 2). Ignored with <option>-O0</option>.</entry> |