X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAlloc%2FLinear%2FBase.hs;fp=compiler%2FnativeGen%2FRegAlloc%2FLinear%2FBase.hs;h=432acdf314111f7e741d54defce020049cd96459;hp=9fd090ce929616150a46cb8c18740c132176d559;hb=7e95df790b34e11d7308e43dab0a7175b69b70fc;hpb=c0687066474aa4ce4912f31a5c09c1bcd673fb06 diff --git a/compiler/nativeGen/RegAlloc/Linear/Base.hs b/compiler/nativeGen/RegAlloc/Linear/Base.hs index 9fd090c..432acdf 100644 --- a/compiler/nativeGen/RegAlloc/Linear/Base.hs +++ b/compiler/nativeGen/RegAlloc/Linear/Base.hs @@ -2,23 +2,22 @@ -- | Put common type definitions here to break recursive module dependencies. module RegAlloc.Linear.Base ( - BlockAssignment, - - Loc(..), - regsOfLoc, - - -- for stats - SpillReason(..), - RegAllocStats(..), - - -- the allocator monad - RA_State(..), - RegM(..) + BlockAssignment, + + Loc(..), + regsOfLoc, + + -- for stats + SpillReason(..), + RegAllocStats(..), + + -- the allocator monad + RA_State(..), + RegM(..) ) where -import RegAlloc.Linear.FreeRegs import RegAlloc.Linear.StackMap import RegAlloc.Liveness import Reg @@ -30,40 +29,40 @@ import UniqSupply -- | Used to store the register assignment on entry to a basic block. --- We use this to handle join points, where multiple branch instructions --- target a particular label. We have to insert fixup code to make --- the register assignments from the different sources match up. +-- We use this to handle join points, where multiple branch instructions +-- target a particular label. We have to insert fixup code to make +-- the register assignments from the different sources match up. -- -type BlockAssignment - = BlockMap (FreeRegs, RegMap Loc) +type BlockAssignment freeRegs + = BlockMap (freeRegs, RegMap Loc) -- | Where a vreg is currently stored --- A temporary can be marked as living in both a register and memory --- (InBoth), for example if it was recently loaded from a spill location. --- This makes it cheap to spill (no save instruction required), but we --- have to be careful to turn this into InReg if the value in the --- register is changed. - --- This is also useful when a temporary is about to be clobbered. We --- save it in a spill location, but mark it as InBoth because the current --- instruction might still want to read it. +-- A temporary can be marked as living in both a register and memory +-- (InBoth), for example if it was recently loaded from a spill location. +-- This makes it cheap to spill (no save instruction required), but we +-- have to be careful to turn this into InReg if the value in the +-- register is changed. + +-- This is also useful when a temporary is about to be clobbered. We +-- save it in a spill location, but mark it as InBoth because the current +-- instruction might still want to read it. -- -data Loc - -- | vreg is in a register - = InReg !RealReg +data Loc + -- | vreg is in a register + = InReg !RealReg - -- | vreg is held in a stack slot - | InMem {-# UNPACK #-} !StackSlot + -- | vreg is held in a stack slot + | InMem {-# UNPACK #-} !StackSlot - -- | vreg is held in both a register and a stack slot - | InBoth !RealReg - {-# UNPACK #-} !StackSlot - deriving (Eq, Show, Ord) + -- | vreg is held in both a register and a stack slot + | InBoth !RealReg + {-# UNPACK #-} !StackSlot + deriving (Eq, Show, Ord) instance Outputable Loc where - ppr l = text (show l) + ppr l = text (show l) -- | Get the reg numbers stored in this Loc. @@ -74,64 +73,64 @@ regsOfLoc (InMem _) = [] -- | Reasons why instructions might be inserted by the spiller. --- Used when generating stats for -ddrop-asm-stats. +-- Used when generating stats for -ddrop-asm-stats. -- data SpillReason - -- | vreg was spilled to a slot so we could use its - -- current hreg for another vreg - = SpillAlloc !Unique + -- | vreg was spilled to a slot so we could use its + -- current hreg for another vreg + = SpillAlloc !Unique - -- | vreg was moved because its hreg was clobbered - | SpillClobber !Unique + -- | vreg was moved because its hreg was clobbered + | SpillClobber !Unique - -- | vreg was loaded from a spill slot - | SpillLoad !Unique + -- | vreg was loaded from a spill slot + | SpillLoad !Unique - -- | reg-reg move inserted during join to targets - | SpillJoinRR !Unique + -- | reg-reg move inserted during join to targets + | SpillJoinRR !Unique - -- | reg-mem move inserted during join to targets - | SpillJoinRM !Unique + -- | reg-mem move inserted during join to targets + | SpillJoinRM !Unique -- | Used to carry interesting stats out of the register allocator. data RegAllocStats - = RegAllocStats - { ra_spillInstrs :: UniqFM [Int] } + = RegAllocStats + { ra_spillInstrs :: UniqFM [Int] } -- | The register alloctor state -data RA_State - = RA_State +data RA_State freeRegs + = RA_State + + { + -- | the current mapping from basic blocks to + -- the register assignments at the beginning of that block. + ra_blockassig :: BlockAssignment freeRegs - { - -- | the current mapping from basic blocks to - -- the register assignments at the beginning of that block. - ra_blockassig :: BlockAssignment - - -- | free machine registers - , ra_freeregs :: {-#UNPACK#-}!FreeRegs + -- | free machine registers + , ra_freeregs :: !freeRegs - -- | assignment of temps to locations - , ra_assig :: RegMap Loc + -- | assignment of temps to locations + , ra_assig :: RegMap Loc - -- | current stack delta - , ra_delta :: Int + -- | current stack delta + , ra_delta :: Int - -- | free stack slots for spilling - , ra_stack :: StackMap + -- | free stack slots for spilling + , ra_stack :: StackMap - -- | unique supply for generating names for join point fixup blocks. - , ra_us :: UniqSupply + -- | unique supply for generating names for join point fixup blocks. + , ra_us :: UniqSupply - -- | Record why things were spilled, for -ddrop-asm-stats. - -- Just keep a list here instead of a map of regs -> reasons. - -- We don't want to slow down the allocator if we're not going to emit the stats. - , ra_spills :: [SpillReason] } + -- | Record why things were spilled, for -ddrop-asm-stats. + -- Just keep a list here instead of a map of regs -> reasons. + -- We don't want to slow down the allocator if we're not going to emit the stats. + , ra_spills :: [SpillReason] } -- | The register allocator monad type. -newtype RegM a - = RegM { unReg :: RA_State -> (# RA_State, a #) } +newtype RegM freeRegs a + = RegM { unReg :: RA_State freeRegs -> (# RA_State freeRegs, a #) }