X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocLinear.hs;h=7c7690c798261d7e3ca0fc2920d6c73d108aba35;hb=295d2a0018243d94a7bd4e72d88d056db32ff3cf;hp=c3a731910256bcc5f6959bd3cb0660d00d8dcc1a;hpb=272f0ba89eca1d9fc700cf4c27b9f8c3e23d6fe8;p=ghc-hetmet.git diff --git a/compiler/nativeGen/RegAllocLinear.hs b/compiler/nativeGen/RegAllocLinear.hs index c3a7319..7c7690c 100644 --- a/compiler/nativeGen/RegAllocLinear.hs +++ b/compiler/nativeGen/RegAllocLinear.hs @@ -92,7 +92,7 @@ import MachRegs import MachInstrs import RegAllocInfo import RegLiveness -import Cmm +import Cmm hiding (RegSet) import Digraph import Unique ( Uniquable(getUnique), Unique ) @@ -102,11 +102,9 @@ import UniqSupply import Outputable import State -#ifndef DEBUG -import Data.Maybe ( fromJust ) -#endif -import Data.List ( nub, partition, foldl') -import Control.Monad ( when ) +import Data.Maybe +import Data.List +import Control.Monad import Data.Word import Data.Bits @@ -224,6 +222,7 @@ emptyStackMap = StackMap [0..maxSpillSlots] emptyUFM getStackSlotFor :: StackMap -> Unique -> (StackMap,Int) getStackSlotFor (StackMap [] _) _ = panic "RegAllocLinear.getStackSlotFor: out of stack slots" + getStackSlotFor fs@(StackMap (freeSlot:stack') reserved) reg = case lookupUFM reserved reg of Just slot -> (fs,slot) @@ -242,12 +241,12 @@ regAlloc (CmmData sec d) ( CmmData sec d , Nothing ) -regAlloc (CmmProc (LiveInfo info _ _) lbl params []) +regAlloc (CmmProc (LiveInfo info _ _) lbl params (ListGraph [])) = return - ( CmmProc info lbl params [] + ( CmmProc info lbl params (ListGraph []) , Nothing ) -regAlloc (CmmProc static lbl params comps) +regAlloc (CmmProc static lbl params (ListGraph comps)) | LiveInfo info (Just first_id) block_live <- static = do -- do register allocation on each component. @@ -263,7 +262,7 @@ regAlloc (CmmProc static lbl params comps) let ((first':_), rest') = partition ((== first_id) . blockId) final_blocks - return ( CmmProc info lbl params (first' : rest') + return ( CmmProc info lbl params (ListGraph (first' : rest')) , Just stats) -- bogus. to make non-exhaustive match warning go away. @@ -292,10 +291,8 @@ save it in a spill location, but mark it as InBoth because the current instruction might still want to read it. -} -#ifdef DEBUG instance Outputable Loc where ppr l = text (show l) -#endif -- | Do register allocation on some basic blocks. @@ -1111,7 +1108,7 @@ pprStats code statss #ifdef DEBUG my_fromJust s p Nothing = pprPanic ("fromJust: " ++ s) p -my_fromJust s p (Just x) = x +my_fromJust _ _ (Just x) = x #else my_fromJust _ _ = fromJust #endif