X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FnativeGen%2FRegLiveness.hs;h=9ee98971baf49e320983970c1a357f8b4dda386f;hp=e18931caa234b07fc7955b6963168bf289fe8b77;hb=220a12e946b80166d3fe20419091135cef01f668;hpb=2381528a3b655af6becce8c8b130c63217992137 diff --git a/compiler/nativeGen/RegLiveness.hs b/compiler/nativeGen/RegLiveness.hs index e18931c..9ee9897 100644 --- a/compiler/nativeGen/RegLiveness.hs +++ b/compiler/nativeGen/RegLiveness.hs @@ -23,7 +23,6 @@ module RegLiveness ( spillNatBlock, slurpConflicts, slurpReloadCoalesce, - lifetimeCount, eraseDeltasLive, patchEraseLive, patchRegsLiveInstr, @@ -381,48 +380,6 @@ spillNatBlock (BasicBlock i is) = spillNat (instr : acc) instrs --- | Slurp out a map of how many times each register was live upon entry to an instruction. - -lifetimeCount - :: LiveCmmTop - -> UniqFM (Reg, Int) -- ^ reg -> (reg, count) - -lifetimeCount cmm - = countCmm emptyUFM cmm - where - countCmm fm CmmData{} = fm - countCmm fm (CmmProc info _ _ (ListGraph blocks)) - = foldl' (countComp info) fm blocks - - countComp info fm (BasicBlock _ blocks) - = foldl' (countBlock info) fm blocks - - countBlock info fm (BasicBlock blockId instrs) - | LiveInfo _ _ blockLive <- info - , Just rsLiveEntry <- lookupUFM blockLive blockId - = countLIs rsLiveEntry fm instrs - - | otherwise - = error "RegLiveness.countBlock: bad block" - - countLIs _ fm [] = fm - countLIs rsLive fm (Instr _ Nothing : lis) = countLIs rsLive fm lis - - countLIs rsLiveEntry fm (Instr _ (Just live) : lis) - = let - rsLiveAcross = rsLiveEntry `minusUniqSet` (liveDieRead live) - - rsLiveNext = (rsLiveAcross `unionUniqSets` (liveBorn live)) - `minusUniqSet` (liveDieWrite live) - - add r fm = addToUFM_C - (\(r1, l1) (_, l2) -> (r1, l1 + l2)) - fm r (r, 1) - - fm' = foldUniqSet add fm rsLiveEntry - in countLIs rsLiveNext fm' lis - - -- | Erase Delta instructions. eraseDeltasLive :: LiveCmmTop -> LiveCmmTop