diff options
| -rw-r--r-- | compiler/cmm/CmmParse.y | 4 | ||||
| -rw-r--r-- | compiler/cmm/CmmPipeline.hs | 27 | ||||
| -rw-r--r-- | compiler/main/DynFlags.hs | 20 | ||||
| -rw-r--r-- | compiler/main/HscMain.hs | 15 | ||||
| -rw-r--r-- | docs/users_guide/8.0.2-notes.rst | 11 | ||||
| -rw-r--r-- | docs/users_guide/debugging.rst | 12 | ||||
| -rw-r--r-- | testsuite/tests/codeGen/should_compile/Makefile | 4 | ||||
| -rw-r--r-- | utils/mkUserGuidePart/Options/CompilerDebugging.hs | 10 |
8 files changed, 71 insertions, 32 deletions
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index e07e0a65c8..6b326b8bfb 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -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" } diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs index 37dbd12525..b19e4180f8 100644 --- a/compiler/cmm/CmmPipeline.hs +++ b/compiler/cmm/CmmPipeline.hs @@ -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 diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 24746d6836..dc29176ddf 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -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" diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 9c510df27b..bd7f8c9cde 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -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 diff --git a/docs/users_guide/8.0.2-notes.rst b/docs/users_guide/8.0.2-notes.rst index 1972e6ded0..d5d442f59b 100644 --- a/docs/users_guide/8.0.2-notes.rst +++ b/docs/users_guide/8.0.2-notes.rst @@ -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 ~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst index a865f0afb2..d414408a02 100644 --- a/docs/users_guide/debugging.rst +++ b/docs/users_guide/debugging.rst @@ -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 diff --git a/testsuite/tests/codeGen/should_compile/Makefile b/testsuite/tests/codeGen/should_compile/Makefile index 412c9029c9..fda9c9490e 100644 --- a/testsuite/tests/codeGen/should_compile/Makefile +++ b/testsuite/tests/codeGen/should_compile/Makefile @@ -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 diff --git a/utils/mkUserGuidePart/Options/CompilerDebugging.hs b/utils/mkUserGuidePart/Options/CompilerDebugging.hs index ce84a2a48b..c886156d80 100644 --- a/utils/mkUserGuidePart/Options/CompilerDebugging.hs +++ b/utils/mkUserGuidePart/Options/CompilerDebugging.hs @@ -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" |