diff options
Diffstat (limited to 'compiler/GHC/Cmm/Pipeline.hs')
| -rw-r--r-- | compiler/GHC/Cmm/Pipeline.hs | 176 |
1 files changed, 88 insertions, 88 deletions
diff --git a/compiler/GHC/Cmm/Pipeline.hs b/compiler/GHC/Cmm/Pipeline.hs index d408402e27..59dc19ba80 100644 --- a/compiler/GHC/Cmm/Pipeline.hs +++ b/compiler/GHC/Cmm/Pipeline.hs @@ -62,95 +62,95 @@ cpsTop :: DynFlags -> CmmDecl -> IO (Either (CAFEnv, [CmmDecl]) (CAFSet, CmmDecl cpsTop dflags p@(CmmData _ statics) = return (Right (cafAnalData (targetPlatform dflags) statics, p)) cpsTop dflags proc = do - ----------- Control-flow optimisations ---------------------------------- - - -- The first round of control-flow optimisation speeds up the - -- later passes by removing lots of empty blocks, so we do it - -- even when optimisation isn't turned on. - -- - CmmProc h l v g <- {-# SCC "cmmCfgOpts(1)" #-} - return $ cmmCfgOptsProc splitting_proc_points proc - dump Opt_D_dump_cmm_cfg "Post control-flow optimisations" g - - let !TopInfo {stack_info=StackInfo { arg_space = entry_off - , do_layout = do_layout }} = h - - ----------- Eliminate common blocks ------------------------------------- - g <- {-# SCC "elimCommonBlocks" #-} - condPass Opt_CmmElimCommonBlocks elimCommonBlocks g - Opt_D_dump_cmm_cbe "Post common block elimination" - - -- Any work storing block Labels must be performed _after_ - -- elimCommonBlocks - - ----------- Implement switches ------------------------------------------ - g <- {-# SCC "createSwitchPlans" #-} - runUniqSM $ cmmImplementSwitchPlans (backend dflags) platform g - dump Opt_D_dump_cmm_switch "Post switch plan" g - - ----------- Proc points ------------------------------------------------- - let - call_pps :: ProcPointSet -- LabelMap - call_pps = {-# SCC "callProcPoints" #-} callProcPoints g - proc_points <- - if splitting_proc_points - then do - pp <- {-# SCC "minimalProcPointSet" #-} runUniqSM $ - minimalProcPointSet platform call_pps g - dumpWith dflags Opt_D_dump_cmm_proc "Proc points" - FormatCMM (pdoc platform l $$ ppr pp $$ pdoc platform g) - return pp - else - return call_pps - - ----------- Layout the stack and manifest Sp ---------------------------- - (g, stackmaps) <- - {-# SCC "layoutStack" #-} - if do_layout - then runUniqSM $ cmmLayoutStack dflags proc_points entry_off g - else return (g, mapEmpty) - dump Opt_D_dump_cmm_sp "Layout Stack" g - - ----------- Sink and inline assignments -------------------------------- - g <- {-# SCC "sink" #-} -- See Note [Sinking after stack layout] - condPass Opt_CmmSink (cmmSink platform) g - Opt_D_dump_cmm_sink "Sink assignments" - - ------------- CAF analysis ---------------------------------------------- - let cafEnv = {-# SCC "cafAnal" #-} cafAnal platform call_pps l g - dumpWith dflags Opt_D_dump_cmm_caf "CAFEnv" FormatText (pdoc platform cafEnv) - - g <- if splitting_proc_points + ----------- Control-flow optimisations ---------------------------------- + + -- The first round of control-flow optimisation speeds up the + -- later passes by removing lots of empty blocks, so we do it + -- even when optimisation isn't turned on. + -- + CmmProc h l v g <- {-# SCC "cmmCfgOpts(1)" #-} + return $ cmmCfgOptsProc splitting_proc_points proc + dump Opt_D_dump_cmm_cfg "Post control-flow optimisations" g + + let !TopInfo {stack_info=StackInfo { arg_space = entry_off + , do_layout = do_layout }} = h + + ----------- Eliminate common blocks ------------------------------------- + g <- {-# SCC "elimCommonBlocks" #-} + condPass Opt_CmmElimCommonBlocks elimCommonBlocks g + Opt_D_dump_cmm_cbe "Post common block elimination" + + -- Any work storing block Labels must be performed _after_ + -- elimCommonBlocks + + ----------- Implement switches ------------------------------------------ + g <- {-# SCC "createSwitchPlans" #-} + runUniqSM $ cmmImplementSwitchPlans (backend dflags) platform g + dump Opt_D_dump_cmm_switch "Post switch plan" g + + ----------- Proc points ------------------------------------------------- + let + call_pps :: ProcPointSet -- LabelMap + call_pps = {-# SCC "callProcPoints" #-} callProcPoints g + proc_points <- + if splitting_proc_points then do - ------------- Split into separate procedures ----------------------- - let pp_map = {-# SCC "procPointAnalysis" #-} - procPointAnalysis proc_points g - dumpWith dflags Opt_D_dump_cmm_procmap "procpoint map" - FormatCMM (ppr pp_map) - g <- {-# SCC "splitAtProcPoints" #-} runUniqSM $ - splitAtProcPoints platform l call_pps proc_points pp_map - (CmmProc h l v g) - dumps Opt_D_dump_cmm_split "Post splitting" g - return g - else do - -- attach info tables to return points - return $ [attachContInfoTables call_pps (CmmProc h l v g)] - - ------------- Populate info tables with stack info ----------------- - g <- {-# SCC "setInfoTableStackMap" #-} - return $ map (setInfoTableStackMap platform stackmaps) g - dumps Opt_D_dump_cmm_info "after setInfoTableStackMap" g - - ----------- Control-flow optimisations ----------------------------- - g <- {-# SCC "cmmCfgOpts(2)" #-} - return $ if optLevel dflags >= 1 - then map (cmmCfgOptsProc splitting_proc_points) g - else g - g <- return (map removeUnreachableBlocksProc g) - -- See Note [unreachable blocks] - dumps Opt_D_dump_cmm_cfg "Post control-flow optimisations" g - - return (Left (cafEnv, g)) + pp <- {-# SCC "minimalProcPointSet" #-} runUniqSM $ + minimalProcPointSet platform call_pps g + dumpWith dflags Opt_D_dump_cmm_proc "Proc points" + FormatCMM (pdoc platform l $$ ppr pp $$ pdoc platform g) + return pp + else + return call_pps + + ----------- Layout the stack and manifest Sp ---------------------------- + (g, stackmaps) <- + {-# SCC "layoutStack" #-} + if do_layout + then runUniqSM $ cmmLayoutStack dflags proc_points entry_off g + else return (g, mapEmpty) + dump Opt_D_dump_cmm_sp "Layout Stack" g + + ----------- Sink and inline assignments -------------------------------- + g <- {-# SCC "sink" #-} -- See Note [Sinking after stack layout] + condPass Opt_CmmSink (cmmSink platform) g + Opt_D_dump_cmm_sink "Sink assignments" + + ------------- CAF analysis ---------------------------------------------- + let cafEnv = {-# SCC "cafAnal" #-} cafAnal platform call_pps l g + dumpWith dflags Opt_D_dump_cmm_caf "CAFEnv" FormatText (pdoc platform cafEnv) + + g <- if splitting_proc_points + then do + ------------- Split into separate procedures ----------------------- + let pp_map = {-# SCC "procPointAnalysis" #-} + procPointAnalysis proc_points g + dumpWith dflags Opt_D_dump_cmm_procmap "procpoint map" + FormatCMM (ppr pp_map) + g <- {-# SCC "splitAtProcPoints" #-} runUniqSM $ + splitAtProcPoints platform l call_pps proc_points pp_map + (CmmProc h l v g) + dumps Opt_D_dump_cmm_split "Post splitting" g + return g + else + -- attach info tables to return points + return $ [attachContInfoTables call_pps (CmmProc h l v g)] + + ------------- Populate info tables with stack info ----------------- + g <- {-# SCC "setInfoTableStackMap" #-} + return $ map (setInfoTableStackMap platform stackmaps) g + dumps Opt_D_dump_cmm_info "after setInfoTableStackMap" g + + ----------- Control-flow optimisations ----------------------------- + g <- {-# SCC "cmmCfgOpts(2)" #-} + return $ if optLevel dflags >= 1 + then map (cmmCfgOptsProc splitting_proc_points) g + else g + g <- return (map removeUnreachableBlocksProc g) + -- See Note [unreachable blocks] + dumps Opt_D_dump_cmm_cfg "Post control-flow optimisations" g + + return (Left (cafEnv, g)) where platform = targetPlatform dflags dump = dumpGraph dflags |