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