LiveInfo (..),
LiveBasicBlock,
- mapBlockTop,
- mapBlockTopM,
+ mapBlockTop, mapBlockTopM,
+ mapGenBlockTop, mapGenBlockTopM,
stripLive,
+ spillNatBlock,
slurpConflicts,
lifetimeCount,
eraseDeltasLive,
patchEraseLive,
patchRegsLiveInstr,
regLiveness
+
) where
#include "HsVersions.h"
return $ BasicBlock i blocks'
+-- map a function across all the basic blocks in this code
+mapGenBlockTop
+ :: (GenBasicBlock i -> GenBasicBlock i)
+ -> (GenCmmTop d h i -> GenCmmTop d h i)
+
+mapGenBlockTop f cmm
+ = evalState (mapGenBlockTopM (\x -> return $ f x) cmm) ()
+
+
+-- | map a function across all the basic blocks in this code (monadic version)
+mapGenBlockTopM
+ :: Monad m
+ => (GenBasicBlock i -> m (GenBasicBlock i))
+ -> (GenCmmTop d h i -> m (GenCmmTop d h i))
+
+mapGenBlockTopM f cmm@(CmmData{})
+ = return cmm
+
+mapGenBlockTopM f (CmmProc header label params blocks)
+ = do blocks' <- mapM f blocks
+ return $ CmmProc header label params blocks'
+
+
-- | Slurp out the list of register conflicts from this top level thing.
slurpConflicts :: LiveCmmTop -> Bag (UniqSet Reg)
stripLI (Instr instr _) = instr
+-- | Make real spill instructions out of SPILL, RELOAD pseudos
+
+spillNatBlock :: NatBasicBlock -> NatBasicBlock
+spillNatBlock (BasicBlock i instrs)
+ = BasicBlock i instrs'
+ where (instrs', _)
+ = runState (spillNat [] instrs) 0
+
+ spillNat acc []
+ = return (reverse acc)
+
+ spillNat acc (instr@(DELTA i) : instrs)
+ = do put i
+ spillNat acc instrs
+
+ spillNat acc (SPILL reg slot : instrs)
+ = do delta <- get
+ spillNat (mkSpillInstr reg delta slot : acc) instrs
+
+ spillNat acc (RELOAD slot reg : instrs)
+ = do delta <- get
+ spillNat (mkLoadInstr reg delta slot : acc) instrs
+
+ spillNat acc (instr : instrs)
+ = spillNat (instr : acc) instrs
+
+
-- | Slurp out a map of how many times each register was live upon entry to an instruction.
lifetimeCount