X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmProcPointZ.hs;h=13f6421d08b1701b468ce1ef7453be8fe273bd51;hb=2bb3a439c106935d97fae7f7a0b60c21493d1bef;hp=138626765b810a6d8efc26e8ff82ba5b2a2dd4b6;hpb=703ca1542c8e0983cc9d8eebce6e9f3dd3fd71e2;p=ghc-hetmet.git diff --git a/compiler/cmm/CmmProcPointZ.hs b/compiler/cmm/CmmProcPointZ.hs index 1386267..13f6421 100644 --- a/compiler/cmm/CmmProcPointZ.hs +++ b/compiler/cmm/CmmProcPointZ.hs @@ -16,11 +16,11 @@ import CmmLiveZ import CmmTx import DFMonad import FiniteMap -import List (sortBy) +import Data.List (sortBy) import Maybes import MkZipCfg import MkZipCfgCmm hiding (CmmBlock, CmmGraph, CmmTopZ) -import Monad +import Control.Monad import Outputable import UniqSet import UniqSupply @@ -127,18 +127,21 @@ forward = ForwardTransfers first middle last exit -- those that are induced by calls in the original graph -- and those that are introduced because they're reachable from multiple proc points. callProcPoints :: CmmGraph -> ProcPointSet -minimalProcPointSet :: ProcPointSet -> CmmGraph -> FuelMonad ProcPointSet - callProcPoints g = fold_blocks add (unitBlockSet (lg_entry g)) g where add b set = case last $ unzip b of LastOther (LastCall _ (Just k) _ _ _) -> extendBlockSet set k _ -> set +minimalProcPointSet :: ProcPointSet -> CmmGraph -> FuelMonad ProcPointSet +-- Given the set of successors of calls (which must be proc-points) +-- figure ou the minimal set of necessary proc-points minimalProcPointSet callProcPoints g = extendPPSet g (postorder_dfs g) callProcPoints type PPFix = FuelMonad (ForwardFixedPoint Middle Last Status ()) procPointAnalysis :: ProcPointSet -> CmmGraph -> FuelMonad (BlockEnv Status) +-- Once you know what the proc-points are, figure out +-- what proc-points each block is reachable from procPointAnalysis procPoints g = let addPP env id = extendBlockEnv env id ProcPoint initProcPoints = foldl addPP emptyBlockEnv (blockSetToList procPoints)