projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Make some more modules use LazyUniqFM instead of UniqFM
[ghc-hetmet.git]
/
compiler
/
nativeGen
/
RegAllocLinear.hs
diff --git
a/compiler/nativeGen/RegAllocLinear.hs
b/compiler/nativeGen/RegAllocLinear.hs
index
968b399
..
e6491b7
100644
(file)
--- a/
compiler/nativeGen/RegAllocLinear.hs
+++ b/
compiler/nativeGen/RegAllocLinear.hs
@@
-1,3
+1,4
@@
+{-# OPTIONS -fno-warn-missing-signatures #-}
-----------------------------------------------------------------------------
--
-- The register allocator
-----------------------------------------------------------------------------
--
-- The register allocator
@@
-5,7
+6,6
@@
-- (c) The University of Glasgow 2004
--
-----------------------------------------------------------------------------
-- (c) The University of Glasgow 2004
--
-----------------------------------------------------------------------------
-{-# OPTIONS -fno-warn-missing-signatures #-}
{-
The algorithm is roughly:
{-
The algorithm is roughly:
@@
-102,11
+102,9
@@
import UniqSupply
import Outputable
import State
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
import Data.Word
import Data.Bits
@@
-157,8
+155,9
@@
getFreeRegs :: RegClass -> FreeRegs -> [RegNo] -- lazilly
getFreeRegs cls (FreeRegs g f)
| RcDouble <- cls = go f (0x80000000) 63
| RcInteger <- cls = go g (0x80000000) 31
getFreeRegs cls (FreeRegs g f)
| RcDouble <- cls = go f (0x80000000) 63
| RcInteger <- cls = go g (0x80000000) 31
+ | otherwise = pprPanic "RegAllocLinear.getFreeRegs: Bad cls" (ppr cls)
where
where
- go x 0 i = []
+ go _ 0 _ = []
go x m i | x .&. m /= 0 = i : (go x (m `shiftR` 1) $! i-1)
| otherwise = go x (m `shiftR` 1) $! i-1
go x m i | x .&. m /= 0 = i : (go x (m `shiftR` 1) $! i-1)
| otherwise = go x (m `shiftR` 1) $! i-1
@@
-223,7
+222,8
@@
emptyStackMap = StackMap [0..maxSpillSlots] emptyUFM
getStackSlotFor :: StackMap -> Unique -> (StackMap,Int)
getStackSlotFor (StackMap [] _) _
getStackSlotFor :: StackMap -> Unique -> (StackMap,Int)
getStackSlotFor (StackMap [] _) _
- = panic "RegAllocLinear.getStackSlotFor: out of stack slots"
+ = panic "RegAllocLinear.getStackSlotFor: out of stack slots, try -fregs-graph"
+ -- This happens with darcs' SHA1.hs, see #1993
getStackSlotFor fs@(StackMap (freeSlot:stack') reserved) reg =
case lookupUFM reserved reg of
getStackSlotFor fs@(StackMap (freeSlot:stack') reserved) reg =
case lookupUFM reserved reg of
@@
-293,10
+293,8
@@
save it in a spill location, but mark it as InBoth because the current
instruction might still want to read it.
-}
instruction might still want to read it.
-}
-#ifdef DEBUG
instance Outputable Loc where
ppr l = text (show l)
instance Outputable Loc where
ppr l = text (show l)
-#endif
-- | Do register allocation on some basic blocks.
-- | Do register allocation on some basic blocks.