Parameterise the RegM monad on the FreeRegs type

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

diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index 1e904ae..ba8cdce 100644 (file)
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -1,4 +1,3 @@
-{-# OPTIONS -fno-warn-missing-signatures #-}
 -----------------------------------------------------------------------------
 --
 -- The register allocator
@@ -179,6 +178,13 @@ linearRegAlloc first_id block_live sccs
 
         return  (blocks, stats)
 
+linearRA_SCCs :: (Instruction instr, Outputable instr)
+              => BlockId
+              -> BlockMap RegSet
+              -> [NatBasicBlock instr]
+              -> [SCC (LiveBasicBlock instr)]
+              -> RegM FreeRegs [NatBasicBlock instr]
+
 linearRA_SCCs _ _ blocksAcc []
         = return $ reverse blocksAcc
 
@@ -207,6 +213,15 @@ linearRA_SCCs first_id block_live blocksAcc (CyclicSCC blocks : sccs)
    more sanity checking to guard against this eventuality.
 -}
 
+process :: (Instruction instr, Outputable instr)
+        => BlockId
+        -> BlockMap RegSet
+        -> [GenBasicBlock (LiveInstr instr)]
+        -> [GenBasicBlock (LiveInstr instr)]
+        -> [[NatBasicBlock instr]]
+        -> Bool
+        -> RegM FreeRegs [[NatBasicBlock instr]]
+
 process _ _ [] []         accum _
         = return $ reverse accum
 
@@ -245,7 +260,7 @@ processBlock
         :: (Outputable instr, Instruction instr)
         => BlockMap RegSet              -- ^ live regs on entry to each basic block
         -> LiveBasicBlock instr         -- ^ block to do register allocation on
-        -> RegM [NatBasicBlock instr]   -- ^ block with registers allocated
+        -> RegM FreeRegs [NatBasicBlock instr]   -- ^ block with registers allocated
 
 processBlock block_live (BasicBlock id instrs)
  = do   initBlock id
@@ -256,7 +271,7 @@ processBlock block_live (BasicBlock id instrs)
 
 -- | Load the freeregs and current reg assignment into the RegM state
 --      for the basic block with this BlockId.
-initBlock :: BlockId -> RegM ()
+initBlock :: BlockId -> RegM FreeRegs ()
 initBlock id
  = do   block_assig     <- getBlockAssigR
         case mapLookup id block_assig of
@@ -283,7 +298,8 @@ linearRA
         -> BlockId                              -- ^ id of the current block, for debugging.
         -> [LiveInstr instr]                    -- ^ liveness annotated instructions in this block.
 
-        -> RegM ( [instr]                       --   instructions after register allocation
+        -> RegM FreeRegs
+                ( [instr]                       --   instructions after register allocation
                 , [NatBasicBlock instr])        --   fresh blocks of fixup code.
 
 
@@ -308,7 +324,7 @@ raInsn
         -> [instr]                              -- ^ accumulator for instructions already processed.
         -> BlockId                              -- ^ the id of the current block, for debugging
         -> LiveInstr instr                      -- ^ the instr to have its regs allocated, with liveness info.
-        -> RegM
+        -> RegM FreeRegs
                 ( [instr]                       -- new instructions
                 , [NatBasicBlock instr])        -- extra fixup blocks
 
@@ -366,7 +382,14 @@ raInsn _ _ _ instr
         = pprPanic "raInsn" (text "no match for:" <> ppr instr)
 
 
-
+genRaInsn :: (Instruction instr, Outputable instr)
+          => BlockMap RegSet
+          -> [instr]
+          -> BlockId
+          -> instr
+          -> [Reg]
+          -> [Reg]
+          -> RegM FreeRegs ([instr], [NatBasicBlock instr])
 
 genRaInsn block_live new_instrs block_id instr r_dying w_dying =
     case regUsageOfInstr instr              of { RU read written ->
@@ -463,6 +486,7 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying =
 -- -----------------------------------------------------------------------------
 -- releaseRegs
 
+releaseRegs :: [Reg] -> RegM FreeRegs ()
 releaseRegs regs = do
   assig <- getAssigR
   free <- getFreeRegsR
@@ -500,7 +524,7 @@ saveClobberedTemps
         :: (Outputable instr, Instruction instr)
         => [RealReg]            -- real registers clobbered by this instruction
         -> [Reg]                -- registers which are no longer live after this insn
-        -> RegM [instr]         -- return: instructions to spill any temps that will
+        -> RegM FreeRegs [instr]         -- return: instructions to spill any temps that will
                                 -- be clobbered.
 
 saveClobberedTemps [] _
@@ -539,7 +563,7 @@ saveClobberedTemps clobbered dying
 -- | Mark all these real regs as allocated,
 --      and kick out their vreg assignments.
 --
-clobberRegs :: [RealReg] -> RegM ()
+clobberRegs :: [RealReg] -> RegM FreeRegs ()
 clobberRegs []
         = return ()
 
@@ -595,8 +619,7 @@ allocateRegsAndSpill
         -> [instr]              -- spill insns
         -> [RealReg]            -- real registers allocated (accum.)
         -> [VirtualReg]         -- temps to allocate
-        -> RegM ( [instr]
-                , [RealReg])
+        -> RegM FreeRegs ( [instr] , [RealReg])
 
 allocateRegsAndSpill _       _    spills alloc []
         = return (spills, reverse alloc)
@@ -634,6 +657,16 @@ allocateRegsAndSpill reading keep spills alloc (r:rs)
 
 -- reading is redundant with reason, but we keep it around because it's
 -- convenient and it maintains the recursive structure of the allocator. -- EZY
+allocRegsAndSpill_spill :: (Instruction instr, Outputable instr)
+                        => Bool
+                        -> [VirtualReg]
+                        -> [instr]
+                        -> [RealReg]
+                        -> VirtualReg
+                        -> [VirtualReg]
+                        -> UniqFM Loc
+                        -> SpillLoc
+                        -> RegM FreeRegs ([instr], [RealReg])
 allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
  = do
         freeRegs                <- getFreeRegsR
@@ -734,7 +767,7 @@ loadTemp
         -> SpillLoc     -- the current location of this temp
         -> RealReg      -- the hreg to load the temp into
         -> [instr]
-        -> RegM [instr]
+        -> RegM FreeRegs [instr]
 
 loadTemp vreg (ReadMem slot) hreg spills
  = do