1{-# LANGUAGE BangPatterns #-} 2{-# LANGUAGE FlexibleContexts #-} 3{-# LANGUAGE GADTs #-} 4{-# LANGUAGE ScopedTypeVariables #-} 5 6module CmmLive 7 ( CmmLocalLive 8 , cmmLocalLiveness 9 , cmmGlobalLiveness 10 , liveLattice 11 , gen_kill 12 ) 13where 14 15import GhcPrelude 16 17import DynFlags 18import BlockId 19import Cmm 20import PprCmmExpr () -- For Outputable instances 21import Hoopl.Block 22import Hoopl.Collections 23import Hoopl.Dataflow 24import Hoopl.Label 25 26import Maybes 27import Outputable 28 29----------------------------------------------------------------------------- 30-- Calculating what variables are live on entry to a basic block 31----------------------------------------------------------------------------- 32 33-- | The variables live on entry to a block 34type CmmLive r = RegSet r 35type CmmLocalLive = CmmLive LocalReg 36 37-- | The dataflow lattice 38liveLattice :: Ord r => DataflowLattice (CmmLive r) 39{-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive LocalReg) #-} 40{-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive GlobalReg) #-} 41liveLattice = DataflowLattice emptyRegSet add 42 where 43 add (OldFact old) (NewFact new) = 44 let !join = plusRegSet old new 45 in changedIf (sizeRegSet join > sizeRegSet old) join 46 47-- | A mapping from block labels to the variables live on entry 48type BlockEntryLiveness r = LabelMap (CmmLive r) 49 50----------------------------------------------------------------------------- 51-- | Calculated liveness info for a CmmGraph 52----------------------------------------------------------------------------- 53 54cmmLocalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness LocalReg 55cmmLocalLiveness dflags graph = 56 check $ analyzeCmmBwd liveLattice (xferLive dflags) graph mapEmpty 57 where 58 entry = g_entry graph 59 check facts = 60 noLiveOnEntry entry (expectJust "check" $ mapLookup entry facts) facts 61 62cmmGlobalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness GlobalReg 63cmmGlobalLiveness dflags graph = 64 analyzeCmmBwd liveLattice (xferLive dflags) graph mapEmpty 65 66-- | On entry to the procedure, there had better not be any LocalReg's live-in. 67noLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a 68noLiveOnEntry bid in_fact x = 69 if nullRegSet in_fact then x 70 else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact) 71 72gen_kill 73 :: (DefinerOfRegs r n, UserOfRegs r n) 74 => DynFlags -> n -> CmmLive r -> CmmLive r 75gen_kill dflags node set = 76 let !afterKill = foldRegsDefd dflags deleteFromRegSet set node 77 in foldRegsUsed dflags extendRegSet afterKill node 78{-# INLINE gen_kill #-} 79 80xferLive 81 :: forall r. 82 ( UserOfRegs r (CmmNode O O) 83 , DefinerOfRegs r (CmmNode O O) 84 , UserOfRegs r (CmmNode O C) 85 , DefinerOfRegs r (CmmNode O C) 86 ) 87 => DynFlags -> TransferFun (CmmLive r) 88xferLive dflags (BlockCC eNode middle xNode) fBase = 89 let joined = gen_kill dflags xNode $! joinOutFacts liveLattice xNode fBase 90 !result = foldNodesBwdOO (gen_kill dflags) middle joined 91 in mapSingleton (entryLabel eNode) result 92{-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive LocalReg) #-} 93{-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive GlobalReg) #-} 94