Skip to content
Snippets Groups Projects
Commit dba9bf67 authored by Jan Stolarek's avatar Jan Stolarek
Browse files

Eliminate duplicate code in Cmm pipeline

End of Cmm pipeline used to be split into two alternative flows,
depending on whether we did proc-point splitting or not. There
was a lot of code duplication between these two branches. But it
wasn't really necessary as the differences can be easily enclosed
within an if-then-else. I observed no impact of this change on
compilation performance.
parent 526cbc7a
No related branches found
No related tags found
No related merge requests found
...@@ -84,10 +84,6 @@ cpsTop hsc_env proc = ...@@ -84,10 +84,6 @@ cpsTop hsc_env proc =
else else
return call_pps 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 ---------------------------- ----------- Layout the stack and manifest Sp ----------------------------
(g, stackmaps) <- (g, stackmaps) <-
{-# SCC "layoutStack" #-} {-# SCC "layoutStack" #-}
...@@ -105,57 +101,40 @@ cpsTop hsc_env proc = ...@@ -105,57 +101,40 @@ cpsTop hsc_env proc =
let cafEnv = {-# SCC "cafAnal" #-} cafAnal g let cafEnv = {-# SCC "cafAnal" #-} cafAnal g
dumpIfSet_dyn dflags Opt_D_dump_cmm "CAFEnv" (ppr cafEnv) dumpIfSet_dyn dflags Opt_D_dump_cmm "CAFEnv" (ppr cafEnv)
if splitting_proc_points g <- if splitting_proc_points
then do then do
------------- Split into separate procedures ----------------------- ------------- Split into separate procedures -----------------------
pp_map <- {-# SCC "procPointAnalysis" #-} runUniqSM $ pp_map <- {-# SCC "procPointAnalysis" #-} runUniqSM $
procPointAnalysis proc_points g procPointAnalysis proc_points g
dumpWith dflags Opt_D_dump_cmm_procmap "procpoint map" pp_map dumpWith dflags Opt_D_dump_cmm_procmap "procpoint map" pp_map
gs <- {-# SCC "splitAtProcPoints" #-} runUniqSM $ g <- {-# SCC "splitAtProcPoints" #-} runUniqSM $
splitAtProcPoints dflags l call_pps proc_points pp_map splitAtProcPoints dflags l call_pps proc_points pp_map
(CmmProc h l v g) (CmmProc h l v g)
dumps Opt_D_dump_cmm_split "Post splitting" gs dumps Opt_D_dump_cmm_split "Post splitting" g
return g
------------- Populate info tables with stack info ----------------- else do
gs <- {-# SCC "setInfoTableStackMap" #-} -- attach info tables to return points
return $ map (setInfoTableStackMap dflags stackmaps) gs return $ [attachContInfoTables call_pps (CmmProc h l v g)]
dumps Opt_D_dump_cmm_info "after setInfoTableStackMap" gs
------------- Populate info tables with stack info -----------------
----------- Control-flow optimisations ----------------------------- g <- {-# SCC "setInfoTableStackMap" #-}
gs <- {-# SCC "cmmCfgOpts(2)" #-} return $ map (setInfoTableStackMap dflags stackmaps) g
return $ if optLevel dflags >= 1 dumps Opt_D_dump_cmm_info "after setInfoTableStackMap" g
then map (cmmCfgOptsProc splitting_proc_points) gs
else gs ----------- Control-flow optimisations -----------------------------
gs <- return (map removeUnreachableBlocksProc gs) g <- {-# SCC "cmmCfgOpts(2)" #-}
-- Note [unreachable blocks] return $ if optLevel dflags >= 1
dumps Opt_D_dump_cmm_cfg "Post control-flow optimisations" gs then map (cmmCfgOptsProc splitting_proc_points) g
else g
return (cafEnv, gs) g <- return (map removeUnreachableBlocksProc g)
-- See Note [unreachable blocks]
else do dumps Opt_D_dump_cmm_cfg "Post control-flow optimisations" g
-- attach info tables to return points
g <- return $ attachContInfoTables call_pps (CmmProc h l v g) return (cafEnv, 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])
where dflags = hsc_dflags hsc_env where dflags = hsc_dflags hsc_env
platform = targetPlatform dflags platform = targetPlatform dflags
dump = dumpGraph dflags dump = dumpGraph dflags
dump' = dumpWith dflags
dumps flag name dumps flag name
= mapM_ (dumpWith dflags flag name) = mapM_ (dumpWith dflags flag name)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment