summaryrefslogtreecommitdiff
path: root/compiler/cmm/CmmPipeline.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/cmm/CmmPipeline.hs')
-rw-r--r--compiler/cmm/CmmPipeline.hs9
1 files changed, 5 insertions, 4 deletions
diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs
index b3b4af712d..76927266ad 100644
--- a/compiler/cmm/CmmPipeline.hs
+++ b/compiler/cmm/CmmPipeline.hs
@@ -43,7 +43,7 @@ cmmPipeline hsc_env topSRT prog =
tops <- {-# SCC "tops" #-} mapM (cpsTop hsc_env) prog
- (topSRT, cmms) <- {-# SCC "toTops" #-} doSRTs topSRT tops
+ (topSRT, cmms) <- {-# SCC "doSRTs" #-} doSRTs dflags topSRT tops
dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (ppr cmms)
return (topSRT, cmms)
@@ -105,6 +105,7 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
------------- CAF analysis ----------------------------------------------
let cafEnv = {-# SCC "cafAnal" #-} cafAnal g
+ dumpIfSet_dyn dflags Opt_D_dump_cmmz "CAFEnv" (ppr cafEnv)
if splitting_proc_points
then do
@@ -118,7 +119,7 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
------------- Populate info tables with stack info -----------------
gs <- {-# SCC "setInfoTableStackMap" #-}
- return $ map (setInfoTableStackMap stackmaps) gs
+ return $ map (setInfoTableStackMap dflags stackmaps) gs
dumps Opt_D_dump_cmmz_info "after setInfoTableStackMap" gs
----------- Control-flow optimisations -----------------------------
@@ -136,7 +137,7 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
------------- Populate info tables with stack info -----------------
g <- {-# SCC "setInfoTableStackMap" #-}
- return $ setInfoTableStackMap stackmaps g
+ return $ setInfoTableStackMap dflags stackmaps g
dump' Opt_D_dump_cmmz_info "after setInfoTableStackMap" g
----------- Control-flow optimisations -----------------------------
@@ -182,7 +183,7 @@ dumpGraph dflags flag name g = do
when (dopt Opt_DoCmmLinting dflags) $ do_lint g
dumpWith dflags flag name g
where
- do_lint g = case cmmLintGraph g of
+ do_lint g = case cmmLintGraph dflags g of
Just err -> do { fatalErrorMsg dflags err
; ghcExit dflags 1
}