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 False
  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) $
  98                           liveKill' set []
  99   where liveKill' [] z = z
 100         liveKill' (s'@(a', hi', w') : rst) z =
 101           if a /= a' || hi < lo' || lo > hi' then    -- no overlap
 102             liveKill' rst (s' : z)
 103           else                                       -- overlap: split the old slot
 104             let z'  = if hi' > hi  then (a, hi', hi' - hi)  : z else z
 105                 z'' = if lo  > lo' then (a, lo,  lo  - lo') : z' else z'
 106             in liveKill' rst z''
 107           where lo  = hi  - w  -- remember: areas grow down
 108                 lo' = hi' - w'
 109
 110 -- Note: the stack slots that hold variables returned on the stack are not
 111 -- considered live in to the block -- we treat the first node as a definition site.
 112 -- BEWARE?: Am I being a little careless here in failing to check for the
 113 -- entry Id (which would use the CallArea Old).
 114 liveSlotTransfers :: BackwardTransfers Middle Last SubAreaSet
 115 liveSlotTransfers =
 116   BackwardTransfers first liveInSlots liveLastIn
 117     where first live id = delFromFM live (CallArea (Young id))
 118
 119 -- Slot sets: adding slots, removing slots, and checking for membership.
 120 liftToArea :: Area -> ([SubArea] -> [SubArea]) -> SubAreaSet -> SubAreaSet
 121 addSlot, removeSlot :: SubAreaSet -> SubArea -> SubAreaSet
 122 elemSlot            :: SubAreaSet -> SubArea -> Bool
 123 liftToArea a f map = addToFM map a $ f (lookupWithDefaultFM map [] a)
 124 addSlot    live (a, i, w) = liftToArea a (snd . liveGen  (a, i, w)) live
 125 removeSlot live (a, i, w) = liftToArea a       (liveKill (a, i, w)) live
 126 elemSlot   live (a, i, w) =
 127   not $ fst $ liveGen  (a, i, w) (lookupWithDefaultFM live [] a)
 128
 129 removeLiveSlotDefs :: (DefinerOfSlots s, UserOfSlots s) => SubAreaSet -> s -> SubAreaSet
 130 removeLiveSlotDefs = foldSlotsDefd removeSlot
 131
 132 liveInSlots :: (DefinerOfSlots s, UserOfSlots s) => SubAreaSet -> s -> SubAreaSet
 133 liveInSlots live x = foldSlotsUsed addSlot (removeLiveSlotDefs live x) x
 134
 135 liveLastIn :: (BlockId -> SubAreaSet) -> Last -> SubAreaSet
 136 liveLastIn env l = liveInSlots (liveLastOut env l) l
 137
 138 -- Don't forget to keep the outgoing parameters in the CallArea live,
 139 -- as well as the update frame.
 140 -- Note: We have to keep the update frame live at a call because of the
 141 -- case where the function doesn't return -- in that case, there won't
 142 -- be a return to keep the update frame live. We'd still better keep the
 143 -- info pointer in the update frame live at any call site;
 144 -- otherwise we could screw up the garbage collector.
 145 liveLastOut :: (BlockId -> SubAreaSet) -> Last -> SubAreaSet
 146 liveLastOut env l =
 147   case l of
 148     LastCall _ Nothing n _ ->
 149       add_area (CallArea Old) n out -- add outgoing args (includes upd frame)
 150     LastCall _ (Just k) n (Just _) ->
 151       add_area (CallArea Old) n (add_area (CallArea (Young k)) n out)
 152     LastCall _ (Just k) n Nothing ->
 153       add_area (CallArea (Young k)) n out
 154     _ -> out
 155   where out = joinOuts slotLattice env l
 156         add_area _ n live | n == 0 = live
 157         add_area a n live =
 158           addToFM live a $ snd $ liveGen (a, n, n) $ lookupWithDefaultFM live [] a
 159
 160 -- The liveness analysis must be precise: otherwise, we won't know if a definition
 161 -- should really kill a live-out stack slot.
 162 -- But the interference graph does not have to be precise -- it might decide that
 163 -- any live areas interfere. To maintain both a precise analysis and an imprecise
 164 -- interference graph, we need to convert the live-out stack slots to graph nodes
 165 -- at each and every instruction; rather than reconstruct a new list of nodes
 166 -- every time, I provide a function to fold over the nodes, which should be a
 167 -- reasonably efficient approach for the implementations we envision.
 168 -- Of course, it will probably be much easier to program if we just return a list...
 169 type Set x = FiniteMap x ()
 170 data IGraphBuilder n =
 171   Builder { foldNodes     :: forall z. SubArea -> (n -> z -> z) -> z -> z
 172           , _wordsOccupied :: AreaMap -> AreaMap -> n -> [Int]
 173           }
 174
 175 areaBuilder :: IGraphBuilder Area
 176 areaBuilder = Builder fold words
 177   where fold (a, _, _) f z = f a z
 178         words areaSize areaMap a =
 179           case lookupFM areaMap a of
 180             Just addr -> [addr .. addr + (lookupFM areaSize a `orElse`
 181                                           pprPanic "wordsOccupied: unknown area" (ppr a))]
 182             Nothing   -> []
 183
 184 --slotBuilder :: IGraphBuilder (Area, Int)
 185 --slotBuilder = undefined
 186
 187 -- Now, we can build the interference graph.
 188 -- The usual story: a definition interferes with all live outs and all other
 189 -- definitions.
 190 type IGraph x = FiniteMap x (Set x)
 191 type IGPair x = (IGraph x, IGraphBuilder x)
 192 igraph :: (Ord x) => IGraphBuilder x -> SlotEnv -> LGraph Middle Last -> IGraph x
 193 igraph builder env g = foldr interfere emptyFM (postorder_dfs g)
 194   where foldN = foldNodes builder
 195         interfere block igraph =
 196           let (h, l) = goto_end (unzip block)
 197               --heads :: ZHead Middle -> (IGraph x, SubAreaSet) -> IGraph x
 198               heads (ZFirst _ _) (igraph, _)       = igraph
 199               heads (ZHead h m)    (igraph, liveOut) =
 200                 heads h (addEdges igraph m liveOut, liveInSlots liveOut m)
 201               -- add edges between a def and the other defs and liveouts
 202               addEdges igraph i out = fst $ foldSlotsDefd addDef (igraph, out) i
 203               addDef (igraph, out) def@(a, _, _) =
 204                 (foldN def (addDefN out) igraph,
 205                  addToFM out a (snd $ liveGen def (lookupWithDefaultFM out [] a)))
 206               addDefN out n igraph =
 207                 let addEdgeNO o igraph = foldN o addEdgeNN igraph
 208                     addEdgeNN n' igraph = addEdgeNN' n n' $ addEdgeNN' n' n igraph
 209                     addEdgeNN' n n' igraph = addToFM igraph n (addToFM set n' ())
 210                       where set = lookupWithDefaultFM igraph emptyFM n
 211                 in foldFM (\ _ os igraph -> foldr addEdgeNO igraph os) igraph out
 212               env' bid = lookupBlockEnv env bid `orElse` panic "unknown blockId in igraph"
 213           in heads h $ case l of LastExit    -> (igraph, emptyFM)
 214                                  LastOther l -> (addEdges igraph l $ liveLastOut env' l,
 215                                                  liveLastIn env' l)
 216
 217 -- Before allocating stack slots, we need to collect one more piece of information:
 218 -- what's the highest offset (in bytes) used in each Area?
 219 -- We'll need to allocate that much space for each Area.
 220 getAreaSize :: LGraph Middle Last -> AreaMap
 221 getAreaSize g@(LGraph _ off _) =
 222   fold_blocks (fold_fwd_block first add_regslots last)
 223               (unitFM (CallArea Old) off) g
 224   where first id (StackInfo {argBytes = Just off}) z = add z (CallArea (Young id)) off
 225         first _  _          z = z
 226         add_regslots i z = foldSlotsUsed addSlot (foldSlotsDefd addSlot z i) i
 227         last l@(LastOther (LastCall _ Nothing off _)) z =
 228           add_regslots l (add z (CallArea Old) off)
 229         last l@(LastOther (LastCall _ (Just k) off _)) z =
 230           add_regslots l (add z (CallArea (Young k)) off)
 231         last l z = add_regslots l z
 232         addSlot z (a@(RegSlot _), off, _) = add z a off
 233         addSlot z _ = z
 234         add z a off = addToFM z a (max off (lookupWithDefaultFM z 0 a))
 235
 236
 237 -- Find the Stack slots occupied by the subarea's conflicts
 238 conflictSlots :: Ord x => IGPair x -> AreaMap -> AreaMap -> SubArea -> Set Int
 239 conflictSlots (ig, Builder foldNodes wordsOccupied) areaSize areaMap subarea =
 240   foldNodes subarea foldNode emptyFM
 241   where foldNode n set = foldFM conflict set $ lookupWithDefaultFM ig emptyFM n
 242         conflict n' () set = liveInSlots areaMap n' set
 243         -- Add stack slots occupied by igraph node n
 244         liveInSlots areaMap n set = foldr setAdd set (wordsOccupied areaSize areaMap n)
 245         setAdd w s = addToFM s w ()
 246
 247 -- Find any open space on the stack, starting from the offset.
 248 -- If the area is a CallArea or a spill slot for a pointer, then it must
 249 -- be word-aligned.
 250 freeSlotFrom :: Ord x => IGPair x -> AreaMap -> Int -> AreaMap -> Area -> Int
 251 freeSlotFrom ig areaSize offset areaMap area =
 252   let size = lookupFM areaSize area `orElse` 0
 253       conflicts = conflictSlots ig areaSize areaMap (area, size, size)
 254       -- CallAreas and Ptrs need to be word-aligned (round up!)
 255       align = case area of CallArea _                                -> align'
 256                            RegSlot  r | isGcPtrType (localRegType r) -> align'
 257                            RegSlot  _                                -> id
 258       align' n = (n + (wORD_SIZE - 1)) `div` wORD_SIZE * wORD_SIZE
 259       -- Find a space big enough to hold the area
 260       findSpace curr 0 = curr
 261       findSpace curr cnt = -- part of target slot, # of bytes left to check
 262         if elemFM curr conflicts then
 263           findSpace (align (curr + size)) size -- try the next (possibly) open space
 264         else findSpace (curr - 1) (cnt - 1)
 265   in findSpace (align (offset + size)) size
 266
 267 -- Find an open space on the stack, and assign it to the area.
 268 allocSlotFrom :: Ord x => IGPair x -> AreaMap -> Int -> AreaMap -> Area -> AreaMap
 269 allocSlotFrom ig areaSize from areaMap area =
 270   if elemFM area areaMap then areaMap
 271   else addToFM areaMap area $ freeSlotFrom ig areaSize from areaMap area
 272
 273 -- | Greedy stack layout.
 274 -- Compute liveness, build the interference graph, and allocate slots for the areas.
 275 -- We visit each basic block in a (generally) forward order.
 276 -- At each instruction that names a register subarea r, we immediately allocate
 277 -- any available slot on the stack by the following procedure:
 278 --  1. Find the nodes N' that conflict with r
 279 --  2. Find the stack slots used for N'
 280 --  3. Choose a contiguous stack space s not in N' (s must be large enough to hold r)
 281 -- For a CallArea, we allocate the stack space only when we reach a function
 282 -- call that returns to the CallArea's blockId.
 283 -- We use a similar procedure, with one exception: the stack space
 284 -- must be allocated below the youngest stack slot that is live out.
 285
 286 -- Note: The stack pointer only has to be younger than the youngest live stack slot
 287 -- at proc points. Otherwise, the stack pointer can point anywhere.
 288 layout :: ProcPointSet -> SlotEnv -> LGraph Middle Last -> AreaMap
 289 layout procPoints env g =
 290   let builder = areaBuilder
 291       ig = (igraph builder env g, builder)
 292       env' bid = lookupBlockEnv env bid `orElse` panic "unknown blockId in igraph"
 293       areaSize = getAreaSize g
 294       -- Find the slots that are live-in to the block
 295       live_in (ZTail m l) = liveInSlots (live_in l) m
 296       live_in (ZLast (LastOther l)) = liveLastIn env' l
 297       live_in (ZLast LastExit) = emptyFM
 298       -- Find the youngest live stack slot
 299       youngest_live areaMap live = fold_subareas young_slot live 0
 300         where young_slot (a, o, _) z = case lookupFM areaMap a of
 301                                          Just top -> max z $ top + o
 302                                          Nothing  -> z
 303       fold_subareas :: (SubArea -> z -> z) -> SubAreaSet -> z -> z
 304       fold_subareas f m z = foldFM (\_ s z -> foldr f z s) z m
 305       -- Allocate space for spill slots and call areas
 306       allocVarSlot = allocSlotFrom ig areaSize 0
 307       allocCallSlot areaMap (Block id stackInfo t)
 308         | elemBlockSet id procPoints =
 309         let young  = youngest_live areaMap $ live_in t
 310             start = case returnOff stackInfo of Just b  -> max b young
 311                                                 Nothing -> young
 312             z = allocSlotFrom ig areaSize start areaMap (CallArea (Young id))
 313         in -- pprTrace "allocCallSlot for" (ppr id <+> ppr young <+> ppr (live_in t) <+> ppr z)
 314            z
 315       allocCallSlot areaMap _ = areaMap
 316       -- mid foreign calls need to have info tables placed on the stack
 317       allocMidCall m@(MidForeignCall (Safe bid _) _ _ _) t areaMap =
 318         let young     = youngest_live areaMap $ removeLiveSlotDefs (live_in t) m
 319             area      = CallArea (Young bid)
 320             areaSize' = addToFM areaSize area (widthInBytes (typeWidth gcWord))
 321         in  allocSlotFrom ig areaSize' young areaMap area
 322       allocMidCall _ _ areaMap = areaMap
 323       alloc m t areaMap =
 324           foldSlotsDefd alloc' (foldSlotsUsed alloc' (allocMidCall m t areaMap) m) m
 325         where alloc' areaMap (a@(RegSlot _), _, _) = allocVarSlot areaMap a
 326               alloc' areaMap _ = areaMap
 327       layoutAreas areaMap b@(Block _ _ t) = layout areaMap t
 328         where layout areaMap (ZTail m t) = layout (alloc m t areaMap) t
 329               layout areaMap (ZLast _)   = allocCallSlot areaMap b
 330       areaMap = foldl layoutAreas (addToFM emptyFM (CallArea Old) 0) (postorder_dfs g)
 331   in -- pprTrace "ProcPoints" (ppr procPoints) $
 332        -- pprTrace "Area SizeMap" (ppr areaSize) $
 333          -- pprTrace "Entry SP" (ppr entrySp) $
 334            -- pprTrace "Area Map" (ppr areaMap) $
 335      areaMap
 336
 337 -- After determining the stack layout, we can:
 338 -- 1. Replace references to stack Areas with addresses relative to the stack
 339 --    pointer.
 340 -- 2. Insert adjustments to the stack pointer to ensure that it is at a
 341 --    conventional location at each proc point.
 342 --    Because we don't take interrupts on the execution stack, we only need the
 343 --    stack pointer to be younger than the live values on the stack at proc points.
 344 -- 3. Compute the maximum stack offset used in the procedure and replace
 345 --    the stack high-water mark with that offset.
 346 manifestSP :: ProcPointSet -> BlockEnv Status -> AreaMap ->
 347                 LGraph Middle Last -> FuelMonad (LGraph Middle Last)
 348 manifestSP procPoints procMap areaMap g@(LGraph entry args blocks) =
 349   liftM (LGraph entry args) blocks'
 350   where blocks' = foldl replB (return emptyBlockEnv) (postorder_dfs g)
 351         slot a = -- pprTrace "slot" (ppr a) $
 352                    lookupFM areaMap a `orElse` panic "unallocated Area"
 353         slot' (Just id) = slot $ CallArea (Young id)
 354         slot' Nothing   = slot $ CallArea Old
 355         sp_high = maxSlot slot g
 356         proc_entry_sp = slot (CallArea Old) + args
 357         sp_on_entry id | id == entry = proc_entry_sp
 358         sp_on_entry id =
 359           case lookupBlockEnv blocks id of
 360             Just (Block _ (StackInfo {argBytes = Just o}) _) -> slot' (Just id) + o
 361             _ ->
 362              case expectJust "sp_on_entry" (lookupBlockEnv procMap id) of
 363                ReachedBy pp ->
 364                  case blockSetToList pp of
 365                    [id] -> sp_on_entry id
 366                    _    -> panic "block not reached by one proc point"
 367                ProcPoint -> pprPanic "procpoint doesn't take any arguments?"
 368                                (ppr id <+> ppr g <+> ppr procPoints <+> ppr procMap)
 369
 370         -- On entry to procpoints, the stack pointer is conventional;
 371         -- otherwise, we check the SP set by predecessors.
 372         replB :: FuelMonad (BlockEnv CmmBlock) -> CmmBlock -> FuelMonad (BlockEnv CmmBlock)
 373         replB blocks (Block id o t) =
 374           do bs <- replTail (Block id o) spIn t
 375              -- pprTrace "spIn" (ppr id <+> ppr spIn) $ do
 376              liftM (flip (foldr insertBlock) bs) blocks
 377           where spIn = sp_on_entry id
 378         replTail :: (ZTail Middle Last -> CmmBlock) -> Int -> (ZTail Middle Last) ->
 379                     FuelMonad ([CmmBlock])
 380         replTail h spOff (ZTail m@(MidForeignCall (Safe bid _) _ _ _) t) =
 381           replTail (\t' -> h (setSp spOff spOff' (ZTail (middle spOff m) t'))) spOff' t
 382             where spOff' = slot' (Just bid) + widthInBytes (typeWidth gcWord)
 383         replTail h spOff (ZTail m t) = replTail (h . ZTail (middle spOff m)) spOff t
 384         replTail h spOff (ZLast (LastOther l)) = fixSp h spOff l
 385         replTail h _   l@(ZLast LastExit) = return [h l]
 386         middle spOff m = mapExpDeepMiddle (replSlot spOff) m
 387         last   spOff l = mapExpDeepLast   (replSlot spOff) l
 388         replSlot spOff (CmmStackSlot a i) = CmmRegOff (CmmGlobal Sp) (spOff - (slot a + i))
 389         replSlot _ (CmmLit CmmHighStackMark) = -- replacing the high water mark
 390           CmmLit (CmmInt (toInteger (max 0 (sp_high - proc_entry_sp))) (typeWidth bWord))
 391         replSlot _ e = e
 392         -- The block must establish the SP expected at each successsor.
 393         fixSp :: (ZTail Middle Last -> CmmBlock) -> Int -> Last -> FuelMonad ([CmmBlock])
 394         fixSp h spOff l@(LastCall _ k n _) = updSp h spOff (slot' k + n) l
 395         fixSp h spOff l@(LastBranch k) =
 396           let succSp = sp_on_entry k in
 397           if succSp /= spOff then
 398                -- pprTrace "updSp" (ppr k <> ppr spOff <> ppr (sp_on_entry k)) $
 399                updSp h spOff succSp l
 400           else return $ [h (ZLast (LastOther (last spOff l)))]
 401         fixSp h spOff l = liftM (uncurry (:)) $ fold_succs succ l $ return (b, [])
 402           where b = h (ZLast (LastOther (last spOff l)))
 403                 succ succId z =
 404                   let succSp = sp_on_entry succId in
 405                   if succSp /= spOff then
 406                     do (b,  bs)  <- z
 407                        (b', bs') <- insertBetween b [setSpMid spOff succSp] succId
 408                        return (b', bs ++ bs')
 409                   else z
 410         updSp h old new l = return [h $ setSp old new $ ZLast $ LastOther (last new l)]
 411         setSpMid sp sp' = MidAssign (CmmGlobal Sp) e
 412           where e = CmmMachOp (MO_Add wordWidth) [CmmReg (CmmGlobal Sp), off]
 413                 off = CmmLit $ CmmInt (toInteger $ sp - sp') wordWidth
 414         setSp sp sp' t = if sp == sp' then t else ZTail (setSpMid sp sp') t
 415
 416
 417 -- To compute the stack high-water mark, we fold over the graph and
 418 -- compute the highest slot offset.
 419 maxSlot :: (Area -> Int) -> CmmGraph -> Int
 420 maxSlot slotOff g = fold_blocks (fold_fwd_block (\ _ _ x -> x) highSlot highSlot) 0 g
 421   where highSlot i z = foldSlotsUsed add (foldSlotsDefd add z i) i
 422         add z (a, i, _) = max z (slotOff a + i)
 423
 424 -----------------------------------------------------------------------------
 425 -- | Sanity check: stub pointers immediately after they die
 426 -----------------------------------------------------------------------------
 427 -- This will miss stack slots that are last used in a Last node,
 428 -- but it should do pretty well...
 429
 430 type StubPtrFix = FuelMonad (BackwardFixedPoint Middle Last SubAreaSet CmmGraph)
 431
 432 stubSlotsOnDeath :: (LGraph Middle Last) -> FuelMonad (LGraph Middle Last)
 433 stubSlotsOnDeath g = liftM zdfFpContents $ (res :: StubPtrFix)
 434     where res = zdfBRewriteFromL RewriteShallow emptyBlockEnv "stub ptrs" slotLattice
 435                                  liveSlotTransfers rewrites (fact_bot slotLattice) g
 436           rewrites = BackwardRewrites first middle last Nothing
 437           first _ _ = Nothing
 438           last  _ _ = Nothing
 439           middle liveSlots m = foldSlotsUsed (stub liveSlots m) Nothing m
 440           stub liveSlots m rst subarea@(a, off, w) =
 441             if elemSlot liveSlots subarea then rst
 442             else let store = mkStore (CmmStackSlot a off)
 443                                      (stackStubExpr (widthFromBytes w))
 444                  in case rst of Nothing -> Just (mkMiddle m <*> store)
 445                                 Just g  -> Just (g <*> store)