Commit 1ba79fa4 authored by tvv's avatar tvv Committed by Ben Gamari

CodeGen: Way to dump cmm only once (#11717)

The `-ddump-cmm` put all stages of Cmm processing into one output.
This patch changes its behavior and adds two more options to make
Cmm dumping flexible.

- `-ddump-cmm-from-stg` dumps only initial version of  Cmm right after
   STG->Cmm codegen
- `-ddump-cmm` dumps the final result of the Cmm pipeline processing
- `-ddump-cmm-verbose` dumps intermediate output of each Cmm pipeline
   step
- `-ddump-cmm-proc` and `-ddump-cmm-caf` seems were lost. Now enabled

Test Plan: ./validate

Reviewers: thomie, simonmar, austin, bgamari

Reviewed By: thomie, simonmar

Subscribers: simonpj, thomie

Differential Revision: https://phabricator.haskell.org/D2393

GHC Trac Issues: #11717
parent 0f0cdb68
......@@ -1394,9 +1394,7 @@ parseCmmFile dflags filename = withTiming (pure dflags) (text "ParseCmm"<+>brack
let ms = getMessages pst dflags
if (errorsFound dflags ms)
then return (ms, Nothing)
else do
dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (ppr cmm)
return (ms, Just cmm)
else return (ms, Just cmm)
where
no_module = panic "parseCmmFile: no module"
}
......@@ -31,7 +31,7 @@ import Platform
-----------------------------------------------------------------------------
cmmPipeline :: HscEnv -- Compilation env including
-- dynamic flags: -dcmm-lint -ddump-cps-cmm
-- dynamic flags: -dcmm-lint -ddump-cmm-cps
-> TopSRT -- SRT table and accumulating list of compiled procs
-> CmmGroup -- Input C-- with Procedures
-> IO (TopSRT, CmmGroup) -- Output CPS transformed C--
......@@ -42,7 +42,7 @@ cmmPipeline hsc_env topSRT prog =
tops <- {-# SCC "tops" #-} mapM (cpsTop hsc_env) prog
(topSRT, cmms) <- {-# SCC "doSRTs" #-} doSRTs dflags topSRT tops
dumpWith dflags Opt_D_dump_cmm_cps "Post CPS Cmm" cmms
dumpWith dflags Opt_D_dump_cmm_cps "Post CPS Cmm" (ppr cmms)
return (topSRT, cmms)
......@@ -83,7 +83,7 @@ cpsTop hsc_env proc =
then do
pp <- {-# SCC "minimalProcPointSet" #-} runUniqSM $
minimalProcPointSet (targetPlatform dflags) call_pps g
dumpIfSet_dyn dflags Opt_D_dump_cmm "Proc points"
dumpWith dflags Opt_D_dump_cmm_proc "Proc points"
(ppr l $$ ppr pp $$ ppr g)
return pp
else
......@@ -104,14 +104,15 @@ cpsTop hsc_env proc =
------------- CAF analysis ----------------------------------------------
let cafEnv = {-# SCC "cafAnal" #-} cafAnal g
dumpIfSet_dyn dflags Opt_D_dump_cmm "CAFEnv" (ppr cafEnv)
dumpWith dflags Opt_D_dump_cmm_caf "CAFEnv" (ppr cafEnv)
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
dumpWith dflags Opt_D_dump_cmm_procmap "procpoint map" $
ppr pp_map
g <- {-# SCC "splitAtProcPoints" #-} runUniqSM $
splitAtProcPoints dflags l call_pps proc_points pp_map
(CmmProc h l v g)
......@@ -142,7 +143,7 @@ cpsTop hsc_env proc =
dump = dumpGraph dflags
dumps flag name
= mapM_ (dumpWith dflags flag name)
= mapM_ (dumpWith dflags flag name . ppr)
condPass flag pass g dumpflag dumpname =
if gopt flag dflags
......@@ -346,7 +347,7 @@ runUniqSM m = do
dumpGraph :: DynFlags -> DumpFlag -> String -> CmmGraph -> IO ()
dumpGraph dflags flag name g = do
when (gopt Opt_DoCmmLinting dflags) $ do_lint g
dumpWith dflags flag name g
dumpWith dflags flag name (ppr g)
where
do_lint g = case cmmLintGraph dflags g of
Just err -> do { fatalErrorMsg dflags err
......@@ -354,11 +355,11 @@ dumpGraph dflags flag name g = do
}
Nothing -> return ()
dumpWith :: Outputable a => DynFlags -> DumpFlag -> String -> a -> IO ()
dumpWith dflags flag txt g = do
dumpWith :: DynFlags -> DumpFlag -> String -> SDoc -> IO ()
dumpWith dflags flag txt sdoc = do
-- ToDo: No easy way of say "dump all the cmm, *and* split
-- them into files." Also, -ddump-cmm doesn't play nicely
-- with -ddump-to-file, since the headers get omitted.
dumpIfSet_dyn dflags flag txt (ppr g)
-- them into files." Also, -ddump-cmm-verbose doesn't play
-- nicely with -ddump-to-file, since the headers get omitted.
dumpIfSet_dyn dflags flag txt sdoc
when (not (dopt flag dflags)) $
dumpIfSet_dyn dflags Opt_D_dump_cmm txt (ppr g)
dumpIfSet_dyn dflags Opt_D_dump_cmm_verbose txt sdoc
......@@ -295,15 +295,19 @@ data DumpFlag
-- debugging flags
= Opt_D_dump_cmm
| Opt_D_dump_cmm_from_stg
| Opt_D_dump_cmm_raw
-- All of the cmm subflags (there are a lot!) Automatically
-- enabled if you run -ddump-cmm
| Opt_D_dump_cmm_verbose
-- All of the cmm subflags (there are a lot!) automatically
-- enabled if you run -ddump-cmm-verbose
-- Each flag corresponds to exact stage of Cmm pipeline.
| Opt_D_dump_cmm_cfg
| Opt_D_dump_cmm_cbe
| Opt_D_dump_cmm_switch
| Opt_D_dump_cmm_proc
| Opt_D_dump_cmm_sink
| Opt_D_dump_cmm_sp
| Opt_D_dump_cmm_sink
| Opt_D_dump_cmm_caf
| Opt_D_dump_cmm_procmap
| Opt_D_dump_cmm_split
| Opt_D_dump_cmm_info
......@@ -2606,8 +2610,12 @@ dynamic_flags_deps = [
, make_ord_flag defGhcFlag "ddump-cmm"
(setDumpFlag Opt_D_dump_cmm)
, make_ord_flag defGhcFlag "ddump-cmm-from-stg"
(setDumpFlag Opt_D_dump_cmm_from_stg)
, make_ord_flag defGhcFlag "ddump-cmm-raw"
(setDumpFlag Opt_D_dump_cmm_raw)
, make_ord_flag defGhcFlag "ddump-cmm-verbose"
(setDumpFlag Opt_D_dump_cmm_verbose)
, make_ord_flag defGhcFlag "ddump-cmm-cfg"
(setDumpFlag Opt_D_dump_cmm_cfg)
, make_ord_flag defGhcFlag "ddump-cmm-cbe"
......@@ -2616,10 +2624,12 @@ dynamic_flags_deps = [
(setDumpFlag Opt_D_dump_cmm_switch)
, make_ord_flag defGhcFlag "ddump-cmm-proc"
(setDumpFlag Opt_D_dump_cmm_proc)
, make_ord_flag defGhcFlag "ddump-cmm-sink"
(setDumpFlag Opt_D_dump_cmm_sink)
, make_ord_flag defGhcFlag "ddump-cmm-sp"
(setDumpFlag Opt_D_dump_cmm_sp)
, make_ord_flag defGhcFlag "ddump-cmm-sink"
(setDumpFlag Opt_D_dump_cmm_sink)
, make_ord_flag defGhcFlag "ddump-cmm-caf"
(setDumpFlag Opt_D_dump_cmm_caf)
, make_ord_flag defGhcFlag "ddump-cmm-procmap"
(setDumpFlag Opt_D_dump_cmm_procmap)
, make_ord_flag defGhcFlag "ddump-cmm-split"
......
......@@ -1337,16 +1337,16 @@ hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do
liftIO $ do
us <- mkSplitUniqSupply 'S'
let initTopSRT = initUs_ us emptySRT
dumpIfSet_dyn dflags Opt_D_dump_cmm "Parsed Cmm" (ppr cmm)
dumpIfSet_dyn dflags Opt_D_dump_cmm_verbose "Parsed Cmm" (ppr cmm)
(_, cmmgroup) <- cmmPipeline hsc_env initTopSRT cmm
rawCmms <- cmmToRawCmm dflags (Stream.yield cmmgroup)
_ <- codeOutput dflags no_mod output_filename no_loc NoStubs [] rawCmms
return ()
where
no_mod = panic "hscCmmFile: no_mod"
no_mod = panic "hscCompileCmmFile: no_mod"
no_loc = ModLocation{ ml_hs_file = Just filename,
ml_hi_file = panic "hscCmmFile: no hi file",
ml_obj_file = panic "hscCmmFile: no obj file" }
ml_hi_file = panic "hscCompileCmmFile: no hi file",
ml_obj_file = panic "hscCompileCmmFile: no obj file" }
-------------------- Stuff for new code gen ---------------------
......@@ -1372,8 +1372,8 @@ doCodeGen hsc_env this_mod data_tycons
-- CmmGroup on input may produce many CmmGroups on output due
-- to proc-point splitting).
let dump1 a = do dumpIfSet_dyn dflags Opt_D_dump_cmm
"Cmm produced by new codegen" (ppr a)
let dump1 a = do dumpIfSet_dyn dflags Opt_D_dump_cmm_from_stg
"Cmm produced by codegen" (ppr a)
return a
ppr_stream1 = Stream.mapM dump1 cmm_stream
......@@ -1406,7 +1406,8 @@ doCodeGen hsc_env this_mod data_tycons
Stream.yield (srtToData topSRT)
let
dump2 a = do dumpIfSet_dyn dflags Opt_D_dump_cmm "Output Cmm" $ ppr a
dump2 a = do dumpIfSet_dyn dflags Opt_D_dump_cmm
"Output Cmm" (ppr a)
return a
ppr_stream2 = Stream.mapM dump2 pipeline_stream
......
......@@ -22,6 +22,17 @@ Language
refer to closed local bindings. For instance, this is now permitted:
``f = static x where x = 'a'``.
Compiler
~~~~~~~~
- TODO FIXME.
- The :ghc-flag:`-ddump-cmm` now dumps the result after C-- pipeline pass. Two
more flags were added: :ghc-flag:`-ddump-cmm-from-stg` to allow to get the
initial cmm from STG-to-C-- code generation and :ghc-flag:`-ddump-cmm-verbose`
to obtain the intermediates from all C-- pipeline stages.
TODO FIXME Heading title
~~~~~~~~~~~~~~~~~~~~~~~~
......
......@@ -131,7 +131,17 @@ Dumping out compiler intermediate structures
.. ghc-flag:: -ddump-cmm
Print the C-- code out.
Dump the result of the C-- pipeline processing
.. ghc-flag:: -ddump-cmm-from-stg
Dump the result of STG-to-C-- conversion
.. ghc-flag:: -ddump-cmm-verbose
Dump output from all C-- pipeline stages. In case of
``.cmm`` compilation this also dumps the result of
file parsing.
.. ghc-flag:: -ddump-opt-cmm
......
......@@ -9,13 +9,13 @@ debug:
# Without optimisations, we should get annotations for basically
# all expressions in the example program.
echo == Dbg ==
'$(TEST_HC)' $(TEST_HC_OPTS) debug -fforce-recomp -g -dppr-ticks -ddump-cmm \
'$(TEST_HC)' $(TEST_HC_OPTS) debug -fforce-recomp -g -dppr-ticks -ddump-cmm-verbose \
| grep -o src\<debug.hs:.*\> | sort -u
./debug
# With optimisations we will get fewer annotations.
echo == Dbg -O2 ==
'$(TEST_HC)' $(TEST_HC_OPTS) debug -fforce-recomp -g -dppr-ticks -ddump-cmm -O2 \
'$(TEST_HC)' $(TEST_HC_OPTS) debug -fforce-recomp -g -dppr-ticks -ddump-cmm-verbose -O2 \
> debug.cmm
cat debug.cmm | grep -o src\<debug.hs:.*\> | sort -u
......
......@@ -20,8 +20,16 @@ compilerDebuggingOptions =
, flagDescription = "Dump interpreter byte code"
, flagType = DynamicFlag
}
, flag { flagName = "-ddump-cmm-from-stg"
, flagDescription = "Dump STG-to-C-- output"
, flagType = DynamicFlag
}
, flag { flagName = "-ddump-cmm-verbose"
, flagDescription = "Show output from each C-- pipeline pass"
, flagType = DynamicFlag
}
, flag { flagName = "-ddump-cmm"
, flagDescription = "Dump C-- output"
, flagDescription = "Dump the final C-- output"
, flagType = DynamicFlag
}
, flag { flagName = "-ddump-core-stats"
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment