NCG: Split linear allocator into separate modules.

[ghc-hetmet.git] / compiler / nativeGen / RegAlloc / Linear / Base.hs

diff --git a/compiler/nativeGen/RegAlloc/Linear/Base.hs b/compiler/nativeGen/RegAlloc/Linear/Base.hs
new file mode 100644 (file)
index 0000000..95c9965
--- /dev/null
+++ b/compiler/nativeGen/RegAlloc/Linear/Base.hs
@@ -0,0 +1,128 @@
+
+-- | Put common type definitions here to break recursive module dependencies.
+
+module RegAlloc.Linear.Base (
+       BlockAssignment,
+       Loc(..),
+
+       -- for stats
+       SpillReason(..),
+       RegAllocStats(..),
+       
+       -- the allocator monad
+       RA_State(..),
+       RegM(..)
+)
+
+where
+
+import RegAlloc.Linear.FreeRegs
+import RegAlloc.Linear.StackMap
+
+import RegLiveness
+import MachRegs
+
+import Outputable
+import Unique
+import UniqFM
+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.
+--
+type BlockAssignment 
+       = 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.
+--
+data Loc 
+       -- | vreg is in a register
+       = InReg   {-# UNPACK #-} !RegNo
+
+       -- | vreg is held in a stack slot
+       | InMem   {-# UNPACK #-} !StackSlot
+
+
+       -- | vreg is held in both a register and a stack slot
+       | InBoth  {-# UNPACK #-}  !RegNo
+                  {-# UNPACK #-} !StackSlot
+       deriving (Eq, Show, Ord)
+
+instance Outputable Loc where
+       ppr l = text (show l)
+
+
+-- | Reasons why instructions might be inserted by the spiller.
+--     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 moved because its hreg was clobbered
+       | SpillClobber  !Unique 
+
+       -- | vreg was loaded from a spill slot
+       | SpillLoad     !Unique 
+
+       -- | reg-reg move inserted during join to targets
+       | SpillJoinRR   !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] }
+
+
+-- | The register alloctor state
+data RA_State 
+       = RA_State 
+
+       -- | 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
+
+       -- | assignment of temps to locations
+       , ra_assig      :: RegMap Loc
+
+       -- | current stack delta
+       , ra_delta      :: Int
+
+       -- | free stack slots for spilling
+       , ra_stack      :: StackMap
+
+       -- | 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] }
+
+
+-- | The register allocator monad type.
+newtype RegM a 
+       = RegM { unReg :: RA_State -> (# RA_State, a #) }
+
+