projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Try and allocate vregs spilled/reloaded from some slot to the same hreg
[ghc-hetmet.git]
/
compiler
/
nativeGen
/
RegAllocLinear.hs
diff --git
a/compiler/nativeGen/RegAllocLinear.hs
b/compiler/nativeGen/RegAllocLinear.hs
index
c3a7319
..
7c7690c
100644
(file)
--- a/
compiler/nativeGen/RegAllocLinear.hs
+++ b/
compiler/nativeGen/RegAllocLinear.hs
@@
-92,7
+92,7
@@
import MachRegs
import MachInstrs
import RegAllocInfo
import RegLiveness
import MachInstrs
import RegAllocInfo
import RegLiveness
-import Cmm
+import Cmm hiding (RegSet)
import Digraph
import Unique ( Uniquable(getUnique), Unique )
import Digraph
import Unique ( Uniquable(getUnique), Unique )
@@
-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
@@
-224,6
+222,7
@@
emptyStackMap = StackMap [0..maxSpillSlots] emptyUFM
getStackSlotFor :: StackMap -> Unique -> (StackMap,Int)
getStackSlotFor (StackMap [] _) _
= panic "RegAllocLinear.getStackSlotFor: out of stack slots"
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)
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 )
( CmmData sec d
, Nothing )
-regAlloc (CmmProc (LiveInfo info _ _) lbl params [])
+regAlloc (CmmProc (LiveInfo info _ _) lbl params (ListGraph []))
= return
= return
- ( CmmProc info lbl params []
+ ( CmmProc info lbl params (ListGraph [])
, Nothing )
, 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.
| 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
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.
, 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.
-}
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.
@@
-1111,7
+1108,7
@@
pprStats code statss
#ifdef DEBUG
my_fromJust s p Nothing = pprPanic ("fromJust: " ++ s) p
#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
#else
my_fromJust _ _ = fromJust
#endif