| ... |
... |
@@ -8,6 +8,7 @@ import GHC.Prelude |
|
8
|
8
|
import GHC.Driver.Flags
|
|
9
|
9
|
|
|
10
|
10
|
import GHC.Cmm
|
|
|
11
|
+import GHC.Cmm.CLabel
|
|
11
|
12
|
import GHC.Cmm.Config
|
|
12
|
13
|
import GHC.Cmm.ContFlowOpt
|
|
13
|
14
|
import GHC.Cmm.CommonBlockElim
|
| ... |
... |
@@ -80,14 +81,14 @@ cpsTop logger platform cfg dus proc = |
|
80
|
81
|
--
|
|
81
|
82
|
CmmProc h l v g <- {-# SCC "cmmCfgOpts(1)" #-}
|
|
82
|
83
|
return $ cmmCfgOptsProc splitting_proc_points proc
|
|
83
|
|
- dump Opt_D_dump_cmm_cfg "Post control-flow optimisations (1)" g
|
|
|
84
|
+ dump Opt_D_dump_cmm_cfg "Post control-flow optimisations (1)" l g
|
|
84
|
85
|
|
|
85
|
86
|
let !TopInfo {stack_info=StackInfo { arg_space = entry_off
|
|
86
|
87
|
, do_layout = do_layout }} = h
|
|
87
|
88
|
|
|
88
|
89
|
----------- Eliminate common blocks -------------------------------------
|
|
89
|
90
|
g <- {-# SCC "elimCommonBlocks" #-}
|
|
90
|
|
- condPass (cmmOptElimCommonBlks cfg) elimCommonBlocks g
|
|
|
91
|
+ condPass (cmmOptElimCommonBlks cfg) elimCommonBlocks l g
|
|
91
|
92
|
Opt_D_dump_cmm_cbe "Post common block elimination"
|
|
92
|
93
|
|
|
93
|
94
|
-- Any work storing block Labels must be performed _after_
|
| ... |
... |
@@ -98,7 +99,7 @@ cpsTop logger platform cfg dus proc = |
|
98
|
99
|
then {-# SCC "createSwitchPlans" #-}
|
|
99
|
100
|
pure $ runUniqueDSM dus $ cmmImplementSwitchPlans platform g
|
|
100
|
101
|
else pure (g, dus)
|
|
101
|
|
- dump Opt_D_dump_cmm_switch "Post switch plan" g
|
|
|
102
|
+ dump Opt_D_dump_cmm_switch "Post switch plan" l g
|
|
102
|
103
|
|
|
103
|
104
|
----------- ThreadSanitizer instrumentation -----------------------------
|
|
104
|
105
|
g <- {-# SCC "annotateTSAN" #-}
|
| ... |
... |
@@ -111,7 +112,7 @@ cpsTop logger platform cfg dus proc = |
|
111
|
112
|
return $ initUs_ us $
|
|
112
|
113
|
annotateTSAN platform g
|
|
113
|
114
|
else return g
|
|
114
|
|
- dump Opt_D_dump_cmm_thread_sanitizer "ThreadSanitizer instrumentation" g
|
|
|
115
|
+ dump Opt_D_dump_cmm_thread_sanitizer "ThreadSanitizer instrumentation" l g
|
|
115
|
116
|
|
|
116
|
117
|
----------- Proc points -------------------------------------------------
|
|
117
|
118
|
let
|
| ... |
... |
@@ -134,11 +135,11 @@ cpsTop logger platform cfg dus proc = |
|
134
|
135
|
if do_layout
|
|
135
|
136
|
then runUniqueDSM dus $ cmmLayoutStack cfg proc_points entry_off g
|
|
136
|
137
|
else ((g, mapEmpty), dus)
|
|
137
|
|
- dump Opt_D_dump_cmm_sp "Layout Stack" g
|
|
|
138
|
+ dump Opt_D_dump_cmm_sp "Layout Stack" l g
|
|
138
|
139
|
|
|
139
|
140
|
----------- Sink and inline assignments --------------------------------
|
|
140
|
141
|
g <- {-# SCC "sink" #-} -- See Note [Sinking after stack layout]
|
|
141
|
|
- condPass (cmmOptSink cfg) (cmmSink platform) g
|
|
|
142
|
+ condPass (cmmOptSink cfg) (cmmSink platform) l g
|
|
142
|
143
|
Opt_D_dump_cmm_sink "Sink assignments"
|
|
143
|
144
|
|
|
144
|
145
|
------------- CAF analysis ----------------------------------------------
|
| ... |
... |
@@ -182,11 +183,11 @@ cpsTop logger platform cfg dus proc = |
|
182
|
183
|
dumps flag name
|
|
183
|
184
|
= mapM_ (dumpWith logger flag name FormatCMM . pdoc platform)
|
|
184
|
185
|
|
|
185
|
|
- condPass do_opt pass g dumpflag dumpname =
|
|
|
186
|
+ condPass do_opt pass lbl g dumpflag dumpname =
|
|
186
|
187
|
if do_opt
|
|
187
|
188
|
then do
|
|
188
|
189
|
g <- return $ pass g
|
|
189
|
|
- dump dumpflag dumpname g
|
|
|
190
|
+ dump dumpflag dumpname lbl g
|
|
190
|
191
|
return g
|
|
191
|
192
|
else return g
|
|
192
|
193
|
|
| ... |
... |
@@ -359,10 +360,10 @@ generator later. |
|
359
|
360
|
|
|
360
|
361
|
-}
|
|
361
|
362
|
|
|
362
|
|
-dumpGraph :: Logger -> Platform -> Bool -> DumpFlag -> String -> CmmGraph -> IO ()
|
|
363
|
|
-dumpGraph logger platform do_linting flag name g = do
|
|
|
363
|
+dumpGraph :: Logger -> Platform -> Bool -> DumpFlag -> String -> CLabel -> CmmGraph -> IO ()
|
|
|
364
|
+dumpGraph logger platform do_linting flag name lbl g = do
|
|
364
|
365
|
when do_linting $ do_lint g
|
|
365
|
|
- dumpWith logger flag name FormatCMM (pdoc platform g)
|
|
|
366
|
+ dumpWith logger flag name FormatCMM (pdoc platform lbl $$ pdoc platform g)
|
|
366
|
367
|
where
|
|
367
|
368
|
do_lint g = case cmmLintGraph platform g of
|
|
368
|
369
|
Just err -> do { fatalErrorMsg logger err
|