diff options
Diffstat (limited to 'compiler/GHC/Driver')
| -rw-r--r-- | compiler/GHC/Driver/CodeOutput.hs | 13 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Main.hs | 18 |
2 files changed, 17 insertions, 14 deletions
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs index 841fa79d33..0e43b64c77 100644 --- a/compiler/GHC/Driver/CodeOutput.hs +++ b/compiler/GHC/Driver/CodeOutput.hs @@ -16,6 +16,7 @@ where #include "HsVersions.h" import GHC.Prelude +import GHC.Platform import GHC.CmmToAsm ( nativeCodeGen ) import GHC.CmmToLlvm ( llvmCodeGen ) @@ -260,8 +261,8 @@ outputForeignStubs_help fname doc_str header footer -- module; -- | Generate code to initialise cost centres -profilingInitCode :: Module -> CollectedCCs -> SDoc -profilingInitCode this_mod (local_CCs, singleton_CCSs) +profilingInitCode :: Platform -> Module -> CollectedCCs -> SDoc +profilingInitCode platform this_mod (local_CCs, singleton_CCSs) = vcat $ map emit_cc_decl local_CCs ++ map emit_ccs_decl singleton_CCSs @@ -278,22 +279,22 @@ profilingInitCode this_mod (local_CCs, singleton_CCSs) where emit_cc_decl cc = text "extern CostCentre" <+> cc_lbl <> text "[];" - where cc_lbl = ppr (mkCCLabel cc) + where cc_lbl = pdoc platform (mkCCLabel cc) local_cc_list_label = text "local_cc_" <> ppr this_mod emit_cc_list ccs = text "static CostCentre *" <> local_cc_list_label <> text "[] =" - <+> braces (vcat $ [ ppr (mkCCLabel cc) <> comma + <+> braces (vcat $ [ pdoc platform (mkCCLabel cc) <> comma | cc <- ccs ] ++ [text "NULL"]) <> semi emit_ccs_decl ccs = text "extern CostCentreStack" <+> ccs_lbl <> text "[];" - where ccs_lbl = ppr (mkCCSLabel ccs) + where ccs_lbl = pdoc platform (mkCCSLabel ccs) singleton_cc_list_label = text "singleton_cc_" <> ppr this_mod emit_ccs_list ccs = text "static CostCentreStack *" <> singleton_cc_list_label <> text "[] =" - <+> braces (vcat $ [ ppr (mkCCSLabel cc) <> comma + <+> braces (vcat $ [ pdoc platform (mkCCSLabel cc) <> comma | cc <- ccs ] ++ [text "NULL"]) <> semi diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index 90a07d7490..44babeec18 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/compiler/GHC/Driver/Main.hs @@ -1417,10 +1417,10 @@ hscGenHardCode hsc_env cgguts location output_filename = do <- {-# SCC "CoreToStg" #-} myCoreToStg dflags this_mod prepd_binds - let cost_centre_info = - (S.toList local_ccs ++ caf_ccs, caf_cc_stacks) + let cost_centre_info = (S.toList local_ccs ++ caf_ccs, caf_cc_stacks) + platform = targetPlatform dflags prof_init - | sccProfilingEnabled dflags = profilingInitCode this_mod cost_centre_info + | sccProfilingEnabled dflags = profilingInitCode platform this_mod cost_centre_info | otherwise = empty foreign_stubs = foreign_stubs0 `appendStubC` prof_init @@ -1446,7 +1446,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do let dump a = do unless (null a) $ - dumpIfSet_dyn dflags Opt_D_dump_cmm_raw "Raw Cmm" FormatCMM (ppr a) + dumpIfSet_dyn dflags Opt_D_dump_cmm_raw "Raw Cmm" FormatCMM (pdoc platform a) return a rawcmms1 = Stream.mapM dump rawcmms0 @@ -1494,9 +1494,10 @@ hscCompileCmmFile :: HscEnv -> FilePath -> FilePath -> IO () hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do let dflags = hsc_dflags hsc_env home_unit = mkHomeUnitFromFlags dflags + platform = targetPlatform dflags cmm <- ioMsgMaybe $ parseCmmFile dflags filename liftIO $ do - dumpIfSet_dyn dflags Opt_D_dump_cmm_verbose_by_proc "Parsed Cmm" FormatCMM (ppr cmm) + dumpIfSet_dyn dflags Opt_D_dump_cmm_verbose_by_proc "Parsed Cmm" FormatCMM (pdoc platform cmm) let -- Make up a module name to give the NCG. We can't pass bottom here -- lest we reproduce #11784. mod_name = mkModuleName $ "Cmm$" ++ FilePath.takeFileName filename @@ -1513,7 +1514,7 @@ hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do unless (null cmmgroup) $ dumpIfSet_dyn dflags Opt_D_dump_cmm "Output Cmm" - FormatCMM (ppr cmmgroup) + FormatCMM (pdoc platform cmmgroup) rawCmms <- lookupHook (\x -> cmmToRawCmmHook x) (\dflgs _ -> cmmToRawCmm dflgs) dflags dflags Nothing (Stream.yield cmmgroup) _ <- codeOutput dflags cmm_mod output_filename no_loc NoStubs [] [] @@ -1556,6 +1557,7 @@ doCodeGen :: HscEnv -> Module -> [TyCon] doCodeGen hsc_env this_mod data_tycons cost_centre_info stg_binds hpc_info = do let dflags = hsc_dflags hsc_env + platform = targetPlatform dflags let stg_binds_w_fvs = annTopBindingsFreeVars stg_binds @@ -1575,7 +1577,7 @@ doCodeGen hsc_env this_mod data_tycons let dump1 a = do unless (null a) $ dumpIfSet_dyn dflags Opt_D_dump_cmm_from_stg - "Cmm produced by codegen" FormatCMM (ppr a) + "Cmm produced by codegen" FormatCMM (pdoc platform a) return a ppr_stream1 = Stream.mapM dump1 cmm_stream @@ -1591,7 +1593,7 @@ doCodeGen hsc_env this_mod data_tycons dump2 a = do unless (null a) $ - dumpIfSet_dyn dflags Opt_D_dump_cmm "Output Cmm" FormatCMM (ppr a) + dumpIfSet_dyn dflags Opt_D_dump_cmm "Output Cmm" FormatCMM (pdoc platform a) return a return (Stream.mapM dump2 pipeline_stream) |