+-- | Spill some registers to stack slots in a top-level thing.
+regSpill_top
+ :: Instruction instr
+ => RegMap Int -- ^ map of vregs to slots they're being spilled to.
+ -> LiveCmmTop instr -- ^ the top level thing.
+ -> SpillM (LiveCmmTop instr)
+
+regSpill_top regSlotMap cmm
+ = case cmm of
+ CmmData{}
+ -> return cmm
+
+ CmmProc info label sccs
+ | LiveInfo static firstId mLiveVRegsOnEntry liveSlotsOnEntry <- info
+ -> do
+ -- We should only passed Cmms with the liveness maps filled in, but we'll
+ -- create empty ones if they're not there just in case.
+ let liveVRegsOnEntry = fromMaybe mapEmpty mLiveVRegsOnEntry
+
+ -- The liveVRegsOnEntry contains the set of vregs that are live on entry to
+ -- each basic block. If we spill one of those vregs we remove it from that
+ -- set and add the corresponding slot number to the liveSlotsOnEntry set.
+ -- The spill cleaner needs this information to erase unneeded spill and
+ -- reload instructions after we've done a successful allocation.
+ let liveSlotsOnEntry' :: Map BlockId (Set Int)
+ liveSlotsOnEntry'
+ = mapFoldWithKey patchLiveSlot liveSlotsOnEntry liveVRegsOnEntry
+
+ let info'
+ = LiveInfo static firstId
+ (Just liveVRegsOnEntry)
+ liveSlotsOnEntry'
+
+ -- Apply the spiller to all the basic blocks in the CmmProc.
+ sccs' <- mapM (mapSCCM (regSpill_block regSlotMap)) sccs
+
+ return $ CmmProc info' label sccs'
+
+ where -- | Given a BlockId and the set of registers live in it,
+ -- if registers in this block are being spilled to stack slots,
+ -- then record the fact that these slots are now live in those blocks
+ -- in the given slotmap.
+ patchLiveSlot :: BlockId -> RegSet -> Map BlockId (Set Int) -> Map BlockId (Set Int)
+ patchLiveSlot blockId regsLive slotMap
+ = let curSlotsLive = fromMaybe Set.empty
+ $ Map.lookup blockId slotMap
+
+ moreSlotsLive = Set.fromList
+ $ catMaybes
+ $ map (lookupUFM regSlotMap)
+ $ uniqSetToList regsLive
+
+ slotMap' = Map.insert blockId (Set.union curSlotsLive moreSlotsLive) slotMap
+
+ in slotMap'
+
+
+
+-- | Spill some registers to stack slots in a basic block.
+regSpill_block
+ :: Instruction instr
+ => UniqFM Int -- ^ map of vregs to slots they're being spilled to.
+ -> LiveBasicBlock instr
+ -> SpillM (LiveBasicBlock instr)
+