X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocLinear.hs;h=918d7c64c5d578e3b0cc60bc02311741d2887b3d;hb=987530c1d23a59b986a54ba2bc9e198061fdcae9;hp=e6491b77ee9a15cdbc437d30e2067c47a5695530;hpb=1370a4a360ec154b390c1da21d40e446739b24c8;p=ghc-hetmet.git diff --git a/compiler/nativeGen/RegAllocLinear.hs b/compiler/nativeGen/RegAllocLinear.hs index e6491b7..918d7c6 100644 --- a/compiler/nativeGen/RegAllocLinear.hs +++ b/compiler/nativeGen/RegAllocLinear.hs @@ -88,6 +88,7 @@ module RegAllocLinear ( #include "HsVersions.h" +import BlockId import MachRegs import MachInstrs import RegAllocInfo @@ -101,6 +102,7 @@ import UniqFM import UniqSupply import Outputable import State +import FastString import Data.Maybe import Data.List @@ -574,7 +576,7 @@ saveClobberedTemps clobbered dying = do recordSpill (SpillClobber temp) let new_assign = addToUFM assig temp (InBoth reg slot) - clobber new_assign (spill : COMMENT FSLIT("spill clobber") : instrs) rest + clobber new_assign (spill : COMMENT (fsLit "spill clobber") : instrs) rest clobberRegs :: [RegNo] -> RegM () clobberRegs [] = return () -- common case @@ -691,7 +693,7 @@ allocateRegsAndSpill reading keep spills alloc (r:rs) = do (spill_insn, slot) <- spillR (RealReg my_reg) temp_to_push_out let spill_store = (if reading then id else reverse) - [ COMMENT FSLIT("spill alloc") + [ COMMENT (fsLit "spill alloc") , spill_insn ] -- record that this temp was spilled @@ -723,7 +725,7 @@ loadTemp True vreg (Just (InMem slot)) hreg spills = do insn <- loadR (RealReg hreg) slot recordSpill (SpillLoad $ getUnique vreg) - return $ COMMENT FSLIT("spill load") : insn : spills + return $ COMMENT (fsLit "spill load") : insn : spills loadTemp _ _ _ _ spills = return spills @@ -795,7 +797,7 @@ joinToTargets block_live new_blocks instr (dest:dests) = do delta <- getDeltaR let graph = makeRegMovementGraph adjusted_assig dest_assig - let sccs = stronglyConnCompR graph + let sccs = stronglyConnCompFromEdgedVerticesR graph fixUpInstrs <- mapM (handleComponent delta instr) sccs block_id <- getUniqueR @@ -807,7 +809,7 @@ joinToTargets block_live new_blocks instr (dest:dests) = do joinToTargets block_live (block : new_blocks) instr' dests --- | Construct a graph of register/spill movements. +-- | Construct a graph of register\/spill movements. -- -- We cut some corners by -- a) not handling cyclic components @@ -825,7 +827,7 @@ makeRegMovementGraph adjusted_assig dest_assig = expandNode vreg src $ lookupWithDefaultUFM_Directly dest_assig - (panic "RegisterAlloc.joinToTargets") + (panic "RegAllocLinear.makeRegMovementGraph") vreg in [ node | (vreg, src) <- ufmToList adjusted_assig @@ -899,7 +901,7 @@ handleComponent delta instr (CyclicSCC ((vreg, (InReg sreg),dsts):rest)) = do spill_id <- getUniqueR (_, slot) <- spillR (RealReg sreg) spill_id - remainingFixUps <- mapM (handleComponent delta instr) (stronglyConnCompR rest) + remainingFixUps <- mapM (handleComponent delta instr) (stronglyConnCompFromEdgedVerticesR rest) restoreAndFixInstr <- getRestoreMoves dsts slot return ([instr] ++ concat remainingFixUps ++ restoreAndFixInstr) @@ -908,7 +910,7 @@ handleComponent delta instr (CyclicSCC ((vreg, (InReg sreg),dsts):rest)) = do restoreToReg <- loadR (RealReg reg) slot moveInstr <- makeMove delta vreg r mem - return $ [COMMENT FSLIT("spill join move"), restoreToReg, moveInstr] + return $ [COMMENT (fsLit "spill join move"), restoreToReg, moveInstr] getRestoreMoves [InReg reg] slot = loadR (RealReg reg) slot >>= return . (:[]) @@ -1108,12 +1110,9 @@ pprStats code statss -- ----------------------------------------------------------------------------- -- Utils -#ifdef DEBUG -my_fromJust s p Nothing = pprPanic ("fromJust: " ++ s) p +my_fromJust :: String -> SDoc -> Maybe a -> a my_fromJust _ _ (Just x) = x -#else -my_fromJust _ _ = fromJust -#endif +my_fromJust s p Nothing = pprPanic ("fromJust: " ++ s) p lookItUp :: Uniquable b => String -> UniqFM a -> b -> a lookItUp str fm x = my_fromJust str (ppr (getUnique x)) (lookupUFM fm x)