CmmSink.hs 18 KB
Newer Older
1 2
{-# LANGUAGE GADTs #-}
module CmmSink (
3
     cmmSink
4 5
  ) where

6 7
import StgCmmUtils (callerSaves)

8 9 10 11 12 13 14
import Cmm
import BlockId
import CmmLive
import CmmUtils
import Hoopl

import UniqFM
Simon Marlow's avatar
Simon Marlow committed
15
-- import PprCmm ()
Simon Marlow's avatar
Simon Marlow committed
16
-- import Outputable
17

18
import Data.List (partition)
19 20 21
import qualified Data.Set as Set

-- -----------------------------------------------------------------------------
Simon Marlow's avatar
Simon Marlow committed
22
-- Sinking and inlining
23 24 25 26

-- This is an optimisation pass that
--  (a) moves assignments closer to their uses, to reduce register pressure
--  (b) pushes assignments into a single branch of a conditional if possible
Simon Marlow's avatar
Simon Marlow committed
27 28 29 30 31 32
--  (c) inlines assignments to registers that are mentioned only once
--  (d) discards dead assignments
--
-- This tightens up lots of register-heavy code.  It is particularly
-- helpful in the Cmm generated by the Stg->Cmm code generator, in
-- which every function starts with a copyIn sequence like:
33 34 35 36 37 38 39 40 41 42 43
--
--    x1 = R1
--    x2 = Sp[8]
--    x3 = Sp[16]
--    if (Sp - 32 < SpLim) then L1 else L2
--
-- we really want to push the x1..x3 assignments into the L2 branch.
--
-- Algorithm:
--
--  * Start by doing liveness analysis.
Simon Marlow's avatar
Simon Marlow committed
44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
--
--  * Keep a list of assignments A; earlier ones may refer to later ones
--
--  * Walk forwards through the graph, look at each node N:
--    * If any assignments in A (1) occur only once in N, and (2) are
--      not live after N, inline the assignment and remove it
--      from A.
--    * If N is an assignment:
--      * If the register is not live after N, discard it
--      * otherwise pick up the assignment and add it to A
--    * If N is a non-assignment node:
--      * remove any assignments from A that conflict with N, and
--        place them before N in the current block.  (we call this
--        "dropping" the assignments).
--      * An assignment conflicts with N if it:
--        - assigns to a register mentioned in N
--        - mentions a register assigned by N
--        - reads from memory written by N
62 63 64
--      * do this recursively, dropping dependent assignments
--    * At a multi-way branch:
--      * drop any assignments that are live on more than one branch
Simon Marlow's avatar
Simon Marlow committed
65 66
--      * if any successor has more than one predecessor (a
--        join-point), drop everything live in that successor
67 68
-- 
-- As a side-effect we'll delete some dead assignments (transitively,
Simon Marlow's avatar
Simon Marlow committed
69 70
-- even).  This isn't as good as removeDeadAssignments, but it's much
-- cheaper.
71 72 73 74 75 76 77

-- If we do this *before* stack layout, we might be able to avoid
-- saving some things across calls/procpoints.
--
-- *but*, that will invalidate the liveness analysis, and we'll have
-- to re-do it.

Simon Marlow's avatar
Simon Marlow committed
78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97
-- TODO: things that we aren't optimising very well yet.
--
-- From GHC's FastString.hashStr:
--
--  s2ay:
--      if ((_s2an::I64 == _s2ao::I64) >= 1) goto c2gn; else goto c2gp;
--  c2gn:
--      R1 = _s2au::I64;
--      call (I64[Sp])(R1) args: 8, res: 0, upd: 8;
--  c2gp:
--      _s2cO::I64 = %MO_S_Rem_W64(%MO_UU_Conv_W8_W64(I8[_s2aq::I64 + (_s2an::I64 << 0)]) + _s2au::I64 * 128,
--                                 4091);
--      _s2an::I64 = _s2an::I64 + 1;
--      _s2au::I64 = _s2cO::I64;
--      goto s2ay;
--
-- a nice loop, but we didn't eliminate the silly assignment at the end.
-- See Note [dependent assignments], which would probably fix this.
--

98
type Assignment = (LocalReg, CmmExpr, AbsMem)
Simon Marlow's avatar
Simon Marlow committed
99 100
  -- Assignment caches AbsMem, an abstraction of the memory read by
  -- the RHS of the assignment.
101

102 103
cmmSink :: CmmGraph -> CmmGraph
cmmSink graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks
104
  where
105
  liveness = cmmLiveness graph
Simon Marlow's avatar
Simon Marlow committed
106
  getLive l = mapFindWithDefault Set.empty l liveness
107 108 109

  blocks = postorderDfs graph

Simon Marlow's avatar
Simon Marlow committed
110
  join_pts = findJoinPoints blocks
Simon Marlow's avatar
Simon Marlow committed
111

112 113 114
  sink :: BlockEnv [Assignment] -> [CmmBlock] -> [CmmBlock]
  sink _ [] = []
  sink sunk (b:bs) =
Simon Marlow's avatar
Simon Marlow committed
115
    -- pprTrace "sink" (ppr lbl) $
Simon Marlow's avatar
Simon Marlow committed
116
    blockJoin first final_middle final_last : sink sunk' bs
117 118 119 120
    where
      lbl = entryLabel b
      (first, middle, last) = blockSplit b

Simon Marlow's avatar
Simon Marlow committed
121
      succs = successors last
122

Simon Marlow's avatar
Simon Marlow committed
123 124 125 126 127
      -- Annotate the middle nodes with the registers live *after*
      -- the node.  This will help us decide whether we can inline
      -- an assignment in the current node or not.
      live = Set.unions (map getLive succs)
      live_middle = gen_kill last live
128 129
      ann_middles = annotate live_middle (blockToList middle)

Simon Marlow's avatar
Simon Marlow committed
130 131 132 133
      -- Now sink and inline in this block
      (middle', assigs) = walk ann_middles (mapFindWithDefault [] lbl sunk)
      (final_last, assigs') = tryToInline live last assigs

Simon Marlow's avatar
Simon Marlow committed
134 135 136
      -- We cannot sink into join points (successors with more than
      -- one predecessor), so identify the join points and the set
      -- of registers live in them.
137
      (joins, nonjoins) = partition (`mapMember` join_pts) succs
Simon Marlow's avatar
Simon Marlow committed
138 139 140 141 142 143 144 145 146 147 148 149 150 151
      live_in_joins = Set.unions (map getLive joins)

      -- We do not want to sink an assignment into multiple branches,
      -- so identify the set of registers live in multiple successors.
      -- This is made more complicated because when we sink an assignment
      -- into one branch, this might change the set of registers that are
      -- now live in multiple branches.
      init_live_sets = map getLive nonjoins
      live_in_multi live_sets r =
         case filter (Set.member r) live_sets of
           (_one:_two:_) -> True
           _ -> False

      -- Now, drop any assignments that we will not sink any further.
Simon Marlow's avatar
Simon Marlow committed
152
      (dropped_last, assigs'') = dropAssignments drop_if init_live_sets assigs'
Simon Marlow's avatar
Simon Marlow committed
153 154 155

      drop_if a@(r,rhs,_) live_sets = (should_drop, live_sets')
          where
Simon Marlow's avatar
Simon Marlow committed
156
            should_drop =  a `conflicts` final_last
Simon Marlow's avatar
Simon Marlow committed
157 158
                        || {- not (isTiny rhs) && -} live_in_multi live_sets r
                        || r `Set.member` live_in_joins
159

Simon Marlow's avatar
Simon Marlow committed
160 161
            live_sets' | should_drop = live_sets
                       | otherwise   = map upd live_sets
162

Simon Marlow's avatar
Simon Marlow committed
163 164
            upd set | r `Set.member` set = set `Set.union` live_rhs
                    | otherwise          = set
165

Simon Marlow's avatar
Simon Marlow committed
166
            live_rhs = foldRegsUsed extendRegSet emptyRegSet rhs
167 168 169 170

      final_middle = foldl blockSnoc middle' dropped_last

      sunk' = mapUnion sunk $
Simon Marlow's avatar
Simon Marlow committed
171
                 mapFromList [ (l, filterAssignments (getLive l) assigs'')
172 173
                             | l <- succs ]

Simon Marlow's avatar
Simon Marlow committed
174
{-
Simon Marlow's avatar
Simon Marlow committed
175 176 177 178 179
-- tiny: an expression we don't mind duplicating
isTiny :: CmmExpr -> Bool
isTiny (CmmReg _) = True
isTiny (CmmLit _) = True
isTiny _other     = False
Simon Marlow's avatar
Simon Marlow committed
180
-}
181

Simon Marlow's avatar
Simon Marlow committed
182
--
183
-- annotate each node with the set of registers live *after* the node
Simon Marlow's avatar
Simon Marlow committed
184
--
185
annotate :: RegSet -> [CmmNode O O] -> [(RegSet, CmmNode O O)]
Simon Marlow's avatar
Simon Marlow committed
186 187 188 189 190 191 192 193 194 195 196 197 198
annotate live nodes = snd $ foldr ann (live,[]) nodes
  where ann n (live,nodes) = (gen_kill n live, (live,n) : nodes)

--
-- Find the blocks that have multiple successors (join points)
--
findJoinPoints :: [CmmBlock] -> BlockEnv Int
findJoinPoints blocks = mapFilter (>1) succ_counts
 where
  all_succs = concatMap successors blocks

  succ_counts :: BlockEnv Int
  succ_counts = foldr (\l -> mapInsertWith (+) l 1) mapEmpty all_succs
199

Simon Marlow's avatar
Simon Marlow committed
200 201 202 203
--
-- filter the list of assignments to remove any assignments that
-- are not live in a continuation.
--
204 205
filterAssignments :: RegSet -> [Assignment] -> [Assignment]
filterAssignments live assigs = reverse (go assigs [])
Simon Marlow's avatar
Simon Marlow committed
206
  where go []             kept = kept
207 208 209
        go (a@(r,_,_):as) kept | needed    = go as (a:kept)
                               | otherwise = go as kept
           where
Simon Marlow's avatar
Simon Marlow committed
210 211 212 213 214
              needed = r `Set.member` live
                       || any (a `conflicts`) (map toNode kept)
                       --  Note that we must keep assignments that are
                       -- referred to by other assignments we have
                       -- already kept.
215

Simon Marlow's avatar
Simon Marlow committed
216 217 218
-- -----------------------------------------------------------------------------
-- Walk through the nodes of a block, sinking and inlining assignments
-- as we go.
Simon Marlow's avatar
Simon Marlow committed
219

Simon Marlow's avatar
Simon Marlow committed
220 221 222
walk :: [(RegSet, CmmNode O O)]         -- nodes of the block, annotated with
                                        -- the set of registers live *after*
                                        -- this node.
Simon Marlow's avatar
Simon Marlow committed
223

Simon Marlow's avatar
Simon Marlow committed
224 225 226 227
     -> [Assignment]                    -- The current list of
                                        -- assignments we are sinking.
                                        -- Later assignments may refer
                                        -- to earlier ones.
228

Simon Marlow's avatar
Simon Marlow committed
229 230 231
     -> ( Block CmmNode O O             -- The new block
        , [Assignment]                  -- Assignments to sink further
        )
232

Simon Marlow's avatar
Simon Marlow committed
233 234 235 236
walk nodes assigs = go nodes emptyBlock assigs
 where
   go []               block as = (block, as)
   go ((live,node):ns) block as
Simon Marlow's avatar
Simon Marlow committed
237
    | shouldDiscard node live    = go ns block as
Simon Marlow's avatar
Simon Marlow committed
238 239 240 241 242 243 244
    | Just a <- shouldSink node1 = go ns block (a : as1)
    | otherwise                  = go ns block' as'
    where
      (node1, as1) = tryToInline live node as

      (dropped, as') = dropAssignmentsSimple (`conflicts` node1) as1
      block' = foldl blockSnoc block dropped `blockSnoc` node1
245

Simon Marlow's avatar
Simon Marlow committed
246 247 248 249 250 251
--
-- Heuristic to decide whether to pick up and sink an assignment
-- Currently we pick up all assignments to local registers.  It might
-- be profitable to sink assignments to global regs too, but the
-- liveness analysis doesn't track those (yet) so we can't.
--
252
shouldSink :: CmmNode e x -> Maybe Assignment
253
shouldSink (CmmAssign (CmmLocal r) e) | no_local_regs = Just (r, e, exprMem e)
Simon Marlow's avatar
Simon Marlow committed
254
  where no_local_regs = True -- foldRegsUsed (\_ _ -> False) True e
255 256
shouldSink _other = Nothing

Simon Marlow's avatar
Simon Marlow committed
257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275
--
-- discard dead assignments.  This doesn't do as good a job as
-- removeDeadAsssignments, because it would need multiple passes
-- to get all the dead code, but it catches the common case of
-- superfluous reloads from the stack that the stack allocator
-- leaves behind.
--
-- Also we catch "r = r" here.  You might think it would fall
-- out of inlining, but the inliner will see that r is live
-- after the instruction and choose not to inline r in the rhs.
--
shouldDiscard :: CmmNode e x -> RegSet -> Bool
shouldDiscard node live
   = case node of
       CmmAssign r (CmmReg r') | r == r' -> True
       CmmAssign (CmmLocal r) _ -> not (r `Set.member` live)
       _otherwise -> False
  

276 277 278
toNode :: Assignment -> CmmNode O O
toNode (r,rhs,_) = CmmAssign (CmmLocal r) rhs

Simon Marlow's avatar
Simon Marlow committed
279 280
dropAssignmentsSimple :: (Assignment -> Bool) -> [Assignment]
                      -> ([CmmNode O O], [Assignment])
Simon Marlow's avatar
Simon Marlow committed
281 282
dropAssignmentsSimple f = dropAssignments (\a _ -> (f a, ())) ()

Simon Marlow's avatar
Simon Marlow committed
283 284
dropAssignments :: (Assignment -> s -> (Bool, s)) -> s -> [Assignment]
                -> ([CmmNode O O], [Assignment])
Simon Marlow's avatar
Simon Marlow committed
285
dropAssignments should_drop state assigs
286 287
 = (dropped, reverse kept)
 where
Simon Marlow's avatar
Simon Marlow committed
288
   (dropped,kept) = go state assigs [] []
289

Simon Marlow's avatar
Simon Marlow committed
290 291 292 293
   go _ []             dropped kept = (dropped, kept)
   go state (assig : rest) dropped kept
      | conflict  = go state' rest (toNode assig : dropped) kept
      | otherwise = go state' rest dropped (assig:kept)
294
      where
Simon Marlow's avatar
Simon Marlow committed
295 296 297
        (dropit, state') = should_drop assig state
        conflict = dropit || any (assig `conflicts`) dropped

Simon Marlow's avatar
Simon Marlow committed
298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313

-- -----------------------------------------------------------------------------
-- Try to inline assignments into a node.

tryToInline
   :: RegSet                    -- set of registers live after this
                                -- node.  We cannot inline anything
                                -- that is live after the node, unless
                                -- it is small enough to duplicate.
   -> CmmNode O x               -- The node to inline into
   -> [Assignment]              -- Assignments to inline
   -> (
        CmmNode O x             -- New node
      , [Assignment]            -- Remaining assignments
      )

Simon Marlow's avatar
Simon Marlow committed
314
tryToInline live node assigs = go usages node [] assigs
Simon Marlow's avatar
Simon Marlow committed
315 316 317 318
 where
  usages :: UniqFM Int
  usages = foldRegsUsed addUsage emptyUFM node

Simon Marlow's avatar
Simon Marlow committed
319
  go _usages node skipped [] = (node, [])
Simon Marlow's avatar
Simon Marlow committed
320

Simon Marlow's avatar
Simon Marlow committed
321 322 323
  go usages node skipped (a@(l,rhs,_) : rest)
   | can_inline              = inline_and_discard
   | False {- isTiny rhs -}  = inline_and_keep
Simon Marlow's avatar
Simon Marlow committed
324
     --  ^^ seems to make things slightly worse
Simon Marlow's avatar
Simon Marlow committed
325
   where
Simon Marlow's avatar
Simon Marlow committed
326
        inline_and_discard = go usages' node' skipped rest
Simon Marlow's avatar
Simon Marlow committed
327 328

        inline_and_keep = (node'', a : rest')
Simon Marlow's avatar
Simon Marlow committed
329
          where (node'',rest') = go usages' node' (l:skipped) rest
Simon Marlow's avatar
Simon Marlow committed
330

Simon Marlow's avatar
Simon Marlow committed
331 332 333 334 335
        can_inline =
            not (l `elemRegSet` live)
         && not (skipped `regsUsedIn` rhs)  -- Note [dependent assignments]
         && okToInline rhs node
         && lookupUFM usages l == Just 1
Simon Marlow's avatar
Simon Marlow committed
336 337 338 339 340 341 342 343 344

        usages' = foldRegsUsed addUsage usages rhs

        node' = mapExpDeep inline node
           where inline (CmmReg    (CmmLocal l'))     | l == l' = rhs
                 inline (CmmRegOff (CmmLocal l') off) | l == l'
                    = cmmOffset rhs off
                 inline other = other

Simon Marlow's avatar
Simon Marlow committed
345
  go usages node skipped (assig@(l,rhs,_) : rest)
Simon Marlow's avatar
Simon Marlow committed
346
    = (node', assig : rest')
Simon Marlow's avatar
Simon Marlow committed
347
    where (node', rest') = go usages' node (l:skipped) rest
Simon Marlow's avatar
Simon Marlow committed
348 349 350 351
          usages' = foldRegsUsed (\m r -> addToUFM m r 2) usages rhs
          -- we must not inline anything that is mentioned in the RHS
          -- of a binding that we have already skipped, so we set the
          -- usages of the regs on the RHS to 2.
Simon Marlow's avatar
Simon Marlow committed
352

Simon Marlow's avatar
Simon Marlow committed
353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371
-- Note [dependent assignments]
--
-- If our assignment list looks like
--
--    [ y = e,  x = ... y ... ]
--
-- We cannot inline x.  Remember this list is really in reverse order,
-- so it means  x = ... y ...; y = e
--
-- Hence if we inline x, the outer assignment to y will capture the
-- reference in x's right hand side.
--
-- In this case we should rename the y in x's right-hand side,
-- i.e. change the list to [ y = e, x = ... y1 ..., y1 = y ]
-- Now we can go ahead and inline x.
--
-- For now we do nothing, because this would require putting
-- everything inside UniqSM.

Simon Marlow's avatar
Simon Marlow committed
372 373 374
addUsage :: UniqFM Int -> LocalReg -> UniqFM Int
addUsage m r = addToUFM_C (+) m r 1

Simon Marlow's avatar
Simon Marlow committed
375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390
regsUsedIn :: [LocalReg] -> CmmExpr -> Bool
regsUsedIn [] e = False
regsUsedIn ls e = wrapRecExpf f e False
  where f (CmmReg (CmmLocal l))      _ | l `elem` ls = True
        f (CmmRegOff (CmmLocal l) _) _ | l `elem` ls = True
        f _ z = z

-- we don't inline into CmmUnsafeForeignCall if the expression refers
-- to global registers.  This is a HACK to avoid global registers
-- clashing with C argument-passing registers, really the back-end
-- ought to be able to handle it properly, but currently neither PprC
-- nor the NCG can do it.  See Note [Register parameter passing]
-- See also StgCmmForeign:load_args_into_temps.
okToInline :: CmmExpr -> CmmNode e x -> Bool
okToInline expr CmmUnsafeForeignCall{} = not (anyCallerSavesRegs expr)
okToInline _ _ = True
Simon Marlow's avatar
Simon Marlow committed
391

Simon Marlow's avatar
Simon Marlow committed
392
-- -----------------------------------------------------------------------------
393 394 395 396 397 398 399

-- | @conflicts (r,e) stmt@ is @False@ if and only if the assignment
-- @r = e@ can be safely commuted past @stmt@.
--
-- We only sink "r = G" assignments right now, so conflicts is very simple:
--
conflicts :: Assignment -> CmmNode O x -> Bool
400 401 402 403 404 405 406 407 408 409
(r, rhs, addr) `conflicts` node

  -- (1) an assignment to a register conflicts with a use of the register
  | CmmAssign reg  _ <- node, reg `regUsedIn` rhs                 = True
  | foldRegsUsed (\b r' -> r == r' || b) False node               = True

  -- (2) a store to an address conflicts with a read of the same memory
  | CmmStore addr' e <- node, memConflicts addr (loadAddr addr' (cmmExprWidth e)) = True

  -- (3) an assignment to Hp/Sp conflicts with a heap/stack read respectively
410 411 412 413 414 415 416 417 418 419
  | HeapMem    <- addr, CmmAssign (CmmGlobal Hp) _ <- node        = True
  | StackMem   <- addr, CmmAssign (CmmGlobal Sp) _ <- node        = True
  | SpMem{}    <- addr, CmmAssign (CmmGlobal Sp) _ <- node        = True

  -- (4) assignments that read caller-saves GlobalRegs conflict with a
  -- foreign call.  See Note [foreign calls clobber GlobalRegs].
  | CmmUnsafeForeignCall{} <- node, anyCallerSavesRegs rhs        = True

  -- (5) foreign calls clobber memory, but not heap/stack memory
  | CmmUnsafeForeignCall{} <- node, AnyMem <- addr                = True
420

421 422 423 424
  -- (6) native calls clobber any memory
  | CmmCall{} <- node, memConflicts addr AnyMem                   = True

  -- (7) otherwise, no conflict
425 426 427
  | otherwise = False


428 429 430 431 432
anyCallerSavesRegs :: CmmExpr -> Bool
anyCallerSavesRegs e = wrapRecExpf f e False
  where f (CmmReg (CmmGlobal r)) _ | callerSaves r = True
        f _ z = z

433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450
-- An abstraction of memory read or written.
data AbsMem
  = NoMem            -- no memory accessed
  | AnyMem           -- arbitrary memory
  | HeapMem          -- definitely heap memory
  | StackMem         -- definitely stack memory
  | SpMem            -- <size>[Sp+n]
       {-# UNPACK #-} !Int
       {-# UNPACK #-} !Int

-- Having SpMem is important because it lets us float loads from Sp
-- past stores to Sp as long as they don't overlap, and this helps to
-- unravel some long sequences of
--    x1 = [Sp + 8]
--    x2 = [Sp + 16]
--    ...
--    [Sp + 8]  = xi
--    [Sp + 16] = xj
451
--
452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496
-- Note that SpMem is invalidated if Sp is changed, but the definition
-- of 'conflicts' above handles that.

bothMems :: AbsMem -> AbsMem -> AbsMem
bothMems NoMem    x         = x
bothMems x        NoMem     = x
bothMems HeapMem  HeapMem   = HeapMem
bothMems StackMem StackMem     = StackMem
bothMems (SpMem o1 w1) (SpMem o2 w2)
  | o1 == o2  = SpMem o1 (max w1 w2)
  | otherwise = StackMem
bothMems SpMem{}  StackMem  = StackMem
bothMems StackMem SpMem{}   = StackMem
bothMems _         _        = AnyMem

memConflicts :: AbsMem -> AbsMem -> Bool
memConflicts NoMem      _          = False
memConflicts _          NoMem      = False
memConflicts HeapMem    StackMem   = False
memConflicts StackMem   HeapMem    = False
memConflicts SpMem{}    HeapMem    = False
memConflicts HeapMem    SpMem{}    = False
memConflicts (SpMem o1 w1) (SpMem o2 w2)
  | o1 < o2   = o1 + w1 > o2
  | otherwise = o2 + w2 > o1
memConflicts _         _         = True

exprMem :: CmmExpr -> AbsMem
exprMem (CmmLoad addr w)  = bothMems (loadAddr addr (typeWidth w)) (exprMem addr)
exprMem (CmmMachOp _ es)  = foldr bothMems NoMem (map exprMem es)
exprMem _                 = NoMem

loadAddr :: CmmExpr -> Width -> AbsMem
loadAddr e w =
  case e of
   CmmReg r       -> regAddr r 0 w
   CmmRegOff r i  -> regAddr r i w
   _other | CmmGlobal Sp `regUsedIn` e -> StackMem
          | otherwise -> AnyMem

regAddr :: CmmReg -> Int -> Width -> AbsMem
regAddr (CmmGlobal Sp) i w = SpMem i (widthInBytes w)
regAddr (CmmGlobal Hp) _ _ = HeapMem
regAddr r _ _ | isGcPtrType (cmmRegType r) = HeapMem -- yay! GCPtr pays for itself
regAddr _ _ _ = AnyMem