compiler/cmm/CmmStackLayout.hs

   1 module CmmStackLayout
   2     ( SlotEnv, liveSlotAnal, liveSlotTransfers, removeLiveSlotDefs
   3     , layout, manifestSP, igraph, areaBuilder
   4     , stubSlotsOnDeath ) -- to help crash early during debugging
   5 where
   6
   7 import Constants
   8 import qualified Prelude as P
   9 import Prelude hiding (zip, unzip, last)
  10
  11 import BlockId
  12 import CmmExpr
  13 import CmmProcPointZ
  14 import CmmTx
  15 import DFMonad
  16 import FiniteMap
  17 import Maybes
  18 import MkZipCfg
  19 import MkZipCfgCmm hiding (CmmBlock, CmmGraph)
  20 import Monad
  21 import Outputable
  22 import Panic
  23 import ZipCfg
  24 import ZipCfgCmmRep
  25 import ZipDataflow
  26
  27 ------------------------------------------------------------------------
  28 --                    Stack Layout                                    --
  29 ------------------------------------------------------------------------
  30
  31 -- | Before we lay out the stack, we need to know something about the
  32 -- liveness of the stack slots. In particular, to decide whether we can
  33 -- reuse a stack location to hold multiple stack slots, we need to know
  34 -- when each of the stack slots is used.
  35 -- Although tempted to use something simpler, we really need a full interference
  36 -- graph. Consider the following case:
  37 --   case <...> of
  38 --     1 -> <spill x>; // y is dead out
  39 --     2 -> <spill y>; // x is dead out
  40 --     3 -> <spill x and y>
  41 -- If we consider the arms in order and we use just the deadness information given by a
  42 -- dataflow analysis, we might decide to allocate the stack slots for x and y
  43 -- to the same stack location, which will lead to incorrect code in the third arm.
  44 -- We won't make this mistake with an interference graph.
  45
  46 -- First, the liveness analysis.
  47 -- We represent a slot with an area, an offset into the area, and a width.
  48 -- Tracking the live slots is a bit tricky because there may be loads and stores
  49 -- into only a part of a stack slot (e.g. loading the low word of a 2-word long),
  50 -- e.g. Slot A 0 8 overlaps with Slot A 4 4.
  51 --
  52 -- The definition of a slot set is intended to reduce the number of overlap
  53 -- checks we have to make. There's no reason to check for overlap between
  54 -- slots in different areas, so we segregate the map by Area's.
  55 -- We expect few slots in each Area, so we collect them in an unordered list.
  56 -- To keep these lists short, any contiguous live slots are coalesced into
  57 -- a single slot, on insertion.
  58
  59 slotLattice :: DataflowLattice SubAreaSet
  60 slotLattice = DataflowLattice "live slots" emptyFM add True
  61   where add new old = case foldFM addArea (False, old) new of
  62                         (True,  x) -> aTx  x
  63                         (False, x) -> noTx x
  64         addArea a newSlots z = foldr (addSlot a) z newSlots
  65         addSlot a slot (changed, map) =
  66           let (c, live) = liveGen slot $ lookupWithDefaultFM map [] a
  67           in (c || changed, addToFM map a live)
  68
  69 type SlotEnv   = BlockEnv SubAreaSet
  70 type SlotFix a = FuelMonad (BackwardFixedPoint Middle Last SubAreaSet a)
  71
  72 liveSlotAnal :: LGraph Middle Last -> FuelMonad SlotEnv
  73 liveSlotAnal g = liftM zdfFpFacts (res :: SlotFix ())
  74   where res = zdfSolveFromL emptyBlockEnv "live slot analysis" slotLattice
  75                             liveSlotTransfers (fact_bot slotLattice) g
  76
  77 -- Add the subarea s to the subareas in the list-set (possibly coalescing it with
  78 -- adjacent subareas), and also return whether s was a new addition.
  79 liveGen :: SubArea -> [SubArea] -> (Bool, [SubArea])
  80 liveGen s set = liveGen' s set []
  81   where liveGen' s [] z = (True, s : z)
  82         liveGen' s@(a, hi, w) (s'@(a', hi', w') : rst) z =
  83           if a /= a' || hi < lo' || lo > hi' then    -- no overlap
  84             liveGen' s rst (s' : z)
  85           else if s' `contains` s then               -- old contains new
  86             (False, set)
  87           else                                       -- overlap: coalesce the slots
  88             let new_hi = max hi hi'
  89                 new_lo = min lo lo'
  90             in liveGen' (a, new_hi, new_hi - new_lo) rst z
  91           where lo  = hi  - w  -- remember: areas grow down
  92                 lo' = hi' - w'
  93         contains (a, hi, w) (a', hi', w') =
  94           a == a' && hi >= hi' && hi - w <= hi' - w'
  95
  96 liveKill :: SubArea -> [SubArea] -> [SubArea]
  97 liveKill (a, hi, w) set = pprTrace "killing slots in area" (ppr a) $ liveKill' set []
  98   where liveKill' [] z = z
  99         liveKill' (s'@(a', hi', w') : rst) z =
 100           if a /= a' || hi < lo' || lo > hi' then    -- no overlap
 101             liveKill' rst (s' : z)
 102           else                                       -- overlap: split the old slot
 103             let z'  = if hi' > hi  then (a, hi', hi' - hi)  : z else z
 104                 z'' = if lo  > lo' then (a, lo,  lo  - lo') : z' else z'
 105             in liveKill' rst z''
 106           where lo  = hi  - w  -- remember: areas grow down
 107                 lo' = hi' - w'
 108
 109 -- Note: the stack slots that hold variables returned on the stack are not
 110 -- considered live in to the block -- we treat the first node as a definition site.
 111 -- BEWARE?: Am I being a little careless here in failing to check for the
 112 -- entry Id (which would use the CallArea Old).
 113 liveSlotTransfers :: BackwardTransfers Middle Last SubAreaSet
 114 liveSlotTransfers =
 115   BackwardTransfers first liveInSlots liveLastIn
 116     where first live id = delFromFM live (CallArea (Young id))
 117
 118 -- Slot sets: adding slots, removing slots, and checking for membership.
 119 liftToArea :: Area -> ([SubArea] -> [SubArea]) -> SubAreaSet -> SubAreaSet
 120 addSlot, removeSlot :: SubAreaSet -> SubArea -> SubAreaSet
 121 elemSlot            :: SubAreaSet -> SubArea -> Bool
 122 liftToArea a f map = addToFM map a $ f (lookupWithDefaultFM map [] a)
 123 addSlot    live (a, i, w) = liftToArea a (snd . liveGen  (a, i, w)) live
 124 removeSlot live (a, i, w) = liftToArea a       (liveKill (a, i, w)) live
 125 elemSlot   live (a, i, w) =
 126   not $ fst $ liveGen  (a, i, w) (lookupWithDefaultFM live [] a)
 127
 128 removeLiveSlotDefs :: (DefinerOfSlots s, UserOfSlots s) => SubAreaSet -> s -> SubAreaSet
 129 removeLiveSlotDefs = foldSlotsDefd removeSlot
 130
 131 liveInSlots :: (DefinerOfSlots s, UserOfSlots s) => SubAreaSet -> s -> SubAreaSet
 132 liveInSlots live x = foldSlotsUsed addSlot (removeLiveSlotDefs live x) x
 133
 134 liveLastIn :: (BlockId -> SubAreaSet) -> Last -> SubAreaSet
 135 liveLastIn env l = liveInSlots (liveLastOut env l) l
 136
 137 -- Don't forget to keep the outgoing parameters in the CallArea live,
 138 -- as well as the update frame.
 139 liveLastOut :: (BlockId -> SubAreaSet) -> Last -> SubAreaSet
 140 liveLastOut env l =
 141   case l of
 142     LastCall _ Nothing  n _ ->
 143       add_area (CallArea Old) n out -- add outgoing args (includes upd frame)
 144     LastCall _ (Just k) n _ -> add_area (CallArea (Young k)) n out
 145     _ -> out
 146   where out = joinOuts slotLattice env l
 147         add_area _ n live | n == 0 = live
 148         add_area a n live =
 149           addToFM live a $ snd $ liveGen (a, n, n) $ lookupWithDefaultFM live [] a
 150
 151 -- The liveness analysis must be precise: otherwise, we won't know if a definition
 152 -- should really kill a live-out stack slot.
 153 -- But the interference graph does not have to be precise -- it might decide that
 154 -- any live areas interfere. To maintain both a precise analysis and an imprecise
 155 -- interference graph, we need to convert the live-out stack slots to graph nodes
 156 -- at each and every instruction; rather than reconstruct a new list of nodes
 157 -- every time, I provide a function to fold over the nodes, which should be a
 158 -- reasonably efficient approach for the implementations we envision.
 159 -- Of course, it will probably be much easier to program if we just return a list...
 160 type Set x = FiniteMap x ()
 161 data IGraphBuilder n =
 162   Builder { foldNodes     :: forall z. SubArea -> (n -> z -> z) -> z -> z
 163           , _wordsOccupied :: AreaMap -> AreaMap -> n -> [Int]
 164           }
 165
 166 areaBuilder :: IGraphBuilder Area
 167 areaBuilder = Builder fold words
 168   where fold (a, _, _) f z = f a z
 169         words areaSize areaMap a =
 170           case lookupFM areaMap a of
 171             Just addr -> [addr .. addr + (lookupFM areaSize a `orElse`
 172                                           pprPanic "wordsOccupied: unknown area" (ppr a))]
 173             Nothing   -> []
 174
 175 --slotBuilder :: IGraphBuilder (Area, Int)
 176 --slotBuilder = undefined
 177
 178 -- Now, we can build the interference graph.
 179 -- The usual story: a definition interferes with all live outs and all other
 180 -- definitions.
 181 type IGraph x = FiniteMap x (Set x)
 182 type IGPair x = (IGraph x, IGraphBuilder x)
 183 igraph :: (Ord x) => IGraphBuilder x -> SlotEnv -> LGraph Middle Last -> IGraph x
 184 igraph builder env g = foldr interfere emptyFM (postorder_dfs g)
 185   where foldN = foldNodes builder
 186         interfere block igraph =
 187           let (h, l) = goto_end (unzip block)
 188               --heads :: ZHead Middle -> (IGraph x, SubAreaSet) -> IGraph x
 189               heads (ZFirst _ _) (igraph, _)       = igraph
 190               heads (ZHead h m)    (igraph, liveOut) =
 191                 heads h (addEdges igraph m liveOut, liveInSlots liveOut m)
 192               -- add edges between a def and the other defs and liveouts
 193               addEdges igraph i out = fst $ foldSlotsDefd addDef (igraph, out) i
 194               addDef (igraph, out) def@(a, _, _) =
 195                 (foldN def (addDefN out) igraph,
 196                  addToFM out a (snd $ liveGen def (lookupWithDefaultFM out [] a)))
 197               addDefN out n igraph =
 198                 let addEdgeNO o igraph = foldN o addEdgeNN igraph
 199                     addEdgeNN n' igraph = addEdgeNN' n n' $ addEdgeNN' n' n igraph
 200                     addEdgeNN' n n' igraph = addToFM igraph n (addToFM set n' ())
 201                       where set = lookupWithDefaultFM igraph emptyFM n
 202                 in foldFM (\ _ os igraph -> foldr addEdgeNO igraph os) igraph out
 203               env' bid = lookupBlockEnv env bid `orElse` panic "unknown blockId in igraph"
 204           in heads h $ case l of LastExit    -> (igraph, emptyFM)
 205                                  LastOther l -> (addEdges igraph l $ liveLastOut env' l,
 206                                                  liveLastIn env' l)
 207
 208 -- Before allocating stack slots, we need to collect one more piece of information:
 209 -- what's the highest offset (in bytes) used in each Area?
 210 -- We'll need to allocate that much space for each Area.
 211 getAreaSize :: LGraph Middle Last -> AreaMap
 212 getAreaSize g@(LGraph _ off _) =
 213   fold_blocks (fold_fwd_block first add_regslots last)
 214               (unitFM (CallArea Old) off) g
 215   where first id (StackInfo {argBytes = Just off}) z = add z (CallArea (Young id)) off
 216         first _  _          z = z
 217         add_regslots i z = foldSlotsUsed addSlot (foldSlotsDefd addSlot z i) i
 218         last l@(LastOther (LastCall _ Nothing off _)) z =
 219           add_regslots l (add z (CallArea Old) off)
 220         last l@(LastOther (LastCall _ (Just k) off _)) z =
 221           add_regslots l (add z (CallArea (Young k)) off)
 222         last l z = add_regslots l z
 223         addSlot z (a@(RegSlot _), off, _) = add z a off
 224         addSlot z _ = z
 225         add z a off = addToFM z a (max off (lookupWithDefaultFM z 0 a))
 226
 227
 228 -- Find the Stack slots occupied by the subarea's conflicts
 229 conflictSlots :: Ord x => IGPair x -> AreaMap -> AreaMap -> SubArea -> Set Int
 230 conflictSlots (ig, Builder foldNodes wordsOccupied) areaSize areaMap subarea =
 231   foldNodes subarea foldNode emptyFM
 232   where foldNode n set = foldFM conflict set $ lookupWithDefaultFM ig emptyFM n
 233         conflict n' () set = liveInSlots areaMap n' set
 234         -- Add stack slots occupied by igraph node n
 235         liveInSlots areaMap n set = foldr setAdd set (wordsOccupied areaSize areaMap n)
 236         setAdd w s = addToFM s w ()
 237
 238 -- Find any open space on the stack, starting from the offset.
 239 -- If the area is a CallArea or a spill slot for a pointer, then it must
 240 -- be word-aligned.
 241 freeSlotFrom :: Ord x => IGPair x -> AreaMap -> Int -> AreaMap -> Area -> Int
 242 freeSlotFrom ig areaSize offset areaMap area =
 243   let size = lookupFM areaSize area `orElse` 0
 244       conflicts = conflictSlots ig areaSize areaMap (area, size, size)
 245       -- CallAreas and Ptrs need to be word-aligned (round up!)
 246       align = case area of CallArea _                                -> align'
 247                            RegSlot  r | isGcPtrType (localRegType r) -> align'
 248                            RegSlot  _                                -> id
 249       align' n = (n + (wORD_SIZE - 1)) `div` wORD_SIZE * wORD_SIZE
 250       -- Find a space big enough to hold the area
 251       findSpace curr 0 = curr
 252       findSpace curr cnt = -- part of target slot, # of bytes left to check
 253         if elemFM curr conflicts then
 254           findSpace (align (curr + size)) size -- try the next (possibly) open space
 255         else findSpace (curr - 1) (cnt - 1)
 256   in findSpace (align (offset + size)) size
 257
 258 -- Find an open space on the stack, and assign it to the area.
 259 allocSlotFrom :: Ord x => IGPair x -> AreaMap -> Int -> AreaMap -> Area -> AreaMap
 260 allocSlotFrom ig areaSize from areaMap area =
 261   if elemFM area areaMap then areaMap
 262   else addToFM areaMap area $ freeSlotFrom ig areaSize from areaMap area
 263
 264 -- | Greedy stack layout.
 265 -- Compute liveness, build the interference graph, and allocate slots for the areas.
 266 -- We visit each basic block in a (generally) forward order.
 267 -- At each instruction that names a register subarea r, we immediately allocate
 268 -- any available slot on the stack by the following procedure:
 269 --  1. Find the nodes N' that conflict with r
 270 --  2. Find the stack slots used for N'
 271 --  3. Choose a contiguous stack space s not in N' (s must be large enough to hold r)
 272 -- For a CallArea, we allocate the stack space only when we reach a function
 273 -- call that returns to the CallArea's blockId.
 274 -- We use a similar procedure, with one exception: the stack space
 275 -- must be allocated below the youngest stack slot that is live out.
 276
 277 -- Note: The stack pointer only has to be younger than the youngest live stack slot
 278 -- at proc points. Otherwise, the stack pointer can point anywhere.
 279 layout :: ProcPointSet -> SlotEnv -> LGraph Middle Last -> AreaMap
 280 layout procPoints env g@(LGraph _ entrySp _) =
 281   let builder = areaBuilder
 282       ig = (igraph builder env g, builder)
 283       env' bid = lookupBlockEnv env bid `orElse` panic "unknown blockId in igraph"
 284       areaSize = getAreaSize g
 285       -- Find the slots that are live-in to the block
 286       live_in (ZTail m l) = liveInSlots (live_in l) m
 287       live_in (ZLast (LastOther l)) = liveLastIn env' l
 288       live_in (ZLast LastExit) = emptyFM
 289       -- Find the youngest live stack slot
 290       youngest_live areaMap live = fold_subareas young_slot live 0
 291         where young_slot (a, o, _) z = case lookupFM areaMap a of
 292                                          Just top -> max z $ top + o
 293                                          Nothing  -> z
 294       fold_subareas :: (SubArea -> z -> z) -> SubAreaSet -> z -> z
 295       fold_subareas f m z = foldFM (\_ s z -> foldr f z s) z m
 296       -- Allocate space for spill slots and call areas
 297       allocVarSlot = allocSlotFrom ig areaSize 0
 298       allocCallSlot areaMap (Block id stackInfo t)
 299         | elemBlockSet id procPoints =
 300         let young  = youngest_live areaMap $ live_in t
 301             start = case returnOff stackInfo of Just b  -> max b young
 302                                                 Nothing -> young
 303             z = allocSlotFrom ig areaSize start areaMap (CallArea (Young id))
 304         in pprTrace "allocCallSlot for" (ppr id <+> ppr young <+> ppr (live_in t) <+> ppr z) z
 305       allocCallSlot areaMap _ = areaMap
 306       -- mid foreign calls need to have info tables placed on the stack
 307       allocMidCall m@(MidForeignCall (Safe bid _) _ _ _) t areaMap =
 308         let young     = youngest_live areaMap $ removeLiveSlotDefs (live_in t) m
 309             area      = CallArea (Young bid)
 310             areaSize' = addToFM areaSize area (widthInBytes (typeWidth gcWord))
 311         in  allocSlotFrom ig areaSize' young areaMap area
 312       allocMidCall _ _ areaMap = areaMap
 313       alloc m t areaMap =
 314           foldSlotsDefd alloc' (foldSlotsUsed alloc' (allocMidCall m t areaMap) m) m
 315         where alloc' areaMap (a@(RegSlot _), _, _) = allocVarSlot areaMap a
 316               alloc' areaMap _ = areaMap
 317       layoutAreas areaMap b@(Block _ _ t) = layout areaMap t
 318         where layout areaMap (ZTail m t) = layout (alloc m t areaMap) t
 319               layout areaMap (ZLast _)   = allocCallSlot areaMap b
 320       areaMap = foldl layoutAreas (addToFM emptyFM (CallArea Old) 0) (postorder_dfs g)
 321   in pprTrace "ProcPoints" (ppr procPoints) $
 322        pprTrace "Area SizeMap" (ppr areaSize) $
 323          pprTrace "Entry SP" (ppr entrySp) $
 324            pprTrace "Area Map" (ppr areaMap) $ areaMap
 325
 326 -- After determining the stack layout, we can:
 327 -- 1. Replace references to stack Areas with addresses relative to the stack
 328 --    pointer.
 329 -- 2. Insert adjustments to the stack pointer to ensure that it is at a
 330 --    conventional location at each proc point.
 331 --    Because we don't take interrupts on the execution stack, we only need the
 332 --    stack pointer to be younger than the live values on the stack at proc points.
 333 -- 3. Compute the maximum stack offset used in the procedure and replace
 334 --    the stack high-water mark with that offset.
 335 manifestSP :: ProcPointSet -> BlockEnv Status -> AreaMap ->
 336                 LGraph Middle Last -> FuelMonad (LGraph Middle Last)
 337 manifestSP procPoints procMap areaMap g@(LGraph entry args blocks) =
 338   liftM (LGraph entry args) blocks'
 339   where blocks' = foldl replB (return emptyBlockEnv) (postorder_dfs g)
 340         slot a = pprTrace "slot" (ppr a) $
 341                    lookupFM areaMap a `orElse` panic "unallocated Area"
 342         slot' (Just id) = slot $ CallArea (Young id)
 343         slot' Nothing   = slot $ CallArea Old
 344         sp_high = maxSlot slot g
 345         proc_entry_sp = slot (CallArea Old) + args
 346         sp_on_entry id | id == entry = proc_entry_sp
 347         sp_on_entry id =
 348           case lookupBlockEnv blocks id of
 349             Just (Block _ (StackInfo {argBytes = Just o}) _) -> slot' (Just id) + o
 350             _ ->
 351              case expectJust "sp_on_entry" (lookupBlockEnv procMap id) of
 352                ReachedBy pp ->
 353                  case blockSetToList pp of
 354                    [id] -> sp_on_entry id
 355                    _    -> panic "block not reached by one proc point"
 356                ProcPoint -> pprPanic "procpoint doesn't take any arguments?"
 357                                (ppr id <+> ppr g <+> ppr procPoints <+> ppr procMap)
 358
 359         -- On entry to procpoints, the stack pointer is conventional;
 360         -- otherwise, we check the SP set by predecessors.
 361         replB :: FuelMonad (BlockEnv CmmBlock) -> CmmBlock -> FuelMonad (BlockEnv CmmBlock)
 362         replB blocks (Block id o t) =
 363           do bs <- replTail (Block id o) spIn t
 364              pprTrace "spIn" (ppr id <+> ppr spIn)$
 365               liftM (flip (foldr insertBlock) bs) blocks
 366           where spIn = sp_on_entry id
 367         replTail :: (ZTail Middle Last -> CmmBlock) -> Int -> (ZTail Middle Last) ->
 368                     FuelMonad ([CmmBlock])
 369         replTail h spOff (ZTail m@(MidForeignCall (Safe bid _) _ _ _) t) =
 370           replTail (\t' -> h (setSp spOff spOff' (ZTail (middle spOff m) t'))) spOff' t
 371             where spOff' = slot' (Just bid) + widthInBytes (typeWidth gcWord)
 372         replTail h spOff (ZTail m t) = replTail (h . ZTail (middle spOff m)) spOff t
 373         replTail h spOff (ZLast (LastOther l)) = fixSp h spOff l
 374         replTail h _   l@(ZLast LastExit) = return [h l]
 375         middle spOff m = mapExpDeepMiddle (replSlot spOff) m
 376         last   spOff l = mapExpDeepLast   (replSlot spOff) l
 377         replSlot spOff (CmmStackSlot a i) = CmmRegOff (CmmGlobal Sp) (spOff - (slot a + i))
 378         replSlot spOff (CmmLit CmmHighStackMark) = -- replacing the high water mark
 379           CmmLit (CmmInt (toInteger (max 0 (sp_high - proc_entry_sp))) (typeWidth bWord))
 380         replSlot _ e = e
 381         -- The block must establish the SP expected at each successsor.
 382         fixSp :: (ZTail Middle Last -> CmmBlock) -> Int -> Last -> FuelMonad ([CmmBlock])
 383         fixSp h spOff l@(LastCall _ k n _) = updSp h spOff (slot' k + n) l
 384         fixSp h spOff l@(LastBranch k) =
 385           let succSp = sp_on_entry k in
 386           if succSp /= spOff then
 387                pprTrace "updSp" (ppr k <> ppr spOff <> ppr (sp_on_entry k)) $
 388                updSp h spOff succSp l
 389           else return $ [h (ZLast (LastOther (last spOff l)))]
 390         fixSp h spOff l = liftM (uncurry (:)) $ fold_succs succ l $ return (b, [])
 391           where b = h (ZLast (LastOther (last spOff l)))
 392                 succ succId z =
 393                   let succSp = sp_on_entry succId in
 394                   if succSp /= spOff then
 395                     do (b,  bs)  <- z
 396                        (b', bs') <- insertBetween b [setSpMid spOff succSp] succId
 397                        return (b', bs ++ bs')
 398                   else z
 399         updSp h old new l = return [h $ setSp old new $ ZLast $ LastOther (last new l)]
 400         setSpMid sp sp' = MidAssign (CmmGlobal Sp) e
 401           where e = CmmMachOp (MO_Add wordWidth) [CmmReg (CmmGlobal Sp), off]
 402                 off = CmmLit $ CmmInt (toInteger $ sp - sp') wordWidth
 403         setSp sp sp' t = if sp == sp' then t else ZTail (setSpMid sp sp') t
 404
 405
 406 -- To compute the stack high-water mark, we fold over the graph and
 407 -- compute the highest slot offset.
 408 maxSlot :: (Area -> Int) -> CmmGraph -> Int
 409 maxSlot slotOff g = fold_blocks (fold_fwd_block (\ _ _ x -> x) highSlot highSlot) 0 g
 410   where highSlot i z = foldSlotsUsed add (foldSlotsDefd add z i) i
 411         add z (a, i, w) = max z (slotOff a + i)
 412
 413 -----------------------------------------------------------------------------
 414 -- | Sanity check: stub pointers immediately after they die
 415 -----------------------------------------------------------------------------
 416 -- This will miss stack slots that are last used in a Last node,
 417 -- but it should do pretty well...
 418
 419 type StubPtrFix = FuelMonad (BackwardFixedPoint Middle Last SubAreaSet CmmGraph)
 420
 421 stubSlotsOnDeath :: (LGraph Middle Last) -> FuelMonad (LGraph Middle Last)
 422 stubSlotsOnDeath g = liftM zdfFpContents $ (res :: StubPtrFix)
 423     where res = zdfBRewriteFromL RewriteShallow emptyBlockEnv "stub ptrs" slotLattice
 424                                  liveSlotTransfers rewrites (fact_bot slotLattice) g
 425           rewrites = BackwardRewrites first middle last Nothing
 426           first _ _ = Nothing
 427           last  _ _ = Nothing
 428           middle liveSlots m = foldSlotsUsed (stub liveSlots m) Nothing m
 429           stub liveSlots m rst subarea@(a, off, w) =
 430             if elemSlot liveSlots subarea then rst
 431             else let store = mkStore (CmmStackSlot a off)
 432                                      (stackStubExpr (widthFromBytes w))
 433                  in case rst of Nothing -> Just (mkMiddle m <*> store)
 434                                 Just g  -> Just (g <*> store)