diff options
| -rw-r--r-- | compiler/cmm/CmmPipeline.hs | 81 |
1 files changed, 30 insertions, 51 deletions
diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs index 98b398f7cc..1447f6d8cd 100644 --- a/compiler/cmm/CmmPipeline.hs +++ b/compiler/cmm/CmmPipeline.hs @@ -84,10 +84,6 @@ cpsTop hsc_env proc = else return call_pps - let noncall_pps = proc_points `setDifference` call_pps - when (not (setNull noncall_pps) && dopt Opt_D_dump_cmm dflags) $ - pprTrace "Non-call proc points: " (ppr noncall_pps) $ return () - ----------- Layout the stack and manifest Sp ---------------------------- (g, stackmaps) <- {-# SCC "layoutStack" #-} @@ -105,57 +101,40 @@ cpsTop hsc_env proc = let cafEnv = {-# SCC "cafAnal" #-} cafAnal g dumpIfSet_dyn dflags Opt_D_dump_cmm "CAFEnv" (ppr cafEnv) - if splitting_proc_points - then do - ------------- Split into separate procedures ----------------------- - pp_map <- {-# SCC "procPointAnalysis" #-} runUniqSM $ - procPointAnalysis proc_points g - dumpWith dflags Opt_D_dump_cmm_procmap "procpoint map" pp_map - gs <- {-# SCC "splitAtProcPoints" #-} runUniqSM $ - splitAtProcPoints dflags l call_pps proc_points pp_map - (CmmProc h l v g) - dumps Opt_D_dump_cmm_split "Post splitting" gs - - ------------- Populate info tables with stack info ----------------- - gs <- {-# SCC "setInfoTableStackMap" #-} - return $ map (setInfoTableStackMap dflags stackmaps) gs - dumps Opt_D_dump_cmm_info "after setInfoTableStackMap" gs - - ----------- Control-flow optimisations ----------------------------- - gs <- {-# SCC "cmmCfgOpts(2)" #-} - return $ if optLevel dflags >= 1 - then map (cmmCfgOptsProc splitting_proc_points) gs - else gs - gs <- return (map removeUnreachableBlocksProc gs) - -- Note [unreachable blocks] - dumps Opt_D_dump_cmm_cfg "Post control-flow optimisations" gs - - return (cafEnv, gs) - - else do - -- attach info tables to return points - g <- return $ attachContInfoTables call_pps (CmmProc h l v g) - - ------------- Populate info tables with stack info ----------------- - g <- {-# SCC "setInfoTableStackMap" #-} - return $ setInfoTableStackMap dflags stackmaps g - dump' Opt_D_dump_cmm_info "after setInfoTableStackMap" g - - ----------- Control-flow optimisations ----------------------------- - g <- {-# SCC "cmmCfgOpts(2)" #-} - return $ if optLevel dflags >= 1 - then cmmCfgOptsProc splitting_proc_points g - else g - g <- return (removeUnreachableBlocksProc g) - -- Note [unreachable blocks] - dump' Opt_D_dump_cmm_cfg "Post control-flow optimisations" g - - return (cafEnv, [g]) + g <- if splitting_proc_points + then do + ------------- Split into separate procedures ----------------------- + pp_map <- {-# SCC "procPointAnalysis" #-} runUniqSM $ + procPointAnalysis proc_points g + dumpWith dflags Opt_D_dump_cmm_procmap "procpoint map" pp_map + g <- {-# SCC "splitAtProcPoints" #-} runUniqSM $ + splitAtProcPoints dflags 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 dflags 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 (cafEnv, g) where dflags = hsc_dflags hsc_env platform = targetPlatform dflags dump = dumpGraph dflags - dump' = dumpWith dflags dumps flag name = mapM_ (dumpWith dflags flag name) |