diff options
Diffstat (limited to 'compiler/nativeGen/AsmCodeGen.hs')
| -rw-r--r-- | compiler/nativeGen/AsmCodeGen.hs | 32 |
1 files changed, 18 insertions, 14 deletions
diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs index e033a4c218..6b7727a426 100644 --- a/compiler/nativeGen/AsmCodeGen.hs +++ b/compiler/nativeGen/AsmCodeGen.hs @@ -558,7 +558,6 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count (cmmTopCodeGen ncgImpl) fileIds dbgMap opt_cmm cmmCfg - dumpIfSet_dyn dflags Opt_D_dump_asm_native "Native code" (vcat $ map (pprNatCmmDecl ncgImpl) native) @@ -679,12 +678,13 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count cfgRegAllocUpdates = (concatMap Linear.ra_fixupList raStats) let cfgWithFixupBlks = - addNodesBetween nativeCfgWeights cfgRegAllocUpdates + (\cfg -> addNodesBetween cfg cfgRegAllocUpdates) <$> livenessCfg -- Insert stack update blocks let postRegCFG = - foldl' (\m (from,to) -> addImmediateSuccessor from to m ) - cfgWithFixupBlks stack_updt_blks + pure (foldl' (\m (from,to) -> addImmediateSuccessor from to m )) + <*> cfgWithFixupBlks + <*> pure stack_updt_blks ---- generate jump tables let tabled = @@ -701,12 +701,13 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count {-# SCC "shortcutBranches" #-} shortcutBranches dflags ncgImpl tabled postRegCFG - let optimizedCFG = - optimizeCFG (cfgWeightInfo dflags) cmm postShortCFG + let optimizedCFG :: Maybe CFG + optimizedCFG = + optimizeCFG (cfgWeightInfo dflags) cmm <$!> postShortCFG - dumpIfSet_dyn dflags - Opt_D_dump_cfg_weights "CFG Final Weights" - ( pprEdgeWeights optimizedCFG ) + maybe (return ()) + (dumpIfSet_dyn dflags Opt_D_dump_cfg_weights "CFG Final Weights" . pprEdgeWeights) + optimizedCFG --TODO: Partially check validity of the cfg. let getBlks (CmmProc _info _lbl _live (ListGraph blocks)) = blocks @@ -716,7 +717,8 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count (gopt Opt_DoAsmLinting dflags || debugIsOn )) $ do let blocks = concatMap getBlks shorted let labels = setFromList $ fmap blockId blocks :: LabelSet - return $! seq (sanityCheckCfg optimizedCFG labels $ + let cfg = fromJust optimizedCFG + return $! seq (sanityCheckCfg cfg labels $ text "cfg not in lockstep") () ---- sequence blocks @@ -734,7 +736,9 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count {-# SCC "invertCondBranches" #-} map invert sequenced where - invertConds = (invertCondBranches ncgImpl) optimizedCFG + invertConds :: LabelMap CmmStatics -> [NatBasicBlock instr] + -> [NatBasicBlock instr] + invertConds = invertCondBranches ncgImpl optimizedCFG invert top@CmmData {} = top invert (CmmProc info lbl live (ListGraph blocks)) = CmmProc info lbl live (ListGraph $ invertConds info blocks) @@ -884,13 +888,13 @@ shortcutBranches :: forall statics instr jumpDest. (Outputable jumpDest) => DynFlags -> NcgImpl statics instr jumpDest -> [NatCmmDecl statics instr] - -> CFG - -> ([NatCmmDecl statics instr],CFG) + -> Maybe CFG + -> ([NatCmmDecl statics instr],Maybe CFG) shortcutBranches dflags ncgImpl tops weights | gopt Opt_AsmShortcutting dflags = ( map (apply_mapping ncgImpl mapping) tops' - , shortcutWeightMap weights mappingBid ) + , shortcutWeightMap mappingBid <$!> weights ) | otherwise = (tops, weights) where |